1: DECLARE SUB PrintDl () 2: DECLARE FUNCTION VRnm$ (ln$) 3: DECLARE FUNCTION VRTyp$ (ln$) 4: DECLARE SUB VARS () 5: DECLARE FUNCTION Iff$ (f$) 6: DECLARE FUNCTION PRNcrt$ (g$) 7: sspc = FRE("") 8: stck = FRE(-2) 9: aray = FRE(-1) 10: 'PRINT "-------------------------------------" 11: INPUT "PAScal Filename"; f$ 12: INPUT "BASic Filename"; of$ 13: OPEN f$ FOR INPUT AS #1 14: OPEN of$ FOR OUTPUT AS #2 15: DO UNTIL EOF(1) 16: LINE INPUT #1, dd$ 17: dd$ = LTRIM$(RTRIM$(dd$)) 18: IF UCASE$(dd$) = "VAR" THEN VARS: GOTO 12 19: IF RIGHT$(dd$, 1) = ";" THEN dd$ = LEFT$(dd$, LEN(dd$) - 1) 20: IF RIGHT$(dd$, 1) = ":" THEN PRINT #2, dd$: GOTO 12 21: 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 22: IF UCASE$(dd$) = "REPEAT" THEN PRINT #2, "DO": GOTO 12 23: 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 24: IF UCASE$(MID$(dd$, 1, 4)) = "READ" THEN PRINT #2, "INPUT "; MID$(dd$, INSTR(dd$, "(") + 1, INSTR(dd$, ")") - INSTR(dd$, "(") - 1): GOTO 12 25: IF UCASE$(dd$) = "CLRSCR" THEN PRINT #2, "CLS": GOTO 12 26: IF MID$(UCASE$(dd$), 1, 5) = "UNTIL" THEN PRINT #2, "LOOP "; dd$: GOTO 12 27: IF UCASE$(dd$) = "WRITELN('')" THEN PRINT #2, "PRINT": GOTO 12 28: IF UCASE$(dd$) = "WRITELN ('')" THEN PRINT #2, "PRINT": GOTO 12 29: IF MID$(UCASE$(dd$), 1, 9) = "WRITELN('" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 10 - 1, LEN(dd$) - 10 + 1)): GOTO 12 30: IF MID$(UCASE$(dd$), 1, 10) = "WRITELN ('" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 11, LEN(dd$) - 11 + 1)): GOTO 12 31: IF MID$(UCASE$(dd$), 1, 7) = "WRITE('" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 8 - 1, LEN(dd$) - 9 + 2)) + ";": GOTO 12 32: IF MID$(UCASE$(dd$), 1, 8) = "WRITE ('" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 9 - 1, LEN(dd$) - 10 + 2)) + ";": GOTO 12 33: IF MID$(UCASE$(dd$), 1, 8) = "WRITELN(" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 8, LEN(dd$) - 8 + 1)): GOTO 12 34: IF MID$(UCASE$(dd$), 1, 9) = "WRITELN (" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 9, LEN(dd$) - 9 + 1)): GOTO 12 35: IF MID$(UCASE$(dd$), 1, 6) = "WRITE(" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 7 - 1, LEN(dd$) - 7 + 1)) + ";": GOTO 12 36: IF MID$(UCASE$(dd$), 1, 7) = "WRITE (" THEN PRINT #2, "PRINT "; PRNcrt$(MID$(dd$, 8 - 1, LEN(dd$) - 8 + 1)) + ";": GOTO 12 37: IF UCASE$(dd$) = "END." THEN PRINT #2, "END": GOTO 12 38: IF UCASE$(dd$) = "HALT" THEN PRINT #2, "SYSTEM" 39: 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 40: 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 41: IF MID$(UCASE$(dd$), 1, 11) = "HIRESCOLOR(" THEN PRINT #2, "COLOR ,,"; MID$(dd$, 12, LEN(dd$) - 12): GOTO 12 42: IF UCASE$(dd$) = "TEXTMODE" THEN PRINT #2, "SCREEN 0" 43: 44: IF INSTR(dd$, "=") = 0 THEN GOTO nxt: 45: IF LTRIM$(MID$(UCASE$(dd$), INSTR(dd$, "="), 8)) = "=LENGTH(" THEN 46: FOR q = 1 TO LEN(dd$) 47: IF MID$(UCASE$(dd$), q, 3) = "GTH" THEN q = q + 2: GOTO nn 48: IF MID$(dd$, q, 1) = ":" THEN ELSE ln$ = ln$ + MID$(dd$, q, 1) 49: nn: 50: NEXT q 51: PRINT #2, ln$: ln$ = "" 52: GOTO 12 53: END IF 54: nxt: 55: 'FOR nm = 1 TO LEN(dd$) 56: 'IF MID$(dd$, q + 1, 1) = "[" THEN PRINT "MID$(";mid$(dd$,q,instr()-q) 57: 'NEXT nm 58: FOR q = 1 TO LEN(dd$) 59: IF MID$(dd$, q, 6) = "WHEREX" THEN ln$ = ln$ + "POS(0)": q = q + 6 60: IF MID$(dd$, q, 6) = "WHEREY" THEN ln$ = ln$ + "CSRLIN": q = q + 6 61: IF MID$(dd$, q, 7) = "RANDOM(" THEN ln$ = ln$ + "INT(RND * " + MID$(dd$, q + 8, INSTR(q + 7, dd$, ")") - q - 8) + ")": q = q + 7 62: IF MID$(dd$, q, 10) = "KEYPRESSED" THEN ln$ = ln$ + "INKEY$ <> " + CHR$(34) + CHR$(34): q = q + 10 63: IF MID$(dd$, q, 1) = "'" THEN ln$ = ln$ + CHR$(34): q = q + 1 64: IF MID$(dd$, q, 1) = ":" THEN ELSE ln$ = ln$ + MID$(dd$, q, 1) 65: 13 NEXT q 66: PRINT #2, ln$: ln$ = "" 67: 12 LOOP 68: IF delay = 1 THEN PrintDl 69: CLOSE 1, 2 70: PRINT "String Space Used"; TAB(30); sspc - FRE(""); " bytes" 71: PRINT "Stack Space Used"; TAB(30); stck - FRE(-2); " bytes" 72: PRINT "Array Space Used"; TAB(30); aray - FRE(-1); " bytes" 73: 74: FUNCTION Iff$ (f$) 75: FOR q = 4 TO LEN(f$) 76: 77: NEXT q 78: END FUNCTION 79: 80: SUB PrintDl 81: PRINT #2, "" 82: PRINT #2, "SUB Delay (n)" 83: PRINT #2, "n=n/1000" 84: PRINT #2, "a=TIMER+n" 85: PRINT #2, "DO UNTIL TIMER=>a:LOOP" 86: PRINT #2, "END SUB" 87: END SUB 88: 89: FUNCTION PRNcrt$ (g$) 90: 91: FOR q = 1 TO LEN(g$) 92: IF MID$(g$, q, 2) = "'," THEN ln$ = ln$ + CHR$(34) + ";": q = q + 1: GOTO 1222 93: IF MID$(g$, q, 2) = ",'" THEN ln$ = ln$ + ";" + CHR$(34): q = q + 1: GOTO 1222 94: IF MID$(g$, q, 1) = "'" THEN ln$ = ln$ + CHR$(34): GOTO 1222 95: ln$ = ln$ + MID$(g$, q, 1) 96: 1222 NEXT q 97: PRNcrt$ = ln$ 98: END FUNCTION 99: 100: SUB VARS 101: DO UNTIL UCASE$(d$) = "BEGIN" OR UCASE$(MID$(d$, 1, 5)) = "LABEL" 102: LINE INPUT #1, d$ 103: IF UCASE$(d$) = "BEGIN" OR UCASE$(MID$(d$, 1, 5)) = "LABEL" THEN GOTO 14 104: dss$ = VRnm$(d$) 105: FOR m = 1 TO LEN(dss$) 106: IF MID$(dss$, m, 1) = "," THEN PRINT #2, "DIM "; vr$; " AS "; VRTyp$(d$): vr$ = "" ELSE vr$ = vr$ + MID$(dss$, m, 1) 107: NEXT m 108: PRINT #2, "DIM "; vr$; " AS "; VRTyp$(d$): vr$ = "" 109: 14 LOOP 110: END SUB 111: 112: FUNCTION VRnm$ (ln$) 113: VRnm$ = MID$(ln$, 1, INSTR(ln$, " ")) 114: END FUNCTION 115: 116: FUNCTION VRTyp$ (ln$) 117: IF MID$(ln$, INSTR(ln$, " ") + 1, LEN(ln$) - INSTR(ln$, " ")) = ":INTEGER;" THEN VRTyp$ = "INTEGER": EXIT FUNCTION 118: IF MID$(ln$, INSTR(ln$, " ") + 1, LEN(ln$) - INSTR(ln$, " ")) = ":REAL;" THEN VRTyp$ = "LONG": EXIT FUNCTION 119: 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) 120: END FUNCTION 121: |