10
20
30 :
40 list%=FALSE
50 reloc%=TRUE
60 DIM mcode% &3FFF
70 INPUT"VIEW ROM filename: "R$:TMP$="VIEWJ3H"
80 IFreloc%:INPUT"VIEWHI filename: "H$:IFH$="":reloc%=FALSE
90 FOR high%=reloc% TO 0
100 A$=R$:base%=&8000:IFhigh%:A$=H$:base%=&C503
110 OSCLI"LOAD "+A$+" "+STR$~mcode%
120 IFreloc%=0:IFmcode%!9<>&57454956:PRINT"Not VIEW ROM":END
130 IFreloc%=0:IFmcode%!&2842<>&302E3342:PRINT"Not VIEW B3.0":END
140 FORopt%=4TO6-list%STEP2-list%:PROCAsm:NEXT
150 IFhigh%:A$=TMP$ ELSE OSCLI"LOAD pc8b "+STR$~(FONT-base%+mcode%):A$="VIEWJ3"
160 REPEAT?O%=255:O%=O%+1:P%=P%+1:UNTILP%>&BFFF
170 A$="*SAVE "+A$+" "+STR$~mcode%+" "+STR$~O%+" FFFF0000 FFFBBC00"
180 PRINTA$;:OSCLIA$:PRINT:NEXT:IFreloc%:OSCLI"DELETE "+TMP$
190 END
200 DEFFNp(A%):P%=A%-&8000+base%:O%=A%-&8000+mcode%:=opt%
210 DEFFNo(A%):=A%-&8000+base%
220 DEFPROCAsm
230 tmp=&21:ptr=&22:src=ptr+2:dst=ptr+4
240 [OPT FNp(&800E):EQUS "(C)Acornsoft, JGH ":EQUB 0:]
250 [OPT FNp(&80C2):JSR TubeCheck:.CODEBASE:]
260 [OPT FNp(&873A):EQUS "s counted. ":]
270 [OPT FNp(&8944):LDX #7:JSR NewSave:]
280 [OPT FNp(&8CA0):BNE FNo(&8CAF):]
290 [OPT FNp(&8D18):JMP NewBGet:]
300 [OPT FNp(&9A39):JSR Format:]
310 [OPT FNp(&9B96):JSR NewRDCH:]
320 [OPT FNp(&9BA2):BVS FNo(&9BBB):]
330 [OPT FNp(&9BAA):BNE FNo(&9BD0):]
340 [OPT FNp(&A842):EQUS "J3.0":BRK:]:
350 [OPT FNp(&A8A1):NOP:NOP:NOP:]
360 [OPT FNp(&AFE3):LDX #&14:.LAFE5:STA &69,X
370 DEX:BPL LAFE5:STX &50:STX &51:]:
380 [OPT FNp(&B0AE):LDA #15:JSR &FFEE
390 LDA #&DB:LDX #&00:JSR BYTE0
400 LDA #&E1:LDX #&8C:JSR BYTE0
410 LDA #&E2:LDX #&9C:JSR BYTE0
420 LDA #&E3:STA &3D:LDX #&AC:JSR BYTE0
430 LDA #&04:LDX #&02:STX &73:STX &76
440 .BYTE0:LDY #&00:JMP &FFF4:NOP:NOP:]
450 [OPT FNp(&B1F9):.CallArgs:LDX #ptr:JMP &FFDA
460 .InkeyY:LDY #&FF:.InkeyX:LDA #&81:JMP &FFF4:]
470 :
480 [OPT FNp(&B2FD)
490 \ Read <file> translates CRLF and LFCR
500 .NewBGet
510 JSR &FFD7:BCS BGetExit :\ EOF, quit
520 CMP #10:BEQ BGetNext :\ LF, test next
530 CMP #13:BNE BGetOk :\ CR, test next
540 .BGetNext
550 PHA:LDA #0:JSR CallArgs:\ Get current PTR
560 JSR &FFD7:BCS BGetBack :\ EOF, return <cr>
570 CMP #10:BEQ BGetTest :\ Could be <cr><lf>
580 CMP #13:BNE BGetBack :\ 2nd char not <cr>/<lf>
590 .BGetTest
600 TSX:CMP &101,X:BNE BGetCR:\ Different, return <cr>
610 .BGetBack
620 LDA #1:JSR CallArgs :\ Same or 2nd<>eol, move back
630 .BGetCR:PLA:LDA #13 :\ Drop, return <cr>
640 .BGetOk:CLC
650 .BGetExit:RTS
660 :
670 \ Save <file> sets load/exec to text
680 .NewSave
690 TXA:AND #2:BEQ P%+4:LDA #&FF:STA &502,X
700 DEX:BPL NewSave:STX &503:JMP FNo(&894C)
710 :
720 \ Format skips double highlights
730 .Format
740 JSR FNo(&A600):BNE FormOk
750 DEC &39:DEC &39:.FormOk:RTS
760 :
770 \ Extended keyboard handler
780 \ Return A=keypress, VC=char, VS=func/edit
790 .NewRDCH
800 JSR FNo(&A761) :\ Get a keypress
810 CMP #&8C:BIT FormOk:BCS FormOk:\ func/edit
820 TAY:BEQ NewRDok
830 CMP #13:BEQ NewRDok
840 CMP #27:BCC NewRDctrl :\ Ctrl-Letter, get second key
850 CMP #ASC"#":BEQ NewRDpad :\ Keypad, test modifiers
860 CMP #ASC"*":BCC NewRDok :\ Digit punctuation
870 CMP #ASC"9"+1:BCC NewRDpad :\ Keypad, test modifiers
880 .NewRDok:CLV:RTS
890 :
900 .NewRDctrl
910 JSR FNo(&A761):PHA:LDX #9*8:\ Second keypress
920 CMP #ASC"E":BEQ NewRD4:INX :\ AE
930 CMP #ASC"e":BEQ NewRD4:INX :\ ae
940 AND #&DF
950 CMP #ASC"O":BEQ NewRD4:INX :\ ao
960 CMP #ASC"T":BEQ NewRD4:INX :\ Pt
970 CPY #&06:BEQ NewRD4:PLA :\ ff
980 CMP #ASC"!":BCC NewRDok :\ Bad modifier
990 CMP #ASC"A":BCC NewRD2 :\ '!' to '?'
1000 CMP #ASC"[":BCC NewRDok :\ Bad modifier
1010 CMP #ASC"a":BCC NewRD1 :\ '[' to '`'
1020 CMP #ASC"{":BCC NewRDok :\ Bad modifier
1030 CMP #127:BCS NewRDok:SBC #26:\ '{' to '~'
1040 .NewRD1:SBC #27
1050 .NewRD2:SBC #32 :\ 0-40
1060 TAX:LDA NewRDtab1,X
1070 CMP #ASC" ":BCS NewRDok:TAX:\ Single look-up
1080 TYA:LDY #8 :\ X=accent 0...7
1090 .NewRDlp1
1100 CMP NewRDtab2-1,Y:BEQ NewRD3:\ Ctrl-Char matched
1110 DEY:BNE NewRDlp1 :\ Y=character 0...8
1120 .NewRD3
1130 TYA:ASL A:ASL A:ASL A
1140 STX tmp:ADC tmp:TAX:PHA :\ X=char*8+accent
1150 .NewRD4
1160 PLA:LDA NewRDtab3,X:CLV:RTS
1170 :
1180 .NewRDpad
1190 PHA:LDA #0:STA tmp:LDX #&FE:\ Start with CTRL
1200 .NewRDlp3
1210 TXA:PHA:JSR InkeyY :\ Test this key
1220 CPX #1:ROR tmp :\ tmp becomes %SC000000
1230 PLA:TAX:INX:BMI NewRDlp3 :\ Loop until SHIFT read
1240 PLA:BIT tmp:BMI NewRDkey :\ SHIFT -> linedraw
1250 BVC NewRD5 :\ No SHIFT/CTRL
1260 CMP #ASC"0":BCC NewRDkey :\ Not CTRL+Digit
1270 :
1280 AND #15
1290 .NewRDlp5:STA tmp :\ Current num
1300 .NewRDlp6
1310 LDX #&FE:JSR InkeyY:TXA :\ CTRL still pressed?
1320 BNE NewRD6:LDA tmp
1330 .NewRD5:CLV:RTS
1340 .NewRD6
1350 LDX #20:LDY #0:JSR InkeyX :\ Inkey(20)
1360 CPX #ASC"0":BCC NewRDlp6
1370 CPX #ASC"9"+1:BCS NewRDlp6 :\ No digit pressed
1380 LDA tmp:ASL A:ASL A:ADC tmp
1390 ASL A:STA tmp:TXA:AND #15 :\ tmp=tmp*10+num
1400 ADC tmp:JMP NewRDlp5
1410 :
1420 .NewRDkey
1430 CMP #ASC"#":BNE NewRDkey2 :\ Not prefix
1440 BIT tmp:BVC NewRDkey4 :\ Not Ctrl-#
1450 JSR FNo(&A761) :\ Second keypress
1460 CMP #ASC"9"+1:BCS NewRDkey4:\ >'9', ignore
1470 CMP #ASC"1":BCC NewRDkey4 :\ <'1', ignore
1480 SBC #2:BIT tmp:BPL NewRDkey3:\ Ctrl-#-digit
1490 SBC #9:BNE NewRDkey3 :\ CtSh-#-digit
1500 .NewRDkey2
1510 SEC:SBC #ASC"*":LSR tmp :\ '*'-'9' -> &00-&0F
1520 LSR tmp:ORA tmp:EOR #&30 :\ %00sckkkk
1530 .NewRDkey3:TAX:LDA NewRDtab4,X
1540 .NewRDkey4:CLV:RTS
1550 :
1560 .NewRDtab1
1570 EQUS CHR$&AD+CHR$0+"#"+CHR$&AC+CHR$&80+"&'()*+"+CHR$&AE+CHR$7+CHR$&AF+CHR$3
1580 EQUS "0"+CHR$&AD+CHR$1+"3"+CHR$&AC+CHR$&87+"6789:;"+CHR$&AE+CHR$7+CHR$&AF+CHR$2
1590 EQUS "["+CHR$6+"]"+CHR$5+CHR$7+CHR$7+"{"+CHR$6+"}"+CHR$4
1600 .NewRDtab2
1610 EQUB &01:EQUB &03:EQUB &05:EQUB &09:\ ACEI
1620 EQUB &0E:EQUB &0F:EQUB &15:EQUB &19:\ NOUY
1630 .NewRDtab3
1640 EQUS CHR$&AB+CHR$&AB+CHR$&A8+CHR$&A8+CHR$&7E+CHR$&5E+CHR$&5C+CHR$&9C
1650 EQUS CHR$&8E+CHR$&84+CHR$&A0+CHR$&A0+CHR$&83+CHR$&83+CHR$&85+CHR$&A6 :\ A
1660 EQUS CHR$&22+CHR$&32+CHR$&3F+CHR$&2F+CHR$&7E+CHR$&5E+CHR$&9B+CHR$&5F :\ C
1670 EQUS CHR$&89+CHR$&89+CHR$&90+CHR$&82+CHR$&88+CHR$&88+CHR$&8A+CHR$&5F :\ E
1680 EQUS CHR$&8B+CHR$&8B+CHR$&A1+CHR$&A1+CHR$&8C+CHR$&8C+CHR$&8D+CHR$&5F :\ I
1690 EQUS CHR$&22+CHR$&32+CHR$&3F+CHR$&2F+CHR$&A5+CHR$&A4+CHR$&5C+CHR$&5F :\ N
1700 EQUS CHR$&99+CHR$&94+CHR$&A2+CHR$&A2+CHR$&93+CHR$&93+CHR$&95+CHR$&A7 :\ O
1710 EQUS CHR$&9A+CHR$&81+CHR$&A3+CHR$&A3+CHR$&96+CHR$&96+CHR$&97+CHR$&5F :\ U
1720 EQUS CHR$&98+CHR$&98+CHR$&3F+CHR$&2F+CHR$&7E+CHR$&5E+CHR$&5C+CHR$&9D :\ Y
1730 EQUS CHR$&92+CHR$&91+CHR$&8F+CHR$&9E+CHR$&9F
1740 .NewRDtab4
1750 EQUS CHR$&B1+CHR$&DD+CHR$&AA+CHR$&DF+CHR$&CD+CHR$&B0+CHR$&BA+CHR$&C8 :\ SC
1760 EQUS CHR$&CA+CHR$&BC+CHR$&CC+CHR$&CE+CHR$&B9+CHR$&C9+CHR$&CB+CHR$&BB :\ SC
1770 EQUS CHR$&2A+CHR$&2B+CHR$&A9+CHR$&2D+CHR$&C4+CHR$&2F+CHR$&B3+CHR$&C0 :\ S
1780 EQUS CHR$&C1+CHR$&D9+CHR$&C3+CHR$&C5+CHR$&B4+CHR$&DA+CHR$&C2+CHR$&BF :\ S
1790 EQUS CHR$&B2+CHR$&DE+CHR$&2C+CHR$&DC+CHR$&2E+CHR$&DB :\ C
1800 EQUS CHR$&D3+CHR$&D0+CHR$&BD+CHR$&C7+CHR$&D7+CHR$&B6+CHR$&D6+CHR$&D2+CHR$&B7 :\ C#
1810 EQUS CHR$&D4+CHR$&CF+CHR$&BE+CHR$&C6+CHR$&D8+CHR$&B5+CHR$&D5+CHR$&D1+CHR$&B8 :\ SC#
1820 .CODEEND
1830 :
1840 .TubeCheck
1850 LDA #&83:JSR &FFF4:STY tmp:\ Read MEMBOT
1860 LDA #20:LDX #3:JSR &FFF4 :\ Explode font
1870 TYA:BEQ TubeFont :\ MEMBOT not moved
1880 EOR tmp:BEQ TubeFont :\ MEMBOT not moved
1890 LDX &F4:LDA #142:JMP &FFF4:\ We must be on I/O
1900 .TubeFont
1910 LDX #128-1:TAY :\ X=CHR$128, Y=0
1920 LDA #FONT AND 255:STA ptr+0
1930 LDA #FONT DIV 256:STA ptr+1
1940 .FontLp1
1950 TYA:AND #7:BNE FontLp2
1960 INX:BEQ Relocate
1970 LDA #23:JSR &FFEE:TXA:JSR &FFEE
1980 .FontLp2
1990 LDA (ptr),Y:JSR &FFEE:INY:BNE FontLp1
2000 INC ptr+1:BNE FontLp1
2010 :
2020 \ Now relocate if on 2nd processor
2030 .Relocate
2040 JSR &AFB0:BCS P%+3:RTS:LDX #6:\ CLC=Not on CoPro
2050 .RelLp0
2060 LDA ADDRS-1,X:STA ptr-1,X:DEX:\ Set up ptr,src,dst
2070 BNE RelLp0:LDY #0 :\ X=0, Y=0
2080 .RelLp
2090 LDA (src),Y:BPL RelStore :\ Outside code
2100 CMP #(CODEEND+255)DIV256:BCS RelStore:\ Outside code
2110 DEX:BPL RelByte
2120 LDA (ptr),Y:STA tmp:LDX #7 :\ Get relocation byte
2130 INC ptr+0:BNE RelByte:INC ptr+1:\ Update table address
2140 .RelByte
2150 LDA (src),Y:ROR tmp:BCC RelStore :\ Don't update this byte
2160 DEY:DEC src+1:DEC dst+1:LDA (src),Y:\ Get low byte
2170 CLC:ADC #(DESTBASE-CODEBASE)AND255 :\ Update low byte
2180 STA (dst),Y :\ Store it
2190 INY:INC src+1:INC dst+1:LDA (src),Y:\ Get high byte
2200 ADC #((DESTBASE-CODEBASE)DIV256)AND255:\ Update high byte
2210 .RelStore
2220 STA (dst),Y :\ Store byte
2230 INC src+0:BNE P%+4:INC src+1:\ Update addresses
2240 INC dst+0:BNE P%+4:INC dst+1
2250 LDA dst+1:CMP #&F8:BCC RelLp:\ Loop until reach MOS
2260 LDX #GO AND 255:LDY #GO DIV 256
2270 JMP &FFF7 :\ Enter moved code
2280 .GO:EQUS "GO "+STR$~DESTBASE:EQUB 13
2290 .ADDRS:EQUW RELTABLE:EQUW CODEBASE:EQUW DESTBASE
2300 EQUS STRING$((8-P%)AND7,CHR$0)
2310 .FONT:]:P%=P%+&400:O%=O%+&400:[OPT opt%
2320 .RELTABLE:]:DESTBASE=&F800-(CODEEND-CODEBASE)
2330 IFreloc%=0:[OPT FNp(Relocate):RTS:.FONT:]:P%=P%+&400:O%=O%+&400:ENDPROC
2340 IFhigh%ORopt%=4:ENDPROC
2350 ar%=OPENIN(TMP$):PTR#ar%=CODEBASE-base%
2360 addr%=CODEBASE-base%:CHKEND=(CODEEND+255)AND-256:val%=0:bc%=8:v1%=0:v2%=0
2370 REPEAT:v1%=v1%DIV256+256*mcode%?addr%:v2%=v2%DIV256+256*BGET#ar%
2380 PROCcheck:addr%=addr%+1:UNTILaddr%>=CODEEND-base%:CLOSE#ar%
2390 IFbc%<>8:REPEAT:PROCaddbit(0):UNTILbc%=8
2400 RELEND=P%:PRINTCHR$13;:ENDPROC
2410 DEFPROCcheck:d%=v2%-v1%:IFv1%<&8000ORv1%>=CHKEND:ENDPROC
2420 PRINTCHR$13;~addr%+base%;:PROCaddbit((d%>&3FFF)AND1):ENDPROC
2430 DEFPROCaddbit(v%):val%=val%DIV2+v%*128:bc%=bc%-1:IFbc%:ENDPROC
2440 ?O%=val%:O%=O%+1:P%=P%+1:val%=0:bc%=8:ENDPROC