DECLARE SUB refcommands ()
DECLARE SUB clearbot ()
DECLARE SUB OScall (na$)
DECLARE SUB initmem ()
DECLARE FUNCTION Capital! (L$)
DECLARE SUB initsound ()
DECLARE SUB PLsay (w$)
DECLARE SUB qbtalkos ()
DEFSNG A-Z

'       The one and only
DECLARE SUB playwav (WaveFile$)
DECLARE SUB ValidWavHeader (file$, LenHeader%, dataLen&, nChannels%, nSamplesPerSec&, nAvgBytesPerSec&, ok%)
DECLARE SUB WriteToDSP (v%)
DECLARE SUB PlayBack (BUFFER$, size%, FREQ&, BytesPerSec&, chans%, num%)
DECLARE SUB delay (tdelay!)
DECLARE FUNCTION GetBlasterAddr% ()
DECLARE FUNCTION SBreset% ()

DECLARE SUB fixfna (filena$)
DECLARE SUB Qbprun (filena$)
DECLARE SUB ExitRoutine ()
DECLARE SUB udocs (ocs$, ocsm%)
DECLARE SUB cleartxt ()
DECLARE SUB grabtext ()
DECLARE SUB pastebgtext ()
DECLARE SUB typef ()
DECLARE SUB Pause (wlength%)
DECLARE SUB openfile (mh%, mv%)
DECLARE SUB DRAWWINDOWS ()
DECLARE SUB drawPointer ()
DECLARE SUB movewindow (mwct%, rsize%, bsize%)
DECLARE SUB IPxWindow (rsize%, bsize%, mc%, ct%, dta$, dt%)
DECLARE SUB mouseButtons (ct%, bu%)
DECLARE SUB pxwindow (lh%, uv%, mr%, mb%, mc%, ct%, dt%, dta$, ta%)
DECLARE SUB wamouse ()
DECLARE SUB mouse (cx%, dx%, bx%)
DECLARE SUB mousepointer (SW%)
DECLARE SUB umouse (ya%, xa%, bu%, si%)
DECLARE SUB tmouse (mh%, mv%)
DECLARE SUB TBox (lh%, uv%, mr%, mb%, mc%)
DECLARE SUB Menus (Ril%, Bot%, mh%, mv%, bu%, ke$)
DECLARE SUB arrow (h%, v%, h1%, v1%)
DECLARE SUB icons (h%, v%)
DECLARE SUB Crotate (dta$, an%, qa%, ta%, swth%, shht%, sh%, sv%, ag1%, qa1%, ta1%)
DECLARE SUB percad (nm$, dta$, CAD$)
DECLARE SUB QBCADLOGO ()
DECLARE SUB pline (ag%, VR%, EA%, ANGLE%, sz%, x%, y%, h%, v%, c%, size%, swth%, shht%)
DECLARE SUB HELP ()
DECLARE SUB Ncad (dta$)
DECLARE SUB WORLDSCALE (dta$, SE$)
DECLARE SUB portdta (dta$, CAD$)
DECLARE SUB getjoystick (di$)
DECLARE SUB ldsv (dta$, CAD$, SE$)
DECLARE SUB delete (dta$)
DECLARE SUB ROTATE (dta$, an%, qa%, ta%, swth%, shht%, sh%, sv%)
DEFINT A-Z
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%, mr%, mb%)
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 (lh%, uv%, 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%)
COMMON SHARED BlasterAddr%, dma%, repeats%, HTO, oksk
'COMMON SHARED icons() AS STRING
COMMON SHARED Ril, Bot, pxwct, MPTicon, mh1, mv1
COMMON SHARED MOUSEH, MOUSEV, mouseh1, mousev1, si, bu, hidew



DIM SHARED dtxt$, ke$, lcmd$, bgcw$, Lstbgcw$, filena$, bgtext$
DIM SHARED tmarry$(100, 3)
DIM SHARED marry(100, 8)
DIM SHARED box%(24, 24)
DIM SHARED ROOT$


'CALL initmem

proglock$ = "true": REM set to on
ROOT$ = "C:\QBASIC\"

   mh1 = 1
   mv1 = 1
 SE$ = "1"
DTA1$ = dta$
    'size = 100
    swth = 600
    shht = 400
    scale = 1
   sh = swth / 2
   sv = shht / 2
   h1 = sh
   v1 = sv
   VSCN = 1: REM VEIW SCREEN ON
CLOSE




';CALL initsound

'CALL playwav("c:\qbasic\qbwspe~1\a.wav")

ag = 1
qa = 2
ta = 1
b = 0
ag1 = ag
qa1 = qa
ta1 = ta
posnc = 10
PI = 3.142587
REM
sz = 1
DEFINT A-Z
' PlexerOs.bas
'CALL qbtalkos
      
        REM %%%%% SPECIAL THANKS TO  Jeff Barnette  %%%%%
        REM %%%%% FOR THIS MOUSE ROUTINE %%%%%
       
       
       
         DIM SHARED a(9): REM %%% FOR MOUSEROUTINE %%%
         
        DEF SEG = VARSEG(a(0))
     
        RESTORE
        FOR I = 0 TO 17
        READ r
        POKE VARPTR(a(0)) + I, r
        NEXT I
        DATA &HB8,&H00,&H00,&H55,&H8B,&HEC,&HCD,&H33,&H92
        DATA &H8B,&H5E,&H06,&H89,&H07,&H5D,&HCA,&H02,&H00
        CALL mousepointer(0)      'Reset mouse and
        'CALL MOUSEPOINTER(1)      'show arrow
        CALL mousepointer(3)      'Get coordinates

'MPTicon = 1' set to arrow
 MPTicon = 2' set to text
SCREEN 12
 'PALETTE 0, 9

0 sp = 10: REM
 Bot = 420
 Ril = 640
 'GET (0, 20)-(600, 200), BGPicture%
 CLS
10 c = 1:

30 LS = 30

50 ES = 5
si = 12

90  RANDOMIZE TIMER
 'h = 20: H1 = h
 'v = 20: V1 = v

170 CLS




   GET (h, v)-(h + si, v + si), box%
   CALL grabtext ' init screen



ocs$ = CHR$(219)


330 DO
LOCATE 1, 1

PRINT "File Edit Tasks Options System Help [" + lcmd$ + " ] "; ocs$ + " "
PRINT STRING$(79, CHR$(205));
   
    ' 3, 3: PRINT mouseh, mousev

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



410 b = STRIG(0): b = STRIG(B0)



  CALL mouseButtons(ct, bu)


  CALL umouse(ya, xa, bu, si)
  CALL tmouse(mh, mv)
  CALL Menus(Ril, Bot, mh, mv, bu, ke$)
  CALL drawPointer


LOCATE 24, 2: REM opperating system PROMPT

  bckc$ = STRING$(79 - LEN(dtxt$), " ")

 Cktpd = Cktpd + 1


 IF ke$ <> "" THEN
  lc = ASC(LEFT$(ke$, 1)): rc = ASC(RIGHT$(ke$, 1))
 END IF
 IF lc > 0 AND LEN(dtxt$) <= 60 AND ke$ <> "" AND ke$ <> CHR$(13) AND ke$ <> CHR$(8) THEN dtxt$ = dtxt$ + ke$

 COLOR 15
 IF Cktpd >= 20 THEN
 IF pbd = 1 THEN
 PRINT "Ready#" + dtxt$ + " " + bckc$;

 
 pbd = 0
 ELSE
 pbd = 1
 PRINT "Ready " + dtxt$ + "_" + bckc$;
 osc$ = " "
 END IF

 Cktpd = 0
 END IF
 COLOR 7

 SELECT CASE ke$


 CASE IS = CHR$(0) + ";"


 CASE IS = CHR$(27)
      dtxt$ = ""

 CASE IS = CHR$(8)
 REM erase bad character
  
   ll = LEN(dtxt$)
   pc = (ll - 1)
   IF pc >= 0 THEN
   frg$ = LEFT$(dtxt$, pc)
   
   dtxt$ = frg$
   END IF


 CASE IS = CHR$(13)
 
  dtxt$ = UCASE$(dtxt$)

  CALL DRAWWINDOWS
  dtxt4$ = dtxt3$
  dtxt3$ = dtxt2$
  dtxt2$ = dtxt1$
  dtxt1$ = dtxt$


 SELECT CASE (dtxt$)
 CASE IS = "COCOROM"
  RUN ROOT$ + "COCOROM.BAS"

 CASE IS = "-PLEXER"
  SYSTEM


 CASE IS = "BYE"
  proglock$ = "False"
    CALL ExitRoutine

 END SELECT
 
   LOCATE mv1, mh1: PRINT Lstbgcw$
 
 
  LOCATE 2, 2
 
   lcmd$ = dtxt$
   cleartxt
  LOCATE 2, 1
   IF dtxt$ <> "" THEN
   SHELL dtxt$
   END IF
     bgtext$ = ""

     CALL grabtext
      wlength = 2
     CALL Pause(wlength)
      CALL clearbot
  

  'GET (20, 0)-(600, 20 + 50), BGPicture

  'dtxt$ = ""
 END SELECT



  IF dtxt$ = "CLS" THEN
     

  END IF
 
  LOCATE 24, 60
  IF ke$ <> "" THEN
  lc = ASC(LEFT$(ke$, 1)): rc = ASC(RIGHT$(ke$, 1))
  END IF
  PRINT STR$(lc) + " " + STR$(rc)

    qa = qa + 1: IF qa > 360 THEN qa = 1
    ta = ta + 1: IF ta > 360 THEN ta = 1


  ctps = ctps + 1

  IF ctps >= 30 THEN
    CALL DRAWWINDOWS
    CALL udocs(ocs$, ocsm)
  ctps = 0
  END IF
    
  LOCATE 24, 1
  PRINT STRING$(59, CHR$(205));

  COLOR 15
 LOCATE 26, 1
   PRINT dtxt1$
 LOCATE 27, 1
   PRINT dtxt2$
 LOCATE 28, 1
   PRINT dtxt3$
 LOCATE 29, 1
   PRINT dtxt4$;
 
 
 
  COLOR 7
  LOCATE 27, 60
  PRINT "<  "; filena$; " > ";

 LOOP UNTIL proglock$ = "False"

 CALL ExitRoutine


DATA "ONE","TWO","THREE","FOUR","FIVE","SIX","SEVEN","EIGHT","NINE","TEN","ELEVEN","TWELVE"
DATA "THIRTEEN","FOURTEEN","FIFTEEN","SIXTEEN","SEVENTEEN","EIGHTEEN","NINETEEN"
DATA "TEN","TWENTY","THIRTY","FORTY","FIFTY","SIXTY","SEVENTY","EIGHTY","NINETY"
101

SUB blanknnd (txt$, bckc$)
  bckc$ = STRING$(79 - LEN(txt$), " ")



END SUB

SUB clearbot

ch$ = STRING$(79, " ")

LOCATE 25, 1
PRINT ch$

LOCATE 26, 1
PRINT ch$

LOCATE 27, 1
PRINT ch$

LOCATE 28, 1
PRINT ch$



END SUB

SUB cleartxt

LOCATE 2, 1
ch$ = STRING$(79, " ")


FOR v = 2 TO 23
PRINT ch$

NEXT v


END SUB

DEFSNG A-Z
SUB COLORBOX (c)

'h = Form1.ScaleWidth  '
'v = Form1.ScaleHeight ' REM CENTER SHAPE
LINE (h, v)-(h - 800, v - 800), c, BF
LINE (h, v)-(h + 50, v + 50), &HFF, BF

END SUB

DEFINT A-Z
SUB Crotate (dta$, an, qa, ta, swth, shht, sh, sv, ag1, qa1, ta1)

ta1 = ta
  h = sh
  v = sv

  h1 = h
  v1 = v
h2 = h2
v2 = v1

ta = ta + 5

IF ta > 360 THEN ta = 1

b = 0
CALL VBDRAW(lh, uv, ag, qa, ta, dta$, h, v, b, swth, shht)

b = 1
CALL VBDRAW(lh, uv, ag1, qa1, ta1, dta$, h1, v1, b, swth, shht)
  h = sh
  v = sv
  h1 = h: v1 = v
ta1 = ta
qa1 = qa
ag1 = ag




END SUB

DEFSNG A-Z
SUB delay (tdelay!)
'talkhead
END SUB

SUB delete (dta$)

LN = LEN(dta$)
 ct = LN
 DO
 ct = ct - 1
 LN = LN - 1
 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

DEFINT A-Z
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) * size
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 drawPointer

SELECT CASE (MPTicon)

CASE IS = 0
CC = INT(RND(1) * (16)) + 1

LINE (MOUSEH, MOUSEV)-(MOUSEH + si, MOUSEV + si), CC, BF
LINE (MOUSEH, MOUSEV)-(MOUSEH + si, MOUSEV + si), 2, B

CASE IS = 1


CASE IS = 2

CALL tmouse(mh, mv)


LOCATE mv, mh
 c = INT(RND(1) * (15)) + 1
COLOR c
PRINT CHR$(219)

COLOR 7
IF mh1 <> (mh) OR mv1 <> (mv) THEN

  LOCATE mv1, mh1
  PRINT Lstbgcw$;

mh1 = mh
mv1 = mv

 Lstbgcw$ = bgcw$

END IF


END SELECT
END SUB

SUB DRAWWINDOWS

  DO
  lh = marry(tct, 0)
  uv = marry(tct, 1)
  mr = marry(tct, 2)
  mb = marry(tct, 4)
  mc = marry(tct, 5)
  dt = marry(tct, 6)
  ta = marry(tct, 7)' last cad positionf
 

  dta$ = tmarry$(tct, 0)
  REM redraw Window
  ct = tct
 
  CALL pxwindow(lh, uv, mr, mb, mc, ct, dt, dta$, ta)
 
  marry(tct, 7) = ta' update
    



    tct = tct + 1
  LOOP UNTIL tct >= (100)


END SUB

SUB ExitRoutine

REM Exit

 LOCATE 27, 1
 vv = 0

 DO
 PRINT
 vv = vv + 1

 wlength = 1
 CALL Pause(wlength)

 LOOP UNTIL vv >= 27

 
  SYSTEM
 
  END ' exit Routine
END SUB

SUB fixfna (filena$)

IF RIGHT$(filena$, 1) = " " THEN

ll = LEN(filena$)

IF ll > 1 THEN
frg$ = LEFT$(filena$, ll - 1)

filena$ = frg$
END IF
END IF


END SUB

DEFSNG A-Z
SUB getjoystick (di$)
j0 = STICK(0)
j1 = STICK(1)

j2 = STICK(2)
j3 = STICK(3)

LOCATE 10, 1
'PRINT j0, j1, 2, j3; "      "

IF j0 > 95 THEN di$ = "K"
IF j0 < 60 THEN di$ = "j"
IF j1 > 95 THEN di$ = "M"
IF j1 < 60 THEN di$ = "I"






END SUB

DEFINT A-Z
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)
LN = LEN(dta$)
TE = 0
   
    IF (ct + TE) < (LN) THEN
    DO
    
    Tte$ = MID$(dta$, ct + TE, 1)
    
    TE = TE + 1
   ' PRINT TTE$;
    LOOP UNTIL Tte$ = ";" OR (ct + TE) > (LN)
   
      IF TE > 2 THEN
    sz = VAL(MID$(dta$, ct + 1, TE - 2))
     END IF
    END IF
END SUB

SUB grabtext

gh = 1
gv = 2

FOR gv = 2 TO 23
 FOR gh = 1 TO 79
 w$ = CHR$(SCREEN(gv, gh))
 bgtext$ = bgtext$ + w$

 NEXT gh
 bgtext$ = bgtext$ + " "


NEXT gv


END SUB

DEFSNG A-Z
SUB HELP

CLS
PRINT "ARROW keys to position ANGLE OF SHAPE"
PRINT "<B> for blank move"
PRINT "<N> for no update"
PRINT "                         <W>     <R>"
PRINT "   <I>                       <E>     "
PRINT "<j>   <k> = position      <S>   <D>    = DRAW"
PRINT "   <M>                       <X>     "
PRINT "                         <Z>     <C>"
PRINT "                               + <CTRL> = FOWARDMOVE"
PRINT "                               + <ALT> = BACKMOVE"
PRINT "                         <,>= BACK3D <.> =FORW 3D"
PRINT "<F1> CONVERSION UTIL"
PRINT "<F2> to toggle joystick "
PRINT "<F3> toggles dta veiw"
PRINT "<F4> to insert text"
PRINT "<F5> VEIW INFO"
PRINT "<F6> HIDE INFO"
PRINT "<F7> will change your postion incramenty value "
PRINT "<F8> to change color"
PRINT "<F9> to change size incraments"
PRINT "<CTRL> + <F9> CHANGE SCALE"
PRINT "<F10> rotates  "
PRINT "<F11> ?"
PRINT "<F12> HELP."
PRINT "<esc> to exit    "
PRINT "<tab> toggles the save load function"
PRINT "<BACKSPACE> TO DELETE A MOVE"
PRINT "PRESS <C> TO exit this help"
PRINT "PRESS <A> to see a list of commands "
DO
ke$ = INKEY$
ke$ = UCASE$(ke$)
IF ke$ = "A" THEN CALL refcommands
LOOP UNTIL ke$ = "C"

CLS


END SUB

DEFINT A-Z
SUB icons (h, v)




END SUB

SUB initmem
REM MEM SUB

SCREEN 12

' show important hardware stuff here

PRINT "Begin"
ct = 0
v = 10
DO

 mseg% = PEEK(ct)

LINE (0, v)-(mseg%, v), 7
  v = v + 1

 ct = ct + 1
     



IF v = 360 THEN
 
  
  v = 10: SLEEP: CLS
 
  LOCATE 26, 50: PRINT ct / 255
  LOCATE 27, 50: PRINT ct
END IF
ky$ = INKEY$

LOOP UNTIL ky$ = CHR$(27) OR ct >= 32550

END SUB

SUB IPxWindow (rsize, bsize, mc, ct, dta$, dt)


DO

tvar = marry(ct, 2)

IF tvar <> 0 THEN
 ct = ct + 1
END IF
LOOP UNTIL tvar = 0 OR ct >= 100

marry(ct, 0) = MOUSEH:  marry(ct, 2) = MOUSEH + rsize
marry(ct, 1) = MOUSEV: marry(ct, 4) = MOUSEV + bsize
marry(ct, 5) = mc
marry(ct, 6) = dt
tmarry$(ct, 0) = dta$


'LOCATE 24, 2
'PRINT ct

END SUB

DEFSNG A-Z
SUB ldsv (dta$, CAD$, SE$)
     CLS
    
    
     PRINT "< "; CAD$; " > currently in cash"
     PRINT " ### What do you want to do ###"

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


    IF LS$ = "D" THEN
     DO
     FILES
     INPUT "dir >"; DR$

     IF DR$ <> "" THEN CHDIR DR$

     LOOP UNTIL DR$ = ""


    END IF


    IF LS$ = "L" THEN
    REM LOADING ALGORITHM
   
    PRINT "<.Cad> added automatically"
    PRINT
    
    FILES
    INPUT "NAME OF QBcad TO LOAD INTO  "; CAD$
     

     IF CAD$ <> "" THEN
      CLOSE #1
       
        PRINT "OPENING-"; CAD$
        OPEN CAD$ + ".cad" FOR INPUT AS #1
     
        LINE INPUT #1, dta$
    
    CLOSE #1
     
     
     
     
ll = LEN(dta$)

DO
ct = ct + 1
ch$ = MID$(dta$, ct, 1)

LOOP UNTIL ch$ = "S" OR ct >= (ll)

DO
ct = ct + 1
ch$ = MID$(dta$, ct, 1)

NN$ = NN$ + ch$

LOOP UNTIL ch$ = ";" OR ct >= (ll)

SE$ = MID$(NN$, 1, LEN(NN$) - 1)

     
     
     
      ELSE

      PRINT " LOAD ROUTINE ABORTED "
     
     
      END IF
   
    END IF


    IF LS$ = "S" THEN

    REM savinG ALGORITHM
  
    PRINT "<.Cad> added automatically"
    DO
    FILES
    INPUT "NAME OF QBcad TO be saved  "; cd1$
     IF cd1$ <> "" THEN CAD$ = cd1$
    
     IF cd1$ = "" THEN
     PRINT "would you like to replace "; CAD$
     INPUT "Y/N"; YN$
     YN$ = UCASE$(YN$)

     IF YN$ = "Y" THEN cd1$ = CAD$
     END IF
   
    LOOP UNTIL cd1$ <> ""
    
      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

DEFINT A-Z
SUB Menus (Ril, Bot, mh, mv, bu, ke$)

schr$ = CHR$(SCREEN(mv, mh))
' 20, 20
'PRINT mh, mv, schr$
  
   REM ***
   REM fUNCTION kEYS
   REM ***
   
IF ke$ = CHR$(0) + "P" THEN qa = qa + 1: IF qa > 6 THEN qa = -6
IF ke$ = CHR$(0) + "H" THEN qa = qa - 1: IF qa < -6 THEN qa = 6
IF ke$ = CHR$(0) + "M" THEN ta = ta + 5
IF ke$ = CHR$(0) + "K" THEN ta = ta - 5


IF MPTicon = 2 THEN
                     REM Check text
  IF bu = 1 THEN ke$ = CHR$(0) + CHR$(63) ' open filename

END IF



 SELECT CASE ke$
 CASE IS = CHR$(0) + CHR$(68)

 na$ = "c:\qbasic\audiomon.bas"
 OScall (na$)

 CASE IS = CHR$(0) + ";"
  'ct = ct + 1
  schr$ = "F": bu = 1
  
 CASE IS = CHR$(0) + CHR$(60)
     ct = ct + 1
    
     rsize = 160
     marry(tct, 3) = 0
     bsize = 160
    
     mc = 8' set color
     dt = 1'SET TO CAD
    
     dta$ = "S1;C2;L 5;U 5;U 5;R 5;R 5;D 5;D 5;D 5;L 5;L 5;L 5;Z 5;Z 5;Z 5;Z 5;Z 5;Z 5;Z 5;Z 5;Z 5;R 5;R 5;R 5;U 5;U 5;U 5;L 5;L 5;L 5;L 5;L 5;L 5;D 5;D 5;D 5;D 5;D 5;D 5;R 5;R 5;R 5;R 5;R 5;R 5;R 5;R 5;R 5;R 5;R 5; "
     CALL IPxWindow(rsize, bsize, mc, ct, dta$, dt)

     

 CASE IS = CHR$(0) + CHR$(61)
     'ct = ct + 1
     rsize = 160
     marry(tct, 3) = 0
     bsize = 160
   
     mc = 8' set color
     tct = ct
     marry(tct, 6) = 2 ' SET TO TIME
   
     CALL IPxWindow(rsize, bsize, mc, ct, dta$, dt)

     
     CALL DRAWWINDOWS
     
 CASE IS = CHR$(0) + CHR$(62)
    
     rsize = 160
     marry(tct, 3) = 0
     bsize = 160
     'ct = ct + 1
     mc = 1' set color
     tct = ct
     marry(tct, 6) = 3 ' SET TO Demo
     CALL IPxWindow(rsize, bsize, mc, ct, dta$, dt)

     
     CALL DRAWWINDOWS
     

 CASE IS = CHR$(0) + CHR$(63) ' F8

 LOCATE mv1, mh1: PRINT Lstbgcw$;



 LOCATE 10, 10
 PRINT "  <"; filena$; "> # "

 filena$ = UCASE$(filena$)

 CALL fixfna(filena$)

 sv$ = RIGHT$(filena$, 4)

 IF sv$ = ".BAS" OR sv$ = ".EXE" OR sv$ = ".BAT" THEN
  CALL Qbprun(filena$)
 END IF

 CALL openfile(mh, mv)

CASE IS = CHR$(0) + CHR$(66)
REM TYPE File
  


 filena$ = UCASE$(filena$)


 sv$ = RIGHT$(filena$, 4)

 
 
  CALL Qbprun(filena$)

 

  
  
   CALL cleartxt
   LOCATE 2, 1
  
   PRINT STRING$(79, CHR$(205))
   CALL typef

CASE IS = CHR$(0) + CHR$(68)' <F10)
    

         w$ = "hi"

       'CALL PLsay(w$)





CASE IS = CHR$(0) + CHR$(133)' <F11)
        CALL mousepointer(0)      'Reset mouse and
        CALL mousepointer(1)      'show arrow
        CALL mousepointer(3)      'Get coordinates
        MPTicon = 1' set to arrow
        LOCATE mv1, mh1
        PRINT Lstbgcw$;

 CASE IS = CHR$(0) + CHR$(134)' <F12>
         MPTicon = 1
         REM hide arrow
        CALL mousepointer(0)      'Reset mouse and
        CALL mousepointer(2)      'show arrow
        CALL mousepointer(3)      'Get coordinates

        MPTicon = 2' set to text

 CASE IS = CHR$(0) + CHR$(137)

 hidew = 0

 CASE IS = CHR$(0) + CHR$(138)

 hidew = 1
 CALL pastebgtext


 END SELECT
IF bu = 1 THEN
SELECT CASE schr$

CASE IS = "F"
 mc = 3
 lh = 0: uv = 20
 mr = 160
 mb = uv + 160
    rsize = lh + 160
    bsize = mb + 160
     pxwct = ct
     tmarry$(pxwct, 0) = "FILE"
  CALL pxwindow(lh, uv, mr, mb, mc, ct, dt, dta$, ta)
  MOUSEV = 20
  CALL IPxWindow(rsize, bsize, mc, ct, dta$, dt)
  CALL wamouse
END SELECT
END IF



  tct = 0
 
  DO
  lh = marry(tct, 0)
  uv = marry(tct, 1)
  mr = marry(tct, 2)
  mb = marry(tct, 4)
  mc = marry(tct, 5)
     CALL mouse(cx, dx, bx): bu = bx
   
    REM redraw Window
    IF MOUSEH > (lh) AND MOUSEH < (mr) AND MOUSEV > (uv) AND MOUSEV < (mb) THEN
     

      IF dx <> (MOUSEH) OR cx <> (MOUSEV) THEN
      ct = tct
     CALL pxwindow(lh, uv, mr, mb, mc, ct, dt, dta$, ta)
      END IF


     'LOCATE 26, 3
     'REM window index
     'PRINT tct; " #"
    
    
     IF bu = 1 AND MOUSEH > (lh) AND MOUSEH < (lh + 10) AND MOUSEV > (uv) AND MOUSEV < (uv + 10) THEN
    
     mwct = tct
     rsize = (mr - lh)
     bsize = (mb - uv)
     CALL movewindow(mwct, rsize, bsize)
    
     END IF
    
    
     IF bu = 1 AND (MOUSEH + si) < (mr) AND MOUSEV > (uv) AND (MOUSEH + si) > (mr - 10) AND MOUSEV < (uv + 10) THEN
       
          mc = 0
          MOUSEH = 0
          MOUSEV = 0
          mouseh1 = 360 - si
          mousev1 = 200 - si
         'CLS
         ' CALL umouse(cx, dx, bx, bu)
         ct = tct
         CALL pxwindow(lh - 20, uv - 20, mr + 20, mb + 20, mc, ct, dt, dta$, ta)
        

     marry(tct, 0) = 0
     marry(tct, 1) = 0
     marry(tct, 2) = 0
     marry(tct, 3) = 0
     marry(tct, 4) = 0
     marry(tct, 5) = 0
     marry(tct, 6) = 0
    
         CALL pastebgtext
         
     END IF


    END IF



    tct = tct + 1
  LOOP UNTIL tct >= (100)

END SUB

SUB mouse (cx, dx, bx)
       
       
      

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

SUB mouseButtons (ct, bu)


CALL mouse(cx, dx, bx)
bu = bx

SELECT CASE (bu)

CASE IS = 1
    CALL icons(h%, v%)


   


CASE IS = 2
 
CALL wamouse

  lh = MOUSEH
  uv = MOUSEV
  mr = lh + 160
  mb = uv + 160
      mc = 2
CALL pxwindow(lh, uv, mr, mb, mc, ct, dt, dta$, ta)

  rsize = 160
  bsize = 160


IF ct > 100 THEN ct = 1
     mc = 7

  pxwct = ct
 tmarry$(pxwct, 0) = "HELP"
 
CALL IPxWindow(rsize, bsize, mc, ct, dta$, dt)






 CALL wamouse


END SELECT




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 (mwct, rsize, bsize)
DO
CALL mouse(cx, dx, bx)
bu = bx


h = dx
v = cx

LINE (h, v)-(h + rsize, v + bsize), 1, B

IF h <> (h1) OR v <> (v1) THEN
 LINE (h1, v1)-(h1 + rsize, v1 + bsize), 0, B
 
 h1 = h
 v1 = v

END IF


LOOP UNTIL bu = 0

  REM put new position in Array
 marry(mwct, 0) = h
 marry(mwct, 1) = v
 marry(mwct, 2) = h + rsize
 marry(mwct, 4) = v + bsize

    CALL pastebgtext
    'SHELL "cls"
        'CALL MOUSEPOINTER(0)      'Reset mouse and
        'CALL mousepointer(1)      'show arrow
        'CALL mousepointer(3)      'Get coordinates
   
    'PUT (0, 20), BGPicture
END SUB

DEFSNG A-Z
SUB Ncad (dta$)
CLS
PRINT "****************************"
PRINT "*   NCAD HI FUNCTIONS      *"
PRINT "*                          *"
PRINT "****************************"
PRINT ""

SLEEP

PRINT " MENU"
PRINT "      1. EMPTY CASH * "
PRINT "      2. VEIW CASH  "
PRINT "      3. CHANGE BACKGROUND"
PRINT "      4. ENABLE MOVIE CAMREA SYNC"
PRINT "      5. SHOW MACRO COMMANDS"
PRINT "      6.       "
PRINT "      7.       "
PRINT "      8. ABOUT QBCAD"
END SUB

DEFINT A-Z
SUB openfile (mh, mv)

CALL tmouse(mh, mv)
' 2, 1
'PRINT mh, mv


IF mh < 1 THEN mh = 1

DO

w$ = CHR$(SCREEN(mv, mh))
      

na$ = na$ + w$
mh = mh + 1

LOOP UNTIL mh > 79 OR w$ = " "



LOCATE 27, 60
PRINT "<  "; na$; "  >"


filena$ = na$

END SUB

DEFSNG A-Z
SUB OScall (na$)



RUN na$
END SUB

DEFINT A-Z
SUB parkmouse

         MOUSEH = 10
         MOUSEV = 10
       
         GET (MOUSEH, MOUSEV)-(MOUSEH + si, MOUSEV + si), box%
         mouseh1 = MOUSEH: mousev1 = MOUSEV

END SUB

SUB pastebgtext


LOCATE 2, 1
PRINT bgtext$;



END SUB

SUB Pause (wlength)

 DIM tmp%(50, 20)
GET (0, 0)-(50, 20), tmp%

mpb = 0

DO
pb = pb + 1

 DO
 c = INT(RND(1) * (15)) + 1
 COLOR c
 LOCATE 1, 1
  PRINT "P" + TIME$
 
 LOOP UNTIL TIME$ <> (ltime$)
  ltime$ = TIME$
  mpb = mpb + 1

ke$ = INKEY$
LOOP UNTIL ke$ = CHR$(32) OR mpb >= (wlength)
  
PUT (0, 0), tmp%
  COLOR 7


END SUB

DEFSNG A-Z
SUB PDLINE (ag, VR, EA, DMO, h, v, x, y, c, 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) * size
h1 = h


x = h1
y = v1

h = x
v = y

END SUB

SUB percad (nm$, dta$, CAD$)
 INPUT "DO YOU WANT TO SEE THE DATA <Y/N> "; YN$: YN$ = UCASE$(YN$)
 X1 = 0: y1 = 0: z1 = 0
 swth = 0: shht = 0

ct = 1
LN = LEN(dta$)


OPEN nm$ + ".PCD" FOR OUTPUT AS #1

DO

DO
KC$ = MID$(dta$, ct, 1)
ct = ct + 1
WORD$ = WORD$ + KC$

LOOP UNTIL KC$ = ";" OR ct >= (LN)
   'PRINT word$
 
   SL$ = MID$(WORD$, 2, 1)
   KC1$ = LEFT$(WORD$, 1)

 
  
   CNTL$ = LEFT$(WORD$, 1)
 CNTL$ = UCASE$(CNTL$)
 

REM IF ITS AN ANGLED MOVE BUILD THE CNTL$

   IF CNTL$ = "^" OR CNTL$ = "V" THEN
    CNTL$ = LEFT$(WORD$, 2)
   END IF

 n$ = MID$(WORD$, 2, LN - 1)
 n = VAL(n$): ' PRINT N$

 IF KC1$ = "^" OR KC1$ = "V" THEN
    n$ = ""
    ch$ = ""
    LW = LEN(WORD$)
  
     bdn = 2
   
     WHILE ch$ <> ";" AND bdn < LEN(WORD$)
     bdn = bdn + 1
     ch$ = MID$(WORD$, bdn, 1)
    
      IF ch$ <> ";" THEN
       n$ = n$ + ch$
      END IF
   
     WEND
   

   'PRINT "^V "; N$; " ### "
  
    n = VAL(n$): ' PRINT N$
   
 END IF
 IF CNTL$ = "C" THEN

  c = n

 END IF

 IF CNTL$ = "U" THEN y1 = y1 - n: PD = 1
 IF CNTL$ = "D" THEN y1 = y1 + n: PD = 1
 IF CNTL$ = "R" THEN X1 = X1 + n: PD = 1
 IF CNTL$ = "L" THEN X1 = X1 - n: PD = 1
 IF CNTL$ = "Z" THEN z1 = z1 - n: PD = 1: REM f
 IF CNTL$ = "X" THEN z1 = z1 + n: PD = 1: REM b

 IF CNTL$ = "E" THEN
  PD = 1
  X1 = X1 + n: y1 = y1 - n
 END IF
 IF CNTL$ = "H" THEN
  PD = 1
  X1 = X1 - n: y1 = y1 - n
 END IF
 IF CNTL$ = "F" THEN
 PD = 1
 X1 = X1 + n: y1 = y1 + n
 END IF
 IF CNTL$ = "G" THEN
 PD = 1
 X1 = X1 - n: y1 = y1 + n
 END IF



 IF CNTL$ = "^R" THEN
 PD = 1
 X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^D" THEN
 PD = 1
 y1 = y1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^L" THEN
 PD = 1
 X1 = X1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "^U" THEN
 PD = 1
 y1 = y1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "VR" THEN
 PD = 1
 X1 = X1 + n: z1 = z1 + n
 END IF
 IF CNTL$ = "VD" THEN
 PD = 1
 y1 = y1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VL" THEN
 PD = 1
 X1 = X1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "VU" THEN
 PD = 1
 y1 = y1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "^E" THEN
 PD = 1
 y1 = y1 - n: X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^F" THEN
 PD = 1
 y1 = y1 + n: X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^G" THEN
 PD = 1
 y1 = y1 + n: X1 = X1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "^H" THEN
 PD = 1
 y1 = y1 - n: X1 = X1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "VE" THEN
 PD = 1
 y1 = y1 - n: X1 = X1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VF" THEN
 PD = 1
 y1 = y1 + n: X1 = X1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VG" THEN
 PD = 1
 y1 = y1 + n: X1 = X1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "VH" THEN
 PD = 1
 y1 = y1 - n: X1 = X1 - n: z1 = z1 + n
 END IF



 IF lword$ <> "B;" AND PD = 1 THEN
 PRINT #1, x2; ";"; y2; ";"; z2; ";"; X1; ";"; y1; ";"; z1; ";"; c; ";"; CHR$(13)

 IF YN$ = "Y" THEN
  PRINT x2; ";"; y2; ";"; z2; ";"; X1; ";"; y1; ";"; z1; ";"; c; ";"; CHR$(13)
  END IF

 PD = 0


 END IF


   x2 = X1
   y2 = y1
   z2 = z1


 IF tp = 2 THEN
 tp = 0
END IF
 lword$ = WORD$
 WORD$ = ""
LOOP UNTIL ct >= (LN)
CLOSE #1

PRINT nm$; " SAVED #"
SLEEP

END SUB

DEFINT A-Z
SUB pline (ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, 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

LOOP UNTIL (cl) >= (sz * scale)



h = x: v = y
END SUB

DEFSNG A-Z
SUB portdta (dta$, CAD$)
CLS
PRINT
PRINT "**********************"
PRINT "* CONVERTING CAD DATA*"
PRINT "**********************"
PRINT
PRINT "CURRENT    "; CAD$
INPUT "File name  ", nm$

IF nm$ = "" THEN nm$ = CAD$

PRINT "<1> for DANCAD3D 1.0 "
PRINT "<2> for PERCAD 2000  "
PRINT ""
PRINT ""

INPUT ke

SELECT CASE ke
CASE 1
 INPUT "DO YOU WANT TO SEE THE DATA <Y/N> "; YN$: YN$ = UCASE$(YN$)
 X1 = 0: y1 = 0: z1 = 0
 swth = 0: shht = 0

ct = 1
LN = LEN(dta$)

     CHDIR "C:\DANCAD3D"
OPEN nm$ FOR OUTPUT AS #1

PRINT #1, "DATA AS X1 Y1 Z1 X2 Y2 Z2, 0 0 0  0 0 0 ENDS FILE:"; nm$

DO

DO
KC$ = MID$(dta$, ct, 1)
ct = ct + 1
WORD$ = WORD$ + KC$

LOOP UNTIL KC$ = ";" OR ct >= (LN)
   'PRINT word$
  
   SL$ = MID$(WORD$, 2, 1)
   KC1$ = LEFT$(WORD$, 1)

  
   
   CNTL$ = LEFT$(WORD$, 1)
 CNTL$ = UCASE$(CNTL$)
  

REM IF ITS AN ANGLED MOVE BUILD THE CNTL$

   IF CNTL$ = "^" OR CNTL$ = "V" THEN
    CNTL$ = LEFT$(WORD$, 2)
   END IF

 n$ = MID$(WORD$, 2, LN - 1)
 n = VAL(n$): ' PRINT N$

 IF KC1$ = "^" OR KC1$ = "V" THEN
    n$ = ""
    ch$ = ""
    LW = LEN(WORD$)
   
     bdn = 2
    
     WHILE ch$ <> ";"
     bdn = bdn + 1
     ch$ = MID$(WORD$, bdn, 1)
     
      IF ch$ <> ";" THEN
       n$ = n$ + ch$
      END IF
    
     WEND
    

   'PRINT "^V "; N$; " ### "
   
    n = VAL(n$): ' PRINT N$
    
 END IF


 IF CNTL$ = "U" THEN y1 = y1 - n: PD = 1
 IF CNTL$ = "D" THEN y1 = y1 + n: PD = 1
 IF CNTL$ = "R" THEN X1 = X1 + n: PD = 1
 IF CNTL$ = "L" THEN X1 = X1 - n: PD = 1
 IF CNTL$ = "Z" THEN z1 = z1 - n: PD = 1: REM f
 IF CNTL$ = "X" THEN z1 = z1 + n: PD = 1: REM b

 IF CNTL$ = "E" THEN
  PD = 1
  X1 = X1 + n: y1 = y1 - n
 END IF
 IF CNTL$ = "H" THEN
  PD = 1
  X1 = X1 - n: y1 = y1 - n
 END IF
 IF CNTL$ = "F" THEN
 PD = 1
 X1 = X1 + n: y1 = y1 + n
 END IF
 IF CNTL$ = "G" THEN
 PD = 1
 X1 = X1 - n: y1 = y1 + n
 END IF



 IF CNTL$ = "^R" THEN
 PD = 1
 X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^D" THEN
 PD = 1
 y1 = y1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^L" THEN
 PD = 1
 X1 = X1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "^U" THEN
 PD = 1
 y1 = y1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "VR" THEN
 PD = 1
 X1 = X1 + n: z1 = z1 + n
 END IF
 IF CNTL$ = "VD" THEN
 PD = 1
 y1 = y1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VL" THEN
 PD = 1
 X1 = X1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "VU" THEN
 PD = 1
 y1 = y1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "^E" THEN
 PD = 1
 y1 = y1 - n: X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^F" THEN
 PD = 1
 y1 = y1 + n: X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^G" THEN
 PD = 1
 y1 = y1 + n: X1 = X1 - n: z1 = z1 - n
 END IF
 
 IF CNTL$ = "^H" THEN
 PD = 1
 y1 = y1 - n: X1 = X1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "VE" THEN
 PD = 1
 y1 = y1 - n: X1 = X1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VF" THEN
 PD = 1
 y1 = y1 + n: X1 = X1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VG" THEN
 PD = 1
 y1 = y1 + n: X1 = X1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "VH" THEN
 PD = 1
 y1 = y1 - n: X1 = X1 - n: z1 = z1 + n
 END IF

 

 IF lword$ <> "B;" AND PD = 1 THEN
 PRINT #1, x2; " "; y2; " "; z2; " "; X1; " "; y1; " "; z1; " "; CHR$(13)

 IF YN$ = "Y" THEN
  PRINT WORD$; " to "; x2; " "; y2; " "; z2; " "; X1; " "; y1; " "; z1; " "; "SZ "; n; CHR$(13)
 END IF

 PD = 0


 END IF
 

   x2 = X1
   y2 = y1
   z2 = z1

 
 IF tp = 2 THEN
 tp = 0
END IF
 lword$ = WORD$
 WORD$ = ""
LOOP UNTIL ct >= (LN)

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

PRINT nm$; " SAVED #"
SLEEP
 ' DANCAD3D
CASE 2
CALL percad(nm$, dta$, CAD$)

END SELECT
CLS
END SUB

DEFINT A-Z
SUB prtext (txt$, h, v, S, c, mr, mb)
hh = h: vv = v
sz = S
vvv = 0
hh = hh + sz

IF h > 0 AND h < (Ril) AND v > 0 AND v < (Bot) THEN

FOR ct = 1 TO LEN(txt$)
ch$ = MID$(txt$, ct, 1)
IF ch$ = CHR$(32) THEN
hh = hh + (sz * 6)
END IF

IF hh > (mr - (sz * 6)) THEN
   hh = h
   v = v + 10

END IF


IF ch$ = "#" THEN
hh = h
vvv = vvv + (sz * 8)
END IF
IF ch$ = "A" THEN
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)
END IF
IF ch$ = "B" THEN
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)
END IF
IF ch$ = "C" THEN
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)
END IF
IF ch$ = "D" THEN
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)
END IF
IF ch$ = "E" THEN
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)
END IF
IF ch$ = "F" THEN
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)
END IF
IF ch$ = "G" THEN
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)
END IF

IF ch$ = "H" THEN
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)
END IF

IF ch$ = "I" THEN
CALL VBCH("R;R;R;L;U;U;U;U;U;U;L;R;R;R;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "J" THEN
CALL VBCH("U;D;R;R;R;U;U;U;U;U;U;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "K" THEN
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)
END IF
IF ch$ = "L" THEN
CALL VBCH("R;R;R;R;L;L;L;L;U;U;U;U;U;U;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "M" THEN
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 * 6)
END IF
IF ch$ = "N" THEN
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)
END IF

IF ch$ = "O" THEN
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)
END IF
IF ch$ = "P" THEN
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)
END IF

IF ch$ = "Q" THEN
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)
END IF
IF ch$ = "R" THEN
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)
END IF

IF ch$ = "S" THEN
CALL VBCH("R;R;R;E;U;H;L;H;U;E;R;R;R;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF

IF ch$ = "T" THEN
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)
END IF
IF ch$ = "U" THEN
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)
END IF
IF ch$ = "V" THEN
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)
END IF
IF ch$ = "W" THEN
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)
END IF
IF ch$ = "X" THEN
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)
END IF


IF ch$ = "Y" THEN
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)
END IF

IF ch$ = "Z" THEN
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 IF
vv = v + vvv
NEXT ct
END IF
END SUB

SUB pxwindow (lh, uv, mr, mb, mc, ct, dt, dta$, ta)
   
    IF hidew = 0 THEN
    
    IF mc > 0 THEN
     LINE (lh, uv)-(mr, mb), mc, BF
     LINE (lh, uv)-(mr, mb), 4, B
     LINE (lh, uv)-(lh + 10, uv + 10), 8, B
     LINE (mr - 10, uv + 10)-(mr, uv), 9, BF
    
    
     END IF
    
     SELECT CASE (dt)
     CASE IS = 0
      ' pxwct = ct
      'txt$ = tmarry$(pxwct, 0)
          h = lh + 12
          v = uv + 12: S = 1
          c = 1
    
     CALL prtext(txt$, h, v, S, c, mr, mb)
     
   
    CASE IS = 1

      b = 0
      swth = mr
      shht = mb
     
          'ag = 20
          'Ta = 20
          
      CALL VBDRAW(lh, uv, ag, qa, ta, dta$, h, v, b, swth, shht)
        
         
           'ag = ag + 1: IF ag > 360 THEN ag = 1
            ta = ta + 1: IF ta > 360 THEN ta = 1
           'qa = qa + 1: IF qa > 360 THEN qa = 1
         

    CASE IS = 2
       h = lh + 20
       v = uv + 20
      txt$ = lcmd$
      S = 1
      c = 7
      CALL prtext(txt$, h, v, S, c, mr, mb)

    CASE IS = 3


      x = INT(RND(1) * (100)) + 1
      y = INT(RND(1) * (100)) + 1
      x = x + lh + 20
      y = y + uv + 20
      c = INT(RND(1) * (16)) + 1
      CIRCLE (x, y), 10, c




    END SELECT

    IF mc = 0 THEN
    LINE (lh, uv)-(mr, mb), mc, BF
    END IF


END IF
END SUB

SUB Qbprun (filena$)


CALL cleartxt

LOCATE 2, 10: PRINT "                        "
LOCATE 3, 10: PRINT "#####################"
LOCATE 4, 10: PRINT "# Run " + filena$
LOCATE 5, 10: PRINT "#####################"
LOCATE 6, 10: PRINT "                       "
 SLEEP
 DO
 INPUT ke$
  IF ke$ = "Y" THEN
  
   sv$ = RIGHT$(filena$, 4)

   SELECT CASE (sv$)
   CASE IS = ".BAS"

    CHAIN filena$
      REM LH /L:1;2;3;4 +
  
   CASE IS = ".EXE"
   
    SHELL "LH" + filena$
  
   CASE IS = ".BAT"
    SHELL filena$

   CASE IS = ".COM"
    SHELL filena$
  
   CASE IS = ".BAT"
    SHELL filena$
  
   CASE IS = ".WAV"
  
   'CALL initsound
   'CALL playwav(filena$)
  
   END SELECT
 
  END IF

  
 LOOP UNTIL ke$ = "Y" OR ke$ = "N"
 
      wlength = 5
   CALL Pause(wlength)


  CALL cleartxt
 
  CALL pastebgtext

END SUB

SUB refcommands
CLS
n = 0
DO
LOCATE 1, 1
ke$ = INKEY$
IF ke$ = "J" THEN n = n - 1: IF n < 0 THEN n = 0
IF ke$ = "K" THEN n = n + 1


SELECT CASE (n)
CASE IS = 0
PRINT "-plexer"
PRINT "bye"
PRINT ""


CASE IS = 1



END SELECT


LOOP UNTIL ke$ = CHR$(27)


END SUB

SUB ROTATE (dta$, an, qa, ta, swth, shht, sh, sv)
ta = ta
ta1 = ta
  h = sh
  v = sv

  h1 = h
  v1 = v
h2 = h2
v2 = v1

rt = 1
DO
'dta$ = "TA" + Str$(STA) + ";" + "QA" + Str$(QA) + ";" + Text1
rt = rt + 1
b = 1
CALL VBDRAW(lh, uv, ag, qa, ta1, dta$, h1, v1, b, swth, shht)
  h = sh
  v = sv
  h1 = h: v1 = v
ta1 = ta


ta = ta + 5

IF ta > 360 THEN ta = 1


b = 0
CALL VBDRAW(lh, uv, ag, qa, ta, dta$, h, v, b, swth, shht)
ke$ = INKEY$
ke$ = UCASE$(ke$)

LOOP UNTIL rt = (360 / 5) OR ke$ = "Q"
  b = 1
  CALL VBDRAW(lh, uv, ag, qa, ta1, dta$, h1, v1, b, swth, shht)

END SUB

SUB sgline (ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, BL, n, swth, shht)

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 * scale)

BL = 0
IF n = 1 THEN
x = h
y = v
n = 0
END IF

END SUB

SUB TBox (lh, uv, mr, mb, mc)


MLimit = 100
ct = 0

CALL mouse(cx, dx, bx): bu = bx
DO

lh = marry(ct, 0): mr = marry(ct, 2)
uv = marry(ct, 1): mb = marry(ct, 4)

  IF bu = 1 AND MOUSEH > (mr - 10) AND MOUSEV < (uv + 10) AND MOUSEH < (mr) AND MOUSEV > (uv) THEN
   mc = 0
   LINE (lh, uv)-(mr, mb), mc, BF
 
   marry(ct, 0) = 0
   marry(ct, 1) = 0
   marry(ct, 2) = 0
   marry(ct, 3) = 0
 
   mr = 0
   mb = 0
 
   END IF


IF mr = 0 AND mb = 0 THEN

ct = ct + 1
ELSE

    IF MOUSEH > (lh) AND MOUSEH < (mr) AND MOUSEV > (uv) AND MOUSEV < (mb) THEN
    
    
    CALL pxwindow(lh, uv, mr, mb, mc, ct, dt, dta$, ta)


    END IF
   END IF

  IF mc = 0 THEN
  LINE (lh, uv)-(mr, mb), 0, B
END IF

ct = ct + 1


LOOP UNTIL ct >= (MLimit)

END SUB

SUB tmouse (mh, mv)


mh = (MOUSEH / 8) + 1
mv = (MOUSEV / 8) + 1

IF mh > 79 THEN mh = 79
IF mv > 27 THEN mv = 27

bgcw$ = CHR$(SCREEN(mv, mh))



END SUB

SUB typef

 filena$ = UCASE$(filena$)
   sv$ = RIGHT$(filena$, 4)


IF sv$ = ".BAT" OR sv$ = ".BAS" OR sv$ = ".EXE" OR sv$ = ".COM" OR sv$ = ".WAV" THEN


CALL Qbprun(filena$)


END IF


SHELL "type " + filena$


END SUB

SUB udocs (ocs$, ocsm)



ocsm = ocsm + 1
IF ocsm > 3 THEN ocsm = 0

   ocs$ = ""


SELECT CASE (ocsm)

  CASE IS = 0
    ocs$ = CHR$(220)
  CASE IS = 1
    ocs$ = CHR$(222)
  CASE IS = 2
    ocs$ = CHR$(223)
  CASE IS = 3
    ocs$ = CHR$(221)




END SELECT


END SUB

SUB umouse (ya, xa, bu, si)
 ' 10, 10
 'PRINT ril, bot

 '
   CALL mouse(cx, dx, bx)
      MOUSEH = dx: MOUSEV = cx

'
SELECT CASE (MPTicon)
CASE IS = 0
   REM (((( Target point ))))
   IF MOUSEH > Ril THEN MOUSEH = Ril
   IF MOUSEH < 1 THEN MOUSEH = 1
   IF MOUSEV > Bot THEN MOUSEV = Bot
   IF MOUSEV < 1 THEN MOUSEV = 1

mh = (MOUSEH / 8) + 1
mv = (MOUSEV / 16) + 1


IF mouseh1 <> (MOUSEH) OR mousev1 <> (MOUSEV) THEN

IF MOUSEH < (Ril - (si + 1)) AND MOUSEV < (Bot - (si + 1)) THEN
   PUT (mouseh1, mousev1), box%, PSET
   GET (MOUSEH, MOUSEV)-(MOUSEH + si, MOUSEV + si), box%
   
    mouseh1 = MOUSEH
    mousev1 = MOUSEV


CALL drawPointer
END IF

END IF
CASE IS = 1
END SELECT

    
 


END SUB

'------------------------------------------------------------------------------
SUB ValidWavHeader (file$, LenHeader%, dataLen&, nChannels%, nSamplesPerSec&, nAvgBytesPerSec&, ok%)
rID$ = SPACE$(4)
wID$ = SPACE$(4)
fID$ = SPACE$(4)
dat$ = SPACE$(4)
dummy$ = SPACE$(1)
filenum% = FREEFILE
'
'
'
'File not found? Let me explain...
'
OPEN file$ FOR BINARY AS filenum%
'
'If you are using manual input (typing words directly into the pc),
'then you might have made a typo while entering words. entering a "[",
'or other non-letter character will cause the program to crash becasue
'it cannot find the file "[.wav". Get the idea? Or try to use different
'characters when saying a word. (Only the cahracters listed in the
'beginning of this file are allowed).
'
  GET filenum%, , rID$
  GET filenum%, , rLen&
  GET filenum%, , wID$
  GET filenum%, , fID$
  GET filenum%, , fLen&
  GET filenum%, , wFormatTag%       '2 bytes
  GET filenum%, , nChannels%        '2 bytes
  GET filenum%, , nSamplesPerSec&   '4 bytes
  GET filenum%, , nAvgBytesPerSec&  '4 bytes
  GET filenum%, , nBlockAlign%      '2 bytes
  GET filenum%, , FormatSpecific%   '2 bytes
  'Read bytes until have read fLen& total bytes.
  'I have no idea what these next bytes are used for (if they even exist).
  FOR I% = 1 TO fLen& - 16          '16 bytes is what we have read in so far
     GET filenum%, , dummy$         'read in 1 byte at a time
  NEXT I%
  GET filenum%, , dat$
  IF UCASE$(dat$) = "FACT" THEN
     'funny format...
     GET filenum%, , dummy&
     GET filenum%, , dummy&
     GET filenum%, , dat$
  END IF
  GET filenum%, , dataLen&
  LenHeader% = LOC(1)
CLOSE filenum%
'  CLS
'  PRINT rID$;
'  PRINT rLen&;
'  PRINT wID$;
'  PRINT fID$;
'  PRINT fLen&;
'  PRINT wFormatTag%;       '2 bytes
'  PRINT nChannels%;        '2 bytes
'  PRINT nSamplesPerSec&;   '4 bytes
'  PRINT nAvgBytesPerSec&;  '4 bytes
'  PRINT nBlockAlign%;      '2 bytes
'  PRINT FormatSpecific%;   '2 bytes
'  PRINT dat$;
'  PRINT dataLen&;
'  PRINT LenHeader%
IF UCASE$(rID$) = "RIFF" THEN
   IF UCASE$(wID$) = "WAVE" THEN
      IF UCASE$(dat$) = "DATA" THEN
         IF UCASE$(fID$) = "FMT " THEN
          IF FormatSpecific% = 8 THEN ok% = -1
         END IF
      END IF
   END IF
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 (lh, uv, ag, qa, ta, dta$, h, v, b, swth, shht)

LOCATE 4, 3
PRINT lh, uv, h, v
LOCATE 5, 3
PRINT swth, shht
LOCATE 6, 4
PRINT dta$, ag, qa, ta

x = lh + 80
y = uv + 80
h = lh + 80
y = uv + 80



VR = qa
CANGLE = ta
n = 0
BL = 0
  size = 0
  sz = 0
  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
REM BUILD DATA
ll = LEN(dta$)
FOR ct = 1 TO (ll)
 
ch$ = MID$(dta$, ct, 1)
 ch$ = UCASE$(ch$)
CHH$ = ""

 IF ct > 2 THEN
 C1$ = MID$(dta$, ct - 1, 1)
 IF C1$ = "V" OR C1$ = "^" THEN ch$ = ""

CHH$ = MID$(dta$, ct, 2)
 CHH$ = UCASE$(CHH$)


 END IF



 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, mr, mb)
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

REM *******************
REM *** Flat Angles ***
REM *******************
 fx = sz / 3

bll = BL

IF ch$ = "H" OR ch$ = "F" OR ch$ = "E" OR ch$ = "G" THEN

h2 = h: v2 = v
END IF

IF ch$ = "F" THEN
CALL GETVL(dta$, ct, sz)

  EA = 360 + ANGLE
    CALL pline(ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, swth, shht)
  EA = 90 + ANGLE
    CALL pline(ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, swth, shht)
    
END IF
IF ch$ = "H" THEN
CALL GETVL(dta$, ct, sz)
 
  EA = 270 + ANGLE
    CALL pline(ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, swth, shht)
  EA = 180 + ANGLE
    CALL pline(ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, swth, shht)
     
END IF

IF ch$ = "E" THEN
CALL GETVL(dta$, ct, sz)

  EA = 270 + ANGLE
    CALL pline(ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, swth, shht)
  EA = 360 + ANGLE
    CALL pline(ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, swth, shht)
    
END IF

IF ch$ = "G" THEN
CALL GETVL(dta$, ct, sz)

  EA = 180 + ANGLE
    CALL pline(ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, swth, shht)
  EA = 90 + ANGLE
    CALL pline(ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, swth, shht)
    
END IF

IF ch$ = "H" OR ch$ = "F" OR ch$ = "E" OR ch$ = "G" THEN

IF bll = 0 THEN
 IF x > 0 AND x < (swth) AND y > 0 AND y < (shht) THEN
  LINE (h2, v2)-(x, y), c
 END IF
END IF

IF n = 1 THEN


h = h2: v = v2
ELSE

h = x: v = y

END IF
END IF

BL = bll

SUPERANGLE:

IF ct < (ll - 2) THEN
CALL GETVL(dta$, ct + 1, sz)

END IF

REM SZ IS SPEACIAL TO SUPERANGLE ONLY!

REM FOWARDS ANGLES

IF CHH$ = "^U" THEN
    REM U UP/FORWARD
    'rem move 3d forward
     DMO = 0 - sz
     EA = 270 + ANGLE
    GOTO EXTRA
END IF

IF CHH$ = "^R" THEN
    REM ^R RIGHT/FORWARD
    'rem move 3d forward
     DMO = 0 - sz
     EA = 360 + ANGLE
    GOTO EXTRA
END IF

IF CHH$ = "^D" THEN
    REM ^D DOWN/FORWARD
    'rem move 3d forward
     DMO = 0 - sz
     EA = 90 + ANGLE
     GOTO EXTRA
END IF

IF CHH$ = "^L" THEN
    REM ^L DOWN/FORWARD
    'rem move 3d forward
     DMO = 0 - sz
     EA = 180 + ANGLE
     GOTO EXTRA
END IF

REM BACKWARDS ANGLES
 
IF CHH$ = "VU" THEN
    REM VU UP/BACKWARD
    'rem move 3d forward
     DMO = sz
     EA = 270 + ANGLE
    GOTO EXTRA
END IF

IF CHH$ = "VR" THEN
    REM VR RIGHT/BACKWARD
    'rem move 3d forward
     DMO = sz
     EA = 360 + ANGLE
    GOTO EXTRA
END IF

IF CHH$ = "VD" THEN
    REM ^D DOWN/BACKWARD
    'rem move 3d forward
     DMO = sz
     EA = 90 + ANGLE
     GOTO EXTRA
END IF

IF CHH$ = "VL" THEN
    REM VL DOWN/BACKWARD
    'rem move 3d forward
     DMO = sz
     EA = 180 + ANGLE
     GOTO EXTRA
END IF


REM FORWARD ANGLES
REM CTRL ^
IF CHH$ = "^E" THEN
    'rem move 3d forward
     DMO = 0 - sz
     EA = 360 + ANGLE
     EA1 = 270 + ANGLE
     GOTO EXTRA
END IF

IF CHH$ = "^F" THEN
    'rem move 3d forward
     DMO = 0 - sz
     EA = 360 + ANGLE
     EA1 = 90 + ANGLE
     GOTO EXTRA
END IF

IF CHH$ = "^G" THEN
    'rem move 3d forward
     DMO = 0 - sz
     EA = 180 + ANGLE
     EA1 = 90 + ANGLE
     GOTO EXTRA
END IF

IF CHH$ = "^H" THEN
    'rem move 3d forward
     DMO = 0 - sz
     EA = 180 + ANGLE
     EA1 = 270 + ANGLE
     GOTO EXTRA
END IF

REM BACKWARD ANGLES
REM ALT V
IF CHH$ = "VE" THEN
    'rem move 3d forward
     DMO = sz
     EA = 360 + ANGLE
     EA1 = 270 + ANGLE
     GOTO EXTRA
END IF

IF CHH$ = "VF" THEN
    'rem move 3d forward
     DMO = sz
     EA = 360 + ANGLE
     EA1 = 90 + ANGLE
     GOTO EXTRA
END IF

IF CHH$ = "VG" THEN
    'rem move 3d forward
     DMO = sz
     EA = 180 + ANGLE
     EA1 = 90 + ANGLE
     GOTO EXTRA
END IF

IF CHH$ = "VH" THEN
    'rem move 3d forward
     DMO = sz
     EA = 180 + ANGLE
     EA1 = 270 + ANGLE
     GOTO EXTRA
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

REM BLOCK THIS BOTTOM CODE ***
GOTO ET

EXTRA:
  
X1 = x: y1 = y
     
     TBL = BL
     BL = 1
     
     CALL DLINE(ag, VR, EA, DMO, h, v, x, y, c, BL, n, size, swth, shht)
        h = x: v = y
     BL = 1
     CALL sgline(ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, BL, n, swth, shht)
         h = x: v = y
     IF EA1 <> 0 THEN
     BL = 1
     EA = EA1
     CALL sgline(ag, VR, EA, ANGLE, sz, x, y, h, v, c, size, BL, n, swth, shht)
    
     END IF
    
     BL = TBL
    
    
    IF BL = 0 THEN
    LINE (X1, y1)-(x, y), c
    END IF
     CHH$ = ""
   
    IF n = 1 THEN

    h = X1: v = y1
    END IF
    EA1 = 0
    GOTO SUPERANGLE
  


ET:

END SUB

SUB wamouse

LOCATE 25, 60: PRINT "W";
DO
CALL mouse(cx, dx, bx)


LOOP UNTIL bx = 0


LOCATE 25, 60: PRINT " ";

END SUB

DEFSNG A-Z
SUB WORLDSCALE (dta$, SE$)
CLS
ll = LEN(dta$)

DO
ct = ct + 1
ch$ = MID$(dta$, ct, 1)
  ch$ = UCASE$(ch$)
LOOP UNTIL ch$ = "S" OR ct >= (ll)

DO
ct = ct + 1
ch$ = MID$(dta$, ct, 1)

NN$ = NN$ + ch$

LOOP UNTIL ch$ = ";" OR ct >= (ll)

num$ = MID$(NN$, 1, LEN(NN$) - 1)


PRINT " CURRENT SCALE <"; num$
INPUT "NEW SETTING <"; SE$
IF SE$ <> "" THEN
LDTA$ = RIGHT$(dta$, ll - ct)
PRINT LDTA$

dta$ = "S" + SE$ + ";" + LDTA$
ELSE
PRINT " NO CHANGE MADE"
SLEEP
END IF

END SUB

