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;"
  ROOT$ = "C:\QBASIC\"
 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
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


CALL QBCADLOGO

DO

H = sh: V = sv
LOCATE 1, 1
IF VSCN = 1 THEN
PRINT "horz "; H; " vert "; V; " - "; CAD$; " SCALE "; SE$
PRINT ag, qa, ta
PRINT "Size "; size; " "; "color "; C; " postinc "; posnc;
IF dtav = 1 THEN

PRINT "< "; DTA$; " >                              "

               END IF

IF gjs = 1 THEN PRINT "joystk on "; di$ ELSE PRINT "joystk off    "

END IF


B = 0
CALL VBDRAW(ag, qa, ta, DTA$, H, V, B, swth, shht)

DO
KE$ = INKEY$
7 IF KE$ = CHR$(0) + "<" THEN
  IF gjs = 0 THEN gjs = 1 ELSE gjs = 0


END IF

IF gjs = 1 THEN
' rem joystick routine
CALL getjoystick(di$)
IF di$ <> "" THEN
KE$ = di$
di$ = ""
END IF

END IF

LOOP UNTIL KE$ <> ""

KE$ = UCASE$(KE$)


IF KE$ = CHR$(0) + ">" THEN
 INPUT "text "; txt$
 INPUT "size "; ss
txt$ = UCASE$(txt$)
 DTA$ = DTA$ + "~" + txt$ + "," + STR$(ss) + ";"
 CLS
END IF
 IF KE$ = CHR$(0) + "F" THEN CALL WORLDSCALE(DTA$, SE$)
 IF KE$ = CHR$(0) + "^" THEN CALL Ncad(DTA$)

 IF KE$ = CHR$(0) + "=" THEN
 IF dtav = 0 THEN dtav = 1 ELSE dtav = 0
 CLS
 END IF

IF KE$ = CHR$(0) + "B" THEN

   INPUT " color #"; C

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


END IF

IF KE$ = CHR$(0) + ";" THEN CALL portdta(DTA$, CAD$)

IF KE$ = CHR$(0) + "?" THEN VSCN = 1
IF KE$ = CHR$(0) + "@" THEN VSCN = 0: CLS
IF KE$ = CHR$(0) + CHR$(134) THEN CALL HELP






IF KE$ = CHR$(9) THEN CALL ldsv(DTA$, CAD$, SE$)

IF KE$ = CHR$(8) THEN CALL delete(DTA$)


IF KE$ = "7" OR KE$ = "W" THEN DTA$ = DTA$ + "H" + STR$(size) + ";"
IF KE$ = "9" OR KE$ = "R" THEN DTA$ = DTA$ + "E" + STR$(size) + ";"
IF KE$ = "3" OR KE$ = "C" THEN DTA$ = DTA$ + "F" + STR$(size) + ";"
IF KE$ = "1" OR KE$ = "Z" THEN DTA$ = DTA$ + "G" + 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$ = CHR$(0) + "T" THEN DTA$ = DTA$ + "^R" + STR$(size) + ";"
'IF KE$ = CHR$(0) + "" THEN DTA$ = DTA$ + "^D" + STR$(SIZE) + ";"



IF KE$ = "0" OR KE$ = "," THEN DTA$ = DTA$ + "X" + STR$(size) + ";"
IF KE$ = "." THEN DTA$ = DTA$ + "Z" + STR$(size) + ";"
IF KE$ = CHR$(0) + "A" THEN
      INPUT "posnc #"; posnc

END IF
IF KE$ = "M" THEN sv = sv - posnc
IF KE$ = "I" THEN sv = sv + posnc
IF KE$ = "K" THEN sh = sh - posnc
IF KE$ = "J" THEN sh = sh + posnc


REM angled moves


IF KE$ = "X" THEN DTA$ = DTA$ + "D" + STR$(size) + ";"
IF KE$ = "S" THEN DTA$ = DTA$ + "L" + STR$(size) + ";"
IF KE$ = "E" THEN DTA$ = DTA$ + "U" + STR$(size) + ";"
IF KE$ = "D" THEN DTA$ = DTA$ + "R" + STR$(size) + ";"

REM CTRL

IF KE$ = CHR$(24) THEN DTA$ = DTA$ + "^D" + STR$(size) + ";"
IF KE$ = CHR$(19) THEN DTA$ = DTA$ + "^L" + STR$(size) + ";"
IF KE$ = CHR$(5) THEN DTA$ = DTA$ + "^U" + STR$(size) + ";"
IF KE$ = CHR$(4) THEN DTA$ = DTA$ + "^R" + STR$(size) + ";"

REM ALT

IF KE$ = CHR$(0) + CHR$(45) THEN DTA$ = DTA$ + "VD" + STR$(size) + ";"
IF KE$ = CHR$(0) + CHR$(31) THEN DTA$ = DTA$ + "VL" + STR$(size) + ";"
IF KE$ = CHR$(0) + CHR$(18) THEN DTA$ = DTA$ + "VU" + STR$(size) + ";"
IF KE$ = CHR$(0) + CHR$(32) THEN DTA$ = DTA$ + "VR" + STR$(size) + ";"

REM 3d angled moves
REM CTRL

IF KE$ = CHR$(18) THEN DTA$ = DTA$ + "^E" + STR$(size) + ";"
IF KE$ = CHR$(3) THEN DTA$ = DTA$ + "^F" + STR$(size) + ";"
IF KE$ = CHR$(26) THEN DTA$ = DTA$ + "^G" + STR$(size) + ";"
IF KE$ = CHR$(23) THEN DTA$ = DTA$ + "^H" + STR$(size) + ";"

REM ALT

IF KE$ = CHR$(0) + CHR$(19) THEN DTA$ = DTA$ + "VE" + STR$(size) + ";"
IF KE$ = CHR$(0) + CHR$(46) THEN DTA$ = DTA$ + "VF" + STR$(size) + ";"
IF KE$ = CHR$(0) + CHR$(44) THEN DTA$ = DTA$ + "VG" + STR$(size) + ";"
IF KE$ = CHR$(0) + CHR$(17) THEN DTA$ = DTA$ + "VH" + STR$(size) + ";"





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 KE$ = CHR$(0) + "D" THEN CALL ROTATE(DTA$, an, qa, ta, swth, shht, sh, sv)
IF KE$ = "B" THEN DTA$ = DTA$ + "B;"
IF KE$ = "N" THEN DTA$ = DTA$ + "N;"
B = 1
CALL VBDRAW(ag, QA1, TA1, DTA1$, H1, V1, B, swth, shht)

IF KE$ = CHR$(13) THEN KE$ = "13"

LOCATE 28, 55: REM SHOW WHAT KEY WAS PRESSED
PRINT "#"; KE$; "#"; ASC(LEFT$(KE$, 1)); ASC(RIGHT$(KE$, 1)); " "


AG1 = ag
QA1 = qa
TA1 = ta
H1 = sh: V1 = sv
DTA1$ = DTA$

LOOP UNTIL KE$ = CHR$(27)

LOCATE 21, 1

PRINT
PRINT
PRINT
PRINT " GO BACK TO PROGRAM (1.2.3)"
PRINT "1. COCOROM.BAS"
PRINT "2. "
PRINT "3. "
INPUT IC$
IF IC$ = "1" THEN RUN "COCOROM.BAS"

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 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)
TE = 0
DO
    TTE$ = MID$(DTA$, CT + TE, 1)
    TE = TE + 1
   ' PRINT TTE$;
    LOOP UNTIL TTE$ = ";"
   
      IF TE > 2 THEN
    SZ = VAL(MID$(DTA$, CT + 1, TE - 2))
     END IF
  
END SUB

SUB HELP

CLS
PRINT "ARROW keys to position ANGLE OF SHAPE"
PRINT "<B> for blank move"
PRINT "<N> for no updtae"
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 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 ""
PRINT ""
PRINT ""

INPUT KE$


IF KE$ = "1" THEN
 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
END IF ' DANCAD3D

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

