DECLARE SUB COCOSYS ()
DECLARE SUB gnpart (cmd$, otxt$, q!)
DECLARE SUB cexec (P1$)
DECLARE SUB LEAVE (name$)
DECLARE SUB systone (suffix$)
DECLARE SUB ext ()
DECLARE SUB MAKENEW ()
DECLARE SUB clprompt ()
DECLARE SUB mouse (m!)
DECLARE SUB CLICKNOISE ()
DECLARE SUB CHARACTER (x, y, CH$, c, SIZE)
DECLARE SUB MOVEWINDOW (h, v)
DECLARE SUB hekey (HX, HV, RCH$)
DECLARE SUB PROGRUN ()
DECLARE SUB SVPROGRAM (suffix$)
DECLARE SUB CUT32 (W$)
DECLARE SUB lstprog ()
DECLARE SUB LDPROGRAM (suffix$)
DECLARE SUB SPEAKER (pa$)
DECLARE SUB crappynoise ()
DECLARE SUB COPYOS ()
DECLARE SUB VGA ()
DECLARE SUB upgrade ()
DECLARE SUB modemsettings ()
DECLARE SUB REMOTE ()
DECLARE SUB rs232 ()
DECLARE SUB UPDPROMPT ()
DECLARE SUB FILELIST (suffix$)
DECLARE SUB diskgr ()
DECLARE SUB OSERR (z!)
DECLARE SUB PROCTEXT (text$)
DECLARE SUB vgamode ()
REM
REM OPPERATING SYSTEM PROMPT
REM  Features include
REM disk opperatins
REM database
REM com ports
REM vga routines
REM basic interpriter *** <---Cool !!!


REM variables
 COMMON SHARED TIMEON
 COMMON SHARED swth
 COMMON SHARED shht
 COMMON SHARED root$
 COMMON SHARED scsvr' turns on or shuts off screen saver
 COMMON SHARED F1$
 COMMON SHARED KE$
 'ke$  used for keyboard input
 COMMON SHARED lt$'lt$ used with time to hold last read
 COMMON SHARED opp$'opp$ opperating system prompt also used in timing
 COMMON SHARED akb2'
 COMMON SHARED AKB1' used for aux keyboards
 COMMON SHARED text$
 ' time$ qbasic real time clock variable ##:##:## hr mn se
 COMMON SHARED oppv, ctxvar, LP1
 COMMON SHARED auxsp
 COMMON SHARED AUXTEXT$
 COMMON SHARED PROGLENGTH
 COMMON SHARED LNGOTO
 COMMON SHARED prnbr ' used for printer
 COMMON SHARED prnsd$
 COMMON SHARED prnouttext$' used to hold the temporary out text to lpt1
 COMMON SHARED HEADER' used to display header on 1 or off 0
 COMMON SHARED TONE, TONE0, TONE1, TONE2, TONE3, TONE4, TONE5, TONE6, TONE7

 COMMON SHARED SNDSP

 DIM SHARED PROGRAMARRY$(1000)

 LP1 = 0
 swth = 620
 shht = 200
 'OPEN "root.dat" FOR INPUT AS #1
 'LINE INPUT #1, a$
 'root$ = a$
 root$ = "f:\dos\qbasic\"



 ' text$ [ stores the opperating system prompt
 '       [ also talks to basic
 '
 '
 '
 scsvr = 0
 F1$ = CHR$(0) + CHR$(59)

 AKB1 = 0' USED TO TURN ON OR OFF THE AUX KEYBOARD
 TIMEON = 0' SET TO OFF

 CR$ = CHR$(13)

 CART1$ = "EXTENDED DOS " + CR$ + "SERIOL MODEM CARTRIGE"
 'CART1$ THIS IS CARTRIGE 1

REM disk variables
 '
 ' auxsp.set turns (on off) selects port for speech
 '
 '
 '
 '
 '
 '
 '
 '
REM ---- setup
  HEADER = 1
  ' get printer setup

ON ERROR GOTO noprintersetup:
OPEN root$ + "\printer.set" FOR INPUT AS #1

INPUT #1, prnbr
INPUT #1, prnsd$
prnsd$ = UCASE$(prnsd$)
prcart$ = "___"
IF prnbr > 0 THEN
 
  PRINT " make sure your printer is on ... hit <spacebar>"
  SOUND 100 + 200, 5
  SLEEP

  prcart$ = " printer on " + STR$(prnbr) + " " + prnsd$

 
  SELECT CASE (prnbr)
   CASE IS = 1
   OPEN "com1:19200,n,8,1" FOR RANDOM AS #5

   CASE IS = 2
   OPEN "com2:19200,n,8,1" FOR RANDOM AS #5


  END SELECT


  PRINT prcart$ + "is online .."

END IF

CLOSE #1

 
  ' get aux speech
  ON ERROR GOTO noauxsp:

  OPEN root$ + "\auxsp.set" FOR INPUT AS #1
   INPUT #1, auxsp
 
 
  CLOSE #1

    PRINT "##"; auxsp
    SLEEP
    IF auxsp = 0 THEN auxsp$ = "___"
    IF auxsp > 0 THEN
      IF auxsp <> (prnbr) THEN
     IF auxsp = 1 THEN
      auxsp$ = "soundspeechcart on port 1"
      OPEN "com1:19200,n,8,1" FOR RANDOM AS #12
     END IF
   
     IF auxsp = 2 THEN
      auxsp$ = "soundspeechcart on port 2"
      OPEN "com2:19200,n,8,1" FOR RANDOM AS #12
     END IF
   
    PRINT " speech aux online .."
     ELSE

     PRINT " you cannot use the same com port for printing and speech.."
     BEEP
     SLEEP
    
     END IF
    END IF


REM intro
SCREEN 0
COLOR 8, 2
CLS

REM begin
  CLS
  ON ERROR GOTO ER:
REM main loop
  SNDSP = .5

 DO
  
  CALL COCOSYS


   KE$ = ""
   CALL UPDPROMPT
  IF KE$ <> "" THEN LK = ASC(KE$): RK = ASC(RIGHT$(KE$, 1))
  LOCATE 20, 1: PRINT LK, RK

  REM <return>


  IF KE$ = CHR$(13) THEN
    KE$ = ""
   
   
    CALL clprompt
    CALL PROCTEXT(text$)
  END IF

   
  IF KE$ <> "" THEN
   ctxvar = 0
  
   
   IF KE$ = CHR$(0) + CHR$(59) THEN CALL vgamode
   IF KE$ = CHR$(0) + CHR$(94) THEN CALL upgrade
   IF KE$ = CHR$(0) + CHR$(106) THEN OPEN "COM1:19200,N,8,1" FOR RANDOM AS #4: AKB1 = 1: BEEP

   
  END IF
   

   REM "HEADER"
   LOCATE 1, 1
   
    IF HEADER = 1 THEN
    PRINT "RADIO SHACK A DIVISION OF TANDY PRESENTS"
    PRINT "EXTENDED COLOR BASIC FOR TANDY 1000"
    COLOR 0, 6
    PRINT "EMBEDDED CARTRIDGES >"; prcart$
    PRINT CART1$; " | "; CART2$; auxsp$
    COLOR 8, 2
    PRINT "< "; prnouttext$
   LOCATE 10, 1:
   END IF
   REM
   REM OPPERATING SYSTEM TEXT
   PRINT text$; : COLOR blkcol: PRINT CHR$(219); " ": COLOR 0
       
       
       
       
       
       
        tpx = tpx + 1
        IF tpx > 3 THEN
          blkcol = blkcol + 1: IF blkcol > 16 THEN blkcol = 0
           tpx = 0
        END IF
 



 LOOP UNTIL KE$ = CHR$(27)

REM <esc> ends the loop ascii 27

REM end

END

ER:

z = ERR

CALL OSERR(z)


text$ = " ERROR " + STR$(ERR)

WORD$ = ""
suffix$ = ""
KE$ = ""

RESUME



noauxsp:
PRINT " ok wait while i build the aux speech ..."
 

OPEN root$ + "\auxsp.set" FOR OUTPUT AS #1
PRINT #1, 0
CLOSE



RUN


noprintersetup:
CLOSE
CLS

PRINT " PRINTER error..."; ERR
PRINT " R restart"
PRINT " B build printer data"
PRINT " ROM to change settings"
INPUT ":"; CH$
CH$ = UCASE$(CH$)


SELECT CASE (CH$)
CASE IS = "ROM"
CALL LEAVE(root$ + "cocorom.bas")

CASE IS = "R"
RUN

CASE IS = "B"
OPEN root$ + "printer.set" FOR OUTPUT AS #1

PRINT #1, 0
PRINT #1, "null"
CLOSE #1

END SELECT


RUN

SUB cexec (P1$)
    P1$ = UCASE$(P1$)

SELECT CASE (P1$)
CASE IS = "&HE010"
CALL rs232




END SELECT


END SUB

SUB CHARACTER (x, y, CH$, c, SIZE)

 MX = MOUSEXPOS
 MY = MOUSEYPOS

  IF BU = -1 AND MX > (x) AND MY > (y) AND MX < (x + 10) AND MY < (y + 10) THEN text$ = text$ + CH$



 DRAW "BM 0,0S4BR" + STR$(x) + "BD" + STR$(y) + "C" + STR$(c)
 DRAW "S" + STR$(SIZE)



SELECT CASE (CH$)
 CASE IS = ";'"
  DRAW "D3R2L2U3R6D8"
 CASE IS = ","
  DRAW "BD8R1U6D1R4D4F2"


 CASE IS = "."
  DRAW "R2D8U4E4"
 
 CASE IS = "A"
  DRAW "BD2D6R3U8L2R2D8R2U8"
 CASE IS = "B"
  DRAW "BR3R2D8L4"
 CASE IS = "C"
  DRAW "BR2R2D8R1L4"
 CASE IS = "D"
  DRAW "BR2R3D8U2L1D1L1D1"
 CASE IS = "E"
  DRAW "R6D4L2D1L1D3U6"
 CASE IS = "F"
  DRAW "R6D8L6"
 CASE IS = "G"
  DRAW "R2D8L2R2U1R2D1R2U8"
 CASE IS = "H"
  DRAW "BR3R2D2"
 CASE IS = "I"
  DRAW "BF1R2BD2D4"
 CASE IS = "J"
  DRAW "ND8R6D8"

 CASE IS = "K"
  DRAW "D1R6D6L4D1"

 CASE IS = "L"
  DRAW "R6D9"
  'LINE (x, y)-(x + 6, y), C
  'LINE -(x + 6, y + 9), C
 CASE IS = "M"
  DRAW "BD2F3E3G3F3L6"
 CASE IS = "N"
  DRAW "R6D7L4BD1BL2U6"

 CASE IS = "O"
  DRAW "R6D8L6U8"

  'LINE (x, y)-(x + 6, y + 8), C, B
 CASE IS = "P"
  DRAW "D3U3R6D8L6"

 CASE IS = "Q"
 CASE IS = "R"
 DRAW "BR2R4D4"

 CASE IS = "S"
  DRAW "R6L2D8"
 CASE IS = "T"
  DRAW "BD2D4BU6F6BU2U4"
 CASE IS = "U"
  DRAW "BR3R3L1D8"
 CASE IS = "V"
  DRAW "BD8U6BU2R6D8"

 CASE IS = "W"

 CASE IS = "X"

  DRAW "D5F3E3U5L6"
 CASE IS = "Y"
  DRAW "BD1D7R5U8G3"
 CASE IS = "Z"
  DRAW "BD2BR2R4L2D6"


END SELECT


 DRAW "S4"
END SUB

SUB CLICKNOISE



  FOR s = 400 TO 380 STEP -2

  SOUND 100 + s, .05

  NEXT s

END SUB

SUB clprompt



IF HEADER = 1 THEN LOCATE 10, 1
IF HEADER = 0 THEN LOCATE 1, 1

FOR a = 1 TO 10
PRINT STRING$(79, " ")

NEXT a




END SUB

SUB COCOSYS
   IF TONE0 <> 0 THEN
    SOUND 100 + TONE0, SNDSP
   END IF
   
   IF TONE1 <> 0 THEN
    SOUND 100 + TONE1, SNDSP
   END IF
 
   IF TONE2 <> 0 THEN
    SOUND 100 + TONE2, SNDSP
   END IF
   
   IF TONE3 <> 0 THEN
    SOUND 100 + TONE3, SNDSP
   END IF
 
   IF TONE4 <> 0 THEN
    SOUND 100 + TONE4, SNDSP
   END IF
 
   IF TONE5 <> 0 THEN
    SOUND 100 + TONE5, SNDSP
   END IF
 
   IF TONE6 <> 0 THEN
    SOUND 100 + TONE6, SNDSP
   END IF
 
   IF TONE7 <> 0 THEN
    SOUND 100 + TONE7, SNDSP
   END IF

END SUB

SUB COPYOS

INPUT "DRIVE TO COPY TO"; D$


SHELL "COPY C:QBMENU.BAS " + D$ + ":"



END SUB

SUB crappynoise

 s = 0
 DO

 SOUND 100 + s, .5
 SOUND 100 + 20, .5

 SOUND 2000 + 5, .05
 s = s + 1
 LOOP UNTIL s = 20
 
END SUB

SUB CUT32 (W$)
x = 1
L = LEN(W$)
DO
CH$ = MID$(W$, x, 1)

IF CH$ <> CHR$(32) THEN a$ = a$ + CH$

x = x + 1
LOOP UNTIL x >= (L)

W$ = a$

END SUB

SUB diskgr

GRN = 2

LINE (150, 10)-(420, 190), 0, BF
LINE (170, 30)-(390, 170), GRN, B




END SUB

SUB ext
 
  CALL systone("exit")

  CLS

  PRINT " < typewriter > opens the type writer program "
  PRINT " < PF         > print file is a file print utility "
  PRINT " < REBOOT > WILL TAKE YOU TO CoCoROM"
  INPUT " < EXIT   > TO DOS OR MS WINDOWS "; choice$

   choice$ = UCASE$(choice$)

   SELECT CASE (choice$)
    CASE IS = "PF", "TYPWRITER", "TW"
    
     CLS
     PRINT "..."
     PRINT " leaving coco 2 "
     PRINT "..."
     PRINT " opening type writer "

     RUN root$ + "cocotype.bas"


    CASE IS = "DOS"
    SYSTEM

    CASE IS = "REBOOT"
    CLS
    PRINT "GOING INTO COCO ROM"
    PRINT "PLEASE WAIT..."

    CALL LEAVE(root$ + "\COCOROM.BAS")

   END SELECT

END SUB

SUB FILELIST (suffix$)

REM
REM
REM SHOWFILE
 name$ = suffix$


 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
CLS
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 hekey (HX, HV, RCH$)
  'KE$ = INKEY$
  IF BU = -1 AND MX > (HX) AND MX < (HX + 5) AND MY > (HV) AND MY < (HV + 5) THEN CALL MOVEWINDOW(HX, HV)



  h = HX
  v = HV
  hsi = 250: vsi = 150



  LINE (h, v)-(h + hsi, v + vsi), 7, B
LINE (h - 2, v - 2)-(h + hsi + 2, v + vsi + 2), 7, B

  LINE (h, v)-(h + 5, v + 5), blkcol, BF

   x = h + 30
   y = v + 1
   SIZE = 5
   c = 7

   CALL CHARACTER(x, y, "E", c, SIZE)
   CALL CHARACTER(x + 10, y, "R", c, SIZE)
   CALL CHARACTER(x + 20, y, "T", c, SIZE)
   CALL CHARACTER(x + 30, y, "Y", c, SIZE)
   CALL CHARACTER(x + 40, y, "U", c, SIZE)
   CALL CHARACTER(x + 50, y, "I", c, SIZE)
   CALL CHARACTER(x + 60, y, "O", c, SIZE)
   CALL CHARACTER(x + 70, y, "P", c, SIZE)
   CALL CHARACTER(x - 10, y + 20, "A", c, SIZE)
   CALL CHARACTER(x, y + 20, "S", c, SIZE)
   CALL CHARACTER(x + 10, y + 20, "D", c, SIZE)
   CALL CHARACTER(x + 20, y + 20, "F", c, SIZE)
   CALL CHARACTER(x + 30, y + 20, "G", c, SIZE)
   CALL CHARACTER(x + 40, y + 20, "H", c, SIZE)
   CALL CHARACTER(x + 50, y + 20, "J", c, SIZE)
   CALL CHARACTER(x + 60, y + 20, "K", c, SIZE)
   CALL CHARACTER(x + 70, y + 20, "L", c, SIZE)
   CALL CHARACTER(x + 80, y + 20, ";", c, SIZE)
   CALL CHARACTER(x, y + 40, "Z", c, SIZE)
   CALL CHARACTER(x + 10, y + 40, "X", c, SIZE)
   CALL CHARACTER(x + 20, y + 40, "C", c, SIZE)
   CALL CHARACTER(x + 30, y + 40, "V", c, SIZE)
   CALL CHARACTER(x + 40, y + 40, "B", c, SIZE)
   CALL CHARACTER(x + 50, y + 40, "N", c, SIZE)
   CALL CHARACTER(x + 60, y + 40, "M", c, SIZE)
   CALL CHARACTER(x + 70, y + 40, ",", c, SIZE)
   CALL CHARACTER(x + 80, y + 40, ".", c, SIZE)









































   MX = MOUSEXPOS: MY = MOUSEYPOS




END SUB

SUB LDPROGRAM (suffix$)
REM
REM LOADS PROGRAM INTO INTEGER BASIC
REM
CLS
z$ = suffix$




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 LEAVE (name$)
 
 CHDIR root$

CLS
PRINT "exiting coco 2 going to " + name$
SLEEP
CALL systone("exit")
SLEEP 1
RUN name$




END SUB

SUB lstprog
 CLS
 PRINT PROGLENGTH

FOR x = 1 TO (PROGLENGTH)

  PRINT x, PROGRAMARRY$(x)

 a$ = INKEY$

 IF a$ = CHR$(32) THEN SLEEP



NEXT x
SLEEP
CLS
END SUB

SUB MAKENEW

FOR x = 1 TO (PROGLENGTH)


PROGRAMARRY$(x) = ""


NEXT x
PROGLENGTH = 1

PRINT "MEMORY EMPTY..."

BEEP

END SUB

SUB modemsettings

REM self explanatory
REM   change the baud parity port ect
REM





END SUB

SUB mouse (m)



END SUB

SUB MOVEWINDOW (h, v)

CALL CLICKNOISE

DO
IF mspresent = 1 THEN CALL mouse(3)


'CALL CUBE(MX, MY)




LOOP UNTIL MOUSELEFTBUTTON = 0


h = MOUSEXPOS
v = MOUSEYPOS
 CLS
END SUB

SUB OSERR (z)

LOCATE 10, 1

FOR h = 1 TO 5

PRINT STRING$(79, " ")

NEXT h
LOCATE 10, 1
PRINT "ERROR >"; z

SELECT CASE (z)
CASE IS = 1
MESS$ = " NEXT WITHOUT FOR"

CASE IS = 2
MESS$ = " SYNTAX ERROR"

CASE IS = 3
MESS$ = " RETURN WITHOUT GOSUB"

CASE IS = 4
MESS$ = "OUT OF DATA"

CASE IS = 5

MESS$ = "ILLEAGLE FUNCTION CALL"

CASE IS = 6
MESS$ = "OVERFLOW"

CASE IS = 7
MESS$ = "OUT OF MEMORY"

CASE IS = 8

MESS$ = "LABEL NOT DEFINED"

CASE IS = 9

MESS$ = "SUBSCRIPT OUT OF RANGE"

CASE IS = 10

MESS$ = "DUPLICATE DEFINITION"

CASE IS = 11

MESS$ = "DIVISION BY ZERO"

CASE IS = 12

MESS$ = "ILLEAGLE IN DIRECT MODE"

CASE IS = 13

MESS$ = "TYPE MISMATCH"

CASE IS = 14

MESS$ = "OUT OF STRING SPACE"

CASE IS = 15

MESS$ = "YOUR GUESS IS AS GOOD AS MINE ??"

CASE IS = 16

MESS$ = ""
CASE IS = 24
MESS$ = " device timeout "

CASE IS = 52
MESS$ = "BAD FILE NAME OR NUMBER"
CASE IS = 62
MESS$ = "INPUT PAST END OF FILE"

CASE IS = 64
MESS$ = "bad file name"


CASE IS = 68

MESS$ = "DEVISE UNAVAILABLE"


END SELECT


PRINT "  ##  ERROR "; MESS$


CALL crappynoise


SLEEP

INPUT " do you want to stop ? <y,n>"; ynb$

ynb$ = UCASE$(ynb$)

IF ynb$ = "YES" OR ynb$ = "Y" THEN

PRINT "going into Qbasic - bye !!!"


END
ELSE


RUN

END IF

CLS
END SUB

SUB pexit

REM
REM
'









END SUB

SUB PROCTEXT (text$)


 IF text$ <> "" THEN

 text$ = UCASE$(text$)
 'TEXT$ = TEXT$ + " "

 WORD$ = ""
 L = LEN(text$)
 x = 1
 CALL gnpart(text$, otxt$, q): WORD$ = otxt$
 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) = P1$

  IF LNV > (PROGLENGTH) THEN PROGLENGTH = LNV

  END IF
 

'PRINT WORD$, V1
 'SLEEP


 SELECT CASE (WORD$)
 CASE IS = "MODEL2"
  RUN root$ + "MODEL2.BAS"


 CASE IS = "TIMEOFF"
 CLS
 TIMEON = 0
 CASE IS = "TIMEON"
  TIMEON = 1
 CASE IS = "TONE"
  TONE = V1
 CASE IS = "TONE0"
  TONE0 = V1
 CASE IS = "TONE1"
  TONE1 = V1
 CASE IS = "TONE2"
  TONE2 = V1
 CASE IS = "TONE3"
  TONE3 = V1
 CASE IS = "TONE4"
  TONE4 = V1
 CASE IS = "TONE5"
  TONE5 = V1
 CASE IS = "TONE6"
  TONE6 = V1
 CASE IS = "TONE7"
  TONE7 = V1
 CASE IS = "BEEP"
 BEEP
 CASE IS = "TYPEWRITER"
  CALL ext

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


 CASE IS = "HELP"
  CLS
  CALL LEAVE("COCOHELP.BAS")


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

 CASE IS = "LPRINT"

 IF LP1 = 1 THEN PRINT #8, suffix$

 IF LP1 = 0 THEN LPRINT suffix$

 CASE IS = "CLS"
 CLS
 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 = "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 = "COPYOS"
 CALL COPYOS


 CASE IS = "SCREENSAVER"
 CALL LEAVE(root$ + "\SCREENS.BAS")


 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(root$ + "\clock1.bas")



 CASE IS = "BEEP"
 BEEP
 CASE IS = "FILES"
   CHDIR root$

   SHELL "DIR *.COB"
   SLEEP

 CASE IS = "DIR"
 CLS
 FILES
 SLEEP
 CLS
 CASE IS = "DISKCOPY"
 CALL LEAVE(root$ + "\DISKCOPY.BAS")

 CASE IS = "PLAY"
  PLAY suffix$


 CASE IS = "S"
 prnouttext$ = suffix$
 CASE IS = "P"
 LPRINT suffix$
 CASE IS = "PRINT", "?"
  PRINT suffix$



 CASE IS = "LPT1PURG"
  '
  '
  REM EXIT ROUTINE
       CLOSE #8
  CALL LEAVE(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"
  CALL LEAVE(root$ + "TICKER.BAS")


 CASE IS = "TI994A"
 CALL LEAVE(root$ + "TI994A.BAS")


 CASE IS = "CALC"

  CALL LEAVE(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 = "VGA"
 CALL VGA

 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(root$ + "\QBWIN01.BAS")

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


END SUB

SUB PROGRUN
REM
REM
REM RUN THE PROGRAM
CLS
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 PROCTEXT(cmd$)


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




SLEEP
CLS
END SUB

SUB REMOTE
CLOSE
CLS


INPUT "port 1 , 2 "; P
INPUT "basic on 1 or off 2"; B

portname$ = "COM" + STR$(P) + ":19200,8,N,1"
PRINT portname$
SLEEP
CLS

IF P = 1 THEN OPEN "com1:19200,n,8,1" FOR RANDOM AS #4
IF P = 2 THEN OPEN "com2:19200,n,8,1" FOR RANDOM AS #4
IF P > 0 THEN AKB1 = 1' SET AUX KEYBOARD 1 ON


DO
LOCATE 1, 1
PRINT " ### Remote ### up arrow to exit "; opp$
PRINT
PRINT text$; opp$



CALL UPDPROMPT




LOOP UNTIL KE$ = CHR$(0) + CHR$(72)

'CLOSE #4

END SUB

SUB rs232

CLS



DO
LOCATE 1, 1

PRINT " rs232 program pak "; opp$
PRINT "<1>      - change settings"
PRINT "<2>      - enter terminal mode"
PRINT "<3>      - enter teletype mode "
PRINT "<4>      - remote"
PRINT "<F1>     - go back to basic"




CALL UPDPROMPT



    SELECT CASE (KE$)
      CASE IS = "1"
      CALL modemsettings
     
      CASE IS = "4"
      CALL REMOTE



    END SELECT



LOOP UNTIL KE$ = CHR$(0) + CHR$(59)
CLS





END SUB

SUB SPEAKER (pa$)
'   +-----------------------------------------------------------------------+
'   ¦A1 Ale  ¦D1 Dig  ¦G1 Go   ¦J1 Jug  ¦O1 Over ¦R1 Real ¦U1 Usurp¦Y1 Yard ¦
'   ¦A2 Add  ¦D2 biD  ¦G2 Gem  +--------¦O2 Odd  ¦R2 evER ¦U2 Under¦Y2 monEY¦
'   ¦A3 Above¦D3 buDGE¦G3 baG  ¦K1 Key  ¦O3 nOt  ¦R3 veRy ¦U3 rUde ¦Y3 bAY  ¦
'   ¦A4 AUto +--------¦G4 siNG ¦K2 maKE ¦O4 shORt+--------¦U4 mUte ¦Y4 bOY  ¦
'  ¦A5 tAke ¦E1 Even +--------¦K3 sKate¦O5 bOOt ¦S1 Seem ¦U5 mUd  +--------¦
'   ¦A6 mAt  ¦E2 Ever ¦H1 Hut  +--------¦O6 bOAt ¦S2 miSS ¦U6 pUll ¦Z1 Zone ¦
'   ¦A7 cAr  ¦E3 bEt  ¦H2 WHale¦L1 Like ¦O7 wOOd ¦S3 SHy  ¦U7 hOUse¦Z2 buZZ ¦
'   ¦A8 sAW  ¦E4 wEll +--------¦L2 bowL ¦O8 lOUd ¦S4 waSH ¦U8 awfUL¦Z3 aZure¦
'   +--------¦E5 bEAt ¦I1 Irate¦L3 siLLy+--------+--------+--------+--------¦
'   ¦B1 Bad  ¦E6 hEEl ¦I2 Inane+--------¦P1 Pie  ¦T1 Tie  ¦V1 Very ¦SP short¦
'   ¦B2 daB  ¦E7 vERy ¦I3 tIp  ¦M1 May  ¦P2 naP  ¦T2 laTE ¦V2 aliVE¦   pause¦
'   +--------¦E8 nERd ¦I4 hId  ¦M2 huM  ¦P3 sPin ¦T3 THis +--------+--------¦
'   ¦C1 Cent +--------¦I5 sIte +--------+--------¦T4 baTHE¦W1 Witch¦LP long ¦
'   ¦C2 Case ¦F1 Fat  ¦I6 hIde ¦N1 Nice ¦        ¦T5 THing¦W2 WHich¦   pause¦
'   ¦C3 CHin ¦F2 halF ¦I7 thINK¦N2 saNE ¦Q1 QUeen¦T6 wiTH +--------+--------¦
'   ¦        ¦        ¦I8 thING¦        ¦        ¦        ¦X1 aXis ¦^Z exit ¦
'   +-----------------------------------------------------------------------+
 rword$ = ""
 PHR$ = pa$
 PHR$ = PHR$ + " "
 PHR$ = LCASE$(PHR$)
 reader = 0: wpb = 1: wpl = 1
'Get phrase size and check all letters
   lsize = LEN(PHR$)

   FOR lc = 1 TO lsize
   letr$ = MID$(PHR$, lc, 1)
   IF letr$ = CHR$(32) OR lc = (lsize) THEN WORD$ = MID$(PHR$, wpb, wpl): reader = 1
    rword$ = ""
    FOR chc = 1 TO LEN(WORD$): CH$ = MID$(WORD$, chc, 1): IF CH$ <> CHR$(32) THEN rword$ = rword$ + CH$
    NEXT chc

      wpl = wpl + 1 ' needed to prevent contiuous loop
' show Reader status in
'   IF reader = 0 THEN PRINT "Idle"

'   IF reader = 1 THEN PRINT "Reading"
WHILE reader = 1
    IF wpl > 2 THEN lltr$ = MID$(rword$, wpl - 2, 1)
   IF wpl > 2 THEN nlltr$ = MID$(rword$, wpl - 2, 1):

   WORD$ = WORD$ + " ": WORD$ = " " + WORD$
   ' Show the word being read in cell "e:6"

   FOR wc = 2 TO wpl + 1 ' Read entire word compinsating for character placement
   IF wpl > 2 THEN pltr$ = MID$(WORD$, wc - 1, 1)
   ltr$ = MID$(WORD$, wc, 1): nltr$ = MID$(WORD$, wc + 1, 1)
   ltva = VAL(ltr$)
' sgl stands for single letter
' the below 'if then' statement test to see if the word is a single letter
' sgl returns a 1 if true 0 if false
   pltv = VAL(pltr$): nltv = VAL(nltr$) ' get the number values of the character if present
   IF pltr$ = CHR$(32) AND nltr$ = CHR$(32) THEN sgl = 1 ELSE sgl = 0
   IF wpl - wc >= 3 THEN L3tr$ = MID$(WORD$, wc + 2, 1)
' show l3tr$ in cell ("b:3")


' below section of this macro accesses the speech fragments
' it is concerned with assembling speech for numbers
' and commonly used words under united states English western dilect


   lv = 0
  'check to see if word has long vowels "a,e,i,o,u"
   IF ltr$ = "a" OR ltr$ = "e" OR ltr$ = "i" OR ltr$ = "o" OR ltr$ = "u" OR ltr$ = "y" THEN cfv = 1: vowels = vowels + 1
    IF cfv = 1 THEN
 
   IF nltr$ = "a" OR nltr$ = "e" OR nltr$ = "i" OR nltr$ = "o" OR nltr$ = "u" THEN lv = 1: ntv = 1: moc = 1
   IF lltr$ = "a" OR lltr$ = "e" OR lltr$ = "i" OR lltr$ = "o" OR lltr$ = "u" OR lltr$ = "y" THEN lv = 1
   IF wc < wpl - 3 THEN IF ltr$ <> "o" AND nlltr$ = "a" OR nlltr$ = "e" OR nlltr$ = "i" OR nlltr$ = "o" OR nlltr$ = "u" THEN lv = 1

   'return check for vowel to zero hence cfv=0
   'cfv =1 if true 0 if false
   END IF

   cfv = 0
   IF rsword = 1 THEN ltr$ = rword$

   '         [[[[[[[[   ]]]]]]]]
   ' [[[[[[[[  standard letters ]]]]]]]
   '         [[[[[[[[   ]]]]]]]]

' PRINT ltr$ 'for testing purposes only
IF ltr$ = "y" AND sgl = 1 THEN say$ = "w1 i1": ltr$ = ""
IF ltr$ = "y" AND nltr$ = CHR$(32) THEN say$ = "e5": ltr$ = ""
'scope of "a"

   IF ltr$ = "a" AND sgl = 1 THEN say$ = "a1": ltr$ = ""

    ' a cont aeiou section
' Scope of "b"
   IF ltr$ = "b" AND sgl = 1 THEN say$ = "b1 e1"
    IF ltr$ = "b" AND sgl = 0 AND pltr$ = CHR$(32) THEN say$ = "b1"
    IF ltr$ = "b" AND sgl = 0 AND nltr$ = CHR$(32) THEN say$ = "b2"
 
    'scope of "c"
IF ltr$ = "c" AND sgl = 1 THEN say$ = "c1 e5": ltr$ = ""

IF ltr$ = "c" AND nltr$ = "k" THEN moc = 1: say$ = "c2": ltr$ = ""
IF ltr$ = "c" AND pltr$ = "s" THEN say$ = "c2": ltr$ = ""
IF ltr$ = "c" AND lv = 1 THEN say$ = "c1": ltr$ = ""
IF ltr$ = "c" AND rword$ = "nice" THEN say$ = "c1": ltr$ = ""
 IF ltr$ = "c" AND rword$ = "space" THEN say$ = "c1": ltr$ = ""
  IF ltr$ = "c" AND rword$ = "come" THEN say$ = "c2": ltr$ = ""
   IF ltr$ = "c" AND sgl = 1 THEN say$ = "c": ltr$ = ""
    IF ltr$ = "c" AND nltr$ = "h" THEN say$ = "ch": ltr$ = "": moc = 1' ch as in church
   
      IF ltr$ = "c" AND rword$ = "cell" THEN say$ = "c1": ltr$ = ""
       IF ltr$ = "c" AND ntv = 1 THEN say$ = "c1": ltr$ = ""
        IF ltr$ = "c" AND sgl = 0 AND ntv = 0 THEN say$ = "c1": ltr$ = ""
         IF ltr$ = "c" AND ntv = 1 THEN say$ = "c2": ltr$ = ""
          IF ltr$ = "c" AND sgl = 0 AND L3tr$ <> "t" THEN say$ = "c1": ltr$ = ""
           IF ltr$ = "c" AND nltr$ = "c" THEN moc = 1: say$ = "c2"


          
' scope of "d"
   IF ltr$ = "d" AND sgl = 1 THEN say$ = "d1 e1"
     IF ltr$ = "d" AND sgl = 0 THEN say$ = "d1"
' scope of "e"
   IF ltr$ = "e" AND sgl = 1 THEN say$ = "e1": ltr$ = ""
     ' e phonix at aeiou section
' scope of "f"
   IF ltr$ = "f" AND sgl = 1 THEN say$ = "e3 f1"
      IF ltr$ = "f" AND sgl = 0 THEN say$ = "f1"
' scope of "g"
  'PRINT ltr$
 IF ltr$ = "g" AND rword$ = "sign" THEN say$ = "": ltr$ = ""
  IF ltr$ = "g" AND pltr$ = "e" THEN say$ = "g1": ltr$ = ""
   IF ltr$ = "g" AND nltr$ = "r" THEN say$ = "g1": ltr$ = ""
    IF ltr$ = "g" AND pltr$ <> CHR$(32) AND nltr$ <> CHR$(32) THEN say$ = "g2": ltr$ = ""
     IF ltr$ = "g" AND sgl = 1 THEN say$ = "g2 e1"
      IF ltr$ = "g" AND sgl = 0 THEN say$ = "g1"
' scope of "h"
   IF ltr$ = "h" AND sgl = 1 THEN say$ = "a1 c3"
      IF ltr$ = "h" AND sgl = 0 THEN say$ = "h1" 'h as in horse
' scope of "i"
   IF ltr$ = "i" AND sgl = 1 THEN say$ = "i1": ltr$ = ""
' scope of "j"
   IF ltr$ = "j" AND sgl = 1 THEN say$ = "g2 a1"
      IF ltr$ = "j" AND sgl = 0 THEN say$ = "g2"
' scope of "k"
   IF ltr$ = "k" AND sgl = 1 THEN say$ = "c2 a1"
      IF ltr$ = "k" AND sgl = 0 THEN say$ = "c2"
' scope of "l"
   IF ltr$ = "l" AND sgl = 1 THEN say$ = "e2 l1"
      IF ltr$ = "l" AND sgl = 0 THEN say$ = "l2": REM  If nltr$ = "l" Then moc = 2
      IF ltr$ = "l" AND nltr$ <> CHR$(32) AND sgl = 0 THEN say$ = "l2": REM  If nltr$ = "l" Then moc = 2
  
   
   
      IF ltr$ = "l" AND nltr$ = "l" THEN moc = 1: say$ = "l1": REM  If nltr$ = "l" Then moc = 2


' scope of "m"
   IF ltr$ = "m" AND sgl = 1 THEN say$ = "i2 m2"
      IF ltr$ = "m" AND agl = 0 THEN say$ = "m2" ' m as in mouse
' scope of "n"
   IF ltr$ = "n" AND sgl = 1 THEN say$ = "i2 n1"
      IF ltr$ = "n" AND sgl = 0 THEN say$ = "n1"
' scope of "o"
   IF ltr$ = "o" AND sgl = 1 THEN say$ = "o1"
      ' o's phonixe cont at aeiou section
' scope of "p"
   IF ltr$ = "p" AND sgl = 1 THEN say$ = "p1 e1"
  IF ltr$ = "p" AND pltr$ = CHR$(32) AND nltr$ <> CHR$(32) THEN say$ = "p1": ltr$ = ""
  IF ltr$ = "p" AND pltr$ <> CHR$(32) AND nltr$ = CHR$(32) THEN say$ = "p2": ltr$ = ""

  IF ltr$ = "p" AND sgl = 0 THEN say$ = "p3": ltr$ = ""

' scope of "q"
   IF ltr$ = "q" AND sgl = 1 THEN say$ = "q"
      IF ltr$ = "q" AND sgl = 0 THEN say$ = "c2 a1"
' scope of "r"
   IF ltr$ = "r" AND sgl = 1 THEN say$ = "a4 r2"
      IF ltr$ = "r" AND sgl = 0 THEN say$ = "r2"
       IF ltr$ = "r" AND nltr$ = "r" THEN moc = 1
' scope of "s"

   IF ltr$ = "s" AND sgl = 1 THEN say$ = "s"
     IF ltr$ = "s" AND nltr$ = "h" THEN say$ = "sh": moc = 1: ltr$ = "" ' sh as in shack
      IF ltr$ = "s" AND sgl = 0 THEN say$ = "c1"

' scope of "t"
   IF ltr$ = "t" AND sgl = 1 THEN say$ = "t1"
    ' "th" as in the
     IF ltr$ = "t" AND nltr$ = "h" AND pltr$ = "" THEN moc = 1: say$ = "t3": ltr$ = ""' rem th
     IF ltr$ = "t" AND nltr$ = "h" THEN moc = 1: say$ = "t4": ltr$ = "" ' rem th
  
   
      IF ltr$ = "t" AND sgl = 0 THEN say$ = "t1"
       IF ltr$ = "t" AND nltr$ = "t" THEN moc = 1: ltr$ = ""

' scope of "u"
   IF ltr$ = "u" AND sgl = 1 THEN say$ = "y1 o5": ltr$ = ""
' scope of "v"
   IF ltr$ = "v" AND sgl = 1 THEN say$ = "v2 e5"
      IF ltr$ = "v" AND sgl = 0 THEN say$ = "v2"
' scope of "w"
   IF ltr$ = "w" AND sgl = 1 THEN say$ = "d2 u2 b2 l2 u1 o5"
      IF ltr$ = "w" AND sgl = 0 THEN say$ = "w1"
' scope of "x"
   IF ltr$ = "x" THEN say$ = "e2 c2 x1"
' scope of "y"

IF ltr$ = "y" AND pltr$ = "n" THEN say$ = "E5": ltr$ = ""
IF ltr$ = "y" AND sgl = 0 THEN say$ = "y1"
IF ltr$ = "y" AND rword$ = "by" THEN say$ = "i1": ltr$ = ""
 IF ltr$ = "y" AND nltr$ = CHR$(32) THEN say$ = "e5": ltr$ = ""
  IF ltr$ = "y" AND nltr$ = "e" THEN say$ = "y1": ltr$ = ""

   IF ltr$ = "y" AND rword$ = "you" THEN say$ = "y1 o5": ltr$ = "": wc = lsize: WORD$ = ""
 
    IF ltr$ = "y" AND nltr$ = "o" THEN say$ = "y1": ltr$ = ""
   
      IF ltr$ = "y" AND rword$ = "byte" THEN say$ = "i1": ltr$ = ""
       IF ltr$ = "y" AND sgl = 0 AND lv = 0 THEN say$ = "y1": ltr$ = ""
        IF ltr$ = "y" AND sgl = 1 THEN say$ = "w1 i1"
         IF ltr$ = "y" AND pltr$ <> CHR$(32) THEN say$ = "e5"

' scope of "z"
   IF ltr$ = "z" AND sgl = 1 THEN say$ = "z"
      IF ltr$ = "z" AND sgl = 0 THEN say$ = "s2"
' end of standard letters

' special phonix section 'a,e,i,o,u'
' vowel "a"
  IF ltr$ = "a" AND rword$ = "gates" THEN say$ = "a1": ltr$ = ""
   IF ltr$ = "a" AND rword$ = "have" THEN say$ = "a2": ltr$ = ""
    IF ltr$ = "a" AND rword$ = "start" THEN say$ = "R": ltr$ = ""
   
      IF ltr$ = "a" AND rword$ = "happy" THEN say$ = "a2": ltr$ = ""
       IF ltr$ = "a" AND lv = 1 AND nltr$ <> "r" THEN say$ = "a1": ltr$ = ""
        IF ltr$ = "a" AND nltr$ = "r" AND lv = 1 THEN say$ = "r": ltr$ = "": moc = 1
         IF ltr$ = "a" AND lv = 0 THEN say$ = "a2": ltr$ = ""
          IF ltr$ = "a" AND lltr$ = "e" THEN say$ = "a1": ltr$ = ""
           IF ltr$ = "a" AND sgl = 0 AND lltr$ <> "e" THEN say$ = "a1": ltr$ = ""
            IF ltr$ = "a" AND lv = 0 THEN say$ = "a2": ltr$ = ""



' vowel "e
 '  PRINT "lv "; lv

IF ltr$ = "e" AND pltr$ <> CHR$(32) AND nltr$ <> CHR$(32) AND sgl = 0 AND lv = 0 THEN say$ = "e2": ltr$ = ""
IF ltr$ = "e" AND rword$ = "me" THEN say$ = "e1": ltr$ = ""
IF ltr$ = "e" AND rword$ = "hello" THEN say$ = "e4": ltr$ = ""
IF ltr$ = "e" AND rword$ = "the" THEN say$ = "e": ltr$ = ""
 IF ltr$ = "e" AND rword$ = "zero" THEN say$ = "e": ltr$ = ""
  IF ltr$ = "e" AND rword$ = "error" THEN say$ = "a1": ltr$ = ""
   IF ltr$ = "e" AND rword$ = "welcome" AND pltr$ = "w" THEN say$ = "e1": ltr$ = ""
    IF ltr$ = "e" AND rword$ = "byte" THEN say$ = "": ltr$ = ""
     IF ltr$ = "e" AND rword$ = "here" AND pltr$ <> "r" THEN say$ = "e"
      IF ltr$ = "e" AND rword$ = "come" THEN say$ = "": ltr$ = ""
       IF ltr$ = "e" AND rword$ = "there" THEN say$ = "eee": ltr$ = ""
        IF ltr$ = "e" AND rword$ = "the" THEN say$ = "e": ltr$ = "":    ' force long e for "the"
         IF ltr$ = "e" AND ntv = 1 THEN say$ = "e1": ltr$ = ""
         IF ltr$ = "e" AND nltr$ = CHR$(32) AND lv = 1 THEN say$ = "": ltr$ = ""
          IF ltr$ = "e" AND nltr$ = CHR$(32) THEN say$ = "e1": ltr$ = ""
           IF ltr$ = "e" AND nltr$ = "r" THEN say$ = "": ltr$ = ""
            IF ltr$ = "e" AND lltr$ = "y" THEN say$ = "e1": ltr$ = ""
             IF ltr$ = "e" AND ntv = 0 AND nltr$ <> CHR$(32) THEN say$ = "e1": ltr$ = ""
              IF ltr$ = "e" AND nltr$ = "n" THEN say$ = "i2": ltr$ = ""
            
               IF ltr$ = "e" AND nltr$ = "r" THEN say$ = "e1": ltr$ = ""
                IF ltr$ = "e" AND wc < wpl AND pltr$ <> "p" AND lltr$ <> "o" AND lv = 1 THEN say$ = "e":  ltr$ = ""
                 IF ltr$ = "e" AND lv = 1 AND ntv = 1 AND wc < wpl AND pltr$ <> "P" AND lltr$ <> "o" THEN say$ = "e": ltr$ = ""
                  IF ltr$ = "e" AND lv = 1 AND sgl = 0 AND pltr$ <> "p" AND wc < wpl THEN say$ = "e1": ltr$ = ""
                   IF ltr$ = "e" AND lv = 0 THEN say$ = "e1": ltr$ = ""
                    IF ltr$ = "e" AND lv = 1 THEN say$ = "e1": ltr$ = ""
                  
                       'when all else fails long "e"




  ' vowel "i"
 IF ltr$ = "i" AND rword$ = "sign" THEN say$ = "i1": ltr$ = ""
  IF ltr$ = "i" AND rword$ = "hi" THEN say$ = "i1": ltr$ = "" ' force long i as in "hi"
   IF ltr$ = "i" AND ntv = 0 AND lv = 0 THEN say$ = "i2": ltr$ = ""
      IF ltr$ = "i" AND lv = 1 THEN say$ = "i1": ltr$ = ""

' vowel "o"
 IF ltr$ = "o" AND nltr$ = "t" THEN say$ = "o3": ltr$ = ""
 IF ltr$ = "o" AND rword$ = "do" THEN say$ = "o5 ": ltr$ = ""
  IF ltr$ = "o" AND nltr$ = "u" AND lltr$ <> "d" THEN say$ = "o5 ": moc = 1: ltr$ = ""
   IF ltr$ = "o" AND nltr$ = "u" THEN say$ = "a2": ltr$ = ""
    ' "OU" AS IN FOUND OR SOUND = FORCES AA.WAV
     IF ltr$ = "o" AND pltr$ = "c" AND lv = 0 THEN say$ = "aaa": ltr$ = ""
      IF ltr$ = "o" AND nltr$ = "m" THEN say$ = "u2 ": ltr$ = ""
       IF ltr$ = "o" AND rword$ = "come" THEN say$ = "o1"
        IF ltr$ = "o" AND rword$ = "tron" THEN say$ = "aaa": ltr$ = ""
         IF ltr$ = "o" AND nltr$ = "w" THEN say$ = "o8": ltr$ = ""
          IF ltr$ = "o" AND plltr$ = "z" THEN say$ = "o1": ltr$ = ""
           IF ltr$ = "o" AND nltr$ = "o" THEN say$ = "o5 ": ltr$ = ""
            IF ltr$ = "o" AND pltr$ = "t" THEN say$ = "o5 ": ltr$ = ""
             IF ltr$ = "o" AND nltr$ = CHR$(32) AND lv = 1 THEN say$ = "o1": ltr$ = ""
              ' o as in 'on'
               IF ltr$ = "o" AND pltr$ = CHR$(32) THEN say$ = "aaa": ltr$ = ""
                IF ltr$ = "o" AND lv = 1 AND nltr$ <> "o" AND ntv = 1 THEN say$ = "o1": ltr$ = ""
                 IF ltr$ = "o" THEN say$ = "o1"
' vowel "u"
  IF ltr$ = "u" AND rword$ = "yuck" THEN say$ = "u2": ltr$ = ""
  IF ltr$ = "u" AND lv = 0 THEN say$ = "u2 ": ltr$ = ""
  IF ltr$ = "u" AND rword$ = "stupid" THEN say$ = "o5 ": ltr$ = ""
  IF ltr$ = "u" AND rword$ = "user" THEN say$ = "u": ltr$ = ""

     IF ltr$ = "u" AND lv = 1 THEN say$ = "o5 ": 'leave open for next test of "u"






'   end of vowel section

     IF moc > 0 THEN wc = wc + moc: moc = 0
     IF wc > wpl THEN WORD$ = ""
   lv = 0
' end of special vowel "a,e,i,o,u" section

  IF wc >= wpl THEN reader = 0: ltr$ = "": rword$ = ""
  IF wpl = 1 THEN WORD$ = "": rword$ = "": ltr$ = ""

  ltr$ = ""
   text$ = text$ + say$ + " "
 '  PRINT say$
  say$ = ""
NEXT wc

 nlltr$ = "": wpl = 1: wpb = lc: ntv = 0: vowels = 0: lv = 0: L3tr$ = ""
 WEND
  NEXT lc


CHDIR "c:\pcspeak"


  OPEN "textf.txt" FOR OUTPUT AS #1
  PRINT #1, text$
  CLOSE #1
  cc = 0

SHELL "read.bat"





END SUB

SUB SVPROGRAM (suffix$)


z$ = suffix$

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

OPEN root$ + z$ FOR OUTPUT AS #9
x = 1
DO

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

CLOSE #9



END SUB

SUB systone (suffix$)

s$ = UCASE$(suffix$)

SELECT CASE (s$)
 CASE IS = "TP"
  SOUND 100 + 10, 1
  SOUND 120 + 20, 1
  SOUND 100, .5
  SOUND 150, .5
 CASE IS = "RING"
  

DO
c = c + 300
       SOUND 200 + c, .5
 IF c > 2000 THEN c = 10
  x = x + 1

LOOP UNTIL x > 120


CASE IS = "STOP"


SOUND 100 + 50, .5
SOUND 100, 2


CASE IS = "OPEN"

PLAY "abcdefg"

CASE IS = "EXIT"

FOR x = 1 TO 300 STEP 5
SOUND 100 + x, .1
NEXT x

FOR x = 300 TO 1 STEP -5
SOUND 100 + x, .1
NEXT x



END SELECT



END SUB

SUB UPDPROMPT
      IF TIMEON = 1 THEN
       LOCATE 1, 45
       PRINT TIME$

      END IF
       
     REM COM PORT STUFF
        IF prnouttext$ <> "" THEN
         IF prnbr <> 0 THEN
        
          'check to see if port is open
          PRINT #5, prnouttext$
          prnouttext$ = ""
         END IF
        END IF

        IF prnsd$ = "P" THEN
         IF LOC(5) > 0 THEN INPUT #5, a$
         IF a$ <> "" THEN LPRINT a$
         a$ = ""


        END IF


  REM handle the auxillary speech

  IF auxsp > 0 THEN
  
 
  LF = LOC(12)
   IF LF > 0 THEN INPUT #12, PHR$
    LOCATE 1, 50: PRINT "LOC"; LF
 
     IF PHR$ <> "" THEN
  
     AUXTEXT$ = AUXTEXT$ + PHR$
     v$ = RIGHT$(AUXTEXT$, 1)

     IF v$ = "." THEN
     CALL SPEAKER(AUXTEXT$): CLS
    AUXTEXT$ = ""
   END IF
  END IF
 END IF

  REM readkey board

   KE$ = INKEY$
   L = LEN(text$)
   IF KE$ = CHR$(8) THEN KE$ = "": IF L >= 1 THEN text$ = LEFT$(text$, L - 1)
  
   IF KE$ = CHR$(0) + CHR$(67) THEN scsvr = 0
   IF KE$ <> "" THEN
      ctxvar = 0
      IF AKB1 = 1 THEN
       
       
       
       
        IF KE$ = CHR$(0) + CHR$(77) THEN
            PRINT #4, CHR$(13)

         KE$ = ""
        END IF
        PRINT #4, KE$
      END IF

   END IF
  
   a$ = ""

   IF AKB1 = 1 THEN
  
    IF LOC(4) > 0 THEN
    LINE INPUT #4, a$
     IF a$ <> "" THEN KE$ = a$: ctxvar = 0
     IF a$ = "~" THEN KE$ = CHR$(13)

    END IF
 
   END IF
  
  

  IF TIME$ <> (lt$) THEN

  oppv = oppv + 1
 
  IF oppv = 1 THEN opp$ = CHR$(219)
  IF oppv > 1 THEN oppv = 0
  IF oppv = 0 THEN opp$ = " "
 
   lt$ = TIME$: ctxvar = ctxvar + 1
  
   REM we call the screen saver here

   IF ctxvar > 120 THEN
    IF scsvr = 1 THEN CALL LEAVE("screens")
   END IF
  END IF

 IF KE$ <> "" THEN text$ = text$ + KE$

END SUB

SUB upgrade


INPUT "from <A,B,ect> "; D$


SHELL "copy " + D$ + ":qbmenu.bas c:"
PRINT
PRINT
PRINT
PRINT " PRESS <SPACEBAR> TO CONTINUE..."

SLEEP
CLS

PRINT "  PLEASE WAIT ..."

CALL LEAVE("C:QBMENU.BAS")




END SUB

SUB VGA

REM
REM
REM FOR TANDY 1000,



SHELL "C:\VGA.BAT"


END SUB

SUB vgamode


 REM calls a dos program to set
 REM tandy 1000 to speacial vga text mode


SHELL "c:\vga13250.bat"
CLS


END SUB

