10
20
30
40
50 :
60 OSBYTE=&FFF4:OSARGS=&FFDA
70 OSFIND=&FFCE:OSFILE=&FFDD
80 OSBPUT=&FFD4:OSWORD=&FFF1
90 lptr=&A8:
100 A_temp=&A9:
110 addr=&AA:
120 ScrFlag=&AC:mode=&AD
130 length=&AE:try_end=&AE:
140 mcode%=&FFFF08C0
150 :
160 FOR P=0 TO 1
170 P%=mcode%
180 [OPT P*3
190 .palette
200 .error
210 BRK:EQUB 220:EQUS "Syntax: ScrSave <fsp> (+<length>)":BRK
220 .get_char
230 LDA (lptr),Y:INY:CMP #13:RTS
240 .start%
250 LDA #1:LDY #0:LDX #lptr:JSR OSARGS
260 LDA (lptr),Y:CMP #13:BEQ error
270 STY length:STY length+1:STY addr
280 LDA #135:JSR OSBYTE:LDA himems,Y:STA addr+1:STA ctblk+11
290 STY mode:LDY #0
300 .look_lp
310 JSR get_char:BEQ no_plus
320 CMP #ASC"+":BNE look_lp
330 .look_lp2
340 JSR get_char:CMP #ASC" ":BEQ look_lp2:DEY
350 \ Y now points to first digit
360 .plus_lp
370 JSR get_char:CMP #ASC"0":BCC plus_end
380 CMP #ASC"@":BCC hex_ok:AND #&DF:SBC #6:.hex_ok
390 AND #15:LDX #4
400 .hex_lp
410 ROL length:ROL length+1:DEX:BNE hex_lp
420 ORA length:STA length:BPL plus_lp
430 .plus_end
440 LDA addr:ADC length:STA new_end
450 LDA addr+1:ADC length+1:STA new_end+1
460 .no_plus:\ new_end=either default &8000 or value read in
470 :
480 LDA lptr:STA ctblk:LDA lptr+1:STA ctblk+1
490 LDA #0:JSR osbyte192
500 CPX #2:BEQ notShad:BCS Master
510 LDA #34:JSR osbyte128
520 LDA #111:JSR osbyte128
530 LDA #1:BNE notShad
540 .Master
550 LDA &D0:AND #16:BEQ notShad
560 LDA #108:LDX #1:JSR OSBYTE
570 LDA #2
580 .notShad
590 STA ScrFlag
600 :
610 \ Now get palette values
620 LDA mode:LDX #6:LDY #3:JSR pall1
630 LDA &360:CMP #4:BCC less4
640 LDA #3:LDX #2:LDY #6:JSR pall1
650 JSR pall2
660 .less4
670 \ Now try to compress this
680 LDA new_end:STA try_end:LDA new_end+1:STA try_end+1
690 \ addr=start, new_end=end, try_end=end
700 LDA #0:JSR try_to_save_block
710 LDA try_end:SEC:SBC new_end:LDA try_end+1:SBC new_end+1
720 BCS shorter
730 JSR CallOsfile0:JMP SaveFinish
740 :
750 .shorter
760 LDA ctblk+11:PHA:\ Start addr
770 LDA try_end:STA new_end:LDA try_end+1:STA new_end+1
780 LDA #0:STA ctblk+8:STA ctblk+9
790 LDA new_end:PHA:LDA new_end+1:PHA
800 JSR CallOsfile:\ Create file
810 PLA:STA new_end+1:PLA:STA new_end
820 PLA:STA ctblk+11
830 LDX ctblk:LDY ctblk+1
840 LDA #&80:JSR OSFIND:\ Openout
850 JSR try_to_save_block
860 JSR CloseFile
870 \ Rewrite addresses
880 LDX #3:.push_lp
890 LDA ctblk+6,X:PHA:DEX:BPL push_lp
900 LDA #2:JSR CallOsfile
910 LDX #&FC:.pull_lp
920 PLA:STA ctblk+6-&FC,X:INX:BNE pull_lp
930 LDA #3:JSR CallOsfile
940 .SaveFinish
950 LDA ScrFlag:BEQ EndAll
960 CMP #2:BEQ EndMaster
970 LDA #111:JSR osbyte192
980 LDA #34:JMP osbyte192
990 .EndAll:RTS
1000 .EndMaster
1010 LDA #108:LDX #0:JMP OSBYTE
1020 :
1030 .CloseFile
1040 LDA #0:JMP OSFIND
1050 :
1060 .CallOsfile0
1070 LDA #0
1080 .CallOsfile
1090 LDX #ctblk AND 255:LDY #ctblk DIV 256
1100 JMP OSFILE
1110 \
1120 \ Find length and create a file
1130 .try_to_save_block
1140 PHA:\ Save handle (or zero flag)
1150 LDA ctblk+11:STA addr+1:LDA #0:STA addr
1160 .SaveLp
1170 LDY #0:LDX #0:LDA (addr),Y
1180 .SaveSame
1190 INC addr:BNE Save2:INC addr+1:.Save2
1200 LDY addr:CPY new_end:BNE Save3
1210 LDY addr+1:CPY new_end+1:BEQ SaveEnd
1220 .Save3
1230 INX:BEQ SaveOut
1240 LDY #0:CMP (addr),Y:BEQ SaveSame
1250 .SaveOut
1260 STA A_temp:PLA:JSR OutputBytes
1270 PHA:JMP SaveLp
1280 .SaveEnd
1290 INX:STA A_temp:PLA
1300 .OutputBytes
1310 TAY:BEQ Output2
1320 LDA A_temp:JSR OSBPUT:TXA:JSR OSBPUT
1330 .Output2
1340 LDA try_end:CLC:ADC #2:STA try_end
1350 LDA try_end+1:ADC #0:STA try_end+1
1360 TYA:RTS
1370 :
1380 .osword11
1390 LDX #palette AND 255:LDY #palette DIV 256
1400 LDA #11:JSR OSWORD
1410 LDA palette+1
1420 RTS
1430 .pall1
1440 STA ctblk,X:STY palette
1450 .pall1a
1460 ASL ctblk,X:ROL ctblk+1,X
1470 ASL ctblk,X:ROL ctblk+1,X
1480 ASL ctblk,X:ROL ctblk+1,X
1490 TXA:PHA:\STY palette
1500 JSR osword11:PLA:TAX
1510 LDA palette+1:AND #7
1520 ORA ctblk,X:STA ctblk,X
1530 DEC palette:LDA palette
1540 AND #3:BNE pall1a:RTS
1550 :
1560 .pall2
1570 LDA #8:STA palette:.pall2lp
1580 JSR osword11:LDY #0:STA (addr),Y
1590 INC palette:JSR osword11
1600 ASL A:ASL A:ASL A:ASL A:LDY #0
1610 ORA (addr),Y:STA (addr),Y
1620 INC palette:INC addr
1630 LDA palette:CMP #16:BNE pall2lp
1640 RTS
1650 \
1660 \.newbrk
1670 \JSR swapbrk:\JSR SaveFinish
1680 \JMP (&202)
1690 :
1700 \.swapbrk
1710 \LDA &202:\LDX oldbrk:\STX &202:\STA oldbrk
1720 \LDA &203:\LDX oldbrk+1:\STX &203:\STA oldbrk+1
1730 \RTS
1740 :
1750 .osbyte128
1760 LDX #128:BNE CallOsbyte
1770 .osbyte192
1780 LDX #192:.CallOsbyte
1790 JMP OSBYTE
1800 :
1810 .ctblk
1820 EQUW 0
1830 EQUD &FFFF3000:EQUD &FFFF0000
1840 EQUD &FFFF3000
1850 .new_end
1860 EQUD &FFFF8000
1870 .himems
1880 EQUB &30:EQUB &30:EQUB &30
1890 EQUB &40:EQUB &58:EQUB &58
1900 EQUB &60:EQUB &7C
1910 \.oldbrk
1920 \EQUW newbrk
1930 EQUS "v1.08":BRK
1940 ]NEXT
1950 PRINT"*SAVE ScrSave ";~mcode%;" ";~P%;" ";~start%OR&FFFF0000