8-Bit Software Online Conversion
:0.$.3to7 - Listing
10REM "3to7" 80 column to 40
20REM V1.20
30REM Modified JGH 20-Jun-1996
40REM Improved RPS 29-Mar-1997
50IFINKEY(0)=0:INPUT""A$:$&A00=A$
60*FX229
70*FX4,2
80*KEY15 B
90*KEY14 F
100MODE7:VDU23;8202;0;0;0;
110HIMEM=&2FFF
120DIMscr%(20),code 350,string 80
130PROCassemble:F%=0
140ONERROROSCLI"FX4,0":CLOSE#0:IFERR=1
7 THENOSCLI"Exec $.!BOOT":END ELSEMODE7:
REPORT:PRINT:END
150A$=$&A00:IFA$="" ORLENA$>80 ORASCA$
<32 ORASCA$>126:PROCfile ELSE $&A00=""
160PROCheader("Add colour to text ? (Y
/N)")
170?&74=(INSTR("Yy",GET$)>0)AND1
180?&72=130 AND(?&74>0)
190F%=OPENIN A$:IFF%=0:PROCheader(A$+"
not found"):key%=INKEY(150):PROCfile:GO
TO160
200B%=&900:times%=0:back%=0:new%=0
210?&76=?&74:?&71=0
220:
230REPEAT
240IF NOTEOF#F%:new%=1:PROCld
250G%=&3000
260REPEAT:CLS:?&73=0
270REPEAT:CALLcode
280PRINT'CHR$(?&72)$string;
290UNTIL?&73>22 OR G%>=T%
300depth%=(&4000*(times%-1)+G%-&3000)/
(EXT#F%/100)
310PROCheader(RIGHT$(" "+STR$depth%,2)
+"%"+" Arrow keys : up & down Esc : end"
)
320*FX21
330REPEATG$=GET$:UNTILINSTR("BbFb:*/?"
,G$)
340IFINSTR("Bb*:",G$) ANDG%>&3000:PROC
jumpback
350IFINSTR("Ff?/",G$):PROCjumpforward
360UNTILG%>=T%:UNTILFALSE
370END
380:
390DEFPROCld
400IFback%:times%=times%-1:PTR#F%=scr%
(times%)
410IFnew%:times%=times%+1:scr%(times%)
=PTR#F%
420H%=EXT#F%-PTR#F%:IFH%>&3FFF:H%=&400
0
430PROCheader("Loading file...")
440A%=4:X%=B% MOD256:Y%=B% DIV256
450?B%=F%:B%!1=&3000:B%!5=H%
460CALL&FFD1
470D%=0:back%=0:new%=0:T%=&3000+H%+D%
480IFPTR#F%=EXT#F% THENENDPROC
490S%=&6FFF
500REPEAT:D%=D%+1:S%=S%+1:R%=BGET#F%:?
S%=R%:UNTILR%=13 ORR%=10 OREOF#F%
510S%?1=&FF:T%=&3000+H%+D%
520ENDPROC
530:
540DEFPROCfile:REPEAT:CLS
550PRINTTAB(0,2);" 8-Bit Software 80 t
o 40 Column"'" Text Conversion. By C.J.R
ichardson."'" Please enter filename to c
onvert, or"'" '*' to goto the command li
ne."'
560*.
570A$="":*FX138,0,13
580REPEAT
590key%=GET:IF(key%<8 ORkey%>127)ANDke
y%<>13 THENGOTO590
600IFkey%=ASC"*" THENkey%=0:VDU&16,7:R
EPEAT:PRINT"*";:INPUT""A$:OSCLIA$:UNTILL
EN(A$)=0
610IF(key%=127 ORkey%=8)ANDLEN(A$)=0 T
HENVDU7
620IF(key%=127 ORkey%=8)ANDLEN(A$)>=1
THENA$=LEFT$(A$,LEN(A$)-1)
630IFLEN(A$)=21 THENVDU7:GOTO660
640IFkey%>32 ANDkey%<127 THENA$=A$+CHR
$(key%)
650PROCheader("Enter filename: "+A$)
660UNTILkey%=13 ANDLEN(A$)>0
670ENDPROC
680:
690DEFPROCjumpback
700IFG%<=&3600 AND times%=1:G%=&3000:E
NDPROC
710IFG%>&3600:G%=G%-&500:REPEAT:G%=G%-
1:UNTIL ?G%=13 OR G%=&3000:ENDPROC
720back%=1
730PROCld:G%=&6A00:REPEAT:G%=G%-1:UNTI
L ?G%=13
740ENDPROC
750:
760DEFPROCjumpforward
770IFG%>(T%-&380):ENDPROC
780REPEAT:G%=G%-1:UNTIL?G%=13
790G%=G%+1:ENDPROC
800:
810DEFPROCheader(line$)
820PRINTTAB(0,0);CHR$157;CHR$132;LEFT$
(line$,37);STRING$(37-LEN(line$)," ")
830ENDPROC
840:
850DEFPROCassemble
860strpos=string
870FOR I%=0TO2STEP2
880P%=code
890[OPTI%
900JSR clear
910.loop
920JSR get
930LDX &74:BEQ a1
940LDA &404:CMP #13:BNE a1
950LDX &75:BEQ a1
960JSR chcol:JMP a2
970.a1
980LDX #0:STX &75
990LDA &404:CMP #13:BNE a2
1000LDX #1:STX &75
1010.a2
1020LDA &404:CMP #13:BEQ a3
1030CMP #126:BCS a3
1040CMP #29:BEQ high
1050CMP #32:BCC a3
1060JSR atob:JMP a3
1070.high
1080LDA &71:BMI a3:½ View type
1090ASL A:BMI skip:½ Extended
1100½ Not yet set:
1110LDY #1:LDA (&80),Y:PHA:INY
1120.highLP
1130LDA (&80),Y:CMP #29:BEQ high2
1140INY:BPL highLP:STY &71:BMI a3
1150.high2
1160INY:LDA (&80),Y:AND #&DF:STA &70
1170LDA #&80:STA &71
1180PLA:AND #&DF:CMP &70:BNE a3
1190LSR &71
1200.skip
1210JSR g0:½ Skip
1220.a3
1230LDA &404:CMP #13:BEQ a5
1240LDX &76:CPX #40:BEQ a5
1250LDX &41D:CPX &451:BCC a4
1260LDX &41C:CPX &450:BCS a5
1270.a4
1280JMP loop
1290.a5
1300LDX &76:CPX #40:BNE a6
1310JSR back:JMP a7
1320.a6
1330LDA &404:CMP #13:BNE a8
1340.a7
1350LDX &74:STX &76:INC &73
1360.a8
1370RTS
1380½ ******* subroutines ********
1390.clear
1400LDX #0:STX &77
1410LDA #13:STA string,X:RTS
1420.get
1430LDX &41C:STX &80
1440LDX &41D:STX &81
1450LDY #0:LDA (&80),Y:STA &404
1460.g0
1470INC &41C:BNE g1:INC &41D
1480.g1
1490RTS
1500.atob
1510INC &76
1520LDX &77:LDA &404:STA string,X
1530INX:STX &77:LDA #13:STA string,X
1540RTS
1550.chcol
1560INC &72:LDX &72
1570CPX #132:BNE c1
1580LDY #133:STY &72
1590.c1
1600CPX #135:BNE c2
1610LDY #130:STY &72
1620.c2
1630RTS
1640.back
1650LDX &41C:STX &82:LDX &41D:STX &83
1660LDX &77:STX &84
1670.bloop
1680LDY #2
1690.b0
1700LDX &41C:BNE b1:DEC &41D
1710.b1
1720DEC &41C:DEY:BNE b0
1730JSR get
1740DEC &77
1750LDA &404:CMP #32:BEQ b2
1760LDX &77:CPX#1:BNE bloop
1770LDX &84:STX &77
1780LDA #127:STA string,X
1790INX:LDA #13:STA string,X
1800LDX &82:STX &41C
1810LDX &83:STX &41D
1820RTS
1830.b2
1840LDX &77:LDA #13:STA string,X
1850.b3
1860RTS
1870]
1880NEXT:ENDPROC