DECLARE SUB SHOWCARD (NAME$, X!, Y!, BC!)
DECLARE SUB SHOWDECK ()
DECLARE SUB VideoPong (BC, H!, V!)
DECLARE SUB guitextbox (BC, textc!, XH!, YV!, tt$)
DECLARE SUB TESTPANEL (TESTX!, TESTY!)
DECLARE SUB PROCWIN (textrouter$)
DECLARE SUB guibutton (XXB, YYB, szt, RTST, TXT$)
DECLARE SUB EXITPROG (CO$)
DECLARE SUB MOUSEMENU ()
DECLARE SUB mainmenu (textrouter$)
DECLARE SUB COMPORTPANEL (COMPORTX!, COMPORTY!)
DECLARE SUB AUDIOPANNEL (AUDIOX!, AUDIOY!)
DECLARE SUB drawm (H!, V1!, 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 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!, BC!, 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 (BC, pro$)
DECLARE SUB SHOWTEXT (BC!, C!, H!, V!, sz!, HT!, T$, SETPOINTER$)
DECLARE SUB MOUSE (WHICH)
DIM SHARED PROGRAMARRY$(200)

 COMMON SHARED TON1, BC
 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$
COMMON SHARED testt$
COMMON SHARED pspeed
COMMON SHARED pballx, pbally
COMMON SHARED pballx1, pbally1
COMMON SHARED pballrl
COMMON SHARED pballud

CLEAR
SCREEN 7
pspeed = 5



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
                COLOR 4
                PRINT " power on "
                COLOR 14
                PRINT " HELLO AND WELCOME TO ---"
                PRINT "  ---- General Purpose Opperating System -----"
                PRINT "    -------"
                PRINT "     -   ALL RIGHTS RESERVED ----"
                PRINT "      2003"
                COLOR 7
                PRINT " booting GPOS 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 " ["; pro$
               
                IF pro$ <> "" THEN
                CALL PROC(BC, pro$)
                END IF
                CALL mainmenu(textrouter$)
               
                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
PRINT " csize is [ ", csize
    '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

CALL SHOWDECK
SLEEP
'END


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

LOWTEXT$ = "< READY"
WALK = 0
X = 11: Y = 11
currentx = X
currenty = Y
SETX = X
SETY = Y
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
 NOTEY = -100

   ' /// set mainframe \\\
   ' this is the bbs text
   ON ERROR GOTO nomnfrm:
   CHDIR "c:\dosprgs\mainfram"
   OPEN "mainfram.bbs" FOR OUTPUT AS #1
   PRINT #1, "rem /// Main Frame \\\ "
   PRINT #1, "rem ///  BBS   \\\"
   PRINT #1, "rem  gpos root " + root$
   PRINT #1, " GOING TO "; textrouter$
   PRINT #1, " date " + DATE$
   PRINT #1, " time " + TIME$
   PRINT #1, " system timer " + STR$(TIMER)
   PRINT #1, " cad data set to " + zdta$
   CLOSE #1

PRINT " GOING TO "; textrouter$
PRINT " SETX,SETY "; SETX, SETY
PRINT " CURRENTX,CURRENTY ", currentx, currenty
PRINT " X,Y ", X, Y
BC = 7
SLEEP 1
PRINT " your bc (background color variable is set to ) "; BC
BEEP
SLEEP
GOSUB Scls:

DO

textc = 0


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

  GOTO PROCWIN:
JMP:



  l = LEN(pro$)
   
    IF WALK = 0 THEN
    IF SETX <> 0 THEN X = SETX: SETX = 0: GOSUB Scls:
    IF SETY <> 0 THEN Y = SETY: SETY = 0: GOSUB Scls:
   
    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
      LINE (X, Y)-(X + 640, Y + 200), BC, BF: X1 = X: Y1 = Y
     END IF
    xpos = X
    ypos = Y


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

CALL MOUSE(0)
JH = (currentx + (MX * 3))
jv = (currenty + (MY * 3))

CIRCLE (JH, jv), 5, 7
CIRCLE (jh4, jv4), 5, 0
jh4 = JH: jv4 = jv
GRMX = JH
GRMY = jv

'LOCATE 2, 2: PRINT "    "; MX, MY, JH, jv



 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(BC, textc, 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(BC, textc, 100, 50, 200, HT!, T$ + ke$, "GPOS 1101" + CHR$(13))
  CIRCLE (hcirc1, vcirc1), 30, BC
   hcirc1 = hcirc
   vcirc1 = vcirc
 TZ$ = "GPOS FIXEDDISK  MEMORY"
 CALL SHOWTEXT(BC, textc, 100, 170, 200, HT!, TZ$, SETPOINTER$)
 ON ERROR GOTO ER1:
 IF TPS = 20 THEN
 OPEN "C:\UNICORE.MEM" FOR INPUT AS #1

 INPUT #1, TM$
 CLOSE #1
 END IF

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


 Unitext$ = " Extended GPOS Basic " + CHR$(13) + "---" + CHR$(13) + MAINTEXT$

 CALL SHOWTEXT(BC, textc, 320, 50, 500, 200, Unitext$, "MAIN")
 CALL SHOWTEXT(BC, textc, 920, 50, 500, 200, TEXT1$, "AUXTEXT")

 VID1H = -420
 VID1V = 50
 VID1BC = 8
 CALL SHOWTEXT(BC, textc, 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$

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(BC, CMD$)
 xx = xx + 1
 ELSE
 xx = 0
END IF

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

dta$ = zdta$
DTA1$ = dta$


QH = cadh
QV = cadv
B = 0
TEXT1$ = " Z ROT " + STR$(AG!) + " Y ROT" + STR$(QA!) + " X ROT " + STR$(TA!)
CALL SHOWTEXT(BC, textc, 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(BC, textc, PONGH!, PONGV!, 640, 200, TEXT1$, "EMULATED PONG")
             H = PONGH
             V = PONGV
          CALL VideoPong(BC, H, V)
  

   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(BC, textc, 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!)
          TESTX = 5300
          TESTY = -100
          CALL TESTPANEL(TESTX, TESTY)

LOCATE 23, 1: 'PRINT LOPP$, X, Y
'PRINT CURRENTx, CURRENTy
  IF X <> (currentx) THEN currentx = X
  IF Y <> (currenty) THEN currenty = 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

LOOP UNTIL EXT = 1
END
ER1:
 CLOSE
OPEN "C:\UNICORE.MEM" FOR OUTPUT AS #1
PRINT #1, "EMPTY"
CLOSE #1
LOCATE 21, 1
PRINT "OK"
BEEP
PRINT " I HAD TO BUILD A FILE "
PRINT "UNICORE.MEM"
PRINT "PLEASE RESTART THE PROGRAM"

CO$ = "EXIT"
CALL EXITPROG(CO$)


RESUME

PROCWIN:
SELECT CASE (textrouter$)
   CASE IS = "SWITCHBOARD"

   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"
     l = LEN(pro$)
     IF ke$ = CHR$(8) THEN ke$ = "": IF l > 0 THEN pro$ = LEFT$(pro$, l - 1)
     IF ke$ = CHR$(13) THEN CALL PROC(BC, 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 QA > 360 THEN QA = 1
     IF ke$ = "Z" THEN QA = QA - TASP: IF QA < 1 THEN QA = 360
     IF ke$ = "S" THEN TA = TA + TASP: IF TA > 360 THEN TA = 1
     IF ke$ = "A" THEN TA = TA - TASP: : IF TA < 1 THEN TA = 360


     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) + ";"

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) + ";"

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

GOTO JMP:

Scls:
LINE (X, Y)-(X + 640, Y + 200), BC, BF
RETURN


nomnfrm:

MKDIR "c:\dosprgs"
MKDIR "c:\dosprgs\mainfram"
   CHDIR "c:\dosprgs\mainfram"
   OPEN "mainfram.bbs" FOR OUTPUT AS #1
   PRINT #1, "rem /// Main Frame \\\ "
   PRINT #1, "rem ///  BBS   \\\"
   PRINT #1, "rem  gpos root " + root$
   PRINT #1, " GOING TO "; textrouter$
   PRINT #1, " date " + DATE$
   PRINT #1, " time " + TIME$
   PRINT #1, " system timer " + STR$(TIMER)
   PRINT #1, " cad data set to " + zdta$
   CLOSE #1
BEEP
PRINT "main frame directory error"
PRINT "mainframe is a directory in your"
PRINT "c:\dosprgs\mainfram\ "
PRINT " it stores txt files containing information used by external"
PRINT " exicutables"
PRINT "---"
PRINT "you must reboot"
PRINT "press <spacebar>"
SLEEP
RUN

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

HEI = Y + 400
WID = X + 700
LINE (X, Y)-(WID, HEI), C, 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, 0, 7, WID, HEI)

CALL guibutton(X + 3, topy + 3, 30, RTST, "CD")
CALL guibutton(X + 74, topy + 3, 30, RTST, "WAV")
CALL guibutton(X + 148, topy + 3, 30, RTST, "MIDI")
CALL guibutton(X + 219, topy + 3, 30, RTST, "speech")


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(BC, 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), C, 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, 0, 7, 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 EXITPROG (CO$)
  SCREEN 0, 0, 0
   'RUN
   COLOR 5
   SLEEP 1
   IF CO$ = "EXIT" THEN
   LOCATE 21, 1
   PRINT "shutting down GPOS "
   PRINT " verifying FIXEDDISK  memory "
   PRINT "  Good bye "
   COLOR 7
   PRINT "date {"; DATE$
   PRINT "your time [ "; TIME$
   PRINT "----"
   PRINT " END OF LINE "
   END
   END IF
   IF CO$ = "REBOOT" THEN
   LOCATE 21, 1
   COLOR 15
   PRINT "----"
   PRINT ""
   PRINT ""
   SLEEP 1
   PRINT
   COLOR 7
   PRINT " ok to restart GPOS  "
   PRINT "  type uniswtch <enter>"
   PRINT

   END
   END IF


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 guibutton (XXB, YYB, szt, RTST, TXT$)
RTST = 0' rem set to off
RT = XXB + szt + 23
BT = YYB + szt + 5
LINE (XXB, YYB)-(RT, BT), 7, BF
LINE (XXB - 4, YYB - 4)-(RT + 4, BT + 4), 4, B
LINE (XXB + 2, YYB + 2)-(RT + 2, BT + 2), 8, B

H = XXB + 5
V = YYB + 10
S = 1
C = 0
SWTH = RT
SHHT = BT
BC = 7
CALL PRTEXT(TXT$, H, V, S, C, BC, SWTH, SHHT)

IF BUR = -1 THEN

IF GRMX >= (XXB) AND GRMX <= (RT) AND GRMY >= (YYB) AND GRMY <= (BT) THEN RTST = 1
END IF

END SUB

SUB guitextbox (BC, textc, XH, YV, tt$)
C = textc
RT = XH + 300
BT = YV + 10
TP = YV - 24
TXT$ = tt$
H = XH
V = YV
SWTH = RT
SHHT = YV + 20
S = 3



LINE (XH - 3, TP)-(RT + 5, BT), BC, BF
CALL PRTEXT(TXT$, H, V, S, C, BC, SWTH, SHHT)


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            13. TESTPANEL  "
  PRINT " 4. Video1             Pong. game  "
  PRINT " 5. cad video"
  PRINT " 6."
  PRINT " 7. NOTEPAD"
  PRINT " 8. TIMEDATE"
  PRINT " 9. SWITCHBOARD"
  PRINT " 10. COMPORTS"

  LOCATE 2, 2: INPUT "] COMMAND ["; CO$
   CO$ = UCASE$(CO$)
  
   SELECT CASE (CO$)
   CASE IS = "PONG"
   SETX = 530
   SETY = 400

   CASE IS = "MOUSE"
    CALL MOUSEMENU
   CASE IS = "10"
   SETX = 4600: SETY = -100
CASE IS = "NOTEPAD", "7"
 
   textrouter$ = "NOTEPAD"
   SETX = 3120
    SETY = -100
   CASE IS = "TIMEDATE", "8"
   textrouter$ = "TIMEDATE"
   TIDAX = 1540
   tiday = 0
   SETX = TIDAX: SETY = tiday

   CASE IS = "REBOOT", "EXIT"
   CALL EXITPROG(CO$)
 
  
   CASE IS = "9", "SWITCH", "SWITCHBOARD"
   textrouter$ = "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"
   SETX = 3750: SETY = -124
   textrouter$ = "AUDIO"
   CASE IS = "13"

          SETX = 5300
          SETY = -100


   END SELECT
CLS

END SUB

'
SUB MOUSE (WHICH)

LOCATE 21, 2

MX = STICK(0): MY = STICK(1)
B0 = STRIG(0): B1 = STRIG(1)
B2 = STRIG(2): B3 = STRIG(3)


'PRINT mx, my
'PRINT B0, B1, B2, B3



BU = mouseleftbutton
BUR = B0


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

BSPAC = 70
LINE (X, Y - 5)-(WID, topy), C, B

CALL guibutton(X + 3, topy + 3, 30, RTST, "PRINT")
JGD1 = RTST
CALL guibutton(X + BSPAC, topy + 3, 30, jgd2, "EDIT")
CALL guibutton(X + (BSPAC * 2), topy + 3, 30, jgd3, "WINDOW")

IF JGD1 = 1 THEN LPRINT NOTETEXT$: NOTETEXT$ = ""
LINE (X, Y)-(WID, Y + HEI), 7, B
LINE (X + 3, Y + 3)-(WID - 3, Y + HEI - 3), 7, BF

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

END SUB

SUB PROC (BC, 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 = "MEM"
 CLS
 LOCATE 1, 1
 PRINT " your current dos memory settings"
 SHELL "c:\mem"
 SLEEP

 CASE IS = "CLS"
 X = currentx
 Y = currenty

 LINE (X, Y)-(X + 640, Y + 200), BC, BF
 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, BC, 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)), BC, BF
ch$ = MID$(TXT$, CT, 1)
ch$ = UCASE$(ch$)
tx = HH + 2
ty = VV - 8
SELECT CASE (ch$)
CASE IS = CHR$(219)
 RD = HH + (sz * 6)
 LINE (HH, VV)-(RD, VV - 6), C, 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 SHOWCARD (NAME$, X, Y, BC)
NAME$ = UCASE$(NAME$)


LINE (X, Y)-(X + 50, Y + 100), 15, BF
LINE (X - 2, Y - 2)-(X + 52, Y + 102), 0, B
SWTH = X + 50
SHHT = Y + 100
S = 2
HEART$ = "R2F2E2R2F2D2G6H6U2E2R2F2"
KINGFACE$ = "F2E2F2E2D3L8U3D3G2D8F2R8E2U8H2BG3L2BL2L2BF4G2"
H = X + 3
V = Y + 15


SELECT CASE (NAME$)
CASE IS = "KINGHEARTS"
TXT$ = "K"
C = 4
CALL PRTEXT(TXT$, H, V, S, C, BC, SWTH, SHHT)
DRAW "BM0,0BR" + STR$(H + 28) + "BD" + STR$(V - 8) + "C4" + HEART$
DRAW "BM0,0BR" + STR$(H + 15) + "BD" + STR$(V + 20) + "C4" + KINGFACE$
CASE IS = "QUEENHEARTS"
TXT$ = "Q"
C = 4
CALL PRTEXT(TXT$, H, V, S, C, BC, SWTH, SHHT)

CASE IS = "HEARTS1"
TXT$ = "a"
C = 4
CALL PRTEXT(TXT$, H, V, S, C, BC, SWTH, SHHT)
 DRAW "BM0,0BR" + STR$(H + 20) + "BD" + STR$(V + 40) + "C4" + HEART$

CASE IS = "HEARTS2"
TXT$ = "2"
C = 4
CALL PRTEXT(TXT$, H, V, S, C, BC, SWTH, SHHT)
 DRAW "BM0,0BR" + STR$(H + 20) + "BD" + STR$(V + 20) + "C4" + HEART$
 DRAW "BM0,0BR" + STR$(H + 20) + "BD" + STR$(V + 50) + "C4" + HEART$

CASE IS = "HEARTS3"
TXT$ = "3"
C = 4
CALL PRTEXT(TXT$, H, V, S, C, BC, SWTH, SHHT)
 DRAW "BM0,0BR" + STR$(H + 20) + "BD" + STR$(V + 10) + "C4" + HEART$
 DRAW "BM0,0BR" + STR$(H + 20) + "BD" + STR$(V + 30) + "C4" + HEART$
 DRAW "BM0,0BR" + STR$(H + 20) + "BD" + STR$(V + 50) + "C4" + HEART$

CASE IS = "HEARTS4"
TXT$ = "4"
C = 4
CALL PRTEXT(TXT$, H, V, S, C, BC, SWTH, SHHT)
 DRAW "BM0,0BR" + STR$(H + 10) + "BD" + STR$(V + 10) + "C4" + HEART$
 DRAW "BM0,0BR" + STR$(H + 30) + "BD" + STR$(V + 10) + "C4" + HEART$
 DRAW "BM0,0BR" + STR$(H + 10) + "BD" + STR$(V + 50) + "C4" + HEART$
 DRAW "BM0,0BR" + STR$(H + 30) + "BD" + STR$(V + 50) + "C4" + HEART$

CASE IS = "HEARTS5"
TXT$ = "5"
C = 4
CALL PRTEXT(TXT$, H, V, S, C, BC, SWTH, SHHT)
 DRAW "BM0,0BR" + STR$(H + 10) + "BD" + STR$(V + 10) + "C4" + HEART$
 DRAW "BM0,0BR" + STR$(H + 30) + "BD" + STR$(V + 10) + "C4" + HEART$
 DRAW "BM0,0BR" + STR$(H + 10) + "BD" + STR$(V + 50) + "C4" + HEART$
 DRAW "BM0,0BR" + STR$(H + 30) + "BD" + STR$(V + 50) + "C4" + HEART$
 DRAW "BM0,0BR" + STR$(H + 20) + "BD" + STR$(V + 30) + "C4" + HEART$




END SELECT




END SUB

SUB SHOWDECK
SCREEN 12
CLS
BC = 7

CALL SHOWCARD("KINGHEARTS", 5, 5, BC)

CALL SHOWCARD("QUEENHEARTS", 55, 5, BC)

CALL SHOWCARD("HEARTS1", 105, 5, BC)

CALL SHOWCARD("HEARTS2", 155, 5, BC)

CALL SHOWCARD("HEARTS3", 205, 5, BC)

CALL SHOWCARD("HEARTS4", 255, 5, BC)

CALL SHOWCARD("HEARTS5", 305, 5, BC)



END SUB

SUB SHOWTEXT (BC, textc, H, V, sz, HT, T$, SETPOINTER$)
C = textc

WWT = sz
WHT = HT
TXT$ = T$
 DRAW "s7"
 
   X = H
   Y = V
   
 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 - 5
 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 * 12 > (WWT - 5) THEN txx = 1: tyy = tyy + 1: IF tyy > 20 THEN tyy = 1
    tx = (txx * 12) + X: ty = (tyy * 10) + Y
    LINE (tx, ty)-(tx + 12, ty + 8), BC, BF
    ch$ = UCASE$(ch$)
    SELECT CASE (ch$)
    CASE IS = CHR$(219)
    LINE (tx + 1, ty + 1)-(tx + 5, ty + 5), C, 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 - 1, ty + 5)-(tx - 1, ty + 1), C
     LINE -(tx + 2, ty + 1), C
     LINE -(tx + 2, ty + 4), C
     LINE (tx + 2, ty + 1)-(tx + 6, ty + 1), C
      LINE -(tx + 6, ty + 4), C

      
    CASE IS = "N"
     LINE (tx + 1, ty + 5)-(tx, 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 + 1, ty + 1), C
    LINE -(tx + 1, ty + 2), C
    LINE -(tx + 4, ty + 2), C
    LINE -(tx + 4, ty + 4), C
    LINE -(tx + 1, ty + 4), C

    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 + 6, ty + 5), C
      LINE -(tx + 6, 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), C, 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(BC, textc, 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 TESTPANEL (TESTX, TESTY)

H = TESTX
V = TESTY
RT = H + 700
BT = V + 400

sz = 1
HT = 12
T$ = " TEST PANEL"

LINE (H - 2, V - 2)-(RT + 2, BT + 2), 14, B
 LINE (H, V)-(RT, BT), C, B
sz = 800


CALL guitextbox(BC, textc, H, V - 15, testt$)

CALL guibutton(H + 3, V + 3, 10, RTST, "BEEP")
IF RTST = 1 THEN BEEP: RTST = 0

CALL guibutton(H + 73, V + 3, 10, RTST, "TONE")
IF RTST = 1 THEN SOUND 255 + 4, 20: RTST = 0

CALL guibutton(H + 143, V + 3, 10, RTST, "0")
IF RTST = 1 THEN testt$ = testt$ + "0": RTST = 0

CALL guibutton(H + 213, V + 3, 10, RTST, "1")
IF RTST = 1 THEN testt$ = testt$ + "1": RTST = 0


CALL guibutton(H + 213, V + 85, 10, RTST, "z")
IF RTST = 1 THEN testt$ = testt$ + "1": RTST = 0


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)
C = 0
BC = 7
CALL PRTEXT(TXT$, H, V, S, C, BC, 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

SUB VideoPong (BC, H, V)
IF H >= (currentx - 640) AND H <= (currentx + 640) AND V >= (currenty - 200) AND V <= (currenty + 200) THEN
      

IF pballrl = 0 THEN pballx = pballx - pspeed: IF pballx < 0 THEN pballrl = 1
IF pballrl = 1 THEN pballx = pballx + pspeed: IF pballx > 640 THEN pballrl = 0
IF pballud = 0 THEN pbally = pbally - pspeed: IF pbally < 0 THEN pballud = 1
IF pballud = 1 THEN pbally = pbally + pspeed: IF pbally > 200 THEN pballud = 0

CIRCLE (H + pballx, V + pbally), 30, 0
 CIRCLE (H + pballx1, V + pbally1), 30, BC
  pballx1 = pballx
  pbally1 = pbally



END IF
END SUB

