DECLARE SUB MOUSEMENU ()
DECLARE SUB mainmenu (TEXTROUTER$)
DECLARE SUB COMPORTPANEL (COMPORTX!, COMPORTY!)
DECLARE SUB AUDIOPANNEL (AUDIOX!, AUDIOY!)
DECLARE SUB drawm (H, V, MCOLOR)
DECLARE SUB NOTEPAD (NOTEX!, NOTEY!, NOTETEXT$)
DECLARE SUB CLCKNOISE ()
DECLARE SUB SWICTH (H, V, N)
DECLARE SUB SWITCHBOARD (H, V, SWNUMBER$, SWNAM$)
DECLARE SUB mouse (WHICH)
DECLARE SUB ldsv (DTA$)
DECLARE SUB delete (DTA$)
DECLARE SUB ROTATE (DTA$, an, QA, TA, swth, shht, sh, sv)
DECLARE SUB edraw (AG!, QA!, TA!, DTA$, B!)
DECLARE SUB VBCH (DAT$, H!, V!, SZ!, C!)
DECLARE SUB GETTX (DTA$, CT!, TXT$, S)
DECLARE SUB PRTEXT (TXT$, H!, V!, S!, C!, swth, shht)
DECLARE SUB GETVL (DTA$, CT!, SZ!)
DECLARE SUB DLINE (AG!, VR!, EA!, DMO!, H!, V!, X!, Y!, C!, bl!, N!, SIZE!, swth, shht)
DECLARE SUB CDRAW (AG!, QA!, TA!, DTA$, B!)
DECLARE SUB VBDRAW (AG!, QA!, TA!, DTA$, H!, V!, B!, swth, shht)
DECLARE SUB SGLINE (AG!, VR!, EA!, ANGLE!, SZ!, X!, Y!, H!, V!, C!, SIZE!, bl!, N!, swth, shht)
DECLARE SUB balist ()
DECLARE SUB basicPROGRUN ()
DECLARE SUB prostack (pro$, textstack$)
DECLARE SUB video1show (X!, Y!)
DECLARE SUB MousePointer (SW!)
DECLARE SUB gnpart (CMD$, otxt$, q!)
DECLARE SUB PROC (pro$)
DECLARE SUB SHOWTEXT (H!, V!, SZ!, HT!, T$, SETPOINTER$)
DIM SHARED PROGRAMARRY$(200)

 COMMON SHARED TON1
 COMMON SHARED TON2
 COMMON SHARED TON3
 COMMON SHARED TON4

DIM SHARED mouser$, mouseleftbutton, MouseRightButton, mousexpos, mouseypos, AX%, BX%, CX%, DX%
COMMON SHARED MX, MY, MA, MB, EVX, EVY, MSEL, GRMX, GRMY

COMMON SHARED VID1H, VID1V, MX1, MY1
COMMON SHARED cur0, PROGLENGTH, lngoto
COMMON SHARED BU, BUR, SETX, SETY, CURRENTX, CURRENTY

COMMON SHARED CR$
COMMON SHARED XPOS, YPOS, barun, SWTX1, SWTY1, UDSWITCH, WALK
COMMON SHARED TEXTROUTER$, textstack$, LOPP$
COMMON SHARED COMSTATUS$
SCREEN 12

CLS
CLEAR
SCREEN 12
mouse 0

   
                                       'for printing screen.

' ==========================================
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00

' ==========================================

    DATA 205, 5, 203  : ' int 5  retf  'Machine-language code

'0 = Mouse Init
'1 = Mouse Driver
'2 = Mouse Put
'3 = Mouse Status
'4 = Mouse Hide
'5 = Mouse Show
' ==========================================
                CALL mouse(0)      'Reset mouse and
                PRINT "mouse resreset..."
                SLEEP 1
                CALL mouse(4)      'turn pointer on
                PRINT "HIDE MOUSE"
                SLEEP 1
                PRINT " set to get mouse coordinates"
                CALL mouse(3)      'Get coordinates
                PRINT MX, MY, BU
                SLEEP 1
                PRINT "ok"
                SLEEP 1
                CLS
                LOCATE 1, 1
                COLOR 4
                PRINT " power on "
                COLOR 7
                PRINT " booting Univac Vurtial Switcing memory "
                PRINT "  with Gui Interface"
                PRINT ""
                PRINT "   and active gui Elements     "
                PRINT " type < Help > now if you need assistance  "
                PRINT ""
                PRINT " <enter> to proceed                              "
                PRINT "                               "
                INPUT " ["; CMD$
               
                IF CMD$ <> "" THEN
                CALL PROC(pro$)
                END IF
                PRINT " INITIALIZING VARIABLES ..."
                SLEEP 1

 COMSTATUS$ = "COM1 OFF  COM2 OFF"

 SWN1$ = "01001000"' SET FIRST SWITCH
 PRINT "SET FIRST SWICHBOARD  [ "; SWN1$
AG = 1
QA = 2
TA = 1
B = 0

CSIZE = 10
    'swth = 600
    'shht = 400
    SIZE = 100
   sh = swth / 2
   sv = shht / 2
   h1 = sh
   V1 = sv

CR$ = CHR$(13)
AG = 1
QA = 2
TA = 1
B = 0
AG1 = AG
QA1 = QA
TA1 = TA
posnc = 10


CR$ = CHR$(13)


 cadh = 330
 cadv = 300
 hcirc = 120
 vcirc = 150
HT = 100

LOWTEXT$ = "< READY"
WALK = 0
X = 11: Y = 11
SP = 5
EXT = 0
ZDTA$ = "S1;C2;R100;D100;L100;U100;X100;L100;"
IF WALK = 0 THEN PRINT " WALK IS OFF .. ": SLEEP 1
IF WALK = 1 THEN PRINT " WALKING ENABLED ..": SLEEP 1
PRINT "CAD DATA IS SET TO  [ "; DTA$

TEXTROUTER$ = "NOTEPAD"
 NOTEX = 3120
 NOTY = -100

SETX = NOTEX: SETY = NOTEY
PRINT " GOING TO "; TEXTROUTER$
SLEEP 1

DO
 KE$ = INKEY$
 IF KE$ = CHR$(0) + CHR$(59) THEN
  KE$ = ""
  CALL mainmenu(TEXTROUTER$)

 END IF

 IF KE$ = CHR$(0) + "M" THEN SETX = X + SP: KE$ = ""
 IF KE$ = CHR$(0) + "K" THEN SETX = X - SP: KE$ = ""
 IF KE$ = CHR$(0) + "P" THEN SETY = Y + SP: KE$ = ""
 IF KE$ = CHR$(0) + "H" THEN SETY = Y - SP: KE$ = ""
 
  
  TEXTROUTER$ = UCASE$(TEXTROUTER$)

  SELECT CASE (TEXTROUTER$)
   CASE IS = "SWITCHBOARD"
   SETX = 3700: SETY = -114
  
   CASE IS = "TIMEDATE"
   SETX = TIDAX: SETY = tiday


   CASE IS = "NOTEPAD"
      L = LEN(NOTETEXT$)
      IF KE$ = CHR$(8) THEN IF L >= 1 THEN NOTETEXT$ = LEFT$(NOTETEXT$, L - 1): KE$ = ""
      IF KE$ <> "" THEN NOTETEXT$ = NOTETEXT$ + KE$

   CASE IS = "MAIN"
     IF KE$ = CHR$(8) THEN KE$ = "": IF L > 0 THEN pro$ = LEFT$(pro$, L - 1)
     IF KE$ = CHR$(13) THEN CALL PROC(pro$): pro$ = "": KE$ = ""
     IF KE$ <> "" THEN pro$ = pro$ + KE$: pro$ = UCASE$(pro$)
     MAINTEXT$ = textstack$ + CHR$(13) + pro$
  
   CASE IS = "AUXTEXT"
    TEXT1$ = pro$
   CASE IS = "LOWLEVEL"
    IF KE$ = CHR$(13) THEN LOWTEXT$ = ""
    IF KE$ <> "" THEN
    LOWTEXT$ = LOWTEXT$ + KE$
    END IF
    CASE IS = "CADVIDEO"
     DTA$ = ZDTA$
     TASP = 1
     IF KE$ = "W" THEN QA = QA + TASP
     IF KE$ = "Z" THEN QA = QA - TASP
     IF KE$ = "S" THEN TA = TA + TASP
     IF KE$ = "A" THEN TA = TA - TASP

     IF TA1 <> (TA) OR QA <> (QA1) THEN
     LINE (QH + 1, QV + 1)-(QH + 639, QV + 199), 0, BF
              TA1 = TA
              QA1 = QA
     END IF

IF KE$ = "T" THEN
 INPUT "text "; TXT$
 INPUT "size "; ss
TXT$ = UCASE$(TXT$)
 DTA$ = DTA$ + "~" + TXT$ + "," + STR$(ss) + ";"
 CLS
END IF

 IF KE$ = "D" THEN
 IF datv = 0 THEN dtav = 1 ELSE dtav = 0
 END IF

IF KE$ = "C" THEN

   INPUT " color #"; C

  DTA$ = DTA$ + "C" + STR$(C) + ";"
   CLS
END IF
IF KE$ = "I" THEN
 INPUT "Size 0-255"; CSIZE
 CLS


END IF
         SIZE = 10
IF KE$ = CHR$(9) THEN CALL ldsv(DTA$)

IF KE$ = CHR$(8) THEN CALL delete(DTA$)
IF KE$ = "7" THEN DTA$ = DTA$ + "F" + STR$(SIZE) + ";"
IF KE$ = "9" THEN DTA$ = DTA$ + "G" + STR$(SIZE) + ";"
IF KE$ = "3" THEN DTA$ = DTA$ + "H" + STR$(SIZE) + ";"
IF KE$ = "1" THEN DTA$ = DTA$ + "E" + STR$(SIZE) + ";"
IF KE$ = "8" THEN DTA$ = DTA$ + "U" + STR$(SIZE) + ";"
IF KE$ = "2" THEN DTA$ = DTA$ + "D" + STR$(SIZE) + ";"
IF KE$ = "4" THEN DTA$ = DTA$ + "L" + STR$(SIZE) + ";"
IF KE$ = "6" THEN DTA$ = DTA$ + "R" + STR$(SIZE) + ";"
IF KE$ = "0" THEN DTA$ = DTA$ + "X" + STR$(SIZE) + ";"
IF KE$ = "." THEN DTA$ = DTA$ + "Z" + STR$(SIZE) + ";"
IF KE$ = "P" THEN
      INPUT "posnc #"; posnc

END IF
   ZDTA$ = DTA$

END SELECT

  L = LEN(pro$)
    IF WALK = 0 THEN
    IF SETX <> 0 THEN X = SETX: SETX = 0
    IF SETY <> 0 THEN Y = SETY: SETY = 0
    ELSE
    IF SETX < (X) THEN X = X - 10
    IF SETX > (X) THEN X = X + 10
    IF SETY < (Y) THEN Y = Y - 10
    IF SETY > (Y) THEN Y = Y + 10


    END IF
    CURRENTX = X: CURRENTY = Y

    IF X <> (X1) OR Y <> (Y1) THEN CLS : X1 = X: Y1 = Y
    XPOS = X
    YPOS = Y

 WINDOW SCREEN (X, Y)-(X + 640, Y + 200)

 IF RD = 0 THEN hcirc = hcirc + 1: IF hcirc > 190 THEN RD = 1
 IF RD = 1 THEN hcirc = hcirc - 1: IF hcirc < 30 THEN RD = 0

 IF dn = 0 THEN vcirc = vcirc + 1: IF vcirc > HT THEN dn = 1
 IF dn = 1 THEN vcirc = vcirc - 1: IF vcirc < 30 THEN dn = 0
 

 CALL SHOWTEXT(100, -180, 850, 210, STR$(X) + CHR$(13) + " " + STR$(Y) + CHR$(13) + TEXTROUTER$ + CHR$(13) + LOWTEXT$ + LOPP$, "LOWLEVEL")
 ccc = ccc + 1: IF ccc > 18 THEN ccc = 0

 CIRCLE (hcirc, vcirc), 30, ccc: CALL SHOWTEXT(100, 50, 200, HT, T$ + KE$, "UNIVAC 1101" + CHR$(13))
  CIRCLE (hcirc1, vcirc1), 30, 0
   hcirc1 = hcirc
   vcirc1 = vcirc
 TZ$ = "UNIVAC CORE MEMORY"
 CALL SHOWTEXT(100, 170, 200, HT, TZ$, SETPOINTER$)
 'ON ERROR GOTO ER1:
 IF TPS = 20 THEN
  OPEN "B:\UNICORE.MEM" FOR INPUT AS #1

 INPUT #1, TM$
 CLOSE #1
 END IF

 CALL SHOWTEXT(100, 280, 200, HT, TM$, "TIME")


 unitext$ = " Extended Univac Basic " + CHR$(13) + "---" + CHR$(13) + MAINTEXT$

 CALL SHOWTEXT(320, 50, 500, 200, unitext$, "MAIN")

 CALL SHOWTEXT(920, 50, 500, 200, TEXT1$, "AUXTEXT")

 VID1H = -420
 VID1V = 50
 VID1BC = 8
 CALL SHOWTEXT(VID1H, VID1V, 420, 200, TEXT1$, "VIDEO1")
 REM AFTER WINDOW DRAW
 'PAINT (VID1H + 10, VID1V + 30), VID1BC, 7


      

 IF KE$ = CHR$(27) THEN EXT = 1
 IF LTIME$ <> (TIME$) THEN
  LTIME$ = TIME$: TPS = TPS + 1: IF TPS > 40 THEN TPS = 0
  LDATE$ = DATE$

 END IF
 T$ = TIME$

LINE (MX, MY)-(MX + 5, MY + 5), 7, B
IF MX <> (MX1) OR MY <> (MY1) THEN
 LINE (MX1, MY1)-(MX1 + 5, MY1 + 5), 0, B
 'MX1 = MX
 'MY1 = MY


 END IF


REM RUN THE PROGRAM

IF lngoto > 0 THEN xx = lngoto: lngoto = 0
 
IF KE$ = CHR$(0) + CHR$(134) THEN BREAK = 1: PRINT : PRINT "BREAK AT LINE "; xx: barun = 0

 CMD$ = PROGRAMARRY$(xx)

 PRINT STR$(xx) + " " + CMD$
 'SLEEP
IF barun = 1 THEN
 CALL PROC(CMD$)
 xx = xx + 1
 ELSE
 xx = 0
END IF


 IF xx >= 199 THEN xx = 0: barun = 0

'SLEEP
'CLS


DTA$ = ZDTA$
DTA1$ = DTA$


QH = cadh
QV = cadv
B = 0
CALL SHOWTEXT(QH, QV, 640, 200, TEXT1$, "CADVIDEO")
  CALL VBDRAW(AG, QA, TA, DTA$, QH + 320, QV + 100, B, QH + 640, QV + 200)
    PONGH = 500
     PONGV = 570
      CALL SHOWTEXT(PONGH, PONGV, 640, 200, TEXT1$, "EMULATED PONG")
   tspeed = .5
   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

  TDH = 1540: TDV = 0
   TDTEXT$ = CHR$(13) + LTIME$ + CHR$(13) + LDATE$ + CHR$(13)

CALL SHOWTEXT(TDH, TDV, 640, 200, TDTEXT$, "TIMEDATE")
 SWH1 = 2220: SWV = 0
  CALL SWITCHBOARD(SWH1, SWV1, SWN1$, "SWITCHBOARD 1")
   NOTEX = 3120
    NOTEY = -100
     CALL NOTEPAD(NOTEX, NOTEY, NOTETEXT$)
      AUDIOX = 3800: AUDIOY = -100
       CALL AUDIOPANNEL(AUDIOX, AUDIOY)

       COMPORTX = 4600: COMPORTY = -100
        CALL COMPORTPANEL(COMPORTX, COMPORTY)


 
CHMOUSE = CHMOUSE + 1
 IF CHMOUSE > 3 THEN
  CALL mouse(3): CHMOUSE = 0
   'LOCATE 20, 2: PRINT MX, MY, MA, MB, BU, BUR
     END IF
      IF BU = -1 THEN
   SP = 10
   IF MX > 500 THEN SETX = X + SP: BU = 0
   IF MX < 100 THEN SETX = X - SP: BU = 0
   IF MY > 400 THEN SETY = Y + SP: BU = 0
   IF MY < 100 THEN SETY = Y - SP: BU = 0
 
'LOCATE 1, 1
'PRINT "Size "; size; " "; "color "; C; " postinc "; posnc
' PRINT DTA$
  END IF

LOCATE 23, 1: PRINT LOPP$, X, Y


 IF LP = 0 THEN LOPP$ = CHR$(219)
 IF LP = 1 THEN LOPP$ = " "
 IF LOPPTM$ <> (TIME$) THEN LOPPTM$ = TIME$: LP = LP + 1
 IF LP > 1 THEN LP = 0
  GRMX = CURRENTX + MX
  GRMY = CURRENTY + MY

CALL drawm(MXA, MYA, MCOLOR)
LOOP UNTIL EXT = 1
END
ER1:
 CLOSE
OPEN "B:\UNICORE.MEM" FOR OUTPUT AS #1
PRINT #1, "EMPTY"
CLOSE #1
RUN


RESUME

SUB AUDIOPANNEL (AUDIOX, AUDIOY)
X = AUDIOX
Y = AUDIOY

HEI = Y + 400
WID = X + 700
LINE (X, Y)-(WID, HEI), 7, B
LINE (X + 2, Y + 2)-(WID - 2, HEI - 2), 4, B
      S = 2: C = 7
        TXT$ = "AUDIO-PANNEL"

CALL PRTEXT(TXT$, X + 5, Y + 20, S, C, WID, HEI)


END SUB

SUB balist

FOR X = 1 TO (PROGLENGTH)
TE$ = PROGRAMARRY$(X)
L = LEN(TE$)
IF L > 0 THEN
PRINT X, TE$
END IF

NEXT X
SLEEP
END SUB

SUB basicPROGRUN
REM
REM
REM RUN THE PROGRAM
  barun = 1
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)

 pro$ = STR$(xx) + " " + CMD$
 'SLEEP
 CALL PROC(CMD$)

xx = xx + 1
LOOP UNTIL BREAK = 1 OR xx >= 1000 OR xx > (PROGLENGTH)
barun = 0
'SLEEP
'CLS
END SUB

SUB CLCKNOISE
FOR T = 2200 TO 3450 STEP 5
SOUND 255 + T, .2
NEXT T
END SUB

SUB COMPORTPANEL (COMPORTX, COMPORTY)

X = COMPORTX
Y = COMPORTY

WID = X + 620
HEI = Y + 200
H = X + 3
V = Y + 30

LINE (X, Y)-(WID, HEI), 7, B
 TXT$ = "COM 1 " + CHR$(13) + "COM 2 " + CHR$(13) + LOPP$
 TXT$ = TXT$ + "---" + LOPP$ + CHR$(13) + COMSTATUS$ + LOPP$

     C = 7
     S = 2

CALL PRTEXT(TXT$, H, V, S, C, WID, HEI)


END SUB

SUB delete (DTA$)

LN = LEN(DTA$)
 CT = LN
 DO
 CT = CT - 1
 LN = LN - 1
 IF CT > 0 AND CT < (LN) THEN CH$ = MID$(DTA$, CT, 1)


LOOP UNTIL CT = 1 OR CH$ = ";"
IF LN > 2 THEN
PP$ = LEFT$(DTA$, LN)
DTA$ = PP$
END IF
END SUB

SUB DLINE (AG, VR, EA, DMO, H, V, X, Y, C, bl, N, SIZE, swth, shht)
AI = 1
'ADG = AG * 3.142857 / 180
AI = AI * 3.142857 / 180
FOR AAG = 1 TO (ADG) STEP (AI)
NEXT AAG
V1 = V + ((DMO * (VR)) / 6)
h1 = H


IF bl = 0 THEN

IF h1 > 0 AND h1 < (swth) AND V1 > 0 AND V1 < (shht) THEN

LINE (H, V)-(h1, V1), C

END IF
END IF
X = h1
Y = V1
bl = 0
IF N = 1 THEN
X = H
Y = V
N = 0
END IF

END SUB

SUB drawm (H, V, MCOLOR)

 GRMX = CURRENTX + MX
 GRMY = CURRENTY + MY

PSET (H, V), MCOLOR
'DRAW "c0s0" + STR$(MCOLOR) + graph$
IF MX1 <> (MX) OR MY1 <> (MY) THEN
LINE (MX1, MY1)-(MX1 + 7, MY1 + 7), 0, BF
MX1 = GRMX
MY1 = GRMY
END IF
C = INT(RND(1) * (16)) + 1
LINE (GRMX, GRMY)-(GRMX + 7, GRMY + 7), C, BF
END SUB

SUB GETTX (DTA$, CT, TXT$, S)
TE = 0
DO
    TTE$ = MID$(DTA$, CT + TE, 1)
    TE = TE + 1
    LOOP UNTIL TTE$ = ","
    TXT$ = MID$(DTA$, CT + 1, TE - 2)
   
    TS = CT + TE
    TT = 0
    DO
       TT = TT + 1
    TTE$ = MID$(DTA$, TS + TT, 1)
    LOOP UNTIL TTE$ = ";"
    
    S = VAL(MID$(DTA$, TS, TT))
 
CT = CT + (TT)
END SUB

SUB GETVL (DTA$, CT, SZ)
TE = 0
DO
    TTE$ = MID$(DTA$, CT + TE, 1)
    TE = TE + 1
    LOOP UNTIL TTE$ = ";"
    SZ = VAL(MID$(DTA$, CT + 1, TE - 2))
   

END SUB

SUB gnpart (CMD$, otxt$, q)

LL = LEN(CMD$)
IF q <= (LL) THEN
IF q = 0 THEN q = 1

otxt$ = ""
CH$ = ""

DO

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

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

IF q <= (LL) THEN
  q = q + 1

END IF


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

END IF

END SUB

SUB ldsv (DTA$)

     PRINT " ### What do you want to do ###"

     PRINT "load a cad file or save one"
     PRINT "saves to current directory"
  
    INPUT "<L> , <S>"; ls$
    ls$ = UCASE$(ls$)


    IF ls$ = "L" THEN
    REM LOADING ALGORITHM
  
    PRINT "<.Cad> added automatically"
    PRINT
    DO
    SHELL "DIR *.CAD"
    INPUT "NAME OF QBcad TO LOAD INTO  "; Cad$
     IF Cad$ = "" THEN BEEP

    LOOP UNTIL Cad$ <> ""
    
      CLOSE #1
      
        PRINT "OPENING-"; Cad$
        OPEN Cad$ + ".cad" FOR INPUT AS #1
    
        LINE INPUT #1, DTA$
   
    CLOSE #1
    END IF


    IF ls$ = "S" THEN

    REM savinG ALGORITHM
 
    PRINT "<.Cad> added automatically"
    DO
    SHELL "DIR *.CAD"
    INPUT "NAME OF QBcad TO be saved  "; Cad$
     IF Cad$ = "" THEN BEEP

    LOOP UNTIL Cad$ <> ""
   
      CLOSE #1
     
        PRINT "OPENING-"; Cad$
      
        OPEN Cad$ + ".cad" FOR OUTPUT AS #1
    
        PRINT #1, DTA$
   
    CLOSE #1


    END IF

    PRINT "## done ## HIT ANY <KEY> "
     


     SLEEP
     CLS

   


END SUB

SUB mainmenu (TEXTROUTER$)
  LOCATE 3, 3
  PRINT " 1. LOWLEVEL           11. Calculator  "
  PRINT " 2. UNI - BASIC        12. Audio Panel "
  PRINT " 3. FORTRAN "
  PRINT " 4. Video1"
  PRINT " 5. cad video"
  PRINT " 6."
  PRINT " 7. NOTEPAD"
  PRINT " 8. TIMEDATE"
  PRINT " 9. SWITCHBOARD"
  PRINT " 10. COMPORTS"

  LOCATE 2, 2: INPUT "] COMMAND ["; CO$
   SELECT CASE (CO$)
   CASE IS = "MOUSE"
    CALL MOUSEMENU
   CASE IS = "10"
   SETX = 4600: SETY = -100
   
  
   CASE IS = "AUDIO"
   SETX = AUDIOX: SETY = AUDIOY
   TEXTROUTER$ = "AUDIOPANEL"

   CASE IS = "NOTEPAD", "7"
 
   TEXTROUTER$ = "NOTEPAD"
 SETX = NOTEX
 SETY = NOTY
   CASE IS = "TIMEDATE", "8"
   TEXTROUTER$ = "TIMEDATE"
   TIDAX = 1540
   tiday = 0
   SETX = TIDAX: SETY = tiday

   CASE IS = "REBOOT"
   RUN
   CASE IS = "SWITCH", "SWITCHBOARD"
   SETX = 2220: SETY = 0
  
   CASE IS = "JUMP"
   WALK = 0

   CASE IS = "WALK"
   WALK = 1

   CASE IS = "1"
   SETX = 16: SETY = -186
  TEXTROUTER$ = "LOWLEVEL"
   CASE IS = "2"
   SETX = 186: SETY = 32
   TEXTROUTER$ = "MAIN"
   CASE IS = "3"
   '891 46
   SETX = 891
   SETY = 46
    TEXTROUTER$ = "AUXTEXT"
 

   CASE IS = "4"
   CALL video1show(X, Y)
   TEXTROUTER$ = "VIDEO1"
   CASE IS = "5"
   TEXTROUTER$ = "CADVIDEO"
   SETX = 320
   SETY = 300
   CASE IS = "7"
   TEXTROUTER$ = "PONG"
   SETX = 490: SETY = 570
   CASE IS = "AUDIO", "12"
   TEXTROUTER$ = "AUDIO"
   SETX = 2220: SETY = 0
  
   END SELECT
CLS

END SUB

SUB mouse (WHICH)

       
'0 = Mouse Init
'1 = Mouse Driver
'2 = Mouse Put
'3 = Mouse Status
'4 = Mouse Hide
'5 = Mouse Show
IF WHICH = 0 THEN
  RESTORE
  mouser$ = SPACE$(57)
  FOR I% = 1 TO 57
    READ A$
    H$ = CHR$(VAL("&H" + A$))
    MID$(mouser$, I%, 1) = H$
  NEXT I%
  AX% = 0
  BX% = 0
  CX% = 0
  DX% = 0
  mouse 1
  MouseInit% = AX%
  mouse 5
END IF
IF WHICH = 1 THEN
  DEF SEG = VARSEG(mouser$)
  mouser% = SADD(mouser$)
  CALL Absolute(AX%, BX%, CX%, DX%, mouser%)
END IF
IF WHICH = 2 THEN
  AX% = 4
  CX% = X%
  DX% = Y%
  BX% = 0
  mouse 1
END IF
IF WHICH = 3 THEN
  AX% = 3
  mouse 1
  mouseleftbutton = ((BX% AND 1) <> 0)
  MouseRightButton = ((BX% AND 2) <> 0)
  mousexpos = CX%
  mouseypos = DX%
END IF
IF WHICH = 4 THEN
 AX% = 2
 BX% = 0
 CX% = 0
 DX% = 0
 mouse 1
END IF
IF WHICH = 5 THEN
  AX% = 1
  BX% = 0
  CX% = 0
  DX% = 0
  mouse 1
END IF

'LOCATE 21, 2
'PRINT AX%, BX%, CX%, DX%

MX = CX%: MY = DX%
MA = AX%: MB = BX%
BU = mouseleftbutton
BUR = MouseRightButton
'IF



END SUB

SUB MOUSEMENU
LOCATE 10, 20: PRINT "__________________________________"
      
'0 = Mouse Init
'1 = Mouse Driver
'2 = Mouse Put
'3 = Mouse Status
'4 = Mouse Hide
'5 = Mouse Show

PRINT "##### MOUSE MENU ###############################"
PRINT "#     0. INIT MOUSE"
PRINT "#     1. Mouse driver"
PRINT "#     2. mouse put"
PRINT "#     3. mouse status"
PRINT "#     4. mouse hide"
PRINT "#     5. mouse show"
PRINT "#     6. exit"
INPUT " [ "; m
 IF m = 6 THEN GOTO ED1:
 CALL mouse(m)
ED1:
CLS
END SUB

SUB NOTEPAD (NOTEX, NOTEY, NOTETEXT$)
X = NOTEX
Y = NOTEY
WID = X + 620
HEI = Y + 420
TOPY = Y - 70
PRX = X + 3
PRY = TOPY + 3
IF BUR = -1 THEN
BEEP
IF GRMX > (PRX) AND GRMX < (PRX + 20) AND GRMY > (PRY) AND GRMY < (PRY + 20) THEN LPRINT NOTETEXT$: CLS : NOTETEXT$ = "": BUR = 0
BUR = 0
END IF


LINE (X, Y - 5)-(WID, TOPY), 7, B
LINE (PRX, PRY)-(PRX + 20, PRY + 20), 7, B


LINE (X, Y)-(WID, Y + HEI), 7, B
LINE (X + 3, Y + 3)-(WID - 3, Y + HEI - 3), 15, B

TSX = X + 10
TSY = Y + 30
DAT$ = " NOTEPAD 2003 " + CHR$(13) + "[" + NOTETEXT$ + " " + LOPP$ + " "
C = 7: SZ = 2: S = SZ
CALL PRTEXT(DAT$, TSX, TSY, S, C, WID, HEI)

END SUB

SUB PROC (pro$)
 text$ = pro$

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

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

  IF LNV > (PROGLENGTH) THEN PROGLENGTH = LNV

  END IF
  END IF

'PRINT WORD$, V1
 'SLEEP

 SELECT CASE (word$)
 CASE IS = "TIME", "DATE"
 TEXTROUTER$ = "TIMEDATE"
   SETX = TIDAX: SETY = tiday


 CASE IS = "HOME"

 SETX = 80
 SETY = 20
 CASE IS = "NOTONE", "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 = "TON3"
  TON4 = V1
 CASE IS = "TON4"
 
  TON5 = V1



 CASE IS = "GOTO"
  lngoto = VAL(p1$)


 CASE IS = "VIDEO"
 CALL video1show(X, Y)

 CASE IS = "BEEP"
 BEEP

 CASE IS = "LPT1OUT"

 MESSAGE$ = " TYPE TEXT HIT ENTER "
 'CALL apINPUT(OUTTEXT$, MESSAGE$)
 LPRINT OUTTEXT$

 CASE IS = "VIDEOBINOUT", "VIDBO"


 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 = "TON3"
  TON4 = V1

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

  htext$ = p1$
 CASE IS = "L", "LINE"
     LINE (VID1H + V1, VID1V + v2)-(VID1H + v3, VID1V + v3), v4
 


 CASE IS = "CIRCLE", "CIRC", "C"
    CIRCLE (VID1H + V1, VID1V + 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 = "CLS"
 'CALL clprompt
 CASE IS = "RUN"
        barun = 1
  'CALL basicPROGRUN
 
 CASE IS = "SAVE"
  'CALL SVPROGRAM(P1$)


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


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


 CASE IS = "EXIT", "REBOOT"

  'CALL SAVESET
     

  CLS

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

   choice$ = UCASE$(choice$)

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

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

   END SELECT


 CASE IS = "QBASIC"
  CLS

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

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

 IF prnbr = 0 THEN LPRINT p1$


 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 balist




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



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

   SHELL "DIR *.COB"
   SLEEP

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

 CASE IS = "PLAY"
  PLAY p1$

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

 END SELECT




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

'END IF



END IF

CALL prostack(pro$, textstack$)

pro$ = ""

END SUB

SUB prostack (pro$, textstack$)
'
' runthrough text stack and cut extra chr(13)'s
'

textstack$ = textstack$ + CHR$(13) + pro$

textstack$ = textstack$ + CHR$(13) + pro$ + CHR$(13)

L = LEN(textstack$)
FOR T = 1 TO (L)
CH$ = MID$(textstack$, T, 1)
IF CH$ = CHR$(13) THEN cr13 = cr13 + 1
IF cr13 >= 12 THEN
 TX$ = RIGHT$(textstack$, L - T)

END IF
IF cr13 >= 12 OR T >= L THEN GOTO np:

NEXT T
np:
  textstack$ = TX$

END SUB

SUB PRTEXT (TXT$, H, V, S, C, swth, shht)
HH = H: VV = V
SZ = S
VVV = 0
HH = HH + SZ


FOR CT = 1 TO LEN(TXT$)
VV = V + VVV
LINE (HH, VV)-(HH + (SZ * 6 - 1), VV - (SZ * 7)), 0, BF
CH$ = MID$(TXT$, CT, 1)
TX = HH + 2
TY = VV - 8
SELECT CASE (CH$)
CASE IS = CHR$(219)
 RD = HH + (SZ * 6)
 LINE (HH, VV)-(RD, VV - 6), 7, BF
 HH = RD
CASE IS = CHR$(32)
 HH = HH + (SZ * 6)
CASE IS = CHR$(13)
 VVV = VVV + (SZ * 8)
 'VV = VV + (SZ * 16)
 HH = H + SZ
CASE IS = "#"
HH = H
VVV = VVV + (SZ * 8)
    CASE IS = "0"
    LINE (TX + 1, TY + 1)-(TX + 5, TY + 5), C, B
     LINE (TX + 5, TY + 1)-(TX + 1, TY + 5), C
    HH = HH + (SZ * 6)
    CASE IS = "1"
     LINE (TX + 3, TY + 1)-(TX + 3, TY + 5), C
     LINE (TX + 1, TY + 5)-(TX + 5, TY + 5), C
    HH = HH + (SZ * 6)
    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
    HH = HH + (SZ * 6)
    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
    HH = HH + (SZ * 6)
    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
    HH = HH + (SZ * 6)
    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
    HH = HH + (SZ * 6)
    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
    HH = HH + (SZ * 6)
    CASE IS = "7"
      LINE (TX + 1, TY + 1)-(TX + 5, TY + 1), C
       LINE -(TX + 1, TY + 5), C
    HH = HH + (SZ * 6)
    CASE IS = "8"
      LINE (TX + 1, TY + 1)-(TX + 5, TY + 5), C, B
       LINE (TX + 1, TY + 3)-(TX + 5, TY + 3), C
    HH = HH + (SZ * 6)
    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
     HH = HH + (SZ * 6)
CASE IS = "A"
CALL VBCH("U;U;U;U;U;E;R;G;D;D;L;L;L;R;R;R;D;D;D;D;", HH, VV, SZ, C)
HH = HH + (SZ * 6)

CASE IS = "B"
CALL VBCH("U;U;U;U;U;U;R;R;G;D;F;L;R;G;D;F;L;L;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "C"
CALL VBCH("R;R;R;R;L;L;L;L;U;U;U;U;U;U;R;R;R;R;", HH, VV, SZ, C)
HH = HH + (SZ * 6)

CASE IS = "D"
CALL VBCH("R;R;R;L;L;L;U;U;U;U;U;U;R;R;R;G;D;D;D;D;F;", HH, VV, SZ, C)
HH = HH + (SZ * 6)

CASE IS = "E"
CALL VBCH("R;R;R;R;L;L;L;L;U;U;U;R;R;R;L;L;L;U;U;U;R;R;R;R;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "F"
CALL VBCH("U;U;U;R;R;R;L;L;L;U;U;U;R;R;R;R;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "G"
CALL VBCH("R;R;R;U;U;L;L;R;R;D;D;L;L;L;U;U;U;U;U;E;R;G;D;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "H"
CALL VBCH("U;U;U;U;U;U;D;D;D;R;R;R;U;U;U;D;D;D;D;D;D;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "I"
CALL VBCH("R;R;R;L;U;U;U;U;U;U;L;R;R;R;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "J"
CALL VBCH("U;D;R;R;R;U;U;U;U;U;U;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "K"
CALL VBCH("U;U;U;U;U;U;D;D;DR;E;E;E;F;F;F;G;G;G;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "L"
CALL VBCH("R;R;R;R;L;L;L;L;U;U;U;U;U;U;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "M"
CALL VBCH("U;U;U;U;U;U;G;G;G;E;E;E;D;D;D;D;D;D;", HH, VV, SZ, C)
HH = HH + (SZ * 7)
CASE IS = "N"
CALL VBCH("U;U;U;U;U;U;G;G;G;U;U;U;D;D;D;D;D;D;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "O"
CALL VBCH("U;U;U;U;U;U;R;R;R;R;D;D;D;D;D;D;L;L;L;L;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "P"
CALL VBCH("U;U;U;U;U;U;R;R;R;R;D;D;D;D;L;L;L;L;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "Q"
CALL VBCH("U;U;U;U;U;U;R;R;R;R;D;D;D;D;D;D;H;G;G;H;L;L;L;L;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "R"
CALL VBCH("U;U;U;U;U;U;R;R;R;G;D;F;L;L;R;R;G;D;D;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "S"
CALL VBCH("R;R;R;E;U;H;L;H;U;E;R;R;R;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "T"
HH = HH + (SZ * 2)
CALL VBCH("U;U;U;U;U;U;R;R;L;L;L;L;", HH, VV, SZ, C)
HH = HH + (SZ * 4)
CASE IS = "U"
CALL VBCH("U;U;U;U;U;U;D;D;D;D;D;D;R;R;R;R;U;U;U;U;U;U;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "V"
VV = VV - (SZ * 6)
CALL VBCH("D;D;D;G;G;G;E;E;E;U;U;U;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "W"
VV = VV - (SZ * 6)
CALL VBCH("D;D;D;D;G;G;E;E;U;D;G;G;E;E;U;U;U;U;", HH, VV, SZ, C)
HH = HH + (SZ * 12)
CASE IS = "X"
VV = VV - (SZ * 6)
CALL VBCH("G;G;G;G;G;G;H;H;H;E;E;E;F;F;F;F;F;F;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "Y"
VV = VV - (SZ * 6)
CALL VBCH("G;G;G;E;E;E;F;F;F;D;D;D;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
CASE IS = "Z"
VV = VV - (SZ * 6)
CALL VBCH("R;R;R;R;R;R;F;F;F;F;F;F;R;R;R;R;R;R;", HH, VV, SZ, C)
HH = HH + (SZ * 6)
END SELECT
VV = V + VVV
NEXT CT

END SUB

SUB SGLINE (AG, VR, EA, ANGLE, SZ, X, Y, H, V, C, SIZE, bl, N, swth, shht)

'REM EA IS VERTICAL ANGLE
'VR IS HOROZONTAL ANGLE
' AG IF FRONTAL ANGLE
'If AG = 0 Then AG = 1
IF VR = 0 THEN VR = 1
  cl = 0
  AI = 5
  AI = AI * 3.142857 / 180
   EA = EA * 3.142857 / 180
   FOR TR = (ANGLE) TO (ANGLE + EA) STEP AI
NEXT TR
'agc = AG * 3.142857 / 180

FOR ATR = (AI) TO (AI + agc) STEP AI
NEXT ATR

DO
  'AGD = AG * 3.142857 / 180
  cl = cl + SZ
  X = H + (cl * SIZE) * COS(TR)
  Y = V + (cl * SIZE) * SIN(TR) / VR '* ATR
  IF bl = 0 THEN
  IF X > 0 AND X < swth AND Y > 0 AND Y < shht THEN
    LINE (H, V)-(X, Y), C
  END IF
  END IF
LOOP UNTIL (cl) >= (SZ)

bl = 0
IF N = 1 THEN
X = H
Y = V
N = 0
END IF

END SUB

SUB SHOWTEXT (H, V, SZ, HT, T$, SETPOINTER$)

bc = 0
WWT = SZ
WHT = HT
TXT$ = T$
 DRAW "s7"
 
   X = H
   Y = V
   C = 14
   bc = 0
 IF BU = 1 THEN
    jh = MX + XPOS
    jv = MY + YPOS
     IF jh > (H) AND jv > (V) AND jh < (H + WWT) AND V < (V + WHT) THEN
      TEXTROUTER$ = SETPOINTER$

     END IF
END IF
 A = X - 10
 B = Y - 10
 NA = A - 12
 NB = B - 8

IF H >= (CURRENTX - 640) AND H <= (CURRENTX + 640) AND V >= (CURRENTY - 200) AND V <= (CURRENTY + 200) THEN
 LINE (NA, NB)-(NA + WWT, NB - 8), 5, B

 LINE (A + WWT, B)-(X + WWT, Y), 15
 LINE (A, B + WHT)-(X, Y + WHT), 15
 LINE (X, Y)-(A, B), 15
 LINE (A, B)-(A, B + WHT), 15
 LINE (A, B)-(A + WWT, B), 15
 LINE (X, Y)-(X + WWT, Y + WHT), C, B: LINE (X, Y)-(X + 10, Y + 10), C, B
 LINE (X, Y + WHT - 10)-(X + 10, Y + WHT), 8, B
 IF BU = 0 THEN
  txx = 1
  tyy = 1
  TXT$ = SETPOINTER$ + TXT$ + CR$


  LL = LEN(TXT$)
  FOR scrup = 1 TO (LL)
   CH$ = MID$(TXT$, scrup, 1)
    txx = txx + 1
    IF txx * 8 > (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 = CHR$(219)
    LINE (TX + 1, TY + 1)-(TX + 5, TY + 5), 7, BF
   
    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 "c" + STR$(C) + "r5l5d4r5u2l2"

    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 "c" + STR$(C) + "d4l4u2"
    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)
    TY = (tyy * 16) + Y
    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), C


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

    LINE (TX + 8, TY + 1)-(TX + 16, TY + 7), bc, BF
    LX = TX: LY = TY

END IF
END IF





'
END SUB

SUB SWICTH (H, V, N)
   LC = H + 5
   RC = H + 70
   TOP = V + 5
   BOT = V + 41
    LINE (LC, TOP)-(RC, BOT), 7, B
   

  LINE (H + 5, V + 5)-(H + 71, V + 71), 5, B
  IF N = 0 THEN
  CIRCLE (H + 30, V + 20), 10, 7
  ELSE
   CIRCLE (H + 30, V + 20), 10, 0
  END IF
  IF N = 2 THEN CIRCLE (H + 30, V + 20), 10, 4: CIRCLE (H + 30, V + 40), 10, 1
 

  IF BUR = -1 THEN
 IF GRMX >= (LC) AND GRMX <= (RC) AND GRMY >= (TOP) AND GRMY <= (BOT) THEN
      'CLS
     N = N + 1
     IF N > 2 THEN N = 0
     SOUND 200 + 1, .2
     SOUND 200 + 40, .2
     SOUND 200 + 140, .2
     
 END IF
   END IF
 

   
    DO
    CALL mouse(3)
     LOOP UNTIL BUR = 0
      BUR = 0

END SUB

SUB SWITCHBOARD (H, V, SWNUMBER$, SWNAM$)
NN$ = ""
TEMP$ = ""
IF H >= (CURRENTX - 640) AND H <= (CURRENTX + 640) AND V >= (CURRENTY - 200) AND V <= (CURRENTY + 200) THEN
        
        CH$ = ""
        NN$ = ""
  SPL = 1
  T$ = " CLICK TO ACTIVATE  " + SWNUMBER$
  HT = 300
  SZ = 650
  L = LEN(SWNUMBER$)

CALL SHOWTEXT(H, V, SZ, HT, T$, SWNAM$)

NN$ = MID$(SWNUMBER$, 1, 1)
  DO
  IF SPL <= (L) THEN
   CH$ = MID$(SWNUMBER$, SPL, 1)
    N = VAL(CH$)
     SWX = H + X: SWY = V + Y
       CALL SWICTH(SWX, SWY, N)
        NN$ = STR$(N)
          X = X + 80: IF X > 620 THEN X = 0: Y = Y + 80: IF Y > 200 THEN Y = 200
      CH$ = NN$
    
   END IF
     IF CH$ <> CHR$(32) THEN TEMP$ = TEMP$ + CH$
  SPL = SPL + 1
 LOOP UNTIL SPL >= 12 OR SPL >= (L)


 SWNUMBER$ = TEMP$
 
END IF
END SUB

SUB VBCH (DAT$, H, V, SZ, C)
X = H
Y = V
X1 = H
Y1 = Y
REM BUILD DATA
LL = LEN(DAT$)
FOR CT = 1 TO (LL)
CH$ = MID$(DAT$, CT, 1)
 CH$ = UCASE$(CH$)

 REM ACTUALLY DRAWLING SHAPE

IF CH$ = "L" THEN X = X - SZ
IF CH$ = "D" THEN Y = Y + SZ
IF CH$ = "R" THEN X = X + SZ
IF CH$ = "U" THEN Y = Y - SZ
IF CH$ = "F" THEN X = X - SZ: Y = Y + SZ
IF CH$ = "G" THEN X = X + SZ: Y = Y + SZ
IF CH$ = "H" THEN X = X - SZ: Y = Y - SZ
IF CH$ = "E" THEN X = X + SZ: Y = Y - SZ



LINE (X1, Y1)-(X, Y), C
X1 = X: Y1 = Y
NEXT CT
END SUB

SUB VBDRAW (AG, QA, TA, DTA$, H, V, B, swth, shht)

IF H >= (CURRENTX - 640) AND H <= (CURRENTX + 840) AND V >= (CURRENTY - 200) AND V <= (CURRENTY + 400) THEN



C = 7
VR = QA
CANGLE = TA
N = 0
bl = 0
 SIZE = 5
  SA = 0
  SA = SA * 3.142857 / 180

 ANGLE = CANGLE * 3.142857 / 180
 'EA = EA * 3.142857 / 180
  AI = 1
  AI = AI * 3.142857 / 180
  cl = 1
  IF B = 1 THEN C = 0
X = H
Y = V
REM BUILD DATA
LL = LEN(DTA$)
FOR CT = 1 TO (LL)
CH$ = MID$(DTA$, CT, 1)
 CH$ = UCASE$(CH$)
 IF CH$ = "M" THEN
    TE = 0
    CT = CT + 1
    DO
    TE = TE + 1
    TTE$ = MID$(DTA$, CT + TE, 1)
    LOOP UNTIL TTE$ = ","
    H = VAL(MID$(DTA$, CT, TE))
    CT = TE + CT
    TE = 0
    CT = CT + 1
    DO
    TE = TE + 1
    TTE$ = MID$(DTA$, CT + TE, 1)
    LOOP UNTIL TTE$ = ";"
    V = VAL(MID$(DTA$, CT, TE))
    'Debug.Print "M ,"; H; " "; V
    CT = TE + CT
    X = H
    Y = V
    END IF

 REM ACTUALLY DRAWLING SHAPE
IF CH$ = "~" THEN
CALL GETTX(DTA$, CT, TXT$, S)
CALL PRTEXT(TXT$, H, V, S, C, swth, shht)
END IF

IF B = 0 AND CH$ = "C" THEN
CALL GETVL(DTA$, CT, SZ)
  C = SZ
 bl = 0
  
    ' PRINT "C"; C
END IF


IF CH$ = "S" THEN
CALL GETVL(DTA$, CT, SZ)
  SIZE = SZ

    END IF

IF CH$ = "B" THEN
    bl = 1
    END IF
IF CH$ = "N" THEN
    N = 1
    'CT = CT + 1
END IF
 IF CH$ = "T" THEN
   CT = CT + 1
CALL GETVL(DTA$, CT, SZ)
  'Debug.Print "SZ "; SZ
  ANGLE = SZ
  ANGLE = ANGLE * 3.142857 / 180
  ANGLE = ANGLE + CANGLE * 3.142857 / 180
  END IF
 
IF CH$ = "X" THEN
CALL GETVL(DTA$, CT, SZ)
    'rem move 3d forward
   DMO = SZ
  CALL DLINE(AG, VR, EA, DMO, H, V, X, Y, C, bl, N, SIZE, swth, shht)
END IF
IF CH$ = "Z" THEN
CALL GETVL(DTA$, CT, SZ)
    'rem move 3d backward
       DMO = 0 - SZ
  CALL DLINE(AG, VR, EA, DMO, H, V, X, Y, C, bl, N, SIZE, swth, shht)
END IF
IF CH$ = "U" THEN
CALL GETVL(DTA$, CT, SZ)
  EA = 270 + ANGLE
      CALL SGLINE(AG, VR, EA, ANGLE, SZ, X, Y, H, V, C, SIZE, bl, N, swth, shht)
END IF
 IF CH$ = "R" THEN
CALL GETVL(DTA$, CT, SZ)
    EA = 360 + ANGLE
   CALL SGLINE(AG, VR, EA, ANGLE, SZ, X, Y, H, V, C, SIZE, bl, N, swth, shht)
END IF
IF CH$ = "D" THEN
CALL GETVL(DTA$, CT, SZ)
  EA = 90 + ANGLE
    CALL SGLINE(AG, VR, EA, ANGLE, SZ, X, Y, H, V, C, SIZE, bl, N, swth, shht)
END IF
IF CH$ = "L" THEN
CALL GETVL(DTA$, CT, SZ)
  EA = 180 + ANGLE
 
  CALL SGLINE(AG, VR, EA, ANGLE, SZ, X, Y, H, V, C, SIZE, bl, N, swth, shht)
END IF
IF CH$ = "H" THEN
CALL GETVL(DTA$, CT, SZ)
  EA = 225 + ANGLE
    CALL SGLINE(AG, VR, EA, ANGLE, SZ, X, Y, H, V, C, SIZE, bl, N, swth, shht)
END IF
IF CH$ = "F" THEN
CALL GETVL(DTA$, CT, SZ)
  EA = 45 + ANGLE
 
  CALL SGLINE(AG, VR, EA, ANGLE, SZ, X, Y, H, V, C, SIZE, bl, N, swth, shht)
END IF
IF CH$ = "G" THEN
CALL GETVL(DTA$, CT, SZ)
  EA = 135 + ANGLE
  CALL SGLINE(AG, VR, EA, ANGLE, SZ, X, Y, H, V, C, SIZE, bl, N, swth, shht)
END IF
IF CH$ = "E" THEN
CALL GETVL(DTA$, CT, SZ)
    EA = 315 + ANGLE
  CALL SGLINE(AG, VR, EA, ANGLE, SZ, X, Y, H, V, C, SIZE, bl, N, swth, shht)
END IF


IF N = 0 THEN ' REM CHECK FOR NO UPDATE
IF X <> (H) THEN
H = X
END IF
IF Y <> (V) THEN
V = Y
END IF
END IF
CH$ = ""
 NEXT CT
 IF B = 0 AND H > 0 AND H < (swth) AND V > 0 AND V < (shht) THEN
 LINE (H, V)-(H + 5, V + 5), 4, BF
 END IF

 IF B = 1 THEN

 LINE (H, V)-(H + 5, V + 5), 0, BF

 END IF
END IF

END SUB

SUB video1show (X, Y)
'
SETX = -429
SETY = 26

END SUB

