10
20
30
40 :
50 MODE7
60 OSBYTE=&FFF4:OSARGS=&FFDA:OSWRCH=&FFEE:RAWVDU=&FFBC
70 start%=&FFFF7000:zp=&A8:num=&AA:font=&AB
80 FOR opt%=0 TO 3 STEP 3
90 P%=start%
100 [OPT opt%
110 .error
120 BRK:EQUB 220:EQUS "Syntax: Mode <num>":BRK
130 :
140 .get_digit
150 LDA (zp),Y:INY:BCC get_decimal :\ CC=check for decimal digit
160 CMP #ASC"A":BCC get_decimal :\ <'A', check for decimal digit
170 AND #&DF:CMP #ASC"F"+1
180 BCS get_digit_exit:SBC #6
190 .get_digit_ok
200 AND #15:CLC:RTS
210 .get_decimal
220 CMP #ASC"9"+1:BCS get_digit_exit :\ CS=bad character
230 CMP #ASC"0":BCS get_digit_ok:SEC
240 .get_digit_exit
250 RTS
260 :
270 .go%
280 LDA #1:LDX #zp:LDY #0:JSR OSARGS
290 LDA (zp),Y:CMP #13:BEQ error
300 CMP #ASC"&":CLC:BNE get_num :\ CC=dec
310 SEC:INY :\ CS=hex, step past '&'
320 .get_num
330 PHP:JSR get_digit:BCS error:STA num
340 .get_num_lp
350 PLP:PHP:JSR get_digit:BCS get_num_done
360 TAX:LDA num:PLP:PHP:BCS get_hex
370 ASL A:ASL A:ADC num:JMP get_num2
380 .get_hex
390 ASL A:ASL A:ASL A
400 .get_num2
410 ASL A:STA num:CLC:TXA:ADC num:STA num
420 BCS error:BCC get_num_lp
430 :
440 .get_num_done
450 PLP:LDA #0:LDX #1:JSR OSBYTE
460 CPX #3:TXA:PHP:LDA num :\ CC=B/B+, CS=Master, EQ=Elk
470 AND #&7F:CMP #10:BEQ old_mode
480 AND #&78:CMP #8:BNE old_mode
490 LDA &246:STA font :\ Current font state
500 LDA #20:LDX #6:JSR OSBYTE :\ Explode font
510 :
520 LDX #32
530 LDA #chars AND 255:STA zp+0
540 LDA #chars DIV 256:STA zp+1
550 .defn_lp1
560 TXA:PHA:LDA #23:JSR RAWVDU :\ Send directly to VDU
570 PLA:PHA:JSR RAWVDU :\ Avoid sending to OSWRCH streams
580 LDY #0 :\ NB! RAWVDU corrupts all registers
590 .defn_lp2
600 PLA:PHA:LSR A:TYA:PHA
610 LDA (zp),Y:BCC defn_lp3
620 ASL A:ASL A:ASL A:ASL A :\ Swap nybble
630 .defn_lp3
640 AND #&F0:JSR RAWVDU
650 PLA:TAY:INY:CPY #8:BNE defn_lp2
660 PLA:TAX:INX:LSR A:BCC defn_lp1
670 TYA:CLC:ADC zp+0:STA zp+0
680 LDA #0:ADC zp+1:STA zp+1
690 TXA:BNE defn_lp1
700 BEQ check_font
710 :
720 .old_mode
730 LDA #25:LDX #0:PLP:PHP:BCS go_mode
740 LDA #20:LDX &246
750 .go_mode
760 JSR OSBYTE:\ Reset characters
770 .check_font
780 EOR #16:AND #16:PLP:PHA:\ 16=new mode, 0=old mode
790 LDX &28C:BCS check_language:\ CS=Master, PAGE not changed
800 LDA font:CMP &246:BCC mode_continue:\ BBC, PAGE raised
810 .check_language
820 LDA &2A1,X:LDX #&80
830 CMP #96:BNE mode_continue:LDX #&C2
840 .mode_continue
850 \ X=0RRRRRRR - re-enter language
860 \ X=10xxxxxx - don't re-enter language
870 \ X=11000010 - BASIC, becomes &84 for OSBYTE call
880 PLA:TAY:TXA:PHA
890 :
900 LDX #mode_table-mode_set
910 .mode_lp
920 LDA mode_set,X:STA &100,X
930 DEX:BPL mode_lp
940 TYA:BEQ mode_setup
950 LDA num:AND #7:ASL A:ASL A:TAX
960 LDA mode_table+3,X
970 LSR A:LSR A:LSR A:PHA :\ colours
980 LDA mode_table+0,X:PHA :\ width
990 LDA mode_table+1,X:PHA :\ bytes/char
1000 LDA num:AND #&80
1010 ORA mode_table+3,X :\ base mode
1020 AND #&87:ORA #&40:STA num
1030 LDA mode_table+2,X:TAX :\ cursor
1040 LSR A:BCC mode_setup:LDY #&AA:\ adjust bitmap
1050 .mode_setup
1060 LDA #22:JSR OSWRCH
1070 LDA num:JMP &100
1080 :
1090 \ This routine copied to &100+ to change mode
1100 .mode_set
1110 JSR OSWRCH :\ base mode
1120 TYA:BEQ no_palette :\ old mode
1130 BPL not_mode13
1140 STA &362:LSR A:STA &363
1150 LDA #1:STA &361 :\ adust bitmaps
1160 .not_mode13
1170 LDA #154:JSR OSBYTE:\ video ULA
1180 PLA:STA &34F :\ bytes/character
1190 PLA:STA &30A :\ width
1200 PLA:BEQ no_palette :\ colours
1210 STA &360:LDA #20:JSR RAWVDU
1220 .no_palette
1230 PLA:BPL Sel_Lang
1240 ASL A:BPL Not_Basic
1250 JSR OSBYTE
1260 STX 4:STY 5:STX 6:STY 7:\ Reset BASIC's HIMEM
1270 .Not_Basic
1280 RTS
1290 .Sel_Lang :\ PAGE changed, so re-enter language
1300 TAX:LDA #142:JMP OSBYTE
1310 :
1320 .mode_table
1330 \ colours+basemode, ULA value, bytes/char, width
1340 EQUD &0198084F:\ mode 8 80x32x4 4-colour MODE 0
1350 EQUD &02D41027:\ mode 9 40x32x16 16-colour MODE 1
1360 EQUD &82F42013:\ mode 10 20x32x16 256-colour MODE 2 not possible -> 16 colours
1370 EQUD &1B98084F:\ mode 11 80x25x4 4-colour MODE 3
1380 EQUD &05840827:\ mode 12 40x32x2 4-colour MODE 4, small-memory MODE 1
1390 EQUD &7DC11013:\ mode 13 20x32x4 16-colour MODE 5, small-memory MODE 2
1400 EQUD &1E840827:\ mode 14 40x25x4 4-colour MODE 6
1410 EQUD &074A0127:\ mode 15 40x25x8
1420 EQUS "v1.20"
1430 .chars
1440 ]NEXT
1450 OSCLI"LOAD ThinSet "+STR$~P%
1460 PRINT"*SAVE Mode ";~start%;" ";~P%+&380;" ";~go%OR&FFFF0000;" ";~start%