DECLARE SUB ext ()
DECLARE SUB cexec (suffix$)
DECLARE SUB PROC (TEXT$)
REM
REM
REM  ok now were getting main frame so sit back and get ready to juggle disks
REM  you should have all your disks for this program ready to go
' 2003


DIM SHARED PROGRAMARRY$(230)
ON ERROR GOTO er1:

root$ = "a:\"
OPEN root$ + "job1.do" FOR INPUT AS #1
INPUT #1, a$
CLOSE #1

CLS

PRINT "------------------------------------------------"
PRINT "-                                              -"
PRINT "-                                              -"
PRINT "------------------------------------------------"
LOCATE 2, 2: PRINT a$;
LOCATE 10, 1
a$ = UCASE$(a$)
IF a$ = "MENU" THEN

PRINT " this program works best if you have both drives a:\> and b:\> installed "
PRINT "  "
PRINT ""
      

SHELL "dir b/w"
SLEEP
END IF

    TEXT$ = a$

IF a$ <> "" THEN CALL PROC(TEXT$)
DO
PRINT root$
INPUT "COMMAND "; TEXT$

CALL PROC(TEXT$)

LOOP UNTIL TEXT$ = "EXIT"

END

er1:

CLOSE
OPEN root$ + "job1.do" FOR OUTPUT AS #1
PRINT #1, "menu"
CLOSE #1

PRINT "fixed a:\>"
SLEEP

RUN

SUB cexec (suffix$)
END SUB

SUB ext

PRINT
PRINT " exiting boot disk "
PRINT " <1>. CoCo2   "
PRINT " <2>. Ti994a   "
PRINT " <3>. apple ][   "
PRINT " <4>. Univac   "
INPUT " go into <1,2,3,4>"; n
IF n = 5 THEN RUN "c:\qbasic\cocorom.bas"

END SUB

SUB PROC (TEXT$)
 TEXT$ = UCASE$(TEXT$)
 IF TEXT$ <> "" THEN

 TEXT$ = UCASE$(TEXT$)

 'TEXT$ = TEXT$ + " "

 WORD$ = ""
 L = LEN(TEXT$)
 x = 1
 DO

 T$ = MID$(TEXT$, x, 1)

 IF T$ <> " " AND T$ <> CHR$(13) THEN
   WORD$ = WORD$ + T$

 END IF

 x = x + 1

 LOOP UNTIL T$ = CHR$(34) OR T$ = " " OR T$ = CHR$(13) OR x > (L)


  suffix$ = ""


  T$ = MID$(TEXT$, x, 1)
  IF T$ = CHR$(32) THEN x = x + 1

  DO

  T$ = MID$(TEXT$, x, 1)
   suffix$ = suffix$ + T$
  x = x + 1
  LOOP UNTIL x >= (L)

  'LOCATE 1, 45: PRINT SUFFIX$; "   "


  LNV = VAL(WORD$)
  IF LNV > 0 OR WORD$ = "0" THEN
  'BEEP
  'PRINT W$
  'PRINT WORD$

  'PRINT LNV; SUFFIX$

  'SLEEP
  PROGRAMARRY$(LNV) = suffix$
  END IF

  IF LNV > (PROGLENGTH) THEN PROGLENGTH = LNV

   PRINT suffix$



   'SLEEP


 SELECT CASE (WORD$)
 CASE IS = "SCANDISK"
 SHELL "SCANDISK"


 CASE IS = "SHOWDATE"
 NOTEPAD$ = DATE$

 CASE IS = "NOTE", "NOTEPAD"
 NOTEPAD$ = suffix$


 CASE IS = "TYPEWRITER"
  CALL ext

 CASE IS = "EXEC"
  CALL cexec(suffix$)


 CASE IS = "HELP"
  CLS
  RUN root$ + "COCOHELP.BAS"


 CASE IS = "SYSTONE"
  'CALL SYSTONE(suffix$)

 CASE IS = "LPRINT"

 IF LP1 = 1 THEN PRINT #8, suffix$

 IF LP1 = 0 THEN LPRINT suffix$

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

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



 CASE IS = "LPT1PURG"
  '
  '
  REM EXIT ROUTINE
       CLOSE #8
  RUN root$ + "LPT1PURG.BAS"

 CASE IS = "LPT1WRITE"
  CLOSE #8
  OPEN root$ + "FLPT1.DAT" FOR OUTPUT AS #8
  LP1 = 1
 CASE IS = "LPT1READ"
  OPEN root$ + "FLPT1.DAT" FOR INPUT AS #1
  LP1 = 2

 CASE IS = "TICKER"
  RUN root$ + "TICKER.BAS"


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


 CASE IS = "CALC"

  RUN root$ + "qbcalc.bas"




 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) + suffix$ + CHR$(34)
 CLOSE #1
 CHAIN root$ + "QBCAD.BAS"




 CASE IS = "NEW"
 'CALL MAKENEW

 CASE IS = "LIST"

   'CALL lstprog
  'IF SUFFIX$ <> "" THEN CALL FILELIST(SUFFIX$)

 CASE IS = "HEADER"
  HEADER = 1
 CASE IS = "HEADOFF"
 HEADER = 0
 CLS


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



 CASE IS = "CLS"
 CLS
 CASE IS = "RUN"

  'CALL PROGRUN

 CASE IS = "SAVE"
  'CALL SVPROGRAM(SUFFIX$)


 CASE IS = "LOAD"
  'CALL LDPROGRAM(SUFFIX$)


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


 CASE IS = "EXIT", "REBOOT"
   CALL ext


 CASE IS = "QBASIC"
  CLS

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


 CASE IS = "CLS"
 CLS

 CASE IS = "COPYOS"
 'CALL COPYOS


 CASE IS = "SCREENSAVER"
 'CALL LEAVE("c:\qbasic\SCREENS.BAS")


 CASE IS = "VGA"
 'CALL VGA

 CASE IS = "REMOTE"
  'CALL REMOTE

 CASE IS = "RS232", "MODEM"
   'CALL rs232




 CASE IS = "CLOCK"
 CLS
 PRINT " getting clock ...."
 PRINT "       please wait"
 'CALL diskgr
 'CALL LEAVE("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"
 'CALL LEAVE("C:\QBASIC\DISKCOPY.BAS")

 CASE IS = "PLAY"
  PLAY suffix$

 CASE IS = "DRAW"
  DRAW suffix$
 CASE IS = "SHELL"
  SHELL suffix$
  PRINT " ### DONE  ### "

  SLEEP
  CLS
  PRINT "PLEASE WAIT..."
  CASE IS = "OS9"
  'CALL LEAVE(ROOT$ + "qbos9.bas")

  CASE IS = "WINDOWS"
  'CALL LEAVE("C:\QBASIC\QBWIN01.BAS")


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















END SUB

