DECLARE SUB FILELIST (P1$)
DECLARE SUB lstprog ()
DECLARE SUB LDPROGRAM (P1$)
DECLARE SUB SVPROGRAM (P1$)
DECLARE SUB PROGRUN ()
DECLARE SUB LEAVEOS9 (WORD$)
DECLARE SUB gnpart (CMD$, otxt$, Q!)
DECLARE SUB MODELPROC (TEXT$)


COMMON SHARED ROOT$
COMMON SHARED PROGLENGTH
REM MODEL2.BAS

ROOT$ = "C:\QBASIC\"
DIM SHARED PROGRAMARRY$(200)

SCREEN 12

TEXT$ = "HELP"

PRINT "------------------"
PRINT "- MODEL 2 BASIC  -"
PRINT "------------------"



DO



 LINE INPUT "]"; TEXT$

  PRINT "___"

 CALL MODELPROC(TEXT$)

LOOP UNTIL TEXT$ = "EXIT"


PRINT "RETURNING TO DOS"

END

SUB FILELIST (P1$)

REM
REM
REM SHOWFILE
 NAME$ = P1$


 PRINT "#########"
 PRINT "# LIST  #"
 PRINT "#########"
  PRINT NAME$
IF NAME$ <> "" THEN
OPEN NAME$ FOR INPUT AS #1
 DO
 INPUT #1, A$
 PRINT A$


 V = V + 1
 IF V > 22 THEN V = 0: SLEEP

 LOOP UNTIL EOF(1)


CLOSE #1

 SLEEP
END IF


END SUB

SUB gnpart (CMD$, otxt$, Q)

ll = LEN(CMD$)
IF Q <= (ll) THEN
IF Q = 0 THEN Q = 1

otxt$ = ""
CH$ = ""

DO

  CH$ = MID$(CMD$, Q, 1)

IF CH$ <> "," AND CH$ <> ":" AND CH$ <> "(" AND CH$ <> ")" AND CH$ <> CHR$(32) AND CH$ <> CHR$(34) THEN
otxt$ = otxt$ + CH$
END IF

IF Q <= (ll) THEN
  Q = Q + 1

END IF


LOOP UNTIL CH$ = CHR$(13) OR CH$ = ":" OR CH$ = "," OR CH$ = CHR$(34) OR CH$ = CHR$(32) OR Q >= (ll)

END IF

END SUB

SUB LDPROGRAM (P1$)
REM
REM LOADS PROGRAM INTO INTEGER BASIC
REM
CLS
Z$ = P1$




IF RIGHT$(Z$, 4) <> ".COB" THEN Z$ = Z$ + ".COB"


PRINT " getting :"; Z$

OPEN Z$ FOR INPUT AS #8
x = 1
DO
 PRINT A$

 IF EOF(8) = FALSE THEN LINE INPUT #8, A$

 PROGRAMARRY$(x) = A$


 x = x + 1
LOOP UNTIL EOF(8)


CLOSE #8
   PROGLENGTH = x



END SUB

SUB LEAVEOS9 (WORD$)

END SUB

SUB lstprog
 
 PRINT PROGLENGTH

FOR x = 1 TO (PROGLENGTH)

  TXT$ = PROGRAMARRY$(x)
  IF TXT$ <> "" THEN
   PRINT x, TXT$
  END IF
 A$ = INKEY$

 IF A$ = CHR$(32) THEN SLEEP



NEXT x
SLEEP

END SUB

SUB MODELPROC (TEXT$)

 IF TEXT$ <> "" THEN

 TEXT$ = UCASE$(TEXT$)

 IF RIGHT$(TEXT$, 1) <> " " THEN TEXT$ = TEXT$ + " "

 WORD$ = ""
 L = LEN(TEXT$)
 x = 1
 CALL gnpart(TEXT$, otxt$, Q): WORD$ = otxt$
 REST$ = RIGHT$(TEXT$, L - Q + 1)
 CALL gnpart(TEXT$, otxt$, Q): P1$ = otxt$
 CALL gnpart(TEXT$, otxt$, Q): P2$ = otxt$
 CALL gnpart(TEXT$, otxt$, Q): P3$ = otxt$
 CALL gnpart(TEXT$, otxt$, Q): P4$ = otxt$
 CALL gnpart(TEXT$, otxt$, Q): P5$ = otxt$
 CALL gnpart(TEXT$, otxt$, Q): P6$ = otxt$
 CALL gnpart(TEXT$, otxt$, Q): P7$ = otxt$
 CALL gnpart(TEXT$, otxt$, Q): P8$ = otxt$


   V1 = VAL(P1$)
   V2 = VAL(P2$)
   V3 = VAL(P3$)
   V4 = VAL(P4$)
   V5 = VAL(P5$)
   V6 = VAL(P6$)
   V7 = VAL(P7$)
   V8 = VAL(P8$)

  
  LNV = VAL(WORD$)
  IF LNV > 0 OR WORD$ = "0" THEN
  PROGRAMARRY$(LNV) = REST$

  IF LNV > (PROGLENGTH) THEN PROGLENGTH = LNV

  END IF
 

'PRINT WORD$, V1
 'SLEEP

 SELECT CASE (WORD$)

 CASE IS = "CLS", "HOME"
 CLS


 CASE IS = "NEW"
 FOR LX = 0 TO (200)

 PROGRAMARRY$(LX) = ""

 NEXT LX

  PROGLENGTH = 0

 CASE IS = "PRINT", "?"
  PRINT P1$

 CASE IS = "LIST"
 CALL lstprog
 CASE IS = "QBMENU"
  RUN ROOT$ + "QBMENU.BAS"

 CASE IS = "HELP"
  PRINT "### HELP ####"
  PRINT ""
  PRINT ""

 CASE IS = "TI994A"
  RUN ROOT$ + "TI994A.BAS"


 CASE IS = "LPT1WRITE"
  OPEN "FLPT1.DAT" FOR OUTPUT AS #8
  LP1 = 1

 CASE IS = "LPT1READ"
  OPEN "FLPT1.DAT" FOR INPUT AS #8

 CASE IS = "LPT1PURG"
  CLS
  PRINT "# EXITING ROUTINE GOES HERE"
  PRINT "#  "
  PRINT "#   "
      
      'CALL SAVESET
      
        SLEEP 1
  RUN ROOT$ + "LPT1PURG.BAS"



 CASE IS = "COCO2"
  CLS
  PRINT "############"
  PRINT "# COCO 2 ###"
  PRINT "############"
   SLEEP 1
   RUN ROOT$ + "QBMENU.BAS"

 CASE IS = "AUDIO"

   EQ = 1



 CASE IS = "CLS", "TEXT", "AUDIO"
      TEXTSHOW = 1


 CASE IS = "NOTEXT"
 TEXTSHOW = 0


 CASE IS = "HELP"

           

  PROMPT$ = PROMPT$ + "----------- HELP ----------- " + CR$
  PROMPT$ = PROMPT$ + "Beep tone print" + CR$
  PROMPT$ = PROMPT$ + "goto com1 com2 " + CR$
  PROMPT$ = PROMPT$ + "              CirCle Pset " + CR$
  PROMPT$ = PROMPT$ + "              line   Box " + CR$



 CASE IS = "CIRC"


 CASE IS = "DUAL"
  OPEN "COM1:19200,N,8,1" FOR RANDOM AS #1
  DUAL = 1

 CASE IS = "TONOFF", "QUIT", "HALT"

 TON1 = 0
 TON2 = 0
 TON3 = 0
 TON4 = 0

 CASE IS = "TONE"
  TON1 = V1
 CASE IS = "TONE1"
  TON2 = V1
 CASE IS = "TONE2"
  TON3 = V1
 CASE IS = "TONE3"
  TON4 = V1
 CASE IS = "TONE4"
  TON5 = V1
 CASE IS = "TONE5"
  TON6 = V1

 CASE IS = "ADDWORD"
  'CALL BUILDHBASE
 CASE IS = "HEB"

  htext$ = P1$
 CASE IS = "L", "LINE"

 

IF DUAL = 1 THEN

PRINT #1, "L" + STR$(V1) + STR$(V2) + STR$(V3) + STR$(V4) + STR$(V5) + CHR$(13)
DO

 IF LOC(1) <> 0 THEN INPUT #1, A$


LOOP UNTIL LOC(1) = 0 AND A$ = "GO"



END IF

 CASE IS = "CIRCLE", "CIRC", "C"
    CIRCLE (V1, V2), V3, V4

IF DUAL = 1 THEN

PRINT #1, "C" + STR$(V1) + STR$(V2) + STR$(V3) + STR$(V4) + CHR$(13)
DO

 IF LOC(1) <> 0 THEN INPUT #1, A$


LOOP UNTIL LOC(1) = 0 AND A$ = "GO"



END IF

 CASE IS = "CAD"
 CLOSE #1
 OPEN ROOT$ + "CADOBJ.DAT" FOR OUTPUT AS #1
 PRINT "BUILDING CAD DATA"

 PRINT #1, swth / 2
 PRINT #1, shht / 2
 PRINT #1, CHR$(34) + P1$ + CHR$(34)
 CLOSE #1
 CHAIN ROOT$ + "QBCAD.BAS"


 CASE IS = "BASIC"
 CALL LEAVEOS9(WORD$)

 CASE IS = "GOTO"
  LNGOTO = VAL(P1$)

 CASE IS = "RUN"

  CALL PROGRUN
 
 CASE IS = "SAVE"
  CALL SVPROGRAM(P1$)


 CASE IS = "LOAD"
  CALL LDPROGRAM(P1$)


 CASE IS = "SAY"
 'speaker (P1$)
   CLS
 CASE IS = "AUXOUT"
  IF auxsp > 0 THEN PRINT #12, P1$


 CASE IS = "EXIT", "REBOOT"

  'CALL SAVESET
     

  CLS

  PRINT " REBOOT WILL TAKE YOU TO CoCoROM"
  INPUT " EXIT TO DOS OR MS WINDOWS "; choice$

   choice$ = UCASE$(choice$)

   SELECT CASE (choice$)
    CASE IS = "DOS"
    SYSTEM

    CASE IS = "REBOOT"
    CLS
    PRINT "GOING INTO COCO ROM"
    PRINT "PLEASE WAIT..."
 
    RUN "C:\QBASIC\COCOROM.BAS"

   END SELECT


 CASE IS = "QBASIC"
  CLS

  PRINT " EXITING TO QBASIC ... "
  END
 CASE IS = "SCREEN"
  SCREEN VAL(P1$)

 CASE IS = "LPRINT"
     IF LP1 = 1 THEN PRINT #8, SUFFIX$

 IF prnbr = 0 THEN LPRINT P1$

 SELECT CASE (prnsd$)
 CASE IS = "S"
 prnouttext$ = P1$
 CASE IS = "P"
 LPRINT P1$


 CASE IS = "CLS"
 CLS

 CASE IS = "COPYOS"
 RUN "c:\qbasic\cocorom.bas"



 CASE IS = "SCREENSAVER"
  RUN "c:\qbasic\SCREENS.BAS"


 CASE IS = "VGA"
 'CALL VGA

 CASE IS = "REMOTE"
  'CALL REMOTE

 CASE IS = "LIST"

  CALL lstprog
  IF P1$ <> "" THEN CALL FILELIST(P1$)
 CASE IS = "RS232", "MODEM"
   'CALL RS232



 END SELECT


 CASE IS = "CLOCK"
 CLS
 PRINT " getting clock ...."
 PRINT "       please wait"
 'CALL diskgr
 RUN "C:\QBASIC\clock1.bas"



 CASE IS = "BEEP"
 BEEP
 CASE IS = "FILES"
   CHDIR "C:\QBASIC"

   SHELL "DIR *.COB"
   SLEEP

 CASE IS = "DIR"
 CLS
 FILES
 SLEEP
 CLS
 CASE IS = "DISKCOPY"
 RUN "C:\QBASIC\DISKCOPY.BAS"

 CASE IS = "PLAY"
  PLAY P1$

 CASE IS = "SHELL"
  SHELL P1$
  PRINT " ### DONE  ### "

  SLEEP
  CLS
  PRINT "PLEASE WAIT..."

  CASE IS = "WINDOWS", "GUI", "OS9"
  RUN "C:\QBASIC\QBWIN01.BAS"

 CASE IS = "DRAW"
  DRAW P1$


 CASE IS = "DDRAW"

  OPEN ROOT$ + P1$ + ".DRW" FOR INPUT AS #1
   INPUT #1, A$
  
    
   DRAW "BM0,0BR" + STR$(V2) + "BD" + STR$(V3) + "C" + STR$(V4) + A$

  CLOSE #1
 CASE IS = "FILES"
  SHELL "DIR/W *.DRW"


 END SELECT




 TEXT$ = ""
 ' 10, 1: PRINT STRING$(20, " ")

END IF
END SUB

SUB PROGRUN
REM
REM
REM RUN THE PROGRAM

XX = 1
BREAK = 0

DO
IF LNGOTO > 0 THEN XX = LNGOTO: LNGOTO = 0
 A$ = INKEY$
IF A$ = CHR$(0) + CHR$(134) THEN BREAK = 1: PRINT : PRINT "BREAK AT LINE "; XX

 CMD$ = PROGRAMARRY$(XX)

 

 'PRINT "### {"; CMD$; "}"
 CALL MODELPROC(CMD$)
 


 XX = XX + 1
LOOP UNTIL BREAK = 1 OR XX >= 1000 OR XX > (PROGLENGTH)




SLEEP

END SUB

SUB SVPROGRAM (P1$)


PRINT "PROGRAM LENGTH"
PRINT PROGLENGTH

Z$ = P1$

IF RIGHT$(Z$, 4) <> ".COB" THEN Z$ = Z$ + ".COB"

OPEN "c:\qbasic\" + Z$ FOR OUTPUT AS #9
x = 1
DO

 PRINT #9, PROGRAMARRY$(x)
  x = x + 1
LOOP UNTIL x > (PROGLENGTH)

CLOSE #9

PRINT "DONE"
PRINT " SAVING "; Z$

SLEEP
END SUB

