10REM Mode 7 screen compressor 20REM (C) John Robinson 1988 30REM *Guaranteed* not to make the file longer than &3E8 (1000) bytes 40REM Most other screen compaction programs use the algorithm whereby the 50REM number of consecutive identical bytes is counted and written to the 60REM file. This doubles the length of the file if every byte is different 70REM because the file goes in the pattern A,1,B,1,C,1,D,1 instead of just 80REM A,B,C,D or whatever. 90REM This algorithm is based closely on the above algorithm, but depends 100REM on the fact that only 7 bits in every byte are required to represent 110REM the mode 7 screen codes. It sets the top bit of the code where there 120REM is only 1 of the code, and otherwise clears the top bit and sends a 130REM quantity byte as well. Therefore single bytes are written as single 140REM bytes, double bytes as double bytes, up to 256 bytes as double bytes, 150REM and more as 2 bytes per multiple of 256. With most screens the 160REM resulting file will therefore be shorter than the original 170: 180DIM code &400 190packorig$="FFFF0900" 200unpackorig$="FFFF0900" 210: 220osbyte=&FFF4 230oswrch=&FFEE 240osargs=&FFDA 250osbget=&FFD7 260osbput=&FFD4 270osfind=&FFCE 280gsread=&FFC5 290gsinit=&FFC2 300: 310xpos=&A8 320ypos=&A9 330pos=&AA 340vpos=&AB 350filehan=&AC 360previous=&AD 370this=&AE 380how_many=&AF 390tempstore=&AF 400: 410FOR pass=4 TO 7 STEP 3 420P%=EVAL("&"+packorig$) AND &FFFF 430O%=code 440[OPT pass 450 460.pack_screen 470LDA #1 480LDX #&A8 490LDY #0 500JSR osargs 510LDY &A9 520LDX &A8 530STY &F3 540STX &F2 550LDY #0 560CLC 570JSR gsinit 580BNE stringfound 590.syntax1 600BRK 610EQUB 254 620EQUS "Syntax: *PACK7 " 630EQUB 0 640.stringfound 650JSR gsread 660BCC stringfound 670CLC 680JSR gsinit 690BNE syntax1 700LDY #0 710CLC 720JSR gsinit 730TYA 740CLC 750ADC &F2 760TAX 770LDA &F3 780ADC #0 790TAY 800LDA &355 810CMP #7 820BEQ right_mode 830BRK 840EQUB 240 850EQUS "Mode 7 only" 860EQUB 0 870.right_mode 880LDA #&80 890JSR osfind 900TAY 910BNE continue 920BRK 930EQUB 241 940EQUS "Couldn't open file" 950EQUB 0 960.continue 970LDA #0 980STA xpos 990STA ypos 1000STA how_many 1010STY filehan 1020LDA #&86 1030JSR osbyte 1040STX pos 1050STY vpos 1060LDY filehan 1070JSR get_character 1080STA previous 1090PHP 1100.main_loop 1110PLP 1120JSR get_character 1130STA this 1140PHP 1150CMP previous 1160BNE write_to_file 1170INC how_many 1180PLP 1190PHP 1200BCS write_to_file 1210LDA how_many 1220CMP #&FF 1230BNE main_loop 1240.write_to_file 1250LDA how_many 1260BEQ onebyte 1270LDA previous 1280JSR osbput 1290LDA how_many 1300.back_in 1310JSR osbput 1320LDA this 1330STA previous 1340LDA #0 1350STA how_many 1360PLP 1370BCS end 1380PHP 1390BCC main_loop 1400.onebyte 1410LDA previous 1420ORA #&80 1430JMP back_in 1440.end 1450LDA this 1460ORA #&80 1470JSR osbput 1480LDA #0 1490JSR osfind 1500LDA #31 1510JSR oswrch 1520LDA pos 1530JSR oswrch 1540LDA vpos 1550JMP oswrch 1560 1570.get_character 1580STY filehan 1590LDA #31 1600JSR oswrch 1610LDA xpos 1620JSR oswrch 1630LDA ypos 1640JSR oswrch 1650LDA #&87 1660JSR osbyte 1670TXA 1680AND #&7F 1690PHA 1700LDA xpos 1710CLC 1720ADC #1 1730STA xpos 1740CMP #40 1750BCC return 1760LDA #0 1770STA xpos 1780LDA ypos 1790CLC 1800ADC #1 1810STA ypos 1820CMP #25 1830.return 1840PLA 1850LDY filehan 1860RTS 1870 1880] 1890 1900IF (P%+40) DIV 256=P% DIV 256 THEN [OPT pass:EQUS "This program is (C) John Robinson 1988":] 1910 1920halfway=O% 1930P%=EVAL("&"+unpackorig$) AND &FFFF 1940[OPT pass 1950 1960.unpack7 1970LDA #1 1980LDX #&A8 1990LDY #0 2000JSR osargs 2010LDY &A9 2020LDX &A8 2030STY &F3 2040STX &F2 2050LDY #0 2060CLC 2070JSR gsinit 2080BNE stringfound2 2090.syntax2 2100BRK 2110EQUB 254 2120EQUS "Syntax: *UNPACK7 " 2130EQUB 0 2140.stringfound2 2150JSR gsread 2160BCC stringfound2 2170CLC 2180JSR gsinit 2190BNE syntax2 2200LDY #0 2210CLC 2220JSR gsinit 2230TYA 2240CLC 2250ADC &F2 2260TAX 2270LDA &F3 2280ADC #0 2290TAY 2300LDA #22 2310JSR oswrch 2320LDA #7 2330JSR oswrch 2340LDA #&40 2350JSR osfind 2360TAY 2370BNE gotfile 2380BRK 2390EQUB 241 2400EQUS "File not found" 2410EQUB 0 2420.gotfile 2430JSR osbget 2440BCS finished2 2450TAX 2460BMI onebyte2 2470STX this 2480JSR osbget 2490TAX 2500INX 2510LDA this 2520.more_than_one 2530JSR pbyte 2540DEX 2550BNE more_than_one 2560JMP gotfile 2570.onebyte2 2580JSR pbyte 2590JMP gotfile 2600.finished2 2610LDA #30 2620JSR oswrch 2630LDA #11 2640JSR oswrch 2650.toplineagain 2660LDA #0 2670STA &A8 2680STA &A9 2690STA &AA 2700STA &AB 2710LDA #1 2720LDX #&A8 2730JSR osargs 2740STY filehan 2750.loopagain 2760LDY filehan 2770JSR osbget 2780TAX 2790BMI onebyte3 2800PHA 2810JSR osbget 2820TAX 2830INX 2840PLA 2850.printem 2860JSR pbyte 2870DEX 2880BNE printem 2890.loopagain2 2900STY filehan 2910LDA #&86 2920JSR osbyte 2930TYA 2940BEQ loopagain 2950LDY filehan 2960LDA #0 2970JSR osfind 2980LDA #30 2990JMP oswrch 3000.onebyte3 3010JSR pbyte 3020JMP loopagain2 3030 3040.pbyte 3050AND #&7F 3060CMP #32 3070BCC ora 3080CMP #127 3090BCS ora 3100JMP oswrch 3110.ora 3120ORA #&80 3130JMP oswrch 3140 3150] 3160 3170IF (P%+40) DIV 256=P% DIV 256 THEN [OPT pass:EQUS "This program is (C) John Robinson 1988":] 3180 3190NEXT pass 3200: 3210save1$="*SAVE Pack7 "+STR$~code+" "+STR$~halfway+" "+packorig$+" "+packorig$ 3220save2$="*SAVE Unpack7 "+STR$~halfway+" "+STR$~O%+" "+unpackorig$+" "+unpackorig$ 3230PRINT save1$'save2$'"Yes/No? "; 3240IF (GET OR &20)=ASC "y" THEN PRINT "Yes"'"Saving...":OSCLI save1$:OSCLI save2$:PRINT "OK" ELSE PRINT "No" 3250: