;********************************************************************
;*                                                                  *
;*                      S  O  P  R  O  L                            *
;*                                                                  *
;*          Sound  Programming  Language  for the Amiga             *
;*                                                                  *
;*     written by Holger Gehrmann, West-Germany    Feb. 1987        *
;*                                                                  *
;********************************************************************
	
	
	
run:      jmp begin
	
genbase   =$dff0a0
anfinstr  =$60000
instrbase:	blk.b 320,0
irqbuff:	dc.l 0,0,0,0,0,0,0,0
poi1:		dc.l 0,0,0,0
stacks:		dc.l 0,0,0,0
nocnt:		dc.b 0,0,0,0
aklength:	dc.b 0,0,0,0
trans:		dc.b 4,0
handle:		dc.l 0
curname:	dc.l 0
curanf:		dc.l 0
transpoi:	dc.l 0
excnt:		dc.l 0
excnt2:		dc.l 0
	
TBegin      =0
Length      =4
LoopBegin   =6
LoopLength  =10
Octave      =12
Effects     =14
MultiGe     =16
DecWait     =18
EchoWait    =20
EchoSub     =22
ModStep     =24
ModWait     =26
ModArea     =28
Volume      =30
Offset      =32
	
Plint       =34
Multicnt    =Plint
DecayCnt    =Plint+2
CurVolume   =Plint+4
EchoCnt     =Plint+6
EchoNVol    =Plint+8
ModCnt      =Plint+10
ModAreaCnt  =Plint+12
ModDir      =Plint+14
ton1        =Plint+16
ton2        =Plint+18
ton3        =Plint+20
ton4        =Plint+22
	
NextGen     =Plint+24
	
	
Open        =-30
Close       =-36
Read        =-42
	
OpenLibrary =-552
	
Effect      =$f4f4f4f0
Call        =$f4f4f4f1
Recall      =$f4f4f4f2
Rec         =$f4f4f4f2
Jump        =$f4f4f4f3
NoOperation =$f4f4f4f4
Restart     =$f4f4f4f5
	
anfslap     =$60000
anfkoto     =$62000
anfvoice    =$64000
anfbass     =$66000
anfsnare    =$68000
anfclaps    =$6a000
anfwhist    =$6c000
anfsdrums   =$6e000
	
nados:	dc.b "dos.library",0
	
names:	dc.b "df1:slapbass.sh",0,"  "
	dc.b "df1:voice.sh",0,"     "
	dc.b "df1:lead.sh",0,"      "
	dc.b "df1:bassdrum.sh",0,"  "
	dc.b "df1:snaredrum.sh",0," "
	dc.b "df1:claps.sh",0,"     "
	dc.b "df1:whistle.sh",0,"   "
	dc.b "df1:magic.sh",0,"     "
	dc.b 0,0
	
even	
	
notab:	dc.w 54784,51712,48768,46080,43392,40960,38656,36480
	dc.w 34432,32512,30720,28928,27392,27392,27392,27392
	
	
;******** song data anfang *****************************************
	
eff1:	dc.l effect,anfslap,$1c710000,$00000000,$00040000,$00000000
	dc.l $00000000,$00000000,$00000040,$0000f4f4,recall
eff2:	dc.l effect,anfkoto,$11400000,$00000000,$00020000,$00000000
	dc.l $00000000,$00000000,$00000030,$0000f4f4,recall
eff3:	dc.l effect,anfvoice,$249f0000,$00000000,$00020000,$00000000
	dc.l $00000000,$00000000,$00000028,$0000f4f4,recall
eff4:	dc.l effect,anfbass,$10000000,$00000000,$00020000,$00000000
	dc.l $00000000,$00000000,$00000018,$0000f4f4,recall
eff5:	dc.l effect,anfsnare,$10000000,$00000000,$00020000,$00000000
	dc.l $00000000,$00000000,$00000018,$0000f4f4,recall
eff6:	dc.l effect,anfclaps,$10000000,$00000000,$00020000,$00000000
	dc.l $00000000,$00000000,$00000018,$0000f4f4,recall
effp:	dc.l effect,anfclaps,$10000000,$00000000,$00020000,$00000000
	dc.l $00000000,$00000000,$00000000,$0000f4f4,recall
eff7:	dc.l effect,anfwhist,$08000000,$00000000,$00030000,$00000000
	dc.l $00000000,$00000000,$00000030,$0000f4f4,recall
eff8:	dc.l effect,anfsdrums,$10000000,$00000000,$00020000,$00000000
	dc.l $00000000,$00000000,$00000040,$0000f4f4,recall
eff9:	dc.l effect,anfvoice,$20000000,$00000000,$00020001,$00010000
	dc.l $00000000,$00000000,$00000030,$0000f4f4,recall	
eff10:	dc.l effect,anfkoto,$10000000,$00000000,$00030000,$00000000
	dc.l $00000000,$00000000,$00000030,$0000f4f4,recall	
	
;****** Song 1 >>  "Space Port Theme" by Holger Gehrmann
	
pauha:	dc.l call,effp,$d040f4f4,recall
pau1:	dc.l call,effp,$d04040f4,recall
pau2:	dc.l call,effp,$d0404040,$40f4f4f4,recall
pau4:	dc.l call,effp,$d0404040,$40404040,$40f4f4f4,recall
basl1:	dc.l call,eff1,$c4192919,$29192919,$29f4f4f4
	dc.l $17271727,$17271727,$15251525,$15251525
	dc.l $14241424,$18281828,recall
akkt:	dc.l call,eff3,$c4444444,$44454545,$45f4f4f4,recall
akkh:	dc.l call,eff3,$c4494949,$49494949,$49f4f4f4,recall	
wu1:	dc.l call,eff2,$c249c450,$c249c454,$c249c450,$c249cc54
	dc.l recall	
akkz:	dc.l call,eff9,$c4444944,$49444944,$49454945,$49454945
	dc.l $49f4f4f4,recall	
hmel1:	dc.l call,eff8,$c849c449,$4b504b49,$5457524b,$c252c657
	dc.l $c457595b,$60595759,$57595455,$545454c2,$55c254f4
	dc.l call,pauha,recall	
	
song1a:	dc.l call,basl1,jump,song1a
	
song1b:	dc.l call,pau4
ly1:	dc.l call,akkz,jump,ly1
	
song1c:	dc.l call,pau4,call,pau4
ly2:	dc.l call,hmel1,jump,ly2
	
song1d:	dc.l call,pau4,call,pau4
ly3:	dc.l call,wu1,jump,ly3
	
	
;****** Song 2 >>  "Happy Phone"      by Holger Gehrmann
	
paut:	dc.l call,effp,$c6404040,$40f4f4f4,recall
paut2:	dc.l call,effp,$c6404040,$40404040,$40f4f4f4,recall
paut4:	dc.l call,paut2,call,paut2,recall
tut1:	dc.l call,eff3,$c2475054,$47505447,$5054f4f4,call,effp
	dc.l $404040f4,recall
tut2:	dc.l call,eff3,$c2495055,$49505557,$524bf4f4,call,effp
	dc.l $404040f4,recall
tut3:	dc.l call,eff3,$c2495054,$49505449,$5054f4f4,call,effp
	dc.l $404040f4,recall
tut4:	dc.l call,eff3,$c2495255,$49525547,$4b52f4f4,call,effp
	dc.l $404040f4,recall
basb1:	dc.l call,eff1,$c6203020,$30253527,$37203020,$30152517
	dc.l $27f4f4f4,recall
basb2:	dc.l call,eff1,$c6192919,$29152517,$27192919,$29122217
	dc.l $27f4f4f4,recall
mel1:	dc.l call,eff7,$c640c444,$c244c444,$c244c445,$c247c645
	dc.l $45c442c2,$40c442c2,$40c444c2,$40c439c2,$37f4f4f4
	dc.l call,effp,$cc50f4f4,recall
mel1n:	dc.l call,mel1,call,eff2,$c63535c4,$32c230c4,$32c234f4
	dc.l recall
mel2:	dc.l call,effp,$c640f4f4,call,eff7,$c444c244,$c444c244
	dc.l $c445c247,$c64545c4,$42c240c4,$42c240f4,recall
tuta1:	dc.l call,tut1,call,tut2,recall
tuta2:	dc.l call,tut3,call,tut4,recall
schla1:	dc.l call,eff4,$c650f4f4,call,eff5,$ca50f4f4,call,eff4
	dc.l $c250f4f4,call,eff5,$c450c250,recall
melm1:	dc.l call,eff7,$c640c444,$c840c639,$4040c43b,$c239c437
	dc.l $c239f4f4,recall
tutab1:	dc.l call,tuta1,call,tuta1,call,tuta1,call,tuta1,recall
tutab2:	dc.l call,tuta2,call,tuta2,call,tuta2,call,tuta2,recall	
	
song2a:	dc.l call,paut2,call,paut2,call,basb1
lq3:	dc.l call,basb1,call,basb1,call,basb1,call,basb1
	dc.l call,basb2,call,basb2,call,basb2,call,basb2
	dc.l jump,lq3
	
song2b:	dc.l call,paut4,call,paut4
lq1:	dc.l call,mel1n,call,mel2,call,paut,call,paut
	dc.l call,mel1n,call,mel2,call,paut,call,paut
	dc.l call,melm1,call,melm1,call,melm1,call,melm1
	dc.l call,mel1n,call,mel2,call,paut,call,paut
	dc.l jump,lq1
	
song2c:	dc.l call,tut1,call,tut1,call,tut1,call,tut1
	dc.l call,tuta1,call,tuta1
lq2:	dc.l call,tutab1,call,tutab1
	dc.l call,tutab2,call,tutab2,jump,lq2
	
song2d:	dc.l call,schla1,jump,song2d
	
even	
	
tonerz:	nop   ;Generator D0, Ton D1
	movem.l d0-d7/a0-a6,-(sp)
	and.l #3,d0
	move.l d0,d2
	mulu #nextgen,d2
	move.l d2,a1
	move.l d0,d2
	asl.w #4,d2
	move.l d2,a0
	add.l #GenBase,a0
	add.l #InstrBase,a1
	jsr keytrans
	move.l #$00010001,4(a0)       ;reset generator
	move.w #350,d5
te0:	subq.w #1,d5
	tst.w d5
	bne te0
	jsr resplint
	move.w Volume(a1),CurVolume(a1)
	move.w Octave(a1),d3
	asl.b #4,d3
	add.b d3,d1
	move.b d1,d3
	and.l #$0f,d1
	asl.b #1,d1
	add.l #notab,d1
	move.l d1,a4
	move.w (a4),d4
	lsr.b #4,d3
te2:	tst.b d3
	beq te1
	lsr.w #1,d4
	subq.b #1,d3
	jmp te2
te1:	move.w #1,d7
	tst.b d0
	beq te1a
te1b:	asl.w #1,d7
	subq.b #1,d0
	tst.b d0
	bne te1b
te1a:	move.w d7,$dff096
	move.w d4,6(a0)
	move.w ton1(a1),ton2(a1)
	move.w d4,ton1(a1)
	move.l TBegin(a1),(a0)
	move.w Length(a1),4(a0)
	move.w Volume(a1),8(a0)
	or.w #$8000,d7
	move.w d7,$dff096
b2:	movem.l (sp)+,d0-d7/a0-a6
	rts
	
keytrans:nop
	move.b trans,d7
	add.w Offset(a1),d7
	tst.b d7
	beq kt1
kt3:	addq.b #1,d1
	move.b d1,d6
	and.b #$0f,d6
	cmp.b #$0c,d6
	bne kt2
	add.b #$10,d1
	and.b #$f0,d1
kt2:	subq.b #1,d7
	bne kt3
kt1:	rts
	
resplint:movem.l d6/a6,-(sp)
	clr.l d6
	move.b #Plint,d6
	move.l a1,a6
	add.l d6,a6
rp1:	clr.b (a6)
	addq.l #1,a6
	addq.b #1,d6
	cmp.b #nextgen-16,d6
	bne rp1
	movem.l (sp)+,d6/a6
	rts
	
init:	move.l #InstrBase,a0
	move.w $60006,d0       ;length
	lsr.w #1,d0
	move.w d0,Length(a0)
	move.w d0,$dff0a4
	move.w #428,$dff0a6     ;pitch
	move.w #$40,$dff0a8     ;volume
	move.w #$800f,$dff096   ;DMA
	move.l #$60030,$dff0a0  ;location
	move.l #$60030,TBegin(a0)
	move.b #2,Octave(a0)
	move.w #$0088,$dff09e
	move.l #stackanf,stacks
	move.l #stackanf+40,stacks+4
	move.l #stackanf+80,stacks+8
	move.l #stackanf+120,stacks+12
	rts
	
begin:	nop
	cmp.w #$1c71,anfinstr
	beq ru3
	move.l $4,a5
	move.l #nados,a1
	move.l #0,d0
	jsr OpenLibrary(a5)
	move.l d0,a5
	move.l #names,curname
	move.l #anfinstr,curanf
	
ru4:	move.l curname,d1
	move.l #1005,d2
	jsr Open(a5)
	move.l d0,handle
	move.l d0,d1
	move.l curanf,d2
	move.l #$2000,d3
	jsr Read(a5)
	move.l handle,d1
	move.w d1,d2
	jsr Close(a5)
	add.l #18,curname
	add.l #$2000,curanf
	move.l curname,a4
	tst.b (a4)
	bne ru4
	
ru3:	jsr init                   
	move.l #song2a,poi1
	move.l #song2b,poi1+4
	move.l #song2c,poi1+8
	move.l #song2d,poi1+12
	jsr irqsave
	move.l #son,$60
	move.l #son,$64
	move.l #son,$68
	move.l #sopirq,$6c
	move.l #son,$70
	move.l #son,$74
	move.l #son,$78
	move.l #son,$7c
sox:	move.w $dff00c,d0
	btst #1,d0
	beq sox
	jsr irqload
	move.w #$e02c,$dff09a
	move.w #$000f,$dff096
b1:	nop
	rts
	
;****** irq load/save
	
irqsave:move.l #$60,a0
	move.l #irqbuff,a1
	move.b #8,d7
isqq1:	move.l (a0),(a1)
	addq.l #4,a0
	addq.l #4,a1
	subq.b #1,d7
	tst.b d7
	bne isqq1
	rts
	
irqload:move.l #irqbuff,a0
	move.l #$60,a1
	move.b #8,d7
	jmp isqq1
	
	
son:	nop
	movem.l d0/d1/a0/a1/a5/a6,-(sp)
	jmp lax1
sopirq:	movem.l d0/d1/a0/a1/a5/a6,-(sp)
lax1:	move.w #$7fff,$dff09c
	move.w #$7fff,$dff09a
	move.w #$c020,$dff09a
	move.w $dff006,$dff180
	jsr lax2
	move.w #$222,$dff180
lax3:	lea $dff000,a0
	move.l $4,a6
	movem.l $9c(a6),a1/a5
	pea -36(a6)
	jmp (a5)
	
lax2:	movem.l d0-d7/a0-a6,-(sp)
	jsr ru2
	movem.l (sp)+,d0-d7/a0-a6
	rts	
	
ru2:	jsr modton
	cmp.w #3,excnt
	beq ru1a
	tst.w excnt
	beq ru1
	subq.w #1,excnt
	rts
ru1:	move.w #6,excnt
ru1b:	jsr work
	rts
ru1a:	subq.w #1,excnt
	jmp ru1b	
	
work:	nop
	move.l #poi1,a6
	move.l #stacks,a2
	move.l #InstrBase,a1
	move.l #aklength,a4
	move.l #0,d4            ;generator#
	move.l #nocnt,a0
wo0:	move.l (a2),a3
	tst.b (a0)
	beq wo1
	subq.b #1,(a0)
	tst.b (a0)
	bne wow
wo1:	move.l (a6),a5
	move.b (a5),d0     ;Befehl lesen
	cmp.b #$f4,d0      ;NOP
	bne wo2
	addq.l #1,(a6)
	jmp wo1
wo2:	cmp.b #$f3,d0      ;jump
	bne wo3
	addq.l #1,(a6)
	addq.l #1,a5
	move.l (a5),(a6)
	move.l (a6),a5
	jmp wo1
wo3:	cmp.b #$f1,d0      ;call
	bne wo4
	addq.l #1,a5
	move.l a5,(a3)
	addq.l #4,a3
	addq.l #4,(a2)
	move.l (a5),(a6)
	move.l (a6),a5
	jmp wo1
wo4:	cmp.b #$f2,d0      ;recall
	bne wo5
	subq.l #4,a3
	subq.l #4,(a2)
	move.l (a3),a5
	move.l (a3),(a6)
	addq.l #4,a5
	addq.l #4,(a6)
	jmp wo1
wo5:	cmp.b #$f0,d0      ;effect
	bne wo6
	addq.l #1,a5
	addq.l #1,(a6)
	movem.l d6/a4,-(sp)
	move.l #0,a4
	move.b #Plint,d6
wox1:	move.w (a4,a5),(a4,a1)
	addq.l #2,a4
	subq.b #2,d6
	tst.b d6
	bne wox1
	movem.l (sp)+,d6/a4
	add.l #34,a5
	add.l #34,(a6)
	jmp wo1
wo6:	cmp.b #$f5,d0	;restart
	bne wo6a
	nop		;future expansion
wo6a:	and.b #$f0,d0
	cmp.b #$c0,d0
	beq wo7
	cmp.b #$d0,d0
	beq wo7
	cmp.b #$e0,d0
	bne wo8
wo7:	move.b (a5),d0
	sub.b #$c0,d0
	move.b d0,(a0)
	move.b d0,(a4)
	addq.l #1,a5
	addq.l #1,(a6)
	jmp wo1
wo8:	move.b (a5),d1
	move.l d4,d0
	jsr tonerz
	move.w Effects(a1),d0
	btst #0,d0
	beq wo8a
	addq.l #1,a5
	addq.l #1,(a6)
	move.b (a5),d1
	move.l d4,d0
	jsr tonerz
wo8a:	addq.l #1,a5
	addq.l #1,(a6)
	move.b (a4),(a0)
wow:	nop
	addq.b #1,d4
	addq.l #4,a6
	add.l #nextgen,a1
	addq.l #4,a2
	addq.l #1,a0
	addq.l #1,a4
	cmp.b #4,d4
	bne wo0
	
	rts
	
;****** Modulate Toene
	
modton:	move.l #InstrBase,a1
	move.l #GenBase,a0
	clr.l d4
mt1:	move.w Effects(a1),d0
	btst #0,d0
	beq mt4
	tst.w MultiCnt(a1)
	beq mt2
	subq.w #1,MultiCnt(a1)
	jmp mt4
mt2:	move.w MultiGe(a1),MultiCnt(a1)
	move.w ton1(a1),d0
	move.w ton2(a1),ton1(a1)
	move.w d0,ton2(a1)
	move.w ton2(a1),6(a0)
mt4:	nop
	add.l #nextgen,a1
	add.l #$10,a0
	addq.b #1,d4
	cmp.b #4,d4
	bne mt1
	rts
	
even	
	
stackanf:dc.b 0