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)
DECLARE SUB edraw (ag!, qa!, ta!, dta$, B!)
DECLARE SUB VBCH (DAT$, h!, v!, SZ!, C!)
DECLARE SUB GETTX (dta$, CT!, txt$, s)
DECLARE SUB PRTEXT (txt$, h!, v!, s!, C!, swth, shht)
DECLARE SUB GETVL (dta$, CT!, SZ!)
DECLARE SUB DLINE (ag!, VR!, EA!, DMO!, h!, v!, X!, Y!, C!, BL!, N!, size!, swth, shht)
DECLARE SUB CDRAW (ag!, qa!, ta!, dta$, B!)
DECLARE SUB VBDRAW (ag!, qa!, ta!, dta$, h!, v!, B!, swth, shht)
DECLARE SUB sgline (ag!, VR!, EA!, ANGLE!, SZ!, X!, Y!, h!, v!, C!, size!, BL!, N!, swth, shht)
dta$ = "S1;C2;D50;L50;R 100;U 100;L 100;D 100;^L 100;U 100;VR 100;^U 100;R 100;VD 100;^R 100;D 100;VL 100;^D 100;L 100;VU 100;"

 SE$ = "1"
DTA1$ = dta$
    size = 100
    swth = 600
    shht = 400
    scale = 100
   CAD$ = "startup"
   sh = swth / 2
   sv = shht / 2
   H1 = sh
   V1 = sv
   VSCN = 1: REM VEIW SCREEN ON
CLOSE
SCREEN 12
swth = 320
shht = 200

ag = 1
qa = 2
ta = 1
B = 0
ag1 = ag
qa1 = qa
ta1 = ta
posnc = 10
PI = 3.142587
REM
SZ = 1
REM written 2000 april 3
REM Scott Gates
DO
tm$ = TIME$
 txt$ = "TIME " + tm$
LOCATE 1, 1
PRINT tm$

h = 121
v = 121
s = 5
C = 2

CALL PRTEXT(txt$, h, v, s, C, swth, shht)







 ke$ = INKEY$

LOOP UNTIL ke$ = CHR$(27) OR ke$ = "Q"

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

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(ag, qa, ta, dta$, h, v, B, swth, shht)

B = 1
CALL VBDRAW(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

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

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

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 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"
DO
ke$ = INKEY$
ke$ = UCASE$(ke$)
LOOP UNTIL ke$ = "C"
CLS


END SUB

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

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

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

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

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

SUB PRTEXT (txt$, h, v, s, C, swth, shht)
HH = h: vv = v
SZ = s
vvv = 0
HH = HH + SZ
IF h > 0 AND h < (swth) AND v > 0 AND v < (shht) THEN

FOR CT = 1 TO LEN(txt$)
ch$ = MID$(txt$, CT, 1)
IF ch$ = CHR$(32) THEN
HH = HH + (SZ * 6)
END IF

IF ch$ = "#" THEN
HH = h
vvv = vvv + (SZ * 8)
END IF

 ' #### Numbers

IF ch$ = "1" THEN
CALL VBCH("R;R;U;U;U;U;U;U;F;R;D;D;D;D;D;R;R;", HH, vv, SZ, C)
HH = HH + (SZ * 6)
END IF
IF ch$ = "2" THEN
CALL VBCH(" U;E;R;E;U;H;L;F;B;D;D;D;D;V;R;R;R;", HH, vv, SZ, C)
HH = HH + (SZ * 6)
END IF

IF ch$ = "3" THEN
CALL VBCH("R;R;E;U;H;L;L;R;R;E;U;H;L;L;", HH, vv, SZ, C)
HH = HH + (SZ * 6)
END IF


 ' #### end of numbers

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 QBCADLOGO
CLS

DO
LOCATE 4, 1
PRINT "     ###   ####   ###    ##   #####       "
PRINT "    #   #  #   # #   #  #  #  #    #   "
PRINT "    #   #  #   # #     #    # #    #   "
PRINT "    #   #  #   # #     #    # #    #   "
PRINT "    #   #  ####  #     #    # #    #   "
PRINT "    #   #  #   # #     ###### #    #   "
PRINT "    # # #  #   # #     #    # #    #   "
PRINT "    #  ##  #   # #     #    # #    #   "
PRINT "    #   #  #   # #   # #    # #    #   "
PRINT "     ### # ####   ###  #    # #####       "
PRINT
PRINT "  PRESS "
PRINT " <B> TO BEGIN"
PRINT " <H> FOR HELP "


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

IF ke$ = "H" THEN CALL HELP



LOOP UNTIL ke$ = "B"
CLS
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(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(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(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)

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

BL = 0
IF N = 1 THEN
X = h
Y = v
N = 0
END IF

END SUB

SUB VBCH (DAT$, h, v, SZ, C)
X = h
Y = v
X1 = h
y1 = Y
REM BUILD DATA
LL = LEN(DAT$)
FOR CT = 1 TO (LL)
ch$ = MID$(DAT$, CT, 1)
 ch$ = UCASE$(ch$)
 
 REM ACTUALLY DRAWLING SHAPE

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



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

SUB VBDRAW (ag, qa, ta, dta$, h, v, B, swth, shht)

VR = qa
CANGLE = ta
N = 0
BL = 0
  size = scale
  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$)
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, 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

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

