home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Samples / BOZOL2 / BOZOL2.ZIP / BOZOL.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-02-08  |  8.4 KB  |  252 lines
  1. %FALSE=0
  2. %TRUE=NOT %FALSE
  3. %DISABLE=0
  4. %ENABLE = NOT %DISABLE
  5.  
  6. %IO.DIRECT = %ENABLE   'use direct access to video ram
  7. %IO.ANSI   = %DISABLE  'use ANSI driver for keyboard/display (redirectable)
  8. %IO.BIOS   = %DISABLE  'use BIOS for keyboard/display
  9. %BI.DBASE  = %DISABLE  'incorporate dBASE commands
  10. %BI.GRAPH  = %DISABLE  'incorporate graphics commands
  11. %BI.MENUS  = %DISABLE  'incorporate text mode user interface commands
  12.  
  13.  
  14. $ERROR ALL ON
  15. $STACK 4096
  16. $DIM ARRAY
  17.  
  18. $IF %IO.DIRECT
  19.   $LIB LPT ON, GRAPH OFF, IPRINT ON, COM OFF
  20. $ELSE
  21.   $LIB LPT OFF, GRAPH OFF, IPRINT OFF, COM OFF
  22. $ENDIF
  23.  
  24. OPTION BINARY BASE 1            ' dBASE routines require this
  25. REDIM     PROGRAM$(1000)      ' Array to store program source code
  26. DIM     VAR$    (256)       ' Array to store variable names
  27. DIM     VALUE$    (256)       ' Array to store variable contents
  28. DIM     ARG$    (16)        ' Buffer array for argument stack pushpop
  29. DIM    GosubStack%(32)        ' Stack to store return pointers
  30. DIM     LITERAL$(16)            ' Storage of parameter names
  31.  
  32. SHARED Row%, Col%, Cur%     ' Store original cursor position and state
  33. SHARED ProgLine%, Prog%         ' Current line number and running status
  34. SHARED MaxLine%            ' How many lines in the program
  35. SHARED CrLf$                    ' Contains carriage return character
  36. SHARED ARG$(), ArgPtr%          ' Argument stack for parsing statements
  37. SHARED VAR$(), VALUE$()         ' Storage arrays for variables
  38. SHARED Literal$(), NextVar%     ' Literal variable name and Next free var #
  39. SHARED PROGRAM$(), ORG$         ' Source code array and saved screen image
  40. SHARED Token$,TokenType,P,Arg$  ' Used by the CALC function.
  41. SHARED GosubStack%(), GosubPtr% ' Used for GOSUB..RETURN
  42. SHARED ExitFlag%                ' Used by IF and other logic commands
  43. SHARED RepeatFlag%              ' Used by WHILE and UNTIL
  44.  
  45. $INCLUDE "DATATYPE.BAS"
  46. $INCLUDE "ERRORMSG.BAS" ' Data statements with error messages
  47. $INCLUDE "CALC.BAS"     ' arithmetic calculator routine (RCD)
  48. $INCLUDE "PREP.BAS"     ' Interpreted code pre-processor subroutine
  49. $INCLUDE "CUSTOM.BAS"   ' SUBs and FUNCTIONs for custom commands
  50. $INCLUDE "BOZO_IO.BAS"  ' General input output procedures
  51. $INCLUDE "VSET.BAS"     ' Routines to get, set and clear variables
  52. $INCLUDE "DATABASE.BAS" ' dBASE interface
  53. $INCLUDE "BTREE.BAS"    ' indexing
  54.  
  55. IF %IO.ANSI THEN CrLf$=CHR$(13,10) ELSE CrLf$=CHR$(13)
  56.  
  57. ' Set a trap for CONTROL-C to break the program
  58. KEY 15,chr$(4,46,&H70)
  59. ON KEY(15) GOSUB BREAK
  60. KEY(15) ON
  61.  
  62.  
  63. ' A simple way to call the interpreter. With PROGRAM$() empty and Prog%
  64. ' set to 0 it will start in command mode.  Put a program into the array
  65. ' and call PROGRUN with Prog% set to NOT 0 and ProgLine% set to 0 or 1
  66. ' and PROGRUN will start out by running the program instead.  Be sure to
  67. ' end your program with QUIT or END in order to exit the interpreter
  68. ' without going into command mode when the program ends.
  69.  
  70. 'ON ERROR GOTO ErrorHandler
  71. PROGRUN PROGRAM$()
  72. END
  73.  
  74. ' =========================================================================
  75. SUB PROGRUN (RUNPROG$())
  76. EXIT FAR AT ExitFar:
  77. IF CrLf$="" THEN CrLf$=CHR$(13)  ' some output may want line feeds added
  78.  
  79. PROGINPUT: ' Here we create a string variable called PROG$.  this variable
  80.            ' will either be the next line to execute in the program (prog%=1)
  81.            ' or it will be entered at the keyboard (prog%=0).
  82.  
  83. IF Prog% THEN      'single-step parent program if currently running
  84.      stp:       'where we skip to if the line is blank
  85.  
  86.        IF Progline% > UBOUND(RUNPROG$) THEN  '..... no more program to run!
  87.             Prog% = 0                     ' stop executing
  88.                 GOTO PROGINPUT                ' go back to command mode
  89.         ELSE
  90.            IF RTRIM$(RUNPROG$(Progline%)) = "" THEN '.....blank line!
  91.                     Progline% = Progline% + 1        ' skip it
  92.                     GOTO stp                         ' and try the next
  93.                 END IF
  94.        Prog$ = RTRIM$(RUNPROG$(Progline%))              ' trim what we have
  95.     END IF
  96.  
  97. ELSE  ' ...program is NOT running, get user input in command mode !!!!!!!!
  98.  
  99.     LOCATE ,,1 '......................turn on cursor
  100.         BOZOPRINT CrLf$+"OK"+CrLf$ '......display a prompt
  101.         Prog$=BOZOINPUT$ '................get user input
  102.  
  103.         ' From here you can enter a direct statement like QUIT or PRINT,
  104.         ' but you can also write a program by entering a LINE NUMBER
  105.         ' followed by a line of code.
  106.  
  107.         IF VAL(Prog$) THEN '.............................. has a line number!
  108.          A% = VAL(Prog$): B% = INSTR(Prog$, " ") '..... get the line $
  109.             IF B% = 0 OR A% > UBOUND(RUNPROG$()) THEN '...... is it good?
  110.                  PRINT "Illegal program line." + CHR$(7) '........NOT!
  111.                      GOTO PROGINPUT '....................Try again, Sucker
  112.          END IF
  113.              LET RUNPROG$(A%)=MID$(Prog$, B% + 1) '......add line to array
  114.          IF A%>MaxLine% THEN MaxLine%=A% '...........find highest line
  115.         GOTO ProgInput '.............. don't execute it, just go back
  116.     END IF
  117. END IF
  118.  
  119. Bak$=Prog$
  120.  
  121. RepeatLabel:
  122. RepeatFlag%=0 '................... set to true if statement is to be repeated
  123. ExitFlag%=0 '............... set to true if statement is aborted by condition
  124. PREP Prog$ '.......................... PREPROCESS THE STATEMENT !!!!!!!!!!!!!
  125. EXEC Prog$ '.......................... EXECUTE THE PROGRAM LINE !!!!!!!!!!!!!
  126. IF RepeatFlag% THEN Prog$=Bak$:GOTO RepeatLabel
  127.  
  128. DO:Dummy$=POPARG$:LOOP WHILE ArgPtr%>0 '..... remove any extraneous arguments
  129.  
  130. IF Prog% THEN INCR Progline% '.if the program is still running then increment
  131. GOTO ProgInput '..............the line pointer and execute the next statement
  132.  
  133. ' yeah, but what about changing the value of Progline% with GOTO and stuff?
  134. ' what about running a new program with LOAD or RUN commands?  That's all
  135. ' handled in the EXEC sub.
  136.  
  137. ExitFar:
  138. END SUB
  139.  
  140. SUB EXEC (Prg$)
  141.  
  142. IF INSTR(Prg$,ANY " ,;") THEN
  143.     RPrg$=MID$(Prg$, INSTR(Prg$,ANY " ,;")+1)
  144.     Prg$=LEFT$(Prg$, INSTR(Prg$,ANY " ,;")-1)
  145.     Rprg$=LTRIM$(RTRIM$(RPrg$))
  146.     EXEC RPrg$
  147.         IF ExitFlag% THEN EXIT SUB
  148. END IF
  149.  
  150. SELECT CASE UCASE$(Prg$)
  151.  
  152.         $INCLUDE "LOADRUN.CMD"   ' Run, Load, Quit, List, etc.
  153.         $INCLUDE "VIDEO_IO.CMD"  ' Print, Input, TAB, CR, etc.
  154.         $INCLUDE "VARIABLE.CMD"  ' LET, SET, etc.
  155.         $INCLUDE "FLOW.CMD"      ' GOTO, GOSUB, other flow control commands
  156.         $INCLUDE "CALC.CMD"      ' CALC, arithmetic processing commands.
  157.         $INCLUDE "LOGIC.CMD"     ' IF, WHILE, UNTIL, etc.
  158.         $INCLUDE "FUNCTION.CMD"  ' functions (ucase, lcase, chr, etc)
  159.         $INCLUDE "CUSTOM.CMD"    ' custom commands and functions
  160.         $INCLUDE "DATABASE.CMD"
  161.  
  162.     CASE ELSE
  163.  
  164.                 ' It's a variable.  Check to see if it has been defined.
  165.                 IF VAL(PRG$) THEN
  166.                     PUSHARG PRG$
  167.                 ELSE
  168.                     PUSHARG GETVAR$(PRG$)'.......... yes, push the value
  169.                 LITERAL$(ArgPtr%)=UCASE$(PRG$) '....... save the literal name
  170.  
  171.             '.......We may need to remember the name of the var for later
  172.                 END IF
  173. END SELECT
  174. END SUB
  175.  
  176.  
  177. SUB PUSHARG(X$)
  178.     INCR ArgPtr%
  179.     ARG$(ArgPtr%)=X$
  180. END SUB
  181.  
  182. FUNCTION POPARG$
  183.     IF ArgPtr%>0 THEN
  184.     P$=ARG$(ArgPtr%)
  185.     DECR ArgPtr%
  186. Concate:
  187.     IF ArgPtr%>0 AND ARG$(ArgPtr%)="&" THEN
  188.             DECR ArgPtr%
  189.             P$=P$+Arg$(ArgPtr%)
  190.                 IF ArgPtr%>0 THEN DECR ArgPtr%
  191.             GOTO Concate
  192.         END IF
  193. AndOr:
  194.     IF ArgPtr%<0 AND ARG$(ArgPtr%)="&&" THEN
  195.             DECR ArgPtr%
  196.                 P$=STR$(ISTRUE(VAL(P$)) AND ISTRUE(VAL(Arg$(ArgPtr%))) )
  197.         IF ArgPtr%>0 THEN DECR ArgPtr%
  198.             GOTO AndOr:
  199.         END IF
  200.  
  201.     IF ArgPtr%<0 AND ARG$(ArgPtr%)="||" THEN
  202.             DECR ArgPtr%
  203.                 P$=STR$(ISTRUE(VAL(P$)) OR ISTRUE(VAL(Arg$(ArgPtr%))))
  204.         IF ArgPtr%>0 THEN DECR ArgPtr%
  205.                 GOTO AndOr:
  206.         END IF
  207.  
  208.  
  209.  
  210.     END IF
  211.         POPARG$=P$
  212. END FUNCTION
  213.  
  214.  
  215.  
  216.  
  217.  
  218. ErrorHandler:
  219. RESTORE ErrorMessages
  220. DO
  221.     READ E, E$
  222.     IF E=999 THEN EXIT DO
  223. LOOP UNTIL E=ERR
  224.  
  225. BOZOPRINT CHR$(7) + CrLf$ + "ERROR:" + STR$(ERR) + "  " + E$ + CrLf$
  226. BOZOPRINT "Continue? (y/n) --> "
  227. DO
  228.         A$=UCASE$(BOZOINPUT$)
  229.     IF A$="N" THEN END
  230. LOOP WHILE A$<>"Y"
  231. RESUME NEXT
  232.  
  233.  
  234. Break:
  235. BOZOPRINT CHR$(7) + CrLf$ + "BREAK: Program interrupted by user" + CrLf$
  236. BOZOPRINT "Resume? (y/n) --> "
  237. DO
  238.         A$=UCASE$(BOZOINPUT$)
  239.     IF A$="N" THEN END
  240. LOOP WHILE A$<>"Y"
  241. RETURN
  242.  
  243.  
  244.  
  245. SUB CWAIT
  246. DO UNTIL LEN(BOZOINKEY$):LOOP
  247. END SUB
  248.  
  249. SUB BOZOL (X$)
  250.     PREP X$
  251.         EXEC X$
  252. END SUB