10
20
30
40
50
60
70
80 :
90 name$="SVPIC":ver$="v2.00"
100 osword=&FFF1:osbyte=&FFF4
110 osfind=&FFCE:osbput=&FFD4:osargs=&FFDA
120 DIM mcode% &200:load%=&FFFF0900
130 addr=&A8:bits=&AA:data=&AB
140 byte=&AC:count=&AD:dbits=&AE
150 :
160 FOR opt%=4 TO 7 STEP 3
170 O%=mcode%:P%=&900
180 [OPT opt%
190 .outch:BRK:.chn:BRK:.startHi:BRK:.step:BRK:.pass:BRK
200 .size :BRK:BRK:.step0 :BRK:.cbits0:BRK:.cntmax:BRK
210 .small:BRK:BRK:.stepsv:BRK:.cbitsv:BRK:.maxsv :BRK
220 ]
230 O%=mcode%:P%=load%
240 [OPT opt%
250 .errSyntax
260 BRK:EQUB 220:EQUS "Syntax: SVPIC <fsp>":BRK
270 :
280 .go%
290 LDX #addr:LDY #0:LDA #1:JSR osargs :\ Get command line
300 LDA (addr),Y:CMP #33:BCC errSyntax :\ No parameters
310 LDX addr+0:LDY addr+1
320 LDA #&80:JSR osfind:STA chn :\ Open file
330 LDA #&08:STA bits :\ Initialise 8 bits waiting
340 LDA #&87:JSR osbyte:TYA:PHA :\ Y=current screen mode
350 LDA modebase,Y:STA startHi
360 LDA #&84:JSR osbyte :\ Y.b7=shadow screen
370 TYA:BPL noshadow
380 LDA #1:JSR vramSelect :\ Page in video RAM
390 .noshadow
400 :
410 LDY #0:STA addr+0:JSR copy :\ addr=>start of screen
420 LDX #1:STX dbits:STX pass :\ Find the widest byte in memory
430 .back10
440 STX step:LDA dbits
450 CMP (addr),Y:BCS over8 :\ Skip if data <= test byte
460 SEC:ROL dbits :\ Widen test byte
470 INX:CPX #8 :\ Incr. number of bits
480 BCC back10:BCS over9 :\ Loop if still < 8 bits
490 .over8
500 JSR addthem:BPL back10 :\ Loop until end of memory
510 .over9
520 :
530 LDA chn:STA outch :\ Enable output
540 STX dbits:TXA:JSR write8bits :\ Write data width
550 PLA:JSR write8bits :\ Write screen mode
560 :
570 LDX #&0F :\ 16 palette entries
580 .back17
590 TXA:PHA:STA blk
600 LDX #blk AND 255
610 LDY #blk DIV 256
620 LDA #&0B:JSR osword :\ Read palette entry
630 LDA blk+1 :\ Get physical colour
640 LDX #&04:JSR writebits :\ Output 4 bits
650 PLA:TAX:DEX:BPL back17 :\ Loop for 16 palette entries
660 :
670 STX small+0:STX small+1 :\ Initialise max=&FFFF
680 INX:STX outch :\ Disable output
690 INX:STX step0 :\ Start with step=1
700 :
710 .restart
720 LDA #2:STA cbits0 :\ Try 2 count bits
730 LDA #&03:STA cntmax
740 .redo
750 LDA #0:STA size+0:STA size+1 :\ Initialise size=0
760 JSR compress :\ Do a trial compression
770 LDA size+1:CMP small+1 :\ Does this give a smaller output?
780 BCC forward10:BNE roll :\ Bigger than smallest, try again
790 LDA size+0:CMP small+0
800 BCS roll
810 .forward10
820 LDX #4
830 .forward11
840 LDA size,X:STA small,X :\ This pass the smallest so far
850 DEX:BPL forward11
860 :
870 \LDA size+0:\STA small+0 :\ This pass the smallest so far
880 \LDA size+1:\STA small+1
890 \LDA step0:\STA stepsv
900 \LDA cbits0:\STA cbitsv
910 \LDA cntmax:\STA maxsv
920 :
930 .roll
940 SEC:ROL cntmax
950 INC cbits0:LDA cbits0 :\ Try more count bits
960 CMP #9:BNE redo :\ Try up to 8 bits
970 INC step0:LDA step0 :\ Try more steps
980 CMP #9:BNE restart :\ Loop up to 8 steps
990 :
1000 LDA chn:STA outch :\ Enable output
1010 LDA #&08:STA bits :\ Initialise 8 bits waiting
1020 LDA stepsv:STA step0:JSR write8bits :\ Write step
1030 LDA cbitsv:STA cbits0:JSR write8bits:\ Write cbits
1040 LDA maxsv:STA cntmax
1050 JSR compress :\ Compress the screen data
1060 :
1070 .close
1080 LDX #8:LDA #0:JSR writebits :\ Flush output
1090 LDA #0:JSR vramSelect :\ Page video RAM out
1100 LDA #0:LDY chn:JMP osfind :\ Close and exit
1110 :
1120 \ Compress the screen using current settings
1130 .compress
1140 LDA step0:STA step
1150 SEC:SBC #1:STA pass
1160 .doall
1170 JSR copy:LDA pass:STA addr+0:\ addr=>start for this pass
1180 .allagain
1190 LDY #0:LDA (addr),Y :\ Get current byte
1200 LDY step:CMP (addr),Y :\ Compare with next byte
1210 BEQ over16 :\ Same, jump to count them
1220 CLC:JSR write1bit :\ 0=single value
1230 LDY #0:LDA (addr),Y :\ Get the byte
1240 LDX dbits:JSR writebits :\ Write single value
1250 JMP forward :\ Update addr and loop back
1260 :
1270 .over16
1280 STA byte :\ Save test byte
1290 LDY #0:STY count :\ Set count=0
1300 .back11
1310 INC count:JSR addthem :\ Incr. count, update addr
1320 BMI setcarry :\ End of screen, output the data
1330 LDA count
1340 CMP cntmax:BEQ setcarry :\ Max. count met, output the data
1350 LDA (addr),Y :\ Get next byte
1360 CMP byte:BEQ back11 :\ Loop back if still the same
1370 :
1380 .setcarry
1390 SEC:JSR write1bit :\ 1=multiple value
1400 LDA count
1410 LDX cbits0:JSR writebits :\ Write count
1420 LDA byte
1430 LDX dbits:JSR writebits :\ Write value
1440 BIT addr+1:BPL allagain :\ Loop until end of screen
1450 BMI forward2 :\ Do another pass
1460 :
1470 .forward
1480 JSR addthem:BPL allagain :\ Loop until end of screen
1490 .forward2
1500 DEC pass:BPL doall :\ Do another pass
1510 RTS
1520 :
1530 .write1bit
1540 ROL data :\ Rotate Carry into data
1550 DEC bits:BNE return :\ Decr. bits remaining
1560 INC size+0:BNE nohigh :\ Incr. number of bytes output
1570 INC size+1
1580 .nohigh
1590 LDY outch:BEQ noput :\ Skip if only counting
1600 LDA data:JSR osbput :\ Output the data byte
1610 .noput
1620 LDA #8:STA bits :\ Reset back to 8 bits waiting
1630 .return
1640 RTS
1650 :
1660 .write8bits
1670 LDX #8
1680 .writebits
1690 LSR A :\ Move bit into Carry
1700 PHA:JSR write1bit:PLA :\ Send Carry to output stream
1710 DEX:BNE writebits :\ Loop for all the bits
1720 RTS
1730 :
1740 .copy
1750 LDA startHi:STA addr+1 :\ Set addr=screenstart
1760 RTS
1770 :
1780 .addthem
1790 LDA addr+0:CLC:ADC step:STA addr+0 :\ Update addr
1800 LDA addr+1:ADC #0:STA addr+1
1810 .vramOk
1820 RTS
1830 :
1840 .vramSelect
1850 PHA:TAX :\ A=0 main RAM, A=1 video RAM
1860 LDA #108:JSR osbyte :\ Attempt to select Master/Integra-B video RAM
1870 PLA:INX:BNE vramOk :\ X<>255, successful
1880 EOR #1:TAX :\ A=1 main RAM, A=0 video RAM
1890 LDA #111:JMP osbyte :\ Attempt to select Aries/Watford video RAM
1900 :
1910 .blk
1920 .modebase
1930 EQUB &30:EQUB &30:EQUB &30:EQUB &40:EQUB &58:EQUB &58:EQUB &60:EQUB &7C
1940 EQUS ver$
1950 .end%
1960 :
1970 ]:IF end%>&B00:PRINT"Code overrun":END
1980 NEXT:PRINT"Saving ";name$;
1990 OSCLI"SAVE "+name$+" "+STR$~mcode%+" "+STR$~O%+" "+STR$~(go%OR&FFFF0000)+" "+STR$~load%
2000 PRINT