10
20
30
40 :
50 PROCassem(0):CLEAR:PROCassem(2):PROCsm_table
60 A$="*SAVE "+fname$+" "+STR$~(mcode%+M%)+" "+STR$~O%+" FFFF0000 FFFBBC00"
70 PRINTA$;:OSCLIA$:PRINT
80 END
90 :
100 DEFPROCassem(pass%)
110 OSBYTE=&FFF4:OSWRCH=&FFEE:RAWVDU=&FFBC
120 DIM mcode% &1000, L%-1
130 wrchv=&20E:vduq=&26A:zp=&A8
140 Intercept=&380
150 fname$="SWMode"
160 :
170 FOR pass%=pass% TO pass%+1
180 opt%=FNsm_pass(pass%)
190 O0%=O%
200 [OPT opt%
210 .rombase
220 BRK:EQUW RelocTable
230 JMP Serv
240 EQUB &82
250 EQUB copyright-rombase
260 EQUB &12
270 EQUS "NewModes"
280 BRK:EQUS "1.20 (20 May 1993)"
290 .copyright
300 BRK:EQUS "(C)J.G.Harston"
310 BRK
320 :
330 .Serv
340 CMP #1:BEQ Serv1 :\ Set up intercept, not Master
350 CMP #&27:BEQ Serv27:\ Set up intercept, Master
360 CMP #&FE:BEQ ServFE:\ Explode
370 RTS
380 :
390 .Serv1
400 PHA:TYA:PHA:JSR WhatOS:BCS ServEnd
410 JSR Serv27:BNE ServEnd
420 :
430 .ServFE
440 PHA:TYA:PHA:JSR WhatOS:BCS ServEnd
450 LDA ModeFlag-CodeStart+Intercept
460 AND #&3F:BNE ServEnd:\ ModeFlag<>0 - disabled
470 JSR ExplodeChars
480 .ServEnd
490 PLA:TAY:LDX &F4:PLA:RTS
500 :
510 .Serv27
520 LDA ModeFlag-CodeStart+Intercept
530 AND #&3F:BNE Serv27End:\ ModeFlag<>0 - disabled
540 LDX #CodeEnd-CodeStart
550 .Serv27Lp
560 LDA CodeStart,X:STA Intercept,X
570 DEX:BPL Serv27Lp:LDX &F4
580 STX RomNum+1-CodeStart+Intercept
590 LDA wrchv+0:STA OldWRCH+1-CodeStart+Intercept
600 LDA wrchv+1:STA OldWRCH+2-CodeStart+Intercept
610 LDA #(NewWRCH-CodeStart+Intercept) AND 255:STA wrchv+0
620 LDA #(NewWRCH-CodeStart+Intercept) DIV 256:STA wrchv+1
630 .Serv27End
640 LDA #&27:RTS
650 :
660 .CodeStart
670 .ModeFlag:\ b7=intercept pending, b6=previously new mode
680 BRK
690 .NewWRCH
700 BIT ModeFlag-CodeStart+Intercept
710 BMI ModePending
720 BIT vduq:BMI OldWRCH
730 CMP #22:BEQ ModePending
740 .OldWRCH
750 JMP 0
760 .ModePending
770 PHA:LDA &F4:PHA
780 .RomNum
790 LDA #0:STA &F4:STA &FE30
800 JSR DoMode:\ Call ROM code
810 PLA:STA &F4:STA &FE30
820 PLA:RTS
830 .CodeEnd
840 :
850 .DoMode
860 LDA ModeFlag-CodeStart+Intercept:BMI ModeGo
870 ORA #&80:STA ModeFlag-CodeStart+Intercept
880 LDA #22:JMP OldWRCH-CodeStart+Intercept
890 :
900 .ModeGo
910 TXA:PHA:TYA:PHA:LDA zp+1:PHA:LDA zp+0:PHA
920 TSX:LDA &108,X:PHA :\ Mode number
930 JSR OldWRCH-CodeStart+Intercept:\ Complete the MODE call
940 TAX:LDA &27C:AND #2 :\ Check *FX settings
950 BNE ModeExitDone :\ VDU output disabled
960 LDA &D0:BMI ModeExitDone:TXA :\ VDU 21 in effect
970 AND #&7F:CMP #10:BEQ OldMode
980 AND #&78:CMP #8:BEQ NewMode
990 :
1000 .OldMode
1010 BIT ModeFlag-CodeStart+Intercept
1020 BVC ModeExitDone :\ Already in an old MODE
1030 ASL A:BMI ModeExitDone :\ Don't reset if MODE b6 set
1040 JSR ExplodeChars :\ Reset chars
1050 .ModeExitDone
1060 PLA:LDA #0
1070 .ModeExit
1080 STA ModeFlag-CodeStart+Intercept
1090 PLA:STA zp+0:PLA:STA zp+1:PLA:TAY:PLA:TAX
1100 RTS
1110 :
1120 .NewMode
1130 JSR WhatOS:BCS ModeExploded
1140 LDA &246:CMP #6:BCC OldMode :\ Not exploded, do old MODE
1150 .ModeExploded
1160 LDA #22:JSR RAWVDU :\ Send MODE directly to VDU driver
1170 PLA:PHA:AND #&80:STA zp :\ Save shadow bit
1180 PLA:PHA:AND #7:ASL A:ASL A:PHA :\ Index into table
1190 TAX:LDA ModeTable+3,X:ORA zp :\ Get base MODE
1200 JSR RAWVDU
1210 PLA:TAX:PLA:AND #127 :\ Get table index and MODE back
1220 CMP #7:BNE NotMode7
1230 LDA #2:STA &FE00:LDA #53:STA &FE01
1240 .NotMode7
1250 TXA:PHA :\ Save index into table
1260 LDA ModeTable+3,X:LSR A
1270 LSR A:LSR A:BEQ ModeColours :\ Don't need to change number of colours
1280 STA &360:LDA #20:JSR RAWVDU :\ Reset palette
1290 .ModeColours
1300 PLA:TAX :\ Get table index back
1310 LDA ModeTable+0,X:STA &30A :\ Width
1320 LDA ModeTable+1,X:STA &34F :\ Byte/Char
1330 LDA ModeTable+2,X:TAX :\ Cursor
1340 LSR A:BCC ModeAdust
1350 LDA #&55:STA &363:ASL A:STA &362
1360 LDA #1:STA &361
1370 .ModeAdust
1380 LDA #154:JSR OSBYTE :\ Set VideoULA
1390 BIT ModeFlag-CodeStart+Intercept:BVS AlreadyExploded
1400 :
1410 \ Now define thin characters
1420 LDX #32
1430 LDA chars+0:STA zp+0
1440 LDA chars+1:STA zp+1
1450 .defn_lp1
1460 TXA:PHA
1470 LDA #23:JSR RAWVDU
1480 PLA:PHA:JSR RAWVDU
1490 LDY #0
1500 .defn_lp2
1510 PLA:PHA:LSR A:TYA:PHA
1520 LDA (zp),Y:BCC defn_lp3
1530 ASL A:ASL A:ASL A:ASL A
1540 .defn_lp3
1550 AND #&F0:JSR RAWVDU
1560 PLA:TAY:INY:CPY #8:BNE defn_lp2
1570 PLA:TAX:INX:LSR A:BCC defn_lp1
1580 TYA:CLC:ADC zp+0:STA zp+0
1590 LDA #0:ADC zp+1:STA zp+1
1600 TXA:BNE defn_lp1
1610 .AlreadyExploded
1620 LDA #&40:JMP ModeExit
1630 :
1640 .WhatOS
1650 LDA #0:LDX #1:JSR OSBYTE:CPX #3:RTS:\ CC=B/B+, CS=Master
1660 :
1670 .ExplodeChars
1680 LDA #20:LDX #6:JSR OSBYTE:LDA #25:JMP OSBYTE:\ Reset chars
1690 :
1700 EQUB 0
1710 .ModeTable
1720 \ colours+basemode, ULA value, bytes/char, width
1730 EQUD &0198084F:\ mode 8 80x32x4 4-colour MODE 0
1740 EQUD &02D41027:\ mode 9 40x32x16 16-colour MODE 1
1750 EQUD &82F42013:\ mode 10 20x32x16 256-colour MODE 2 not possible -> 16 colours
1760 EQUD &1B98084F:\ mode 11 80x25x4 4-colour MODE 3
1770 EQUD &05840827:\ mode 12 40x32x2 4-colour MODE 4, small-memory MODE 1
1780 EQUD &7DC11013:\ mode 13 20x32x4 16-colour MODE 5, small-memory MODE 2
1790 EQUD &1E840827:\ mode 14 40x25x4 4-colour MODE 6
1800 EQUD &074A0127:\ mode 15 40x25x8
1810 :
1820 .chars:EQUW Chars:.Chars
1830 ]:OSCLI"LOAD ThinSet "+STR$~O%:P%=P%+&380:O%=O%+&380
1840 RelocTable=P%
1850 NEXT:ENDPROC
1860 :
1870 DEFFNsm_pass(pass%)
1880 IFpass%=0:M%=0
1890 IFpass%=1:M%=O%-mcode%
1900 P%=&8100-128*(pass%AND2)
1910 O%=mcode%+M%*(pass%AND2)DIV2
1920 IFpass%=1:IF O%+M%*2.125>L%:PRINT"Code overrun":END
1930 =VALMID$("4647",pass%+1,1)
1940 :
1950 DEFPROCsm_table
1960 base80%=mcode%+M%:base81%=mcode%:byte%=0:count%=0:off%=0:REPEAT
1970 byte80%=base80%?off%:byte81%=base81%?off%:IF off%>=M%:byte80%=&80:byte81%=&80
1980 IF ((byte81%-byte80%) AND &FE)<>0 THEN PRINT "ERROR: Offset by more than one page at &";~&8000+off%
1990 IF (byte80% AND &C0)=&80:byte%=byte%DIV2+128*(byte81%-byte80%):count%=count%+1
2000 IF count%=8:?O%=byte%:O%=O%+1:byte%=0:count%=0
2010 off%=off%+1:UNTILoff%>=M% AND count%=0
2020 ENDPROC