ConvBas.bbc

10 REM > ConvBas 1.02

20 REM v1.01 22-Jun-2020: Tokenises 'BY', opt%=128 tokenises 'PRIVATE', 'EXIT'

30 REM v1.02 16-Sep-2023: Added &18-&1F tokens

40 :

50 PRINT "Convert between Acorn/6502/6809/PDP11/32K/ARM"'" and Russell/Z80/80x86 BASIC files"

60 PROCBasConvInit

70 ON ERROR PRINT:REPORT:PROCCloseAll:PRINT:OSCLI LEFT$("QUIT",PAGE>&FFFF):END

80 REPEAT

90 INPUT LINE"Source file: "src$

100 INPUT LINE"Source type (Acorn/Russell): "A$:srctype%=(INSTR(".AaBbRrPpTt",LEFT$(A$,1))+2)/4

110 INPUT LINE"Dest. file: "dst$

120 INPUT LINE"Dest. type (Acorn/Russell/Text): "A$:dsttype%=(INSTR(".AaBbRrPpTt",LEFT$(A$,1))+2)/4

130 INPUT LINE"List options: "opt%

140 err%=FNBasConv(src$,srctype%,dst$,dsttype%,opt%)

150 IF err%=214:PRINT"'"src$"' not found"

160 IF err%=192:PRINT"Can't open '"dst$"'"

170 IF err%=127:PRINT"Unknown file type"

180 IF err%=126:PRINT"Conversion not supported"

190 PRINT

200 UNTIL FALSE

210 :

220 REM -------------------------------------------------------------------

230 REM src$=source file, srctype%=source type, 1=Acorn, 2=Russell

240 REM dst$=dest. file, dsttype%=dest. type, 1=Acorn, 2=Russell, 3=Text

250 REM opt%=LISTO options when outputting to text

260 REM bit 0: space after line number

270 REM bit 1: indent structures

280 REM bit 2: split lines at ":" (not implemented)

290 REM bit 3: don't list line number (ignored if line destination found)

300 REM bit 4: list tokens in lower case (not implemented)

310 REM bit 5: pause at end of screen (not implemented)

320 REM bit 6:

330 REM bit 7: extension: tokenise PRIVATE, EXIT; 2-byte immediate tokens

340 REM Returns 0=Ok, <>0=failure

350 REM 126: conversion not supported

360 REM 127: unknown file type

370 REM 192: couldn't save to destination file

380 REM 214: source file not found

390 REM -------------------------------------------------------------------

400 DEFFNBasConv(src$,srctype%,dst$,dsttype%,opt%)

410 IF srctype%<1 OR srctype%>3 OR dsttype%<0 OR dsttype%>3:=127

420 IF srctype%=3 OR srctype%=dsttype%:=126

430 in%=OPENIN(src$):IF in%=0:=214

440 out%=OPENOUT(dst$):IF out%=0:CLOSE#in%:in%=0:=192

450 PROCConvert:IF dsttype%=3:IF lnum%:IF opt% AND 8:opt%=opt% AND -9:PTR#in%=0:PTR#out%=0:PROCConvert

460 PROCCloseAll

470 =0

480 :

490 DEFPROCBasConvInit

500 in%=0:out%=0

510 DIM tkn$(255),line% 3:FOR A%=100 TO &11F:READ tkn$(A%AND255):NEXT A%

520 ENDPROC

530 :

540 DEFPROCConvert

550 indent%=0:lnum%=0

560 IF srctype%=1:A%=BGET#in%

570 IF dsttype%=1:BPUT#out%,13

580 REPEAT

590 IF srctype%=1:hi%=FNrd(255):lo%=FNrd(0):len%=FNrd(0)

600 IF srctype%=2:len%=FNrd(0):lo%=FNrd(0):hi%=FNrd(255)

610 L$="":num%=hi%*256+lo%:IF len%:PROCRdLine:len%=LENL$+3

620 IF dsttype%=1:BPUT#out%,hi%:IF hi%<>255:BPUT#out%,lo%:BPUT#out%,len%

630 IF dsttype%=2:BPUT#out%,len%:BPUT#out%,lo%:BPUT#out%,hi%

640 IF dsttype%=3:PROCWrLine ELSE PROCwr(L$)

650 UNTIL EOF#in% OR len%=0 OR hi%=&FF

660 ENDPROC

670 :

680 DEFPROCRdLine

690 P$=" "

700 REPEAT

710 A%=BGET#in%:B$=CHR$A%:len%=len%-1

720 REM INSTR(CHR$&7F+CHR$&C7+CHR$&C6+CHR$&C8+CHR$&CC+"B",B$):B$=FNRdByte2

730 IF srctype%=1:IF A%=&7F OR (A%>&C5 AND A%<&CF) OR A%=66:B$=FNRdByte2

740 IF srctype%=2:IF dsttype%=1:IF A%<32 OR (A%>=&C6 AND A%<=&CC):B$=FNRdByte1

750 L$=L$+B$:IF B$<>" ":P$=B$

760 UNTIL len%<4

770 IF dsttype%=2:IF LEFT$(L$,1)=" ":REPEAT:L$=MID$(L$,2):UNTIL LEFT$(L$,1)<>" "

780 ENDPROC

790 :

800 REM Translate Russell 1-byte tokens

810 DEFFNRdByte1

820 IF A%=&00 OR A%=&0D:=CHR$A% :REM End of line

830 IF A%<&0D+((opt%AND128)DIV32):B%=EVAL("&"+MID$("008F9D909791989394999C969A0DA500A6",A%*2+1,2)):IF B%:=CHR$&C8+CHR$B%

840 IF A%<&11:=tkn$(A%) :REM 'PRIVATE', 'EXIT', convert to text

850 IF A%>&17:IF A%<&20:IF(opt%AND128)=0:=CHR$EVAL("&"+MID$("C6C7CEC9C8CACCCD",A%*2-47,2))

860 IF A%>&17:IF A%<&20:IF(opt%AND128)>0:=CHR$&C7+CHR$EVAL("&"+MID$("8F9192949597999A",A%*2-47,2))

870 IF A%=&C6:=CHR$&C6+CHR$&8E :REM 'SUM'

880 IF A%=&C7:=CHR$&C8+CHR$&95 :REM 'WHILE'

890 IF A%=&C8:=CHR$&C8+CHR$&8E :REM 'CASE'

900 IF A%=&CC:=CHR$&7F :REM 'OTHERWISE'

910 =CHR$A% :REM Leave as is

920 :

930 REM Translate Acorn 2-byte tokens

940 REM &7F 1-byte OTHERWISE

950 REM &CC 1-byte ELSE

960 REM 'B' 'BY' if immediately after DRAW/FILL/MOVE

970 REM &C6,xx 2-byte functions

980 REM &C7,xx 2-byte immediate commands, if &C7 must be non-ARM BASIC edited on RISC OS

990 REM &C8,xx 2-byte commands

1000 DEFFNRdByte2

1010 IF A%=&7F:=CHR$&CC :REM 'OTHERWISE'

1020 IF A%=&CC:=CHR$&8B :REM 'ELSE'

1030 A%=A%*256+BGET#in%:len%=len%-1 :REM Two-byte token

1040 IF A%=&4259:IF INSTR(CHR$&EC+CHR$&DF+CHR$&03,P$):=CHR$&0F :REM [MOVE|DRAW|FILL] 'BY'

1050 IF A%=&C68E:=CHR$&C6 :REM 'SUM'

1060 IF A%=&C68F:=tkn$(117) :REM 'BEAT'

1070 IF A%>=&C78E:IF A%<=&C79A:=B%=EVAL("&"+MID$("001800191A001B1C001D001E1F",(A%-&C78E)*2+1,2)):IF B%:=CHR$B%

1080 IF A%>=&C78E:IF A%<=&C79F:=tkn$(100+A%-&C78E) :REM No 1-byte equivalent, convert to text

1090 IF A%>=&C88E:IF A%<=&C89D:=CHR$(EVAL("&"+MID$("C8010305F00708C70B0406090C0C0A02",(A%-&C88E)*2+1,2)))

1100 IF A%>=&C89E:IF A%<=&C8A4:=tkn$(118+A%-&C89E) :REM No 1-byte equivalent, convert to text

1110 IF A%>=&C8A5:IF A%<=&C8A6:=CHR$(&0E+(A%-&C8A5)*2) :REM 'PRIVATE', 'EXIT'

1120 PTR#in%=PTR#in%-1:len%=len%+1:A%=A%DIV256 :REM Must be 1-byte token

1130 IF A%>=&C6:IF A%<>&CB:=CHR$EVAL("&"+MID$("18191C1B1D001E1F",A%*2-395,2))

1140 =A% :REM Leave as is

1150 :

1160 DEFPROCWrLine

1170 IF L$="":ENDPROC

1180 IF num%:IF (opt% AND 8)=0:PROCwr(FNd(num%,5)) ELSE IF (opt% AND 8)=0:PROCwr(" ")

1190 IF opt% AND 1:BPUT#out%,32

1200 FOR ptr%=1 TO LEN L$

1210 IF INSTR(CHR$&ED+CHR$&FD+CHR$&CE+CHR$&CB+CHR$&CD,MID$(L$,ptr%,1)):indent%=indent%-1

1220 NEXT ptr%

1230 IF opt% AND 2:PROCwr(STRING$(2*indent% AND (indent%>0)," "))

1240 FOR ptr%=1 TO LEN L$

1250 B%=ASCMID$(L$,ptr%,1)

1260 IF B%=&8D:$line%=MID$(L$,ptr%+1,3):ptr%=ptr%+3:lnum%=TRUE

1270 IF B%=&8D:PROCwr(STR$(((line%?2 EOR 16*?line%)*256+(line%?1 EOR (4*?line% AND &C0)))AND&FFFF))

1280 IF B%<&7F:IF B%>&1F:BPUT#out%,B% ELSE IF B%<>&8D:PROCwr(tkn$(B%))

1290 IF INSTR(CHR$&E3+CHR$&F5+CHR$&C7+CHR$&C8,CHR$B%):indent%=indent%+1

1300 NEXT ptr%

1310 IF RIGHT$(L$,2)=CHR$&8C+CHR$13:indent%=indent%+1

1320 BPUT#out%,10

1330 ENDPROC

1340 :

1350 DEFFNrd(A%):IF EOF#in%:=A% ELSE =BGET#in%

1360 DEFPROCwr(A$):IF A$<>"":FOR A%=1 TO LEN A$:BPUT#out%,ASCMID$(A$,A%,1):NEXT A%

1370 ENDPROC

1380 :

1390 DATA APPEND,AUTO,CRUNCH,DELETE,EDIT,HELP,LIST,LOAD,LVAR,NEW,OLD,RENUMBER,SAVE

1400 DATA TEXTLOAD,TEXTSAVE,TWIN,TWINO,INSTALL

1410 DATA BEAT,BEATS,TEMPO,VOICES,VOICE,STEREO,OVERLAY,MANDEL,PRIVATE,EXIT

1420 DATA OTHERWISE,AND,DIV,EOR,MOD,OR,ERROR,LINE,OFF,STEP,SPC,TAB(,ELSE,THEN,,OPENIN,PTR

1430 DATA PAGE,TIME,LOMEM,HIMEM,ABS,ACS,ADVAL,ASC,ASN,ATN,BGET,COS,COUNT,DEG,ERL,ERR,EVAL

1440 DATA EXP,EXT,FALSE,FN,GET,INKEY,INSTR(,INT,LEN,LN,LOG,NOT,OPENUP,OPENOUT,PI,POINT(,POS

1450 DATA RAD,RND,SGN,SIN,SQR,TAN,TO,TRUE,USR,VAL,VPOS,CHR$,GET$,INKEY$,LEFT$(,MID$(,RIGHT$(

1460 DATA STR$,STRING$(,EOF,SUM,WHILE,CASE,WHEN,OF,ENDCASE,OTHERWISE,ENDIF,ENDWHILE,PTR

1470 DATA PAGE,TIME,LOMEM,HIMEM,SOUND,BPUT,CALL,CHAIN,CLEAR,CLOSE,CLG,CLS,DATA,DEF,DIM,DRAW

1480 DATA END,ENDPROC,ENVELOPE,FOR,GOSUB,GOTO,GCOL,IF,INPUT,LET,LOCAL,MODE,MOVE,NEXT,ON,VDU

1490 DATA PLOT,PRINT,PROC,READ,REM,REPEAT,REPORT,RESTORE,RETURN,RUN,STOP,COLOUR,TRACE,UNTIL

1500 DATA WIDTH,OSCLI,,CIRCLE,ELLIPSE,FILL,MOUSE,ORIGIN,QUIT,RECTANGLE,SWAP,SYS,TINT,WAIT

1510 DATA INSTALL,,PRIVATE,BY,EXIT,,,,,,,,AUTO,DELETE,EDIT,LIST,LOAD,NEW,RENUMBER,SAVE

1520 :

1530 DEFPROCCloseAll

1540 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%

1550 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%

1560 ENDPROC

1570 :

1580 DEFFNd(A%,N%)=RIGHT$(" "+STR$A%,N%)

1590 :

1600 PRINT BY;by;"BY":DRAW BY 1,2:DRAW 1+BY,2:MOVE BY 1,2:FILL BY 1,2:REM GOTO 1510

1610 "file",address: "file",start,end: TO "file"