DECLARE SUB PrintDl ()
DECLARE FUNCTION VRnm$ (ln$)
DECLARE FUNCTION VRTyp$ (ln$)
DECLARE SUB VARS ()
DECLARE FUNCTION Iff$ (f$)
DECLARE FUNCTION PRNcrt$ (g$)
sspc = FRE("")
stck = FRE(-2)
aray = FRE(-1)
'PRINT "-------------------------------------"
INPUT "PAScal Filename"; f$
INPUT "BASic Filename"; of$
OPEN f$ FOR INPUT AS #1
OPEN of$ FOR OUTPUT AS #2
DO UNTIL EOF(1)
LINE INPUT #1, dd$
dd$ = LTRIM$(RTRIM$(dd$))
IF UCASE$(dd$) = "VAR" THEN VARS: GOTO 12
IF RIGHT$(dd$, 1) = ";" THEN dd$ = LEFT$(dd$, LEN(dd$) - 1)
IF RIGHT$(dd$, 1) = ":" THEN PRINT #2, dd$: GOTO 12
IF MID$(UCASE$(dd$), 1, 6) = "GOTOXY" THEN PRINT #2, "LOCATE "; MID$(dd$, INSTR(dd$, ",") + 1, LEN(dd$) - INSTR(dd$, ")") + 1); ","; MID$(dd$, INSTR(dd$, "(") + 1, LEN(dd$) - INSTR(dd$, ",") - 1): GOTO 12
IF UCASE$(dd$) = "REPEAT" THEN PRINT #2, "DO": GOTO 12
IF UCASE$(MID$(dd$, 1, 6)) = "DELAY(" THEN delay = 1: PRINT #2, "DELAY "; MID$(dd$, INSTR(dd$, "(") + 1, INSTR(dd$, ")") - INSTR(dd$, "(") - 1): GOTO 12
IF UCASE$(MID$(dd$, 1, 4)) = "READ" THEN PRINT #2, "INPUT "; MID$(dd$, INSTR(dd$, "(") + 1, INSTR(dd$, ")") - INSTR(dd$, "(") - 1): GOTO 12
IF UCASE$(dd$) = "CLRSCR" THEN PRINT #2, "CLS": GOTO 12
IF MID$(UCASE$(dd$), 1, 5) = "UNTIL" THEN PRINT #2, "LOOP "; dd$: GOTO 12
IF UCASE$(dd$) = "WRITELN('')" THEN PRINT #2, "PRINT": GOTO 12
IF UCASE$(dd$) = "WRITELN ('')" THEN PRINT #2, "PRINT": GOTO 12
IF MID$(UCASE$(dd$), 1, 9) = "WRITELN('" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 10 - 1, LEN(dd$) - 10 + 1)): GOTO 12
IF MID$(UCASE$(dd$), 1, 10) = "WRITELN ('" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 11, LEN(dd$) - 11 + 1)): GOTO 12
IF MID$(UCASE$(dd$), 1, 7) = "WRITE('" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 8 - 1, LEN(dd$) - 9 + 2)) + ";": GOTO 12
IF MID$(UCASE$(dd$), 1, 8) = "WRITE ('" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 9 - 1, LEN(dd$) - 10 + 2)) + ";": GOTO 12
IF MID$(UCASE$(dd$), 1, 8) = "WRITELN(" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 8, LEN(dd$) - 8 + 1)): GOTO 12
IF MID$(UCASE$(dd$), 1, 9) = "WRITELN (" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 9, LEN(dd$) - 9 + 1)): GOTO 12
IF MID$(UCASE$(dd$), 1, 6) = "WRITE(" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 7 - 1, LEN(dd$) - 7 + 1)) + ";": GOTO 12
IF MID$(UCASE$(dd$), 1, 7) = "WRITE (" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 8 - 1, LEN(dd$) - 8 + 1)) + ";": GOTO 12
IF UCASE$(dd$) = "END." THEN PRINT #2, "END": GOTO 12
IF UCASE$(dd$) = "HALT" THEN PRINT #2, "SYSTEM"
IF MID$(UCASE$(dd$), 1, 10) = "TEXTCOLOR(" THEN PRINT #2, "COLOR "; MID$(dd$, 11, LEN(dd$) - 11): fc = VAL(MID$(dd$, 11, LEN(dd$) - 11)): GOTO 12
IF MID$(UCASE$(dd$), 1, 15) = "TEXTBACKGROUND(" THEN PRINT #2, "COLOR ,"; MID$(dd$, 16, LEN(dd$) - 16): fb = VAL(MID$(dd$, 16, LEN(dd$) - 16)): GOTO 12
IF MID$(UCASE$(dd$), 1, 11) = "HIRESCOLOR(" THEN PRINT #2, "COLOR ,,"; MID$(dd$, 12, LEN(dd$) - 12): GOTO 12
IF UCASE$(dd$) = "TEXTMODE" THEN PRINT #2, "SCREEN 0"

IF INSTR(dd$, "=") = 0 THEN GOTO nxt:
IF LTRIM$(MID$(UCASE$(dd$), INSTR(dd$, "="), 8)) = "=LENGTH(" THEN
        FOR q = 1 TO LEN(dd$)
        IF MID$(UCASE$(dd$), q, 3) = "GTH" THEN q = q + 2: GOTO nn
        IF MID$(dd$, q, 1) = ":" THEN  ELSE ln$ = ln$ + MID$(dd$, q, 1)
nn:
        NEXT q
        PRINT #2, ln$: ln$ = ""
        GOTO 12
        END IF
nxt:
'FOR nm = 1 TO LEN(dd$)
'IF MID$(dd$, q + 1, 1) = "[" THEN PRINT "MID$(";mid$(dd$,q,instr()-q)
'NEXT nm
FOR q = 1 TO LEN(dd$)
IF MID$(dd$, q, 6) = "WHEREX" THEN ln$ = ln$ + "POS(0)": q = q + 6
IF MID$(dd$, q, 6) = "WHEREY" THEN ln$ = ln$ + "CSRLIN": q = q + 6
IF MID$(dd$, q, 7) = "RANDOM(" THEN ln$ = ln$ + "INT(RND * " + MID$(dd$, q + 8, INSTR(q + 7, dd$, ")") - q - 8) + ")": q = q + 7
IF MID$(dd$, q, 10) = "KEYPRESSED" THEN ln$ = ln$ + "INKEY$ <> " + CHR$(34) + CHR$(34): q = q + 10
IF MID$(dd$, q, 1) = "'" THEN ln$ = ln$ + CHR$(34): q = q + 1
IF MID$(dd$, q, 1) = ":" THEN  ELSE ln$ = ln$ + MID$(dd$, q, 1)
13 NEXT q
PRINT #2, ln$: ln$ = ""
12 LOOP
IF delay = 1 THEN PrintDl
CLOSE 1, 2
PRINT "String Space Used"; TAB(30); sspc - FRE(""); " bytes"
PRINT "Stack Space Used"; TAB(30); stck - FRE(-2); " bytes"
PRINT "Array Space Used"; TAB(30); aray - FRE(-1); " bytes"

FUNCTION Iff$ (f$)
FOR q = 4 TO LEN(f$)

NEXT q
END FUNCTION

SUB PrintDl
PRINT #2, ""
PRINT #2, "SUB Delay (n)"
PRINT #2, "n=n/1000"
PRINT #2, "a=TIMER+n"
PRINT #2, "DO UNTIL TIMER=>a:LOOP"
PRINT #2, "END SUB"
END SUB

FUNCTION PRNcrt$ (g$)

FOR q = 1 TO LEN(g$)
IF MID$(g$, q, 2) = "'," THEN ln$ = ln$ + CHR$(34) + ";": q = q + 1: GOTO 1222
IF MID$(g$, q, 2) = ",'" THEN ln$ = ln$ + ";" + CHR$(34): q = q + 1: GOTO 1222
IF MID$(g$, q, 1) = "'" THEN ln$ = ln$ + CHR$(34): GOTO 1222
ln$ = ln$ + MID$(g$, q, 1)
1222 NEXT q
PRNcrt$ = ln$
END FUNCTION

SUB VARS
DO UNTIL UCASE$(d$) = "BEGIN" OR UCASE$(MID$(d$, 1, 5)) = "LABEL"
LINE INPUT #1, d$
IF UCASE$(d$) = "BEGIN" OR UCASE$(MID$(d$, 1, 5)) = "LABEL" THEN GOTO 14
dss$ = VRnm$(d$)
FOR m = 1 TO LEN(dss$)
IF MID$(dss$, m, 1) = "," THEN PRINT #2, "DIM "; vr$; " AS "; VRTyp$(d$): vr$ = "" ELSE vr$ = vr$ + MID$(dss$, m, 1)
NEXT m
PRINT #2, "DIM "; vr$; " AS "; VRTyp$(d$): vr$ = ""
14 LOOP
END SUB

FUNCTION VRnm$ (ln$)
VRnm$ = MID$(ln$, 1, INSTR(ln$, " "))
END FUNCTION

FUNCTION VRTyp$ (ln$)
IF MID$(ln$, INSTR(ln$, " ") + 1, LEN(ln$) - INSTR(ln$, " ")) = ":INTEGER;" THEN VRTyp$ = "INTEGER": EXIT FUNCTION
IF MID$(ln$, INSTR(ln$, " ") + 1, LEN(ln$) - INSTR(ln$, " ")) = ":REAL;" THEN VRTyp$ = "LONG": EXIT FUNCTION
IF MID$(ln$, INSTR(ln$, " ") + 1, INSTR(ln$, "[") - INSTR(ln$, " ") - 1) = ":STRING" THEN VRTyp$ = "STRING * " + MID$(ln$, INSTR(ln$, "[") + 1, LEN(ln$) - INSTR(ln$, "[") - 2)
END FUNCTION