;********************************************************************
;*                                                                  *
;*                      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
adsrbase: dc.l 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
instrbase:dc.l 0,0,0,0,0,0,0,0,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 5,0
handle:   dc.l 0
curname:  dc.l 0
curanf:   dc.l 0

TBegin      =0
Length      =4
LoopLength  =6
Octave      =8
SAttackWait =9
SAttackStep =10
SSustainWait=11
SDecayWait  =12
SDecayStep  =13
SEndval     =14
SVolume     =15

AttackWait  =0
Attackstep  =1
SustainWait =2
DecayWait   =3
DecayStep   =4
Endval      =5
IPhase      =6
ICount      =7
IVolume     =8

;#### dos_lib.i ####

ando  =-24

Open          =ando-6
Close         =ando-12
Read          =ando-18

;#### exec/exec_lib.i ####

anex=-24

OpenLibrary     =anex-528
RawMayGetChar   =anex-486

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:koto.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:synthdrums.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,$020040ff,$ff0040f4,recall
eff2:     dc.l effect,anfkoto,$11400000,$020040ff,$ff0040f4,recall
eff3:     dc.l effect,anfvoice,$249f0000,$020040ff,$ff0040f4,recall
eff4:     dc.l effect,anfbass,$10000000,$020040ff,$ff001038,recall
eff5:     dc.l effect,anfsnare,$10000000,$020040ff,$ff001038,recall
eff6:     dc.l effect,anfclaps,$10000000,$020040ff,$ff001038,recall
effp:     dc.l effect,anfclaps,$10000000,$020040ff,$ff001000,recall
eff7:     dc.l effect,anfwhist,$08000000,$030040ff,$ff0040f4,recall
eff8:     dc.l effect,anfsdrums,$10000000,$030040ff,$ff0040f4,recall
basa:     dc.l call,eff1,$c4495949,$59f2f4f4
basg:     dc.l $c4475747,$57f2f4f4
basf:     dc.l $c4455545,$55f2f4f4
basd:     dc.l $c4425242,$52f2f4f4
basge:    dc.l $c4475744,$54f2f4f4
blea:     dc.l call,eff2,$c2495054,$59495054,$59f2f4f4
bleg:     dc.l $c2474b52,$57474b52,$57f2f4f4
blege:    dc.l $c2474b52,$5744474b,$54f2f4f4
blef:     dc.l $c2454950,$55454950,$55f2f4f4
bled:     dc.l $c2424549,$52424549,$52f2f4f4
basb1:    dc.l call,basa,call,basa,call,basf,call,basg,call,basa
          dc.l call,basa,call,basd,call,basge,recall
basb2:    dc.l call,basa,call,basa,call,basa,call,basg,call,basa
          dc.l call,basa,call,basf,call,basg,call,basa,call,basa
          dc.l call,basa,call,basg,call,basa,call,basa
          dc.l call,basf,call,basg,call,basf,call,basf,call,basg
          dc.l call,basg,call,basf,call,basf,call,basg,call,basg,rec
ble1:     dc.l call,blea,call,blea,call,blef,call,bleg,call,blea
          dc.l call,blea,call,bled,call,blege,recall
ble1a:    dc.l call,blea,call,blea,call,blef,call,bleg,call,blea
          dc.l call,blea,call,spart,recall
mel1:     dc.l call,eff3,$c4494950,$c249c454,$c249c450,$4b47f2f4
spart:    dc.l call,eff3,$c449f4f4,call,eff8,$3838c234,$c43430c2
          dc.l $2ac42a25,recall
spart2:   dc.l $c4525255,$c252c447,$47c247c4,$4b47f2f4
schla1:   dc.l call,eff4,$c850f4f4,call,eff5,$c450f4f4,call,eff4
          dc.l $50c850f4,call,eff5,$c450f4f4,call,eff4,$c850c450
          dc.l call,eff5,$50f4f4f4,call,eff4,$5050f4f4,call,eff6
          dc.l $494949f2
schla2:   dc.l call,eff4,$c850f4f4,call,eff5,$c450f4f4,call,eff4
          dc.l $50c850f4,call,eff5,$c450f4f4,call,eff4,$c850c450
          dc.l call,eff5,$50f4f4f4,call,eff4,$5050f4f4,call,eff6
          dc.l $c249c449,$c2494949,recall
paub:     dc.l call,effp,$c8505050,$50505050,$50f2f4f4
hmel1:    dc.l call,eff7,$c4505050,$5050504b,$c850dc49,recall
hmel2:    dc.l $c4505050,$50504b47,$e449f2f4
hmel3:    dc.l $c4505050,$50c852c4,$50e454f2

song1a:   dc.l call,paub
lab1a:    dc.l call,basb1,call,basb1,call,basb1,call,basb1
          dc.l call,basb2,jump,lab1a

song1b:   dc.l call,paub
lab1b:    dc.l call,paub,call,paub,call,paub,call,paub
          dc.l call,ble1a,call,ble1a,call,hmel1,call,hmel2,call,hmel1
          dc.l call,hmel3,call,paub,jump,song1b

song1c:   dc.l call,paub,call,paub,call,paub
sl3:      dc.l call,mel1,call,mel1,call,mel1,call,spart2,jump,sl3

song1d:   dc.l call,schla1
sl4:      dc.l call,schla1,call,schla2,jump,sl4    


bb1:      dc.l call,eff1,$c4495949,$59495949,$59455545,$55475747
          dc.l $57f2f4f4
them1:    dc.l call,eff3,$c4393739,$c84039c4,$3739f4f4,call,eff2
          dc.l $54545452,$524b54f4,call,eff3,$c4393739,$c84039c4
          dc.l $44c842c4,$3937f4f4,call,eff2,$14141714,recall
them2:    dc.l call,eff7,$c444504b,$4944504b,$4945504b,$4947504b
          dc.l $49f2f4f4
druv:     dc.l call,eff6,$c4474747,$c447c4f4,call,eff4,$50f4c2f4
          dc.l call,eff6,$4747c447,$47f2f4f4
druh:     dc.l call,eff4,$c840c2f4,call,eff5,$50c4f4f4,call,eff4
          dc.l $40c440c2,$40c4f4f4,call,eff5,$5050c2f4,call,eff6
          dc.l $4746f2f4
drud:     dc.l call,eff4,$c4403b39,$c637c240,call,eff5,$50c450c2
          dc.l call,eff4,$40f4f4f4,call,eff5,$50c250f2

song2a:   dc.l call,bb1,jump,song2a

song2b:   dc.l call,paub,call,paub,call,paub,call,paub
lab2b:    dc.l call,paub,call,paub,call,them1,call,them1,jump,lab2b

song2c:   dc.l call,paub,call,paub,call,paub,call,paub
lab2c:    dc.l call,them2,call,them2,call,them2,call,them2
          dc.l call,them2,call,them2,jump,lab2c
song2d:   dc.l call,druv,call,druv,call,druv,call,drud
lab2d:    dc.l call,druh,jump,lab2d

even

tonerz:   nop   ;Generator D0, Ton D1
          movem.l d0-d7/a0-a6,-(sp)
          jsr keytranspose
          and.l #3,d0
          move.l d0,d2
          asl.b #4,d2
          move.l d2,a0
          move.l d2,a1
          move.l d2,a2
          add.l #GenBase,a0
          add.l #InstrBase,a1
          add.l #AdsrBase,a2
          move.l #$00010001,4(a0)       ;reset generator
          move.w #350,d5
te0:      subq.w #1,d5
          tst.w d5
          bne te0
          clr.b IVolume(a2)
          move.b #1,IPhase(a2)
          move.b AttackWait(a2),ICount(a2)
          move.b 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.l TBegin(a1),(a0)
          move.w Length(a1),4(a0)
          move.b SVolume(a1),9(a0)
          or.w #$8000,d7
          move.w d7,$dff096
          movem.l (sp)+,d0-d7/a0-a6
          rts

keytranspose:nop
          move.b trans,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

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
ru2:      jsr work
          move.l #17000,d0
ru1:      subq.l #1,d0
          tst.l d0
          bne ru1
          move.w $dff00c,d0
          btst #0,d0
          beq ru2
b1:       nop
          rts


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)
          move.l (a5),Tbegin(a1)
          move.l 4(a5),Length(a1)
          move.l 8(a5),Octave(a1)
b2:       move.l 12(a5),SDecayWait(a1)
          add.l #16,a5
          add.l #16,(a6)
          jmp wo1
wo6:      cmp.b #$f5,d0      ;restart
          bne wo6a
          move.w #$000f,$dff096
          jmp b1
          rts
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.b d4,d0
          jsr tonerz
          addq.l #1,a5
          addq.l #1,(a6)
          move.b (a4),(a0)
wow:      nop
          addq.b #1,d4
          addq.l #4,a6
          add.l #16,a1
          addq.l #4,a2
          addq.l #1,a0
          addq.l #1,a4
          cmp.b #4,d4
          bne wo0

          rts



even

stackanf: dc.b 0