10
20
30 :
40 DIM mcode% &200
50 load%=&FFFF09D8
60 OSWORD=&FFF1:OSARGS=&FFDA
70 OSFIND=&FFCE:OSGBPB=&FFD1
80 wordV=&20C
90 :
100 FOR P=0 TO 1
110 P%=load%:O%=mcode%
120 [OPT P*3+4
130 .errCantOpen
140 BRK:EQUB 192:EQUS "Can't open file":BRK
150 :
160 .go%
170 LDA #1:LDX #&A8:LDY #0:JSR OSARGS
180 LDA (&A8),Y:CMP #13:BNE SoundOn
190 \ Should check if SoundTo is actually on
200 LDA #0:LDY channel:JSR OSFIND
210 LDA oldWordV+0:STA wordV+0
220 LDA oldWordV+1:STA wordV+1
230 RTS
240 .SoundOn
250 LDX &A8:LDY &A9:LDA #&80:JSR OSFIND
260 TAY:BEQ errCantOpen:STA channel
270 PHP:SEI
280 LDA wordV+0:STA oldWordV+0
290 LDA wordV+1:STA oldWordV+1
300 LDA #newWord AND 255:STA wordV+0
310 LDA #newWord DIV 256:STA wordV+1
320 PLP:RTS
330 :
340 .newWord
350 CMP #7:BEQ SoundTo :\ SOUND
360 CMP #8:BEQ SoundTo :\ ENVELOPE
370 .oldWord
380 JMP (oldWordV)
390 .SoundTo
400 PHA:TYA:PHA:TXA:PHA
410 LDA waiting:BNE running
420 LDX #time0 AND 255
430 LDY #time0 DIV 256
440 LDA #1:JSR oldWord :\ Read start TIME
450 LDA #0:STA buffer+0 :\ Initial delta=0
460 STA buffer+1:BEQ started
470 :
480 .running
490 LDX #buffer AND 255
500 LDY #buffer DIV 256
510 LDA #1:JSR oldWord :\ Read current TIME
520 LDX #0:SEC
530 .timedelta
540 LDA buffer,X:SBC time0,X:STA buffer,X
550 INX:TXA:EOR #2:BNE timedelta
560 .started
570 TSX
580 LDA &101,X:STA &F0
590 LDA &102,X:STA &F1
600 LDA &103,X:CMP #8:BEQ envelope
610 :
620 LDY #1:LDA (&F0),Y :\ %000h00ss
630 CMP #&20:BCS exit :\ Not internal SOUND command
640 ASL A:ASL A :\ %0h00ss00
650 DEY:ORA (&F0),Y :\ %000f00cc
660 ORA #&80:STA bufferD+0 :\ %1h0fsscc
670 LDX #bufferD-buffer :\ %1xxxxxxx indicates SOUND
680 .soundlp
690 INY:INY:LDA (&F0),Y :\ Copy vol,pit,dur
700 INX:STA buffer,X
710 CPY #8:BNE soundlp
720 TXA:BNE output :\ Number to save
730 :
740 .envelope
750 LDY #13
760 .envelopelp
770 LDA (&F0),Y:STA bufferD,Y
780 DEY:BPL envelopelp :\ %0000nnnn indicates ENVELOPE
790 LDA #16 :\ Number to save
800 :
810 .output
820 STA gbpb+5 :\ count
830 LDA #buffer AND 255:STA gbpb+1 :\ address
840 LDA channel:STA gbpb+0 :\ channel
850 LDX #gbpb AND 255:LDY #gbpb DIV 256
860 LDA #1:STA waiting:JSR OSGBPB
870 \
880 .exit
890 PLA:TAX:PLA:TAY:PLA
900 JMP oldWord
910 :
920 .waiting
930 EQUB 0
940 :
950 .time0
960 EQUW 0
970 :
980 .buffer
990 EQUW 0 :\ time delta
1000 .bufferD
1010 EQUD 0 :\ SOUND/ENVELOPE data
1020 EQUD 0 :\ ENVELOPE data
1030 EQUD 0 :\ ENVELOPE data
1040 EQUW 0 :\ ENVELOPE data
1050 :
1060 .gbpb
1070 EQUB 0 :\ channel
1080 EQUW buffer :\ address
1090 EQUW &FFFF :\ I/O address
1100 EQUD 8 :\ count
1110 EQUD 0 :\ offset
1120 :
1130 ]
1140 channel=P%
1150 oldWordV=P%+1
1160 NEXT
1170 IF(P%AND&FFFF)+3>&B00:PRINT"Code over-run":END
1180 PRINT " *SAVE SoundTo ";~mcode%;" ";~O%;" ";~go%OR&FFFF0000;" ";~load%