8-Bit Software Online Conversion
Forth. From K6N - Listing
5*TV255
10MODE7
20*FX21
30VDU23,1,0;0;0;0;
31title0$=" "
32title1$=" w3````p p 00 "
34title2$=" 5 *z:jzj jjj "
36title3$=" ||||||||||||| "
40B=132
50C1=145:C2=147
60C3=131:C4=129:F3=C3:F4=C4
70C5=129:C6=131
80REPEAT:VDU(30)
90IF F3=C3 F3=C4 ELSE F3=C3
100IF F3=C3 F4=C4
110IF F3=C4 F4=C3
120PRINTCHR$(B)CHR$(157)
130PRINTCHR$(B)CHR$(157)CHR$(F3)"*"CHR
$(F4)"*"CHR$(F3)"*"CHR$(F4)"*"CHR$(F3)"*
"CHR$(F4)"*"CHR$(F3)"*"CHR$(F4)"*"CHR$(F
3)"*"CHR$(F4)"*"CHR$(F3)"*"CHR$(F4)"*"CH
R$(F3)"*"CHR$(F4)"*"CHR$(F3)"*"CHR$(F4)"
*"CHR$(F3)"*"CHR$(F4)"*"
140PRINTCHR$(B)CHR$(157)CHR$(F4)"*"CHR
$(F3)"*"CHR$(F4)"*"CHR$(F3)"*"CHR$(F4)"*
"CHR$(F3)"*"CHR$(F4)"*"CHR$(F3)"*"CHR$(F
4)"*"CHR$(F3)"*"CHR$(F4)"*"CHR$(F3)"*"CH
R$(F4)"*"CHR$(F3)"*"CHR$(F4)"*"CHR$(F3)"
*"CHR$(F4)"*"CHR$(F3)"*"
150PRINTCHR$(B)CHR$(157)CHR$(F3)"*"CHR
$(F4)"* "CHR$(156)CHR$(C2)title0$CHR$(B
)CHR$(157)CHR$(F3)"*"CHR$(F4)"*"
160PRINTCHR$(B)CHR$(157)CHR$(F4)"*"CHR
$(F3)"* "CHR$(156)CHR$(C2)title0$CHR$(B
)CHR$(157)CHR$(F4)"*"CHR$(F3)"*"
170PRINTCHR$(B)CHR$(157)CHR$(F3)"*"CHR
$(F4)"* "CHR$(156)CHR$(C2)title1$CHR$(B
)CHR$(157)CHR$(F3)"*"CHR$(F4)"*"
180PRINTCHR$(B)CHR$(157)CHR$(F4)"*"CHR
$(F3)"* "CHR$(156)CHR$(C2)title2$CHR$(B
)CHR$(157)CHR$(F4)"*"CHR$(F3)"*"
190PRINTCHR$(B)CHR$(157)CHR$(F3)"*"CHR
$(F4)"* "CHR$(156)CHR$(C1)title3$CHR$(B
)CHR$(157)CHR$(F3)"*"CHR$(F4)"*"
200PRINTCHR$(B)CHR$(157)CHR$(F4)"*"CHR
$(F3)"*";" "C
HR$(F4)"*"CHR$(F3)"*"
210PRINTCHR$(B)CHR$(157)CHR$(F3)"*"CHR
$(F4)"*"CHR$(C6)" 1...Run Program
"CHR$(F3)"*"CHR$(F4)"*"
220PRINTCHR$(B)CHR$(157)CHR$(F4)"*"CHR
$(F3)"*";" "C
HR$(F4)"*"CHR$(F3)"*"
230PRINTCHR$(B)CHR$(157)CHR$(F3)"*"CHR
$(F4)"*"CHR$(C6)" 2...Display Source
"CHR$(F3)"*"CHR$(F4)"*"
240PRINTCHR$(B)CHR$(157)CHR$(F4)"*"CHR
$(F3)"*";" "C
HR$(F4)"*"CHR$(F3)"*"
250PRINTCHR$(B)CHR$(157)CHR$(F3)"*"CHR
$(F4)"*"CHR$(C6)" 3...How To Forth
"CHR$(F3)"*"CHR$(F4)"*"
260PRINTCHR$(B)CHR$(157)CHR$(F4)"*"CHR
$(F3)"*";" "C
HR$(F4)"*"CHR$(F3)"*"
270PRINTCHR$(B)CHR$(157)CHR$(F3)"*"CHR
$(F4)"*"CHR$(F3)"*"CHR$(F4)"*"CHR$(F3)"*
"CHR$(F4)"*"CHR$(F3)"*"CHR$(F4)"*"CHR$(F
3)"*"CHR$(F4)"*"CHR$(F3)"*"CHR$(F4)"*"CH
R$(F3)"*"CHR$(F4)"*"CHR$(F3)"*"CHR$(F4)"
*"CHR$(F3)"*"CHR$(F4)"*"
280PRINTCHR$(B)CHR$(157)CHR$(F4)"*"CHR
$(F3)"*"CHR$(F4)"*"CHR$(F3)"*"CHR$(F4)"*
"CHR$(F3)"*"CHR$(F4)"*"CHR$(F3)"*"CHR$(F
4)"*"CHR$(F3)"*"CHR$(F4)"*"CHR$(F3)"*"CH
R$(F4)"*"CHR$(F3)"*"CHR$(F4)"*"CHR$(F3)"
*"CHR$(F4)"*"CHR$(F3)"*"
290PRINTCHR$(B)CHR$(157)
300RESTORE
310READ A$:PRINTCHR$(B)CHR$(157)CHR$(C
6)A$
330READ A$:PRINTCHR$(B)CHR$(157)CHR$(C
6)A$
350READ A$:PRINTCHR$(B)CHR$(157)CHR$(C
6)A$
370READ A$:PRINTCHR$(B)CHR$(157)CHR$(C
6)A$
390READ A$:PRINTCHR$(B)CHR$(157)CHR$(C
6)A$
410READ A$:PRINTCHR$(B)CHR$(157)CHR$(C
6)A$
430PRINTCHR$(B)CHR$(157);
440A$=INKEY$(2)
450IF ASC(A$)<0 A$=" "
460UNTIL INSTR("123",A$)
470:
472IF A$="1":OSCLI"EXEC FORTHLD":END
480IF A$="2":F$="worm"
490IF A$="3":F$="Ftext"
500:
510DATA" Forth 79
"
522DATA" ----------
"
564DATA"
"
565DATA"
"
566DATA"
"
567DATA"
"
570:
572buffer=&4000
574bufsize=&3000
580HIMEM=buffer
590DIMcode 400,scr%(20)
600ONERROR RUN
610*FX4,1
620PROCassemble
630REMPROCfile
650F%=OPENIN F$
660REM" Colour toggles on c
670?&74=1:?&72=130
680B%=&900:times%=0:back%=0:new%=0
690div=EXT#F%/100
700:
710REPEAT
720new%=1:PROCld
730REPEAT
740start%=G%:?&73=0:scol%=?&72
750REPEAT
760CALL gline
770UNTIL ?&73=24 OR G%>=T%
780IF ?&73<>24:REPEAT:PRINTSTRING$(40,
" ");:?&73=?&73+1:UNTIL ?&73=24
790depth=(bufsize*(times%-1)+G%-buffer
)/div
800REPEAT
810PRINTTAB(0,24)CHR$(157)CHR$(132);
820IF depth<10 PRINT" ";
830IF depth<100 PRINT" ";
840PRINTSTR$(INT(depth))"%";
850IF EOF#F% AND G%>=T% PRINTCHR$(136)
" Any Key Finishes or B,[ "; ELSE PRINT
" Any Key [,],B,F or P ";
860IFstart%=buffer:VDU7:E%=1:PRINT"(TO
B) ";
870IFE%=0:IFG%>=T%:VDU7:E%=1:PRINT"(BO
B) ";
880IFE%:E%=0 ELSE PRINT" ";
890PRINTTAB(0,24);
900*FX21
910K%=GET:G$=CHR$(K%)
920IF K%=136 OR K%=139 PROCback1
930IF K%=137 OR K%=138 PROCforward1
940IFINSTR("Bb",G$) PROCjumpback
950IFINSTR("Ff",G$) PROCjumpforward
960IFINSTR("Cc",G$) PROCcolour
970IFINSTR("Pp",G$) PROCprtScreen
980UNTIL K%
990UNTILG%>=T%
1000UNTILEOF#F%
1010:
1020CLOSE#F%
1030*FX4,0
1040RUN
1050END
1060:
1070DEFPROCcolour
1080?&74=?&74 EOR 1
1090IF ?&74 ?&72=130 ELSE ?&72=0
1100G%=start%
1110ENDPROC
1120:
1130DEFPROCcolminus
1140?&72=?&72-1
1150IF?&72=132:?&72=131
1160IF?&72=129:?&72=134
1170ENDPROC
1180:
1190DEFPROCcolplus
1200?&72=?&72+1
1210IF?&72=132:?&72=133
1220IF?&72=135:?&72=130
1230ENDPROC
1240:
1250DEFPROCld
1260IFback% times%=times%-1:PTR#F%=scr%
(times%)
1270IFnew%:times%=times%+1:scr%(times%)
=PTR#F%
1280IF EXT#F%-PTR#F%>(bufsize-1) H%=buf
size ELSE H%=EXT#F%-PTR#F%
1290PRINTTAB(0,24)CHR$(157)CHR$(132)" L
oading Please Wait ";TAB(
0,24);
1300A%=4
1310X%=B% MOD 256
1320Y%=B% DIV 256
1330B%?0=F%
1340B%!1=buffer
1350B%!5=H%
1360CALL&FFD1
1370D%=0:back%=0:new%=0:G%=buffer:T%=G%
+H%+D%
1380IF PTR#F%=EXT#F% ENDPROC
1390S%=&6FFF
1400REPEAT
1410D%=D%+1
1420S%=S%+1
1430R%=BGET#F%
1440?S%=R%
1450UNTIL?S%=13 AND ?(S%-1)=13
1460S%?1=&FF
1470T%=G%+H%+D%
1480ENDPROC
1490:
1500DEFPROCfile
1510REPEAT
1520*.
1530PRINT'"Filename :";
1540INPUT F$
1550IF LEFT$(F$,1)="*" OSCLI+F$
1560UNTILLEFT$(F$,1)<>"*"
1570ENDPROC
1580:
1590DEFPROCback1
1600IFstart%=buffer:IFtimes%>1:G$="B":E
NDPROC
1610IFstart%=buffer:K%=0:ENDPROC
1620?&72=scol%
1630IF?&74:IF?start%=13:PROCcolminus
1640VDU30:G%=start%-1
1650REPEAT:G%=G%-1:UNTIL ?G%=13 OR G%=&
3000
1660IF G%<>buffer:G%=G%+1
1670ENDPROC
1680:
1690DEFPROCforward1
1700IFG%>=T%:G$="F":ENDPROC
1710?&72=scol%
1720VDU30:G%=start%-1
1730REPEAT:G%=G%+1:UNTIL ?G%=13
1740G%=G%+1
1750IF?&74:IF ?G%=13 PROCcolplus
1760ENDPROC
1770:
1780DEFPROCjumpback
1790IFG%<=(buffer+&600) AND times%=1:G%
=buffer:ENDPROC
1800IFG%>(buffer+&600):G%=G%-&600:REPEA
T:G%=G%-1:UNTIL ?G%=13 OR G%=buffer:ENDP
ROC
1810back%=1
1820PROCld:G%=&6A00:REPEAT:G%=G%-1:UNTI
L ?G%=13
1830ENDPROC
1840:
1850DEFPROCjumpforward
1860IFG%>(T%-&380):ENDPROC
1870G%=G%+&300
1880REPEAT:G%=G%+1:UNTIL?G%=13
1890ENDPROC
1900:
1910DEFPROCprtScreen
1920U%=start%:E%=0:cnt%=0:VDU2
1930REPEAT
1940REPEAT
1950A%=?U%
1960IFA%=141:E%=1
1970IFA%>126:A%=32
1980IFA%>31:VDU1,A%
1990U%=U%+1
2000UNTIL?U%=13 OR U%>T%
2010IFE%:REPEAT:U%=U%+1:UNTIL?U%=13:cnt
%=cnt%+1:VDU1,13:E%=0
2020cnt%=cnt%+1:VDU1,13
2030UNTILcnt%=24 OR U%>T%
2040VDU1,13,3:K%=0
2050ENDPROC
2060:
2070DEFPROCerror
2080CLOSE#F%
2090*FX4,0
2100PRINT
2110ENDPROC
2120:
2130DEFPROCassemble
2140FOR I%=0 TO 2 STEP 2
2150P%=code
2160[OPTI%
2170.gline
2180LDX &74:STX &76
2190LDA &72:JSR &FFEE
2200.loopa
2210JSR get
2220CMP #13:BEQ a2
2230CMP #126:BCS a1
2240CMP #32:BCC a1
2250JSR &FFEE:INC &76
2260.a1
2270LDX &76:CPX #40:BNE loopa
2280INC &7F
2290.a2
2300LDX &74:BEQ a3
2310JSR seeatg:CMP #13:BNE a3
2320LDX &7F:BEQ d2
2330LDA &404:PHA
2340JSR get:JSR seeatg
2350LDX &41C:BNE d1:DEC &41D
2360.d1
2370DEC &41C
2380TAX:PLA:STA &404
2390CPX #13:BNE a3
2400.d2
2410JSR chcol
2420.a3
2430LDX #0:STX &7F
2440LDA &404:CMP #13:BNE a4
2450LDA #32
2460.cloop
2470LDX &76:CPX #40:BEQ a4
2480JSR &FFEE:INC &76:BNE cloop
2490.a4
2500LDA &404:CMP #13:BEQ a5
2510CMP #32:BEQ a5:JSR back
2520.a5
2530INC &73
2540RTS
2550½ ******* subroutines ********
2560.get
2570LDX &41C:STX &80
2580LDX &41D:STX &81
2590LDY #0:LDA (&80),Y:STA &404
2600INC &41C:BNE g1:INC &41D
2610.g1
2620RTS
2630.seeatg
2640LDX &41C:STX &80
2650LDX &41D:STX &81
2660LDY #0:LDA (&80),Y
2670RTS
2680.chcol
2690INC &72:LDX &72
2700CPX #132:BNE c1
2710LDY #133:STY &72
2720.c1
2730CPX #135:BNE c2
2740LDY #130:STY &72
2750.c2
2760RTS
2770.back
2780JSR seeatg
2790CMP #32:BEQ b0
2800CMP #13:BNE b2
2810.b0
2820INC &41C:BNE b1:INC &41D
2830.b1
2840RTS
2850.b2
2860LDX &41C:STX &82:LDX &41D:STX &83
2870LDX #0:STX &75
2880.loopb1
2890LDY #2
2900.b3
2910LDX &41C:BNE b4:DEC &41D
2920.b4
2930DEC &41C:DEY:BNE b3
2940JSR get:INC &75:DEC &76
2950CMP #32:BEQ b6
2960LDX &76:CPX &74:BNE loopb1
2970.b5
2980LDX #0:STX &75
2990LDX &82:STX &41C
3000LDX &83:STX &41D
3010JSR seeatg:CMP #13:BNE b6
3020INC &41C:BNE b6:INC &41D
3030.b6
3040LDX &75:BEQ b7:LDA #127
3050.loopb2
3060JSR &FFEE:DEC &75:BNE loopb2
3070JSR &FFE7
3080.b7
3090RTS
3100]NEXT:ENDPROC