DECLARE SUB saveset ()
DECLARE SUB hlpsub ()
DECLARE SUB buildtime (ti$)
DECLARE SUB intro ()
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 CTRSCREEN (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
COMMON SHARED msh1, msv1
COMMON SHARED mhh, mvv, cur0
COMMON SHARED txt$
COMMON SHARED MX, MY
COMMON SHARED WINCOL
COMMON SHARED wht, wwt: REM (wht height) (wwt width)
COMMON SHARED FONTV
COMMON SHARED bc
COMMON SHARED qbmo' 0 is set to off
COMMON SHARED main$
COMMON SHARED blink

' rem basic
REM variables
 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
 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 TNON' used to toggle tones
 COMMON SHARED tonev
 COMMON SHARED tnon1' used to toggle tones
 COMMON SHARED tonev1
 COMMON SHARED htext$
 COMMON SHARED ltxt$
 COMMON SHARED WX, WY
 COMMON SHARED HEBPRES

 DIM SHARED PROGRAMARRY$(200)


'
'   REM
'    OS9
'     FOR QBASIC
'     2002
'
'
'    e-MAIL ME AT ADAM_RACCOON@YAHOO.COM
'
'    Compatability
'
'      qbasic 100%
'
'      OS9  10% <-- add features
'
'      Calc Card < 20% <-- can be programed
'
'      Rom Extended Basic <-- 50% <--
'
'      differences from Qbwin01.bas
'
'         1. better subs
'         2 easier to understand window graphics
'         3 stable mouse routine
'
'
'         4. extra goodies
'
'
'
'               a. Dual Modem card <-- cool
'               b. sound speech emulation 5% sucks
'                      only does voice needs fast cpu and hardisk
'                      if you have a pentium or better it works great
'
'               c.  a kind of compiler that turns basic into a tokenized
'                    set of instructions so you can  ( run programs faster
'                                                    ( run multiple programs or multi task
'
'
'               d. get real !!! a Hebrew font generator and programmable data
'                    base for adding words can be used as a translator and
'                     integrates into programs
'
'               e. with a mouse friendly GUI
'                    thats Graphical user interface for you students
'
'
'
'
'
'
'
'
'
'
'
'
'              ********************************************
'              *                                          *
'              *              QBOS9.BAS                   *
'              *  Mouse Routine for MS-QBasic/IBM-QBasic  *
'              *                1 9 9 5                   *
'              *                                          *
'              ********************************************
'
'********************************* 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 9


 ON ERROR GOTO notiset:
 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 intro

 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
 speed = 3
 CASE IS = 2
 speed = 12
 CASE IS = 3
 speed = 80
 CASE IS = 4
 speed = 320
 CASE IS = 5
 speed = 900


 CASE IS = 6
 speed = 1200
 CASE IS = 7
 speed = 2400
 CASE IS = 8
 speed = 4800
 CASE IS = 9
 speed = 9600
 CASE IS = 10
 speed = 19200




 END SELECT


 htext$ = "ABCDEFGHIJKLMNOP"

 bc = 10
 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$ = "EXTENDED DOS " + cr$ + "SERIOL MODEM CARTRIGE"
 'CART1$ THIS IS CARTRIGE 1

REM disk variables
 cr$ = CHR$(13)

 '
 ' auxsp.set turns (on off) selects port for speech

 'used foe screen size
swth = 640: shht = 400

 '
 '
 '
 '
 '
 '
 '
REM ---- setup

  ' get printer setup

ON ERROR GOTO noprintersetup:
OPEN "c:\qbasic\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 "c:\qbasic\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




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

 wht = 100
 wwt = 200
 wc = 1

 PAINT (1, 1), bc

DO
  
   CALL buildtime(ti$)
   LOCATE 2, 1: PRINT " "; ti$
   ke$ = ""
   CALL UPDPROMPT
 
 
  IF ke$ <> "" THEN
 
  IF ke$ <> "" THEN LK = ASC(ke$): RK = ASC(RIGHT$(ke$, 1))
  REM <return>


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

   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
   IF ke$ <> "" THEN tel$ = tel$ + ke$
  
  END IF
  

    
  
  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
 

  udmain = udmain + 1
 
  IF udmain > speed OR ke$ <> "" THEN
   opp$ = CHR$(219)
  
   main$ = TIME$ + cr$
   main$ = main$ + "  512k EXTENDED COLOR BASIC " + cr$ + "FOR Dos and Qbasic" + cr$ + "OK" + cr$ + text$
   main$ = main$ + "#" + cr$
   CALL OSHEADER

    IF HEBPRES = 1 THEN
    CALL HEBWINDOW(WX, WY)
    END IF
    IF nwinpres = 1 THEN
    CALL NULWINDOW(NX, NY)
    END IF
   udmain = 0
   END IF
 
   IF TNON = 1 THEN SOUND 100 + tonev, .5
   IF TNON = 1 THEN SOUND 100 + tonev1, .5



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
'

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 "c:\qbasic\cocorom.bas"

CASE IS = "R"
RUN

CASE IS = "B"
OPEN "c:\qbasic\printer.set" FOR OUTPUT AS #1

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

END SELECT


RUN

notiset:
 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

CLOSE

CLS
PRINT " UPDATING..."
PRINT " TISET.WND"
SLEEP
RUN ROOT$ + "BOOTDISK.BAS"

SUB buildtime (ti$)

'self explanatory



a$ = TIME$



hr$ = LEFT$(a$, 2)
H = VAL(hr$)

IF H > 12 THEN H = H - 12: ext$ = "PM" ELSE ext$ = "AM"




se$ = RIGHT$(a$, 2)
s = VAL(se$)


min = VAL(MID$(TIME$, 4, 2))


ti$ = STR$(H) + ":" + STR$(min) + ":" + se$ + " " + ext$



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 clprompt

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


END SUB

SUB clrstr
        a = 0
        si = 8
 
  FOR yv = 1 TO 20 STEP si
  FOR cob = 110 TO 500 STEP (si) / 2

     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 CTRSCREEN (X, y)
 IF txt$ <> ltxt$ THEN
  ltxt$ = txt$
 DRAW "s4"
 
 c = 1
 LINE (X, y)-(X + wwt, y + wht), c, B: LINE (X, y)-(X + 10, y + 10), c, B

  txx = 2
  tyy = 1
  ll = LEN(txt$)
  FOR scrup = 1 TO (ll)
   CH$ = MID$(txt$, scrup, c)
    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$)
   
    'PSET (txx, tyy), bc
    SELECT CASE (CH$)
    CASE IS = "*"
     DRAW "nf8bd4r8bu4g8"
    CASE IS = "."
    PSET (tx + 5, ty + 8), c
   
    CASE IS = "#"
    LINE (tx + 1, ty)-(tx + 1, ty + 5), c, B


    CASE IS = "0"
    LINE (tx + 1, ty + 1)-(tx + 5, ty + 5), c, B
     LINE (tx + 5, ty + 1)-(tx + 1, ty + 5), c
    CASE IS = "1"
     LINE (tx + 3, ty + 1)-(tx + 3, ty + 5), c
     LINE (tx + 1, ty + 5)-(tx + 5, ty + 5), c
    CASE IS = "2"
     LINE (tx + 1, ty + 2)-(tx + 2, ty + 1), c
      LINE -(tx + 4, ty + 1), c
       LINE -(tx + 3, ty + 3), c
        LINE -(tx + 1, ty + 5), c
         LINE -(tx + 5, ty + 5), c
    CASE IS = "3"
     LINE (tx + 1, ty + 1)-(tx + 2, ty + 1), c
      LINE -(tx + 5, ty + 1), c
       LINE -(tx + 3, ty + 3), c
        LINE -(tx + 5, ty + 3), c
       LINE -(tx + 5, ty + 6), c
      LINE -(tx + 1, ty + 5), c
    CASE IS = "4"
     LINE (tx + 1, ty + 1)-(tx + 1, ty + 3), c
      LINE -(tx + 5, ty + 3), c
       LINE (tx + 5, ty + 1)-(tx + 5, ty + 5), c
    CASE IS = "5"
     LINE (tx + 5, ty + 1)-(tx + 1, ty + 1), c
      LINE -(tx + 1, ty + 3), c
       LINE -(tx + 3, ty + 3), c
        LINE -(tx + 5, ty + 5), c
         LINE -(tx + 1, ty + 5), c
    CASE IS = "6"
      LINE (tx + 5, ty + 1)-(tx + 1, ty + 1), c
       LINE -(tx + 1, ty + 3), c
        LINE -(tx + 5, ty + 3), c
         LINE -(tx + 5, ty + 5), c
          LINE -(tx + 1, ty + 5), c
           LINE -(tx + 1, ty + 3), c
    CASE IS = "7"
      LINE (tx + 1, ty + 1)-(tx + 5, ty + 1), c
       LINE -(tx + 1, ty + 5), c
    CASE IS = "8"
      LINE (tx + 1, ty + 1)-(tx + 5, ty + 5), c, B
       LINE (tx + 1, ty + 3)-(tx + 5, ty + 3), c
    CASE IS = "9"
      LINE (tx + 1, ty + 1)-(tx + 5, ty + 5), c, B
       LINE (tx + 1, ty + 3)-(tx + 5, ty + 3), c
        LINE (tx + 1, ty + 4)-(tx + 1, ty + 5), bc
    CASE IS = "A"
      LINE (tx + 3, ty + 1)-(tx, ty + 3), c: LINE -(tx + 6, ty + 3), c
       LINE -(tx + 3, ty + 1), c
        LINE (tx, ty + 3)-(tx, ty + 5), c
         LINE (tx + 6, ty + 3)-(tx + 6, ty + 5), c

    CASE IS = "B"
     LINE (tx + 1, ty + 1)-(tx + 3, ty + 3), c, B
      LINE (tx + 1, ty + 3)-(tx + 5, ty + 5), c, B
    CASE IS = "C"
     LINE (tx + 5, ty + 1)-(tx + 1, ty + 1), c
      LINE -(tx + 1, ty + 5), c
       LINE -(tx + 5, ty + 5), c

    CASE IS = "D"
     LINE (tx + 1, ty + 1)-(tx + 1, ty + 5), c
       CIRCLE (tx + 4, ty + 3), 3, c, , , .5
    CASE IS = "E"
     LINE (tx + 1, ty + 1)-(tx + 4, ty + 1), c
     LINE (tx + 1, ty + 1)-(tx + 1, ty + 5), c
     LINE (tx + 1, ty + 3)-(tx + 3, ty + 3), c
     LINE (tx + 1, ty + 5)-(tx + 5, ty + 5), c
    CASE IS = "F"
     LINE (tx + 1, ty + 1)-(tx + 4, ty + 1), c
     LINE (tx + 1, ty + 1)-(tx + 1, ty + 5), c
     LINE (tx + 1, ty + 3)-(tx + 3, ty + 3), c
     'LINE (tx + 1, ty + 5)-(tx + 5, ty + 5), c
    CASE IS = "G"
       LINE (tx, ty)-(tx, ty + 1), bc
       DRAW "c1r5l5d4r5u2l2"

    CASE IS = "H"
     LINE (tx + 1, ty + 1)-(tx + 1, ty + 5), c
     LINE (tx + 1, ty + 4)-(tx + 4, ty + 3), c
     LINE (tx + 6, ty + 1)-(tx + 6, ty + 5), c
    CASE IS = "I"
     LINE (tx + 1, ty + 1)-(tx + 4, ty + 1), c
      LINE (tx + 2, ty + 1)-(tx + 2, ty + 5), c
       LINE (tx + 1, ty + 5)-(tx + 4, ty + 5), c
    CASE IS = "J"
     LINE (tx + 4, ty + 1)-(tx + 4, ty + 1), c
      DRAW "c1d4l4u2"
    CASE IS = "K"
     LINE (tx + 1, ty + 1)-(tx + 1, ty + 5), c
     LINE (tx + 1, ty + 3)-(tx + 5, ty + 1), c
     LINE (tx + 2, ty + 2)-(tx + 5, ty + 5), c

   
    CASE IS = "L"
     LINE (tx + 1, ty + 1)-(tx + 1, ty + 5), c
     LINE (tx + 1, ty + 5)-(tx + 5, ty + 5), c
    CASE IS = "M"
     LINE (tx, ty + 5)-(tx, ty + 5), c
      DRAW "u5r2d5u5r2d5"
    CASE IS = "N"
     LINE (tx + 1, ty + 5)-(tx + 1, ty + 1), c
      LINE -(tx + 5, ty + 5), c
       LINE -(tx + 5, ty + 1), c


    CASE IS = "O"
     LINE (tx + 1, ty + 1)-(tx + 5, ty + 5), c, B
    CASE IS = "P"
     LINE (tx + 4, ty + 3)-(tx + 1, ty + 1), c, B
     LINE -(tx + 1, ty + 5), c
    CASE IS = "Q"
     CIRCLE (tx + 2, ty + 3), 2, c
      LINE (tx + 2, ty + 3)-(tx + 4, ty + 6), c
      


   
    CASE IS = "R"
     LINE (tx + 1, ty + 1)-(tx + 4, ty + 3), c, B
     LINE (tx + 1, ty + 3)-(tx + 1, ty + 5), c
     LINE (tx + 3, ty + 3)-(tx + 5, ty + 5), c
    CASE IS = "S"
     LINE (tx + 4, ty + 1)-(tx + 4, ty + 1), c
      DRAW "l4d2r4d3l4"
    CASE IS = "T"
     LINE (tx + 1, ty + 1)-(tx + 5, ty + 1), c
      LINE (tx + 3, ty + 1)-(tx + 3, ty + 5), c
    CASE IS = "U"
    LINE (tx + 1, ty + 1)-(tx + 1, ty + 5), c
     LINE -(tx + 4, ty + 5), c
      LINE -(tx + 4, ty + 1), c
    CASE IS = "V"
     LINE (tx + 1, ty + 1)-(tx + 3, ty + 5), c
      LINE -(tx + 5, ty + 1), c

    CASE IS = "W"
     LINE (tx, ty + 1)-(tx, ty + 5), c
      LINE -(tx + 2, ty + 1), c
     LINE -(tx + 4, ty + 5), c
      LINE -(tx + 5, ty + 1), c
    CASE IS = "X"
    LINE (tx, ty)-(tx + 5, ty + 5), c
    LINE (tx + 5, ty)-(tx, ty + 5), c
   
    CASE IS = "Y"
    LINE (tx, ty)-(tx + 3, ty + 3), c
    LINE -(tx + 4, ty + 1), c
     LINE (tx + 3, ty + 3)-(tx + 3, ty + 5), c
    CASE IS = "Z"
     LINE (tx + 1, ty + 1)-(tx + 4, ty + 1), c
      LINE -(tx + 1, ty + 5), c
       LINE -(tx + 5, ty + 5), c


    CASE IS = ":"
    PSET (tx + 3, ty + 1), c
    PSET (tx + 3, ty + 5), c


    ' 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
    END IF
    
    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), c


    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 diskgr

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



END SUB

SUB drawm (H, V, mcolor)

graph$ = "r6G2F2G2H2G2U6"

PSET (H, V), mcolor
DRAW "c0s0" + STR$(mcolor) + graph$
PAINT (H + 4, V + 4), mcolor, 0

END SUB

SUB drawmouse (c)



   
 CALL setseriolmouse(0)

 CALL setjoymouse
 
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)

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
CALL world

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"
 CASE IS = "M"
  DRAW "BD2F3E3G3F3L6"
 CASE IS = "N"
  DRAW "R6D7L4BD1BL2U6"
 CASE IS = "O"
  DRAW "R6D8L6U8"
 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 hlpsub
CALL clprompt
DO
   opp$ = CHR$(219)
           main$ = "###### HELP SCREEN os9 basic comands" + cr$
   main$ = main$ + "# RUN      TONE        tone1      " + cr$
   main$ = main$ + "# files    beep                   " + cr$
   main$ = main$ + "# list     play        toneoff                " + cr$
   main$ = main$ + "# HEB ON            " + cr$
   main$ = main$ + "# HEB OFF               " + cr$






   CALL OSHEADER
   ke$ = INKEY$



LOOP UNTIL ke$ = CHR$(8)
CALL clprompt

END SUB

SUB intro
CLS
PRINT "  Basic      "
PRINT "  gui        "
PRINT "  midi       "
PRINT "             "
PRINT "             "
PRINT "  its Os9    "
PRINT




SLEEP



END SUB

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




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


PRINT " getting :"; z$

OPEN z$ FOR INPUT AS #8
X = 1
DO
 PRINT a$

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

 PROGRAMARRY$(X) = a$


 X = X + 1
LOOP UNTIL EOF(8)


CLOSE #8
   PROGLENGTH = X



END SUB

SUB LEAVEOS9 (word$)

CALL saveset


 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 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 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 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 NULWINDOW (NX, NY)
  REM nul window

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

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

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$ = cr$ + main$ + cr$
   

 wht = 400
 wwt = 640
  blink = blink + 1: IF blink > 16 THEN blink = 0

  CALL CTRSCREEN(2, 40)



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$)
 ROOT$ = "c:\qbasic\"

 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$

 v1 = VAL(p1$)
 V2 = VAL(P2$)
 V3 = VAL(P3$)
 v4 = VAL(p4$)
 v5 = VAL(p5$)



  LNV = VAL(word$)
  IF LNV > 0 OR word$ = "0" THEN
  PROGRAMARRY$(LNV) = p1$

  IF LNV > (PROGLENGTH) THEN PROGLENGTH = LNV

  END IF
  
 'PRINT word$
 'PRINT P1$
 'PRINT P2$
 'PRINT P3$
 'PRINT P4$



' SLEEP
  var1 = VAL(p1$)


 SELECT CASE (word$)
 CASE IS = "QBMENU"
  RUN ROOT$ + "QBMENU.BAS"


 CASE IS = "QBMUSIC"
 CLOSE
 RUN ROOT$ + "QBMUSIC.BAS"
 CASE IS = "REST", "SCNSAVER"
  CHDIR ROOT$
  RUN "scrsaver.bas"


 CASE IS = "MEM"
 RUN ROOT$ + "MEMERY.BAS"


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

 CASE IS = "HEBOFF"
 HEBPRES = 0
 CASE IS = "HEBON"
 HEBPRES = 1

 CASE IS = "HELP"
  CALL hlpsub

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



 CASE IS = "BEEP"
 BEEP
 CASE IS = "FILES"
   CHDIR "c:\qbasic"
   SHELL "files.bat"
   SLEEP
 CASE IS = "DIR"
 CLS
 SLEEP
 CLS
 CASE IS = "DISKCOPY"
 RUN "C:\QBASIC\DISKCOPY.BAS"

 CASE IS = "PLAY"
  PLAY p1$

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

  SLEEP
  CLS
  PRINT "PLEASE WAIT..."

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




 CASE IS = "HEB"
 htext$ = p1$
 IF V2 > 0 THEN WX = V2
 IF V3 > 0 THEN WY = V3


 CASE IS = "CALC"
 RUN ROOT$ + "qbcalc.bas"
 CASE IS = "QBASIC"
  CLS

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

 CASE IS = "LPRINT"

 IF prnbr = 0 THEN LPRINT p1$

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

 END SELECT

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


 CASE IS = "CLS"
 CLS

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



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


 CASE IS = "VGA"
 'CALL VGA

 CASE IS = "REMOTE"
  CALL REMOTE

 CASE IS = "LIST"

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








 CASE IS = "TONEOFF"
 TNON = 0
 CASE IS = "TONEON"
  TNON = 1

 CASE IS = "TONE"
 TNON = 1
 tonev = var1

 CASE IS = "TONE1"
 TNON = 1
 tonev1 = var1




 CASE IS = "CIRCLE"
    CIRCLE (VAL(p1$), VAL(P2$)), VAL(P3$), VAL(p4$)

 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 = "SPEED"
 speed = var1
   'adjust speed to machein"
 CASE IS = "CLS"
 CALL clprompt
 CASE IS = "RUN"

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


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


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


 CASE IS = "EXIT", "REBOOT"

  CLS

  PRINT " REBOOT WILL TAKE YOU TO CoCoROM"
  INPUT " EXIT TO DOS OR MS WINDOWS "; choice$
 
   choice$ = UCASE$(choice$)
 
   SELECT CASE (choice$)
    CASE IS = "DOS"
    SYSTEM

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

   END SELECT

 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 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 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 setjoymouse
 
  CALL getjoystick(mh, mv, mh1, mv1)

     mh = mh * 2
     mv = mv
   LINE (mh, mv)-(mh + 3, mv + 2), 1, B
   
   
   
    IF mhh <> (mh) OR mvv <> (mv) THEN
    LINE (mhh, mvv)-(mhh + 3, mvv + 2), bc, B
     mhh = mh
     mvv = mv
    END IF
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
   CALL drawm(H, V, 7)
   END IF

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 (p1$)


z$ = p1$

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

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

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

CLOSE #9



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

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

END SUB

SUB upgrade

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 CTRSCREEN(X, y)




END SUB

DEFSNG A-Z
SUB world
    CIRCLE (128, 96), 120, 1, , , .5
END SUB

