DECLARE SUB mouseclickarea (xxleft%, yytop%, areawidth%, height%, msgout$)
DECLARE SUB loadcartridge ()
DECLARE SUB osstartupmenu ()
DECLARE SUB linfo ()
DECLARE SUB McHSOD ()
DECLARE SUB loadsg ()
DECLARE SUB spmenu ()
DECLARE SUB Menu ()
DECLARE SUB iniscrn ()
DECLARE SUB clm ()
DECLARE SUB doscr ()
DECLARE SUB drsc ()
DECLARE SUB er ()
DECLARE SUB waitp ()
DECLARE SUB sec ()
DECLARE SUB retscr ()
DECLARE SUB playsg (cplc%)
DECLARE SUB mPP (HH%, VV%, H1%, V1%, note$, nt$, n%, o%, tim%, B%)
DECLARE SUB MUSICCOMPOSER ()
DECLARE SUB chsod (aaa%, bbb%, ccc%)
DECLARE SUB SetReg (Reg%, Value%)
DECLARE SUB playt (n%, octave%)
DECLARE SUB CUT34 (T$, OUTTEXT$)
DECLARE SUB GETVAL (VAR$, OUTVAR$)
DECLARE SUB PUTVAR (VAR$, PUTVAL$)
DECLARE SUB SHOWVAR ()
DECLARE SUB OSSTARTBAR ()
DECLARE SUB OSBUTTON (BTXT$, H%, V%, HBSIZE%, VBSIZE%, PRESS$)
DECLARE SUB ASCIITEST ()
DECLARE SUB buildprinttext (REST$, OUTTEXT$)
DECLARE SUB SAVESET ()
DECLARE SUB BUILDHBASE ()
DECLARE SUB MSGBOX (x%, y%, TXT$, msgout$)
DECLARE SUB lstprog ()
DECLARE SUB gnpart (cmd$, otxt$, Q%)
DECLARE SUB DRAWM (H%, V%, MCOLOR%)
DECLARE SUB clrstr ()
DECLARE SUB LEAVEOS9 (WORD$)
DECLARE SUB modemsettings ()
DECLARE SUB diskgr ()
DECLARE SUB RS232 ()
DECLARE SUB crappynoise ()
DECLARE SUB FILELIST (P1$)
DECLARE SUB OSERR (z%)
DECLARE SUB REMOTE ()
DECLARE SUB LDPROGRAM (P1$)
DECLARE SUB SVPROGRAM (P1$)
DECLARE SUB PROGRUN ()
DECLARE SUB speaker (pa$)
DECLARE SUB clprompt ()
DECLARE SUB upgrade ()
DECLARE SUB PROCTEXT (text$)
DECLARE SUB UPDPROMPT ()
DECLARE SUB CLBITMAP ()
DECLARE SUB NULWINDOW (NX%, NY%)
DECLARE SUB OSHEADER ()
DECLARE SUB HEBWINDOW (WX%, WY%)
DECLARE SUB HEBCHARACTER (x%, y%, CH$, c%, SIZE%)
DECLARE SUB HEBTEXT (x%, y%, TXT$, c%, SIZE%)
DEFINT A-Z
DECLARE SUB CHARACTER (x, y, CH$, c, SIZE)
DECLARE SUB movewindow (H%, V%, wc%)
DECLARE SUB Clicknoise ()
DECLARE SUB win (x%, y%, T$, wc%)
DECLARE SUB drawmouse (c%)
DECLARE SUB setjoymouse ()
DEFINT A-Z
DECLARE SUB setseriolmouse (c%)
DECLARE SUB getjoystick (MH%, MV%, MH1%, MV1%)
DECLARE SUB displaytext (x%, y%)
DECLARE SUB world ()
DECLARE SUB grmouse ()
DECLARE SUB grlayout ()
DECLARE SUB pointer (x!, y!, c!)
COMMON SHARED CR$
COMMON SHARED CX, DX, bx, bu
COMMON SHARED msh1, msv1
COMMON SHARED MHH, MVV, cur0, PROGRUNVAR' USED TO TURN ON THR RUN ROUTINE
COMMON SHARED TXT$, PROGRUNNAME$
COMMON SHARED mx, my
COMMON SHARED WINCOL
COMMON SHARED wht, wwt: REM (wht height) (wwt width)
COMMON SHARED FONTV, OSPROMPTON
COMMON SHARED BC
COMMON SHARED qbmo' 0 is set to off
COMMON SHARED MAIN$, root$, TEXTTOCRT$
COMMON SHARED blink, EQ, LP1, xlooplist, HOMEPROMPT

' rem basic
REM variables
 COMMON SHARED TON1, TON4, TON7
 COMMON SHARED TON2, TON5
 COMMON SHARED TON3, TON6


 COMMON SHARED scsvr' turns on or shuts off screen saver
 COMMON SHARED F1$
 COMMON SHARED ke$, PROMPT$
 '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, TCOL'
 COMMON SHARED AKB1' used for aux keyboards
 COMMON SHARED ltext$' used with osheader6
 COMMON SHARED text$

 ' time$ qbasic real time clock variable ##:##:## hr mn se
 COMMON SHARED oppv, ctxvar, TSPEED, udmain
 COMMON SHARED auxsp
 COMMON SHARED AUXTEXT$
 COMMON SHARED PROGLENGTH
 COMMON SHARED LNGOTO
 COMMON SHARED prnbr ' used for printer
 COMMON SHARED prnsd$
 COMMON SHARED lx, ly
 COMMON SHARED cxh, cyv
 COMMON SHARED prnouttext$' used to hold the temporary out text to lpt1
 COMMON SHARED swth, shht
 COMMON SHARED SPEED' used for cpu speed
 COMMON SHARED cart1$, cart2$
 COMMON SHARED ms$
 COMMON SHARED HEBTRANS$
 COMMON SHARED htext$, cur$
 COMMON SHARED DUAL, TEXTSHOW
 COMMON SHARED WX, WY, NX, NY, zzl, tppx, xlst


' REM #### USED FOR SOUNDCARD ####
CONST BaseAddr = &H220 'Change if your sound card uses another base address

CONST RegAddr = BaseAddr + 8, DataAddr = BaseAddr + 9
COMMON note$, nt$

 DIM SHARED songdb(100, 3)
 DIM SHARED programarry$(800)
 

 DIM SHARED VARARRY$(1000, 2)
'              ********************************************
'              *    ti994a 32 - bit                       *
'              ********************************************

'********************************* INI *************************************

    DEFINT A-Z
    DECLARE SUB MOUSE ()
    DECLARE SUB MousePointer (SW)
    DIM SHARED A(9)                 'Set up array for code
                                                          
    DEF SEG = VARSEG(A(0))          'Get array segment (nnnn:    )
                                    '    (two 8 bit)
    FOR i = 0 TO 17                 'length of DATA to
       READ r                       'read
       POKE VARPTR(A(0)) + i, r     'into array/2 (nnnn:iiii) (one 8 bit)
    NEXT i                          'until 17

'**************************** Machine Code *********************************

DATA &HB8,&H00,&H00   :   ' mov  AX,[n]       [Swap code-(L),(H)] in AX
DATA &H55             :   ' push BP           Save BP
DATA &H8B,&HEC        :   ' mov  BP,SP        Get BP to c Seg
DATA &HCD,&H33        :   ' int  33           Interrupt 33
DATA &H92             :   ' xchg AX,[reg]     [Swap code-reg] in AX
DATA &H8B,&H5E,&H06   :   ' mov  BX,[BP+6]    Point to (variable)
DATA &H89,&H07        :   ' mov  [BX],AX      Put AX in (variable)
DATA &H5D             :   ' pop  BP           Restore BP
DATA &HCA,&H02,&H00   :   ' ret  2            Far return

'*********************** P R O G R A M   S C R E E N ***********************
    SCREEN 12
 
  CLOSE
 
  'OPEN "root.dat" FOR INPUT AS #1
   'LINE INPUT #1, ROOT$
  'CLOSE #1
   root$ = "e:\dos\qbasic\"

  OSPROMPTON = 1 ' TURN ON PROMPT
  DUAL = 0
 PRINT " cpu speed"
 PRINT "  fast cpus are and higher 5-20"
 PRINT " slower Cpu's are 1-4"
 PRINT
 PRINT "cpu speed"
 INPUT " cpu "; VAR
 SELECT CASE (VAR)
 CASE IS = 1, 2, 3, 4
 SPEED = 10
 CASE IS = 5, 6, 7, 8, 9, 10
 SPEED = 900
 END SELECT

 PROMPT$ = "Texas Instraments Ti994a Basic 2002 " + CR$ + " ##"
 TXT$ = PROMPT$
 EQ = 0' SHUT EQ OFF
 TEXTSHOW = 1
 TSPEED = 1
 BC = 11
 qbmo = 1: REM turn off
     CALL CLBITMAP
     CALL clrstr


          
                CALL MousePointer(0)      'Reset mouse and
                CALL MousePointer(1)      'turn pointer on
                CALL MousePointer(3)      'Get coordinates

 cart1$ = ""
 cart2$ = ""
 'CART1$ THIS IS CARTRIGE 1

 ms$ = " hit spacebar"
 REM disk variables
 '
 ' auxsp.set turns (on off) selects port for speech

 'used for screen size
swth = 640: shht = 400
 REM ---- setup
 ' 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
    '
    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

 aaa = &HF1
 bbb = &HE4
 ccc = &HE4
 ddd = &H9D
 eee = &H9D

 CALL chsod(aaa, bbb, ccc)
  
  
  'n = 45: octave = 12
  'CALL playt(n, octave)

10 REM
CR$ = CHR$(13)
 wht = 100
 wwt = 200
 'NX = 50
 'NY = 300
 'WX = 30
 'WY = 20

 PAINT (1, 1), BC

 OPEN "TISET.WND" FOR INPUT AS #1
 
 INPUT #1, WX
 INPUT #1, WY
 INPUT #1, NX
 INPUT #1, NY
 INPUT #1, H
 INPUT #1, V
 INPUT #1, htext$


 CLOSE #1

CALL UPDPROMPT: REM BEGIN WINDOW CALLS

'CALL musiccomposer
  
   SCREEN 12
  CALL osstartupmenu
 CLS
 PAINT (1, 1), BC


DO
IF PROGRUNVAR = 1 THEN PROMPT$ = "RUNNING"
IF PROGRUNVAR = 0 THEN PROMPT$ = "BREAK"
REM RUN THE PROGRAM
IF PROGRUNVAR = 1 THEN
 IF LNGOTO > 0 THEN XX = LNGOTO: LNGOTO = 0
  IF ke$ = CHR$(0) + CHR$(134) THEN BREAK = 1: OSPROMPTON = 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)
  IF BREAK = 1 OR XX >= 1000 OR XX > (PROGLENGTH) THEN
    PROGRUNVAR = 0
    XX = 1
    BREAK = 0: OSPROMPTON = 1
  END IF

END IF
  
  
   IF HOMEPROMPT = 1 THEN GOSUB DELPROMPTTEXT:
  
   ke$ = ""
   IF OSPROMPTON = 1 THEN CALL UPDPROMPT
  IF ke$ <> "" THEN LK = ASC(ke$): RK = ASC(RIGHT$(ke$, 1))
  REM <return>
      
      Q = LEN(TEXTTOCRT$)
      IF Q > 0 THEN text$ = TEXTTOCRT$
  IF ke$ = CHR$(13) OR xlooplist = 1 OR Q > 0 THEN
    
    IF LEN(text$) > 0 THEN
       CALL clprompt
       TEXT12$ = TEXT11$: TEXT11$ = TEXT10$: TEXT10$ = TEXT9$
       TEXT9$ = TEXT8$: TEXT8$ = TEXT7$: TEXT7$ = TEXT6$
       TEXT6$ = TEXT5$: TEXT5$ = TEXT4$: TEXT4$ = TEXT3$
       TEXT3$ = TEXT2$: TEXT2$ = TEXT1$: TEXT1$ = text0$
       text0$ = text$
    END IF
    IF xlooplist = 0 AND Q = 0 THEN CALL PROCTEXT(text$)
    ke$ = ""
    text$ = ""
    IF xlooplist = 1 THEN
       inst$ = programarry$(xlst)
       IF inst$ <> "" THEN text$ = STR$(xlst) + " " + inst$
      
       xlst = xlst + 1
       IF xlst > (PROGLENGTH) THEN xlooplist = 0: xlst = 1
  
    END IF
 
    
     
  END IF
    
    IF Q > 0 THEN TEXTTOCRT$ = ""
  IF ke$ <> "" THEN
   ctxvar = 0
 
   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
  blink = blink + 1: IF blink > 16 THEN blink = 0
  LINE (cxh, cyv)-(cxh + 9, cyv + 9), blink, BF
   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


    mdelay = mdelay + 1
  IF mdelay > (SPEED / 2) THEN

  
   CALL drawmouse(7)
   mdelay = 0
 
 
  END IF
 

  IF ke$ <> "" THEN tel$ = tel$ + ke$
    
       udmain = udmain + 1
  IF udmain > (SPEED) OR ke$ <> "" THEN
    opp$ = CHR$(219)
     zzl = zzl + 1: IF zzl > 2 THEN zzl = 0
     IF zzl = 0 THEN cur$ = "_"
     IF zzl = 1 THEN cur$ = " "
      MAIN$ = PROGRUNNAME$ + CR$ + PROMPT$ + CR$ + "Ready" + CR$ + TEXT12$ + CR$ + TEXT11$ + CR$ + TEXT10$ + CR$ + TEXT9$ + CR$ + TEXT8$ + CR$ + TEXT7$ + CR$ + TEXT6$ + CR$ + TEXT5$ + CR$ + TEXT4$ + CR$ + TEXT3$ + CR$ + TEXT2$ + CR$ + TEXT1$ + CR$ + _
 text0$ + CR$ + text$ + cur$
       
        IF EQ = 1 THEN
         PROMPT$ = "SOUND CARD   " + CR$
         PROMPT$ = PROMPT$ + " RIGHT " + CR$
         PROMPT$ = PROMPT$ + " LEFT " + CR$
         END IF
         IF OSPROMPTON = 1 THEN CALL OSHEADER
        
     END IF
  
   IF OSPROMPTON = 1 THEN
      'CALL HEBWINDOW(WX, WY)
      'CALL NULWINDOW(NX, NY)
   END IF
  
  
 
   IF TON1 > 0 THEN
    SOUND 100 + TON1, TSPEED
   END IF

   IF TON2 > 0 THEN
    SOUND 100 + TON2, TSPEED
   END IF

   IF TON3 > 0 THEN
    SOUND 100 + TON3, TSPEED
   END IF

   IF TON4 > 0 THEN
    SOUND 100 + TON4, TSPEED
   END IF
  
   IF TON5 > 0 THEN
    SOUND 100 + TON5, TSPEED
   END IF

   IF TON6 > 0 THEN
    SOUND 100 + TON6, TSPEED
   END IF
  
   IF TON7 > 0 THEN
    SOUND 100 + TON7, TSPEED
   END IF



CALL OSSTARTBAR
LOOP UNTIL ke$ = CHR$(27)  ' REM loop test for <ESC>

REM end

END

er:

z = ERR

CALL OSERR(z)


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

WORD$ = ""
P1$ = ""
ke$ = ""

RESUME



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

'OPEN "c:\qbasic\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"
RUN 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



NOHEBBASE:

BEEP

FILES
CLOSE
CHDIR "C:\QBASIC"
OPEN "HEBREW.LAN" FOR OUTPUT AS #1
PRINT #1, "every", "KF"
CLOSE
PRINT " DONE "
PRINT "BUILDING DATABASE"
   SLEEP 1
RUN

TIERR1:

REM THIS IS FOR FORCEING THE WINDOWS SETTINGS TO THE BACKPLAN"

CHDIR "C:\QBASIC"
CLOSE

OPEN "TISET.WND" FOR OUTPUT AS #1
PRINT #1, WX
PRINT #1, WY
PRINT #1, NX
PRINT #1, NY
PRINT #1, H
PRINT #1, V
PRINT #1, htext$




CLOSE #1

PRINT "DONE"
PRINT "..."
SLEEP 2
RUN

DELPROMPTTEXT:
TEXT12$ = ""
TEXT11$ = ""
TEXT10$ = ""
TEXT9$ = ""
TEXT8$ = ""
TEXT7$ = ""
TEXT6$ = ""
TEXT5$ = ""
TEXT4$ = ""
TEXT3$ = ""
TEXT2$ = ""
TEXT1$ = ""
text$ = "OK"
HOMEPROMPT = 0
CLS
PAINT (1, 1), BC
RETURN

SUB ASCIITEST
 CLS
 PAINT (1, 1), BC


 DO
  ke$ = INKEY$
  TXT$ = "### TI994A ASCII TEST ### <F1> TO EXIT." + CR$
  TXT$ = TXT$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + CR$
  TXT$ = TXT$ + CHR$(34) + "~!@#$%^&*()_+`=[]{};'<>,./?"
  TXT$ = TXT$ + STR$(n) + " " + LK$ + STR$(RK)

 WINCOL = 5
 TCOL = 0
 BC = 11
 wc = 4
 wwt = 450
 wht = 200
 CALL MSGBOX(x, y, TXT$, msgout$)

  IF ke$ <> "" THEN LK$ = ke$: n = ASC(ke$): rc$ = RIGHT$(ke$, 1): RK = ASC(rc$)


 LOOP UNTIL ke$ = CHR$(0) + CHR$(59)


END SUB

SUB BUILDHBASE
REM
REM we build new hebrew english translations here
ON ERROR GOTO NOHEBBASE:

CLS
PRINT "############"
PRINT " you only have to give the english to hebrew"
PRINT " the software will provie bi directional translation "



INPUT "english word"; en$
INPUT "hebrew translation"; hb$

  PRINT "please wait..."



  CHDIR "c:\qbasic"
  OPEN "hebrew.lan" FOR RANDOM AS #1
  ex1 = 0

  DO

 
  IF EOF(1) = 0 THEN INPUT #1, A$, AA$
    PRINT A$, AA$
   IF A$ = (en$) AND hb$ = (AA$) THEN ex1 = 1

  LOOP UNTIL EOF(1) OR ex1 = 1


    IF ex1 = 0 THEN

     PRINT #1, en$, hb$
     PRINT
     PRINT " updated ... "; DATE$

     PRINT " English  "; en$
     PRINT
     PRINT " hebrew   "; hb$

     SLEEP 1

    END IF

     CLOSE #1

    CLS

'ON ERROR GOTO ER:
END SUB

SUB buildprinttext (REST$, OUTTEXT$)
x = 1
L = LEN(REST$)
FCH$ = LEFT$(REST$, 1)
IF FCH$ = CHR$(34) THEN x = 2
DO
  
 
  CH$ = MID$(REST$, x, 1)
   IF FCH$ = CHR$(34) AND CH$ <> CHR$(13) THEN
    DO
     CH$ = MID$(REST$, x, 1)
     WORD$ = WORD$ + CH$
      'PRINT "WORD"; CH$
      'SLEEP
    
    
     x = x + 1
    LOOP UNTIL x > (L) OR CH$ = CHR$(34) OR CH$ = CHR$(13)
    PNT$ = WORD$
    END IF

   IF CH$ <> CHR$(34) AND FCH$ <> CHR$(34) THEN
    DO
    CH$ = MID$(REST$, x, 1)
    IF CH$ <> "," AND CH$ <> CHR$(13) THEN WORD$ = WORD$ + CH$
    x = x + 1
    LOOP UNTIL x > (L) OR CH$ = "," OR CH$ = CHR$(13)
  
    
    SELECT CASE (WORD$)
     CASE IS = "TSPEED"
     PNT$ = STR$(TSPEED)
     CASE IS = "SPEED"
     PNT$ = STR$(SPEED)
     CASE IS = "TIME$"
     PNT$ = TIME$
     CASE IS = "TIMER"
     PNT$ = STR$(TIMER)
     CASE IS = "DATE$"
     PNT$ = DATE$

    END SELECT
    
     IF PNT$ = "" THEN
      VAR$ = WORD$
      CALL GETVAL(VAR$, OUTVAR$)
      PNT$ = OUTVAR$
     END IF
  
   END IF
  
  
  
 
 IF LEN(PNT$) <> 0 THEN OUTTEXT$ = OUTTEXT$ + PNT$: PNT$ = "": FCH$ = "": WORD$ = ""


CH$ = MID$(REST$, x, 1)
x = x + 1

LOOP UNTIL x >= (L)
  

END SUB

SUB chsod (aaa, bbb, ccc)

 aa2 = &HF1 + aaa
 bb2 = &HE4 + bbb
 cc2 = &HE4 + ccc
 dd2 = &H9D + ddd
 ee2 = &H9D + eee



FOR i = 0 TO 224
  SetReg i, 0 'Clear all registers
NEXT i

SetReg &H20, &H1 'Plays carrier note at specified octave ch. 1
SetReg &H23, &H1 'Plays modulator note at specified octave ch. 1
SetReg &H40, aa2 'Set carrier total level to softest ch. 1
SetReg &H43, &H0 'Set modulator level to loudest ch. 1
SetReg &H60, bb2 'Set carrier attack and decay ch. 1
SetReg &H63, cc2 'Set modulator attack and decay ch. 1
SetReg &H80, dd2 'Set carrier sustain and release ch. 1
SetReg &H83, ee2 'Set modulator sustain and release ch. 1

SetReg &H21, &H1 'Plays carrier note at specified octave ch. 2
SetReg &H24, &H1 'Plays modulator note at specified octave ch. 2
SetReg &H41, &H1F 'Set carrier total level to softest ch. 2
SetReg &H44, &H0 'Set modulator level to loudest ch. 2
SetReg &H61, &HE4 'Set carrier attack and decay ch. 2
SetReg &H64, &HE4 'Set modulator attack and decay ch. 2
SetReg &H81, &H9D 'Set carrier sustain and release ch. 2
SetReg &H84, &H9D 'Set modulator sustain and release ch. 2

SetReg &H22, &H1 'Plays carrier note at specified octave ch. 3
SetReg &H25, &H1 'Plays modulator note at specified octave ch. 3
SetReg &H42, &H1F 'Set carrier total level to softest ch. 3
SetReg &H45, &H0 'Set modulator level to loudest ch. 3
SetReg &H62, &HE4 'Set carrier attack and decay ch. 3
SetReg &H65, &HE4 'Set modulator attack and decay ch. 3
SetReg &H82, &H9D 'Set carrier sustain and release ch. 3
SetReg &H85, &H9D 'Set modulator sustain and release ch. 3


END SUB

SUB CLBITMAP

PAINT (1, 1), BC
PAINT (620, 200), BC
PAINT (1, 200), BC


END SUB

SUB Clicknoise



SOUND 100 + 2, .2

END SUB

SUB clm
CLS
COLOR 0, 1, 0
PRINT "Clearing music buffer..."

INPUT "are you sure you want to empty the Buffer?"; yn$

IF yn$ = "Y" OR yn$ = "y" THEN
DO

 songdb(ct, 0) = 0

 songdb(ct, 1) = 0

 songdb(ct, 2) = 0

 songdb(ct, 3) = 0
 ct = ct + 1

LOOP UNTIL ct >= (plc)



PRINT " Buffer Cleared .."
SLEEP
CLS
END IF
  plc = 0

CALL doscr

END SUB

SUB clprompt

LINE (2, 10)-(640, 400), BC, BF


END SUB

SUB clrstr
        A = 0
        si = 10
 
  FOR yv = 1 TO (si * 3) STEP si
  FOR cob = 110 TO 590 STEP si

     LINE (x + cob, yv + 1)-(x + cob + si, yv + 19), A, BF
     A = A + 1

  NEXT cob
  NEXT yv


  cxh = lx
  cyv = ly

END SUB

SUB crappynoise



DO
SOUND 100 + 5, .2

LOOP UNTIL s > 3


END SUB

SUB CUT34 (T$, OUTTEXT$)
OUTTEXT$ = ""
L = LEN(T$)
FOR x = 1 TO (L)
 CH$ = MID$(T$, x, 1)
 IF CH$ <> CHR$(34) THEN OUTTEXT$ = OUTTEXT$ + CH$

NEXT x



END SUB

SUB diskgr

LINE (640, 2)-(620, 20), 17



END SUB

SUB displaytext (x, y)

 
 DRAW "s4"
 
 REM tcol = text color
 LINE (x, y)-(x + wwt, y + wht), WINCOL, B: LINE (x, y)-(x + 10, y + 10), WINCOL, B

  txx = 2
  tyy = 1
  ll = LEN(TXT$)
  FOR scrup = 1 TO (ll)
   CH$ = MID$(TXT$, scrup, 1)
    txx = txx + 1: IF txx > (wwt - 5) THEN txx = 1: tyy = tyy + 1: IF tyy > 20 THEN tyy = 1
    TX = (txx * 8) + x: TY = (tyy * 8) + y
    LINE (TX, TY)-(TX + 8, TY + 8), BC, BF
           CH$ = UCASE$(CH$)
    SELECT CASE (CH$)
    CASE IS = "~"
     PSET (TX + 1, TY + 1), BC
      DRAW "C" + STR$(TCOL) + "F1E1F1E1"
    CASE IS = "!"
     PSET (TX + 1, TY + 5), TCOL
      DRAW "BU2U3"
    CASE IS = "@"
     PSET (TX + 2, TY + 3), BC
      DRAW "C" + STR$(TCOL) + "R2U2L4D5R4"
    CASE IS = "#"
     PSET (TX + 3, TY + 1), TCOL
     DRAW "D1NL1D2NL1ND1R2ND1NR1U2NR1NU1L2"
    CASE IS = "$"
     PSET (TX + 3, TY + 1), TCOL
     DRAW "D1NR1L2D2R3D2L3R1D1"
    CASE IS = "%"
     PSET (TX + 1, TY + 1), TCOL
     DRAW "BR4G4BR3R1"
    CASE IS = "^"
     PSET (TX + 1, TY + 3), TCOL
     DRAW "E3F3"
    CASE IS = "&"
     PSET (TX + 5, TY + 5), TCOL
     DRAW "H3U2R2D1G3D1F1R1E3"
    CASE IS = "*"
     PSET (TX + 3, TY + 1), TCOL
     DRAW "D4U2NG2NL2NH2NE2NR2NF2"
    CASE IS = "("
     PSET (TX + 2, TY + 1), TCOL
     DRAW "G1D2F1"
    CASE IS = ")"
     PSET (TX + 3, TY + 1), TCOL
     DRAW "F1D2G1"
    CASE IS = "+"
     PSET (TX + 2, TY + 1), TCOL
     DRAW "D2ND2NL2R2"
    CASE IS = "="
     PSET (TX + 1, TY + 2), TCOL
     DRAW "R4BD2L4"
    CASE IS = "["
     PSET (TX + 1, TY + 1), TCOL
     DRAW "NR3D4R3"
    CASE IS = "]"
     PSET (TX + 1, TY + 1), TCOL
     DRAW "R3D4L3"
    CASE IS = "{"
     PSET (TX + 4, TY + 1), TCOL
     DRAW "L3D2NL1D2R3"
    CASE IS = "}"
     PSET (TX + 1, TY + 1), TCOL
     DRAW "R3D2NR1D2L3"
    CASE IS = "<"
     PSET (TX + 1, TY + 3), TCOL
     DRAW "NE3F3"
    CASE IS = ">"
     PSET (TX + 4, TY + 3), TCOL
     DRAW "NH3G3"
    CASE IS = CHR$(34)
     PSET (TX + 1, TY + 1), TCOL
     DRAW "ND2BR2D2"
    CASE IS = "'"
    PSET (TX + 3, TY + 1), TCOL
    DRAW "D1G1"
    CASE IS = ","
     PSET (TX, TY), BC
      DRAW "BR5BD5C" + STR$(TCOL) + "L1D1"
    CASE IS = "."
     PSET (TX, TY), BC
      DRAW "BR4BD5C" + STR$(TCOL) + "R1"

    CASE IS = " "
    LINE (TX + 1, TY + 1)-(TX + 5, TY + 5), BC, BF
    CASE IS = "_"
    LINE (TX + 1, TY + 5)-(TX + 5, TY + 5), TCOL
    CASE IS = "0"
    LINE (TX + 1, TY + 1)-(TX + 5, TY + 5), TCOL, B
      LINE (TX + 5, TY + 1)-(TX + 1, TY + 5), TCOL
    CASE IS = "1"
     LINE (TX + 3, TY + 1)-(TX + 3, TY + 5), TCOL
     LINE (TX + 1, TY + 5)-(TX + 5, TY + 5), TCOL
    CASE IS = "2"
     LINE (TX + 1, TY + 2)-(TX + 2, TY + 1), TCOL
      LINE -(TX + 4, TY + 1), TCOL
       LINE -(TX + 3, TY + 3), TCOL
        LINE -(TX + 1, TY + 5), TCOL
         LINE -(TX + 5, TY + 5), TCOL
    CASE IS = "3"
     LINE (TX + 1, TY + 1)-(TX + 2, TY + 1), TCOL
      LINE -(TX + 5, TY + 1), TCOL
       LINE -(TX + 3, TY + 3), TCOL
        LINE -(TX + 5, TY + 3), TCOL
       LINE -(TX + 5, TY + 6), TCOL
      LINE -(TX + 1, TY + 5), TCOL
    CASE IS = "4"
     LINE (TX + 1, TY + 1)-(TX + 1, TY + 3), TCOL
      LINE -(TX + 5, TY + 3), TCOL
       LINE (TX + 5, TY + 1)-(TX + 5, TY + 5), TCOL
    CASE IS = "5"
     LINE (TX + 5, TY + 1)-(TX + 1, TY + 1), TCOL
      LINE -(TX + 1, TY + 3), TCOL
       LINE -(TX + 3, TY + 3), TCOL
        LINE -(TX + 5, TY + 5), TCOL
         LINE -(TX + 1, TY + 5), TCOL
    CASE IS = "6"
      LINE (TX + 5, TY + 1)-(TX + 1, TY + 1), TCOL
       LINE -(TX + 1, TY + 3), TCOL
        LINE -(TX + 5, TY + 3), TCOL
         LINE -(TX + 5, TY + 5), TCOL
          LINE -(TX + 1, TY + 5), TCOL
           LINE -(TX + 1, TY + 3), TCOL
    CASE IS = "7"
      LINE (TX + 1, TY + 1)-(TX + 5, TY + 1), TCOL
       LINE -(TX + 1, TY + 5), TCOL
    CASE IS = "8"
      LINE (TX + 1, TY + 1)-(TX + 5, TY + 5), TCOL, B
       LINE (TX + 1, TY + 3)-(TX + 5, TY + 3), TCOL
    CASE IS = "9"
      LINE (TX + 1, TY + 1)-(TX + 5, TY + 5), TCOL, B
       LINE (TX + 1, TY + 3)-(TX + 5, TY + 3), TCOL
        LINE (TX + 1, TY + 4)-(TX + 1, TY + 5), BC
    CASE IS = "A"
      LINE (TX + 3, TY + 1)-(TX, TY + 3), TCOL: LINE -(TX + 6, TY + 3), TCOL
       LINE -(TX + 3, TY + 1), TCOL
        LINE (TX, TY + 3)-(TX, TY + 5), TCOL
         LINE (TX + 6, TY + 3)-(TX + 6, TY + 5), TCOL

    CASE IS = "B"
     LINE (TX + 1, TY + 1)-(TX + 3, TY + 3), TCOL, B
      LINE (TX + 1, TY + 3)-(TX + 5, TY + 5), TCOL, B
    CASE IS = "C"
     LINE (TX + 5, TY + 1)-(TX + 1, TY + 1), TCOL
      LINE -(TX + 1, TY + 5), TCOL
       LINE -(TX + 5, TY + 5), TCOL

    CASE IS = "D"
     LINE (TX + 1, TY + 1)-(TX + 1, TY + 5), TCOL
       CIRCLE (TX + 4, TY + 3), 3, TCOL, , , .5
    CASE IS = "E"
     LINE (TX + 1, TY + 1)-(TX + 4, TY + 1), TCOL
     LINE (TX + 1, TY + 1)-(TX + 1, TY + 5), TCOL
     LINE (TX + 1, TY + 3)-(TX + 3, TY + 3), TCOL
     LINE (TX + 1, TY + 5)-(TX + 5, TY + 5), TCOL
    CASE IS = "F"
     LINE (TX + 1, TY + 1)-(TX + 4, TY + 1), TCOL
     LINE (TX + 1, TY + 1)-(TX + 1, TY + 5), TCOL
     LINE (TX + 1, TY + 3)-(TX + 3, TY + 3), TCOL
     'LINE (tx + 1, ty + 5)-(tx + 5, ty + 5), tcol
    CASE IS = "G"
       LINE (TX, TY)-(TX, TY + 1), BC
       DRAW "c1r5l5d4r5u2l2"

    CASE IS = "H"
     LINE (TX + 1, TY + 1)-(TX + 1, TY + 5), TCOL
     LINE (TX + 1, TY + 4)-(TX + 4, TY + 3), TCOL
     LINE (TX + 6, TY + 1)-(TX + 6, TY + 5), TCOL
    CASE IS = "I"
     LINE (TX + 1, TY + 1)-(TX + 4, TY + 1), TCOL
      LINE (TX + 2, TY + 1)-(TX + 2, TY + 5), TCOL
       LINE (TX + 1, TY + 5)-(TX + 4, TY + 5), TCOL
    CASE IS = "J"
     LINE (TX + 4, TY + 1)-(TX + 4, TY + 1), TCOL
      DRAW "c1d4l4u2"
    CASE IS = "K"
     LINE (TX + 1, TY + 1)-(TX + 1, TY + 5), TCOL
     LINE (TX + 1, TY + 3)-(TX + 5, TY + 1), TCOL
     LINE (TX + 2, TY + 2)-(TX + 5, TY + 5), TCOL

   
    CASE IS = "L"
     LINE (TX + 1, TY + 1)-(TX + 1, TY + 5), TCOL
     LINE (TX + 1, TY + 5)-(TX + 5, TY + 5), TCOL
    CASE IS = "M"
     LINE (TX, TY + 5)-(TX, TY + 5), TCOL
      DRAW "u5r2d5u5r2d5"
    CASE IS = "N"
     LINE (TX + 1, TY + 5)-(TX + 1, TY + 1), TCOL
      LINE -(TX + 5, TY + 5), TCOL
       LINE -(TX + 5, TY + 1), TCOL


    CASE IS = "O"
     LINE (TX + 1, TY + 1)-(TX + 5, TY + 5), TCOL, B
    CASE IS = "P"
     LINE (TX + 4, TY + 3)-(TX + 1, TY + 1), TCOL, B
     LINE -(TX + 1, TY + 5), TCOL
    CASE IS = "Q"
     CIRCLE (TX + 2, TY + 3), 2, TCOL
      LINE (TX + 2, TY + 3)-(TX + 4, TY + 6), TCOL
      


   
    CASE IS = "R"
     LINE (TX + 1, TY + 1)-(TX + 4, TY + 3), TCOL, B
     LINE (TX + 1, TY + 3)-(TX + 1, TY + 5), TCOL
     LINE (TX + 3, TY + 3)-(TX + 5, TY + 5), TCOL
    CASE IS = "S"
     LINE (TX + 4, TY + 1)-(TX + 4, TY + 1), TCOL
      DRAW "l4d2r4d3l4"
    CASE IS = "T"
     LINE (TX + 1, TY + 1)-(TX + 5, TY + 1), TCOL
      LINE (TX + 3, TY + 1)-(TX + 3, TY + 5), TCOL
    CASE IS = "U"
    LINE (TX + 1, TY + 1)-(TX + 1, TY + 5), TCOL
     LINE -(TX + 4, TY + 5), TCOL
      LINE -(TX + 4, TY + 1), TCOL
    CASE IS = "V"
     LINE (TX + 1, TY + 1)-(TX + 3, TY + 5), TCOL
      LINE -(TX + 5, TY + 1), TCOL

    CASE IS = "W"
     LINE (TX, TY + 1)-(TX, TY + 5), TCOL
      LINE -(TX + 2, TY + 1), TCOL
     LINE -(TX + 4, TY + 5), TCOL
      LINE -(TX + 5, TY + 1), TCOL
    CASE IS = "X"
    LINE (TX, TY)-(TX + 5, TY + 5), TCOL
    LINE (TX + 5, TY)-(TX, TY + 5), TCOL
   
    CASE IS = "Y"
    LINE (TX, TY)-(TX + 3, TY + 3), TCOL
    LINE -(TX + 4, TY + 1), TCOL
     LINE (TX + 3, TY + 3)-(TX + 3, TY + 5), TCOL
    CASE IS = "Z"
     LINE (TX + 1, TY + 1)-(TX + 4, TY + 1), TCOL
      LINE -(TX + 1, TY + 5), TCOL
       LINE -(TX + 5, TY + 5), TCOL


    CASE IS = ":"
    PSET (TX + 3, TY + 1), TCOL
    PSET (TX + 3, TY + 5), TCOL


    ' rem function stuff ###
    
    CASE IS = CHR$(13)
    tyy = tyy + 1
    txx = 0
    CASE IS = CHR$(32)
    txx = txx + 1


    END SELECT

  NEXT scrup
    TX = TX + 8
    SELECT CASE (cur0)
    CASE IS = 0
    LINE (TX + 1, TY + 5)-(TX + 5, TY + 5), BC

    CASE IS = 1
    LINE (TX + 1, TY + 5)-(TX + 5, TY + 5), TCOL


    END SELECT
    cur0 = cur0 + 1: IF cur0 > 1 THEN cur0 = 0

    LINE (TX + 1, TY + 1)-(TX + 7, TY + 7), blink, BF
    lx = TX: ly = TY

END SUB

SUB doscr
CALL retscr
CALL iniscrn
CALL drsc


END SUB

SUB drawmouse (c)



   
 CALL setseriolmouse(0)

 CALL setjoymouse
 
END SUB

SUB drsc


V = 0

COLOR 2, 4

LOCATE 5, 1

nnt$ = ""
nnd$ = ""


DO
SELECT CASE (V)
CASE IS = 0
nnt$ = "C"
nnd$ = "D"
CASE IS = 1
nnt$ = "E"
nnd$ = "F"
CASE IS = 2
nnt$ = "G"
nnd$ = "A"

CASE IS = 3
nnt$ = "B"
nnd$ = "C"

CASE IS = 4
nnt$ = "D"
nnd$ = "E"

CASE IS = 5
nnt$ = "F"
nnd$ = "G"

CASE IS = 6
nnt$ = "A"
nnd$ = "B"

CASE IS = 7
nnt$ = "C"
nnd$ = "D"



END SELECT

PRINT nnt$; STRING$(78, " ")
PRINT nnd$

V = V + 1

LOOP UNTIL V >= 8

   CALL retscr

END SUB

SUB er
COLOR 4, 0, 0
CLS


PRINT "!!   ERROR  !! "
PRINT " You have exceeded Buffer Space"
PRINT "## Recording haulted ##"
PRINT "Press <X> to resume ."

   DO
    ke$ = INKEY$
   LOOP UNTIL ke$ = "X"


  CALL doscr

END SUB

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
CLS
END SUB

SUB getjoystick (MH, MV, MH1, MV1)


  MH = STICK(0): MV = STICK(1)
  MH1 = STICK(2): MV1 = STICK(3)
  JB0 = STRIG(0)
  JB1 = STRIG(1)
  JB2 = STRIG(2)
  JB3 = STRIG(3)


END SUB

SUB GETVAL (VAR$, OUTVAR$)
  ext1 = 0
  x = 0
  OUTVAR$ = ""
  DO
   CH$ = VARARRY$(x, 0)
   IF CH$ = (VAR$) THEN OUTVAR$ = VARARRY$(x, 1): ext1 = 1
   x = x + 1
  LOOP UNTIL x > 1000 OR ext1 = 1

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

DEFSNG A-Z
SUB grlayout
LOCATE 22, 1
PRINT "X "; STICK(0) * 2
15 V = 1
   hwidth = 270
   grsize = 12
   vtop = 25
   vsize = 165
   ' REM matrix layout
V = vtop
HH = -60
20 FOR H = 30 TO (hwidth) STEP grsize
25   LINE (0, V)-(hwidth, V), 1
   IF HH < (hwidth) THEN
   LINE (H, vtop)-(HH, vsize), 1
   END IF
     HH = HH + grsize + 10
     V = V + grsize
     IF V >= vsize THEN V = vsize
     IF HH >= (hwidth) THEN HH = hwidth
35 NEXT H
   LINE (hwidth, vtop)-(hwidth, vsize), 1
                 'CIRCLE (128, 96), 120, 1, , , .5

END SUB

SUB grmouse
REM useus tandy 1000 game port with tandy CoCo mouse


H = STICK(0) * 2
V = STICK(1)

   REM pointer <----
   x = H: y = V
   CALL pointer(x, y, 1)
   IF H <> (H1) OR V <> (V1) THEN
    CALL pointer(H1, V1, BC)
    'LINE (h1, v1 - 5)-(h1 + 5, v1 + 5), Bc, BF
    H1 = H
    V1 = V



'CALL grlayout

' CALL world
  

  
   CALL pointer(x, y, 3)
   END IF




END SUB

DEFINT A-Z
SUB HEBCHARACTER (x, y, CH$, c, SIZE)


  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 HEBTEXT (x, y, TXT$, c, SIZE)



    DRH = x
    DRV = y

    ll = LEN(TXT$)

   FOR WRD = 1 TO (ll)

  
   CH$ = MID$(TXT$, WRD, 1)
   IF CH$ = CHR$(13) OR DRH > (x + wwt - 8) THEN DRH = x: DRV = DRV + SIZE: IF DRV > y + (wht - 8) THEN DRV = (y + wht - 8)

  
   CALL HEBCHARACTER(DRH, DRV, CH$, c, SIZE)
   IF CH$ <> "" THEN DRH = DRH + SIZE + 4

   NEXT WRD
END SUB

SUB HEBWINDOW (WX, WY)
  FONTV = 1
  T$ = htext$
  wc = 5
 wht = 100
 wwt = 200

  CALL win(WX, WY, T$, wc)

END SUB

SUB iniscrn


CH = 0

DO

PRINT STRING$(79, 219)
CH = CH + 1

LOOP UNTIL CH >= 23


END SUB

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

z$ = P1$

L = LEN(z$)
IF L <= 1 THEN
 CLS
 PAINT (1, 1), BC
 WINCOL = 5
 TCOL = 0
 BC = 11
 wc = 4
 wwt = 450
 wht = 200
 TXT$ = " you need to specify the name of the file to load." + CR$ + "<hit spacebar>"

 CALL MSGBOX(x, y, TXT$, msgout$)
6
LOCATE 10, 1
INPUT z$

 IF z$ = "" THEN EXIT SUB

END IF

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


PRINT " getting :"; z$


OPEN z$ FOR INPUT AS #8


x = 1
DO

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

 programarry$(x) = A$


 x = x + 1
LOOP UNTIL EOF(8)


CLOSE #8
   PROGLENGTH = x
   PROGRUNNAME$ = z$


END SUB

SUB LEAVEOS9 (WORD$)


 'ROOT$ = "C:\QBASIC\"
SELECT CASE (WORD$)
 CASE IS = "BASIC"
 RUN root$ + "QBMENU.BAS"
 CASE IS = "KINGAREN"
 RUN root$ + "ARENSOS.BAS"




END SELECT



END SUB

SUB linfo
 
   COLOR 7, 0, 0
   CLS
 
 
   ct = 0
   DO

    PRINT songdb(ct, 0), songdb(ct, 1), songdb(ct, 2)

   ct = ct + 1
   LOOP UNTIL ct >= (plc)

   PRINT
   PRINT " ### DONE ###"
   SLEEP
CALL doscr

END SUB

SUB loadcartridge
CLS
PRINT " loading cartridge ..."
END






END SUB

SUB loadsg

FILES


INPUT "Name of Qbmusic file to load "; na$

OPEN na$ FOR INPUT AS #1
ct = 0
DO

LINE INPUT #1, A$

   ll = LEN(A$)


 FOR ct = 1 TO (ll)
 CH$ = MID$(A$, ct, 1)
   PRINT CH$;
     
   
  IF CH$ = ":" THEN
    
   SELECT CASE cut
     CASE IS = 0
     songdb(cct, 0) = VAL(NN$)
   
     CASE IS = 1
     songdb(cct, 1) = VAL(NN$)
   
     CASE IS = 2
     songdb(cct, 2) = VAL(NN$)


      END SELECT
     IF CH$ = ":" THEN cut = cut + 1
      IF cut = 3 THEN cut = 0: cct = cct + 1: PRINT
NN$ = "": CH$ = ""
  END IF

 NN$ = NN$ + CH$
 NEXT ct


LOOP UNTIL EOF(1)

  
CLOSE #1
   plc = cct
     PRINT "Size <"; plc; ">"
SLEEP
END SUB

SUB lstprog
 CLS
 PRINT PROGLENGTH

FOR x = 1 TO (PROGLENGTH)
  IF programarry$(x) <> "" THEN
  PRINT x, programarry$(x)
  END IF
 A$ = INKEY$

 IF A$ = CHR$(32) THEN SLEEP



NEXT x
SLEEP
CLS
END SUB

SUB McHSOD

        CLS
        COLOR 3, 0

        INPUT "Tone "; AA1
         INPUT " Decay t "; BB1
          INPUT "Decay d"; CC1
           INPUT "cd1 "; dd1
            INPUT "CD2 "; ee1
         
           IF AA1 <> 0 THEN aaa = AA1
           IF BB1 <> 0 THEN bbb = BB1
           IF CC1 <> 0 THEN ccc = CC1
         
           IF dd1 <> 0 THEN ddd = dd1
           IF ee1 <> 0 THEN eee = ee1
     

         
         CALL chsod(aaa, bbb, ccc)
   
CALL doscr
END SUB

SUB Menu
COLOR 1, 0, 0
 CLS
 DO
 PRINT "Load a File <L>"
 PRINT " Save this File <S>"
 PRINT "  Name this File  <N>"
 PRINT "   Tweek the SEC feature <E>"
 PRINT "    Change Screen Colors <C>  "
 PRINT "e<X>it"

INPUT ke$

    ke$ = UCASE$(ke$)
   
   
     SELECT CASE ke$
     CASE IS = "C"
      INPUT "Fore Color "; Fgnd
      INPUT "BackGround "; Bgnd
      INPUT "Border "; Border
      CALL retscr
    
     CASE IS = "E"
       INPUT "SEC"; slim
       PRINT "Sec delay is now < "; slim
       PRINT
    CASE IS = "L"
    'CALL clm
     CALL loadsg
  
    CASE IS = "S"
      INPUT "Name of file to be Saved under "; na$

      OPEN na$ FOR OUTPUT AS #1

      DO
       n = songdb(ct, 0)
       o = songdb(ct, 1)
       tim = songdb(ct, 2)

       PRINT #1, STR$(n); ":"; STR$(o); ":"; STR$(tim); ":"

         ct = ct + 1
      LOOP UNTIL ct >= (plc)
       CLOSE #1

    END SELECT

LOOP UNTIL ke$ = "X"

CALL doscr

END SUB

SUB modemsettings

REM self explanatory
REM   change the baud parity port ect
REM





END SUB

SUB MOUSE
        
           POKE VARPTR(A(4)), &H92           'Swap code,Get CX setup
          CALL absolute(CX, VARPTR(A(0)))     'Run Code
              CX = CX
                                   'Adjust 25x80
           POKE VARPTR(A(4)), &H91           'Swap code,Get DX setup
          CALL absolute(DX, VARPTR(A(0)))     'Run Code
             
              DX = DX                    'Adjust 25x80
           POKE VARPTR(A(4)), &H93           'Swap code,Get BX setup
          CALL absolute(bx, VARPTR(A(0)))     'Run Code

                   bu = bx              'Note :
                                   'Remove the /8
                                   'for graphics modes.




        mx = DX
        my = CX










END SUB

SUB mouseclickarea (xxleft, yytop, areawidth, height, msgout$)
  msgout$ = ""

  rc = INT(RND(1) * 16) + 1
  LINE (xxleft, yytop)-(areawidth, height), rc, B
  IF bu = 1 THEN
   IF mx > (xxleft) AND mx < (areawidth) AND my > (yytop) AND my < (height) THEN
   msgout$ = "True"

   END IF

  END IF



END SUB

SUB MousePointer (SW)


       
           POKE VARPTR(A(0)) + 1, SW         'Swap code,Set AX = (SW)
          CALL absolute(c, VARPTR(A(0)))     'Run Code

                                          'Note:
                                             'SW = 0-reset
                                             'SW = 1-on
                                             'SW = 2-off
                                             'SW = 3-coordinates


END SUB

SUB movewindow (H, V, wc)

CALL Clicknoise


LINE (H - 8, V - 15)-(H + wwt + 5, V + wht + 5), BC, BF
DO
drawmouse (7)


'CALL CUBE(MX, MY)




LOOP UNTIL bx = 0


H = mx
V = my
 CALL CLBITMAP

LINE (H - 8, V - 15)-(H + wwt + 5, V + wht + 7), BC, BF

END SUB

SUB mPP (HH, VV, H1, V1, note$, nt$, n, o, tim, B)
      
           drawmouse (c)
           DX = bu
           cur$ = CHR$(177)
    'LOCATE 20, 1: PRINT dx

       IF DX = 1 OR DX = 2 THEN
      
         IF DX = 1 THEN cur$ = CHR$(221)
         IF DX = 2 THEN cur$ = CHR$(222)

        IF DX = 2 THEN EX = 1 ELSE EX = 0

        SELECT CASE (VV)
       
         CASE IS = (5)
          n = 95: o = 3 + EX
       
       
         CASE IS = (6)
          n = 135: o = 3 + EX

         CASE IS = (7)
        
           n = 175: o = 3 + EX
         CASE IS = (8)
        
           n = 205: o = 3 + EX
         CASE IS = (9)
        
           n = 255: o = 3 + EX
         CASE IS = (10)
         
           n = 35: o = 4 + EX
         CASE IS = (11)
         
           n = 75: o = 4 + EX
         CASE IS = (12)
         
           n = 95: o = 4 + EX
         CASE IS = (13)
         
           n = 125: o = 4 + EX
         CASE IS = (14)
         
           n = 175: o = 4 + EX
         CASE IS = (15)
          note$ = "F"
           n = 195: o = 4 + EX
         CASE IS = (16)
         
           n = 255: o = 4 + EX
         CASE IS = (17)
           n = 35: o = 5 + EX
         CASE IS = (18)
          n = 75: o = 5 + EX
       
         CASE IS = (19)
          n = 95: o = 5 + EX
       
     

       END SELECT
      
         IF VV > 0 AND VV < 22 THEN note$ = CHR$(SCREEN(VV, 1))
      
  END IF


       HH = CX
       VV = bx
   
   
       VV = CX / 8
       HH = bx / 8


       IF HH < 1 THEN HH = 1
       IF VV < 1 THEN VV = 1
   
       IF HH > 79 THEN HH = 79
       IF VV > 23 THEN VV = 23
      
        rc = INT(RND(1) * (14)) + 1
         COLOR curc, rc
       LOCATE VV, HH
        PRINT cur$;


       IF V1 <> (VV) OR H1 <> (HH) THEN

       LOCATE V1, H1
    


       COLOR Bgnd, Bgnd, 0
       PRINT " ";
       END IF
           CALL retscr

  IF DX = 0 THEN note$ = " ": nt$ = " ": B = 0 ELSE B = 1: cur$ = CHR$(178)



     


END SUB

SUB MSGBOX (x, y, TXT$, msgout$)
   msgout$ = ""
    CALL MOUSE

  CALL displaytext(x, y)
  

     IF bu = 1 THEN
      IF mx > (x) AND mx < (x + 10) AND my > (y) AND my < y + 10 THEN
       msgout$ = "True"
      END IF
     END IF


END SUB

SUB MUSICCOMPOSER
      CLS
      Bgnd = 0
      Fgnd = 7
      Border = 1
      curc = 15
   
     slim = 100' set sec delay at 300
      plc = 0
      plclim = 100
     rec$ = "Stop"
     octave = 4
     duration! = .01


  cur$ = CHR$(219)


 

H1 = 1: V1 = 1

'CALL retscr

'CALL iniscrn

DO

LOCATE 1, 1
     
DO
ke$ = INKEY$
  ke$ = UCASE$(ke$)
     
 LOCATE 2, 2
   PRINT LN$; " "; rec$; " "; octave; "oct N <"; n; " "; slim; "T"; aaa; " "; bbb; " "; ccc; "--"; NN
  
  
    LOCATE 3, 2: PRINT ddd, eee
   IF ke$ <> "" THEN
 
      lch = ASC(LEFT$(ke$, 1)): rch = ASC(RIGHT$(ke$, 1))
      PRINT lch, rch;
   

   END IF
   CALL mPP(HH, VV, H1, V1, note$, nt$, n, o, tim, B)


  
    IF rec$ = "PLAY" AND B = 0 THEN
    
      CALL playsg(cplc)

       CALL waitp
    END IF



   IF note$ <> (nt$) THEN
   songdb(plc, 2) = tim
    tim = 0
   END IF
   IF note$ <> (nt$) OR DX = 1 THEN
   
     CALL waitp
  
     octave = o
    CALL playt(n, octave)
   
     IF rec$ = "Record" THEN
     
      songdb(plc, 0) = n
      songdb(plc, 1) = o
    
      plc = plc + 1
      IF plc > (plclim) THEN plc = plclim: rec$ = "Stop": CALL er
     END IF
      
   nt$ = note$
   LN$ = nt$
 
   END IF

    IF rec$ = "Record" THEN
     tim = tim + 1: IF tim > 4000 THEN tim = 4000
    END IF


   IF note$ = "" THEN tm = 0
  
 IF V1 <> (VV) OR H1 <> (HH) THEN
  CALL drsc
       H1 = HH
       V1 = VV
 END IF

LOOP UNTIL ke$ <> ""
 CALL waitp
  IF ke$ = "," THEN octave = octave - 1
     IF octave < 1 THEN octave = 1
  IF ke$ = "." THEN octave = octave + 1
     IF octave > 7 THEN octave = 7

  IF ke$ = "1" THEN NN = NN + 1
    
  IF ke$ = "2" THEN NN = NN - 1
    

  IF ke$ = "R" THEN rec$ = "Record"
  IF ke$ = "P" THEN rec$ = "PLAY"
  IF ke$ = "S" THEN rec$ = "Stop"

   IF ke$ = "N" THEN rec$ = "New": CALL clm
   IF ke$ = "M" THEN CALL Menu
  
     IF ke$ = "V" THEN

       CALL spmenu


      END IF
 
  
   
      IF lch = 0 AND rch = 63 THEN
          CALL McHSOD

      END IF


      IF lch = 0 AND rch = 73 THEN slim = slim - 5: IF slim <= 5 THEN slim = 5
  
      IF lch = 0 AND rch = 81 THEN slim = slim + 5: IF slim >= 2000 THEN slim = 2000
  
      IF lch = 0 AND rch = 59 THEN aaa = aaa + 1: CALL chsod(aaa, bbb, ccc)
      IF lch = 0 AND rch = 84 THEN aaa = aaa - 1: CALL chsod(aaa, bbb, ccc)
      IF lch = 0 AND rch = 60 THEN bbb = bbb + 1: CALL chsod(aaa, bbb, ccc)
      IF lch = 0 AND rch = 85 THEN bbb = bbb - 1: CALL chsod(aaa, bbb, ccc)
    
      IF lch = 0 AND rch = 61 THEN ccc = ccc + 1: CALL chsod(aaa, bbb, ccc)
      IF lch = 0 AND rch = 86 THEN ccc = ccc - 1: CALL chsod(aaa, bbb, ccc)

      IF lch = 0 AND rch = 134 THEN ddd = ddd + 1: CALL chsod(aaa, bbb, ccc)
      IF lch = 0 AND rch = 136 THEN ddd = ddd - 1: CALL chsod(aaa, bbb, ccc)

      IF lch = 0 AND rch = 133 THEN eee = eee + 1: CALL chsod(aaa, bbb, ccc)
      IF lch = 0 AND rch = 135 THEN eee = eee - 1: CALL chsod(aaa, bbb, ccc)









   IF ke$ = "L" THEN CALL linfo

 CALL playt(n + NN, octave)

Ed = 0' set end variable to 0

   p$ = INKEY$
    IF p$ = "q" THEN Ed = 1


   lch = 0
   rch = 0





LOOP UNTIL ke$ = CHR$(27)
END SUB

SUB NULWINDOW (NX, NY)
  REM nul window

 
  FONTV = 0
  T$ = " Hello World" + CR$ + TIME$ + CR$ + tel$ + CR$ + HEBTRANS$
  nc = 1
 wht = 200
 wwt = 200

  CALL win(NX, NY, T$, nc)

END SUB

SUB OSBUTTON (BTXT$, H, V, HBSIZE, VBSIZE, PRESS$)

        'MX = Dx
        'MY = Cx
        'BU BUTTON

LINE (H + 1, V + 3)-(H + HBSIZE, V + VBSIZE), WINCOL, B
 LINE (H + 2, V + 4)-(H + HBSIZE - 1, V + VBSIZE - 1), 7, B

 
 
 
 
 
 

 wwt = HBSIZE
 wht = VBSIZE
 TXT$ = BTXT$
 CALL MSGBOX(H, V + 2, TXT$, mgsout$)
 
 
  IF bu = 1 AND mx > (H) AND mx < (H + HBSIZE) AND my > (V) AND my < (V + VBSIZE) THEN
     PRESS$ = "1"
  END IF



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 OSHEADER
   CR$ = CHR$(13)
   TXT$ = STR$(mx) + "," + STR$(my) + "," + STR$(bu) + " " + cart1$ + CR$ + cart2$ + CR$ + MAIN$ + CR$
   wc = 2

 wht = 400
 wwt = 640

  IF text$ <> ltext$ OR udmain >= (SPEED) THEN
  CALL displaytext(2, 40)
 
  ltext$ = text$
  END IF
  udmain = 0

END SUB

SUB OSSTARTBAR
  EXTS = 0
  LINE (1, 450)-(470, 475), 7, B
   LINE (480, 450)-(630, 475), 7, B
  CALL OSBUTTON("[<START>]", 15, 448, 100, 20, PRESS$)
   IF PRESS$ = "1" THEN
    LINE (11, 240)-(90, 442), BC, BF
    DO
  
    LINE (11, 240)-(90, 442), 5, B
    PRESS$ = ""
    CALL setseriolmouse(c)
     CALL OSBUTTON("<RUN>", 15, 400, 70, 30, PRESS$)
   
     IF PRESS$ = "1" THEN
        PROGRUNVAR = 1' TURN ON
        XX = 1
        BREAK = 0
        EXTS = 1: PRESS$ = ""
     END IF

     CALL OSBUTTON("<BREAK>", 15, 350, 70, 30, PRESS$)
  
     IF PRESS$ = "1" THEN
        PROGRUNVAR = 0' TURN ON
        XX = 1
        BREAK = 1
        EXTS = 1: PRESS$ = ""
        OSPROMPTON = 1
     END IF


     CALL OSBUTTON("<SAVE>", 15, 300, 70, 30, PRESS$)
 
     IF PRESS$ = "1" THEN
       CALL SVPROGRAM(P1$)

       EXTS = 1: PRESS$ = ""
     END IF

     CALL OSBUTTON("<LOAD>", 15, 250, 70, 30, PRESS$)

     IF PRESS$ = "1" THEN
       CALL LDPROGRAM(P1$)

       EXTS = 1
     END IF




    LOOP UNTIL ke$ = CHR$(27) OR EXTS = 1
   END IF


  PRESS$ = ""
  IF EXTS = 1 THEN
   CLS
   PAINT (1, 1), BC
  END IF
END SUB

SUB osstartupmenu
REM allows user to select startup options
'   from a menu
'
 ext1 = 0
 CLS
 PAINT (1, 1), BC
 WINCOL = 5
 TCOL = 0
 BC = 11
 wc = 4
 wwt = 200
 wht = 200
 x = 100
 y = 30



 DO
  ke$ = INKEY$
   TXT$ = CHR$(13) + " Cartridge " + CHR$(13) + " 32 bit Basic "
   CALL MSGBOX(x, y, TXT$, msgout$)
    xxleft = x + 10
    yytop = y + 14
    areawidth = x + 150
    height = y + 24
     CALL mouseclickarea(xxleft, yytop, areawidth, height, msgout$)
      IF msgout$ = "True" THEN CALL loadcartridge
   
    yytop = y + 25
    height = y + 35

     CALL mouseclickarea(xxleft, yytop, areawidth, height, msgout$)
      IF msgout$ = "True" THEN ext1 = 1

    
     CALL OSBUTTON("<Diskboot>", x + 10, y + 40, 120, y + 10, PRESS$)
 
     CALL OSBUTTON("<HDboot>", x + 10, y + 85, 120, y + 10, PRESS$)




   
LOOP UNTIL ext1 = 1



END SUB

SUB playsg (cplc)


cplc = cplc + 1
IF cplc > (plc) THEN cplc = 0

n = songdb(cplc, 0): o = songdb(cplc, 1): TD = songdb(cplc, 2)

octave = o
CALL playt(n, octave)

ddy = 0
RANDOMIZE TIMER
ddy = 0
DO

CALL sec

 ddy = ddy + 1

LOOP UNTIL ddy >= (TD)



END SUB

SUB playt (n, octave)

       FOR j = 0 TO 2
      SetReg &HA0 + j, n 'Set note number
      SetReg &HB0 + j, &H21 + 4 * octave 'Set octave and switch on channel
       NEXT j

END SUB

DEFSNG A-Z
SUB pointer (x, y, c)
   
   LINE (x, y)-(x + 5, y + 5), c
   LINE -(x + 5, y - 5), c
   LINE -(x, y), c
END SUB

DEFINT A-Z
SUB PROCTEXT (text$)

 IF text$ <> "" THEN

 text$ = UCASE$(text$)

 '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
   'PRINT p1$, "stored in "; lnv
   'SLEEP
  END IF
  

'PRINT WORD$, V1
 'SLEEP

 SELECT CASE (WORD$)
 CASE IS = "PLAYT"

 CALL playt(V1 + V2, V3)

 CASE IS = "CLS"
 CALL clprompt
   CLS
   PAINT (1, 1), BC

 CASE IS = "GR"

  OSPROMPTON = 0
  CLS

 CASE IS = "DRAW"
  CALL buildprinttext(REST$, OUTTEXT$)
   T$ = OUTTEXT$
 
  CALL CUT34(T$, OUTTEXT$)
  DRAW OUTTEXT$

 CASE IS = "SHOWVAR"
 CALL SHOWVAR
 CASE IS = "LET"
  CALL PUTVAR(P1$, P2$)



 CASE IS = "DEL"
  programarry$(V1) = ""
  TEXTTOCRT$ = "LINE " + STR$(V1) + " DELETED."

 CASE IS = "SLEEP"
 IF V1 > 0 THEN SLEEP V1 ELSE SLEEP

 CASE IS = "HOME"
  HOMEPROMPT = 1
 CASE IS = "ASCIITEST"
  CALL ASCIITEST
 CASE IS = "TSPEED"
 TSPEED = V1
 CASE IS = "NEW"
 CLS
 PAINT (1, 1), BC
 WINCOL = 5
 TCOL = 0
 BC = 11
 wc = 4
 wwt = 450
 wht = 200
 TXT$ = "ARE YOU SURE YOU WANT TO LEAVE " + PROGRUNNAME$ + CR$
 TXT$ = TXT$ + " AND START A NEW PROGRAM?"
 TXT$ = TXT$ + " <Y> FOR YES"
 CALL MSGBOX(x, y, TXT$, msgout$)
   LOCATE 10, 1
   INPUT y$
   y$ = UCASE$(y$)
   IF y$ = "Y" OR y$ = "YES" THEN
    FOR XX = 0 TO (PROGLENGTH)
     programarry$(XX) = ""
    NEXT XX
    PROGLENGTH = 0
    PROGRUNNAME$ = ""
   END IF

 CASE IS = "PRINT", "?"
  'PRINT p1$
  CALL buildprinttext(REST$, OUTTEXT$)
   TEXTTOCRT$ = OUTTEXT$

 CASE IS = "RUN"

  'CALL PROGRUN
  PROGRUNVAR = 1' TURN ON
  XX = 1
  BREAK = 0


 CASE IS = "LIST"
  xlst = 1
  xlooplist = 1
  'CALL lstprog
  'IF p1$ <> "" THEN CALL FILELIST(p1$)
 CASE IS = "RS232", "MODEM"
   CALL RS232


 CASE IS = "SHOWROOT"
      MAIN$ = MAIN$ + root$ + CR$
 CASE IS = "BYE"
  SYSTEM

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

CASE IS = "MODEL2"
  RUN root$ + "MODEL2.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 = "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 = "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



 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"
   

   SHELL "DIR *.COB"
   SLEEP

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

 CASE IS = "PLAY"
 
  CALL buildprinttext(REST$, OUTTEXT$)
  T$ = OUTTEXT$
  CALL CUT34(T$, OUTTEXT$)
  PLAY OUTTEXT$

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

  SLEEP
  CLS
  PRINT "PLEASE WAIT..."

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


 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 root$ + "\COCOROM.BAS"

   END SELECT




 END SELECT




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

END IF
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 PUTVAR (VAR$, PUTVAL$)
ext1 = 0
x = 0
DO
CH$ = VARARRY$(x, 0)
IF CH$ = "" OR CH$ = (VAR$) THEN
   VARARRY$(x, 0) = VAR$
   VARARRY$(x, 1) = PUTVAL$
   ext1 = 1
END IF
x = x + 1
LOOP UNTIL x > 1000 OR ext1 = 1

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 retscr
COLOR Bgnd, Fgnd, Border


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 SAVESET


CLOSE #1
OPEN "TISET.WND" FOR OUTPUT AS #1

PRINT #1, WX
PRINT #1, WY
PRINT #1, NX
PRINT #1, NY
PRINT #1, H
PRINT #1, V
PRINT #1, htext$

CLOSE #1


END SUB

SUB sec

FOR y = 0 TO (slim)

ke$ = INKEY$
 ke$ = UCASE$(ke$)

 IF ke$ = "S" THEN
  y = slim
  rec$ = "Stop"
 END IF

NEXT y

END SUB

SUB setjoymouse
 
  'CALL getjoystick(MH, MV, MH1, MV1)

   '  MH = MH * 2
    ' MV = MV
     
    
    'IF MHH <> (MH) OR MVV <> (MV) THEN
    'LINE (MHH, MVV)-(MHH + 23, MVV + 22), BC, BF
    ' MHH = MH
    ' MVV = MV
    'END IF
    

END SUB

SUB SetReg (Reg, Value)
OUT RegAddr, Reg
OUT DataAddr, Value
END SUB

SUB setseriolmouse (c)


CALL MOUSE


   H = mx
   V = my


   IF V < 40 THEN V = 40
   IF qbmo = 1 THEN
   
                   
   IF H <> (msh1) OR V <> (msv1) THEN

    
   'LINE (msh1 - 3, msv1 - 3)-(msh1 + 25, msv1 + 25), BC, BF

   msh1 = H
   msv1 = V
   END IF
   
   END IF

END SUB

SUB shhelp

DO







LOOP UNTIL ke$ = CHR$(32)


END SUB

SUB SHOWVAR
 CLS
 FOR x = 0 TO 20
   PRINT VARARRY$(x, 0), VARARRY$(x, 1)
 NEXT x
 SLEEP

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 spmenu
COLOR 1, 0, 1
CLS

INPUT "Playback Speed "; slim

CALL doscr
END SUB

SUB SVPROGRAM (P1$)


z$ = P1$
L = LEN(z$)
IF L <= 1 THEN

PAINT (1, 1), BC

TXT$ = " you need to name the file." + CR$ + "<hit spacebar>"

 WINCOL = 5
 TCOL = 0
 BC = 11
 wc = 4
 wwt = 450
 wht = 200

 CALL MSGBOX(x, y, TXT$, msgout$)


CLS
INPUT " name of file to save."; z$
IF z$ = "" THEN EXIT SUB

END IF

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

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

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

CLOSE #9


PROGRUNNAME$ = z$
END SUB

SUB UPDPROMPT

  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$ = "-"
  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 RUN "screens"
   END IF
  END IF

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

END SUB

SUB upgrade

END SUB

SUB waitp

  FOR j = 0 TO 2
    SetReg &HB0 + j, 0 'Switch channel off
  NEXT j

END SUB

SUB win (x, y, T$, wc)


IF y < 70 THEN y = 70

IF bx = 1 THEN

 IF mx > (x) AND mx < (x + 40) AND my > (y) AND my < (y + 40) THEN
  CALL movewindow(x, y, 4)
 END IF
END IF





TXT$ = T$

LINE (x - 4, y - 14)-(x + wwt + 4, y + wht + 5), 8, B
LINE (x, y - 4)-(x + wwt, y - 12), 5, BF
LINE (x + 2, y + wht - 9)-(x + wwt - 2, y + wht - 2), wc, BF

LINE (x - 2, y - 2)-(x + wwt + 2, y + wht + 2), 3, B

  WINCOL = wc
  TXT$ = T$
  CH$ = TXT$
  c = wc
  SIZE = 5

 IF FONTV = 1 THEN CALL HEBTEXT(x + 5, y + 5, TXT$, c, SIZE)
 IF FONTV = 0 THEN CALL displaytext(x, y)




END SUB

