10
20
30
40
50
60 :
70 MODE 7:ver$="2.00"
80 HIMEM=&7000
90 PROCvars
100 PRINT "Assembling ROM..."
110 FOR pass=4 TO 6 STEP 2
120 PRINT "Pass ";(pass-2)DIV2
130 P%=&8000:O%=&7000
140 PROCromhead
150 PROCwindows
160 NEXT
170 PRINT "Calculating checksums";
180 PROCchecksum("begin","comcheck")
190 PROCchecksum("comcheck","clear")
200 PROCchecksum("clear","open6")
210 PROCchecksum("open6","calcstart")
220 PROCchecksum("calcstart","colconv")
230 PROCchecksum("colconv","restore")
240 PROCchecksum("restore","bottomright")
250 PRINT
260 PRINT"Press SPACE to save code.":REPEATUNTILGET=32
270 OSCLI"SAVE WINDOWS"+LEFT$(ver$,1)+MID$(ver$,3)+" 7000 "+STR$~O%+" 0 FFFBBC00"
280 END
290 :
300 DEFPROCvars
310 osbyte=&FFF4:oswrch=&FFEE
320 osnewl=&FFE7:osasci=&FFE3
330 gsread=&FFC5:gsinit=&FFC2
340 osrdsc=&FFB9:oswrsc=&FFB3
350 wrscptr=&D6
360 oswnum=&EF:oswptr=&F0
370 rdscptr=&F6
380
390 graphl=&300:graphb=&302
400 graphr=&304:grapht=&306
410 textl=&308:textb=&309
420 textr=&30A:textt=&30B
430 originX=&30C:originY=&30E
440 cursorX=&310:cursorY=&312
450 oldcursorX=&314:oldcursorY=&316
460 Xpos=&318:Ypos=&319
470 screenstart=&34E
480 byteschar=&34F
490 TLHC=&350
500 bytesrow=&352
510 mode=&355
520 forecol=&357:backcol=&358
530 plotfore=&35B:plotback=&35C
540 gforecol=&36D:gbackcol=&36E
550
560 addr=&A8:temp=&AA:count=&AB
570 screen=&AC:mult=&AC:byte=&AE
580 repeat=&AF
590
600 oswwin=193:oswbase=0
610 oswcmd=oswbase+2
620 oswres=oswbase+3
630 oswblk=oswbase+4
640 ENDPROC
650 :
660 DEFPROCromhead
670 [OPT pass
680 .begin
690 EQUB 0:EQUW 0
700 JMP serviceentry
710 EQUB &82
720 EQUB (copyright-&8000)
730 EQUB VALver$
740 .title
750 EQUS "WINDOWS":EQUB 0
760 EQUS ver$
770 .copyright EQUB 0
780 EQUS "(C)1988 Alan Blundell"
790 EQUB 0
800 \
810 .serviceentry
820 PHP
830 CMP #4:BNE P%+5:JMP comcheck
840 CMP #8:BNE P%+5:JMP oswcheck
850 CMP #9:BEQ help
860 CMP #39:BEQ reset
870 PLP:RTS
880 \
890 .reset
900 PHA:PHX:PHY
910 JSR wclear
920 JMP out
930 \
940 .help
950 PHA:PHX:PHY
960 CLD:CLC:JSR gsinit
970 BEQ helptitle:LDX #255
980 .loop1
990 INX:LDA helpstring,X
1000 BEQ ourhelp
1010 JSR gsread
1020 ORA #32:CMP helpstring,X
1030 BEQ loop1
1040 CMP #ASC".":BEQ ourhelp
1050 JMP out
1060 \
1070 .helpstring
1080 EQUS "windows"+CHR$0
1090 \
1100 .helptitle
1110 JSR print
1120 EQUB 13:EQUS "WINDOWS "+ver$
1130 EQUB 13:EQUS " WINDOWS"
1140 EQUB 13
1150 NOP
1160 JMP out
1170 \
1180 .ourhelp
1190 JSR print
1200 EQUB 13
1210 EQUS "WINDOWS "+ver$+CHR$13
1220 EQUS " WCLEAR clears any window data"+CHR$13
1230 EQUS " (automatically cleared on break)"+CHR$13
1240 EQUS " WFREE displays remaining data space"+CHR$13
1250 EQUS " WBACK makes previous window active"+CHR$13
1260 EQUS " WFORE makes next window active"+CHR$13
1270 EQUS " OSWORD "+STR$oswwin+" to open/close a window"+CHR$13
1280 NOP
1290 JMP outdone
1300 \
1310 .comcheck
1320 PHA:PHX:PHY
1330 CLD:SEC:JSR gsinit
1340 BNE gsok:JMP out
1350 .gsok
1360 LDX #0:JSR setjmp
1370 JSR gsread
1380 CMP #ASC"X"
1390 BEQ notprefix
1400 DEY
1410 .notprefix
1420 STY temp
1430 .loop2
1440 JSR gsread
1450 CMP #ASC".":BEQ gotcom
1460 ORA #32:CMP commands,X
1470 BNE nextcom
1480 INX:LDA commands,X
1490 BMI gotcom:BPL loop2
1500 .nextcom
1510 INX:LDA commands,X
1520 BPL nextcom
1530 JSR setjmp
1540 LDY temp
1550 LDA commands,X
1560 CMP #&FF:BNE loop2
1570 JMP out
1580 .gotcom
1590 STY temp
1600 JMP (addr)
1610 \
1620 .setjmp
1630 LDA commands,X:STA addr+1
1640 INX:LDA commands,X:STA addr+0
1650 INX:RTS
1660 \
1670 .oswcheck
1680 PHA:PHX:PHY
1690 LDA oswnum
1700 CMP #oswwin:BNE out
1710 LDY #oswcmd
1720 LDA (oswptr),Y
1730 CMP #10:BCS out
1740 ASL A
1750 TAY:LDA ostable,Y:STA addr+0
1760 INY:LDA ostable,Y:STA addr+1
1770 JSR getcoords
1780 JMP (addr)
1790 \
1800 .ostable
1810 EQUW closeall
1820 EQUW close
1830 EQUW release
1840 EQUW open3
1850 EQUW open4
1860 EQUW open5
1870 EQUW open6
1880 EQUW open7
1890 EQUW open8
1900 EQUW open9
1910 \
1920 .out
1930 PLY:PLX:PLA:PLP
1940 RTS
1950 \
1960 .outdone
1970 PLY:PLX:PLA
1980 LDA #0:PLP
1990 RTS
2000 \
2010 .errors
2020 PLA:STA addr+0
2030 PLA:STA addr+1
2040 LDY #1
2050 .loop3
2060 LDA (addr),Y:BEQ skip1
2070 STA &101,Y
2080 INY:BNE loop3
2090 .skip1
2100 STA &101,Y:STA &100
2110 STX &101:JMP &100
2120 \
2130 .print
2140 STY temp
2150 PLA:STA addr+0
2160 PLA:STA addr+1
2170 LDY #0
2180 .loop4
2190 INC addr+0:BNE skip2:INC addr+1
2200 .skip2
2210 LDA (addr),Y
2220 CMP #&EA:BEQ endtext
2230 JSR osasci
2240 \BIT &FF:\BMI esc
2250 JMP loop4
2260 .endtext
2270 LDY temp
2280 JMP (addr)
2290 \
2300 \.esc
2310 \LDA #126:\JSR osbyte
2320 \JSR osnewl:\LDX #17
2330 \JSR errors
2340 \EQUS "Escape"
2350 \BRK
2360 \
2370 .hexout
2380 PHA
2390 LSR A:LSR A
2400 LSR A:LSR A
2410 JSR pchar
2420 PLA
2430 .pchar
2440 AND #&0F:CLC
2450 ADC #ASC"0"
2460 CMP #ASC"9"+1
2470 BCC skip3:ADC #6
2480 .skip3
2490 JMP oswrch
2500 \
2510 .commands
2520 EQUB clear DIV256:EQUB clear MOD256:EQUS "wclear"
2530 EQUB free DIV256:EQUB free MOD256:EQUS "wfree"
2540 EQUB wback DIV256:EQUB wback MOD256:EQUS "wback"
2550 EQUB wfore DIV256:EQUB wfore MOD256:EQUS "wfore"
2560 EQUD &FFFFFFFF
2570 ]
2580 ENDPROC
2590 :
2600 DEFPROCwindows
2610 [OPT pass
2620 \
2630 .clear
2640 JSR wclear
2650 JMP outdone
2660 \
2670 .wclear
2680 LDA #data MOD256
2690 STA ptrlo:STA activelo
2700 LDA #data DIV256
2710 STA ptrhi:STA activehi
2720 RTS
2730 \
2740 .free
2750 JSR osnewl
2760 LDA #ASC"&":JSR oswrch
2770 SEC:LDA #&FF
2780 SBC ptrlo:PHA
2790 LDA #&BF:SBC ptrhi
2800 JSR hexout:PLA
2810 JSR hexout
2820 JSR print
2830 EQUS " bytes free for window data"+CHR$13
2840 NOP
2850 JMP outdone
2860 \
2870 .wback
2880 LDA activelo
2890 CMP #data MOD256:BNE skip4
2900 LDA activehi
2910 CMP #data DIV256:BNE skip4
2920 LDX #134
2930 JSR errors
2940 EQUS "No window active"
2950 BRK
2960 .skip4
2970 JSR activetoaddr
2980 JSR pointblock
2990 JSR storeheader
3000 JSR moveback
3010 JSR pointblock
3020 JSR restore
3030 LDA #&2E
3040 JSR incaddr
3050 JSR setactive
3060 JMP outdone
3070 \
3080 .wfore
3090 JSR checkptr
3100 LDA ptrlo:CMP activelo:BNE skip5
3110 LDA ptrhi:CMP activehi:BNE skip5
3120 LDX #132
3130 JSR errors
3140 EQUS "Last window already active"
3150 BRK
3160 .skip5
3170 JSR ptrtoaddr
3180 .loop5
3190 JSR pointblock
3200 LDY #&2C:LDA (addr),Y
3210 CMP activelo:BNE skip6
3220 INY:LDA (addr),Y
3230 CMP activehi:BEQ skip7
3240 .skip6
3250 JSR moveback
3260 JMP loop5
3270 .skip7
3280 LDA addr+0:PHA
3290 LDA addr+1:PHA
3300 JSR moveback
3310 JSR pointblock
3320 JSR storeheader
3330 PLA:STA addr+1
3340 PLA:STA addr+0
3350 JSR restore
3360 LDA #&2E
3370 JSR incaddr
3380 JSR setactive
3390 JMP outdone
3400 \
3410 \ Window command 2 - Release
3420 \ --------------------------
3430 .release
3440 JSR checkptr
3450 JSR ptrtoaddr
3460 JSR pointblock
3470 JSR moveback
3480 JSR setptr
3490 JSR checkactive
3500 JMP outdone
3510 \
3520 \ Window command 0 - Close all windows
3530 \ ------------------------------------
3540 .closeall
3550 LDA ptrlo:CMP #data MOD256:BNE skip8
3560 LDA ptrhi:CMP #data DIV256:BNE skip8
3570 JMP outdone
3580 .skip8
3590 JSR closewindow
3600 JMP closeall
3610 \
3620 \ Window command 1 - Close current window
3630 \ ---------------------------------------
3640 .close
3650 JSR checkptr
3660 JSR closewindow
3670 JMP outdone
3680 \
3690 .closewindow
3700 JSR ptrtoaddr
3710 JSR pointblock
3720 JSR moveback
3730 JSR pointblock
3740 JSR restore
3750 LDA #&2E
3760 JSR incaddr
3770 JSR setptr
3780 JSR checkactive
3790 LDY #0
3800 .loop6
3810 LDA (addr),Y
3820 STA coords,Y
3830 INY
3840 CPY #4
3850 BCC loop6
3860 LDA #4
3870 JSR incaddr
3880 JSR calcstart
3890 LDY #0
3900 STY repeat
3910 .rows
3920 LDA left
3930 STA count
3940 LDA screen+0
3950 STA wrscptr+0
3960 LDA screen+1
3970 STA wrscptr+1
3980 .cols
3990 LDX byteschar
4000 .chars
4010 JSR unpack
4020 JSR oswrsc
4030 INC wrscptr+0
4040 BNE skip9
4050 INC wrscptr+1
4060 .skip9
4070 DEX
4080 BNE chars
4090 INC count
4100 LDA count
4110 CMP right
4120 BNE cols
4130 JSR nextrow
4140 INC top
4150 LDA top
4160 CMP bottom
4170 BNE rows
4180 RTS
4190 \
4200 \ Window command 6
4210 \ ----------------
4220 .open6
4230 JSR square
4240 JMP open67
4250 \
4260 \ Window command 7
4270 \ ----------------
4280 .open7
4290 JSR round
4300 JMP open67
4310 \
4320 \ Window command 8
4330 \ ----------------
4340 .open8
4350 JSR square
4360 JMP open89
4370 \
4380 \ Window command 9
4390 \ ----------------
4400 .open9
4410 JSR round
4420 JMP open89
4430 \
4440 .open89
4450 JSR checkmode
4460 LDA top
4470 SEC
4480 SBC #3
4490 BMI open6789out
4500 STA top
4510 JSR setframe
4520 LDA #166
4530 JSR doline
4540 LDA topright
4550 JSR oswrch
4560 LDA #169
4570 JSR oswrch
4580 LDY #oswblk+6 :\ ->title colours
4590 JSR setcols
4600 LDX left
4610 INX
4620 JSR ptitle
4630 CPX right
4640 BCS skip10
4650 LDA #32
4660 JSR doline
4670 .skip10
4680 LDY #oswblk+8 :\ ->edge colours
4690 JSR setcols
4700 LDA #169
4710 JSR oswrch
4720 LDX left
4730 LDA #171
4740 JSR oswrch
4750 INX
4760 LDA #166
4770 JSR doline
4780 LDA #173
4790 JSR oswrch
4800 LDY top
4810 INY
4820 INY
4830 INY
4840 JMP doframe
4850 \
4860 .open6789out
4870 JSR getcoords
4880 JMP open5
4890 \
4900 .open67
4910 JSR checkmode
4920 DEC top
4930 BMI open6789out
4940 JSR setframe
4950 LDY #oswblk+6 :\ -> title colours
4960 JSR setcols
4970 LDX left
4980 INX
4990 JSR ptitle
5000 LDY #oswblk+8 :\ ->edge colours
5010 JSR setcols
5020 CPX right
5030 BCS skip11
5040 LDA #166
5050 JSR doline
5060 .skip11
5070 LDA topright
5080 JSR oswrch
5090 LDY top
5100 INY
5110 JMP doframe
5120 \
5130 .setframe
5140 DEC left
5150 BMI open6789out
5160 LDY mode
5170 INC right
5180 LDA right
5190 CMP colstable,Y
5200 BCS open6789out
5210 INC bottom
5220 LDA bottom
5230 CMP rowstable,Y
5240 BCS open6789out
5250 JSR ptrtoaddr
5260 JSR pointblock
5270 JSR storeheader
5280 JSR ptrtoaddr
5290 JSR storesc
5300 JSR setwind
5310 LDY #oswblk+8 :\ ->edge colours
5320 JSR setcols
5330 LDA #12
5340 JSR oswrch
5350 LDA topleft
5360 JSR oswrch
5370 LDX left
5380 INX
5390 RTS
5400 \
5410 .doframe
5420 LDX left
5430 LDA #169
5440 JSR oswrch
5450 LDA #32
5460 INX
5470 JSR doline
5480 LDA #169
5490 JSR oswrch
5500 INY
5510 CPY bottom
5520 BCC doframe
5530 LDA bottomleft
5540 JSR oswrch
5550 LDX left
5560 INX
5570 LDA #166
5580 JSR doline
5590 LDX Xpos
5600 LDY Ypos
5610 LDA #26
5620 JSR oswrch
5630 LDA #31
5640 JSR oswrch
5650 TXA
5660 JSR oswrch
5670 TYA
5680 JSR oswrch
5690 LDA bottomright
5700 JSR oswrch
5710 JSR getcoords
5720 JSR setwind
5730 LDY #oswblk+4 :\ ->text colours
5740 JSR setcols
5750 LDA #12
5760 JSR oswrch
5770 JSR storeheader
5780 JSR setptractive
5790 JMP outdone
5800 \
5810 \ Window command 5
5820 \ ----------------
5830 .open5
5840 JSR checkmode
5850 DEC top
5860 BPL skip12
5870 INC top
5880 JMP open4
5890 .skip12
5900 JSR ptrtoaddr
5910 JSR pointblock
5920 JSR storeheader
5930 JSR ptrtoaddr
5940 JSR storesc
5950 JSR setwind
5960 LDY #oswblk+6 :\ ->title colours
5970 JSR setcols
5980 LDX left
5990 JSR ptitle
6000 DEX
6010 LDA #32
6020 JSR doline
6030 INC top
6040 JSR setwind
6050 LDY #oswblk+4 :\ -> text colours
6060 JSR setcols
6070 LDA #12
6080 JSR oswrch
6090 JSR storeheader
6100 JSR setptractive
6110 JMP outdone
6120 \
6130 \ Window command 4
6140 \ ----------------
6150 .open4
6160 JSR open
6170 LDY #oswblk+4 :\ -> text colours
6180 JSR setcols
6190 LDA #12
6200 JSR oswrch
6210 JMP outdone
6220 \
6230 \ Window command 3
6240 \ ----------------
6250 .open3
6260 JSR open
6270 JMP outdone
6280 \
6290 .open
6300 JSR ptrtoaddr
6310 JSR pointblock
6320 JSR storeheader
6330 JSR ptrtoaddr
6340 JSR storesc
6350 JSR storeheader
6360 JSR setptractive
6370 JMP setwind
6380 \
6390 .calcstart
6400 INC bottom
6410 INC right
6420 LDA TLHC+0
6430 STA screen+0
6440 LDA TLHC+1
6450 STA screen+1
6460 LDY top
6470 BEQ skip13
6480 .loop7
6490 LDA screen
6500 CLC
6510 ADC bytesrow
6520 STA screen+0
6530 LDA screen+1
6540 ADC bytesrow+1
6550 STA screen+1
6560 DEY
6570 BNE loop7
6580 .skip13
6590 LDY left
6600 BEQ skip14
6610 .loop8
6620 LDA screen
6630 CLC
6640 ADC byteschar
6650 STA screen+0
6660 LDA screen+1
6670 ADC #0
6680 STA screen+1
6690 DEY
6700 BNE loop8
6710 .skip14
6720 RTS
6730 \
6740 .storesc
6750 JSR chkedge
6760 LDY #0
6770 .loop9
6780 LDA coords,Y
6790 STA (addr),Y
6800 INY
6810 CPY #4
6820 BCC loop9
6830 LDA #4
6840 JSR incaddr
6850 LDA top
6860 PHA
6870 JSR calcstart
6880 LDA screen
6890 STA rdscptr
6900 LDA screen+1
6910 STA rdscptr+1
6920 LDY #0
6930 JSR osrdsc
6940 STA byte
6950 LDA #1
6960 STA repeat
6970 INC rdscptr
6980 BNE skip15
6990 INC rdscptr+1
7000 .skip15
7010 LDA left
7020 STA count
7030 LDX byteschar
7040 DEX
7050 BNE chars2
7060 .rows2
7070 LDA left
7080 STA count
7090 LDA screen
7100 STA rdscptr
7110 LDA screen+1
7120 STA rdscptr+1
7130 .cols2
7140 LDX byteschar
7150 .chars2
7160 STX temp
7170 JSR osrdsc
7180 LDX temp
7190 CMP byte
7200 BEQ samebyte
7210 PHA
7220 JSR pack
7230 PLA
7240 STA byte
7250 INC repeat
7260 BNE stored
7270 .samebyte
7280 LDA repeat
7290 CMP #255
7300 BNE skip16
7310 JSR pack
7320 .skip16
7330 INC repeat
7340 .stored
7350 INC rdscptr
7360 BNE skip17
7370 INC rdscptr+1
7380 .skip17
7390 DEX
7400 BNE chars2
7410 INC count
7420 LDA count
7430 CMP right
7440 BNE cols2
7450 JSR nextrow
7460 INC top
7470 LDA top
7480 CMP bottom
7490 BNE rows2
7500 JSR pack
7510 DEC bottom
7520 DEC right
7530 PLA
7540 STA top
7550 RTS
7560 \
7570 .storeheader
7580 LDY #0
7590 LDA #28
7600 JSR put
7610 LDA textl
7620 LDX textb
7630 JSR put2
7640 LDA textr
7650 LDX textt
7660 JSR put2
7670 LDA #17
7680 JSR put
7690 LDA forecol
7700 JSR colconv
7710 JSR put
7720 PHA
7730 LDA #17
7740 JSR put
7750 LDA backcol
7760 JSR colconv
7770 ORA #&80
7780 JSR put
7790 LDA #17
7800 JSR oswrch
7810 PLA
7820 JSR oswrch
7830 LDA #31
7840 JSR put
7850 LDA Xpos
7860 SEC
7870 SBC textl
7880 JSR put
7890 LDA Ypos
7900 SEC
7910 SBC textt
7920 JSR put
7930 LDA #29
7940 JSR put
7950 LDA originX
7960 LDX originX+1
7970 JSR put2
7980 LDA originY
7990 LDX originY+1
8000 JSR put2
8010 LDA #24
8020 JSR put
8030 LDA byteschar
8040 LSR A
8050 LSR A
8060 LSR A
8070 STA count
8080 LDA graphl
8090 LDX graphl+1
8100 JSR setX
8110 LDA graphb
8120 LDX graphb+1
8130 JSR setY
8140 LDA graphr
8150 LDX graphr+1
8160 JSR setX
8170 LDA grapht
8180 LDX grapht+1
8190 JSR setY
8200 LDA #18
8210 JSR put
8220 LDA plotfore
8230 JSR put
8240 LDA gforecol
8250 JSR put
8260 LDA #18
8270 JSR put
8280 LDA plotback
8290 JSR put
8300 LDA gbackcol
8310 ORA #&80
8320 JSR put
8330 LDA #25
8340 LDX #4
8350 JSR put2
8360 LDA oldcursorX
8370 LDX oldcursorX+1
8380 JSR setX
8390 LDA oldcursorY
8400 LDX oldcursorY+1
8410 JSR setY
8420 LDA #25
8430 LDX #4
8440 JSR put2
8450 LDA cursorX
8460 LDX cursorX+1
8470 JSR put2
8480 LDA cursorY
8490 LDX cursorY+1
8500 JSR put2
8510 RTS
8520 \
8530 .colconv
8540 STA temp
8550 LDX #255
8560 .loop10
8570 LDA #17
8580 JSR oswrch
8590 INX
8600 TXA
8610 JSR oswrch
8620 LDA temp
8630 CMP forecol
8640 BNE loop10
8650 TXA
8660 RTS
8670 \
8680 .put
8690 STA (addr),Y
8700 INY
8710 RTS
8720 \
8730 .put2
8740 STA (addr),Y
8750 INY
8760 TXA
8770 STA (addr),Y
8780 INY
8790 RTS
8800 \
8810 .setX
8820 STA mult
8830 STX mult+1
8840 LDA count
8850 .loop11
8860 ASL mult
8870 ROL mult+1
8880 LSR A
8890 BNE loop11
8900 LDA mult
8910 SEC
8920 SBC originX
8930 STA mult
8940 LDA mult+1
8950 SBC originX+1
8960 TAX
8970 LDA mult
8980 JSR put2
8990 RTS
9000 \
9010 .setY
9020 STX mult+1
9030 ASL A
9040 ROL mult+1
9050 ASL A
9060 ROL mult+1
9070 SEC
9080 SBC originY
9090 STA mult
9100 LDA mult+1
9110 SBC originY+1
9120 TAX
9130 LDA mult
9140 JSR put2
9150 RTS
9160 \
9170 .setwind
9180 LDA #28
9190 JSR oswrch
9200 LDY #0
9210 .loop12
9220 LDA coords,Y
9230 JSR oswrch
9240 INY
9250 CPY #4
9260 BNE loop12
9270 LDA #29
9280 JSR oswrch
9290 LDA left
9300 JSR convX
9310 LDA bottom
9320 CLC
9330 ADC #1
9340 JSR convY
9350 JSR invert
9360 JSR multwrch
9370 LDA #24
9380 JSR oswrch
9390 LDA #0
9400 JSR oswrch
9410 JSR oswrch
9420 JSR oswrch
9430 JSR oswrch
9440 LDA right
9450 SEC
9460 SBC left
9470 CLC
9480 ADC #1
9490 JSR convX
9500 LDA bottom
9510 SEC
9520 SBC top
9530 CLC
9540 ADC #1
9550 JSR convY
9560 JSR multwrch
9570 LDY #255
9580 .moves
9590 LDA #25
9600 JSR oswrch
9610 LDA #4
9620 JSR oswrch
9630 LDA #0
9640 JSR oswrch
9650 JSR oswrch
9660 JSR oswrch
9670 JSR oswrch
9680 INY
9690 BEQ moves
9700 RTS
9710 \
9720 .convX
9730 CLC
9740 LDY #0
9750 STY mult
9760 LDY byteschar
9770 STY count
9780 .loop13
9790 ASL A
9800 ROL mult
9810 LSR count
9820 BNE loop13
9830 JSR oswrch
9840 LDA mult
9850 JMP oswrch
9860 \
9870 .convY
9880 CLC
9890 LDY #0
9900 STY mult+1
9910 ASL A
9920 ROL mult+1
9930 ASL A
9940 ROL mult+1
9950 ASL A
9960 ROL mult+1
9970 ASL A
9980 ROL mult+1
9990 ASL A
10000 ROL mult+1
10010 STA mult
10020 RTS
10030 \
10040 .invert
10050 LDA #1024 MOD256
10060 SEC
10070 SBC mult
10080 STA mult
10090 LDA #1024 DIV256
10100 SBC mult+1
10110 STA mult+1
10120 RTS
10130 \
10140 .multwrch
10150 LDA mult
10160 JSR oswrch
10170 LDA mult+1
10180 JMP oswrch
10190 \
10200 .setcols
10210 LDA #17:JSR oswrch
10220 LDA (oswptr),Y:JSR oswrch
10230 LDA #17:JSR oswrch
10240 INY:LDA (oswptr),Y:ORA #&80:JSR oswrch
10250 LDA #18:JSR oswrch:LDA #0:JSR oswrch
10260 DEY:LDA (oswptr),Y:JSR oswrch
10270 LDA #18:JSR oswrch:LDA #0:JSR oswrch
10280 INY:LDA (oswptr),Y:ORA #&80:JMP oswrch
10290 \
10300 .pack
10310 LDA repeat:STA (addr),Y:INY
10320 LDA byte:STA (addr),Y:DEY
10330 LDA #2:JSR incaddr
10340 LDA addr+1:CMP #&BF:BCC stillfree
10350 LDA addr:CMP #&BF \&FF-&2E-2 for 2 more bytes
10360 BCC stillfree
10370 LDX #128:JSR errors
10380 EQUS "No memory for window data"
10390 BRK
10400 .stillfree
10410 LDA #0
10420 STA repeat
10430 RTS
10440 \
10450 .unpack
10460 LDA repeat
10470 BNE skip18
10480 LDA (addr),Y
10490 STA repeat
10500 INY
10510 LDA (addr),Y
10520 STA byte
10530 DEY
10540 LDA #2
10550 JSR incaddr
10560 .skip18
10570 DEC repeat
10580 LDA byte
10590 RTS
10600 \
10610 .nextrow
10620 LDA screen
10630 CLC
10640 ADC bytesrow
10650 STA screen
10660 LDA screen+1
10670 ADC bytesrow+1
10680 CMP #&80
10690 BCC skip19
10700 AND #&7F
10710 CLC
10720 ADC screenstart
10730 .skip19
10740 STA screen+1
10750 RTS
10760 \
10770 .incaddr
10780 CLC
10790 ADC addr
10800 STA addr
10810 LDA addr+1
10820 ADC #0
10830 STA addr+1
10840 RTS
10850 \
10860 .restore
10870 LDY #0
10880 .loop14
10890 LDA (addr),Y
10900 JSR oswrch
10910 INY
10920 CPY #&2C
10930 BCC loop14
10940 RTS
10950 \
10960 .getcoords
10970 LDY #oswblk
10980 .loop15
10990 LDA (oswptr),Y :\ Copy coords
11000 STA coords-oswblk,Y
11010 INY:CPY #oswblk+4 :\ four bytes
11020 BNE loop15
11030 RTS
11040 \
11050 .checkptr
11060 LDA ptrlo
11070 CMP #data MOD256
11080 BNE skip20
11090 LDA ptrhi
11100 CMP #data DIV256
11110 BNE skip20
11120 LDX #131:JSR errors
11130 EQUS "No window open"
11140 BRK
11150 .skip20
11160 RTS
11170 \
11180 .ptrtoaddr
11190 LDA ptrlo
11200 STA addr
11210 LDA ptrhi
11220 STA addr+1
11230 RTS
11240 \
11250 .activetoaddr
11260 LDA activelo
11270 STA addr
11280 LDA activehi
11290 STA addr+1
11300 RTS
11310 \
11320 .setptractive
11330 LDA ptrlo
11340 STA (addr),Y
11350 INY
11360 LDA ptrhi
11370 STA (addr),Y
11380 LDA #&2E
11390 JSR incaddr
11400 JSR setactive
11410 JMP setptr
11420 \
11430 .checkactive
11440 LDA ptrhi
11450 CMP activehi
11460 BEQ locheck
11470 BCC change
11480 .nochange
11490 RTS
11500 .locheck
11510 LDA ptrlo
11520 CMP activelo
11530 BCS nochange
11540 .change
11550 JMP setactive
11560 \
11570 .pointblock
11580 LDA addr
11590 SEC
11600 SBC #&2E
11610 STA addr
11620 LDA addr+1
11630 SBC #0
11640 STA addr+1
11650 RTS
11660 \
11670 .setactive
11680 LDA addr
11690 STA activelo
11700 LDA addr+1
11710 STA activehi
11720 RTS
11730 \
11740 .setptr
11750 LDA addr
11760 STA ptrlo
11770 LDA addr+1
11780 STA ptrhi
11790 RTS
11800 \
11810 .moveback
11820 LDY #&2C
11830 LDA (addr),Y
11840 PHA
11850 INY
11860 LDA (addr),Y
11870 STA addr+1
11880 PLA
11890 STA addr
11900 RTS
11910 \
11920 .square
11930 LDA #163
11940 STA topleft
11950 LDA #165
11960 STA topright
11970 LDA #170
11980 STA bottomleft
11990 LDA #172
12000 STA bottomright
12010 RTS
12020 \
12030 .round
12040 LDA #176
12050 STA topleft
12060 LDA #177
12070 STA topright
12080 LDA #178
12090 STA bottomleft
12100 LDA #179
12110 STA bottomright
12120 RTS
12130 \
12140 .ptitle
12150 LDY #oswblk+10
12160 .loop16
12170 LDA (oswptr),Y
12180 CMP #32:BCC skip21 :\ Terinated by control char
12190 JSR oswrch
12200 INY:INX
12210 CPX right
12220 BCC loop16
12230 .skip21
12240 RTS
12250 \
12260 .doline
12270 JSR oswrch:INX
12280 CPX right:BCC doline
12290 RTS
12300 \
12310 .checkmode
12320 LDA mode
12330 CMP #7:BCC modeok
12340 LDX #129:JSR errors
12350 EQUS "Not suitable for teletext"
12360 BRK
12370 .modeok
12380 RTS
12390 \
12400 .chkedge
12410 LDA right
12420 CMP left
12430 BCC chkerr
12440 LDY mode
12450 CMP colstable,Y
12460 BCS chkerr
12470 LDA bottom
12480 CMP top
12490 BCC chkerr
12500 CMP rowstable,Y
12510 BCS chkerr
12520 RTS
12530 .chkerr
12540 LDX #135:JSR errors
12550 EQUS "Parameters"
12560 BRK
12570 \
12580 .colstable
12590 EQUB 80
12600 EQUB 40
12610 EQUB 20
12620 EQUB 80
12630 EQUB 40
12640 EQUB 20
12650 EQUB 40
12660 EQUB 40
12670 \
12680 .rowstable
12690 EQUB 32
12700 EQUB 32
12710 EQUB 32
12720 EQUB 25
12730 EQUB 32
12740 EQUB 32
12750 EQUB 25
12760 EQUB 25
12770 \
12780 \Variables held in SWR
12790 .ptrlo :EQUB data MOD256
12800 .ptrhi :EQUB data DIV256
12810 .activelo :EQUB data MOD256
12820 .activehi :EQUB data DIV256
12830 .coords
12840 .left :EQUB 0
12850 .bottom :EQUB 0
12860 .right :EQUB 0
12870 .top :EQUB 0
12880 .topleft :EQUB 0
12890 .topright :EQUB 0
12900 .bottomleft :EQUB 0
12910 .bottomright:EQUB 0
12920 ]
12930 data=P%+&2E
12940 ENDPROC
12950 :
12960 DEFPROCchecksum(start$,end$)
12970 start%=EVAL(start$)-(P%-O%)
12980 end%=EVAL(end$)-1-(P%-O%)
12990 sum%=0:FOR loop%=start% TO end%
13000 sum%=sum%+?loop%:NEXT
13010 READ check%
13020 IF check%<>sum% PRINT '"Checksum error between:"'" .";start$;" and .";end$:END ELSE PRINT ".";
13030 ENDPROC
13040 :
13050 DATA 34146,35024,47709,54234,53724,62358,41279