DECLARE SUB incertbox (na$, phr$, sizesh%)
DECLARE SUB mass (phr$, sizesh%, na$)
DECLARE SUB showT ()
DECLARE SUB MoveplotA (ploh%, plov%)
DECLARE SUB MouseArw (mh1%, mv1%)
DECLARE SUB JoyRoutines (ljoyH%, ljoyv%, rjoyh%, rjoyv%)
DECLARE SUB PlotGrid (joypres%, GRH%, GRV%, plos%, ploh%, plov%, lhp%, lvp%)
DECLARE SUB FRGDRAW (frg$, phr$)
DECLARE SUB drect ()
DECLARE SUB MOUSE (cx%, dx%, bx%)
DECLARE SUB MousePointer (SW%)

DEFINT A-Z

DECLARE SUB LSUtil (phr$, sizesh, na$)
DECLARE SUB saveshape (phr$, sizesh, na$)
DECLARE SUB setup (lhc, lvc, rhc, rvc, b1, b2, b3, b4)
DECLARE SUB endprg ()
DECLARE SUB intro (lhc, lvc, rhc, rvc, b1, b2, b3, b4)
DECLARE SUB message ()
DECLARE SUB pause ()
DECLARE SUB incrtpeice (frg$)
DECLARE SUB scrninit ()
DECLARE SUB getpoint (phr$, plc, x, y, z, x1, y1, z1, c)
DECLARE SUB loadshape (phr$, sizesh, na$)
DECLARE SUB help (lhc, lvc, rhc, rvc, b1, b2, b3, b4)
TYPE LineType
    x AS INTEGER
    y AS INTEGER
    z AS INTEGER
    x1 AS INTEGER
    y1 AS INTEGER
    z1 AS INTEGER
END TYPE
DIM points(500) AS LineType
DIM Xn(100), Yn(100), Zn(100)
DIM Xs1(100), Ys1(100), Xe1(100), Ye1(100)
DIM x(100), y(100), z(100), Pointers1(100), Pointers2(100), Sp(100), Zp(100)
DIM r(100), B(63), b1(63)
DIM Cosine&(360), Sine&(360)
DIM phr$(3000)
DIM Cc(500)




0 CLS


REM begin

CALL scrninit


        


fctj$ = "Nav"
lhc = 128
lvc = 128
rhc = 128
rvc = 128
NDRc = 0 ' set to off
b1 = 3
b2 = 7
b3 = 1
b4 = 5


  PRINT " Joystick Ready Software \"
INPUT " Do you have joysticks <1=Yes 0=No>"; joypres
joypres = 1

ploh = 640 / 2 + (640 / 4)
plov = 480 / 2
plos = 120
 GRH = ploh
 GRV = plov

HorXn = 100
VerYn = 100


CALL intro(lhc, lvc, rhc, rvc, b1, b2, b3, b4)

'The following for/next loop makes a sine & cosine table.
'Each sine & cosine is multiplied by 1024 and stored as long integers.
'This is done so that we don't have to use any slow floating point
'math at run time.
a = 0
FOR a! = 0 TO 359 / 57.29577951# STEP 1 / 57.29577951#
    Cosine&(a) = INT(.5 + COS(a!) * 1024)
    Sine&(a) = INT(.5 + SIN(a!) * 1024): a = a + 1
NEXT

CALL help(lhc, lvc, rhc, rvc, b1, b2, b3, b4) ' show the help sceen

CALL incertbox(na$, phr$, sizesh)
'CALL loadshape(phr$, sizesh, na$)



'Next we read in all of the lines that are in the object...
'PRINT sizesh; " Count "
'SLEEP

5 PRINT " Doing math ..."
FOR a = 0 TO (sizesh)
     CALL getpoint(phr$, plc, x, y, z, x1, y1, z1, c)
    
     points(a).x = x
     points(a).y = y
     points(a).z = z
     points(a).x1 = x1
     points(a).y1 = y1
     points(a).z1 = z1
     Cc(a) = c
'PRINT PLC; " PLACE"
NEXT
SLEEP
CLS
'Here comes the hard part... Consider this scenario:

'We have two connected lines, like this:

'   1--------2 and 3
'            |
'            |
'            |
'            |
'            4
'Where 1,2, 3, & 4 are the starting and ending points of each line.
'The first line consists of points 1 & 2  and the second line
'is made of points 3 & 4.
'So, you ask, what's wrong? Nothing, really, but don't you see that
'points 2 and 3 are really at the sample place? Why rotate them twice,
'that would be a total waste of time? The following code eliminates such
'occurrences from the line table. (great explanation, huh?)

NumberLines = 45
'take all of the starting & ending points and put them in one big
'array...
Np = 0
FOR a = 0 TO NumberLines - 1
    x(Np) = points(a).x
    y(Np) = points(a).y
    z(Np) = points(a).z
    Np = Np + 1
    x(Np) = points(a).x1
    y(Np) = points(a).y1
    z(Np) = points(a).z1
    Np = Np + 1
NEXT
'Now set up two sets of pointers that point to each point that a line
'is made of... (in other words, scan for the first occurrence of each
'starting and ending point in the point array we just built...)
FOR a = 0 TO NumberLines - 1
    Xs = points(a).x
    Ys = points(a).y
    Zs = points(a).z            'get the 3 coordinates of the start point
    FOR B = 0 TO Np - 1         'scan the point array
        IF x(B) = Xs AND y(B) = Ys AND z(B) = Zs THEN
            Pointers1(a) = B    'set the pointer to point to the
            EXIT FOR            'point we have just found
        END IF
    NEXT
    Xs = points(a).x1           'do the same thing that we did above
    Ys = points(a).y1           'except scan for the ending point
    Zs = points(a).z1           'of each line
    FOR B = 0 TO Np - 1
        IF x(B) = Xs AND y(B) = Ys AND z(B) = Zs THEN
            Pointers2(a) = B
            EXIT FOR
        END IF
    NEXT
NEXT
'Okay, were almost done! All we have to do now is to build a table
'that tells us which points to actually rotate...
Nr = 0
FOR a = 0 TO NumberLines - 1
    F1 = Pointers1(a)   'get staring & ending point number
    S1 = Pointers2(a)
    IF Nr = 0 THEN      'if this is the first point then it of course
                        'has to be rotated
        r(Nr) = F1: Nr = Nr + 1
    ELSE
        Found = 0       'scan to see if this point already exists...
        FOR B = 0 TO Nr - 1
            IF r(B) = F1 THEN
                Found = -1: EXIT FOR    'shoot, it's already here!
            END IF
        NEXT
        IF NOT Found THEN r(Nr) = F1: Nr = Nr + 1   'point the point
                                                    'in the array it we
    END IF                                          'can't find it...
        
    Found = 0   'now look for the ending point
    FOR B = 0 TO Nr - 1
        IF r(B) = S1 THEN
            Found = -1: EXIT FOR
        END IF
    NEXT
    IF NOT Found THEN r(Nr) = S1: Nr = Nr + 1
NEXT
FOR a = 0 TO 63
    B(a) = (4 * a) \ 8
    b1(a) = a - B(a)
NEXT
PRINT "Press any key to begin..."
a$ = INPUT$(1)

Deg1 = 0: Deg2 = 0: d1 = 0: d2 = 0

Spos = -200: Mypos = 0

mx = 0: my = 0: Mz = 0: Ox = 0: Oy = 0: Oz = -260

NumberOfFrames = 0
DEF SEG = &H40
StartTime = PEEK(&H6C)

CALL scrninit

DO


    
    Deg1 = (Deg1 + d1) MOD 360
    Deg2 = (Deg2 + d2) MOD 360
    IF Deg1 < 0 THEN Deg1 = Deg1 + 360
    IF Deg2 < 0 THEN Deg2 = Deg2 + 360
   
    C1& = Cosine&(Deg1): S1& = Sine&(Deg1)
    C2& = Cosine&(Deg2): S2& = Sine&(Deg2)
    C3& = Cosine&(Deg3): S3& = Sine&(Deg3)
    'Deg3 = (Deg3 + 5) MOD 360
   
    x = Speed: y = 0: z = 0
 
    x1 = (x * C1&) \ 1024: y1 = (x * S1&) \ 1024
    x2 = (x1 * C2&) \ 1024: Zn = (x1 * S2&) \ 1024
   
    y3 = (y1 * C3& - Zn * S3&) \ 1024
    Z3 = (y1 * S3& + Zn * C3&) \ 1024
   
    Ox = Ox + x2: Oy = Oy + y3: Oz = Oz + Z3
    IF Oz > 32000 THEN Oz = 32000
    IF Oz < -32000 THEN Oz = -32000
    IF Ox > 32000 THEN Ox = 32000
    IF Ox < -32000 THEN Ox = -32000
    IF Oy > 32000 THEN Oy = 32000
    IF Oy < -32000 THEN Oy = -32000
   
    
    IF AtLoc THEN
        mx = mx + (Ox - mx) \ 4
        my = my + (Oy - my) \ 4
        Mz = Mz + ((Oz + 200) - Mz) \ 4
    ELSE
        'adjust the users position based on how much he is moving...
        Mz = Mz + Mzm: mx = mx + mxm: my = my + mym
        IF Mz > 32000 THEN Mz = 32000
        IF Mz < -32000 THEN Mz = -32000
        IF mx > 32000 THEN mx = 32000
        IF mx < -32000 THEN mx = -32000
        IF my > 32000 THEN my = 32000
        IF my < -32000 THEN my = -32000
    END IF
   
    'LOCATE 1, 1: PRINT A$
    
    maxz = -32768
    LowZ = 32767
    FOR a = 0 TO Nr - 1
        r = r(a)
        Xo = x(r): Yo = y(r): Zo = z(r)
        
        x1 = (Xo * C1& - Yo * S1&) \ 1024
        y1 = (Xo * S1& + Yo * C1&) \ 1024
       
        x2& = (x1 * C2& - Zo * S2&) \ 1024 - mx + Ox
        z2 = (x1 * S2& + Zo * C2&) \ 1024
        
        y3& = (y1 * C3& - z2 * S3&) \ 1024 - my + Oy
        Z4 = (y1 * S3& + z2 * C3&) \ 1024
        
        Z3 = Z4 - Mz + Oz
       

        Zn(r) = Z4
        IF Z4 > maxz THEN maxz = Z4
        IF Z4 < LowZ THEN LowZ = Z4
       
        'X2&,Y3&,Z3

        'if the point is too close(or behind) the viewer then
        'don't draw it...
        IF (Mypos - Z3) < 15 THEN
            Xn(r) = -1000: Yn(r) = 0: Zn = 0
        ELSE
            v = (1330& * (Spos - Z3)) \ (Mypos - Z3)
            Xn(r) = 160 + x2& + (-x2& * v) \ 1330
            Yn(r) = 100 + (8 * (y3& + (-y3& * v) \ 1330)) \ 10
        END IF
    NEXT
       
    maxz = maxz - LowZ
   
       
    Nl = 0
    FOR a = 0 TO NumberLines - 1
        F1 = Pointers1(a): S1 = Pointers2(a)
        IF Xn(F1) <> -1000 AND Xn(S1) <> -1000 THEN
            Sp(Nl) = a
            Zp(a) = (Zn(F1) + Zn(S1)) \ 2
            Nl = Nl + 1
        END IF
    NEXT
    Nl = Nl - 1
    'sort lines according to their Z coordinates
    IF Nl > -1 THEN
        Mid = Nl \ 2
        DO
            FOR a = 0 TO Nl - Mid
                IF Zp(Sp(a)) > Zp(Sp(a + Mid)) THEN
                    SWAP Sp(a), Sp(a + Mid)
                    CL = a - Mid
                    ch = a
                    DO WHILE CL >= 0
                        IF Zp(Sp(CL)) > Zp(Sp(ch)) THEN
                            SWAP Sp(CL), Sp(ch)
                            ch = CL
                            CL = CL - Mid
                        ELSE
                            EXIT DO
                        END IF
                    LOOP
                END IF
            NEXT
            Mid = Mid \ 2
        LOOP WHILE Mid > 0
    END IF
    'wait for vertical retrace
    WAIT &H3DA, 8
   
    ' erase old points
   
    FOR a = ln - 1 TO 0 STEP -1
        LINE (HorXn + Xs1(a), VerYn + Ys1(a))-(HorXn + Xe1(a), VerYn + Ye1(a)), 0
    NEXT
   
    ln = 0
    FOR A1 = 0 TO Nl
        a = Sp(A1)
       
        z = Zp(a)
        F1 = Pointers1(Sp(A1)): S1 = Pointers2(Sp(A1))
       
        Xn = Xn(F1): Yn = Yn(F1)
        
        IF Xn <> -1000 THEN
            x1 = Xn(S1)
            IF x1 <> -1000 THEN
                y1 = Yn(S1)
                z1 = (z - Mz + Oz)
                
                IF z1 > -1500 THEN
                    'calculate color
                    t = 63 - ((z1 * -63&) \ 1500)
                    IF maxz = 0 THEN maxz = 1
                   
                    c = Cc(a)
                    
                    'draw line
                    LINE (HorXn + x1, VerYn + y1)-(HorXn + Xn, VerYn + Yn), c
                    'store for later
                    Xs1(ln) = x1: Ys1(ln) = y1
                    Xe1(ln) = Xn: Ye1(ln) = Yn
                    ln = ln + 1
                END IF
            END IF
        END IF
    NEXT
   
               
         CALL MouseArw(mh1, mv1)

    CALL PlotGrid(joypres, GRH, GRV, plos, ploh, plov, lhp, lvp)
    '
    ' **********  Process Keystroke *********
    '
    llphr = LEN(phr$)
    k$ = UCASE$(INKEY$)

   
    IF k$ <> "" THEN
    lark = ASC(LEFT$(k$, 1))
    rark = ASC(RIGHT$(k$, 1))
    END IF
   
    LOCATE 1, 30: PRINT lark, rark
   
    'Process the keystroke(if any)...
   
        IF seei = 0 THEN
         LOCATE 1, 23: PRINT "<F12> help < "; na$; " >"
        END IF
           jb1 = STRIG(0)
           jb1 = STRIG(b1)
           jb2 = STRIG(b2)
           jb3 = STRIG(b3)
           jb4 = STRIG(b4)

            IF jb1 = -1 OR jb2 = -1 OR jb3 = -1 OR jb4 = -1 THEN
             joypres = 1
            END IF

    IF k$ <> "" THEN
   
    LOCATE 21, 1: PRINT jps$; joypres
    LOCATE 22, 1: PRINT " "; k$; ASC(LEFT$(k$, 1)), ASC(RIGHT$(k$, 1))
    IF mx > 400 THEN mx = 400
    IF mx < 0 THEN mx = 0
    IF my > 400 THEN my = 400
    IF my < 0 THEN my = 0
   
    SELECT CASE k$
           
            CASE IS = CHR$(0) + CHR$(79)
            d1 = 0: d2 = 0
            CASE IS = CHR$(0) + CHR$(73)

            CLS
            PRINT phr$
            SLEEP

            CASE IS = CHR$(0) + CHR$(133) ' joystick setup
            
            CALL setup(lhc, lvc, RHV, rvc, b1, b2, b3, b4)

            CASE IS = CHR$(0) + CHR$(60)
               seei = seei + 1
               IF seei >= 2 THEN seei = 0
               IF seei = 1 THEN CLS
           
            CASE IS = CHR$(0) + CHR$(61) '<F3>   
            CALL MoveplotA(ploh, plov)
                 GRH = ploh
                 GRV = plov
            
                       
            CASE IS = "J"
            joypres = 0
             jsp$ = "OFF>    "
            CASE IS = "P"
           
            CALL pause

            CASE "A"
                AtLoc = NOT AtLoc
            CASE "+"
                Mzm = Mzm + 2
            CASE "-"
                Mzm = Mzm - 2
            CASE "5"
                mxm = 0: mym = 0: Mzm = 0
                d1 = 0
                d2 = 0
                d3 = 0
                Deg1 = 0: Deg2 = 0
            CASE "4"
                mxm = mxm - 2
            CASE "6"
                mxm = mxm + 2
            CASE "8"
                mym = mym - 2
            CASE "2"
                mym = mym + 2
            CASE "F"
                Speed = Speed + 5
            CASE "B"
                Speed = Speed - 5
            CASE "C"
                d1 = 0: d2 = 0
            CASE "S"
                Speed = 0
       
        REM Arrow Keys!!! ******
            CASE CHR$(0) + CHR$(72)
                d1 = d1 + 1
            CASE CHR$(0) + CHR$(80)
                d1 = d1 - 1
            CASE CHR$(0) + CHR$(75)
                d2 = d2 - 1
            CASE CHR$(0) + CHR$(77)
                d2 = d2 + 1
        REM *********************
       
            CASE "Q", CHR$(27)
             CALL endprg
           
            CASE "V"
                d1 = 0: d2 = 0: Deg1 = 0: Deg2 = 0: Speed = 0
            CASE CHR$(0) + CHR$(59)
            CALL loadshape(phr$, sizesh, na$)
            CASE CHR$(0) + CHR$(134)
            SCREEN 2
            CALL help(lhc, lvc, rhc, rvc, b1, b2, b3, b4)
            CALL scrninit
       
            CASE IS = CHR$(0) + CHR$(68)


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

              FOR a = 0 TO (sizesh)
              xtt = points(a).x
              ytt = points(a).y
              ztt = points(a).z
              x1tt = points(a).x1
              y1tt = points(a).y1
              z1tt = points(a).z1
              ctt = Cc(a)
             
              PRINT xtt, ytt, ztt, x1tt, y1tt, z1tt, ctt
              NEXT


            
           
         REM ******* Incert fragment *********

            CASE IS = CHR$(0) + CHR$(82)
             CALL incrtpeice(frg$)
             phr$ = phr$ + frg$ + CHR$(13)
              plc = 0
              sizesh = 0
               ct = 0
            DO
            ct = ct + 1
            ch$ = MID$(phr$, ct, 1)
            IF ch$ = CHR$(13) THEN sizesh = sizesh + 1

            LOOP UNTIL ct >= LEN(phr$)
            GOTO 5
       
         REM draw keys
       
        CASE IS = "M" + CHR$(0) ' Right
         
          
        CASE IS = "K" + CHR$(0) ' Left
         
          
           
        CASE IS = "H" + CHR$(0) ' Up
         
          
           
        CASE IS = "P" + CHR$(0) ' Down
           
       
          
        CASE IS = CHR$(9)
         CALL LSUtil(phr$, sizesh, na$)
       
        END SELECT
   
        IF NDRc = 1 THEN
         CALL FRGDRAW(frg$, phr$)
          NDRc = 0
        END IF

        IF LEN(phr$) <> (llphr) THEN 5
        

   
    END IF
    NumberOfFrames = NumberOfFrames + 1
    'see if 20 frames have passed; if so then see
    'how long it took...
    IF NumberOfFrames = 20 THEN
        TotalTime = PEEK(&H6C) - StartTime
        IF TotalTime < 0 THEN TotalTime = TotalTime + 256
        FramesPerSecX100 = 36400 \ TotalTime
        High = FramesPerSecX100 \ 100
        Low = FramesPerSecX100 - High
        'A$ has the string that is printed at the upper left
        'corner of the screen
        a$ = MID$(STR$(High), 2) + "."
        a$ = a$ + RIGHT$("0" + MID$(STR$(Low), 2), 2) + "  "
        NumberOfFrames = 0
        StartTime = PEEK(&H6C)
    END IF
LOOP
'data is stored as Start X,Y,Z & End X,Y,Z

SUB drect


DO
FILES
INPUT "</> "; dr$
IF dr$ <> "/" THEN CHDIR dr$

LOOP UNTIL dr$ = "/"


END SUB

SUB endprg


                SCREEN 0, , 0, 0: WIDTH 80
                CLS
                PRINT "***************************"
                PRINT "* Ok i'm tired of this    *"
                PRINT "*   Time for a Beer       *"
                PRINT "*                         *"
                PRINT "***************************"
                END




END SUB

SUB FRGDRAW (frg$, phr$)
             phr$ = phr$ + frg$ + CHR$(13)
              plc = 0
              sizesh = 0
               ct = 0
            DO
            ct = ct + 1
            ch$ = MID$(phr$, ct, 1)
            IF ch$ = CHR$(13) THEN sizesh = sizesh + 1

            LOOP UNTIL ct >= LEN(phr$)

END SUB

SUB getpoint (phr$, plc, x, y, z, x1, y1, z1, c)

edn = LEN(phr$)
IF plc = 0 THEN plc = 1

st = plc


DO
st = st + ln
ln = 0

DO

ln = ln + 1

 IF (st + ln) <= (LEN(phr$)) THEN
 nn$ = MID$(phr$, st + ln, 1)
 END IF

PRINT nn$;
LOOP UNTIL nn$ = ";" OR plc >= (edn) OR ln >= LEN(phr$)


 
 nn$ = MID$(phr$, st, ln - 1)
 nn = VAL(nn$)
 

 SELECT CASE ct
 CASE 0
 x = nn
 CASE 1
 y = nn
 CASE 2
 z = nn
 CASE 3
 x1 = nn
 CASE 4
 y1 = nn
 CASE 5
 z1 = nn
 CASE 6
 c = nn
 END SELECT
 ln = ln + 1
 
 nn = 0
 nn$ = ""
 ct = ct + 1
 
LOOP UNTIL ct = 7 OR ln >= LEN(phr$)
  'PRINT
  'PRINT "X "; x; " Y "; y; " Z "; Z; "X1 "; x1; " Y1 "; y1; " Z1 "; Z1
 plc = st + ln

END SUB

SUB help (lhc, lvc, rhc, rvc, b1, b2, b3, b4)

bgg:
SCREEN 12
CLS

LOCATE 2, 2
PRINT "3-D Cad enhancement <ESC> to exit <I> for Intro"
PRINT "Keys to use: (Turn NUMLOCK on!)"
PRINT "Q...Quits"
PRINT "Numeric keypad..Controls your position(press 5 on the keypad"
PRINT "                to completly stop yourself) "
PRINT "-...Forward exceleration"
PRINT "+...Backward exceleration"
PRINT "Arrow keys...Controls the rotation of the craft"
PRINT "F...Excelerates the craft (Forward)"
PRINT "B...Slows the craft (Backward)"
PRINT "S...Stops the craft"
PRINT "A...Toggles Auto Center, use this when you lose";
PRINT " the craft"
PRINT "C...Stops the shape's rotation"
PRINT "V...Resets the shape to starting position"
PRINT "<5> will stop rotation and scrolling"
PRINT "<Insert> will help you add a line "
PRINT "<F11> will get the joystick setup"
PRINT "<TAB> will get the SAVE/LOAD menu"
DO

LOCATE 1, 1: PRINT DATE$ + " " + TIME$ + " >"

ke$ = INKEY$
IF ke$ = "I" THEN CALL intro(lhc, lvc, RHV, rvc, b1, b2, b3, b4): GOTO bgg

LOOP UNTIL ke$ = CHR$(27)
  CLS
END SUB

       '
      SUB HMMM
        IF joypres = 1 THEN
           jps$ = " Joy on"
         
           jx = STICK(0)
           jy = STICK(1)
           jxx = STICK(2)
           jyy = STICK(3)

         LOCATE 20, 1: PRINT jx, jy, jxx, jyy
       
         SELECT CASE fctj$
          CASE IS = "Nav"
            IF jx > (lhc + 20) THEN
            mxm = mxm + 2
            END IF
          
            IF jx < (lhc - 20) THEN
            mxm = mxm - 2
            END IF
  
            IF jy > (lvc + 20) THEN
            mym = mym + 2
            END IF
       
            IF jy < (lvc - 20) THEN
            mym = mym - 2
            END IF

            IF jb1 = -1 THEN k$ = "5"
       
            REM right joystick
           
             IF jxx > (rhc + 20) THEN
                 d1 = d1 - 2
             END IF
             IF jxx < (rhc - 20) THEN
                 d1 = d1 + 2
             END IF
           
             IF jyy > (rvc + 20) THEN
                 d2 = d2 - 2
             END IF
           
             IF jyy < (rvc - 20) THEN
                 d2 = d2 + 2
             END IF


              IF jxx > (rhc - 20) AND jxx < (rhc + 20) AND jyy > (rvc - 20) AND jyy < (rvc + 20) THEN
              d1 = 0: d2 = 0
              END IF

             IF jb3 = -1 THEN d1 = 0: d2 = 0

         END SELECT
      
      
        IF mxm < 0 THEN mxm = 2
        IF mxm > 255 THEN mxm = 255
        IF mym < 0 THEN mym = 0
        IF mym > 255 THEN mym = 255
        END IF
'
END SUB

SUB incertbox (na$, phr$, sizesh)

cr$ = CHR$(13)
INPUT "color"; c
INPUT " x plot "; xr
INPUT " y plot "; yr
INPUT " z plot "; zr




  dt$ = ""

  dt$ = dt$ + "; " + STR$(xr - 40) + " ;"
   dt$ = dt$ + STR$(yr) + " ;"
    dt$ = dt$ + STR$(zr) + " ;"

  dt$ = dt$ + STR$(xr + 40) + " ;"
   dt$ = dt$ + STR$(yr) + " ;"
    dt$ = dt$ + STR$(zr) + " ;"
      dt$ = dt$ + STR$(c) + " ;" + cr$

    


  dt$ = dt$ + STR$(xr - 40) + " ;"
   dt$ = dt$ + STR$(yr + 40) + " ;"
    dt$ = dt$ + STR$(zr) + " ;"

  dt$ = dt$ + STR$(xr + 40) + " ;"
   dt$ = dt$ + STR$(yr + 40) + " ;"
    dt$ = dt$ + STR$(zr) + " ;"
            dt$ = dt$ + STR$(c) + " ;" + cr$

    

       phr$ = phr$ + dt$
          c = 7
            PRINT phr$
       CALL getpoint(phr$, plc, x, y, z, x1, y1, z1, c)
END SUB

SUB incrtpeice (frg$)

GOTO strt
menu:
             LOCATE 10, 5: PRINT "****************************"
             LOCATE 11, 5: PRINT "*                          *"
             LOCATE 12, 5: PRINT "****************************"
DO

LOCATE 11, 11: PRINT " Press <I>"

ke$ = INKEY$
LOOP UNTIL ke$ = "I" OR ke$ = "i"

LOCATE 11, 11: PRINT "                 "
RETURN


strt:

 GOSUB menu
 
  LOCATE 11, 12
  INPUT " hor1 "; hor1
 GOSUB menu

  LOCATE 11, 12
  INPUT " Ver1 "; ver1
 GOSUB menu

  LOCATE 11, 12
  INPUT " Z1 "; z1
   
  LOCATE 11, 12
  PRINT " now to the end point"
  SLEEP

 GOSUB menu
 
  LOCATE 11, 12
  INPUT " hor2 "; hor2
 GOSUB menu

  LOCATE 11, 12
  INPUT " Ver2 "; ver2
 GOSUB menu

  LOCATE 11, 12
  INPUT " Z2 "; z2

  GOSUB menu
  LOCATE 11, 12
  INPUT "Color "; c


    frg$ = STR$(hor1) + " ;" + STR$(ver1) + " ;" + STR$(z1) + " ;" + STR$(hor2) + " ;" + STR$(ver2) + " ;" + STR$(z2) + " ;" + STR$(c) + " ;"

 
 
  LOCATE 14, 11
   PRINT frg$
   SLEEP

   CLS


END SUB

SUB intro (lhc, lvc, rhc, rvc, b1, b2, b3, b4)

BG:
SCREEN 12
CLS
LOCATE 5, 5
PRINT "A 3D ShapeMaker "
PRINT " Trs - 80 CoCo Forever !!!    "
PRINT " 3d routins extracted from 3dship.bas"
PRINT "  Program at < http:\\www.Qbasic.com >"
PRINT "   Cad and all added code written by Scott Gates"
PRINT "    E-mail < Gates_scott@hotmail.com >"
PRINT "     "
PRINT
PRINT " <S> for setup"
PRINT "  <ESC> to exit this screen"
PRINT " Todays date is - "; DATE$


   DO
   ke$ = INKEY$
   ke$ = UCASE$(ke$)
   IF ke$ = "M" THEN CALL message: GOTO BG
    IF ke$ = "S" THEN CALL setup(lhc, lvc, RHV, rvc, b1, b2, b3, b4): GOTO BG
   LOOP UNTIL ke$ = CHR$(27)
CLS
END SUB

SUB JoyRoutines (ljoyH, ljoyv, rjoyh, rjoyv)
 ' we read in the yoystick
  ' Values here
   ' yeah duh! i know
   '

 ljoyH = STICK(0)
  ljoyv = STICK(1)
   rjoyh = STICK(2)
    rjoyv = STICK(3)
  
 



END SUB

SUB loadshape (phr$, sizesh, na$)

ON ERROR GOTO 0
FILES
PRINT
sizesh = 0

dr$ = "c:\qbasic\caddata"
ON ERR GOTO er1:
CHDIR dr$
FILES


INPUT "name of shape to open"; na$
IF LEN(na$) >= 5 THEN
 ext$ = RIGHT$(na$, 4)
END IF
IF ext$ <> ".PCD" THEN
 na$ = na$ + ".PCD"
END IF

IF LEN(na$) >= 5 THEN
OPEN na$ FOR INPUT AS #1
DO

INPUT #1, PH$

phr$ = phr$ + PH$
'PRINT PH$
sizesh = sizesh + 1
LOOP UNTIL EOF(1)

CLOSE #1

PRINT
PRINT "done "
SLEEP
ELSE

PRINT "No name Given, thats ok well start you "
PRINT " with an Empty Board :)"
END IF

 SLEEP
CLS
EXIT SUB

er1:

SHELL "cd c:\qbasic"
SHELL "md caddata"
RETURN
END SUB

SUB LSUtil (phr$, sizesh, na$)
REM this is the load save utility
REM  a control program designed to help with cad
REM   data storage and retrival

DO
INPUT "<T>,<L>,<S>,<D> </> will exit "; ch$


IF ch$ = "D" THEN CALL drect
IF ch$ = "L" THEN CALL loadshape(phr$, sizesh, na$)
IF ch$ = "S" THEN CALL saveshape(phr$, sizesh, na$)
IF ch$ = "T" THEN CALL showT
IF ch$ = "M" THEN
     INPUT "name to add "; na$
    CALL mass(phr$, sizesh, na$)
END IF







LOOP UNTIL ch$ = "/"

 PRINT "Remember to update your cad <F10>"
 SLEEP

END SUB

SUB mass (phr$, sizesh, na$)
IF LEN(na$) >= 5 THEN
 ext$ = RIGHT$(na$, 4)
END IF
IF ext$ <> ".PCD" THEN
 na$ = na$ + ".PCD"
END IF

IF LEN(na$) >= 5 THEN
OPEN na$ FOR INPUT AS #1
DO

INPUT #1, PH$

phr$ = phr$ + PH$
PRINT PH$
sizesh = sizesh + 1
LOOP UNTIL EOF(1)

CLOSE #1

PRINT
PRINT "done "
SLEEP
ELSE

PRINT "No name Given, thats ok well start you "
PRINT " with an Empty Board :)"
END IF

 SLEEP
CLS

END SUB

SUB message
SCREEN 12
CLS
LOCATE 1, 5
PRINT "Hi , Scott Here,"
PRINT "  this program is ment to be [FreeWare] ok !!!"
PRINT " it is not to sold to anyone, it is leagle to have- "
PRINT "  it is leagle to distribute and make copies of. i dont"
PRINT "   care if you want to make alterations. just be sure to add"
PRINT "    in the intro that you have done this. and you take full credit "
PRINT "     for whatever changes you make. "
PRINT "this program is ment to be used in MS Qbasic.exe"
PRINT " If you want to Compile it i dont care. just be careful what you do"
PRINT "  i dont mind if you have questions. you can E-mail me i won't bite  "
PRINT " your head off like some people. Just be Sure to include what the Question is"
PRINT "  where in the Code it applies too. what you are trying to do or understand."
PRINT "   and finnaly if you have made an improvement and want to tell me. thats-"
PRINT " ok too. if i like what you have done i'll make that part of the next version."
PRINT "  try to use subs it cuts down on coding time."
PRINT "   Programming can be alot of fun and you Can make $$$ at it"
PRINT "    all i ask is that you share this Program and do not sell it to"
PRINT "     anyone. it is FreeWare!!!. "
PRINT " it is My Gift to all of you   "
PRINT ""
PRINT "                                    Scott"
PRINT ""
PRINT "P.S. if anyone wants to send me Free Beer, a Playstation2 or stereo equiptment"
PRINT " I have no Problem with that HA! :)"
PRINT ""
PRINT ""
PRINT "<ESC> to Go Back..."

  DO

  ke$ = INKEY$
  LOOP UNTIL ke$ = CHR$(27)
  CLS

END SUB

SUB MouseArw (mh1, mv1)

 CALL JoyRoutines(ljoyH, ljoyv, rjoyh, rjoyv)

    h = rjoyh * 2
    v = rjoyv * 2


    CIRCLE (h, v), 10, 7


    IF h <> (mh1) OR v <> (mv1) THEN

        CIRCLE (mh1, mv1), 10, 0

      mh1 = h
      mv1 = v
    END IF


END SUB

SUB MoveplotA (ploh, plov)

REDIM BOX%(30, 30)
    LOCATE 1, 1: PRINT ploh, plov
   GET (ploh, plov)-(ploh + 30, plov + 30), BOX%

   PH1 = ploh
   PV1 = plov
  ke$ = ""

DO

   LINE (ploh, plov + 15)-(ploh + 30, plov + 15), 7
    LINE (ploh + 15, plov)-(ploh + 15, plov + 30), 7


 SELECT CASE (ke$)
 
  CASE IS = "I", CHR$(0) + "H"
  plov = plov - 5
 
  CASE IS = "M", CHR$(0) + "P"
  plov = plov + 5
 
  CASE IS = "J", CHR$(0) + "K"
  ploh = ploh - 5

  CASE IS = "K", CHR$(0) + "M"
  ploh = ploh + 5

  END SELECT


  
    IF PH1 <> (ploh) OR PV1 <> (plov) THEN
     
      PUT (PH1, PV1), BOX%, PSET
       GET (ploh, plov)-(ploh + 30, plov + 30), BOX%

       PH1 = ploh
       PV1 = plov
   


        
    END IF





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

LOOP UNTIL ke$ = "X" OR ke$ = CHR$(13)
 CLS
END SUB

SUB pause

LOCATE 10, 10: PRINT "***************"
LOCATE 11, 10: PRINT "* PAUSED      *"
LOCATE 12, 10: PRINT "* hit <ENTER> *"
LOCATE 13, 10: PRINT "***************"


 DO

  ke$ = INKEY$
 LOOP UNTIL ke$ = CHR$(13)
  CLS
END SUB

SUB PlotGrid (joypres, GRH, GRV, plos, ploh, plov, lhp, lvp)
'
' Draws the Border for plot area
'
   LINE (GRH, GRV)-(GRH + plos, GRV + plos), 6, B
   LINE (GRH + 4, GRV + 4)-(GRH + (plos - 4), GRV + (plos - 4)), 4, B


      IF joypres = 1 THEN
        CALL JoyRoutines(ljoyH, ljoyv, rjoyh, rjoyv)
           
           h = GRH + ljoyH
           v = GRV + ljoyv
          LINE (h, v)-(h + 3, v + 3), 3, B
         
           IF h <> (lhp) OR v <> (lvp) THEN

             LINE (lhp, lvp)-(lhp + 3, lvp + 3), 0, B

            lhp = h
            lvp = v
           END IF

     
      END IF



END SUB

SUB saveshape (phr$, sizesh, na$)


INPUT "what do you want to call this project "; nw$

IF nw$ <> "" THEN na$ = nw$




st$ = RIGHT$(na$, 4)

 st$ = UCASE$(st$)
 IF st$ <> ".PCD" THEN

   na$ = na$ + ".PCD"
 END IF

OPEN "c:\qbasic\caddata\" + na$ FOR OUTPUT AS #1


PRINT #1, phr$
CLOSE #1

PRINT na$; " -Saved..."
    PRINT phr$

END SUB

SUB scrninit
            SCREEN 12
'FOR a = 0 TO 63
'    OUT &H3C7, a: OUT &H3C8, a: OUT &H3C9, a: OUT &H3C9, 0: OUT &H3C9, 0
'NEXT

END SUB

SUB setup (lhc, lvc, rhc, rvc, b1, b2, b3, b4)
'
' here we handle setting up the joysticks
'  or mouse if you write code for it !
'
mg = 1

CLS
SCREEN 12

DO

x = STICK(0)
y = STICK(1)
x2 = STICK(2)
y2 = STICK(3)


LOCATE 1, 1: PRINT "<ESC> to exit"
LOCATE 2, 1: PRINT x, y, x2, y2

LOCATE 18, 1: PRINT " use your joystick button to set the center pos"
LOCATE 19, 1: PRINT " this checks the joysticks for you"
LOCATE 20, 1: PRINT " if you can move the + and the O then your ok"

LOCATE 2, 75: PRINT "B0 "; STRIG(0)
LOCATE 3, 75: PRINT "B1 "; STRIG(1)
LOCATE 4, 75: PRINT "B2 "; STRIG(2)
LOCATE 5, 75: PRINT "B3 "; STRIG(3)
LOCATE 6, 75: PRINT "B4 "; STRIG(4)
LOCATE 7, 75: PRINT "B5 "; STRIG(5)
LOCATE 8, 75: PRINT "B6 "; STRIG(6)
LOCATE 9, 75: PRINT "B7 "; STRIG(7)

 LOCATE 25, 5: PRINT lhc; " "; lvc
 LOCATE 26, 5: PRINT rhc; " "; rvc

CIRCLE (x, y), 30, 3

IF x1 <> (x) OR y1 <> (y) THEN
CIRCLE (x1, y1), 30, 0
x1 = x
y1 = y
END IF

CIRCLE (x2 + 256, y2 + 50), 30, 3

IF x3 <> (x2) OR y3 <> (y2) THEN


CIRCLE (x3 + 256, y3 + 50), 30, 0
 

 x3 = x2
 y3 = y2

END IF



bb0 = STRIG(0)
bb1 = STRIG(1)
bb2 = STRIG(2)
bb3 = STRIG(3)
bb4 = STRIG(4)
bb5 = STRIG(5)
bb6 = STRIG(6)
bb7 = STRIG(7)


IF bb0 = 0 AND bb1 = 0 AND bb2 = 0 AND bb3 = 0 AND bb4 = 0 AND bb5 = 0 AND bb6 = 0 AND bb7 = 0 THEN
 bpp = 0
END IF


IF bpp = 0 THEN

IF bb0 = -1 THEN poolb = 0: bp = 1: bpp = 1
IF bb1 = -1 THEN poolb = 1: bp = 1: bpp = 1
IF bb2 = -1 THEN poolb = 2: bp = 1: bpp = 1
IF bb3 = -1 THEN poolb = 3: bp = 1: bpp = 1
IF bb4 = -1 THEN poolb = 4: bp = 1: bpp = 1
IF bb5 = -1 THEN poolb = 5: bp = 1: bpp = 1
IF bb6 = -1 THEN poolb = 6: bp = 1: bpp = 1
IF bb7 = -1 THEN poolb = 7: bp = 1: bpp = 1

END IF



SELECT CASE mg
 CASE IS = 1
   msg$ = "Ceneter left joystick and hit <Enter>"
   IF ke$ = CHR$(13) THEN
    lhc = x
    lvc = y
    mg = 2
   END IF
 CASE IS = 2
   msg$ = "Center right joystick and Hit <Enter>"
   IF ke$ = CHR$(13) THEN
    rhc = x2
    rvc = y2
    mg = 3
   END IF
  
 CASE IS = 3
  msg$ = "Press button (1) on Left joystick"
  IF bp = 1 THEN
   b1 = poolb
   mg = 4
   bp = 0
  END IF
 CASE IS = 4
 msg$ = "Ppress button (2) on Left joystick"
  IF bp = 1 THEN
   b2 = poolb
   mg = 5
   bp = 0
  END IF
 CASE IS = 5
  msg$ = "Press button (1) on Right joystick"
  IF bp = 1 THEN
   b3 = poolb
   mg = 6
   bp = 0
  END IF
 CASE IS = 6
  msg$ = "Press button (2) on Right joystick"
  IF bp = 1 THEN
  b4 = poolb
  mg = 7
  bp = 0
  END IF
  CASE IS = 7
  msg$ = "   Your Done here !!!!   "


END SELECT
   
LOCATE 16, 1: PRINT msg$' current message to user
LOCATE 21, 1: PRINT "Buttons "; b1; " "; b2; " "; b3; " "; b4



ke$ = INKEY$
LOOP UNTIL ke$ = CHR$(27)

CLS
END SUB

SUB showT



END SUB

