RogCAD home
Calculator kernel
Curve generator
Screen capture
RogCAD code complete
All the math and code was developed by RogCAD (Roger Luebeck).
The code was originally written in GW-BASIC. It was re-coded
in QuickBASIC, then VisualBASIC.
The QuickBASIC version with 72 modules was then
modified for use as a single module in QB64.
This page contains only the RogCAD_QB64 code.
VS coding is next (2023-2024) for long-term
compatibilty with MS OS.
Calculator kernel
Vector cross-product is used to create a floating image plane
with a normal vector that passes through the origin of the xyz axes.
(The focal point can be shifted away from the origin in any manner
by the CAD user.)
Vector dot-product is used to test from which side of the z-axis
each projected point stems.
RogCAD's point-pair system allows the calculator kernel to
clip lines (thus planes) which land behind the floating
image plane, thus enabling surface-rendering even when the
perspective point is moved inside an object.
The CAD user moves around a stationary object by moving the image plane.
the code:
For LN = FL(GB) To LL(GB)
1045 inc = 299
1050 If DT = 1 Then DT = 0: G = SP(LN): GoTo 1090
G = FP(LN): DT = 1
1070:
If ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) >
((L * L) + (M * M) + (N * N)) Then GoTo 3070
If DT = 1 Then GoTo 1100
1090:
If ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) >
((L * L) + (M * M) + (N * N)) Then GoTo 3120
1100:
W = ((A * A) + (B * B) + (C * C) -
(A * X(G)) - (B * Y(G)) - (C * Z(G)))
[ W is then the denominator in the
following three equations. ]
R(G) = (((A * I) * (A - X(G))) + (B * B * X(G)) + (C * C * X(G))
- (B * X(G) * Y(G)) - (C * X(G) * Z(G)) + ((B * J)
* (A - X(G))) + ((C * K) * (A - X(G))) - ((B * Y(G))
* (A - X(G))) - ((C * Z(G)) * (A - X(G)))) / W
S(G) = (((B * J) * (B - Y(G))) + (A * A * Y(G)) + (C * C * Y(G))
- (A * Y(G) * X(G)) - (C * Y(G) * Z(G)) + ((A * I)
* (B - Y(G))) + ((C * K) * (B - Y(G))) - ((A * X(G))
* (B - Y(G))) - ((C * Z(G)) * (B - Y(G)))) / W
T(G) = (((C * K) * (C - Z(G))) + (A * A * Z(G)) + (B * B * Z(G))
- (A * Z(G) * X(G)) - (B * Z(G) * Y(G)) + ((A * I)
* (C - Z(G))) + ((B * J) * (C - Z(G))) - ((A * X(G))
* (C - Z(G))) - ((B * Y(G)) * (C - X(G)))) / W
[ R(G), S(G) and T(G) are then inserted into
the following two equations. ]
U(G) = (((R(G) - L) ^ 2) + ((S(G) - M) ^ 2) +
((T(G) - N) ^ 2)) ^ 0.5
V(G) = (((R(G) - L) * (R(8001) - L)) +
((S(G) - M) * (S(8001) - M))
+ ((T(G) - N) * (T(8001) - N))) /
(U(G) * ((((R(8001) - L) ^ 2)
+ ((S(8001) - M) ^ 2) + ((T(8001) - N) ^ 2)) ^ 0.5))
[ U(G) and V(G) are then inserted into
the following equation. ]
XX(G) = U(G) * V(G)
If V(G) > 0.9999 Or V(G) < -0.9999 Then YY(G) = 0: GoTo 1200
YY(G) = U(G) * ((1 - ((V(G)) ^ 2)) ^ 0.5)
If ((L * S(G)) - (M * R(G))) < 0 Then YY(G) = (-1 * YY(G))
1200:
If CHK = 0 Then CHK = 1: GoTo 950
'If AP = 1 Then CHAIN "ENHANCE.MOD"
IF DT = 1 THEN X(G) = XR(G) - TX: Y(G) = YR(G) - TY
Z(G) = ZR(G) - TZ: GOTO 1050
END IF
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
1250:
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 430 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 430 - VSH
If ICHK = 1 Then GoTo 1280
'If SS2$ = "Hide" Then READSWITCH = 1
'If SS2$ = "Show" Then READSWITCH = 2: S3 = 1
If READSWITCH = 1 Then GoTo 1290
1280:
viewport.Line (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN))),
RGB(redd(cdex), green(cdex), blue(cdex))
1290 Next LN
3070 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX:
Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999:
GOTO 1290
X(G) = ((INC / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GOTO 1070
3120 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX:
Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999:
GOTO 1290
X(G) = ((INC / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GOTO 1090
-----------------------------------------------------------------------------------------
end of calculator kernel / wireframe image projection
-----------------------------------------------------------------------------------------
Curve generator
(uses sine function to make repeatable, deformable arcs):
CXBAS :
GOSUB WIPEVALUES
RL = 1: CIRC = 0: COUNT = 0
ON ERROR GOTO CXoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB CXoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
READATA = 3
GOTO MAIN
CXoREADDATA:
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K10
DO WHILE TIPE$ <> "DARKESTCOLOR:"
INPUT #2, TIPE$
LOOP
INPUT #2, DRKCOL
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA,
YENDDATA, ZBEGINDATA, ZENDDATA
DO WHILE TIPE$ <> "CURVDATA:"
INPUT #2, TIPE$
LOOP
FOR RD = 1 TO 400 'up to 400 sections in accordance with DIM statements
INPUT #2, CURVPOINTS(RD)
INPUT #2, DEGB(RD), ARCB(RD), RADZB(RD), RADYB(RD)
INPUT #2, XB(RD), YB(RD), ZB(RD), LB(RD), INCB(RD), STREB(RD)
INPUT #2, DEGT(RD), ARCT(RD), RADZT(RD), RADYT(RD)
INPUT #2, XT(RD), YT(RD), ZT(RD), LT(RD), INCT(RD), STRET(RD)
IF CURVPOINTS(RD) = 999 THEN EXIT FOR
CURVEFINE(RD) = (CURVPOINTS(RD)) * .5
CURVINC(RD) = CURVEFINE(RD) - 1
PTPAIRS(RD) = CURVEFINE(RD) * 2
NP6 = NP6 + PTPAIRS(RD)
COUNT = COUNT + 1
NEXT RD
'points
FOR RD = 1 TO COUNT
'bottom
DEG1 = DEGB(RD): DEG2 = DEG1 + ARCB(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LB(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
Z(CIRC) = (RADZB(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + ZB(RD)
Y(CIRC) = (RADYB(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + YB(RD)
IF INCB(RD) = 0 THEN X(CIRC) = XB(RD): GOTO CXo10
XDEG = XDEG - INCB(RD)
XRAD = STREB(RD) * (COS((XDEG * 3.14159) / 180))
X(CIRC) = (-1 * (XRAD)) + XB(RD)
CXo10:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
'top
DEG1 = DEGT(RD): DEG2 = DEG1 + ARCT(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LT(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
Z(CIRC) = (RADZT(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + ZT(RD)
Y(CIRC) = (RADYT(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + YT(RD)
IF INCT(RD) = 0 THEN X(CIRC) = XT(RD): GOTO CXo20
XDEG = XDEG - INCT(RD)
XRAD = STRET(RD) * (COS((XDEG * 3.14159) / 180))
X(CIRC) = (-1 * (XRAD)) + XT(RD)
CXo20:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
NEXT RD
'connect points
FOR RD = 1 TO COUNT
IF RD = 1 THEN CP = 1: GOTO C30
RPREVIOUS = RD - 1
CP = CP + PTPAIRS(RPREVIOUS)
C30:
FOR CNT = 1 TO CURVEFINE(RD)
FP(RL) = CP: SP(RL) = CP + CURVEFINE(RD): RL = RL + 1: CP = CP + 1
NEXT CNT
CP = CP - CURVEFINE(RD)
FOR CNT = 1 TO CURVINC(RD)
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
NEXT CNT
CP = CP + 1
FOR CNT = 1 TO CURVINC(RD)
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
NEXT CNT
CP = (CP - PTPAIRS(RD)) + 1
NEXT RD
'planes
FOR RD = 1 TO COUNT
IF RD = 1 THEN PP = 1: RPL = 1: GOTO C40
RPREVIOUS = RD - 1
PP = PP + CURVEFINE(RPREVIOUS): RPL = RPL + CURVEFINE(RPREVIOUS)
C40:
FOR CNT = 1 TO CURVINC(RD)
B1(RPL) = PP: T1(RPL) = PP + 1
B2(RPL) = PP + CURVEFINE(RD): T2(RPL) = PP + CURVEFINE(RD) + 1
RPL = RPL + 1: PP = PP + 1
NEXT CNT
PP = PP + 1: RPL = RPL + 1
NEXT RD
RL = RL - 2
NL10 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9)
RETURN
CXoERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 3
GOTO MAIN
end of curves generator
----------------------------------------------------------------------------
Screen capture and screen set:
(Compresses file by recording only color
changes from one pixel to the next,
rather than the color of each pixel.)
scrncapture:
COLOR 255
LOCATE 120, 172
INPUT "file"; cap$
TYPE scrncap
R AS INTEGER
colvall AS INTEGER
repeatt AS INTEGER
END TYPE
DIM capture AS scrncap
OPEN "DATA\" + cap$ + ".cap" FOR RANDOM AS #2 LEN = 6
R = 1
FOR COL = 1 TO 1360
colval = 0: curval = 0: repeat = 0: preval = 0
inc = inc + 1
IF inc = 9 THEN
column = column + 1
inc = 0
LOCATE 27, column
PRINT "I"
END IF
FOR row = 1 TO 1019
repeat = repeat + 1
colval = POINT(COL, row)
IF row = 1 THEN
repeat = 0
curval = colval
preval = colval
GOTO SKIP
END IF
IF row = 1019 AND colval = curval THEN GOTO PUTIT
IF colval = curval THEN GOTO SKIP
PUTIT: curval = colval
capture.colvall = preval
capture.repeatt = repeat
PUT #2, R, capture
IF row = 1019 THEN
R = R + 1
capture.colvall = colval
capture.repeatt = 1
PUT #2, R, capture
END IF
preval = colval: repeat = 0
R = R + 1
SKIP: NEXT row
NEXT COL
column = 0
CLOSE #2
GOTO ENHANCE
scrnset:
COLOR 255
LOCATE 120, 172
INPUT "file"; cap$
TYPE scrnset
R AS INTEGER
colvall AS INTEGER
repeatt AS INTEGER
END TYPE
DIM setit AS scrnset
OPEN "DATA\" + cap$ + ".cap" FOR RANDOM AS #2 LEN = 6
R = 0
FOR COL = 1 TO 1360
CHANGE: reptot = 1
NEWREC: R = R + 1
GET #2, R, setit
colval = setit.colvall
rep = setit.repeatt
endrep = (reptot + rep) - 1
FOR row = reptot TO endrep
PSET (COL, row), colval
NEXT row
reptot = reptot + rep
IF reptot = 1020 THEN GOTO NCOL
GOTO NEWREC
NCOL: NEXT COL
CLOSE #2
----------------------------------------------------------------
RogCAD code, complete:
One brief detour:
RogCAD_Windows declarations section
-----------------------------------
Only the variables accessed by the entire program are listed here.
They are declared "public" due to that scope. Other variables
are limited in scope to the subroutines in which they appear.
Public FP(20000), SP(20000), FL(255), LL(255)
Public XR(10001), YR(10001), ZR(10001)
Public XX(10001), YY(10001)
Public RR(10001)
Public X(10001), Y(10001), Z(10001)
Public TEMX(10001), TEMY(10001), TEMZ(10001)
Public R(10001), S(10001), T(10001)
Public U(10001), V(10001)
Public GX(10001), GY(10001)
Public PN1(10001), PN2(10001), PN3(10001), PN4(10001)
Public T1(10001), T2(10001), B1(10001), B2(10001)
Public DIS(10001), ORD(10001), AUTOFRM1(10001), AUTOFRM2(10001)
Public DIS1(10001), DIS2(10001), DIS3(10001), DIS4(10001)
Public DIR(10001), TDIR(10001)
Public ROTT(10001), ROTAT(10001), COLAC(10001), COLR(10001)
Public ROOT, COOLAC
Public zfa, zfb, zfc, zfx, zfy, zfz, zfm, zfv, zfh
Public zza, zzb, zzc, zzx, zzy, zzz, zzm, zzv, zzh
Public xfa, xfb, xfc, xfx, xfy, xfz, xfm, xfv, xfh
Public xza, xzb, xzc, xzx, xzy, xzz, xzm, xzv, xzh
Public yfa, yfb, yfc, yfx, yfy, yfz, yfm, yfv, yfh
Public yza, yzb, yzc, yzx, yzy, yzz, yzm, yzv, yzh
Public p1a, p1b, p1c, p1x, p1y, p1z, p1m, p1v, p1h
Public p2a, p2b, p2c, p2x, p2y, p2z, p2m, p2v, p2h
Public p3a, p3b, p3c, p3x, p3y, p3z, p3m, p3v, p3h
Public p4a, p4b, p4c, p4x, p4y, p4z, p4m, p4v, p4h
Public p5a, p5b, p5c, p5x, p5y, p5z, p5m, p5v, p5h
Public p6a, p6b, p6c, p6x, p6y, p6z, p6m, p6v, p6h
Public ICHK, RA, RB, RC, RIT
Public KLR(), MA, GB
Public RES, QRES, ACHK, CV, G, DM, BACK
Public MM, MAG, MAD, A, B, C, L, M, N, I, J, K
Public TX, TY, TZ, VSH, HSH, CHK, AA, BB, CC
Public K1, K2, K3, K4, K5, K6, K7, K8, K9, K10
Public NP1, NP2, NP3, NP4, NP5, NP6, NP7, NP8, NP9
Public NL1, NL2, NL3, NL4, NL5, NL6, NL7, NL8, NL9, NL10
Public RT, CN, MN, SHIF, DRW, IFRM
Public R1, R2, R3, R4, REC
Public D, E, F, H, O, Q, FX(), FY(), FZ()
Public AP, PAST, A1, ASWITCH, GSWITCH, READSWITCH
Public S1, S2, S3, S4, S5, S6, S7, S8, S9, S10
Public PLA, READATA, LINP1, LINP2
Public QPLN, RED(), GRN(), BLU()
Public SS1$, SS2$, SS3$, SS4$, SS5$, SS6$
Public MMM$, GRPSWI, GG$, TT$, GS
Public groupname$, grpname$(200), grptype$(200), gtype$
Public titem$(30), iitem$(100), totalitems
Public RRRRA, RRRRB, RRRRC, PAL$
Public redval$, greenval$, blueval$
Public INCR, INCG, INCV
Public LEFTC, RIGHTC
Public pinc, finc, minc, PSW, iinc, VVA, VVB, VVC
Public FCH, INF, sinc, jump, PICSWITCH
Public VB1, VB2, VT1, VT2, vrepeat, VCOL, VEECOLOR
Public LIGHTT, DARKK, PNM
Public vfcolor, vauto, vplane, PL, capcolor$, cap$
Public reddback, greenback, blueback
Public CVP1(100), CVP2(100)
Public CNR(2001), CVCOL(256), CPNM(100)
Public CVT1(100), CVT2(100), CVB1(100), CVB2(100)
Public CURVINC(400), CURVEFINE(400), CURVPOINTS(400)
Public FIN(400), PTPAIRS(400)
Public DEGB(400), ARCB(400), RADXB(400), RADYB(400), RADZB(400)
Public XB(400), YB(400), ZB(400), LB(400), INCB(400), STREB(400)
Public DEGT(400), ARCT(400), RADXT(400), RADYT(400), RADZT(400)
Public XT(400), YT(400), ZT(400), LT(400), INCT(400), STRET(400)
Public vsplane(1000), veplane(100), vplaneinc(100)
Public vscolor(256), vcolorinc(256)
Public grouptype$, grname$(50), fullname$(50)
Public smerror, NUM, gname$
Public MACROSWITCH, mgrp, rp, rm, rch, rf
Public gcol, TYP$, GRNAM$, rcroutine$
Public rdata, rl, howmany, vnum(), CNUM8()
Public rcdelineator$, numberoffiles, numfile
Public NUM8, rml, delineator$
Public maval$, macs, macp, MNUM, MNUM8
Public XANGLE, YANGLE, ZANGLE, xang, yang, zang
Public FDIS1(10001), FDIS2(10001), FDIS3(10001)
Public FDIS4(10001), FDIS(10001)
Public NDIS1(10001), NDIS2(10001), NDIS3(10001)
Public NDIS4(10001), NDIS(10001)
Public DRKCOL
Public P1, P2
Public ORT, CP, RPL, PP, RPREVIOUS, rcount
Public X1, X6, Y1, Y6, Z1, Z6, P
Public P3, P4, P5, P6, P7, P8, rlin
Public AC
'---------------------------------------
' test variables (keep)
Public dummy1, testtext$, testval
Public temp, rtemp, gtemp, btemp, arrow$
Public redd(256), green(256), blue(256)
Public cdex, coldex, rowdex, repeat
Public curcol$, inc, inclist
' end test variables
'---------------------------------------
--------- end RogCAD_Windows section --------------
--------- begin RogCAD_QB64 -----------------------
_TITLE "RogCAD DOS c-code version"
SCREEN _NEWIMAGE(1620, 1022, 13)
' modules data readers
' ------- ------------
'
' ROGCAD-MOD AX-BAS
' MAIN-MOD AY-BAS
' ARROWS-MOD AZ-BAS
' ENHANCE-MOD
' PLANE-MOD CX-BAS
' FRAME-MOD CY-BAS
' ROUTINES-MOD CZ-BAS
' COLOR-MOD
' MX-BAS
' H1-MOD MY-BAS
' H2-MOD MZ-BAS
' H3-MOD
' H-MOD X8-BAS
' Y8-BAS
' P1-MOD Z8-BAS
' P2-MOD
' P3-MOD S-BAS
' P-MOD
'
' MP1-MOD
' CP1-MOD
' SP1-MOD
'
' MACRO-A-MOD
' MACRO-G-MOD
'
' TRANSFORM-MOD
'
' VIEW SCREEN main menu
'
' SUBROUTINES
'
'
'
'=========================================================
'
' ROGCAD-MOD
'
'=========================================================
STARTPROGRAM:
KEY OFF
CLEAR
PALETTE
DIM RED(256): DIM GRN(256): DIM BLU(256): DIM PAL(256): DIM P(256)
DM = 10001: MOV = 10001: PLA = 10001: CRD = 400
DIM FP(20000): DIM SP(20000): DIM XR(DM): DIM YR(DM): DIM ZR(DM): DIM XX(DM)
DIM YY(DM): DIM RR(DM): DIM X(DM): DIM Y(DM): DIM FL(15): DIM LL(15)
DIM GY(DM): DIM GX(DM): DIM Z(DM): DIM R(DM): DIM S(DM)
DIM T(DM): DIM U(DM): DIM V(DM): DIM TEMX(DM): DIM TEMY(DM): DIM TEMZ(DM)
DIM PN1(PLA): DIM PN2(PLA): DIM PN3(PLA): DIM PN4(PLA)
DIM T1(PLA): DIM T2(PLA): DIM B1(PLA): DIM B2(PLA)
DIM PL1(MOV): DIM PL2(MOV): DIM PL3(MOV): DIM PL4(MOV): DIM PN(MOV)
DIM FT1(MOV): DIM FT2(MOV): DIM FB1(MOV): DIM FB2(MOV): DIM SNUM(MOV)
DIM CT1(MOV): DIM CT2(MOV): DIM CB1(MOV): DIM CB2(MOV): DIM CNUM(MOV)
DIM LP1(MOV): DIM LP2(MOV)
DIM PCOL(MOV): DIM FCOL(MOV): DIM LCOL(MOV): DIM CCOL(MOV)
DIM AMN(MOV): DIM GRP(MOV)
DIM DIS1(PLA): DIM DIS2(PLA): DIM DIS3(PLA): DIM DIS4(PLA): DIM DIS(PLA)
DIM ORD(PLA): DIM AUTOFRM1(8000): DIM AUTOFRM2(8000)
DIM DIR(PLA): DIM TDIR(PLA): DIM ROT(PLA): DIM ROTAT(PLA)
DIM COLAC(800): DIM COLR(PLA)
DIM FIN(CRD)
DIM DEGB(CRD): DIM ARCB(CRD): DIM RADXB(CRD): DIM RADYB(CRD)
DIM XB(CRD): DIM YB(CRD): DIM ZB(CRD): DIM LB(CRD): DIM INCB(CRD): DIM STREB(CRD)
DIM DEGT(CRD): DIM ARCT(CRD): DIM RADXT(CRD): DIM RADYT(CRD)
DIM XT(CRD): DIM YT(CRD): DIM ZT(CRD): DIM LT(CRD): DIM INCT(CRD): DIM STRET(CRD)
DIM CURVINC(CRD): DIM CURVEFINE(CRD): DIM PTPAIRS(CRD): DIM CURVPOINTS(CRD)
DIM vsplane(400)
DIM veplane(400)
DIM vplaneinc(400)
DIM vscolor(260)
DIM vcolorinc(260)
DIM CVP1(400)
DIM CVP2(400)
DIM CNR(200)
DIM CVCOL(260)
DIM CPNM(400)
DIM CVT1(400)
DIM CVT2(400)
DIM CVB1(400)
DIM CVB2(400)
DIM NDIS1(PLA): DIM NDIS2(PLA): DIM NDIS3(PLA): DIM NDIS4(PLA): DIM NDIS(PLA)
DIM FDIS1(PLA): DIM FDIS2(PLA): DIM FDIS3(PLA): DIM FDIS4(PLA): DIM FDIS(PLA)
OPEN "data\start256.txt" FOR INPUT AS #2
GOSUB SUBQUICKCHANGE
DO WHILE TIPE$ <> "DEFAULTVIEW:"
INPUT #2, TIPE$
LOOP
INPUT #2, A, B, C, TX, TY, TZ, MM, VSH, HSH
DO WHILE TIPE$ <> "DEFAULTPAL:"
INPUT #2, TIPE$
LOOP
INPUT #2, PAL$
'cls background color:
DO WHILE TIPE$ <> "BACKGROUNDCOLOR:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACKGROUND
'fill color is specified in data files
GOSUB ROGCADoREADDATA
GOSUB ROGCADoWIRECOLORS
'PAL(1) = 4144959
TYPE UHUHER
R AS INTEGER
BL AS INTEGER
GR AS INTEGER
RE AS INTEGER
COD AS SINGLE
END TYPE
DIM UHUHS AS UHUHER
OPEN "data\" + PAL$ + ".pal" FOR RANDOM AS #2 LEN = 12
FOR R = 1 TO 255
GET #2, R, UHUHS
BLU(R) = UHUHS.BL
GRN(R) = UHUHS.GR
RED(R) = UHUHS.RE
DUMB = UHUHS.COD
PAL(R) = (65536 * BLU(R)) + (256 * GRN(R)) + RED(R)
PALETTE R, PAL(R)
NEXT R
CLOSE #2
FOR RP = 1 TO 255: PALETTE RP, PAL(RP): NEXT RP
PALETTE 0, 1315860
AUTO = 0: NAR = 0
S3$ = "AUTOMA"
READATA = 1: ' STD modules must have READATA = 1
GOTO MAIN
'------------------------------------------------
ROGCADoREADDATA :
'POINTS:
RESTORE ROGCADoSTANDARD
FOR RW = 1 TO 4000: READ X(RW), Y(RW), Z(RW)
XR(RW) = X(RW): YR(RW) = Y(RW): ZR(RW) = Z(RW)
IF X(RW) = 999 AND Y(RW) = 999 AND Z(RW) = 999 THEN
NP1 = RW - 1
GOTO ROGCADoLG1
END IF
NEXT RW
'LINES:
ROGCADoLG1 :
RESTORE ROGCADoLINEG1
FOR RL = 1 TO 20000
READ FP(RL), SP(RL)
IF FP(RL) = 999 AND SP(RL) = 999 THEN
NL1 = RL - 1
GOTO ROGCADoLG2
END IF
NEXT RL
ROGCADoLG2 :
RESTORE ROGCADoLINEG2
FOR RL = (NL1 + 1) TO 20000
READ FP(RL), SP(RL)
IF FP(RL) = 999 AND SP(RL) = 999 THEN
NL2 = RL - 1 - NL1
GOTO ROGCADoLG3
END IF
NEXT RL
ROGCADoLG3 :
RESTORE ROGCADoLINEG3
FOR RL = (NL1 + NL2 + 1) TO 20000
READ FP(RL), SP(RL)
IF FP(RL) = 999 AND SP(RL) = 999 THEN
NL3 = RL - 1 - NL1 - NL2
GOTO ROGCADoLG4
END IF
NEXT RL
ROGCADoLG4 :
RESTORE ROGCADoLINEG4
FOR RL = (NL1 + NL2 + NL3 + 1) TO 20000
READ FP(RL), SP(RL)
IF FP(RL) = 999 AND SP(RL) = 999 THEN
NL4 = RL - 1 - NL1 - NL2 - NL3
GOTO ROGCADoLG5
END IF
NEXT RL
ROGCADoLG5 :
RESTORE ROGCADoLINEG5
FOR RL = (NL1 + NL2 + NL3 + NL4 + 1) TO 20000
READ FP(RL), SP(RL)
IF FP(RL) = 999 AND SP(RL) = 999 THEN
NL5 = RL - 1 - NL1 - NL2 - NL3 - NL4
GOTO ROGCADoJKREAD
END IF
NEXT RL
ROGCADoJKREAD :
RESTORE ROGCADoAUTOPLANE : REM 800 MAX (1 - 800)
FOR RPL = 1 TO 8000
READ T1(RPL), B1(RPL), T2(RPL), B2(RPL), COLR(RPL), DIR(RPL)
IF T1(RPL) = 999 AND B1(RPL) = 999 AND T2(RPL) = 999
AND B2(RPL) = 999 AND COLR(RPL) = 0 AND DIR(RPL) = 0
THEN GOTO ROGCADoFRAMINGREAD1
NEXT RPL
ROGCADoFRAMINGREAD1 :
RESTORE ROGCADoAUTOFRAMING1 :
REM Reads plane number and number of framing lines
FOR AF = 1 TO 8000
READ PL, NFL
IF PL = 999 AND NFL = 999 THEN GOTO ROGCADoFRAMINGREAD2
AUTOFRM1(PL) = NFL
NEXT AF
ROGCADoFRAMINGREAD2 :
RESTORE ROGCADoAUTOFRAMING2 :
REM Reads plane number and number of framing lines
FOR AF = 1 TO 8000
READ PL, NFL
IF PL = 999 AND NFL = 999 THEN GOTO ROGCADoBLOCKS
AUTOFRM2(PL) = NFL
NEXT AF
ROGCADoBLOCKS :
'P is first pt number.
'RL is first line number.
'RPL is first pl number.
RESTORE ROGCADoBLOCK401
P = 4001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 4001
FOR AC = 400 TO 599
BLOK = 1: GOTO ROGCADoB100
ROGCADoB10 :
IF X1 = 999 AND Y1 = 999 AND Z1 = 999 AND X6 = 999 AND Y6 = 999
AND Z6 = 999 AND ROT(AC) = 0 AND COLAC(AC) = 0 THEN GOTO ROGCADoB11
NEXT AC
ROGCADoB11 :
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5)
NP3 = P - 4000
RESTORE ROGCADoBLOCK601
P = 6001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 6001
FOR AC = 600 TO 799
BLOK = 2: GOTO ROGCADoB100
ROGCADoB20 :
IF X1 = 999 AND Y1 = 999 AND Z1 = 999 AND X6 = 999 AND Y6 = 999
AND Z6 = 999 AND ROT(AC) = 0 AND COLAC(AC) = 0 THEN GOTO ROGCADoB21
NEXT AC
ROGCADoB21 :
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL7 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP4 = P - 6000
RETURN: '(from gosub readdata)
ROGCADoB100 :
READ X1, Y1, Z1, X6, Y6, Z6, ROT(AC), COLAC(AC)
IF X1 = 999 AND Y1 = 999 AND Z1 = 999 AND X6 = 999 AND Y6 = 999
AND Z6 = 999 AND ROT(AC) = 0 AND COLAC(AC) = 0 THEN GOTO ROGCADoB150
DX = X6 - X1: DY = Y6 - Y1: DZ = Z6 - Z1
X(P) = X1: Y(P) = Y1: Z(P) = Z1: P1 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1: Y(P) = Y1: Z(P) = Z1 + DZ: P2 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1: Y(P) = Y1 + DY: Z(P) = Z1: P3 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1: Y(P) = Y1 + DY: Z(P) = Z1 + DZ: P4 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1 + DX: Y(P) = Y1 + DY: Z(P) = Z1: P5 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X6: Y(P) = Y6: Z(P) = Z6: P6 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1 + DX: Y(P) = Y1: Z(P) = Z1: P7 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1 + DX: Y(P) = Y1: Z(P) = Z1 + DZ: P8 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = 0: Y(P) = 0: Z(P) = 0: P = P + 1
X(P) = 0: Y(P) = 0: Z(P) = 0: P = P + 1
FP(RL) = P1: SP(RL) = P2: RL = RL + 1
FP(RL) = P3: SP(RL) = P4: RL = RL + 1
FP(RL) = P5: SP(RL) = P6: RL = RL + 1
FP(RL) = P7: SP(RL) = P8: RL = RL + 1
FP(RL) = P1: SP(RL) = P3: RL = RL + 1
FP(RL) = P3: SP(RL) = P5: RL = RL + 1
FP(RL) = P5: SP(RL) = P7: RL = RL + 1
FP(RL) = P7: SP(RL) = P1: RL = RL + 1
FP(RL) = P2: SP(RL) = P4: RL = RL + 1
FP(RL) = P4: SP(RL) = P6: RL = RL + 1
FP(RL) = P6: SP(RL) = P8: RL = RL + 1
FP(RL) = P8: SP(RL) = P2: RL = RL + 1
T1(RPL) = P1: B1(RPL) = P2: T2(RPL) = P3: B2(RPL) = P4
DIR(RPL) = 1: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P3: B1(RPL) = P4: T2(RPL) = P5: B2(RPL) = P6
DIR(RPL) = 2: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P5: B1(RPL) = P6: T2(RPL) = P7: B2(RPL) = P8
DIR(RPL) = 3: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P7: B1(RPL) = P8: T2(RPL) = P1: B2(RPL) = P2
DIR(RPL) = 4: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P1: B1(RPL) = P3: T2(RPL) = P7: B2(RPL) = P5
DIR(RPL) = 5: COLR(RPL) = COLAC(AC): RPL = RPL + 1
T1(RPL) = P2: B1(RPL) = P4: T2(RPL) = P8: B2(RPL) = P6
DIR(RPL) = 6: COLR(RPL) = COLAC(AC): RPL = RPL + 5
ROGCADoB150 :
IF BLOK = 1 THEN GOTO ROGCADoB10
IF BLOK = 2 THEN GOTO ROGCADoB20
'---editing area starts here
ROGCADoWIRECOLORS :
BACK = 255
K1 = 251
K2 = 5
K3 = 3
K4 = 11
K5 = 12
K6 = 13
K7 = 14
K8 = 15
RETURN
'AUTOCUBES
ROGCADoBLOCK401 :
'Points 4001 - 5998
DATA 999,999,999, 999,999,999, 0,0
ROGCADoBLOCK601 :
'Points 6001 - 7998
DATA 999,999,999, 999,999,999, 0,0
ROGCADoSTANDARD :
'Points 1 - 4000
'Use line labels starting at 1.
'x and arrow
1 DATA 0,0,0
2 DATA 66,0,0
3 DATA 58,-4,0
4 DATA 58,4,0
5 DATA 70,-4,0
6 DATA 70,4,0
7 DATA 78,-4,0
8 DATA 78,4,0
'y and arrow
9 DATA 0,64,0
10 DATA 4,58,0
11 DATA -4,58,0
12 DATA 6,74,0
13 DATA 0,74,0
14 DATA -6,70,0
15 DATA -6,78,0
16 DATA 0,0,0
DATA 999,999,999
ROGCADoLINEG1 : 'color K1
'x and y and arrows
DATA 1,2, 2,3, 2,4, 5,8, 6,7
DATA 9,16, 9,10, 9,11, 12,13, 13,14, 13,15
DATA 999,999
ROGCADoLINEG2 :
DATA 999,999
ROGCADoLINEG3 :
DATA 999,999
ROGCADoLINEG4 :
DATA 999,999
ROGCADoLINEG5 :
DATA 999,999
ROGCADoAUTOPLANE :
' Enter points for planes consistent with cross-hatch
' function to enable k-plane and j-plane functions.
' Maximum of 4000 plane entries, since autocube planes
' begin at 4001.
' Use code line labels starting at 7001.
' The "7" is just a convention. Plane numbers are
' the digits to the right of digit 7.
'-----------------------------------------------
' T1, B1, T2, B2, direction, base color
ROGCADo7001 :
DATA 999,999,999,999, 0,0
ROGCADoAUTOFRAMING1 :
' plane number, number of framing lines
DATA 999,999
ROGCADoAUTOFRAMING2 :
' plane number, number of framing lines
DATA 999,999
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' MAIN-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
MAIN :
FOR RP = 1 TO 255: PALETTE RP, PAL(RP)
NEXT RP
PALETTE 0, 1315860
LOCATE 60, 172: PRINT " "'Enhance menu
LOCATE 62, 172: PRINT " "
LOCATE 64, 172: PRINT " "
LOCATE 66, 172: PRINT " "
LOCATE 68, 172: PRINT " "
LOCATE 70, 172: PRINT " "
LOCATE 72, 172: PRINT " "
LOCATE 74, 172: PRINT " "
LOCATE 76, 172: PRINT " "
LOCATE 78, 172: PRINT " "
LOCATE 80, 172: PRINT " "
LOCATE 82, 172: PRINT " "
LOCATE 84, 172: PRINT " "
LOCATE 86, 172: PRINT " "
LOCATE 88, 172: PRINT " "
LOCATE 90, 172: PRINT " "
LOCATE 92, 172: PRINT " "'Enhance input
LOCATE 94, 172: PRINT " "
LOCATE 96, 172: PRINT " "
LOCATE 98, 172: PRINT " "
LOCATE 100, 172: PRINT " "'M menu
LOCATE 101, 172: PRINT " "
LOCATE 102, 172: PRINT " "
LOCATE 103, 172: PRINT " "
LOCATE 104, 172: PRINT " "
LOCATE 105, 172: PRINT " "
LOCATE 106, 172: PRINT " "'Main input
LOCATE 107, 172: PRINT " "
LOCATE 108, 172: PRINT " "
LOCATE 109, 172: PRINT " "
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
LOCATE 112, 172: PRINT " "
LOCATE 113, 172: PRINT " "
LOCATE 114, 172: PRINT " "
LOCATE 115, 172: PRINT " "
LOCATE 116, 172: PRINT " "
LOCATE 117, 172: PRINT " "
LOCATE 118, 172: PRINT " "
LOCATE 119, 172: PRINT " "
LOCATE 120, 172: PRINT " "
LOCATE 121, 172: PRINT " "
LOCATE 122, 172: PRINT " "
IF S7 = 1 THEN S7 = 0: GOTO MAINo1320
IF S4 = 1 THEN S4 = 0: GOTO MAINo1330
IF READSWITCH = 1 OR READSWITCH = 2 THEN GOTO MAINo50
IF AP = 0 AND ICHK = 0 THEN PALETTE 0, 1315860: COLOR 255: CLS
PALETTE 0, 1315860
MAINo50 :
IF AP = 1 THEN GOTO MAINo1100
IF ICHK = 1 THEN GOTO MAINo870
MAINo550 :
FL(1) = 1
LL(1) = NL1
FL(2) = NL1 + 1
LL(2) = NL1 + NL2
FL(3) = NL1 + NL2 + 1
LL(3) = NL1 + NL2 + NL3
FL(4) = NL1 + NL2 + NL3 + 1
LL(4) = NL1 + NL2 + NL3 + NL4
FL(5) = NL1 + NL2 + NL3 + NL4 + 1
LL(5) = NL1 + NL2 + NL3 + NL4 + NL5
FL(6) = NL1 + NL2 + NL3 + NL4 + NL5 + 1
LL(6) = NL1 + NL2 + NL3 + NL4 + NL5 + NL6
FL(7) = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
LL(7) = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7
FL(8) = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
LL(8) = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8
FL(9) = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + 1
LL(9) = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9
FL(10) = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9 + 1
LL(10) = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9 + NL10 + 1
IF READSWITCH = 1 OR READSWITCH = 2 THEN
A = RA: B = RB: C = RC
CHK = 0
GOTO MAINo690
END IF
MAINo570 :
CHK = 0
PALETTE 0, 1315860
MAINo600 : ' arbitrary A,B,C values auto-adjusted to
' prevent division by zero as CAD user shifts
' perspective and focal point.
IF S3$ = "AUTOMA" THEN
IF TX = A AND TY = B THEN A = A * .997
IF TX = A AND TZ = C THEN A = A * .998
IF TY = B AND TZ = C THEN B = B * .999
IF TY = 0 THEN TY = .0001
IF TX = 0 THEN TX = .0001
IF TZ = 0 THEN TZ = .0001
IF A = 0 THEN A = .1
IF B = 0 THEN B = .1
IF C = 0 THEN C = .1
IF A / B = TX / TY THEN A = A * .997
IF A / C = TX / TZ THEN A = A * .998
IF B / C = TY / TZ THEN B = B * .999
RA = A: RB = B: RC = C
S3$ = "PROMPT": GOTO MAINo685
END IF
IF FCV = 0 THEN GOTO MAINo680
LOCATE 111, 172: INPUT "view number "; VN$
LOCATE 111, 172: PRINT " "
IF VN$ = "ZF" or VN$ = "zf" THEN GOTO MAINo605
IF VN$ = "ZZ" or VN$ = "zz" THEN GOTO MAINo610
IF VN$ = "XF" or VN$ = "xf" THEN GOTO MAINo615
IF VN$ = "XZ" or VN$ = "xz" THEN GOTO MAINo620
IF VN$ = "YF" or VN$ = "yf" THEN GOTO MAINo625
IF VN$ = "YZ" or VN$ = "yz" THEN GOTO MAINo630
IF VN$ = "1" THEN GOTO MAINo635
IF VN$ = "2" THEN GOTO MAINo640
IF VN$ = "3" THEN GOTO MAINo645
IF VN$ = "4" THEN GOTO MAINo650
IF VN$ = "5" THEN GOTO MAINo655
IF VN$ = "6" THEN GOTO MAINo660
FCV = 0: GOTO MAINo680
MAINo605:
LOCATE 2, 5: PRINT " "
A = zfa + zfx: B = zfb + zfy: C = zfc + zfz
TX = zfx: TY = zfy: TZ = zfz: MM = zfm
VSH = zfv: HSH = zfh
GOTO MAINo681
MAINo610:
A = zza + zzx: B = zzb + zzy: C = zzc + zzz
TX = zzx: TY = zzy: TZ = zzz: MM = zzm
VSH = zzv: HSH = zzh
GOTO MAINo681
MAINo615:
A = xfa + xfx: B = xfb + xfy: C = xfc + xfz
TX = xfx: TY = xfy: TZ = xfz: MM = xfm
VSH = xfv: HSH = xfh
GOTO MAINo681
MAINo620:
A = xza + xzx: B = xzb + xzy: C = xzc + xzz
TX = xzx: TY = xzy: TZ = xzz: MM = xzm
VSH = xzv: HSH = xzh
GOTO MAINo681
MAINo625:
A = yfa + yfx: B = yfb + yfy: C = yfc + yfz
TX = yfx: TY = yfy: TZ = yfz: MM = yfm
VSH = yfv: HSH = yfh
GOTO MAINo681
MAINo630:
A = yza + yzx: B = yzb + yzy: C = yzc + yzz
TX = yzx: TY = yzy: TZ = yzz: MM = yzm
VSH = yzv: HSH = yzh
GOTO MAINo681
MAINo635:
A = p1a + p1x: B = p1b + p1y: C = p1c + p1z
TX = p1x: TY = p1y: TZ = p1z: MM = p1m
VSH = p1v: HSH = p1h
GOTO MAINo681
MAINo640:
A = p2a + p2x: B = p2b + p2y: C = p2c + p2z
TX = p2x: TY = p2y: TZ = p2z: MM = p2m
VSH = p2v: HSH = p2h
GOTO MAINo681
MAINo645:
A = p3a + p3x: B = p3b + p3y: C = p3c + p3z
TX = p3x: TY = p3y: TZ = p3z: MM = p3m
VSH = p3v: HSH = p3h
GOTO MAINo681
MAINo650:
A = p4a + p4x: B = p4b + p4y: C = p4c + p4z
TX = p4x: TY = p4y: TZ = p4z: MM = p4m
VSH = p4v: HSH = p4h
GOTO MAINo681
MAINo655:
A = p5a + p5x: B = p5b + p5y: C = p5c + p5z
TX = p5x: TY = p5y: TZ = p5z: MM = p5m
VSH = p5v: HSH = p5h
GOTO MAINo681
MAINo660:
A = p6a + p6x: B = p6b + p6y: C = p6c + p6z
TX = p6x: TY = p6y: TZ = p6z: MM = p6m
VSH = p6v: HSH = p6h
GOTO MAINo681
MAINo680:
LOCATE 108, 172: PRINT "PERSPECTIVE POINT"
LOCATE 110, 172: INPUT "X "; A
LOCATE 111, 172: INPUT "Y "; B
LOCATE 112, 172: INPUT "Z "; C
LOCATE 114, 172: PRINT "FOCAL POINT"
LOCATE 116, 172: INPUT "X "; TX
LOCATE 117, 172: INPUT "Y "; TY
LOCATE 118, 172: INPUT "Z "; TZ
MAINo681:
IF TX = A AND TY = B THEN A = A * .997
IF TX = A AND TZ = C THEN A = A * .998
IF TY = B AND TZ = C THEN B = B * .999
IF TY = 0 THEN TY = .0001
IF TX = 0 THEN TX = .0001
IF TZ = 0 THEN TZ = .0001
IF A = 0 THEN A = .1
IF B = 0 THEN B = .1
IF C = 0 THEN C = .1
IF A / B = TX / TY THEN A = A * .997
IF A / C = TX / TZ THEN A = A * .998
IF B / C = TY / TZ THEN B = B * .999
RA = A: RB = B: RC = C
IF FCV = 1 THEN GOTO MAINo685
LOCATE 120, 172: INPUT "MAGNIFICATION"; MM
LOCATE 108, 172: PRINT " "
LOCATE 109, 172: PRINT " "
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
LOCATE 112, 172: PRINT " "
LOCATE 113, 172: PRINT " "
LOCATE 114, 172: PRINT " "
LOCATE 115, 172: PRINT " "
LOCATE 116, 172: PRINT " "
LOCATE 117, 172: PRINT " "
LOCATE 118, 172: PRINT " "
LOCATE 119, 172: PRINT " "
LOCATE 120, 172: PRINT " "
MAINo685 :
MM = 10 * MM: MAG = MM
MAINo690 : ' (keep this BELIEVE IT january 6 2023)
MAINoB690 : RRA = A: RRB = B: RRC = C
IF S1 = 0 THEN
A = A - TX: B = B - TY: C = C - TZ
S1 = 1: RA = A: RB = B: RC = C
RRA = A: RRB = B: RRC = C
END IF
IF READATA = 1 THEN GOTO MAINo691 'keep this. rogcad.bas has readata = 1
IF READATA = 2 THEN GOTO MAINo692
IF READATA = 3 THEN GOTO MAINo693
MAINo691 :
FOR RR = 1 TO NP1
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 4001 TO 4000 + NP3
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 6001 TO 6000 + NP4
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
GOTO MAINo700
MAINo692 :
FOR RR = 1 TO NP1
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 2001 TO 2000 + NP2
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 4001 TO 4000 + NP3
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 6001 TO 6000 + NP4
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
GOTO MAINo700
MAINo693 :
FOR RR = 1 TO NP6
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
MAINo700 : X(10001) = 0: Y(10001) = 0: Z(10001) = 1
GOTO MAINo880
MAINo870 :
FOR RR = 8001 TO (2 * (LL(GB)) - 8000)
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
IF ICHK = 1 THEN GOTO MAINo1040
MAINo880 : ' I,J,K values are arbitrary.
' 94/94/95 has a nice ring to it.
I = .94 * A
J = .94 * B
K = .95 * C
L = A * ((A * I) + (B * J) + (C * K)) / ((A * A) + (B * B) + (C * C))
M = B * ((A * I) + (B * J) + (C * K)) / ((A * A) + (B * B) + (C * C))
N = C * ((A * I) + (B * J) + (C * K)) / ((A * A) + (B * B) + (C * C))
MAINo900 :
'------------------ begin calculator --------------------------------
IF CHK = 0 THEN G = 10001: GOTO MAINo1100
MAINo950 :
VIEW SCREEN (0, 0)-(1360, 1020)
IF READSWITCH = 0 THEN CLS : VIEW SCREEN (0, 0)-(1360, 1020), BACK
'------------------ begin calculator main loop ---------
FOR GB = 1 TO 10
IF GB = 1 AND NL1 = 0 THEN GOTO MAINo1310
IF GB = 2 AND NL2 = 0 THEN GOTO MAINo1310
IF GB = 3 AND NL3 = 0 THEN GOTO MAINo1310
IF GB = 4 AND NL4 = 0 THEN GOTO MAINo1310
IF GB = 5 AND NL5 = 0 THEN GOTO MAINo1310
IF GB = 6 AND NL6 = 0 THEN GOTO MAINo1310
IF GB = 7 AND NL7 = 0 THEN GOTO MAINo1310
IF GB = 8 AND NL8 = 0 THEN GOTO MAINo1310
IF GB = 9 AND NL9 = 0 THEN GOTO MAINo1310
IF GB = 10 AND NL10 = 0 THEN GOTO MAINo1310
IF GB = 1 THEN COLOR K1: GOTO MAINo1040
IF GB = 2 THEN COLOR K2: GOTO MAINo1040
IF GB = 3 THEN COLOR K3: GOTO MAINo1040
IF GB = 4 THEN COLOR K4: GOTO MAINo1040
IF GB = 5 THEN COLOR K5: GOTO MAINo1040
IF GB = 6 THEN COLOR K6: GOTO MAINo1040
IF GB = 7 THEN COLOR K7: GOTO MAINo1040
IF GB = 8 THEN COLOR K8: GOTO MAINo1040
IF GB = 9 THEN COLOR K9: GOTO MAINo1040
IF GB = 10 THEN COLOR K10: GOTO MAINo1040
MAINo1040 : '------ begin calculator kernel ---------------
FOR LN = FL(GB) TO LL(GB)
MAINo1045 :
INC = 299
MAINo1050 :
IF DT = 1 THEN DT = 0: G = SP(LN): GOTO MAINo1090
G = FP(LN): DT = 1
MAINo1070 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO MAINo3070
IF DT = 1 THEN GOTO MAINo1100
MAINo1090 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO MAINo3120
MAINo1100 :
GOSUB CALCSUB
MAINo1200 :
IF CHK = 0 THEN CHK = 1: GOTO MAINo950
IF AP = 1 THEN GOTO ENHANCE
IF DT = 1 THEN X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ:
GOTO MAINo1050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
MAINo1250 :
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 510 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 510 - VSH
IF ICHK = 1 THEN GOTO MAINo1280
IF S2$ = "Hide" THEN READSWITCH = 1
IF S2$ = "Show" THEN READSWITCH = 2: S3 = 1
IF READSWITCH = 1 THEN GOTO MAINo1290
MAINo1280 :
LINE (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN)))
MAINo1290 : NEXT LN
'------------ end calculator kernel ---------------
IF ICHK = 1 THEN ICHK = 0: GOTO ENHANCE
MAINo1310 : NEXT GB
'------------ end calculator main loop ---------------
IF GS = 2 THEN READSWITCH = 0: GOTO MAINo1320
IF READSWITCH = 1 OR S3 = 1 THEN READSWITCH = 0: S3 = 0: GOTO ENHANCE
IF READSWITCH = 2 THEN READSWITCH = 0: GOTO MAINo1320
'------------ end calculator ----------------------------------------
'------------ main menu ---------------------------------------------
MAINo1320 :
PSW = 0
AA = RA + TX: BB = RB + TY: CC = RC + TZ
MA = MM * .1: MAD = MA
'------------------------------------------------------------
SOLA = 0 'SA standard groups
SOLAINC = 0
COLA = 0 'CA curve groups
COLAINC = 0
MPOLA = 0 'MPA mxyz groups
MPOLAINC = 0
'------------------------------------------------------------
MAINo1330 :
COLOR 255
LOCATE 123, 172
PRINT "P "; AA; " "; BB; " "; CC
LOCATE 124, 172
PRINT "F "; TX; " "; TY; " "; TZ
LOCATE 125, 172
PRINT "M "; MA
MAINo1370 :
LOCATE 90, 172
COLOR 255
PRINT "Main menu "
LOCATE 96, 172
PRINT "fc: xf xz yf yz zf zz "
LOCATE 98, 172
PRINT "1 2 3 4 5 6"
LOCATE 102, 172
PRINT "SA MPA CA"
LOCATE 104, 172
PRINT "A CV SH GP G EN QT"
LOCATE 106, 172: INPUT ; M$
LOCATE 106, 172: PRINT " "
IF M$ = "CLS" OR M$ = "cls" THEN
CLS
VIEW SCREEN (0, 0)-(1360, 1020), BACKGROUND 'start256.txt
GOTO MAINo1320
END IF
IF M$ = "FILL" OR M$ = "fill" THEN
CLS
VIEW SCREEN (0, 0)-(1360, 1020), BACK 'data files
GOTO MAINo1320
END IF
IF M$ = "FC" OR M$ = "fc" THEN S1 = 0: FCV = 1: GOTO MAINo2000
IF M$ = "CV" OR M$ = "cv" THEN S1 = 0: GOTO MAINo2000
IF M$ = "SH" OR M$ = "sh" THEN GOTO MAINo1500
IF M$ = "EN" OR M$ = "en" THEN GOTO ENHANCE
IF M$ = "QT" OR M$ = "qt" THEN END
IF M$ = "GP" OR M$ = "gp" THEN GPMENU = 1: GOTO ROUTINES
'IF M$ = "CH" OR M$ = "ch" THEN H = 1: GOTO COLORMOD
IF M$ = "A" OR M$ = "a" THEN
SOLA = 0
SOLAINC = 0
COLA = 0
COLAINC = 0
MPOLA = 0
MPOLAINC = 0
GOTO ARROWS
END IF
IF M$ = "SA" OR M$ = "sa" THEN
SOLA = 1
SOLAINC = 0
COLA = 0
COLAINC = 0
MPOLA = 0
MPOLAINC = 0
GOTO ARROWS
END IF
IF M$ = "CA" OR M$ = "ca" THEN
SOLA = 0
SOLAINC = 0
COLA = 1
COLAINC = 0
MPOLA = 0
MPOLAINC = 0
GOTO ARROWS
END IF
IF M$ = "MPA" OR M$ = "mpa" THEN
SOLA = 0
SOLAINC = 0
COLA = 0
COLAINC = 0
MPOLA = 1
MPOLAINC = 0
GOTO ARROWS
END IF
IF M$ = "G" OR M$ = "g" THEN
MAINoGRPSWI:
LOCATE 106, 172: PRINT " "
LOCATE 106, 172: INPUT "Data type "; T$
IF T$ = "S" OR T$ = "s" THEN GOTO MAINo1400
IF T$ = "CX" OR T$ = "CY" OR T$ = "CZ" THEN GOTO MAINo1400
IF T$ = "MX" OR T$ = "MY" OR T$ = "MZ" THEN GOTO MAINo1400
IF T$ = "AX" OR T$ = "AY" OR T$ = "AZ" THEN GOTO MAINo1400
IF T$ = "X8" OR T$ = "Y8" OR T$ = "Z8" THEN GOTO MAINo1400
IF T$ = "cx" OR T$ = "cy" OR T$ = "cz" THEN GOTO MAINo1400
IF T$ = "mx" OR T$ = "my" OR T$ = "mz" THEN GOTO MAINo1400
IF T$ = "ax" OR T$ = "ay" OR T$ = "az" THEN GOTO MAINo1400
IF T$ = "x8" OR T$ = "y8" OR T$ = "z8" THEN GOTO MAINo1400
IF T$ = "E" OR T$ = "e" THEN
LOCATE 106, 172
PRINT " "
GOTO MAINo1330
END IF
GOTO MAINoGRPSWI
'-----------
MAINo1400 :
LOCATE 108, 172: INPUT "number "; G$
LOCATE 108, 172: PRINT " "
IF T$ = "E" OR T$ = "e" THEN
GOTO MAINo1330
END IF
READSWITCH = 2
IF T$ = "S" THEN GOTO SBAS
IF T$ = "CX" THEN GOTO CXBAS
IF T$ = "CY" THEN GOTO CYBAS
IF T$ = "CZ" THEN GOTO CZBAS
IF T$ = "AX" THEN GOTO AXBAS
IF T$ = "AY" THEN GOTO AYBAS
IF T$ = "AZ" THEN GOTO AZBAS
IF T$ = "mx" THEN GOTO MXBAS
IF T$ = "my" THEN GOTO MYBAS
IF T$ = "mz" THEN GOTO MZBAS
IF T$ = "s" THEN GOTO SBAS
IF T$ = "cx" THEN GOTO CXBAS
IF T$ = "cy" THEN GOTO CYBAS
IF T$ = "cz" THEN GOTO CZBAS
IF T$ = "ax" THEN GOTO AXBAS
IF T$ = "ay" THEN GOTO AYBAS
IF T$ = "az" THEN GOTO AZBAS
IF T$ = "MX" THEN GOTO MXBAS
IF T$ = "MY" THEN GOTO MYBAS
IF T$ = "MZ" THEN GOTO MZBAS
IF T$ = "x8" THEN GOTO X8BAS
IF T$ = "y8" THEN GOTO Y8BAS
IF T$ = "z8" THEN GOTO Z8BAS
IF T$ = "X8" THEN GOTO X8BAS
IF T$ = "Y8" THEN GOTO Y8BAS
IF T$ = "Z8" THEN GOTO Z8BAS
END IF
GOTO MAINo1370
'------------------ end main menu -----------------------
MAINo1500 :
LOCATE 111, 172: INPUT " VERTICAL"; VS
LOCATE 113, 172: INPUT "HORIZONTAL"; HS
LOCATE 111, 172: PRINT " "
LOCATE 113, 172: PRINT " "
VSH = VSH + VS: HSH = HSH + HS
CLS : GOTO MAINo950
'--------------------------------------------------------
MAINo2000 :
IF READATA = 1 THEN GOTO MAINo2011
IF READATA = 2 THEN GOTO MAINo2012
IF READATA = 3 THEN GOTO MAINo2013
MAINo2011 :
FOR RR = 1 TO NP1
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
FOR RR = 4001 TO (NP3 + 4000)
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
FOR RR = 6001 TO (NP4 + 6000)
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
GOTO MAINo2090
MAINo2012 :
FOR RR = 1 TO NP1
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
FOR RR = 2001 TO (NP2 + 2000)
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
FOR RR = 4001 TO (NP3 + 4000)
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
FOR RR = 6001 TO (NP4 + 6000)
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
GOTO MAINo2090
MAINo2013 :
FOR RR = 1 TO NP6
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
'--------------------------------------------------------
MAINo2090 :
GOTO MAINo570
MAINo3070 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX:
Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999:
GOTO MAINo1290
X(G) = ((INC / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GOTO MAINo1070
MAINo3120 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX:
Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999:
GOTO MAINo1290
X(G) = ((INC / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GOTO MAINo1090
'=========================================================
'=========================================================
'=========================================================
'=========================================================
' S-BAS
'=========================================================
'=========================================================
'=========================================================
'=========================================================
SBAS :
's-data mod only -------
READATA = 2
GOSUB WIPEVALUES
ON ERROR GOTO SoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB SoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
GOTO MAIN
'---------------------------------------------
SoREADDATA :
Do While TIPE$ <> "LIGHTDARK:"
Input #2, TIPE$
Loop
Input #2, LIGHT, DARKK
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K1, K2, K3, K4, K5, K6, K7, K8
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
GOSUB STANDARDPOINTSLINES
SoAUTOCUBE:
'==============================================
DO WHILE TIPE$ <> "AUTOCUBE200:"
INPUT #2, TIPE$
LOOP
P = 2001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 2001
FOR AC = 200 TO 399
BLOK = 1: GOTO SoB100
SoB10:
IF DUMMY% = 999 THEN EXIT FOR
NEXT AC
SoB11:
'==============================================
DO WHILE TIPE$ <> "AUTOCUBE400:"
INPUT #2, TIPE$
LOOP
'---------------------------------------
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5)
NP2 = P - 2000
'---------------------------------------
P = 4001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 4001
FOR AC = 400 TO 599
BLOK = 2: GOTO SoB100
SoB20:
IF DUMMY% = 999 THEN EXIT FOR
NEXT AC
SoB21:
'==============================================
DO WHILE TIPE$ <> "AUTOCUBE600:"
INPUT #2, TIPE$
LOOP
'------------------------------------------------
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL7 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP3 = P - 4000
'------------------------------------------------
P = 6001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
RPL = 6001
FOR AC = 600 TO 799
BLOK = 3: GOTO SoB100
SoB30:
IF DUMMY% = 999 THEN EXIT FOR
NEXT AC
SoB31:
'==============================================
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL8 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7)
NP4 = P - 6000
GOTO SoJKREAD
SoB100 :
INPUT #2, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROT(AC), COLAC(AC)
IF DUMMY% = 999 THEN GOTO SoB150
GOSUB B101ASSIGNMENTS
GOSUB T1B1T2B2
SoB150:
IF BLOK = 1 THEN GOTO SoB10
IF BLOK = 2 THEN GOTO SoB20
IF BLOK = 3 THEN GOTO SoB30
SoJKREAD :
DO WHILE TIPE$ <> "AUTOPLANE:"
INPUT #2, TIPE$
LOOP
FOR RPL = 1 TO 8000
INPUT #2, DUMMY%, T1(RPL), B1(RPL), T2(RPL), B2(RPL), DIR(RPL), COLR(RPL)
IF DUMMY% = 999 THEN EXIT FOR
NEXT RPL
GOSUB FRAMINGSTMXYZ
RETURN
'----------------------------------------------------------
SoERR1 :
GOSUB ERRORCODES
CLOSE #2
READATA = 2
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
' AX-BAS
'=========================================================
'=========================================================
'=========================================================
'=========================================================
AXBAS :
READATA = 2
GOSUB WIPEVALUES
ON ERROR GOTO AXoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB AXoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
GOTO MAIN
'------------------------------
AXoREADDATA:
Do While TIPE$ <> "LIGHTDARK:"
Input #2, TIPE$
Loop
Input #2, LIGHT, DARKK
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K6, K7, K8, K9
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
AXoBLOCKS:
' P is first point number.
' RL is first line number.
' RPL is first plane number.
DO WHILE TIPE$ <> "AUTOCUBE000:"
INPUT #2, TIPE$
LOOP
P = 1: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 1
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
FOR AC = 0 TO ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 1: GOTO AXoB101
AXoB10:
IF AC = STOPREAD THEN GOTO AXoB11
NEXT AC
AXoB11:
DO WHILE TIPE$ <> "AUTOCUBE200:"
INPUT #2, TIPE$
LOOP
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5)
NP1 = P
P = 2001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 2001
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
FOR AC = 200 TO ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 2: GOTO AXoB101
AXoB20:
IF AC = STOPREAD THEN GOTO AXoB21
NEXT AC
AXoB21:
DO WHILE TIPE$ <> "AUTOCUBE400:"
INPUT #2, TIPE$
LOOP
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL7 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP2 = P - 2000
P = 4001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
RPL = 4001
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
FOR AC = 400 TO ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 3: GOTO AXoB101
AXoB30:
IF AC = STOPREAD THEN GOTO AXoB31
NEXT AC
AXoB31:
DO WHILE TIPE$ <> "AUTOCUBE600:"
INPUT #2, TIPE$
LOOP
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL8 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7)
NP3 = P - 4000
P = 6001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + 1
RPL = 6001
FOR AC = 600 TO 799: REM cube numbers. (600-799)
BLOK = 4: GOTO AXoB100
AXoB40:
IF DUMMY% = 999 THEN EXIT FOR
NEXT AC
AXoB41:
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL9 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8)
NP4 = P - 6000
GOTO AXoFRAMINGREAD1
AXoB100:
INPUT #2, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROT(AC), COLAC(AC)
IF DUMMY% = 999 THEN GOTO AXoB150
AXoB101:
GOSUB B101ASSIGNMENTS
IF BLOK = 4 THEN GOTO AXoSINGLES
GOSUB FMEMBERS
GOTO AXoB150
AXoSINGLES:
GOSUB LUCKY
AXoB150:
IF BLOK = 1 THEN GOTO AXoB10
IF BLOK = 2 THEN GOTO AXoB20
IF BLOK = 3 THEN GOTO AXoB30
IF BLOK = 4 THEN GOTO AXoB40
AXoFRAMINGREAD1:
GOSUB FRAMINGAXYZXYZ8
RETURN
'---------------------------------------------------
AXoERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 2
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' AY-BAS
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
AYBAS :
READATA = 2
GOSUB WIPEVALUES
ON ERROR GOTO AYoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB AYoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
GOTO MAIN
'------------------------------
AYoREADDATA:
Do While TIPE$ <> "LIGHTDARK:"
Input #2, TIPE$
Loop
Input #2, LIGHT, DARKK
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K6, K7, K8, K9
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
AYoBLOCKS:
' P is first point number.
' RL is first line number.
' RPL is first plane number.
DO WHILE TIPE$ <> "AUTOCUBE000:"
INPUT #2, TIPE$
LOOP
P = 1: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 1
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
FOR AC = 0 TO ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 1: GOTO AYoB101
AYoB10:
IF AC = STOPREAD THEN GOTO AYoB11
NEXT AC
AYoB11:
DO WHILE TIPE$ <> "AUTOCUBE200:"
INPUT #2, TIPE$
LOOP
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5)
NP1 = P
P = 2001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 2001
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
FOR AC = 200 TO ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 2: GOTO AYoB101
AYoB20:
IF AC = STOPREAD THEN GOTO AYoB21
NEXT AC
AYoB21:
DO WHILE TIPE$ <> "AUTOCUBE400:"
INPUT #2, TIPE$
LOOP
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL7 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP2 = P - 2000
P = 4001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
RPL = 4001
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
FOR AC = 400 TO ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 3: GOTO AYoB101
AYoB30:
IF AC = STOPREAD THEN GOTO AYoB31
NEXT AC
AYoB31:
DO WHILE TIPE$ <> "AUTOCUBE600:"
INPUT #2, TIPE$
LOOP
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL8 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7)
NP3 = P - 4000
P = 6001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + 1
RPL = 6001
FOR AC = 600 TO 799: REM cube numbers. (600-799)
BLOK = 4: GOTO AYoB100
AYoB40:
IF DUMMY% = 999 THEN EXIT FOR
NEXT AC
AYoB41:
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL9 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8)
NP4 = P - 6000
GOTO AYoFRAMINGREAD1
AYoB100:
INPUT #2, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROT(AC), COLAC(AC)
IF DUMMY% = 999 THEN GOTO AYoB150
AYoB101:
GOSUB B101ASSIGNMENTS
IF BLOK = 4 THEN GOTO AYoSINGLES
GOSUB FMEMBERS
GOTO AYoB150
AYoSINGLES:
GOSUB LUCKY
AYoB150:
IF BLOK = 1 THEN GOTO AYoB10
IF BLOK = 2 THEN GOTO AYoB20
IF BLOK = 3 THEN GOTO AYoB30
IF BLOK = 4 THEN GOTO AYoB40
AYoFRAMINGREAD1:
GOSUB FRAMINGAXYZXYZ8
RETURN
AYoERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 2
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' AZ-BAS
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
AZBAS :
READATA = 2
GOSUB WIPEVALUES
ON ERROR GOTO AZoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB AZoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
GOTO MAIN
'------------------------------
AZoREADDATA:
Do While TIPE$ <> "LIGHTDARK:"
Input #2, TIPE$
Loop
Input #2, LIGHT, DARKK
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K6, K7, K8, K9
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
AZoBLOCKS:
' P is first point number.
' RL is first line number.
' RPL is first plane number.
DO WHILE TIPE$ <> "AUTOCUBE000:"
INPUT #2, TIPE$
LOOP
P = 1: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 1
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
FOR AC = 0 TO ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 1: GOTO AZoB101
AZoB10:
IF AC = STOPREAD THEN GOTO AZoB11
NEXT AC
AZoB11:
DO WHILE TIPE$ <> "AUTOCUBE200:"
INPUT #2, TIPE$
LOOP
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5)
NP1 = P
P = 2001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 2001
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
FOR AC = 200 TO ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 2: GOTO AZoB101
AZoB20:
IF AC = STOPREAD THEN GOTO AZoB21
NEXT AC
AZoB21:
DO WHILE TIPE$ <> "AUTOCUBE400:"
INPUT #2, TIPE$
LOOP
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL7 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP2 = P - 2000
P = 4001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
RPL = 4001
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
FOR AC = 400 TO ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 3: GOTO AZoB101
AZoB30:
IF AC = STOPREAD THEN GOTO AZoB31
NEXT AC
AZoB31:
DO WHILE TIPE$ <> "AUTOCUBE600:"
INPUT #2, TIPE$
LOOP
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL8 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7)
NP3 = P - 4000
P = 6001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + 1
RPL = 6001
FOR AC = 600 TO 799: REM cube numbers. (600-799)
BLOK = 4: GOTO AZoB100
AZoB40:
IF DUMMY% = 999 THEN EXIT FOR
NEXT AC
AZoB41:
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL9 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8)
NP4 = P - 6000
GOTO AZoFRAMINGREAD1
AZoB100:
INPUT #2, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROT(AC), COLAC(AC)
IF DUMMY% = 999 THEN GOTO AZoB150
AZoB101:
GOSUB B101ASSIGNMENTS
IF BLOK = 4 THEN GOTO AZoSINGLES
GOSUB FMEMBERS
GOTO AZoB150
AZoSINGLES:
GOSUB LUCKY
AZoB150:
IF BLOK = 1 THEN GOTO AZoB10
IF BLOK = 2 THEN GOTO AZoB20
IF BLOK = 3 THEN GOTO AZoB30
IF BLOK = 4 THEN GOTO AZoB40
AZoFRAMINGREAD1:
GOSUB FRAMINGAXYZXYZ8
RETURN
'------------------------------------------------------
AZoERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 2
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' ENHANCE-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
ENHANCE :
LOCATE 70, 172: PRINT " "'Enhance menu
LOCATE 72, 172: PRINT " "
LOCATE 74, 172: PRINT " "
LOCATE 76, 172: PRINT " "
LOCATE 78, 172: PRINT " "
LOCATE 80, 172: PRINT " "
LOCATE 82, 172: PRINT " "
LOCATE 84, 172: PRINT " "
LOCATE 86, 172: PRINT " "
LOCATE 88, 172: PRINT " "
LOCATE 90, 172: PRINT " "'Enhance input
LOCATE 92, 172: PRINT " "
LOCATE 94, 172: PRINT " "
LOCATE 96, 172: PRINT " "
LOCATE 98, 172: PRINT " "
LOCATE 100, 172: PRINT " "'MM
LOCATE 101, 172: PRINT " "
LOCATE 102, 172: PRINT " "
LOCATE 103, 172: PRINT " "
LOCATE 104, 172: PRINT " "
LOCATE 105, 172: PRINT " "
LOCATE 106, 172: PRINT " "'MI
LOCATE 107, 172: PRINT " "
LOCATE 108, 172: PRINT " "
LOCATE 109, 172: PRINT " "
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
LOCATE 112, 172: PRINT " "
LOCATE 113, 172: PRINT " "
LOCATE 114, 172: PRINT " "
LOCATE 115, 172: PRINT " "
LOCATE 116, 172: PRINT " "
LOCATE 117, 172: PRINT " "
LOCATE 118, 172: PRINT " "
LOCATE 119, 172: PRINT " "
LOCATE 120, 172: PRINT " "
LOCATE 121, 172: PRINT " "
LOCATE 122, 172: PRINT " "
IF MACROSWITCH = 4 THEN GOTO MACROAMOD
IF MACROSWITCH = 5 THEN GOTO MACROAMOD
IF MACROSWITCH = 6 THEN GOTO MACROAMOD
IF MACROSWITCH = 7 THEN GOTO MACROAMOD
IF MACROSWITCH = 8 THEN GOTO MACROAMOD
IF MACROSWITCH = 9 THEN GOTO MACROAMOD
IF MACROSWITCH = 1 THEN
GS = 1: READSWITCH = 1: MACROSWITCH = 2
IF T$ = "S" THEN GOTO SBAS
IF T$ = "s" THEN GOTO SBAS
IF T$ = "CX" THEN GOTO CXBAS
IF T$ = "CY" THEN GOTO CYBAS
IF T$ = "CZ" THEN GOTO CZBAS
IF T$ = "MX" THEN GOTO MXBAS
IF T$ = "MY" THEN GOTO MYBAS
IF T$ = "MZ" THEN GOTO MZBAS
IF T$ = "AX" THEN GOTO AXBAS
IF T$ = "AY" THEN GOTO AYBAS
IF T$ = "AZ" THEN GOTO AZBAS
IF T$ = "cx" THEN GOTO CXBAS
IF T$ = "cy" THEN GOTO CYBAS
IF T$ = "cz" THEN GOTO CZBAS
IF T$ = "mx" THEN GOTO MXBAS
IF T$ = "my" THEN GOTO MYBAS
IF T$ = "mz" THEN GOTO MZBAS
IF T$ = "ax" THEN GOTO AXBAS
IF T$ = "ay" THEN GOTO AYBAS
IF T$ = "az" THEN GOTO AZBAS
IF T$ = "X8" THEN GOTO X8BAS
IF T$ = "Y8" THEN GOTO Y8BAS
IF T$ = "Z8" THEN GOTO Z8BAS
IF T$ = "x8" THEN GOTO X8BAS
IF T$ = "y8" THEN GOTO Y8BAS
IF T$ = "z8" THEN GOTO Z8BAS
END IF
IF MACROSWITCH = 2 THEN MACROSWITCH = 3: GOTO ENo50
ENo50:
IF GRPSWI = 1 THEN GRPSWI = 0: GOTO P1MOD
IF GRPSWI = 2 THEN GRPSWI = 0: GOTO P2MOD
IF GRPSWI = 3 THEN GRPSWI = 0: GOTO P3MOD
IF GRPSWI = 4 THEN GRPSWI = 0: GOTO H1MOD
IF GRPSWI = 5 THEN GRPSWI = 0: GOTO H2MOD
IF GRPSWI = 6 THEN GRPSWI = 0: GOTO H3MOD
IF GRPSWI = 21 THEN GRPSWI = 0: GOTO SP1MOD
IF GRPSWI = 22 THEN GRPSWI = 0: GOTO CP1MOD
IF GRPSWI = 23 THEN GRPSWI = 0: GOTO MP1MOD
ENo100 :
ENo1560 :
IF CHT = 1 THEN GOSUB ENoCHT
IF S5 = 0 THEN S5 = 1: S2$ = "hide"
IF AP = 1 THEN AP = 0: GOTO ENo1910
ENo1600 :
COLOR 255: PALETTE 0, 1315860
'-----------------------------------
ENo1610 :
COLOR 255
LOCATE 60, 172
PRINT "Enhance menu "
LOCATE 64, 172
PRINT "G "
DG$ = T$ + "-" + G$
LOCATE 64, 185: PRINT DG$
LOCATE 64, 178: PRINT S2$
'LOCATE 66, 172
'PRINT S2$" HCHT SCHT"
LOCATE 66, 172
PRINT S2$
LOCATE 68, 172
PRINT "h1 h2 h3 h "
LOCATE 70, 172
PRINT "p1 p2 p3 p "
LOCATE 72, 172
PRINT "hn1 hn2 hn3 pn1 pn2 pn3 "
LOCATE 74, 172
PRINT "sp1 cp1 mp1 sc1 "
LOCATE 78, 172
PRINT " K K1 K2 J J1 J2 C "
LOCATE 80, 172
PRINT " SK SJ F L P A "
LOCATE 82, 172
PRINT "G MG MA "
LOCATE 84, 172
PRINT "SC SS GP "
LOCATE 86, 172
PRINT "CV CLS QT "
LOCATE 90, 172: INPUT ; M$
LOCATE 90, 172: PRINT " "
IF M$ = "P1" OR M$ = "p1" THEN GRPSWI = 1: GS = 1: GOTO ENoGRPSWITCH
IF M$ = "P2" OR M$ = "p2" THEN GRPSWI = 2: GS = 1: GOTO ENoGRPSWITCH
IF M$ = "P3" OR M$ = "p3" THEN GRPSWI = 3: GS = 1: GOTO ENoGRPSWITCH
IF M$ = "H1" OR M$ = "h1" THEN GRPSWI = 4: GS = 1: GOTO ENoGRPSWITCH
IF M$ = "H2" OR M$ = "h2" THEN GRPSWI = 5: GS = 1: GOTO ENoGRPSWITCH
IF M$ = "H3" OR M$ = "h3" THEN GRPSWI = 6: GS = 1: GOTO ENoGRPSWITCH
IF M$ = "SP1" OR M$ = "sp1" THEN GRPSWI = 21: GS = 1: GOTO ENoGRPSWITCH
IF M$ = "CP1" OR M$ = "cp1" THEN GRPSWI = 22: GS = 1: GOTO ENoGRPSWITCH
IF M$ = "MP1" OR M$ = "mp1" THEN GRPSWI = 23: GS = 1: GOTO ENoGRPSWITCH
IF M$ = "HP" OR M$ = "hp" THEN GOTO HMOD
IF M$ = "PP" OR M$ = "pp" THEN GOTO PMOD
'-----------------------------------------------------------------------
IF M$ = "CV" OR M$ = "cv" THEN GS = 2: GOTO ENoGRPSWITCH
IF M$ = "P" OR M$ = "p" THEN QPLN = 0: GOTO PLANE
IF M$ = "F" OR M$ = "f" THEN GOTO FRAME
IF M$ = "L" OR M$ = "l" THEN GOTO ROUTINES
IF M$ = "A" OR M$ = "a" THEN GOTO ENo1770
IF M$ = "C" OR M$ = "c" THEN GOTO ROUTINES
IF M$ = "K" OR M$ = "k" THEN GOTO ROUTINES
IF M$ = "K1" OR M$ = "k1" THEN GOTO ROUTINES
IF M$ = "K2" OR M$ = "k2" THEN GOTO ROUTINES
IF M$ = "J" OR M$ = "j" THEN GOTO ROUTINES
IF M$ = "J1" OR M$ = "j1" THEN GOTO ROUTINES
IF M$ = "J2" OR M$ = "j2" THEN GOTO ROUTINES
IF M$ = "SK" OR M$ = "sk" THEN NUM = 400: GOTO ROUTINES
IF M$ = "SJ" OR M$ = "sj" THEN NUM = 400: GOTO ROUTINES
IF M$ = "GP" OR M$ = "gp" THEN GPMENU = 2: GOTO ROUTINES
IF M$ = "SC" OR M$ = "sc" THEN GOTO ROUTINES
IF M$ = "SS" OR M$ = "ss" THEN GOTO ROUTINES
IF M$ = "QT" OR M$ = "qt" THEN GOTO ENoQUIT
IF M$ = "CLS" OR M$ = "cls" THEN
CLS : VIEW SCREEN (0, 0)-(1360, 1020), BACKGROUND: GOTO ENo1610
END IF 'start256.txt
IF M$ = "FILL" OR M$ = "fill" THEN
CLS : VIEW SCREEN (0, 0)-(1360, 1020), BACK: GOTO ENo1610
END IF 'data files
IF M$ = "H" OR M$ = "h" THEN S2$ = "Hide": GOTO ENo1610
IF M$ = "S" OR M$ = "s" THEN S2$ = "Show": GOTO ENo1610
IF M$ = "G" OR M$ = "g" THEN GS = 1: GOTO ENoGRPSWITCH
IF M$ = "MG" OR M$ = "mg" THEN GOTO MACROGMOD
IF M$ = "MA" OR M$ = "ma" THEN
LOCATE 111, 172: INPUT "macro #" ; MA$
LOCATE 111, 172: PRINT " "
GOTO MACROAMOD
END IF
GOTO ENo1610
'---------------------------------------
ENo1770:
'ADD POINT
ENo1810 :
LOCATE 111, 172: INPUT "POINT # "; P1
IF P1 > 8000 THEN LOCATE 111, 172: INPUT "max is #8000 "; P1
LOCATE 113, 172: INPUT "X "; X(P1)
LOCATE 115, 172: INPUT "Y "; Y(P1)
LOCATE 117, 172: INPUT "Z "; Z(P1)
X(P1) = X(P1) - TX: Y(P1) = Y(P1) - TY: Z(P1) = Z(P1) - TZ
IF ((X(P1) * L) + (Y(P1) * M) + (Z(P1) * N)) <
((L * L) + (M * M) + (N * N)) THEN GOTO ENo1900
LOCATE 119, 172
PRINT "POINT WAS BEHIND IMAGE PLANE"
LOCATE 119, 172: PRINT " "
GOTO ENo1810
ENo1900:
G = P1: AP = 1: GOTO MAIN
ENo1910:
GY(P1) = (MM * 15.2 * YY(P1)) + 680 + HSH
GX(P1) = (MM * (-15.2) * XX(P1)) + 510 - VSH
ENo1930:
LOCATE 121, 172: INPUT "COLOR (1-15 ONLY) "; COL
LOCATE 121, 172: PRINT " "
IF COL < 1 THEN GOTO ENo1930
IF COL > 15 THEN GOTO ENo1930
COLOR COL
LINE (GY(P1), GX(P1))-(GY(P1), GX(P1))
GOTO ENo1610
'-------------------------------------------
ENo4000 :
'-------------------------------------------
ENoGRPSWITCH:
LOCATE 111, 172: INPUT "Data type "; T$
IF T$ = "S" OR T$ = "s" THEN GOTO ENoGRPNUM
IF T$ = "CX" OR T$ = "CY" OR T$ = "CZ" THEN GOTO ENoGRPNUM
IF T$ = "MX" OR T$ = "MY" OR T$ = "MZ" THEN GOTO ENoGRPNUM
IF T$ = "AX" OR T$ = "AY" OR T$ = "AZ" THEN GOTO ENoGRPNUM
IF T$ = "X8" OR T$ = "Y8" OR T$ = "Z8" THEN GOTO ENoGRPNUM
IF T$ = "cx" OR T$ = "cy" OR T$ = "cz" THEN GOTO ENoGRPNUM
IF T$ = "mx" OR T$ = "my" OR T$ = "mz" THEN GOTO ENoGRPNUM
IF T$ = "ax" OR T$ = "ay" OR T$ = "az" THEN GOTO ENoGRPNUM
IF T$ = "x8" OR T$ = "y8" OR T$ = "z8" THEN GOTO ENoGRPNUM
IF T$ = "E" OR T$ = "e" THEN
LOCATE 111, 172: PRINT " "
GOTO ENo1610
END IF
GOTO ENoGRPSWITCH
'-------------------------------------------
ENoGRPNUM:
LOCATE 113, 172: INPUT "number "; G$
LOCATE 113, 172: PRINT " "
IF T$ = "E" OR T$ = "e" THEN
GOTO ENo1610
END IF
IF GS = 1 THEN READSWITCH = 1
IF GS = 2 THEN READSWITCH = 2
IF T$ = "S" THEN GOTO SBAS
IF T$ = "CX" THEN GOTO CXBAS
IF T$ = "CY" THEN GOTO CYBAS
IF T$ = "CZ" THEN GOTO CZBAS
IF T$ = "AX" THEN GOTO AXBAS
IF T$ = "AY" THEN GOTO AYBAS
IF T$ = "AZ" THEN GOTO AZBAS
IF T$ = "s" THEN GOTO SBAS
IF T$ = "cx" THEN GOTO CXBAS
IF T$ = "cy" THEN GOTO CYBAS
IF T$ = "cz" THEN GOTO CZBAS
IF T$ = "ax" THEN GOTO AXBAS
IF T$ = "ay" THEN GOTO AYBAS
IF T$ = "az" THEN GOTO AZBAS
IF T$ = "MX" THEN GOTO MXBAS
IF T$ = "MY" THEN GOTO MYBAS
IF T$ = "MZ" THEN GOTO MZBAS
IF T$ = "mx" THEN GOTO MXBAS
IF T$ = "my" THEN GOTO MYBAS
IF T$ = "mz" THEN GOTO MZBAS
IF T$ = "x8" THEN GOTO X8BAS
IF T$ = "y8" THEN GOTO Y8BAS
IF T$ = "z8" THEN GOTO Z8BAS
IF T$ = "X8" THEN GOTO X8BAS
IF T$ = "Y8" THEN GOTO Y8BAS
IF T$ = "Z8" THEN GOTO Z8BAS
LOCATE 113, 172: PRINT " "
GOTO ENoGRPNUM
'-------------------------------------------
ENoCHT:
'-------------------------------------------
ENoQUIT:
LOCATE 120, 172
PRINT "NOTE VALUES for .cap files"
LOCATE 121, 172
PRINT "S - SAVE - exit "
ENo5000 :
CHOICE$ = INKEY$
IF CHOICE$ = "" THEN GOTO ENo5000
IF CHOICE$ = "S" OR CHOICE$ = "s" THEN
LOCATE 120, 172
PRINT " "
LOCATE 121, 172
PRINT " "
GOTO ENo1610
END IF
END 'exit program
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' ARROWS-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
ARROWS :
LOCATE 70, 172: PRINT " "'Enhance menu
LOCATE 72, 172: PRINT " "
LOCATE 74, 172: PRINT " "
LOCATE 76, 172: PRINT " "
LOCATE 78, 172: PRINT " "
LOCATE 80, 172: PRINT " "
LOCATE 82, 172: PRINT " "
LOCATE 84, 172: PRINT " "
LOCATE 86, 172: PRINT " "
LOCATE 88, 172: PRINT " "
LOCATE 90, 172: PRINT " "
LOCATE 92, 172: PRINT " "'Enhance input
LOCATE 94, 172: PRINT " "
LOCATE 96, 172: PRINT " "
LOCATE 98, 172: PRINT " "
LOCATE 100, 172: PRINT " "'M menu
LOCATE 101, 172: PRINT " "
LOCATE 102, 172: PRINT " "
LOCATE 103, 172: PRINT " "
LOCATE 104, 172: PRINT " "
LOCATE 105, 172: PRINT " "
LOCATE 106, 172: PRINT " "'Main input
LOCATE 107, 172: PRINT " "
LOCATE 108, 172: PRINT " "
LOCATE 109, 172: PRINT " "
LOCATE 110, 172: PRINT " "
ARRoMAIN:
ARRo2000 :
IF READATA = 1 THEN GOTO ARRo2011
IF READATA = 2 THEN GOTO ARRo2012
IF READATA = 3 THEN GOTO ARRo2013
ARRo2011 :
FOR RR = 1 TO NP1
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
FOR RR = 4001 TO (NP3 + 4000)
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
FOR RR = 6001 TO (NP4 + 6000)
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
GOTO ARRo2100
ARRo2012 :
FOR RR = 1 TO NP1
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
FOR RR = 2001 TO (NP2 + 2000)
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
FOR RR = 4001 TO (NP3 + 4000)
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
FOR RR = 6001 TO (NP4 + 6000)
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
GOTO ARRo2100
ARRo2013 :
FOR RR = 1 TO NP6
X(RR) = XR(RR): Y(RR) = YR(RR): Z(RR) = ZR(RR)
NEXT RR
ARRo2100 :
LOCATE 120, 172
PRINT "P F M R"
ARRo2110 :
AR$ = INKEY$
IF AR$ = "" THEN GOTO ARRo2110
IF AR$ = "P" OR AR$ = "p" THEN GOTO ARRo2200
IF AR$ = "F" OR AR$ = "f" THEN GOTO ARRo2500
IF AR$ = "M" OR AR$ = "m" THEN GOTO ARRo2800
IF AR$ = "E" OR AR$ = "e" THEN S7 = 1: GOTO MAIN
IF AR$ = "CLR" OR AR$ = "clr" THEN GOTO STARTPROGRAM
IF AR$ = "R" OR AR$ = "r" THEN
'TX = 0: TY = 0: TZ = 0
GOTO ARRo2900
END IF
GOTO ARRo2110
ARRo2200 :
LOCATE 120, 172
PRINT " X Y Z "
ARRo2210 :
P$ = INKEY$
IF P$ = "" THEN GOTO ARRo2210
IF P$ = "X" OR P$ = "x" THEN GOTO ARRo2260
IF P$ = "Y" OR P$ = "y" THEN GOTO ARRo2280
IF P$ = "Z" OR P$ = "z" THEN GOTO ARRo2300
IF P$ = "E" OR P$ = "e" THEN GOTO ARRo2100
GOTO ARRo2210
ARRo2260 :
LOCATE 120, 172: PRINT "Increment "
LOCATE 120, 192
INPUT INCR
LOCATE 120, 172: PRINT " "
ARRo2261 :
PX = 1
VA = A + TX: VB = B + TY: VC = C + TZ
LOCATE 125, 190: PRINT " "
LOCATE 123, 172
PRINT "P "; VA; " "; VB; " "; VC
LOCATE 124, 172
PRINT "F "; TX; " "; TY; " "; TZ
LOCATE 125, 172
PRINT "M "; MAD
LOCATE 125, 180
PRINT " "
ARRo2262 :
PI$ = INKEY$
IF PI$ = "" THEN GOTO ARRo2262
IF PI$ = CHR$(0) + "H" THEN A = A + INCR: RA = A
IF PI$ = CHR$(0) + "P" THEN A = A - INCR: RA = A
IF PI$ = "e" OR PI$ = "E" THEN PX = 0: GOTO ARRo2200
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
GOTO ARRoCALC
ARRo2280 :
LOCATE 120, 172: PRINT " "
LOCATE 120, 172: PRINT "Increment "
LOCATE 120, 192
INPUT INCR
LOCATE 120, 172: PRINT " "
ARRo2281 :
PY = 1
VA = A + TX: VB = B + TY: VC = C + TZ
LOCATE 125, 190: PRINT " "
LOCATE 123, 172
PRINT "P "; VA; " "; VB; " "; VC
LOCATE 124, 172
PRINT "F "; TX; " "; TY; " "; TZ
LOCATE 125, 172
PRINT "M "; MAD
LOCATE 125, 180
PRINT " "
ARRo2282 :
PI$ = INKEY$
IF PI$ = "" THEN GOTO ARRo2282
IF PI$ = CHR$(0) + "H" THEN B = B + INCR: RB = B
IF PI$ = CHR$(0) + "P" THEN B = B - INCR: RB = B
IF PI$ = "e" OR PI$ = "E" THEN PY = 0: GOTO ARRo2200
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
GOTO ARRoCALC
ARRo2300 :
LOCATE 120, 172: PRINT " "
LOCATE 120, 172: PRINT "Increment "
LOCATE 120, 192
INPUT INCR
LOCATE 120, 172: PRINT " "
ARRo2301 :
PZ = 1
VA = A + TX: VB = B + TY: VC = C + TZ
LOCATE 125, 190: PRINT " "
LOCATE 123, 172
PRINT "P "; VA; " "; VB; " "; VC
LOCATE 124, 172
PRINT "F "; TX; " "; TY; " "; TZ
LOCATE 125, 172
PRINT "M "; MAD
LOCATE 125, 180
PRINT " "
ARRo2302 :
PI$ = INKEY$
IF PI$ = "" THEN GOTO ARRo2302
IF PI$ = CHR$(0) + "H" THEN C = C + INCR: RC = C
IF PI$ = CHR$(0) + "P" THEN C = C - INCR: RC = C
IF PI$ = "e" OR PI$ = "E" THEN PZ = 0: GOTO ARRo2200
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
GOTO ARRoCALC
ARRo2500 :
LOCATE 120, 172
PRINT " X Y Z"
ARRo2510 :
P$ = INKEY$
IF P$ = "" THEN GOTO ARRo2510
IF P$ = "X" OR P$ = "x" THEN GOTO ARRo2560
IF P$ = "Y" OR P$ = "y" THEN GOTO ARRo2580
IF P$ = "Z" OR P$ = "z" THEN GOTO ARRo2600
IF P$ = "E" OR P$ = "e" THEN GOTO ARRo2100
GOTO ARRo2510
ARRo2560 :
LOCATE 120, 172: PRINT " "
LOCATE 120, 172: PRINT "Increment "
LOCATE 120, 192
INPUT INF
LOCATE 120, 172: PRINT " "
ARRo2561 :
FX = 1
VA = A + TX: VB = B + TY: VC = C + TZ
LOCATE 125, 190: PRINT " "
LOCATE 123, 172
PRINT "P "; VA; " "; VB; " "; VC
LOCATE 124, 172
PRINT "F "; TX; " "; TY; " "; TZ
LOCATE 125, 172
PRINT "M "; MAD
LOCATE 125, 180
PRINT " "
ARRo2562 :
PI$ = INKEY$
IF PI$ = "" THEN GOTO ARRo2562
IF PI$ = CHR$(0) + "H" THEN TX = TX + INF: FCH = 1: A = A - INF: RA = A
IF PI$ = CHR$(0) + "P" THEN TX = TX - INF: FCH = -1: A = A + INF: RA = A
IF PI$ = "e" OR PI$ = "E" THEN FX = 0: GOTO ARRo2500
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
IF FCH = 1 THEN INCR = INF
IF FCH = -1 THEN INCR = -INF
GOTO ARRo3000
ARRo2580 :
LOCATE 120, 172: PRINT " "
LOCATE 120, 172: PRINT "Increment "
LOCATE 120, 192
INPUT INF
LOCATE 120, 172: PRINT " "
ARRo2581 :
FY = 1
VA = A + TX: VB = B + TY: VC = C + TZ
LOCATE 125, 190: PRINT " "
LOCATE 123, 172
PRINT "P "; VA; " "; VB; " "; VC
LOCATE 124, 172
PRINT "F "; TX; " "; TY; " "; TZ
LOCATE 125, 172
PRINT "M "; MAD
LOCATE 125, 180
PRINT " "
ARRo2582 :
PI$ = INKEY$
IF PI$ = "" THEN GOTO ARRo2582
IF PI$ = CHR$(0) + "H" THEN TY = TY + INF: FCH = 1: B = B - INF: RB = B
IF PI$ = CHR$(0) + "P" THEN TY = TY - INF: FCH = -1: B = B + INF: RB = B
IF PI$ = "e" OR PI$ = "E" THEN FY = 0: GOTO ARRo2500
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
IF FCH = 1 THEN INCR = INF
IF FCH = -1 THEN INCR = -INF
GOTO ARRo3020
ARRo2600 :
LOCATE 120, 172: PRINT " "
LOCATE 120, 172: PRINT "Increment "
LOCATE 120, 192
INPUT INF
LOCATE 120, 172: PRINT " "
ARRo2601 :
FZ = 1
VA = A + TX: VB = B + TY: VC = C + TZ
LOCATE 125, 190: PRINT " "
LOCATE 123, 172
PRINT "P "; VA; " "; VB; " "; VC
LOCATE 124, 172
PRINT "F "; TX; " "; TY; " "; TZ
LOCATE 125, 172
PRINT "M "; MAD
LOCATE 125, 180
PRINT " "
ARRo2602 :
PI$ = INKEY$
IF PI$ = "" THEN GOTO ARRo2602
IF PI$ = CHR$(0) + "H" THEN TZ = TZ + INF: FCH = 1: C = C - INF: RC = C
IF PI$ = CHR$(0) + "P" THEN TZ = TZ - INF: FCH = -1: C = C + INF: RC = C
IF PI$ = "e" OR PI$ = "E" THEN FZ = 0: GOTO ARRo2500
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
IF FCH = 1 THEN INCR = INF
IF FCH = -1 THEN INCR = -INF
GOTO ARRo3040
ARRo2800 :
LOCATE 120, 172: PRINT " "
LOCATE 120, 172: PRINT "Increment "
LOCATE 120, 192
INPUT INCR
LOCATE 120, 172: PRINT " "
ARRo2808 :
VA = A + TX: VB = B + TY: VC = C + TZ
LOCATE 125, 190: PRINT " "
LOCATE 123, 172
PRINT "P "; VA; " "; VB; " "; VC
LOCATE 124, 172
PRINT "F "; TX; " "; TY; " "; TZ
LOCATE 125, 172
PRINT "M "; MAD
LOCATE 125, 180
PRINT " "
ARRo2810 :
MG = 1
MA$ = INKEY$
IF MA$ = "" THEN GOTO ARRo2810
IF MA$ = CHR$(0) + "H" THEN MM = MM + (10 * INCR)
IF MA$ = CHR$(0) + "P" THEN MM = MM - (10 * INCR)
IF MA$ = "e" OR MA$ = "E" THEN
MG = 0
LOCATE 125, 180
PRINT " "
GOTO ARRo2100
END IF
MAD = .1 * MM
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
GOTO ARRoCALC
'======================================================
'
'
' ROTATE X Y Z
'
'
'======================================================
ARRo2900 :
LOCATE 120, 172
PRINT " X Y Z"
ARRo2910 : P$ = INKEY$
IF P$ = "" THEN GOTO ARRo2910
IF P$ = "X" OR P$ = "x" THEN GOTO ARRo2960
IF P$ = "Y" OR P$ = "y" THEN GOTO ARRo2980
IF P$ = "Z" OR P$ = "z" THEN GOTO ARRoZ2980
IF P$ = "E" OR P$ = "e" THEN S7 = 1: GOTO MAIN
GOTO ARRo2910
ARRo2960 :
LOCATE 120, 172: PRINT " "
LOCATE 120, 172: PRINT "Increment "
LOCATE 120, 192
INPUT INCR
LOCATE 120, 172: PRINT " "
ARRo2961 :
RX = 1
'VA = A + TX: VB = B + TY: VC = C + TZ
ARRo2962 :
PI$ = INKEY$
IF PI$ = "" THEN GOTO ARRo2962
IF PI$ = CHR$(0) + "H" THEN GOTO ARRo2970
IF PI$ = CHR$(0) + "P" THEN GOTO ARRo2975
IF PI$ = "e" OR PI$ = "E" THEN RX = 0: GOTO ARRo2900
ARRo2970 :
XANGLE = (INCR * 3.14159) / 180
For ROTA = XBEGINDATA To XENDDATA
Y(ROTA) = (YR(ROTA) * Cos(XANGLE)) - (ZR(ROTA) * Sin(XANGLE))
Z(ROTA) = (YR(ROTA) * Sin(XANGLE)) + (ZR(ROTA) * Cos(XANGLE))
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
GOTO ARRoCALC
ARRo2975 :
XANGLE = ((-1 * INCR) * 3.14159) / 180
For ROTA = XBEGINDATA To XENDDATA
Y(ROTA) = (YR(ROTA) * Cos(XANGLE)) - (ZR(ROTA) * Sin(XANGLE))
Z(ROTA) = (YR(ROTA) * Sin(XANGLE)) + (ZR(ROTA) * Cos(XANGLE))
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
GOTO ARRoCALC
ARRo2980 :
LOCATE 120, 172: PRINT " "
LOCATE 120, 172: PRINT "Increment "
LOCATE 120, 192
INPUT INCR
LOCATE 120, 172: PRINT " "
ARRo2981 :
RY = 1
'VA = A + TX: VB = B + TY: VC = C + TZ
ARRo2982 :
PI$ = INKEY$
IF PI$ = "" THEN GOTO ARRo2982
IF PI$ = CHR$(0) + "H" THEN GOTO ARRo2990
IF PI$ = CHR$(0) + "P" THEN GOTO ARRo2995
IF PI$ = "e" OR PI$ = "E" THEN RY = 0: GOTO ARRo2900
ARRo2990 :
YANGLE = (INCR * 3.14159) / 180
For ROTA = YBEGINDATA To YENDDATA
X(ROTA) = (XR(ROTA) * Cos(YANGLE)) - (ZR(ROTA) * Sin(YANGLE))
Z(ROTA) = (XR(ROTA) * Sin(YANGLE)) + (ZR(ROTA) * Cos(YANGLE))
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
GOTO ARRoCALC
ARRo2995 :
YANGLE = ((-1 * INCR) * 3.14159) / 180
For ROTA = YBEGINDATA To YENDDATA
X(ROTA) = (XR(ROTA) * Cos(YANGLE)) - (ZR(ROTA) * Sin(YANGLE))
Z(ROTA) = (XR(ROTA) * Sin(YANGLE)) + (ZR(ROTA) * Cos(YANGLE))
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
GOTO ARRoCALC
ARRoZ2980 :
LOCATE 120, 172: PRINT " "
LOCATE 120, 172: PRINT "Increment "
LOCATE 120, 192
INPUT INCR
LOCATE 120, 172: PRINT " "
ARRoZ2981 :
RZ = 1
'VA = A + TX: VB = B + TY: VC = C + TZ
ARRoZ2982 :
PI$ = INKEY$
IF PI$ = "" THEN GOTO ARRoZ2982
IF PI$ = CHR$(0) + "H" THEN GOTO ARRoZ2990
IF PI$ = CHR$(0) + "P" THEN GOTO ARRoZ2995
IF PI$ = "e" OR PI$ = "E" THEN RZ = 0: GOTO ARRo2900
ARRoZ2990 :
ZANGLE = (INCR * 3.14159) / 180
For ROTA = ZBEGINDATA To ZENDDATA
Y(ROTA) = (XR(ROTA) * Sin(ZANGLE)) + (YR(ROTA) * Cos(ZANGLE))
X(ROTA) = (XR(ROTA) * Cos(ZANGLE)) - (YR(ROTA) * Sin(ZANGLE))
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
GOTO ARRoCALC
ARRoZ2995 :
ZANGLE = ((-1 * INCR) * 3.14159) / 180
For ROTA = ZBEGINDATA To ZENDDATA
Y(ROTA) = (XR(ROTA) * Sin(ZANGLE)) + (YR(ROTA) * Cos(ZANGLE))
X(ROTA) = (XR(ROTA) * Cos(ZANGLE)) - (YR(ROTA) * Sin(ZANGLE))
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
CHK = 0
IF PSW = 0 THEN PSW = 1: GOTO ARRoREREAD
GOTO ARRoCALC
ARRo3000 :
IF READATA = 1 THEN GOTO ARRo3001
IF READATA = 2 THEN GOTO ARRo3002
IF READATA = 3 THEN GOTO ARRo3003
ARRo3001 :
FOR RR = 1 TO NP1
X(RR) = X(RR) - INCR
TEMX(RR) = X(RR)
NEXT RR
FOR RR = 4001 TO (NP3 + 4000)
X(RR) = X(RR) - INCR
TEMX(RR) = X(RR)
NEXT RR
FOR RR = 6001 TO (6000 + NP4)
X(RR) = X(RR) - INCR
TEMX(RR) = X(RR)
NEXT RR
GOTO ARRoCALC
ARRo3002 :
FOR RR = 1 TO NP1
X(RR) = X(RR) - INCR
TEMX(RR) = X(RR)
NEXT RR
FOR RR = 2001 TO (NP2 + 2000)
X(RR) = X(RR) - INCR
TEMX(RR) = X(RR)
NEXT RR
FOR RR = 4001 TO (NP3 + 4000)
X(RR) = X(RR) - INCR
TEMX(RR) = X(RR)
NEXT RR
FOR RR = 6001 TO (NP4 + 6000)
X(RR) = X(RR) - INCR
TEMX(RR) = X(RR)
NEXT RR
GOTO ARRoCALC
ARRo3003 :
FOR RR = 1 TO NP6
X(RR) = X(RR) - INCR
TEMX(RR) = X(RR)
NEXT RR
GOTO ARRoCALC
ARRo3020 :
IF READATA = 1 THEN GOTO ARRo3021
IF READATA = 2 THEN GOTO ARRo3022
IF READATA = 3 THEN GOTO ARRo3023
ARRo3021 :
FOR RR = 1 TO NP1
Y(RR) = Y(RR) - INCR
TEMY(RR) = Y(RR)
NEXT RR
FOR RR = 4001 TO (NP3 + 4000)
Y(RR) = Y(RR) - INCR
TEMY(RR) = Y(RR)
NEXT RR
FOR RR = 6001 TO (6000 + NP4)
Y(RR) = Y(RR) - INCR
TEMY(RR) = Y(RR)
NEXT RR
GOTO ARRoCALC
ARRo3022 :
FOR RR = 1 TO NP1
Y(RR) = Y(RR) - INCR
TEMY(RR) = Y(RR)
NEXT RR
FOR RR = 2001 TO (NP2 + 2000)
Y(RR) = Y(RR) - INCR
TEMY(RR) = Y(RR)
NEXT RR
FOR RR = 4001 TO (4000 + NP3)
Y(RR) = Y(RR) - INCR
TEMY(RR) = Y(RR)
NEXT RR
FOR RR = 6001 TO (NP4 + 6000)
Y(RR) = Y(RR) - INCR
TEMY(RR) = Y(RR)
NEXT RR
GOTO ARRoCALC
ARRo3023 :
FOR RR = 1 TO NP6
Y(RR) = Y(RR) - INCR
TEMY(RR) = Y(RR)
NEXT RR
GOTO ARRoCALC
ARRo3040 :
IF READATA = 1 THEN GOTO ARRo3041
IF READATA = 2 THEN GOTO ARRo3042
IF READATA = 3 THEN GOTO ARRo3043
ARRo3041 :
FOR RR = 1 TO NP1
Z(RR) = Z(RR) - INCR
TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 4001 TO (NP3 + 4000)
Z(RR) = Z(RR) - INCR
TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 6001 TO (6000 + NP4)
Z(RR) = Z(RR) - INCR
TEMZ(RR) = Z(RR)
NEXT RR
GOTO ARRoCALC
ARRo3042 :
FOR RR = 1 TO NP1
Z(RR) = Z(RR) - INCR
TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 2001 TO (NP2 + 2000)
Z(RR) = Z(RR) - INCR
TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 4001 TO (4000 + NP3)
Z(RR) = Z(RR) - INCR
TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 6001 TO (NP4 + 6000)
Z(RR) = Z(RR) - INCR
TEMZ(RR) = Z(RR)
NEXT RR
GOTO ARRoCALC
ARRo3043 :
FOR RR = 1 TO NP6
Z(RR) = Z(RR) - INCR
TEMZ(RR) = Z(RR)
NEXT RR
GOTO ARRoCALC
ARRoSUBROUTINES:
'-----------------------------------------
ARRoREREAD:
RRA = A: RRB = B: RRC = C
IF S1 = 0 THEN
A = A - TX: B = B - TY: C = C - TZ
S1 = 1: RA = A: RB = B: RC = C
RRA = A: RRB = B: RRC = C
END IF
IF READATA = 1 THEN GOTO ARRo3691
IF READATA = 2 THEN GOTO ARRo3692
IF READATA = 3 THEN GOTO ARRo3693
ARRo3691 :
FOR RR = 1 TO NP1
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 4001 TO 4000 + NP3
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 6001 TO 6000 + NP4
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
GOTO ARRoCALC
ARRo3692 :
FOR RR = 1 TO NP1
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 2001 TO 2000 + NP2
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 4001 TO 4000 + NP3
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
FOR RR = 6001 TO 6000 + NP4
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
GOTO ARRoCALC
ARRo3693 :
FOR RR = 1 TO NP6
X(RR) = X(RR) - TX: Y(RR) = Y(RR) - TY: Z(RR) = Z(RR) - TZ
TEMX(RR) = X(RR): TEMY(RR) = Y(RR): TEMZ(RR) = Z(RR)
NEXT RR
ARRoCALC:
CLS : VIEW SCREEN (0, 0)-(1360, 1020), BACK
X(10001) = 0: Y(10001) = 0: Z(10001) = 1
I = .94 * A
J = .94 * B
K = .95 * C
L = A * ((A * I) + (B * J) + (C * K)) / ((A * A) + (B * B) + (C * C))
M = B * ((A * I) + (B * J) + (C * K)) / ((A * A) + (B * B) + (C * C))
N = C * ((A * I) + (B * J) + (C * K)) / ((A * A) + (B * B) + (C * C))
ARRo3900 :
'calculator
IF CHK = 0 THEN G = 10001: GOTO ARRo4100
ARRo3950 :
FOR GB = 1 TO 10
IF GB = 1 AND NL1 = 0 THEN GOTO ARRo4310
IF GB = 2 AND NL2 = 0 THEN GOTO ARRo4310
IF GB = 3 AND NL3 = 0 THEN GOTO ARRo4310
IF GB = 4 AND NL4 = 0 THEN GOTO ARRo4310
IF GB = 5 AND NL5 = 0 THEN GOTO ARRo4310
IF GB = 6 AND NL6 = 0 THEN GOTO ARRo4310
IF GB = 7 AND NL7 = 0 THEN GOTO ARRo4310
IF GB = 8 AND NL8 = 0 THEN GOTO ARRo4310
IF GB = 9 AND NL9 = 0 THEN GOTO ARRo4310
IF GB = 10 AND NL10 = 0 THEN GOTO ARRo4310
IF GB = 1 THEN COLOR K1: GOTO ARRo4040
IF GB = 2 THEN COLOR K2: GOTO ARRo4040
IF GB = 3 THEN COLOR K3: GOTO ARRo4040
IF GB = 4 THEN COLOR K4: GOTO ARRo4040
IF GB = 5 THEN COLOR K5: GOTO ARRo4040
IF GB = 6 THEN COLOR K6: GOTO ARRo4040
IF GB = 7 THEN COLOR K7: GOTO ARRo4040
IF GB = 8 THEN COLOR K8: GOTO ARRo4040
IF GB = 9 THEN COLOR K9: GOTO ARRo4040
IF GB = 10 THEN COLOR K10: GOTO ARRo4040
ARRo4040 : 'calculator kernel
FOR LN = FL(GB) TO LL(GB)
ARRo4045 : INC = 299
ARRo4050 :
IF DT = 1 THEN DT = 0: G = SP(LN): GOTO ARRo4090
G = FP(LN): DT = 1
ARRo4070 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) >
((L * L) + (M * M) + (N * N)) THEN GOTO ARRo5070
IF DT = 1 THEN GOTO ARRo4100
ARRo4090 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) >
((L * L) + (M * M) + (N * N)) THEN GOTO ARRo5120
ARRo4100 :
GOSUB CALCSUB
ARRo4200 :
IF CHK = 0 THEN CHK = 1: GOTO ARRo3950
IF DT = 1 THEN X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GOTO ARRo4050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
ARRo4250 :
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 510 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 510 - VSH
ARRo4280 :
LINE (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN)))
ARRo4290: NEXT LN
ARRo4310: NEXT GB
'end calculator kernel
ARRoSJNCT :
IF SOLA = 1 THEN GOTO SP1MOD
ARRoSRETURN :
IF SOLA = 1 THEN SOLAINC = 1
ARRoCJNCT :
IF COLA = 1 THEN GOTO CP1MOD
ARRoCRETURN :
IF COLA = 1 THEN COLAINC = 1
ARRoMJNCT :
IF MPOLA = 1 THEN GOTO MP1MOD
ARRoMRETURN :
IF MPOLA = 1 THEN MPOLAINC = 1
IF PX = 1 THEN COLOR 255: GOTO ARRo2261
IF PY = 1 THEN COLOR 255: GOTO ARRo2281
IF PZ = 1 THEN COLOR 255: GOTO ARRo2301
IF FX = 1 THEN COLOR 255: GOTO ARRo2561
IF FY = 1 THEN COLOR 255: GOTO ARRo2581
IF FZ = 1 THEN COLOR 255: GOTO ARRo2601
IF MG = 1 THEN COLOR 255: GOTO ARRo2808
IF RX = 1 THEN COLOR 255: GOTO ARRo2961
IF RY = 1 THEN COLOR 255: GOTO ARRo2981
IF RZ = 1 THEN COLOR 255: GOTO ARRoZ2981
ARRoINSIDE:
ARRo5070 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX:
Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999:
GOTO ARRo4290
X(G) = ((INC / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GOTO ARRo4070
ARRo5120 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX:
Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999:
GOTO ARRo4290
X(G) = ((INC / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GOTO ARRo4090
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' FRAME-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
FRAME :
FRMo3170 :
GB = 11
LOCATE 114, 172: INPUT " TOP' POINT "; T1
LOCATE 115, 172: INPUT "BOTTOM' POINT "; B1
LOCATE 116, 172: INPUT " `TOP' POINT "; T2
LOCATE 117, 172: INPUT "BOTTOM' POINT "; B2
FRMo3230 :
LOCATE 119, 189: PRINT "LIMIT:1000"
LOCATE 119, 172: INPUT "# SPACES "; NR
IF NR > 1000 THEN GOTO FRMo3230
FRMo3260 : LOCATE 121, 172: INPUT "COLOR (1-255) "; COL
LOCATE 121, 172: PRINT " "
IF COL < 1 THEN GOTO FRMo3260
IF COL > 255 THEN GOTO FRMo3260
FRMo3300 : COLOR COL
LINE (GY(T2), GX(T2))-(GY(B2), GX(B2))
FL(GB) = 8001: LL(GB) = 8000 + NR
LA = 8000: INS = -1
FOR TI = 8001 TO (8000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(T1) + ((INS / (NR)) * (X(T2) - X(T1)))
Y(TI) = Y(T1) + ((INS / (NR)) * (Y(T2) - Y(T1)))
Z(TI) = Z(T1) + ((INS / (NR)) * (Z(T2) - Z(T1)))
FP(LA) = TI
NEXT TI
LA = 8000: INS = -1
FOR BI = (8001 + NR) TO (8000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(B1) + ((INS / (NR)) * (X(B2) - X(B1)))
Y(BI) = Y(B1) + ((INS / (NR)) * (Y(B2) - Y(B1)))
Z(BI) = Z(B1) + ((INS / (NR)) * (Z(B2) - Z(B1)))
SP(LA) = BI
NEXT BI
ICHK = 1
FRMo3500 : GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' PLANE-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
PLANE :
IF QPLN = 1 THEN GOTO PLNo5425 ' q plane
IF QPLN = 0 THEN GOTO PLNo5485 ' plane by points entry
'---sq (QPLN = 2)
SQ = 1
LOCATE 111, 172: INPUT "Start plane "; SQ1
LOCATE 113, 172: INPUT " End plane "; SQ2
LOCATE 115, 172: INPUT " Increment "; SQINC
LOCATE 117, 172: INPUT "Start color "; COL: COL = COL - 1
LOCATE 119, 172: INPUT " Color inc "; COLINC
IF COLINC < 0 THEN COL = COL + 2
IF COLINC = 0 THEN COL = COL + 1
FOR PLNU = SQ1 TO SQ2 STEP SQINC
PN(1) = T1(PLNU)
PN(2) = B1(PLNU)
PN(3) = T2(PLNU)
PN(4) = B2(PLNU)
COL = COL + COLINC
IF PC = 0 THEN PC = 1
IF COL = 0 THEN COL = 1
IF COL = 256 THEN COL = 255
GOTO ENHANCE
GOTO PLNo5550
PLNo5420:
NEXT PLNU
SQ = 0
QPLN = 0
GOTO PLNo5900
'---end sq
'---q plane
PLNo5425: LOCATE 117, 172: INPUT "PLANE "; PLNU
PN(1) = T1(PLNU)
PN(2) = B1(PLNU)
PN(3) = T2(PLNU)
PN(4) = B2(PLNU)
QPLN = 0: GOTO PLNo5550: REM (5550 unscrambler)
'---plane by points entry
PLNo5485:
LOCATE 111, 172: INPUT "POINT 1"; PN(1)
LOCATE 113, 172: INPUT "POINT 2"; PN(2)
LOCATE 115, 172: INPUT "POINT 3"; PN(3)
LOCATE 117, 172: INPUT "POINT 4"; PN(4)
PLNo5550: REM unscrambler
LG1 = (((GY(PN(2))) - (GY(PN(1)))) ^ 2 + ((GX(PN(2))) - (GX(PN(1)))) ^ 2) ^ .5
LG2 = (((GY(PN(3))) - (GY(PN(2)))) ^ 2 + ((GX(PN(3))) - (GX(PN(2)))) ^ 2) ^ .5
LG3 = (((GY(PN(4))) - (GY(PN(3)))) ^ 2 + ((GX(PN(4))) - (GX(PN(3)))) ^ 2) ^ .5
LG4 = (((GY(PN(1))) - (GY(PN(4)))) ^ 2 + ((GX(PN(1))) - (GX(PN(4)))) ^ 2) ^ .5
D1 = LG1 + LG2 + LG3 + LG4
LG1 = (((GY(PN(2))) - (GY(PN(1)))) ^ 2 + ((GX(PN(2))) - (GX(PN(1)))) ^ 2) ^ .5
LG2 = (((GY(PN(4))) - (GY(PN(2)))) ^ 2 + ((GX(PN(4))) - (GX(PN(2)))) ^ 2) ^ .5
LG3 = (((GY(PN(3))) - (GY(PN(4)))) ^ 2 + ((GX(PN(3))) - (GX(PN(4)))) ^ 2) ^ .5
LG4 = (((GY(PN(1))) - (GY(PN(3)))) ^ 2 + ((GX(PN(1))) - (GX(PN(3)))) ^ 2) ^ .5
D2 = LG1 + LG2 + LG3 + LG4
LG1 = (((GY(PN(3))) - (GY(PN(1)))) ^ 2 + ((GX(PN(3))) - (GX(PN(1)))) ^ 2) ^ .5
LG2 = (((GY(PN(2))) - (GY(PN(3)))) ^ 2 + ((GX(PN(2))) - (GX(PN(3)))) ^ 2) ^ .5
LG3 = (((GY(PN(4))) - (GY(PN(2)))) ^ 2 + ((GX(PN(4))) - (GX(PN(2)))) ^ 2) ^ .5
LG4 = (((GY(PN(1))) - (GY(PN(4)))) ^ 2 + ((GX(PN(1))) - (GX(PN(4)))) ^ 2) ^ .5
D3 = LG1 + LG2 + LG3 + LG4
IF D1 < D2 AND D1 < D3 THEN GOTO PLNo5570
IF D2 < D3 THEN SWAP PN(4), PN(3): GOTO PLNo5570
SWAP PN(3), PN(2)
PLNo5570 :
IF SQ = 1 THEN GOTO PLNo5630
PLNo5580 :
PLNo5590 :
LOCATE 119, 172: INPUT "COLOR (1-255 ONLY) "; PC
IF PC < 1 THEN GOTO PLNo5590
IF PC > 255 THEN GOTO PLNo5590
PLNo5630 : FC = PC + 1
IF FC = 256 THEN FC = 254
IF FC = 257 THEN FC = 253
COLOR FC: CT = 1: GOTO PLNo5740
PLNo5660 : COLOR PC: CT = 0
PLNo5740 : LINE (GY(PN(1)), GX(PN(1)))-(GY(PN(2)), GX(PN(2)))
LINE (GY(PN(2)), GX(PN(2)))-(GY(PN(3)), GX(PN(3)))
LINE (GY(PN(3)), GX(PN(3)))-(GY(PN(4)), GX(PN(4)))
LINE (GY(PN(4)), GX(PN(4)))-(GY(PN(1)), GX(PN(1)))
AY = (GY(PN(1)) + GY(PN(2)) + GY(PN(3)) + GY(PN(4))) / 4
AX = (GX(PN(1)) + GX(PN(2)) + GX(PN(3)) + GX(PN(4))) / 4
PLNo5800 : IF CT = 1 THEN PAINT (AY, AX), FC, FC: GOTO PLNo5660
PAINT (AY, AX), PC, PC
IF SQ = 1 THEN GOTO PLNo5420
PLNo5900 : GOTO ENHANCE
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' ROUTINES-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
ROUTINES :
' IF M$ = "SP" OR M$ = "sp" THEN M$ = "": GOTO ROUoSPAL
' keep get palette. it gets used.
IF M$ = "GP" OR M$ = "gp" THEN M$ = "": GOTO ROUoGPAL
IF M$ = "SC" OR M$ = "sc" THEN M$ = "": GOTO scrncapture
IF M$ = "SS" OR M$ = "ss" THEN M$ = "": GOTO scrnset
IF M$ = "C" OR M$ = "c" THEN GOTO ROUo2010
IF M$ = "K" OR M$ = "k" THEN GOTO ROUo2045
IF M$ = "K1" OR M$ = "k1" THEN GOTO ROUo2045
IF M$ = "K2" OR M$ = "k2" THEN GOTO ROUo2045
IF M$ = "J" OR M$ = "j" THEN GOTO ROUo2045
IF M$ = "J1" OR M$ = "j1" THEN GOTO ROUo2045
IF M$ = "J2" OR M$ = "j2" THEN GOTO ROUo2045
IF M$ = "SK" OR M$ = "sk" THEN NUM = 600: GOTO ROUoSKJPLANE
IF M$ = "SJ" OR M$ = "sj" THEN NUM = 600: GOTO ROUoSKJPLANE
IF M$ = "L" OR M$ = "l" THEN M$ = "": GOTO ROUo2390
scrncapture:
COLOR 255
LOCATE 120, 172
INPUT "file"; cap$
TYPE scrncap
R AS INTEGER
colvall AS INTEGER
repeatt AS INTEGER
END TYPE
DIM capture AS scrncap
OPEN "DATA\" + cap$ + ".cap" FOR RANDOM AS #2 LEN = 6
R = 1
FOR COL = 1 TO 1360
colval = 0: curval = 0: repeat = 0: preval = 0
inc = inc + 1
IF inc = 9 THEN
column = column + 1
inc = 0
LOCATE 27, column
PRINT "I"
END IF
FOR row = 1 TO 1019
repeat = repeat + 1
colval = POINT(COL, row)
IF row = 1 THEN
repeat = 0
curval = colval
preval = colval
GOTO SKIP
END IF
IF row = 1019 AND colval = curval THEN GOTO PUTIT
IF colval = curval THEN GOTO SKIP
PUTIT: curval = colval
capture.colvall = preval
capture.repeatt = repeat
PUT #2, R, capture
IF row = 1019 THEN
R = R + 1
capture.colvall = colval
capture.repeatt = 1
PUT #2, R, capture
END IF
preval = colval: repeat = 0
R = R + 1
SKIP: NEXT row
NEXT COL
column = 0
CLOSE #2
GOTO ENHANCE
scrnset:
COLOR 255
LOCATE 120, 172
INPUT "file"; cap$
TYPE scrnset
R AS INTEGER
colvall AS INTEGER
repeatt AS INTEGER
END TYPE
DIM setit AS scrnset
OPEN "DATA\" + cap$ + ".cap" FOR RANDOM AS #2 LEN = 6
R = 0
FOR COL = 1 TO 1360
CHANGE: reptot = 1
NEWREC: R = R + 1
GET #2, R, setit
colval = setit.colvall
rep = setit.repeatt
endrep = (reptot + rep) - 1
FOR row = reptot TO endrep
PSET (COL, row), colval
NEXT row
reptot = reptot + rep
IF reptot = 1020 THEN GOTO NCOL
GOTO NEWREC
NCOL: NEXT COL
CLOSE #2
GOTO ENHANCE
'----------------------------------------------
ROUoGPAL:
REM Get palette Keep this. It gets used.
LOCATE 120, 172
INPUT "Palette "; PAL$
LOCATE 120, 172: PRINT " "
TYPE RUHUHER
R AS INTEGER
BL AS INTEGER
GR AS INTEGER
RE AS INTEGER
COD AS SINGLE
END TYPE
DIM RUHUHS AS RUHUHER
OPEN "DATA\" + PAL$ + ".pal" FOR RANDOM AS #2 LEN = 12
FOR R = 1 TO 255
GET #2, R, RUHUHS
BLU(R) = RUHUHS.BL
GRN(R) = RUHUHS.GR
RED(R) = RUHUHS.RE
DUMB = RUHUHS.COD
PAL(R) = (65536 * BLU(R)) + (256 * GRN(R)) + RED(R)
PALETTE R, PAL(R)
NEXT R
CLOSE #2
FOR RP = 1 TO 255: PALETTE RP, PAL(RP): NEXT RP
PALETTE 0, 1315860
IF GPMENU = 1 THEN GOTO MAINo1320
IF GPMENU = 2 THEN GOTO ENHANCE
'-------------------------------------------------------
ROUoSKJPLANE:
COLOR 255
LOCATE 111, 172: INPUT "Start plane "; SK1
LOCATE 113, 172: INPUT " End plane "; SK2
LOCATE 115, 172: INPUT " Increment "; SKINC
LOCATE 117, 172: INPUT "Start color "; COL: COL = COL - 1
LOCATE 119, 172: INPUT " Color inc "; COLINC
IF COLINC < 0 THEN COL = COL + 2
IF COLINC = 0 THEN COL = COL + 1
FOR PLNU = SK1 TO SK2 STEP SKINC
IF M$ = "SJ" OR M$ = "sj" THEN GOTO ROUoSJPLANE
T1 = T1(PLNU)
T2 = T2(PLNU)
B1 = B1(PLNU)
B2 = B2(PLNU)
GOTO ROUo1700
ROUoSJPLANE:
T1 = T1(PLNU)
T2 = B1(PLNU)
B1 = T2(PLNU)
B2 = B2(PLNU)
ROUo1700 : COL = COL + COLINC
IF COL = 0 THEN COL = 1
IF COL = 256 THEN COL = 255
GOTO ROUo2120: ' draw line
ROUo1710 : NEXT PLNU
GOTO ENHANCE
'---------------------------------------------------------
REM start cross hatch
ROUo2010 :
LOCATE 111, 172: INPUT " TOP' POINT "; T1
LOCATE 112, 172: INPUT "BOTTOM' POINT "; B1
LOCATE 113, 172: INPUT " `TOP' POINT "; T2
LOCATE 114, 172: INPUT "BOTTOM' POINT "; B2
LOCATE 115, 172: INPUT " # LINES "; NUM
GOTO ROUo2100
'----------- k k1 k2 j j1 j2 ---------------
ROUo2045 :
LOCATE 111, 172: PRINT " "
LOCATE 111, 172: INPUT "Plane number "; PNM
IF M$ = "K" OR M$ = "k" THEN M$ = "": NUM = 300: GOTO ROUo2050
IF M$ = "K1" OR M$ = "k1" THEN M$ = "": NUM = 1200: GOTO ROUo2050
IF M$ = "K2" OR M$ = "k2" THEN M$ = "": NUM = 4800: GOTO ROUo2050
IF M$ = "J" OR M$ = "j" THEN M$ = "": NUM = 300: GOTO ROUo2060
IF M$ = "J1" OR M$ = "j1" THEN M$ = "": NUM = 1200: GOTO ROUo2060
IF M$ = "J2" OR M$ = "j2" THEN M$ = "": NUM = 4800: GOTO ROUo2060
ROUo2050 : T1 = T1(PNM): T2 = T2(PNM): B1 = B1(PNM): B2 = B2(PNM):
GOTO ROUo2100
ROUo2060 : T1 = T1(PNM): T2 = B1(PNM): B1 = T2(PNM): B2 = B2(PNM):
GOTO ROUo2100
'------------------------------------------------------
ROUo2100 :
LOCATE 117, 172: INPUT "COLOR (1-255 ONLY) "; COL
IF COL < 1 THEN GOTO ROUo2100
IF COL > 255 THEN GOTO ROUo2100
ROUo2120 :
' draw line
COLOR COL
FOR INS = 0 TO NUM
GYT = GY(T1) + ((INS / (NUM)) * (GY(T2) - GY(T1)))
GXT = GX(T1) + ((INS / (NUM)) * (GX(T2) - GX(T1)))
GYB = GY(B1) + ((INS / (NUM)) * (GY(B2) - GY(B1)))
GXB = GX(B1) + ((INS / (NUM)) * (GX(B2) - GX(B1)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
IF M$ = "SK" OR M$ = "sk" OR M$ = "SJ" OR M$ = "sj" THEN GOTO ROUo1710
GOTO ENHANCE
REM ------- end cross hatch and k k1 k2 j j1 j2
'-----------------------------------------------------------
REM start line
ROUo2390 :
LOCATE 111, 172: INPUT " FIRST POINT "; P1
LOCATE 113, 172: INPUT "SECOND POINT "; P2
ROUo2410 :
LOCATE 115, 172: INPUT "COLOR (1-255 ONLY) "; COL
IF COL < 1 THEN GOTO ROUo2410
IF COL > 255 THEN GOTO ROUo2410
ROUo2450 : COLOR COL
LINE (GY(P1), GX(P1))-(GY(P2), GX(P2))
GOTO ENHANCE
REM end line
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' H3-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
H3MOD:
'Read distance to average point for each plane
FOR PL = 1 TO 7998
IF T1(PL) = 0 AND T2(PL) = 0 AND B1(PL) = 0 AND B2(PL) = 0 THEN GOTO HLAoNPL
DIS1(PL) = ((A - X(T1(PL))) ^ 2 + (B - Y(T1(PL))) ^ 2 + (C - Z(T1(PL))) ^ 2) ^ .5
DIS2(PL) = ((A - X(B1(PL))) ^ 2 + (B - Y(B1(PL))) ^ 2 + (C - Z(B1(PL))) ^ 2) ^ .5
DIS3(PL) = ((A - X(T2(PL))) ^ 2 + (B - Y(T2(PL))) ^ 2 + (C - Z(T2(PL))) ^ 2) ^ .5
DIS4(PL) = ((A - X(B2(PL))) ^ 2 + (B - Y(B2(PL))) ^ 2 + (C - Z(B2(PL))) ^ 2) ^ .5
DIS(PL) = (DIS1(PL) + DIS2(PL) + DIS3(PL) + DIS4(PL)) / 4
HLAoNPL:
NEXT PL
'Sort planes
FOR ORT = 1 TO 7998
IF T1(ORT) = 0 AND T2(ORT) = 0 AND B1(ORT) = 0 AND B2(ORT) = 0 THEN GOTO HLAoNPL3
NEWMAX = 1
FOR PL = 1 TO 7998
IF T1(PL) = 0 AND T2(PL) = 0 AND B1(PL) = 0 AND B2(PL) = 0
THEN GOTO HLAoNPL2
IF DIS(PL) > NEWMAX THEN
NEWMAX = DIS(PL)
ORD(ORT) = PL
END IF
HLAoNPL2:
NEXT PL
DIS(ORD(ORT)) = 0: 'key step
HLAoNPL3:
NEXT ORT
'-------------------------------------------------
'Paint white with black border
NUM = 1800
FOR PL = 1 TO 7998
IF T1(PL) = 0 AND T2(PL) = 0 AND B1(PL) = 0 AND B2(PL) = 0
THEN GOTO HLAoNPL4
COLOR 255
TT1 = T1(ORD(PL))
TT2 = T2(ORD(PL))
BB1 = B1(ORD(PL))
BB2 = B2(ORD(PL))
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(TT2) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(TT2) - GX(TT1)))
GYB = GY(BB1) + ((INS / (NUM)) * (GY(BB2) - GY(BB1)))
GXB = GX(BB1) + ((INS / (NUM)) * (GX(BB2) - GX(BB1)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(BB1) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(BB1) - GX(TT1)))
GYB = GY(TT2) + ((INS / (NUM)) * (GY(BB2) - GY(TT2)))
GXB = GX(TT2) + ((INS / (NUM)) * (GX(BB2) - GX(TT2)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
COLOR 251
LINE (GY(TT1), GX(TT1))-(GY(BB1), GX(BB1))
LINE (GY(TT2), GX(TT2))-(GY(BB2), GX(BB2))
LINE (GY(TT1), GX(TT1))-(GY(TT2), GX(TT2))
LINE (GY(BB1), GX(BB1))-(GY(BB2), GX(BB2))
HLAoNPL4:
NEXT PL
COLOR 255
IF MACROSWITCH = 3 THEN GOTO MACROAMOD
GOTO ENHANCE
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' H1-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
H1MOD:
'Read distance to nearest point for each plane
FOR PL = 1 TO 7998
IF T1(PL) = 0 AND T2(PL) = 0 AND B1(PL) = 0 AND B2(PL) = 0 THEN GOTO HLEoNPL
DIS1(PL) = ((A - X(T1(PL))) ^ 2 + (B - Y(T1(PL))) ^ 2 + (C - Z(T1(PL))) ^ 2) ^ 0.5
DIS2(PL) = ((A - X(B1(PL))) ^ 2 + (B - Y(B1(PL))) ^ 2 + (C - Z(B1(PL))) ^ 2) ^ 0.5
DIS3(PL) = ((A - X(T2(PL))) ^ 2 + (B - Y(T2(PL))) ^ 2 + (C - Z(T2(PL))) ^ 2) ^ 0.5
DIS4(PL) = ((A - X(B2(PL))) ^ 2 + (B - Y(B2(PL))) ^ 2 + (C - Z(B2(PL))) ^ 2) ^ 0.5
FDIS1(PL) = ((A - X(T1(PL))) ^ 2 + (B - Y(T1(PL))) ^ 2 + (C - Z(T1(PL))) ^ 2) ^ 0.5
FDIS2(PL) = ((A - X(B1(PL))) ^ 2 + (B - Y(B1(PL))) ^ 2 + (C - Z(B1(PL))) ^ 2) ^ 0.5
FDIS3(PL) = ((A - X(T2(PL))) ^ 2 + (B - Y(T2(PL))) ^ 2 + (C - Z(T2(PL))) ^ 2) ^ 0.5
FDIS4(PL) = ((A - X(B2(PL))) ^ 2 + (B - Y(B2(PL))) ^ 2 + (C - Z(B2(PL))) ^ 2) ^ 0.5
DIS(PL) = DIS1(PL)
If DIS2(PL) < DIS(PL) Then DIS(PL) = DIS2(PL)
If DIS3(PL) < DIS(PL) Then DIS(PL) = DIS3(PL)
If DIS4(PL) < DIS(PL) Then DIS(PL) = DIS4(PL)
FDIS(PL) = FDIS1(PL)
If FDIS2(PL) > FDIS(PL) Then FDIS(PL) = FDIS2(PL)
If FDIS3(PL) > FDIS(PL) Then FDIS(PL) = FDIS3(PL)
If FDIS4(PL) > FDIS(PL) Then FDIS(PL) = FDIS4(PL)
HLEoNPL:
NEXT PL
'Sort planes
FOR ORT = 1 TO 7998
IF T1(ORT) = 0 AND T2(ORT) = 0 AND B1(ORT) = 0 AND B2(ORT) = 0
THEN GOTO HLEoNPL3
NEWMIN = 1000000
FOR PL = 1 TO 7998
IF T1(PL) = 0 AND T2(PL) = 0 AND B1(PL) = 0 AND B2(PL) = 0
THEN GOTO HLEoNPL2
PPL = PL - 1
If DIS(PL) = NEWMIN And FDIS(PL) > FDIS(PPL) Then
NEWMIN = DIS(PL) - 0.1
ORD(ORT) = PL
End If
If DIS(PL) < NEWMIN Then
NEWMIN = DIS(PL)
ORD(ORT) = PL
End If
HLEoNPL2:
NEXT PL
DIS(ORD(ORT)) = 2000000: 'key step
HLEoNPL3:
NEXT ORT
'-------------------------------------------------
'Paint white with black border
NUM = 1800
FOR PL = 7998 TO 1 STEP -1
IF T1(PL) = 0 AND T2(PL) = 0 AND B1(PL) = 0 AND B2(PL) = 0
THEN GOTO HLEoNPL4
COLOR 255
TT1 = T1(ORD(PL))
TT2 = T2(ORD(PL))
BB1 = B1(ORD(PL))
BB2 = B2(ORD(PL))
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(TT2) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(TT2) - GX(TT1)))
GYB = GY(BB1) + ((INS / (NUM)) * (GY(BB2) - GY(BB1)))
GXB = GX(BB1) + ((INS / (NUM)) * (GX(BB2) - GX(BB1)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(BB1) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(BB1) - GX(TT1)))
GYB = GY(TT2) + ((INS / (NUM)) * (GY(BB2) - GY(TT2)))
GXB = GX(TT2) + ((INS / (NUM)) * (GX(BB2) - GX(TT2)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
COLOR 251
LINE (GY(TT1), GX(TT1))-(GY(BB1), GX(BB1))
LINE (GY(TT2), GX(TT2))-(GY(BB2), GX(BB2))
LINE (GY(TT1), GX(TT1))-(GY(TT2), GX(TT2))
LINE (GY(BB1), GX(BB1))-(GY(BB2), GX(BB2))
HLEoNPL4:
NEXT PL
COLOR 255
IF MACROSWITCH = 3 THEN GOTO MACROAMOD
GOTO ENHANCE
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' H2-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
H2MOD:
'Read distance to farthest point for each plane
FOR PL = 1 TO 7998
IF T1(PL) = 0 AND T2(PL) = 0 AND B1(PL) = 0 AND B2(PL) = 0 THEN GOTO HLFoNPL
DIS1(PL) = ((A - X(T1(PL))) ^ 2 + (B - Y(T1(PL))) ^ 2 + (C - Z(T1(PL))) ^ 2) ^ 0.5
DIS2(PL) = ((A - X(B1(PL))) ^ 2 + (B - Y(B1(PL))) ^ 2 + (C - Z(B1(PL))) ^ 2) ^ 0.5
DIS3(PL) = ((A - X(T2(PL))) ^ 2 + (B - Y(T2(PL))) ^ 2 + (C - Z(T2(PL))) ^ 2) ^ 0.5
DIS4(PL) = ((A - X(B2(PL))) ^ 2 + (B - Y(B2(PL))) ^ 2 + (C - Z(B2(PL))) ^ 2) ^ 0.5
NDIS1(PL) = ((A - X(T1(PL))) ^ 2 + (B - Y(T1(PL))) ^ 2 + (C - Z(T1(PL))) ^ 2) ^ 0.5
NDIS2(PL) = ((A - X(B1(PL))) ^ 2 + (B - Y(B1(PL))) ^ 2 + (C - Z(B1(PL))) ^ 2) ^ 0.5
NDIS3(PL) = ((A - X(T2(PL))) ^ 2 + (B - Y(T2(PL))) ^ 2 + (C - Z(T2(PL))) ^ 2) ^ 0.5
NDIS4(PL) = ((A - X(B2(PL))) ^ 2 + (B - Y(B2(PL))) ^ 2 + (C - Z(B2(PL))) ^ 2) ^ 0.5
DIS(PL) = DIS1(PL)
If DIS2(PL) > DIS(PL) Then DIS(PL) = DIS2(PL)
If DIS3(PL) > DIS(PL) Then DIS(PL) = DIS3(PL)
If DIS4(PL) > DIS(PL) Then DIS(PL) = DIS4(PL)
NDIS(PL) = NDIS1(PL)
If NDIS2(PL) > NDIS(PL) Then NDIS(PL) = NDIS2(PL)
If NDIS3(PL) > NDIS(PL) Then NDIS(PL) = NDIS3(PL)
If NDIS4(PL) > NDIS(PL) Then NDIS(PL) = NDIS4(PL)
HLFoNPL:
NEXT PL
'-------------------------------------------------
'Sort planes
FOR ORT = 1 TO 7998
IF T1(ORT) = 0 AND T2(ORT) = 0 AND B1(ORT) = 0 AND B2(ORT) = 0
THEN GOTO HLFoNPL3
NEWMAX = 1
FOR PL = 1 TO 7998
IF T1(PL) = 0 AND T2(PL) = 0 AND B1(PL) = 0 AND B2(PL) = 0
THEN GOTO HLFoNPL2
PPL = PL - 1
If DIS(PL) = NEWMAX And NDIS(PL) > NDIS(PPL) Then
NEWMAX = DIS(PL) + 0.1
ORD(ORT) = PL
End If
If DIS(PL) > NEWMAX Then
NEWMAX = DIS(PL)
ORD(ORT) = PL
End If
HLFoNPL2:
NEXT PL
DIS(ORD(ORT)) = 0: 'key step
HLFoNPL3:
NEXT ORT
'-------------------------------------------------
'Paint white with black border
NUM = 1800
FOR PL = 1 TO 7998
IF T1(PL) = 0 AND T2(PL) = 0 AND B1(PL) = 0 AND B2(PL) = 0
THEN GOTO HLFoNPL4
COLOR 255
TT1 = T1(ORD(PL))
TT2 = T2(ORD(PL))
BB1 = B1(ORD(PL))
BB2 = B2(ORD(PL))
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(TT2) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(TT2) - GX(TT1)))
GYB = GY(BB1) + ((INS / (NUM)) * (GY(BB2) - GY(BB1)))
GXB = GX(BB1) + ((INS / (NUM)) * (GX(BB2) - GX(BB1)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(BB1) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(BB1) - GX(TT1)))
GYB = GY(TT2) + ((INS / (NUM)) * (GY(BB2) - GY(TT2)))
GXB = GX(TT2) + ((INS / (NUM)) * (GX(BB2) - GX(TT2)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
COLOR 251
LINE (GY(TT1), GX(TT1))-(GY(BB1), GX(BB1))
LINE (GY(TT2), GX(TT2))-(GY(BB2), GX(BB2))
LINE (GY(TT1), GX(TT1))-(GY(TT2), GX(TT2))
LINE (GY(BB1), GX(BB1))-(GY(BB2), GX(BB2))
HLFoNPL4:
NEXT PL
COLOR 255
IF MACROSWITCH = 3 THEN GOTO MACROAMOD
GOTO ENHANCE
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' H-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
HMOD:
'Paint white with black border
NUM = 500
LOCATE 111, 172
INPUT "Plane number ";PL
LOCATE 111, 172
PRINT " "
COLOR 255
FOR INS = 0 TO NUM
GYT = GY(T1(PL)) + ((INS / (NUM)) * (GY(T2(PL)) - GY(T1(PL))))
GXT = GX(T1(PL)) + ((INS / (NUM)) * (GX(T2(PL)) - GX(T1(PL))))
GYB = GY(B1(PL)) + ((INS / (NUM)) * (GY(B2(PL)) - GY(B1(PL))))
GXB = GX(B1(PL)) + ((INS / (NUM)) * (GX(B2(PL)) - GX(B1(PL))))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
COLOR 251
LINE (GY(T1(PL)), GX(T1(PL)))-(GY(B1(PL)), GX(B1(PL)))
LINE (GY(T2(PL)), GX(T2(PL)))-(GY(B2(PL)), GX(B2(PL)))
LINE (GY(T1(PL)), GX(T1(PL)))-(GY(T2(PL)), GX(T2(PL)))
LINE (GY(B1(PL)), GX(B1(PL)))-(GY(B2(PL)), GX(B2(PL)))
COLOR 255
GOTO ENHANCE
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' SP1-MOD sa
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
SP1MOD:
COLOR K1
'------------------------------------------------
'Read distance to nearest point for each plane
FOR DPL = 1 TO 7998
IF T1(DPL) = 0 AND T2(DPL) = 0 AND B1(DPL) = 0 AND B2(DPL) = 0 THEN GOTO SPoNPL
DIS1(DPL) = ((A - X(T1(DPL))) ^ 2 + (B - Y(T1(DPL))) ^ 2 + (C - Z(T1(DPL))) ^ 2) ^ 0.5
DIS2(DPL) = ((A - X(B1(DPL))) ^ 2 + (B - Y(B1(DPL))) ^ 2 + (C - Z(B1(DPL))) ^ 2) ^ 0.5
DIS3(DPL) = ((A - X(T2(DPL))) ^ 2 + (B - Y(T2(DPL))) ^ 2 + (C - Z(T2(DPL))) ^ 2) ^ 0.5
DIS4(DPL) = ((A - X(B2(DPL))) ^ 2 + (B - Y(B2(DPL))) ^ 2 + (C - Z(B2(DPL))) ^ 2) ^ 0.5
FDIS1(DPL) = ((A - X(T1(DPL))) ^ 2 + (B - Y(T1(DPL))) ^ 2 + (C - Z(T1(DPL))) ^ 2) ^ 0.5
FDIS2(DPL) = ((A - X(B1(DPL))) ^ 2 + (B - Y(B1(DPL))) ^ 2 + (C - Z(B1(DPL))) ^ 2) ^ 0.5
FDIS3(DPL) = ((A - X(T2(DPL))) ^ 2 + (B - Y(T2(DPL))) ^ 2 + (C - Z(T2(DPL))) ^ 2) ^ 0.5
FDIS4(DPL) = ((A - X(B2(DPL))) ^ 2 + (B - Y(B2(DPL))) ^ 2 + (C - Z(B2(DPL))) ^ 2) ^ 0.5
DIS(DPL) = DIS1(DPL)
If DIS2(DPL) < DIS(DPL) Then DIS(DPL) = DIS2(DPL)
If DIS3(DPL) < DIS(DPL) Then DIS(DPL) = DIS3(DPL)
If DIS4(DPL) < DIS(DPL) Then DIS(DPL) = DIS4(DPL)
FDIS(DPL) = FDIS1(DPL)
If FDIS2(DPL) > FDIS(DPL) Then FDIS(DPL) = FDIS2(DPL)
If FDIS3(DPL) > FDIS(DPL) Then FDIS(DPL) = FDIS3(DPL)
If FDIS4(DPL) > FDIS(DPL) Then FDIS(DPL) = FDIS4(DPL)
SPoNPL:
NEXT DPL
'-------------------------------------------------
'Sort planes
FOR ORV = 1 TO 7998
IF T1(ORV) = 0 AND T2(ORV) = 0 AND B1(ORV) = 0 AND B2(ORV) = 0 THEN GOTO SPoNPL3
NEWMIN = 1000000
FOR OPL = 1 TO 7998
IF T1(OPL) = 0 AND T2(OPL) = 0 AND B1(OPL) = 0 AND B2(OPL) = 0 THEN GOTO SPoNPL2
POPL = OPL - 1
If DIS(OPL) = NEWMIN And FDIS(OPL) > FDIS(POPL) Then
NEWMIN = DIS(OPL) - 0.1
ORD(ORV) = OPL
End If
If DIS(OPL) < NEWMIN Then
NEWMIN = DIS(OPL)
ORD(ORV) = OPL
End If
SPoNPL2:
NEXT OPL
DIS(ORD(ORV)) = 2000000: 'key step
SPoNPL3:
NEXT ORV
'-------------------------------------------------
'Paint colors and draw framing lines
NUM = 1800
FOR ORT = 7998 TO 1 STEP -1
IF T1(ORT) = 0 AND T2(ORT) = 0 AND B1(ORT) = 0 AND B2(ORT) = 0 THEN GOTO SPoNPL4
IF DIR(ORD(ORT)) = 5 THEN TDIR(ORD(ORT)) = 5
IF DIR(ORD(ORT)) = 6 THEN TDIR(ORD(ORT)) = 6
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 1
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 1
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 1
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 1
IF COLR(ORD(ORT)) = 0 THEN COLR(ORD(ORT)) = 1
IF SOLAINC = 1 THEN GOTO SPoCONT
IF TDIR(ORD(ORT)) = LIGHT THEN COLR(ORD(ORT)) = COLR(ORD(ORT)) - 1
IF TDIR(ORD(ORT)) = DARKK THEN COLR(ORD(ORT)) = COLR(ORD(ORT)) + 1
SPoCONT :
COLOR COLR(ORD(ORT))
TT1 = T1(ORD(ORT))
TT2 = T2(ORD(ORT))
BB1 = B1(ORD(ORT))
BB2 = B2(ORD(ORT))
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(TT2) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(TT2) - GX(TT1)))
GYB = GY(BB1) + ((INS / (NUM)) * (GY(BB2) - GY(BB1)))
GXB = GX(BB1) + ((INS / (NUM)) * (GX(BB2) - GX(BB1)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(BB1) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(BB1) - GX(TT1)))
GYB = GY(TT2) + ((INS / (NUM)) * (GY(BB2) - GY(TT2)))
GXB = GX(TT2) + ((INS / (NUM)) * (GX(BB2) - GX(TT2)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
'----------------
IF AUTOFRM1(ORD(ORT)) = 0 AND AUTOFRM2(ORD(ORT)) = 0 THEN GOTO SPoNPL4
COL = COLR(ORD(ORT)) + 1
IF AUTOFRM1(ORD(ORT)) = 0 AND AUTOFRM2(ORD(ORT)) > 0 THEN GOTO SPoFLIP2
IF AUTOFRM1(ORD(ORT)) > 0 AND AUTOFRM2(ORD(ORT)) = 0 THEN GOTO SPoFLIP1
IF AUTOFRM1(ORD(ORT)) > 0 AND AUTOFRM2(ORD(ORT)) > 0 THEN REPEAT = 1: GOTO SPoFLIP1
SPoFLIP1:
T1 = T1(ORD(ORT)): T2 = T2(ORD(ORT)): B1 = B1(ORD(ORT)): B2 = B2(ORD(ORT)):
NR = AUTOFRM1(ORD(ORT)): GOTO SPoFRAMEIT
SPoFLIP2:
T1 = T1(ORD(ORT)): T2 = B1(ORD(ORT)): B1 = T2(ORD(ORT)): B2 = B2(ORD(ORT)):
NR = AUTOFRM2(ORD(ORT)): GOTO SPoFRAMEIT
SPoNPL4:
NEXT ORT
IF SOLA = 1 THEN GOTO ARRoSRETURN
GOTO ENHANCE
'Subs
'----------------------------------------------------
SPoFRAMEIT:
GB = 11
SPo3300 : COLOR COL
LINE (GY(T2), GX(T2))-(GY(B2), GX(B2))
FL(GB) = 8001: LL(GB) = 8000 + NR
LA = 8000: INS = -1
FOR TI = 8001 TO (8000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(T1) + ((INS / (NR)) * (X(T2) - X(T1)))
Y(TI) = Y(T1) + ((INS / (NR)) * (Y(T2) - Y(T1)))
Z(TI) = Z(T1) + ((INS / (NR)) * (Z(T2) - Z(T1)))
FP(LA) = TI
NEXT TI
LA = 8000: INS = -1
FOR BI = (8001 + NR) TO (8000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(B1) + ((INS / (NR)) * (X(B2) - X(B1)))
Y(BI) = Y(B1) + ((INS / (NR)) * (Y(B2) - Y(B1)))
Z(BI) = Z(B1) + ((INS / (NR)) * (Z(B2) - Z(B1)))
SP(LA) = BI
NEXT BI
SPo1040 : 'calculator kernel
FOR LN = FL(GB) TO LL(GB)
SPo1045 : INC = 299
SPo1050 : IF DT = 1 THEN DT = 0: G = SP(LN): GOTO SPo1090
G = FP(LN): DT = 1
SPo1070 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO SPo3070
IF DT = 1 THEN GOTO SPo1100
SPo1090 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO SPo3120
SPo1100 :
GOSUB CALCSUB
SPo1200 :
IF DT = 1 THEN X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GOTO SPo1050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
SPo1250 :
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 510 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 510 - VSH
SPo1280 :
LINE (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN)))
SPo1290 : NEXT LN
IF REPEAT = 1 THEN REPEAT = 0: GOTO SPoFLIP2
GOTO SPoNPL4
'------------------------------------------
SPo3070 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999: GOTO SPo1290
X(G) = ((INC / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GOTO SPo1070
SPo3120 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999: GOTO SPo1290
X(G) = ((INC / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GOTO SPo1090
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' CP1-MOD ca
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
CP1MOD:
COLOR K1
'------------------------------------------------
'Read distance to nearest point for each plane
FOR DPL = 1 TO 7998
IF T1(DPL) = 0 AND T2(DPL) = 0 AND B1(DPL) = 0 AND B2(DPL) = 0 THEN GOTO CPoNPL
DIS1(DPL) = ((A - X(T1(DPL))) ^ 2 + (B - Y(T1(DPL))) ^ 2 + (C - Z(T1(DPL))) ^ 2) ^ .5
DIS2(DPL) = ((A - X(B1(DPL))) ^ 2 + (B - Y(B1(DPL))) ^ 2 + (C - Z(B1(DPL))) ^ 2) ^ .5
DIS3(DPL) = ((A - X(T2(DPL))) ^ 2 + (B - Y(T2(DPL))) ^ 2 + (C - Z(T2(DPL))) ^ 2) ^ .5
DIS4(DPL) = ((A - X(B2(DPL))) ^ 2 + (B - Y(B2(DPL))) ^ 2 + (C - Z(B2(DPL))) ^ 2) ^ .5
DIS(DPL) = DIS1(DPL)
IF DIS2(DPL) < DIS(DPL) THEN DIS(DPL) = DIS2(DPL)
IF DIS3(DPL) < DIS(DPL) THEN DIS(DPL) = DIS3(DPL)
IF DIS4(DPL) < DIS(DPL) THEN DIS(DPL) = DIS4(DPL)
CPoNPL:
NEXT DPL
'-------------------------------------------------
'Sort planes
FOR ORV = 1 TO 7998
IF T1(ORV) = 0 AND T2(ORV) = 0 AND B1(ORV) = 0 AND B2(ORV) = 0 THEN GOTO CPoNPL3
NEWMIN = 1000000
FOR OPL = 1 TO 7998
IF T1(OPL) = 0 AND T2(OPL) = 0 AND B1(OPL) = 0 AND B2(OPL) = 0 THEN GOTO CPoNPL2
IF DIS(OPL) < NEWMIN THEN
NEWMIN = DIS(OPL)
ORD(ORV) = OPL
END IF
CPoNPL2:
NEXT OPL
DIS(ORD(ORV)) = 2000000: 'key step
CPoNPL3:
NEXT ORV
'-------------------------------------------------
'Paint colors and draw framing lines
NUM = 900
CURVCOL = DRKCOL
FOR ORT = 7998 TO 1 STEP -1
IF T1(ORT) = 0 AND T2(ORT) = 0 AND B1(ORT) = 0 AND B2(ORT) = 0 THEN GOTO CPoNPL4
CURVCOL = CURVCOL - 1
COLR(ORD(ORT)) = CURVCOL
IF COLR(ORD(ORT)) < 1 THEN COLR(ORD(ORT)) = 1
COLOR COLR(ORD(ORT))
TT1 = T1(ORD(ORT))
TT2 = T2(ORD(ORT))
BB1 = B1(ORD(ORT))
BB2 = B2(ORD(ORT))
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(TT2) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(TT2) - GX(TT1)))
GYB = GY(BB1) + ((INS / (NUM)) * (GY(BB2) - GY(BB1)))
GXB = GX(BB1) + ((INS / (NUM)) * (GX(BB2) - GX(BB1)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(BB1) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(BB1) - GX(TT1)))
GYB = GY(TT2) + ((INS / (NUM)) * (GY(BB2) - GY(TT2)))
GXB = GX(TT2) + ((INS / (NUM)) * (GX(BB2) - GX(TT2)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
CPoNPL4:
NEXT ORT
IF COLA = 1 THEN GOTO ARRoCRETURN
GOTO ENHANCE
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' MP1-MOD mpa
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
MP1MOD:
COLOR K1
'------------------------------------------------
'Read distance to nearest point for each plane
FOR DPL = 1 TO 5998
IF T1(DPL) = 0 AND T2(DPL) = 0 AND B1(DPL) = 0 AND B2(DPL) = 0 THEN GOTO MSAoNPL
DIS1(DPL) = ((A - X(T1(DPL))) ^ 2 + (B - Y(T1(DPL))) ^ 2 + (C - Z(T1(DPL))) ^ 2) ^ 0.5
DIS2(DPL) = ((A - X(B1(DPL))) ^ 2 + (B - Y(B1(DPL))) ^ 2 + (C - Z(B1(DPL))) ^ 2) ^ 0.5
DIS3(DPL) = ((A - X(T2(DPL))) ^ 2 + (B - Y(T2(DPL))) ^ 2 + (C - Z(T2(DPL))) ^ 2) ^ 0.5
DIS4(DPL) = ((A - X(B2(DPL))) ^ 2 + (B - Y(B2(DPL))) ^ 2 + (C - Z(B2(DPL))) ^ 2) ^ 0.5
DIS(DPL) = DIS1(DPL)
If DIS2(DPL) < DIS(DPL) Then DIS(DPL) = DIS2(DPL)
If DIS3(DPL) < DIS(DPL) Then DIS(DPL) = DIS3(DPL)
If DIS4(DPL) < DIS(DPL) Then DIS(DPL) = DIS4(DPL)
MSAoNPL:
NEXT DPL
'-------------------------------------------------
'Sort planes
FOR ORV = 1 TO 5998
IF T1(ORV) = 0 AND T2(ORV) = 0 AND B1(ORV) = 0 AND B2(ORV) = 0 THEN GOTO MSAoNPL3
NEWMIN = 1000000
FOR OPL = 1 TO 5998
IF T1(OPL) = 0 AND T2(OPL) = 0 AND B1(OPL) = 0 AND B2(OPL) = 0 THEN GOTO MSAoNPL2
If DIS(OPL) < NEWMIN Then
NEWMIN = DIS(OPL)
ORD(ORV) = OPL
End If
MSAoNPL2:
NEXT OPL
DIS(ORD(ORV)) = 2000000: 'key step
MSAoNPL3:
NEXT ORV
'-------------------------------------------------
'Paint colors and draw framing lines
NUM = 1800
FOR ORT = 5998 TO 1 STEP -1
IF T1(ORT) = 0 AND T2(ORT) = 0 AND B1(ORT) = 0 AND B2(ORT) = 0 THEN GOTO MSAoNPL4
IF DIR(ORD(ORT)) = 5 THEN TDIR(ORD(ORT)) = 5
IF DIR(ORD(ORT)) = 6 THEN TDIR(ORD(ORT)) = 6
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 1
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 1
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 1
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 1
IF COLR(ORD(ORT)) = 0 THEN COLR(ORD(ORT)) = 1
IF MPOLAINC = 1 THEN GOTO MSAoCONT
IF TDIR(ORD(ORT)) = LIGHT THEN COLR(ORD(ORT)) = COLR(ORD(ORT)) - 1
IF TDIR(ORD(ORT)) = DARKK THEN COLR(ORD(ORT)) = COLR(ORD(ORT)) + 1
MSAoCONT :
COLOR COLR(ORD(ORT))
TT1 = T1(ORD(ORT))
TT2 = T2(ORD(ORT))
BB1 = B1(ORD(ORT))
BB2 = B2(ORD(ORT))
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(TT2) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(TT2) - GX(TT1)))
GYB = GY(BB1) + ((INS / (NUM)) * (GY(BB2) - GY(BB1)))
GXB = GX(BB1) + ((INS / (NUM)) * (GX(BB2) - GX(BB1)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(BB1) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(BB1) - GX(TT1)))
GYB = GY(TT2) + ((INS / (NUM)) * (GY(BB2) - GY(TT2)))
GXB = GX(TT2) + ((INS / (NUM)) * (GX(BB2) - GX(TT2)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
'----------------
IF AUTOFRM1(ORD(ORT)) = 0 AND AUTOFRM2(ORD(ORT)) = 0 THEN GOTO MSAoNPL4
COL = COLR(ORD(ORT)) + 1
IF AUTOFRM1(ORD(ORT)) = 0 AND AUTOFRM2(ORD(ORT)) > 0 THEN GOTO MSAoFLIP2
IF AUTOFRM1(ORD(ORT)) > 0 AND AUTOFRM2(ORD(ORT)) = 0 THEN GOTO MSAoFLIP1
IF AUTOFRM1(ORD(ORT)) > 0 AND AUTOFRM2(ORD(ORT)) > 0 THEN REPEAT = 1: GOTO MSAoFLIP1
MSAoFLIP1:
T1 = T1(ORD(ORT)): T2 = T2(ORD(ORT)): B1 = B1(ORD(ORT)): B2 = B2(ORD(ORT)):
NR = AUTOFRM1(ORD(ORT)): GOTO MSAoFRAMEIT
MSAoFLIP2:
T1 = T1(ORD(ORT)): T2 = B1(ORD(ORT)): B1 = T2(ORD(ORT)): B2 = B2(ORD(ORT)):
NR = AUTOFRM2(ORD(ORT)): GOTO MSAoFRAMEIT
MSAoNPL4:
NEXT ORT
'Read distance to nearest point for each plane
FOR DPL = 6001 TO 7998
IF T1(DPL) = 0 AND T2(DPL) = 0 AND B1(DPL) = 0 AND B2(DPL) = 0 THEN GOTO MSA2oNPL
DIS1(DPL) = ((A - X(T1(DPL))) ^ 2 + (B - Y(T1(DPL))) ^ 2 + (C - Z(T1(DPL))) ^ 2) ^ .5
DIS2(DPL) = ((A - X(B1(DPL))) ^ 2 + (B - Y(B1(DPL))) ^ 2 + (C - Z(B1(DPL))) ^ 2) ^ .5
DIS3(DPL) = ((A - X(T2(DPL))) ^ 2 + (B - Y(T2(DPL))) ^ 2 + (C - Z(T2(DPL))) ^ 2) ^ .5
DIS4(DPL) = ((A - X(B2(DPL))) ^ 2 + (B - Y(B2(DPL))) ^ 2 + (C - Z(B2(DPL))) ^ 2) ^ .5
DIS(DPL) = DIS1(DPL)
IF DIS2(DPL) < DIS(DPL) THEN DIS(DPL) = DIS2(DPL)
IF DIS3(DPL) < DIS(DPL) THEN DIS(DPL) = DIS3(DPL)
IF DIS4(DPL) < DIS(DPL) THEN DIS(DPL) = DIS4(DPL)
MSA2oNPL:
NEXT DPL
'-------------------------------------------------
'Sort planes
FOR ORV = 6001 TO 7998
IF T1(ORV) = 0 AND T2(ORV) = 0 AND B1(ORV) = 0 AND B2(ORV) = 0 THEN GOTO MSA2oNPL3
NEWMIN = 1000000
FOR OPL = 6001 TO 7998
IF T1(OPL) = 0 AND T2(OPL) = 0 AND B1(OPL) = 0 AND B2(OPL) = 0 THEN GOTO MSA2oNPL2
IF DIS(OPL) < NEWMIN THEN
NEWMIN = DIS(OPL)
ORD(ORV) = OPL
END IF
MSA2oNPL2:
NEXT OPL
DIS(ORD(ORV)) = 2000000: 'key step
MSA2oNPL3:
NEXT ORV
'-------------------------------------------------
'Paint colors and draw framing lines
NUM = 900
CURVCOL = DRKCOL
FOR ORT = 7998 TO 6001 STEP -1
IF T1(ORT) = 0 AND T2(ORT) = 0 AND B1(ORT) = 0 AND B2(ORT) = 0 THEN GOTO MSA2oNPL4
CURVCOL = CURVCOL - 1
COLR(ORD(ORT)) = CURVCOL
IF COLR(ORD(ORT)) < 1 THEN COLR(ORD(ORT)) = 1
COLOR COLR(ORD(ORT))
TT1 = T1(ORD(ORT))
TT2 = T2(ORD(ORT))
BB1 = B1(ORD(ORT))
BB2 = B2(ORD(ORT))
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(TT2) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(TT2) - GX(TT1)))
GYB = GY(BB1) + ((INS / (NUM)) * (GY(BB2) - GY(BB1)))
GXB = GX(BB1) + ((INS / (NUM)) * (GX(BB2) - GX(BB1)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(BB1) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(BB1) - GX(TT1)))
GYB = GY(TT2) + ((INS / (NUM)) * (GY(BB2) - GY(TT2)))
GXB = GX(TT2) + ((INS / (NUM)) * (GX(BB2) - GX(TT2)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
MSA2oNPL4:
NEXT ORT
IF MPOLA = 1 THEN GOTO ARRoMRETURN
GOTO ENHANCE
'Subs
'----------------------------------------------------
MSAoFRAMEIT:
GB = 11
MSAo3300 : COLOR COL
LINE (GY(T2), GX(T2))-(GY(B2), GX(B2))
FL(GB) = 8001: LL(GB) = 8000 + NR
LA = 8000: INS = -1
FOR TI = 8001 TO (8000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(T1) + ((INS / (NR)) * (X(T2) - X(T1)))
Y(TI) = Y(T1) + ((INS / (NR)) * (Y(T2) - Y(T1)))
Z(TI) = Z(T1) + ((INS / (NR)) * (Z(T2) - Z(T1)))
FP(LA) = TI
NEXT TI
LA = 8000: INS = -1
FOR BI = (8001 + NR) TO (8000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(B1) + ((INS / (NR)) * (X(B2) - X(B1)))
Y(BI) = Y(B1) + ((INS / (NR)) * (Y(B2) - Y(B1)))
Z(BI) = Z(B1) + ((INS / (NR)) * (Z(B2) - Z(B1)))
SP(LA) = BI
NEXT BI
MSAo1040 : 'calculator kernel
FOR LN = FL(GB) TO LL(GB)
MSAo1045 : INC = 299
MSAo1050 : IF DT = 1 THEN DT = 0: G = SP(LN): GOTO MSAo1090
G = FP(LN): DT = 1
MSAo1070 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO MSAo3070
IF DT = 1 THEN GOTO MSAo1100
MSAo1090 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO MSAo3120
MSAo1100 :
GOSUB CALCSUB
MSAo1200 :
IF DT = 1 THEN X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GOTO MSAo1050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
MSAo1250 :
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 510 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 510 - VSH
MSAo1280 :
LINE (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN)))
MSAo1290 : NEXT LN
IF REPEAT = 1 THEN REPEAT = 0: GOTO MSAoFLIP2
GOTO MSAoNPL4
'------------------------------------------
MSAo3070 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999: GOTO MSAo1290
X(G) = ((INC / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GOTO MSAo1070
MSAo3120 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999: GOTO MSAo1290
X(G) = ((INC / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GOTO MSAo1090
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' P1-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
P1MOD:
COLOR K1
'------------------------------------------------
'Read distance to nearest point for each plane
FOR DPL = 1 TO 7998
IF T1(DPL) = 0 AND T2(DPL) = 0 AND B1(DPL) = 0 AND B2(DPL) = 0 THEN GOTO HPToNPL
DIS1(DPL) = ((A - X(T1(DPL))) ^ 2 + (B - Y(T1(DPL))) ^ 2 + (C - Z(T1(DPL))) ^ 2) ^ 0.5
DIS2(DPL) = ((A - X(B1(DPL))) ^ 2 + (B - Y(B1(DPL))) ^ 2 + (C - Z(B1(DPL))) ^ 2) ^ 0.5
DIS3(DPL) = ((A - X(T2(DPL))) ^ 2 + (B - Y(T2(DPL))) ^ 2 + (C - Z(T2(DPL))) ^ 2) ^ 0.5
DIS4(DPL) = ((A - X(B2(DPL))) ^ 2 + (B - Y(B2(DPL))) ^ 2 + (C - Z(B2(DPL))) ^ 2) ^ 0.5
FDIS1(DPL) = ((A - X(T1(DPL))) ^ 2 + (B - Y(T1(DPL))) ^ 2 + (C - Z(T1(DPL))) ^ 2) ^ 0.5
FDIS2(DPL) = ((A - X(B1(DPL))) ^ 2 + (B - Y(B1(DPL))) ^ 2 + (C - Z(B1(DPL))) ^ 2) ^ 0.5
FDIS3(DPL) = ((A - X(T2(DPL))) ^ 2 + (B - Y(T2(DPL))) ^ 2 + (C - Z(T2(DPL))) ^ 2) ^ 0.5
FDIS4(DPL) = ((A - X(B2(DPL))) ^ 2 + (B - Y(B2(DPL))) ^ 2 + (C - Z(B2(DPL))) ^ 2) ^ 0.5
DIS(DPL) = DIS1(DPL)
If DIS2(DPL) < DIS(DPL) Then DIS(DPL) = DIS2(DPL)
If DIS3(DPL) < DIS(DPL) Then DIS(DPL) = DIS3(DPL)
If DIS4(DPL) < DIS(DPL) Then DIS(DPL) = DIS4(DPL)
FDIS(DPL) = FDIS1(DPL)
If FDIS2(DPL) > FDIS(DPL) Then FDIS(DPL) = FDIS2(DPL)
If FDIS3(DPL) > FDIS(DPL) Then FDIS(DPL) = FDIS3(DPL)
If FDIS4(DPL) > FDIS(DPL) Then FDIS(DPL) = FDIS4(DPL)
HPToNPL:
NEXT DPL
'-------------------------------------------------
'Sort planes
FOR ORV = 1 TO 7998
IF T1(ORV) = 0 AND T2(ORV) = 0 AND B1(ORV) = 0 AND B2(ORV) = 0 THEN GOTO HPToNPL3
NEWMIN = 1000000
FOR OPL = 1 TO 7998
IF T1(OPL) = 0 AND T2(OPL) = 0 AND B1(OPL) = 0 AND B2(OPL) = 0 THEN GOTO HPToNPL2
POPL = OPL - 1
If DIS(OPL) = NEWMIN And FDIS(OPL) > FDIS(POPL) Then
NEWMIN = DIS(OPL) - 0.1
ORD(ORV) = OPL
End If
If DIS(OPL) < NEWMIN Then
NEWMIN = DIS(OPL)
ORD(ORV) = OPL
End If
HPToNPL2:
NEXT OPL
DIS(ORD(ORV)) = 2000000: 'key step
HPToNPL3:
NEXT ORV
'-------------------------------------------------
'Paint colors and draw framing lines
NUM = 1800
FOR ORT = 7998 TO 1 STEP -1
IF T1(ORT) = 0 AND T2(ORT) = 0 AND B1(ORT) = 0 AND B2(ORT) = 0 THEN GOTO HPToNPL4
GOSUB AUTODIRDRAW
IF AUTOFRM1(ORD(ORT)) = 0 AND AUTOFRM2(ORD(ORT)) = 0 THEN GOTO HPToNPL4
COL = COLR(ORD(ORT)) + 1
IF AUTOFRM1(ORD(ORT)) = 0 AND AUTOFRM2(ORD(ORT)) > 0 THEN GOTO HPToFLIP2
IF AUTOFRM1(ORD(ORT)) > 0 AND AUTOFRM2(ORD(ORT)) = 0 THEN GOTO HPToFLIP1
IF AUTOFRM1(ORD(ORT)) > 0 AND AUTOFRM2(ORD(ORT)) > 0 THEN REPEAT = 1: GOTO HPToFLIP1
HPToFLIP1:
T1 = T1(ORD(ORT)): T2 = T2(ORD(ORT)): B1 = B1(ORD(ORT)): B2 = B2(ORD(ORT)):
NR = AUTOFRM1(ORD(ORT)): GOTO HPToFRAMEIT
HPToFLIP2:
T1 = T1(ORD(ORT)): T2 = B1(ORD(ORT)): B1 = T2(ORD(ORT)): B2 = B2(ORD(ORT)):
NR = AUTOFRM2(ORD(ORT)): GOTO HPToFRAMEIT
HPToNPL4:
NEXT ORT
IF MACROSWITCH = 3 THEN GOTO MACROAMOD
GOTO ENHANCE
'Subs
'----------------------------------------------------
HPToFRAMEIT:
GB = 11
HPTo3300 : COLOR COL
LINE (GY(T2), GX(T2))-(GY(B2), GX(B2))
FL(GB) = 8001: LL(GB) = 8000 + NR
LA = 8000: INS = -1
FOR TI = 8001 TO (8000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(T1) + ((INS / (NR)) * (X(T2) - X(T1)))
Y(TI) = Y(T1) + ((INS / (NR)) * (Y(T2) - Y(T1)))
Z(TI) = Z(T1) + ((INS / (NR)) * (Z(T2) - Z(T1)))
FP(LA) = TI
NEXT TI
LA = 8000: INS = -1
FOR BI = (8001 + NR) TO (8000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(B1) + ((INS / (NR)) * (X(B2) - X(B1)))
Y(BI) = Y(B1) + ((INS / (NR)) * (Y(B2) - Y(B1)))
Z(BI) = Z(B1) + ((INS / (NR)) * (Z(B2) - Z(B1)))
SP(LA) = BI
NEXT BI
HPTo1040 : 'calculator kernel
FOR LN = FL(GB) TO LL(GB)
HPTo1045 : INC = 299
HPTo1050 : IF DT = 1 THEN DT = 0: G = SP(LN): GOTO HPTo1090
G = FP(LN): DT = 1
HPTo1070 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO HPTo3070
IF DT = 1 THEN GOTO HPTo1100
HPTo1090 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO HPTo3120
HPTo1100 :
GOSUB CALCSUB
HPTo1200 :
IF DT = 1 THEN X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GOTO HPTo1050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
HPTo1250 :
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 510 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 510 - VSH
HPTo1280 :
LINE (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN)))
HPTo1290 : NEXT LN
IF REPEAT = 1 THEN REPEAT = 0: GOTO HPToFLIP2
GOTO HPToNPL4
'------------------------------------------
HPTo3070 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999: GOTO HPTo1290
X(G) = ((INC / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GOTO HPTo1070
HPTo3120 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999: GOTO HPTo1290
X(G) = ((INC / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GOTO HPTo1090
'FOR DLY = 1 TO 200000
'NEXT DLY
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' P3-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
P3MOD:
COLOR K1
'------------------------------------------------
'Read distance to average point for each plane
FOR DPL = 1 TO 7998
IF T1(DPL) = 0 AND T2(DPL) = 0 AND B1(DPL) = 0 AND B2(DPL) = 0 THEN GOTO HPAoNPL
DIS1(DPL) = ((A - X(T1(DPL))) ^ 2 + (B - Y(T1(DPL))) ^ 2 + (C - Z(T1(DPL))) ^ 2) ^ .5
DIS2(DPL) = ((A - X(B1(DPL))) ^ 2 + (B - Y(B1(DPL))) ^ 2 + (C - Z(B1(DPL))) ^ 2) ^ .5
DIS3(DPL) = ((A - X(T2(DPL))) ^ 2 + (B - Y(T2(DPL))) ^ 2 + (C - Z(T2(DPL))) ^ 2) ^ .5
DIS4(DPL) = ((A - X(B2(DPL))) ^ 2 + (B - Y(B2(DPL))) ^ 2 + (C - Z(B2(DPL))) ^ 2) ^ .5
DIS(DPL) = (DIS1(DPL) + DIS2(DPL) + DIS3(DPL) + DIS4(DPL)) / 4
HPAoNPL:
NEXT DPL
'-------------------------------------------------
'Sort planes
FOR ORV = 1 TO 7998
IF T1(ORV) = 0 AND T2(ORV) = 0 AND B1(ORV) = 0 AND B2(ORV) = 0 THEN GOTO HPAoNPL3
NEWMAX = 1
FOR OPL = 1 TO 7998
IF T1(OPL) = 0 AND T2(OPL) = 0 AND B1(OPL) = 0 AND B2(OPL) = 0 THEN GOTO HPAoNPL2
IF DIS(OPL) > NEWMAX THEN
NEWMAX = DIS(OPL)
ORD(ORV) = OPL
END IF
HPAoNPL2:
NEXT OPL
DIS(ORD(ORV)) = 0: 'key step
HPAoNPL3:
NEXT ORV
'-------------------------------------------------
'Paint colors and draw framing lines
NUM = 1800
FOR ORT = 1 TO 7998
IF T1(ORT) = 0 AND T2(ORT) = 0 AND B1(ORT) = 0 AND B2(ORT) = 0 THEN GOTO HPAoNPL4
GOSUB AUTODIRDRAW
IF AUTOFRM1(ORD(ORT)) = 0 AND AUTOFRM2(ORD(ORT)) = 0 THEN GOTO HPAoNPL4
COL = COLR(ORD(ORT)) + 1
IF AUTOFRM1(ORD(ORT)) = 0 AND AUTOFRM2(ORD(ORT)) > 0 THEN GOTO HPAoFLIP2
IF AUTOFRM1(ORD(ORT)) > 0 AND AUTOFRM2(ORD(ORT)) = 0 THEN GOTO HPAoFLIP1
IF AUTOFRM1(ORD(ORT)) > 0 AND AUTOFRM2(ORD(ORT)) > 0 THEN REPEAT = 1: GOTO HPAoFLIP1
HPAoFLIP1:
T1 = T1(ORD(ORT)): T2 = T2(ORD(ORT)): B1 = B1(ORD(ORT)): B2 = B2(ORD(ORT)):
NR = AUTOFRM1(ORD(ORT)): GOTO HPAoFRAMEIT
HPAoFLIP2:
T1 = T1(ORD(ORT)): T2 = B1(ORD(ORT)): B1 = T2(ORD(ORT)): B2 = B2(ORD(ORT)):
NR = AUTOFRM2(ORD(ORT)): GOTO HPAoFRAMEIT
HPAoNPL4:
NEXT ORT
IF MACROSWITCH = 3 THEN GOTO MACROAMOD
GOTO ENHANCE
'Subs
'----------------------------------------------------
HPAoFRAMEIT:
GB = 11
HPAo3300 : COLOR COL
LINE (GY(T2), GX(T2))-(GY(B2), GX(B2))
FL(GB) = 8001: LL(GB) = 8000 + NR
LA = 8000: INS = -1
FOR TI = 8001 TO (8000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(T1) + ((INS / (NR)) * (X(T2) - X(T1)))
Y(TI) = Y(T1) + ((INS / (NR)) * (Y(T2) - Y(T1)))
Z(TI) = Z(T1) + ((INS / (NR)) * (Z(T2) - Z(T1)))
FP(LA) = TI
NEXT TI
LA = 8000: INS = -1
FOR BI = (8001 + NR) TO (8000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(B1) + ((INS / (NR)) * (X(B2) - X(B1)))
Y(BI) = Y(B1) + ((INS / (NR)) * (Y(B2) - Y(B1)))
Z(BI) = Z(B1) + ((INS / (NR)) * (Z(B2) - Z(B1)))
SP(LA) = BI
NEXT BI
HPAo1040 : 'calculator kernel
FOR LN = FL(GB) TO LL(GB)
HPAo1045 : INC = 299
HPAo1050 : IF DT = 1 THEN DT = 0: G = SP(LN): GOTO HPAo1090
G = FP(LN): DT = 1
HPAo1070 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO HPAo3070
IF DT = 1 THEN GOTO HPAo1100
HPAo1090 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO HPAo3120
HPAo1100 :
GOSUB CALCSUB
HPAo1200 :
IF DT = 1 THEN X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GOTO HPAo1050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
HPAo1250 :
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 510 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 510 - VSH
HPAo1280 :
LINE (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN)))
HPAo1290 : NEXT LN
IF REPEAT = 1 THEN REPEAT = 0: GOTO HPAoFLIP2
GOTO HPAoNPL4
'------------------------------------------
HPAo3070 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999: GOTO HPAo1290
X(G) = ((INC / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GOTO HPAo1070
HPAo3120 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999: GOTO HPAo1290
X(G) = ((INC / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GOTO HPAo1090
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' P2-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
P2MOD:
COLOR K1
'------------------------------------------------
'Read distance to farthest point for each plane
FOR DPL = 1 TO 7998
IF T1(DPL) = 0 AND T2(DPL) = 0 AND B1(DPL) = 0 AND B2(DPL) = 0 THEN GOTO HPFoNPL
DIS1(DPL) = ((A - X(T1(DPL))) ^ 2 + (B - Y(T1(DPL))) ^ 2 + (C - Z(T1(DPL))) ^ 2) ^ 0.5
DIS2(DPL) = ((A - X(B1(DPL))) ^ 2 + (B - Y(B1(DPL))) ^ 2 + (C - Z(B1(DPL))) ^ 2) ^ 0.5
DIS3(DPL) = ((A - X(T2(DPL))) ^ 2 + (B - Y(T2(DPL))) ^ 2 + (C - Z(T2(DPL))) ^ 2) ^ 0.5
DIS4(DPL) = ((A - X(B2(DPL))) ^ 2 + (B - Y(B2(DPL))) ^ 2 + (C - Z(B2(DPL))) ^ 2) ^ 0.5
NDIS1(DPL) = ((A - X(T1(DPL))) ^ 2 + (B - Y(T1(DPL))) ^ 2 + (C - Z(T1(DPL))) ^ 2) ^ 0.5
NDIS2(DPL) = ((A - X(B1(DPL))) ^ 2 + (B - Y(B1(DPL))) ^ 2 + (C - Z(B1(DPL))) ^ 2) ^ 0.5
NDIS3(DPL) = ((A - X(T2(DPL))) ^ 2 + (B - Y(T2(DPL))) ^ 2 + (C - Z(T2(DPL))) ^ 2) ^ 0.5
NDIS4(DPL) = ((A - X(B2(DPL))) ^ 2 + (B - Y(B2(DPL))) ^ 2 + (C - Z(B2(DPL))) ^ 2) ^ 0.5
DIS(DPL) = DIS1(DPL)
If DIS2(DPL) > DIS(DPL) Then DIS(DPL) = DIS2(DPL)
If DIS3(DPL) > DIS(DPL) Then DIS(DPL) = DIS3(DPL)
If DIS4(DPL) > DIS(DPL) Then DIS(DPL) = DIS4(DPL)
NDIS(DPL) = NDIS1(DPL)
If NDIS2(DPL) > NDIS(DPL) Then NDIS(DPL) = NDIS2(DPL)
If NDIS3(DPL) > NDIS(DPL) Then NDIS(DPL) = NDIS3(DPL)
If NDIS4(DPL) > NDIS(DPL) Then NDIS(DPL) = NDIS4(DPL)
HPFoNPL:
NEXT DPL
'-------------------------------------------------
'Sort planes
FOR ORV = 1 TO 7998
IF T1(ORV) = 0 AND T2(ORV) = 0 AND B1(ORV) = 0 AND B2(ORV) = 0 THEN GOTO HPFoNPL3
NEWMAX = 0.1
FOR OPL = 1 TO 7998
IF T1(OPL) = 0 AND T2(OPL) = 0 AND B1(OPL) = 0 AND B2(OPL) = 0 THEN GOTO HPFoNPL2
POPL = OPL - 1
If DIS(OPL) = NEWMAX And NDIS(OPL) > NDIS(POPL) Then
NEWMAX = DIS(OPL) + 0.1
ORD(ORV) = OPL
End If
If DIS(OPL) > NEWMAX Then
NEWMAX = DIS(OPL)
ORD(ORV) = OPL
End If
HPFoNPL2:
NEXT OPL
DIS(ORD(ORV)) = 0: 'key step
HPFoNPL3:
NEXT ORV
'-------------------------------------------------
'Paint colors and draw framing lines
NUM = 1800
FOR ORT = 1 TO 7998
IF T1(ORT) = 0 AND T2(ORT) = 0 AND B1(ORT) = 0 AND B2(ORT) = 0 THEN GOTO HPFoNPL4
GOSUB AUTODIRDRAW
IF AUTOFRM1(ORD(ORT)) = 0 AND AUTOFRM2(ORD(ORT)) = 0 THEN GOTO HPFoNPL4
COL = COLR(ORD(ORT)) + 1
IF AUTOFRM1(ORD(ORT)) = 0 AND AUTOFRM2(ORD(ORT)) > 0 THEN GOTO HPFoFLIP2
IF AUTOFRM1(ORD(ORT)) > 0 AND AUTOFRM2(ORD(ORT)) = 0 THEN GOTO HPFoFLIP1
IF AUTOFRM1(ORD(ORT)) > 0 AND AUTOFRM2(ORD(ORT)) > 0 THEN REPEAT = 1: GOTO HPFoFLIP1
HPFoFLIP1:
T1 = T1(ORD(ORT)): T2 = T2(ORD(ORT)): B1 = B1(ORD(ORT)): B2 = B2(ORD(ORT)):
NR = AUTOFRM1(ORD(ORT)): GOTO HPFoFRAMEIT
HPFoFLIP2:
T1 = T1(ORD(ORT)): T2 = B1(ORD(ORT)): B1 = T2(ORD(ORT)): B2 = B2(ORD(ORT)):
NR = AUTOFRM2(ORD(ORT)): GOTO HPFoFRAMEIT
HPFoNPL4:
NEXT ORT
IF MACROSWITCH = 3 THEN GOTO MACROAMOD
GOTO ENHANCE
'Subs
'----------------------------------------------------
HPFoFRAMEIT:
GB = 11
HPFo3300 : COLOR COL
LINE (GY(T2), GX(T2))-(GY(B2), GX(B2))
FL(GB) = 8001: LL(GB) = 8000 + NR
LA = 8000: INS = -1
FOR TI = 8001 TO (8000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(T1) + ((INS / (NR)) * (X(T2) - X(T1)))
Y(TI) = Y(T1) + ((INS / (NR)) * (Y(T2) - Y(T1)))
Z(TI) = Z(T1) + ((INS / (NR)) * (Z(T2) - Z(T1)))
FP(LA) = TI
NEXT TI
LA = 8000: INS = -1
FOR BI = (8001 + NR) TO (8000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(B1) + ((INS / (NR)) * (X(B2) - X(B1)))
Y(BI) = Y(B1) + ((INS / (NR)) * (Y(B2) - Y(B1)))
Z(BI) = Z(B1) + ((INS / (NR)) * (Z(B2) - Z(B1)))
SP(LA) = BI
NEXT BI
HPFo1040 : 'calculator kernel
FOR LN = FL(GB) TO LL(GB)
HPFo1045 : INC = 299
HPFo1050 : IF DT = 1 THEN DT = 0: G = SP(LN): GOTO HPFo1090
G = FP(LN): DT = 1
HPFo1070 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO HPFo3070
IF DT = 1 THEN GOTO HPFo1100
HPFo1090 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO HPFo3120
HPFo1100 :
GOSUB CALCSUB
HPFo1200 :
IF DT = 1 THEN X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GOTO HPFo1050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
HPFo1250 :
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 510 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 510 - VSH
HPFo1280 :
LINE (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN)))
HPFo1290 : NEXT LN
IF REPEAT = 1 THEN REPEAT = 0: GOTO HPFoFLIP2
GOTO HPFoNPL4
'------------------------------------------
HPFo3070 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999: GOTO HPFo1290
X(G) = ((INC / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GOTO HPFo1070
HPFo3120 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999: GOTO HPFo1290
X(G) = ((INC / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GOTO HPFo1090
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' P-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
PMOD:
'Paint colors and draw framing lines
NUM = 1800
LOCATE 111, 172
INPUT "Plane number ";PL
LOCATE 111, 172
PRINT " "
IF DIR(PL) = 5 THEN TDIR(PL) = 5
IF DIR(PL) = 6 THEN TDIR(PL) = 6
IF ROTAT(PL) = 0 AND DIR(PL) = 1 THEN TDIR(PL) = 1
IF ROTAT(PL) = 0 AND DIR(PL) = 2 THEN TDIR(PL) = 2
IF ROTAT(PL) = 0 AND DIR(PL) = 3 THEN TDIR(PL) = 3
IF ROTAT(PL) = 0 AND DIR(PL) = 4 THEN TDIR(PL) = 4
IF ROTAT(PL) = 1 AND DIR(PL) = 1 THEN TDIR(PL) = 4
IF ROTAT(PL) = 1 AND DIR(PL) = 2 THEN TDIR(PL) = 1
IF ROTAT(PL) = 1 AND DIR(PL) = 3 THEN TDIR(PL) = 2
IF ROTAT(PL) = 1 AND DIR(PL) = 4 THEN TDIR(PL) = 3
IF ROTAT(PL) = 2 AND DIR(PL) = 1 THEN TDIR(PL) = 3
IF ROTAT(PL) = 2 AND DIR(PL) = 2 THEN TDIR(PL) = 4
IF ROTAT(PL) = 2 AND DIR(PL) = 3 THEN TDIR(PL) = 1
IF ROTAT(PL) = 2 AND DIR(PL) = 4 THEN TDIR(PL) = 2
IF ROTAT(PL) = 3 AND DIR(PL) = 1 THEN TDIR(PL) = 2
IF ROTAT(PL) = 3 AND DIR(PL) = 2 THEN TDIR(PL) = 3
IF ROTAT(PL) = 3 AND DIR(PL) = 3 THEN TDIR(PL) = 4
IF ROTAT(PL) = 3 AND DIR(PL) = 4 THEN TDIR(PL) = 1
IF DIR(PL) = 6 OR DIR(PL) = 5 THEN
COLR(PL) = COLR(PL) + 1
GOTO CONTCOL
END IF
IF PL < 2001 THEN
COLR(PL) = COLR(PL) - 1
END IF
CONTCOL :
IF TDIR(PL) = LIGHT THEN COLR(PL) = COLR(PL) - 1
IF TDIR(PL) = DARKK THEN COLR(PL) = COLR(PL) + 1
COLOR COLR(PL)
FOR INS = 0 TO NUM
GYT = GY(T1(PL)) + ((INS / (NUM)) * (GY(T2(PL)) - GY(T1(PL))))
GXT = GX(T1(PL)) + ((INS / (NUM)) * (GX(T2(PL)) - GX(T1(PL))))
GYB = GY(B1(PL)) + ((INS / (NUM)) * (GY(B2(PL)) - GY(B1(PL))))
GXB = GX(B1(PL)) + ((INS / (NUM)) * (GX(B2(PL)) - GX(B1(PL))))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
FOR INS = 0 TO NUM
GYT = GY(T1(PL)) + ((INS / (NUM)) * (GY(B1(PL)) - GY(T1(PL))))
GXT = GX(T1(PL)) + ((INS / (NUM)) * (GX(B1(PL)) - GX(T1(PL))))
GYB = GY(T2(PL)) + ((INS / (NUM)) * (GY(B2(PL)) - GY(T2(PL))))
GXB = GX(T2(PL)) + ((INS / (NUM)) * (GX(B2(PL)) - GX(T2(PL))))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
'----------------
IF AUTOFRM1(PL) = 0 AND AUTOFRM2(PL) = 0 THEN GOTO PLPoNPL4
COL = COLR(PL) + 1
IF AUTOFRM1(PL) = 0 AND AUTOFRM2(PL) > 0 THEN GOTO PLPoFLIP2
IF AUTOFRM1(PL) > 0 AND AUTOFRM2(PL) = 0 THEN GOTO PLPoFLIP1
IF AUTOFRM1(PL) > 0 AND AUTOFRM2(PL) > 0 THEN REPEAT = 1: GOTO PLPoFLIP1
PLPoFLIP1:
T1 = T1(PL): T2 = T2(PL): B1 = B1(PL): B2 = B2(PL): NR = AUTOFRM1(PL):
GOTO PLPoFRAMEIT
PLPoFLIP2:
T1 = T1(PL): T2 = B1(PL): B1 = T2(PL): B2 = B2(PL): NR = AUTOFRM2(PL):
GOTO PLPoFRAMEIT
PLPoNPL4:
GOTO ENHANCE
'Subs
'----------------------------------------------------
PLPoFRAMEIT:
GB = 11
PLPo3300 : COLOR COL
LINE (GY(T2), GX(T2))-(GY(B2), GX(B2))
FL(GB) = 8001: LL(GB) = 8000 + NR
LA = 8000: INS = -1
FOR TI = 8001 TO (8000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(T1) + ((INS / (NR)) * (X(T2) - X(T1)))
Y(TI) = Y(T1) + ((INS / (NR)) * (Y(T2) - Y(T1)))
Z(TI) = Z(T1) + ((INS / (NR)) * (Z(T2) - Z(T1)))
FP(LA) = TI
NEXT TI
LA = 8000: INS = -1
FOR BI = (8001 + NR) TO (8000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(B1) + ((INS / (NR)) * (X(B2) - X(B1)))
Y(BI) = Y(B1) + ((INS / (NR)) * (Y(B2) - Y(B1)))
Z(BI) = Z(B1) + ((INS / (NR)) * (Z(B2) - Z(B1)))
SP(LA) = BI
NEXT BI
PLPo1040 : 'calculator kernel
FOR LN = FL(GB) TO LL(GB)
PLPo1045 : INC = 299
PLPo1050 : IF DT = 1 THEN DT = 0: G = SP(LN): GOTO PLPo1090
G = FP(LN): DT = 1
PLPo1070 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO PLPo3070
IF DT = 1 THEN GOTO PLPo1100
PLPo1090 :
IF ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
THEN GOTO PLPo3120
PLPo1100 :
GOSUB CALCSUB
PLPo1200 :
IF DT = 1 THEN X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GOTO PLPo1050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
PLPo1250 :
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 510 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 510 - VSH
PLPo1280 :
LINE (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN)))
PLPo1290 : NEXT LN
IF REPEAT = 1 THEN REPEAT = 0: GOTO PLPoFLIP2
GOTO PLPoNPL4
'------------------------------------------
PLPo3070 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999: GOTO PLPo1290
X(G) = ((INC / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GOTO PLPo1070
PLPo3120 :
INC = INC - 1
IF INC = 0 THEN INC = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999: GOTO PLPo1290
X(G) = ((INC / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((INC / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((INC / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GOTO PLPo1090
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' CX-BAS
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
CXBAS :
GOSUB WIPEVALUES
RL = 1: CIRC = 0: COUNT = 0
ON ERROR GOTO CXoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB CXoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
READATA = 3
GOTO MAIN
'========================================
'========================================
CXoREADDATA:
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K10
DO WHILE TIPE$ <> "DARKESTCOLOR:"
INPUT #2, TIPE$
LOOP
INPUT #2, DRKCOL
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
DO WHILE TIPE$ <> "CURVDATA:"
INPUT #2, TIPE$
LOOP
'================================
FOR RD = 1 TO 400 'up to 400 sections in accordance with DIM statements
INPUT #2, CURVPOINTS(RD)
INPUT #2, DEGB(RD), ARCB(RD), RADZB(RD), RADYB(RD)
INPUT #2, XB(RD), YB(RD), ZB(RD), LB(RD), INCB(RD), STREB(RD)
INPUT #2, DEGT(RD), ARCT(RD), RADZT(RD), RADYT(RD)
INPUT #2, XT(RD), YT(RD), ZT(RD), LT(RD), INCT(RD), STRET(RD)
IF CURVPOINTS(RD) = 999 THEN EXIT FOR
CURVEFINE(RD) = (CURVPOINTS(RD)) * .5
CURVINC(RD) = CURVEFINE(RD) - 1
PTPAIRS(RD) = CURVEFINE(RD) * 2
NP6 = NP6 + PTPAIRS(RD)
COUNT = COUNT + 1
NEXT RD
'points
FOR RD = 1 TO COUNT
'bottom
DEG1 = DEGB(RD): DEG2 = DEG1 + ARCB(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LB(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
Z(CIRC) = (RADZB(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + ZB(RD)
Y(CIRC) = (RADYB(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + YB(RD)
IF INCB(RD) = 0 THEN X(CIRC) = XB(RD): GOTO CXo10
XDEG = XDEG - INCB(RD)
XRAD = STREB(RD) * (COS((XDEG * 3.14159) / 180))
X(CIRC) = (-1 * (XRAD)) + XB(RD)
CXo10:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
'top
DEG1 = DEGT(RD): DEG2 = DEG1 + ARCT(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LT(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
Z(CIRC) = (RADZT(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + ZT(RD)
Y(CIRC) = (RADYT(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + YT(RD)
IF INCT(RD) = 0 THEN X(CIRC) = XT(RD): GOTO CXo20
XDEG = XDEG - INCT(RD)
XRAD = STRET(RD) * (COS((XDEG * 3.14159) / 180))
X(CIRC) = (-1 * (XRAD)) + XT(RD)
CXo20:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
NEXT RD
GOSUB CONNECT
RL = RL - 2
NL10 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9)
RETURN
'-----------------------------------------------
CXoERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 3
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' CY-BAS
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
CYBAS :
GOSUB WIPEVALUES
RL = 1: CIRC = 0: COUNT = 0
ON ERROR GOTO CYoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB CYoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
READATA = 3
GOTO MAIN
'========================================
'========================================
CYoREADDATA:
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K10
DO WHILE TIPE$ <> "DARKESTCOLOR:"
INPUT #2, TIPE$
LOOP
INPUT #2, DRKCOL
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
DO WHILE TIPE$ <> "CURVDATA:"
INPUT #2, TIPE$
LOOP
'================================
FOR RD = 1 TO 400 'up to 400 sections in accordance with DIM statements
INPUT #2, CURVPOINTS(RD)
INPUT #2, DEGB(RD), ARCB(RD), RADXB(RD), RADZB(RD)
INPUT #2, XB(RD), YB(RD), ZB(RD), LB(RD), INCB(RD), STREB(RD)
INPUT #2, DEGT(RD), ARCT(RD), RADXT(RD), RADZT(RD)
INPUT #2, XT(RD), YT(RD), ZT(RD), LT(RD), INCT(RD), STRET(RD)
IF CURVPOINTS(RD) = 999 THEN EXIT FOR
CURVEFINE(RD) = (CURVPOINTS(RD)) * .5
CURVINC(RD) = CURVEFINE(RD) - 1
PTPAIRS(RD) = CURVEFINE(RD) * 2
NP6 = NP6 + PTPAIRS(RD)
COUNT = COUNT + 1
NEXT RD
'points
FOR RD = 1 TO COUNT
'bottom
DEG1 = DEGB(RD): DEG2 = DEG1 + ARCB(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LB(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
X(CIRC) = (RADXB(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + XB(RD)
Z(CIRC) = (RADZB(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + ZB(RD)
IF INCB(RD) = 0 THEN Y(CIRC) = YB(RD): GOTO CYo10
YDEG = YDEG - INCB(RD)
YRAD = STREB(RD) * (COS((YDEG * 3.14159) / 180))
Y(CIRC) = (-1 * (YRAD)) + YB(RD)
CYo10:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
'top
DEG1 = DEGT(RD): DEG2 = DEG1 + ARCT(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LT(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
X(CIRC) = (RADXT(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + XT(RD)
Z(CIRC) = (RADZT(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + ZT(RD)
IF INCT(RD) = 0 THEN Y(CIRC) = YT(RD): GOTO CYo20
YDEG = YDEG - INCT(RD)
YRAD = STRET(RD) * (COS((YDEG * 3.14159) / 180))
Y(CIRC) = (-1 * (YRAD)) + YT(RD)
CYo20:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
NEXT RD
GOSUB CONNECT
RL = RL - 2
NL10 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9)
RETURN
'--------------------------------------------------------
CYoERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 3
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' CZ-BAS
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
CZBAS :
GOSUB WIPEVALUES
RL = 1: CIRC = 0: COUNT = 0
ON ERROR GOTO CZoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB CZoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
READATA = 3
GOTO MAIN
'========================================
'========================================
CZoREADDATA:
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K10
DO WHILE TIPE$ <> "DARKESTCOLOR:"
INPUT #2, TIPE$
LOOP
INPUT #2, DRKCOL
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
DO WHILE TIPE$ <> "CURVDATA:"
INPUT #2, TIPE$
LOOP
'================================
FOR RD = 1 TO 400 'up to 400 sections in accordance with DIM statements
INPUT #2, CURVPOINTS(RD)
INPUT #2, DEGB(RD), ARCB(RD), RADXB(RD), RADYB(RD)
INPUT #2, XB(RD), YB(RD), ZB(RD), LB(RD), INCB(RD), STREB(RD)
INPUT #2, DEGT(RD), ARCT(RD), RADXT(RD), RADYT(RD)
INPUT #2, XT(RD), YT(RD), ZT(RD), LT(RD), INCT(RD), STRET(RD)
IF CURVPOINTS(RD) = 999 THEN EXIT FOR
CURVEFINE(RD) = (CURVPOINTS(RD)) * .5
CURVINC(RD) = CURVEFINE(RD) - 1
PTPAIRS(RD) = CURVEFINE(RD) * 2
NP6 = NP6 + PTPAIRS(RD)
COUNT = COUNT + 1
NEXT RD
'points
FOR RD = 1 TO COUNT
'bottom
DEG1 = DEGB(RD): DEG2 = DEG1 + ARCB(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LB(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
X(CIRC) = (RADXB(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + XB(RD)
Y(CIRC) = (RADYB(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + YB(RD)
IF INCB(RD) = 0 THEN Z(CIRC) = ZB(RD): GOTO CZo10
ZDEG = ZDEG - INCB(RD)
ZRAD = STREB(RD) * (COS((ZDEG * 3.14159) / 180))
Z(CIRC) = (-1 * (ZRAD)) + ZB(RD)
CZo10:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
'top
DEG1 = DEGT(RD): DEG2 = DEG1 + ARCT(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LT(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
X(CIRC) = (RADXT(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + XT(RD)
Y(CIRC) = (RADYT(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + YT(RD)
IF INCT(RD) = 0 THEN Z(CIRC) = ZT(RD): GOTO CZo20
ZDEG = ZDEG - INCT(RD)
ZRAD = STRET(RD) * (COS((ZDEG * 3.14159) / 180))
Z(CIRC) = (-1 * (ZRAD)) + ZT(RD)
CZo20:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
NEXT RD
GOSUB CONNECT
RL = RL - 2
NL10 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9)
RETURN
'---------------------------------------------------------
CZoERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 3
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' MACRO-A-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
MACROAMOD:
rm = 0
rch = 0
rf = 0
rml = 0
rp = 0
ON ERROR GOTO McAoErr
IF MACROSWITCH = 3 THEN MACROSWITCH = 0: GOTO McAoREADSJK
IF MACROSWITCH = 5 THEN MACROSWITCH = 0: GOTO McAo50
IF MACROSWITCH = 6 THEN MACROSWITCH = 0: GOTO McAo60
IF MACROSWITCH = 7 THEN MACROSWITCH = 0: GOTO McAo70
IF MACROSWITCH = 8 THEN MACROSWITCH = 0: GOTO McAo80
IF MACROSWITCH = 4 THEN MACROSWITCH = 0: GOTO McAoREADLINE
IF MACROSWITCH = 9 THEN MACROSWITCH = 0: GOTO McAo90
MACROSWITCH = 0
Open "data\" + "macro-" + MA$ + ".txt" For Input As #1
Do While TIPE$ <> "MACROGROUPS:"
Input #1, TIPE$
Loop
Input #1, macs, macp
McAo10:
Input #1, delineator$
Input #1, grouptype$
Input #1, groupname$
If delineator$ = "GROUPEND" Then GoTo amacstop
McAoREADAUTO:
S2$ = "Hide"
Input #1, delineator$, htype
If htype = 0 Then GoTo McAoREADSJK
GoTo McAohidmacro
McAoREADSJK:
S2$ = "Hide"
Input #1, delineator$
For rdata = 1 To 1000
Input #1, vsplane(rdata), veplane(rdata)
Input #1, vplaneinc(rdata), vscolor(rdata), vcolorinc(rdata)
If vsplane(rdata) = 0 And rdata = 1 Then GoTo McAoREADPLANE
If vsplane(rdata) = 0 Then GoTo McAosmacro
Next rdata
McAoREADPLANE:
S2$ = "Hide"
Input #1, delineator$
For rdata = 1 To 1000
Input #1, CPNM(rdata), CVCOL(rdata)
If CPNM(rdata) = 0 And rdata = 1 Then GoTo McAoREADCROSS
If CPNM(rdata) = 0 Then GoTo McAopmacro
Next rdata
McAoREADCROSS:
S2$ = "Hide"
Input #1, delineator$
For rdata = 1 To 1000
Input #1, CVT1(rdata), CVB1(rdata), CVT2(rdata)
Input #1, CVB2(rdata), CNR(rdata), CVCOL(rdata)
If CVT1(rdata) = 0 And rdata = 1 Then GoTo McAoREADFRAME
If CVT1(rdata) = 0 Then GoTo McAochmacro
Next rdata
McAoREADFRAME:
S2$ = "Hide"
Input #1, delineator$
For rdata = 1 To 1000
Input #1, CVT1(rdata), CVB1(rdata), CVT2(rdata)
Input #1, CVB2(rdata), CNR(rdata), CVCOL(rdata)
If CVT1(rdata) = 0 And rdata = 1 Then GoTo McAoREADGRUP
If CVT1(rdata) = 0 Then GoTo McAofmacro
Next rdata
McAoREADGRUP:
S2$ = "Hide"
Input #1, delineator$, grup
If grup = 0 Then GoTo McAoREADLINE
GoTo McAogrupmacro
McAoREADLINE:
S2$ = "Hide"
Input #1, delineator$
For rdata = 1 To 1000
Input #1, CVP1(rdata), CVP2(rdata), CVCOL(rdata)
If CVP1(rdata) = 0 And rdata = 1 Then GoTo McAoREADNEXT
If CVP1(rdata) = 0 Then GoTo McAolmacro
Next rdata
McAoREADNEXT:
GoTo McAo10
amacstop:
Close #1
GOTO ENHANCE
'=================================================
'=================================================
'=================================================
' auto
'=================================================
'=================================================
'=================================================
McAohidmacro:
GRPSWI = htype
MACROSWITCH = 1
T$ = grouptype$
G$ = groupname$
GOTO ENHANCE
'=================================================
'=================================================
'=================================================
' sk sj
'=================================================
'=================================================
'=================================================
McAosmacro:
MACROSWITCH = 5
T$ = grouptype$
G$ = groupname$
NUM = macs
GS = 1: READSWITCH = 1
IF T$ = "S" THEN GOTO SBAS
IF T$ = "s" THEN GOTO SBAS
IF T$ = "CX" THEN GOTO CXBAS
IF T$ = "CY" THEN GOTO CYBAS
IF T$ = "CZ" THEN GOTO CZBAS
IF T$ = "MX" THEN GOTO MXBAS
IF T$ = "MY" THEN GOTO MYBAS
IF T$ = "MZ" THEN GOTO MZBAS
IF T$ = "AX" THEN GOTO AXBAS
IF T$ = "AY" THEN GOTO AYBAS
IF T$ = "AZ" THEN GOTO AZBAS
IF T$ = "cx" THEN GOTO CXBAS
IF T$ = "cy" THEN GOTO CYBAS
IF T$ = "cz" THEN GOTO CZBAS
IF T$ = "mx" THEN GOTO MXBAS
IF T$ = "my" THEN GOTO MYBAS
IF T$ = "mz" THEN GOTO MZBAS
IF T$ = "ax" THEN GOTO AXBAS
IF T$ = "ay" THEN GOTO AYBAS
IF T$ = "az" THEN GOTO AZBAS
IF T$ = "x8" THEN GOTO X8BAS
IF T$ = "y8" THEN GOTO Y8BAS
IF T$ = "z8" THEN GOTO Z8BAS
IF T$ = "X8" THEN GOTO X8BAS
IF T$ = "Y8" THEN GOTO Y8BAS
IF T$ = "Z8" THEN GOTO Z8BAS
McAo50:
rm = rm + 1
If rm = rdata Then rm = 0: GoTo McAoREADPLANE
SK1 = vsplane(rm)
SK2 = veplane(rm)
SKINC = vplaneinc(rm)
PLNU = SK1 - SKINC
VCOL = vscolor(rm)
VCOL = VCOL - 1
VCOLINC = vcolorinc(rm)
If VCOLINC < 0 Then VCOL = VCOL + 2
If VCOLINC = 0 Then VCOL = VCOL + 1
McAo55:
PLNU = PLNU + SKINC
If PLNU > SK2 Then GoTo McAo50
VT1 = T1(PLNU)
VT2 = T2(PLNU)
VB1 = B1(PLNU)
VB2 = B2(PLNU)
VCOL = VCOL + VCOLINC
If VCOL = 0 Then VCOL = 1
If VCOL = 256 Then VCOL = 255
COLOR VCOL
For INS = 0 To NUM
GYT = GY(VT1) + ((INS / (NUM)) * (GY(VT2) - GY(VT1)))
GXT = GX(VT1) + ((INS / (NUM)) * (GX(VT2) - GX(VT1)))
GYB = GY(VB1) + ((INS / (NUM)) * (GY(VB2) - GY(VB1)))
GXB = GX(VB1) + ((INS / (NUM)) * (GX(VB2) - GX(VB1)))
LINE (GYT, GXT)-(GYB, GXB)
Next INS
For INS = 0 To NUM
GYT = GY(VT1) + ((INS / (NUM)) * (GY(VB1) - GY(VT1)))
GXT = GX(VT1) + ((INS / (NUM)) * (GX(VB1) - GX(VT1)))
GYB = GY(VT2) + ((INS / (NUM)) * (GY(VB2) - GY(VT2)))
GXB = GX(VT2) + ((INS / (NUM)) * (GX(VB2) - GX(VT2)))
LINE (GYT, GXT)-(GYB, GXB)
Next INS
GoTo McAo55
'=================================================
'=================================================
'=================================================
' plane
'=================================================
'=================================================
'=================================================
McAopmacro:
MACROSWITCH = 6
T$ = grouptype$
G$ = groupname$
NUM8 = macp
GS = 1: READSWITCH = 1
IF T$ = "S" THEN GOTO SBAS
IF T$ = "s" THEN GOTO SBAS
IF T$ = "CX" THEN GOTO CXBAS
IF T$ = "CY" THEN GOTO CYBAS
IF T$ = "CZ" THEN GOTO CZBAS
IF T$ = "MX" THEN GOTO MXBAS
IF T$ = "MY" THEN GOTO MYBAS
IF T$ = "MZ" THEN GOTO MZBAS
IF T$ = "AX" THEN GOTO AXBAS
IF T$ = "AY" THEN GOTO AYBAS
IF T$ = "AZ" THEN GOTO AZBAS
IF T$ = "cx" THEN GOTO CXBAS
IF T$ = "cy" THEN GOTO CYBAS
IF T$ = "cz" THEN GOTO CZBAS
IF T$ = "mx" THEN GOTO MXBAS
IF T$ = "my" THEN GOTO MYBAS
IF T$ = "mz" THEN GOTO MZBAS
IF T$ = "ax" THEN GOTO AXBAS
IF T$ = "ay" THEN GOTO AYBAS
IF T$ = "az" THEN GOTO AZBAS
IF T$ = "x8" THEN GOTO X8BAS
IF T$ = "y8" THEN GOTO Y8BAS
IF T$ = "z8" THEN GOTO Z8BAS
IF T$ = "X8" THEN GOTO X8BAS
IF T$ = "Y8" THEN GOTO Y8BAS
IF T$ = "Z8" THEN GOTO Z8BAS
McAo60:
rp = rp + 1
If rp = rdata Then rp = 0: GoTo McAoREADCROSS
COLOR CVCOL(rp)
VT1 = T1(CPNM(rp)): VT2 = B1(CPNM(rp)): VB1 = T2(CPNM(rp)): VB2 = B2(CPNM(rp))
For INS = 0 To NUM8
GYT = GY(VT1) + ((INS / (NUM8)) * (GY(VT2) - GY(VT1)))
GXT = GX(VT1) + ((INS / (NUM8)) * (GX(VT2) - GX(VT1)))
GYB = GY(VB1) + ((INS / (NUM8)) * (GY(VB2) - GY(VB1)))
GXB = GX(VB1) + ((INS / (NUM8)) * (GX(VB2) - GX(VB1)))
LINE (GYT, GXT)-(GYB, GXB)
Next INS
VT1 = T1(CPNM(rp)): VT2 = T2(CPNM(rp)): VB1 = B1(CPNM(rp)): VB2 = B2(CPNM(rp))
For INS = 0 To NUM8
GYT = GY(VT1) + ((INS / (NUM8)) * (GY(VT2) - GY(VT1)))
GXT = GX(VT1) + ((INS / (NUM8)) * (GX(VT2) - GX(VT1)))
GYB = GY(VB1) + ((INS / (NUM8)) * (GY(VB2) - GY(VB1)))
GXB = GX(VB1) + ((INS / (NUM8)) * (GX(VB2) - GX(VB1)))
LINE (GYT, GXT)-(GYB, GXB)
Next INS
GOTO McAo60
'=================================================
'=================================================
'=================================================
' cross hatch
'=================================================
'=================================================
'=================================================
McAochmacro:
MACROSWITCH = 7
T$ = grouptype$
G$ = groupname$
GS = 1: READSWITCH = 1
IF T$ = "S" THEN GOTO SBAS
IF T$ = "s" THEN GOTO SBAS
IF T$ = "CX" THEN GOTO CXBAS
IF T$ = "CY" THEN GOTO CYBAS
IF T$ = "CZ" THEN GOTO CZBAS
IF T$ = "MX" THEN GOTO MXBAS
IF T$ = "MY" THEN GOTO MYBAS
IF T$ = "MZ" THEN GOTO MZBAS
IF T$ = "AX" THEN GOTO AXBAS
IF T$ = "AY" THEN GOTO AYBAS
IF T$ = "AZ" THEN GOTO AZBAS
IF T$ = "cx" THEN GOTO CXBAS
IF T$ = "cy" THEN GOTO CYBAS
IF T$ = "cz" THEN GOTO CZBAS
IF T$ = "mx" THEN GOTO MXBAS
IF T$ = "my" THEN GOTO MYBAS
IF T$ = "mz" THEN GOTO MZBAS
IF T$ = "ax" THEN GOTO AXBAS
IF T$ = "ay" THEN GOTO AYBAS
IF T$ = "az" THEN GOTO AZBAS
IF T$ = "x8" THEN GOTO X8BAS
IF T$ = "y8" THEN GOTO Y8BAS
IF T$ = "z8" THEN GOTO Z8BAS
IF T$ = "X8" THEN GOTO X8BAS
IF T$ = "Y8" THEN GOTO Y8BAS
IF T$ = "Z8" THEN GOTO Z8BAS
McAo70 :
rch = rch + 1
If rch = rdata Then rch = 0: GoTo McAoREADFRAME
COLOR CVCOL(rch)
For INS = 0 To CNR(rch)
GYT = GY(CVT1(rch)) + ((INS / (CNR(rch))) * (GY(CVT2(rch)) - GY(CVT1(rch))))
GXT = GX(CVT1(rch)) + ((INS / (CNR(rch))) * (GX(CVT2(rch)) - GX(CVT1(rch))))
GYB = GY(CVB1(rch)) + ((INS / (CNR(rch))) * (GY(CVB2(rch)) - GY(CVB1(rch))))
GXB = GX(CVB1(rch)) + ((INS / (CNR(rch))) * (GX(CVB2(rch)) - GX(CVB1(rch))))
LINE (GYT, GXT)-(GYB, GXB)
Next INS
GOTO McAo70
'=================================================
'=================================================
'=================================================
' framing lines
'=================================================
'=================================================
'=================================================
McAofmacro:
MACROSWITCH = 8
T$ = grouptype$
G$ = groupname$
GS = 1: READSWITCH = 1
IF T$ = "S" THEN GOTO SBAS
IF T$ = "s" THEN GOTO SBAS
IF T$ = "CX" THEN GOTO CXBAS
IF T$ = "CY" THEN GOTO CYBAS
IF T$ = "CZ" THEN GOTO CZBAS
IF T$ = "MX" THEN GOTO MXBAS
IF T$ = "MY" THEN GOTO MYBAS
IF T$ = "MZ" THEN GOTO MZBAS
IF T$ = "AX" THEN GOTO AXBAS
IF T$ = "AY" THEN GOTO AYBAS
IF T$ = "AZ" THEN GOTO AZBAS
IF T$ = "cx" THEN GOTO CXBAS
IF T$ = "cy" THEN GOTO CYBAS
IF T$ = "cz" THEN GOTO CZBAS
IF T$ = "mx" THEN GOTO MXBAS
IF T$ = "my" THEN GOTO MYBAS
IF T$ = "mz" THEN GOTO MZBAS
IF T$ = "ax" THEN GOTO AXBAS
IF T$ = "ay" THEN GOTO AYBAS
IF T$ = "az" THEN GOTO AZBAS
IF T$ = "x8" THEN GOTO X8BAS
IF T$ = "y8" THEN GOTO Y8BAS
IF T$ = "z8" THEN GOTO Z8BAS
IF T$ = "X8" THEN GOTO X8BAS
IF T$ = "Y8" THEN GOTO Y8BAS
IF T$ = "Z8" THEN GOTO Z8BAS
McAo80:
rf = rf + 1
If rf = rdata Then rf = 0: GoTo McAoREADGRUP
COLOR CVCOL(rf)
GB = 11
LINE (GY(CVT2(rf)), GX(CVT2(rf)))-(GY(CVB2(rf)), GX(CVB2(rf)))
FL(GB) = 8001: LL(GB) = 8000 + CNR(rf)
LA = 8000: INS = -1
For TI = 8001 To (8000 + CNR(rf))
LA = LA + 1: INS = INS + 1
X(TI) = X(CVT1(rf)) + ((INS / (CNR(rf))) * (X(CVT2(rf)) - X(CVT1(rf))))
Y(TI) = Y(CVT1(rf)) + ((INS / (CNR(rf))) * (Y(CVT2(rf)) - Y(CVT1(rf))))
Z(TI) = Z(CVT1(rf)) + ((INS / (CNR(rf))) * (Z(CVT2(rf)) - Z(CVT1(rf))))
FP(LA) = TI
Next TI
LA = 8000: INS = -1
For BI = (8001 + CNR(rf)) To (8000 + CNR(rf) + CNR(rf))
LA = LA + 1: INS = INS + 1
X(BI) = X(CVB1(rf)) + ((INS / (CNR(rf))) * (X(CVB2(rf)) - X(CVB1(rf))))
Y(BI) = Y(CVB1(rf)) + ((INS / (CNR(rf))) * (Y(CVB2(rf)) - Y(CVB1(rf))))
Z(BI) = Z(CVB1(rf)) + ((INS / (CNR(rf))) * (Z(CVB2(rf)) - Z(CVB1(rf))))
SP(LA) = BI
Next BI
For RRRR = 8001 To (2 * (LL(GB)) - 8000)
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
7040 'calculator kernel
For LN = FL(GB) To LL(GB)
7045 inc = 299
7050 If DT = 1 Then DT = 0: G = SP(LN): GoTo 7090
G = FP(LN): DT = 1
7070:
If ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
Then GoTo 8070
If DT = 1 Then GoTo 7100
7090:
If ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
Then GoTo 8120
7100:
W = ((A * A) + (B * B) + (C * C) - (A * X(G)) - (B * Y(G)) - (C * Z(G)))
R(G) = (((A * I) * (A - X(G))) + (B * B * X(G)) + (C * C * X(G)) -
(B * X(G) * Y(G)) - (C * X(G) * Z(G)) + ((B * J) * (A - X(G))) +
((C * K) * (A - X(G))) - ((B * Y(G)) * (A - X(G))) - ((C * Z(G)) *
(A - X(G)))) / W
S(G) = (((B * J) * (B - Y(G))) + (A * A * Y(G)) + (C * C * Y(G)) -
(A * Y(G) * X(G)) - (C * Y(G) * Z(G)) + ((A * I) * (B - Y(G))) +
((C * K) * (B - Y(G))) - ((A * X(G)) * (B - Y(G))) - ((C * Z(G)) *
(B - Y(G)))) / W
T(G) = (((C * K) * (C - Z(G))) + (A * A * Z(G)) + (B * B * Z(G)) -
(A * Z(G) * X(G)) - (B * Z(G) * Y(G)) + ((A * I) * (C - Z(G))) +
((B * J) * (C - Z(G))) - ((A * X(G)) * (C - Z(G))) - ((B * Y(G)) *
(C - X(G)))) / W
U(G) = (((R(G) - L) ^ 2) + ((S(G) - M) ^ 2) + ((T(G) - N) ^ 2)) ^ 0.5
V(G) = (((R(G) - L) * (R(10001) - L)) + ((S(G) - M) * (S(10001) - M)) +
((T(G) - N) * (T(10001) - N))) / (U(G) * ((((R(10001) - L) ^ 2) +
((S(10001) - M) ^ 2) + ((T(10001) - N) ^ 2)) ^ 0.5))
XX(G) = U(G) * V(G)
If V(G) > 0.999 Or V(G) < -0.999 Then YY(G) = 0: GoTo 7200
YY(G) = U(G) * ((1 - ((V(G)) ^ 2)) ^ 0.5)
If ((L * S(G)) - (M * R(G))) < 0 Then YY(G) = (-1 * YY(G))
7200:
If DT = 1 Then X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GoTo 7050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
7250:
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 510 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 510 - VSH
7280:
LINE (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN)))
7290 Next LN
GoTo 8150
8070:
inc = inc - 1
If inc = 0 Then inc = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999: GoTo 7290
X(G) = ((inc / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((inc / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((inc / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GoTo 7070
8120:
inc = inc - 1
If inc = 0 Then inc = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999: GoTo 7290
X(G) = ((inc / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((inc / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((inc / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GoTo 7090
'---------------------------------
8150:
GOTO McAo80
'=================================================
'=================================================
'=================================================
' group show
'=================================================
'=================================================
'=================================================
McAogrupmacro:
MACROSWITCH = 4
T$ = grouptype$
G$ = groupname$
GS = 1
READSWITCH = 1 'bogus
S2$ = "Show"
S7 = 0
S4 = 0
AP = 0
ICHK = 0
S1 = 1
CHK = 1
DT = 0
IF T$ = "S" THEN GOTO SBAS
IF T$ = "s" THEN GOTO SBAS
IF T$ = "CX" THEN GOTO CXBAS
IF T$ = "CY" THEN GOTO CYBAS
IF T$ = "CZ" THEN GOTO CZBAS
IF T$ = "MX" THEN GOTO MXBAS
IF T$ = "MY" THEN GOTO MYBAS
IF T$ = "MZ" THEN GOTO MZBAS
IF T$ = "AX" THEN GOTO AXBAS
IF T$ = "AY" THEN GOTO AYBAS
IF T$ = "AZ" THEN GOTO AZBAS
IF T$ = "cx" THEN GOTO CXBAS
IF T$ = "cy" THEN GOTO CYBAS
IF T$ = "cz" THEN GOTO CZBAS
IF T$ = "mx" THEN GOTO MXBAS
IF T$ = "my" THEN GOTO MYBAS
IF T$ = "mz" THEN GOTO MZBAS
IF T$ = "ax" THEN GOTO AXBAS
IF T$ = "ay" THEN GOTO AYBAS
IF T$ = "az" THEN GOTO AZBAS
IF T$ = "x8" THEN GOTO X8BAS
IF T$ = "y8" THEN GOTO Y8BAS
IF T$ = "z8" THEN GOTO Z8BAS
IF T$ = "X8" THEN GOTO X8BAS
IF T$ = "Y8" THEN GOTO Y8BAS
IF T$ = "Z8" THEN GOTO Z8BAS
'=================================================
'=================================================
'=================================================
' line
'=================================================
'=================================================
'=================================================
McAolmacro:
MACROSWITCH = 9
T$ = grouptype$
G$ = groupname$
GS = 1: READSWITCH = 1
IF T$ = "S" THEN GOTO SBAS
IF T$ = "s" THEN GOTO SBAS
IF T$ = "CX" THEN GOTO CXBAS
IF T$ = "CY" THEN GOTO CYBAS
IF T$ = "CZ" THEN GOTO CZBAS
IF T$ = "MX" THEN GOTO MXBAS
IF T$ = "MY" THEN GOTO MYBAS
IF T$ = "MZ" THEN GOTO MZBAS
IF T$ = "AX" THEN GOTO AXBAS
IF T$ = "AY" THEN GOTO AYBAS
IF T$ = "AZ" THEN GOTO AZBAS
IF T$ = "cx" THEN GOTO CXBAS
IF T$ = "cy" THEN GOTO CYBAS
IF T$ = "cz" THEN GOTO CZBAS
IF T$ = "mx" THEN GOTO MXBAS
IF T$ = "my" THEN GOTO MYBAS
IF T$ = "mz" THEN GOTO MZBAS
IF T$ = "ax" THEN GOTO AXBAS
IF T$ = "ay" THEN GOTO AYBAS
IF T$ = "az" THEN GOTO AZBAS
IF T$ = "x8" THEN GOTO X8BAS
IF T$ = "y8" THEN GOTO Y8BAS
IF T$ = "z8" THEN GOTO Z8BAS
IF T$ = "X8" THEN GOTO X8BAS
IF T$ = "Y8" THEN GOTO Y8BAS
IF T$ = "Z8" THEN GOTO Z8BAS
McAo90:
rml = rml + 1
If rml = rdata Then rml = 0: GoTo McAoREADNEXT
COLOR CVCOL(rml)
LINE (GY(CVP1(rml)), GX(CVP1(rml)))-(GY(CVP2(rml)), GX(CVP2(rml)))
GOTO McAo90
McAoErr :
GOSUB ERRORCODES
GOTO amacstop
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' MACRO-G-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
MACROGMOD :
rm = 0
rp = 0
rch = 0
rf = 0
rlin = 0
ON ERROR GOTO McGoErr
Open "data\macro-g.txt" For Input As #1
groupname$ = T$ + "-" + G$ + ".txt"
Do While TIPE$ <> groupname$
Input #1, TIPE$
Loop
Input #1, macs, macp
McGoRC1A:
Input #1, delineator$
For rdata = 1 To 1000
Input #1, vsplane(rdata), veplane(rdata)
Input #1, vplaneinc(rdata), vscolor(rdata), vcolorinc(rdata)
If vsplane(rdata) = 0 And rdata = 1 Then GoTo McGoRC2A
If vsplane(rdata) = 0 Then GoTo McGosmacro
Next rdata
McGoRC2A:
Input #1, delineator$
For rdata = 1 To 1000
Input #1, CPNM(rdata), CVCOL(rdata)
If CPNM(rdata) = 0 And rdata = 1 Then GoTo McGoRC3A
If CPNM(rdata) = 0 Then GoTo McGopmacro
Next rdata
McGoRC3A:
Input #1, delineator$
For rdata = 1 To 1000
Input #1, CVT1(rdata), CVB1(rdata), CVT2(rdata)
Input #1, CVB2(rdata), CNR(rdata), CVCOL(rdata)
If CVT1(rdata) = 0 And rdata = 1 Then GoTo McGoRC4A
If CVT1(rdata) = 0 Then GoTo McGochmacro
Next rdata
McGoRC4A:
Input #1, delineator$
For rdata = 1 To 1000
Input #1, CVT1(rdata), CVB1(rdata), CVT2(rdata)
Input #1, CVB2(rdata), CNR(rdata), CVCOL(rdata)
If CVT1(rdata) = 0 And rdata = 1 Then GoTo McGoRC5A
If CVT1(rdata) = 0 Then GoTo McGofmacro
Next rdata
McGoRC5A:
Input #1, delineator$
For rdata = 1 To 1000
Input #1, CVP1(rdata), CVP2(rdata), CVCOL(rdata)
If CVP1(rdata) = 0 And rdata = 1 Then GoTo McGolmacro
If CVP1(rdata) = 0 Then GoTo McGolmacro
Next rdata
'=================================================
'=================================================
'=================================================
' sk sj
'=================================================
'=================================================
'=================================================
McGosmacro:
NUM = macs
McGoRC10:
rm = rm + 1
If rm = rdata Then rm = 0: GoTo McGoRC2A
SK1 = vsplane(rm)
SK2 = veplane(rm)
SKINC = vplaneinc(rm)
PLNU = SK1 - SKINC
VCOL = vscolor(rm)
VCOL = VCOL - 1
VCOLINC = vcolorinc(rm)
If VCOLINC < 0 Then VCOL = VCOL + 2
If VCOLINC = 0 Then VCOL = VCOL + 1
McGoRC15:
PLNU = PLNU + SKINC
If PLNU > SK2 Then GoTo McGoRC10
VT1 = T1(PLNU)
VT2 = T2(PLNU)
VB1 = B1(PLNU)
VB2 = B2(PLNU)
VCOL = VCOL + VCOLINC
If VCOL = 0 Then VCOL = 1
If VCOL = 256 Then VCOL = 255
COLOR VCOL
For INS = 0 To NUM
GYT = GY(VT1) + ((INS / (NUM)) * (GY(VT2) - GY(VT1)))
GXT = GX(VT1) + ((INS / (NUM)) * (GX(VT2) - GX(VT1)))
GYB = GY(VB1) + ((INS / (NUM)) * (GY(VB2) - GY(VB1)))
GXB = GX(VB1) + ((INS / (NUM)) * (GX(VB2) - GX(VB1)))
LINE (GYT, GXT)-(GYB, GXB)
Next INS
For INS = 0 To NUM
GYT = GY(VT1) + ((INS / (NUM)) * (GY(VB1) - GY(VT1)))
GXT = GX(VT1) + ((INS / (NUM)) * (GX(VB1) - GX(VT1)))
GYB = GY(VT2) + ((INS / (NUM)) * (GY(VB2) - GY(VT2)))
GXB = GX(VT2) + ((INS / (NUM)) * (GX(VB2) - GX(VT2)))
LINE (GYT, GXT)-(GYB, GXB)
Next INS
GoTo McGoRC15
'=================================================
'=================================================
'=================================================
' plane
'=================================================
'=================================================
'=================================================
McGopmacro:
NUM8 = macp
McGoRC20:
rp = rp + 1
If rp = rdata Then rp = 0: GoTo McGoRC3A
COLOR CVCOL(rp)
VT1 = T1(CPNM(rp)): VT2 = B1(CPNM(rp)): VB1 = T2(CPNM(rp)): VB2 = B2(CPNM(rp))
For INS = 0 To NUM8
GYT = GY(VT1) + ((INS / (NUM8)) * (GY(VT2) - GY(VT1)))
GXT = GX(VT1) + ((INS / (NUM8)) * (GX(VT2) - GX(VT1)))
GYB = GY(VB1) + ((INS / (NUM8)) * (GY(VB2) - GY(VB1)))
GXB = GX(VB1) + ((INS / (NUM8)) * (GX(VB2) - GX(VB1)))
LINE (GYT, GXT)-(GYB, GXB)
Next INS
VT1 = T1(CPNM(rp)): VT2 = T2(CPNM(rp)): VB1 = B1(CPNM(rp)): VB2 = B2(CPNM(rp))
For INS = 0 To NUM8
GYT = GY(VT1) + ((INS / (NUM8)) * (GY(VT2) - GY(VT1)))
GXT = GX(VT1) + ((INS / (NUM8)) * (GX(VT2) - GX(VT1)))
GYB = GY(VB1) + ((INS / (NUM8)) * (GY(VB2) - GY(VB1)))
GXB = GX(VB1) + ((INS / (NUM8)) * (GX(VB2) - GX(VB1)))
LINE (GYT, GXT)-(GYB, GXB)
Next INS
GoTo McGoRC20
'=================================================
'=================================================
'=================================================
' cross hatch
'=================================================
'=================================================
'=================================================
McGochmacro:
McGoRC30:
rch = rch + 1
If rch = rdata Then rch = 0: GoTo McGoRC4A
COLOR CVCOL(rch)
For INS = 0 To CNR(rch)
GYT = GY(CVT1(rch)) + ((INS / (CNR(rch))) * (GY(CVT2(rch)) - GY(CVT1(rch))))
GXT = GX(CVT1(rch)) + ((INS / (CNR(rch))) * (GX(CVT2(rch)) - GX(CVT1(rch))))
GYB = GY(CVB1(rch)) + ((INS / (CNR(rch))) * (GY(CVB2(rch)) - GY(CVB1(rch))))
GXB = GX(CVB1(rch)) + ((INS / (CNR(rch))) * (GX(CVB2(rch)) - GX(CVB1(rch))))
LINE (GYT, GXT)-(GYB, GXB)
Next INS
GoTo McGoRC30
'=================================================
'=================================================
'=================================================
' framing lines
'=================================================
'=================================================
'=================================================
McGofmacro:
McGoRC40:
rf = rf + 1
If rf = rdata Then rf = 0: GoTo McGoRC5A
COLOR CVCOL(rf)
GB = 11
LINE (GY(CVT2(rf)), GX(CVT2(rf)))-(GY(CVB2(rf)), GX(CVB2(rf)))
FL(GB) = 8001: LL(GB) = 8000 + CNR(rf)
LA = 8000: INS = -1
For TI = 8001 To (8000 + CNR(rf))
LA = LA + 1: INS = INS + 1
X(TI) = X(CVT1(rf)) + ((INS / (CNR(rf))) * (X(CVT2(rf)) - X(CVT1(rf))))
Y(TI) = Y(CVT1(rf)) + ((INS / (CNR(rf))) * (Y(CVT2(rf)) - Y(CVT1(rf))))
Z(TI) = Z(CVT1(rf)) + ((INS / (CNR(rf))) * (Z(CVT2(rf)) - Z(CVT1(rf))))
FP(LA) = TI
Next TI
LA = 8000: INS = -1
For BI = (8001 + CNR(rf)) To (8000 + CNR(rf) + CNR(rf))
LA = LA + 1: INS = INS + 1
X(BI) = X(CVB1(rf)) + ((INS / (CNR(rf))) * (X(CVB2(rf)) - X(CVB1(rf))))
Y(BI) = Y(CVB1(rf)) + ((INS / (CNR(rf))) * (Y(CVB2(rf)) - Y(CVB1(rf))))
Z(BI) = Z(CVB1(rf)) + ((INS / (CNR(rf))) * (Z(CVB2(rf)) - Z(CVB1(rf))))
SP(LA) = BI
Next BI
For RRRR = 8001 To (2 * (LL(GB)) - 8000)
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
McGo7040:
'calculator kernel
For LN = FL(GB) To LL(GB)
McGo7045: inc = 299
McGo7050: If DT = 1 Then DT = 0: G = SP(LN): GoTo McGo7090
G = FP(LN): DT = 1
McGo7070:
If ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
Then GoTo McGo8070
If DT = 1 Then GoTo McGo7100
McGo7090:
If ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N))
Then GoTo McGo8120
McGo7100:
W = ((A * A) + (B * B) + (C * C) - (A * X(G)) - (B * Y(G)) - (C * Z(G)))
R(G) = (((A * I) * (A - X(G))) + (B * B * X(G)) + (C * C * X(G)) -
(B * X(G) * Y(G)) - (C * X(G) * Z(G)) + ((B * J) * (A - X(G))) +
((C * K) * (A - X(G))) - ((B * Y(G)) * (A - X(G))) - ((C * Z(G)) *
(A - X(G)))) / W
S(G) = (((B * J) * (B - Y(G))) + (A * A * Y(G)) + (C * C * Y(G)) -
(A * Y(G) * X(G)) - (C * Y(G) * Z(G)) + ((A * I) * (B - Y(G))) +
((C * K) * (B - Y(G))) - ((A * X(G)) * (B - Y(G))) - ((C * Z(G)) *
(B - Y(G)))) / W
T(G) = (((C * K) * (C - Z(G))) + (A * A * Z(G)) + (B * B * Z(G)) -
(A * Z(G) * X(G)) - (B * Z(G) * Y(G)) + ((A * I) * (C - Z(G))) +
((B * J) * (C - Z(G))) - ((A * X(G)) * (C - Z(G))) - ((B * Y(G)) *
(C - X(G)))) / W
U(G) = (((R(G) - L) ^ 2) + ((S(G) - M) ^ 2) + ((T(G) - N) ^ 2)) ^ 0.5
V(G) = (((R(G) - L) * (R(10001) - L)) + ((S(G) - M) * (S(10001) - M)) +
((T(G) - N) * (T(10001) - N))) / (U(G) * ((((R(10001) - L) ^ 2) +
((S(10001) - M) ^ 2) + ((T(10001) - N) ^ 2)) ^ 0.5))
XX(G) = U(G) * V(G)
If V(G) > 0.999 Or V(G) < -0.999 Then YY(G) = 0: GoTo McGo7200
YY(G) = U(G) * ((1 - ((V(G)) ^ 2)) ^ 0.5)
If ((L * S(G)) - (M * R(G))) < 0 Then YY(G) = (-1 * YY(G))
McGo7200:
If DT = 1 Then X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GoTo McGo7050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
McGo7250:
GY(FP(LN)) = (MM * 15.2 * YY(FP(LN))) + 680 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 510 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 680 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 510 - VSH
McGo7280:
LINE (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN)))
McGo7290: Next LN
GoTo McGo8150
McGo8070:
inc = inc - 1
If inc = 0 Then inc = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(FP(LN)) = 999: GoTo McGo7290
X(G) = ((inc / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((inc / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((inc / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GoTo McGo7070
McGo8120:
inc = inc - 1
If inc = 0 Then inc = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY:
Z(G) = ZR(G) - TZ: GX(SP(LN)) = 999: GoTo McGo7290
X(G) = ((inc / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((inc / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((inc / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GoTo McGo7090
'---------------------------------
McGo8150:
GoTo McGoRC40
'=================================================
'=================================================
'=================================================
' line
'=================================================
'=================================================
'=================================================
McGolmacro:
McGoRC50:
rlin = rlin + 1
If rlin = rdata Then rlin = 0: GoTo McGoretoinmacro
COLOR CVCOL(rlin)
LINE (GY(CVP1(rlin)), GX(CVP1(rlin)))-(GY(CVP2(rlin)), GX(CVP2(rlin)))
GoTo McGoRC50
'---------------------------------------------------------------
McGoErr :
GOSUB ERRORCODES
McGoretoinmacro:
Close #1
GOTO ENHANCE
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' X8-BAS
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
X8BAS :
READATA = 2
GOSUB WIPEVALUES
ON ERROR GOTO X8oERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB X8oREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
GOTO MAIN
'------------------------------
X8oREADDATA:
Do While TIPE$ <> "LIGHTDARK:"
Input #2, TIPE$
Loop
Input #2, LIGHT, DARKK
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K6, K7, K8, K9
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
' P is first point number.
' RL is first line number.
' RPL is first plane number.
' two blocks per line group (RL = RL - 1 alternates)
' NP2 adjuster also alternates
X8oB00:
Do While TIPE$ <> "AUTOCUBE000:"
Input #2, TIPE$
Loop
P = 1: rl = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 1
Input #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 0 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 1: GoTo X8oB101
X8oB10:
If AC = STOPREAD Then GoTo X8oB11
Next AC
X8oB11:
Do While TIPE$ <> "AUTOCUBE100:"
Input #2, TIPE$
Loop
RPL = RPL - 5
P = 1001
RPL = 1001
Input #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 100 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 2: GoTo X8oB101
X8oB20:
If AC = STOPREAD Then GoTo X8oB21
Next AC
X8oB21:
Do While TIPE$ <> "AUTOCUBE200:"
Input #2, TIPE$
Loop
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL6 = rl - (NL1 + NL2 + NL3 + NL4 + NL5)
NP1 = P
P = 2001: rl = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 2001
Input #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 200 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 3: GoTo X8oB101
X8oB30:
If AC = STOPREAD Then GoTo X8oB31
Next AC
X8oB31:
Do While TIPE$ <> "AUTOCUBE300:"
Input #2, TIPE$
Loop
RPL = RPL - 5
P = 3001
RPL = 3001
Input #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 300 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 4: GoTo X8oB101
X8oB40:
If AC = STOPREAD Then GoTo X8oB41
Next AC
X8oB41:
Do While TIPE$ <> "AUTOCUBE400:"
Input #2, TIPE$
Loop
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL7 = rl - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP2 = P - 2000
P = 4001: rl = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
RPL = 4001
Input #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 400 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 5: GoTo X8oB101
X8oB50:
If AC = STOPREAD Then GoTo X8oB51
Next AC
X8oB51:
Do While TIPE$ <> "AUTOCUBE500:"
Input #2, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 5001
RPL = 5001
Input #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 500 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 6: GoTo X8oB101
X8oB60:
If AC = STOPREAD Then GoTo X8oB61
Next AC
X8oB61:
Do While TIPE$ <> "AUTOCUBE600:"
Input #2, TIPE$
Loop
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL8 = rl - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7)
NP3 = P - 4000
P = 6001: rl = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + 1
RPL = 6001
Input #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 600 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 7: GoTo X8oB101
X8oB70:
If AC = STOPREAD Then GoTo X8oB71
Next AC
X8oB71:
Do While TIPE$ <> "AUTOCUBE700:"
Input #2, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 7001
RPL = 7001
Input #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 700 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 8: GoTo X8oB101
X8oB80:
If AC = STOPREAD Then GoTo X8oB81
Next AC
X8oB81:
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL9 = rl - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8)
NP4 = P - 6000
GoTo X8oFRAMINGREAD1
X8oB101:
GOSUB B101ASSIGNMENTS
GOSUB FMEMBERS
X8oB150:
If BLOK = 1 Then GoTo X8oB10
If BLOK = 2 Then GoTo X8oB20
If BLOK = 3 Then GoTo X8oB30
If BLOK = 4 Then GoTo X8oB40
If BLOK = 5 Then GoTo X8oB50
If BLOK = 6 Then GoTo X8oB60
If BLOK = 7 Then GoTo X8oB70
If BLOK = 8 Then GoTo X8oB80
X8oFRAMINGREAD1:
GOSUB FRAMINGAXYZXYZ8
RETURN
'-----------------------------------------------
X8oERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 2
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' Y8-BAS
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
Y8BAS :
READATA = 2
GOSUB WIPEVALUES
ON ERROR GOTO Y8oERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB Y8oREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
GOTO MAIN
'------------------------------
Y8oREADDATA:
Do While TIPE$ <> "LIGHTDARK:"
Input #2, TIPE$
Loop
Input #2, LIGHT, DARKK
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K6, K7, K8, K9
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
' P is first point number.
' RL is first line number.
' RPL is first plane number.
' two blocks per line group (RL = RL - 1 alternates)
' NP2 adjuster also alternates
Y8oB00:
Do While TIPE$ <> "AUTOCUBE000:"
Input #2, TIPE$
Loop
P = 1: rl = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 1
Input #2, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 0 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 1: GoTo Y8oB101
Y8oB10:
If AC = STOPREAD Then GoTo Y8oB11
Next AC
Y8oB11:
Do While TIPE$ <> "AUTOCUBE100:"
Input #2, TIPE$
Loop
RPL = RPL - 5
P = 1001
RPL = 1001
Input #2, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 100 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 2: GoTo Y8oB101
Y8oB20:
If AC = STOPREAD Then GoTo Y8oB21
Next AC
Y8oB21:
Do While TIPE$ <> "AUTOCUBE200:"
Input #2, TIPE$
Loop
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL6 = rl - (NL1 + NL2 + NL3 + NL4 + NL5)
NP1 = P
P = 2001: rl = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 2001
Input #2, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 200 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 3: GoTo Y8oB101
Y8oB30:
If AC = STOPREAD Then GoTo Y8oB31
Next AC
Y8oB31:
Do While TIPE$ <> "AUTOCUBE300:"
Input #2, TIPE$
Loop
RPL = RPL - 5
P = 3001
RPL = 3001
Input #2, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 300 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 4: GoTo Y8oB101
Y8oB40:
If AC = STOPREAD Then GoTo Y8oB41
Next AC
Y8oB41:
Do While TIPE$ <> "AUTOCUBE400:"
Input #2, TIPE$
Loop
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL7 = rl - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP2 = P - 2000
P = 4001: rl = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
RPL = 4001
Input #2, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 400 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 5: GoTo Y8oB101
Y8oB50:
If AC = STOPREAD Then GoTo Y8oB51
Next AC
Y8oB51:
Do While TIPE$ <> "AUTOCUBE500:"
Input #2, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 5001
RPL = 5001
Input #2, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 500 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 6: GoTo Y8oB101
Y8oB60:
If AC = STOPREAD Then GoTo Y8oB61
Next AC
Y8oB61:
Do While TIPE$ <> "AUTOCUBE600:"
Input #2, TIPE$
Loop
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL8 = rl - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7)
NP3 = P - 4000
P = 6001: rl = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + 1
RPL = 6001
Input #2, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 600 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 7: GoTo Y8oB101
Y8oB70:
If AC = STOPREAD Then GoTo Y8oB71
Next AC
Y8oB71:
Do While TIPE$ <> "AUTOCUBE700:"
Input #2, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 7001
RPL = 7001
Input #2, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 700 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 8: GoTo Y8oB101
Y8oB80:
If AC = STOPREAD Then GoTo Y8oB81
Next AC
Y8oB81:
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL9 = rl - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8)
NP4 = P - 6000
GoTo Y8oFRAMINGREAD1
Y8oB101:
GOSUB B101ASSIGNMENTS
GOSUB FMEMBERS
Y8oB150:
If BLOK = 1 Then GoTo Y8oB10
If BLOK = 2 Then GoTo Y8oB20
If BLOK = 3 Then GoTo Y8oB30
If BLOK = 4 Then GoTo Y8oB40
If BLOK = 5 Then GoTo Y8oB50
If BLOK = 6 Then GoTo Y8oB60
If BLOK = 7 Then GoTo Y8oB70
If BLOK = 8 Then GoTo Y8oB80
Y8oFRAMINGREAD1:
GOSUB FRAMINGAXYZXYZ8
RETURN
'-----------------------------------------------
Y8oERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 2
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' Z8-BAS
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
Z8BAS :
READATA = 2
GOSUB WIPEVALUES
ON ERROR GOTO Z8oERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB Z8oREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
GOTO MAIN
'------------------------------
Z8oREADDATA:
Do While TIPE$ <> "LIGHTDARK:"
Input #2, TIPE$
Loop
Input #2, LIGHT, DARKK
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K6, K7, K8, K9
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
' P is first point number.
' RL is first line number.
' RPL is first plane number.
' two blocks per line group (RL = RL - 1 alternates)
' NP2 adjuster also alternates
Z8oB00:
Do While TIPE$ <> "AUTOCUBE000:"
Input #2, TIPE$
Loop
P = 1: rl = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 1
Input #2, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 0 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 1: GoTo Z8oB101
Z8oB10:
If AC = STOPREAD Then GoTo Z8oB11
Next AC
Z8oB11:
Do While TIPE$ <> "AUTOCUBE100:"
Input #2, TIPE$
Loop
RPL = RPL - 5
P = 1001
RPL = 1001
Input #2, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 100 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 2: GoTo Z8oB101
Z8oB20:
If AC = STOPREAD Then GoTo Z8oB21
Next AC
Z8oB21:
Do While TIPE$ <> "AUTOCUBE200:"
Input #2, TIPE$
Loop
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL6 = rl - (NL1 + NL2 + NL3 + NL4 + NL5)
NP1 = P
P = 2001: rl = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 2001
Input #2, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 200 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 3: GoTo Z8oB101
Z8oB30:
If AC = STOPREAD Then GoTo Z8oB31
Next AC
Z8oB31:
Do While TIPE$ <> "AUTOCUBE300:"
Input #2, TIPE$
Loop
RPL = RPL - 5
P = 3001
RPL = 3001
Input #2, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 300 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 4: GoTo Z8oB101
Z8oB40:
If AC = STOPREAD Then GoTo Z8oB41
Next AC
Z8oB41:
Do While TIPE$ <> "AUTOCUBE400:"
Input #2, TIPE$
Loop
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL7 = rl - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP2 = P - 2000
P = 4001: rl = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
RPL = 4001
Input #2, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 400 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 5: GoTo Z8oB101
Z8oB50:
If AC = STOPREAD Then GoTo Z8oB51
Next AC
Z8oB51:
Do While TIPE$ <> "AUTOCUBE500:"
Input #2, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 5001
RPL = 5001
Input #2, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 500 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 6: GoTo Z8oB101
Z8oB60:
If AC = STOPREAD Then GoTo Z8oB61
Next AC
Z8oB61:
Do While TIPE$ <> "AUTOCUBE600:"
Input #2, TIPE$
Loop
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL8 = rl - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7)
NP3 = P - 4000
P = 6001: rl = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + 1
RPL = 6001
Input #2, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 600 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 7: GoTo Z8oB101
Z8oB70:
If AC = STOPREAD Then GoTo Z8oB71
Next AC
Z8oB71:
Do While TIPE$ <> "AUTOCUBE700:"
Input #2, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 7001
RPL = 7001
Input #2, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 700 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 8: GoTo Z8oB101
Z8oB80:
If AC = STOPREAD Then GoTo Z8oB81
Next AC
Z8oB81:
P = P - 1: rl = rl - 1: RPL = RPL - 5
NL9 = rl - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8)
NP4 = P - 6000
GoTo Z8oFRAMINGREAD1
Z8oB101:
GOSUB B101ASSIGNMENTS
GOSUB FMEMBERS
Z8oB150:
If BLOK = 1 Then GoTo Z8oB10
If BLOK = 2 Then GoTo Z8oB20
If BLOK = 3 Then GoTo Z8oB30
If BLOK = 4 Then GoTo Z8oB40
If BLOK = 5 Then GoTo Z8oB50
If BLOK = 6 Then GoTo Z8oB60
If BLOK = 7 Then GoTo Z8oB70
If BLOK = 8 Then GoTo Z8oB80
Z8oFRAMINGREAD1:
GOSUB FRAMINGAXYZXYZ8
RETURN
'-----------------------------------------------
Z8oERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 2
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' MX-BAS
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
MXBAS :
READATA = 2
GOSUB WIPEVALUES
ON ERROR GOTO MxoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB MxoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
GOTO MAIN
'------------------------------
MxoREADDATA:
Do While TIPE$ <> "LIGHTDARK:"
Input #2, TIPE$
Loop
Input #2, LIGHT, DARKK
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K1, K2, K3, K4, K5, K6, K7, K8
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
GOSUB STANDARDPOINTSLINES
'==============================================
DO WHILE TIPE$ <> "AUTOCUBE200:"
INPUT #2, TIPE$
LOOP
P = 2001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 2001
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROT, COLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
FOR AC = 20 TO ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 1: GOTO MxoB101
MxoB10:
IF AC = STOPREAD THEN GOTO MxoB11
NEXT AC
MxoB11:
'==============================================
DO WHILE TIPE$ <> "AUTOCUBE400:"
INPUT #2, TIPE$
LOOP
'---------------------------------------
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5)
NP2 = P - 2000
'---------------------------------------
P = 4001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 4001
FOR AC = 400 TO 599
BLOK = 2: GOTO MxoB100
MxoB20:
IF DUMMY% = 999 THEN EXIT FOR
NEXT AC
MxoB21:
'==============================================
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL7 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP3 = P - 4000
GOTO MxoJKREAD
MxoB100:
INPUT #2, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROT(AC), COLAC(AC)
IF DUMMY% = 999 THEN GOTO MxoB150
MxoB101:
GOSUB B101ASSIGNMENTS
IF BLOK = 2 THEN GOTO MxoSINGLES
GOSUB FMEMBERS
GOTO MxoB150
MxoSINGLES:
GOSUB LUCKY
MxoB150:
IF BLOK = 1 THEN GOTO MxoB10
IF BLOK = 2 THEN GOTO MxoB20
MxoJKREAD:
DO WHILE TIPE$ <> "AUTOPLANE:"
INPUT #2, TIPE$
LOOP
FOR RPL = 1 TO 8000
INPUT #2, DUMMY%, T1(RPL), B1(RPL), T2(RPL), B2(RPL), DIR(RPL), COLR(RPL)
IF DUMMY% = 999 THEN EXIT FOR
NEXT RPL
GOSUB FRAMINGSTMXYZ
'===================================================
P = 6001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
RPL = 6001
CIRC = 6000: COUNT = 0
DO WHILE TIPE$ <> "DARKESTCOLOR:"
INPUT #2, TIPE$
LOOP
INPUT #2, DRKCOL
DO WHILE TIPE$ <> "CURVDATA:"
INPUT #2, TIPE$
LOOP
FOR RD = 1 TO 400 'up to 400 sections in accordance with DIM statements
INPUT #2, CURVPOINTS(RD)
INPUT #2, DEGB(RD), ARCB(RD), RADZB(RD), RADYB(RD)
INPUT #2, XB(RD), YB(RD), ZB(RD), LB(RD), INCB(RD), STREB(RD)
INPUT #2, DEGT(RD), ARCT(RD), RADZT(RD), RADYT(RD)
INPUT #2, XT(RD), YT(RD), ZT(RD), LT(RD), INCT(RD), STRET(RD)
IF CURVPOINTS(RD) = 999 THEN EXIT FOR
CURVEFINE(RD) = (CURVPOINTS(RD)) * .5
CURVINC(RD) = CURVEFINE(RD) - 1
PTPAIRS(RD) = CURVEFINE(RD) * 2
NP4 = NP4 + PTPAIRS(RD)
COUNT = COUNT + 1
NEXT RD
'points
FOR RD = 1 TO COUNT
'bottom
DEG1 = DEGB(RD): DEG2 = DEG1 + ARCB(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LB(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
Z(CIRC) = (RADZB(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + ZB(RD)
Y(CIRC) = (RADYB(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + YB(RD)
IF INCB(RD) = 0 THEN X(CIRC) = XB(RD): GOTO Mxo10
XDEG = XDEG - INCB(RD)
XRAD = STREB(RD) * (COS((XDEG * 3.14159) / 180))
X(CIRC) = (-1 * (XRAD)) + XB(RD)
Mxo10:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
'top
DEG1 = DEGT(RD): DEG2 = DEG1 + ARCT(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LT(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
Z(CIRC) = (RADZT(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + ZT(RD)
Y(CIRC) = (RADYT(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + YT(RD)
IF INCT(RD) = 0 THEN X(CIRC) = XT(RD): GOTO Mxo20
XDEG = XDEG - INCT(RD)
XRAD = STRET(RD) * (COS((XDEG * 3.14159) / 180))
X(CIRC) = (-1 * (XRAD)) + XT(RD)
Mxo20:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
NEXT RD
GOSUB CONNECTMXYZ
RL = RL - 1
NL8 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7)
RETURN
'--------------------------------------------------------
MxoERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 2
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
' MY-BAS
'=========================================================
'=========================================================
'=========================================================
'=========================================================
MYBAS :
READATA = 2
GOSUB WIPEVALUES
ON ERROR GOTO MyoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB MyoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
GOTO MAIN
'------------------------------
MyoREADDATA:
Do While TIPE$ <> "LIGHTDARK:"
Input #2, TIPE$
Loop
Input #2, LIGHT, DARKK
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K1, K2, K3, K4, K5, K6, K7, K8
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
GOSUB STANDARDPOINTSLINES
'==============================================
DO WHILE TIPE$ <> "AUTOCUBE200:"
INPUT #2, TIPE$
LOOP
P = 2001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 2001
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROT, COLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
FOR AC = 200 TO ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 1: GOTO MyoB101
MyoB10:
IF AC = STOPREAD THEN GOTO MyoB11
NEXT AC
MyoB11:
'==============================================
DO WHILE TIPE$ <> "AUTOCUBE400:"
INPUT #2, TIPE$
LOOP
'---------------------------------------
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5)
NP2 = P - 2000
'---------------------------------------
P = 4001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 4001
FOR AC = 400 TO 599
BLOK = 2: GOTO MyoB100
MyoB20:
IF DUMMY% = 999 THEN EXIT FOR
NEXT AC
MyoB21:
'==============================================
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL7 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP3 = P - 4000
GOTO MyoJKREAD
MyoB100:
INPUT #2, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROT(AC), COLAC(AC)
IF DUMMY% = 999 THEN GOTO MyoB150
MyoB101:
GOSUB B101ASSIGNMENTS
IF BLOK = 2 THEN GOTO MyoSINGLES
GOSUB FMEMBERS
GOTO MyoB150
MyoSINGLES:
GOSUB LUCKY
MyoB150:
IF BLOK = 1 THEN GOTO MyoB10
IF BLOK = 2 THEN GOTO MyoB20
MyoJKREAD:
DO WHILE TIPE$ <> "AUTOPLANE:"
INPUT #2, TIPE$
LOOP
FOR RPL = 1 TO 8000
INPUT #2, DUMMY%, T1(RPL), B1(RPL), T2(RPL), B2(RPL), DIR(RPL), COLR(RPL)
IF DUMMY% = 999 THEN EXIT FOR
NEXT RPL
GOSUB FRAMINGSTMXYZ
'===================================================
P = 6001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
RPL = 6001
CIRC = 6000: COUNT = 0
DO WHILE TIPE$ <> "DARKESTCOLOR:"
INPUT #2, TIPE$
LOOP
INPUT #2, DRKCOL
DO WHILE TIPE$ <> "CURVDATA:"
INPUT #2, TIPE$
LOOP
FOR RD = 1 TO 400 'up to 400 sections in accordance with DIM statements
INPUT #2, CURVPOINTS(RD)
INPUT #2, DEGB(RD), ARCB(RD), RADXB(RD), RADZB(RD)
INPUT #2, XB(RD), YB(RD), ZB(RD), LB(RD), INCB(RD), STREB(RD)
INPUT #2, DEGT(RD), ARCT(RD), RADXT(RD), RADZT(RD)
INPUT #2, XT(RD), YT(RD), ZT(RD), LT(RD), INCT(RD), STRET(RD)
IF CURVPOINTS(RD) = 999 THEN EXIT FOR
CURVEFINE(RD) = (CURVPOINTS(RD)) * .5
CURVINC(RD) = CURVEFINE(RD) - 1
PTPAIRS(RD) = CURVEFINE(RD) * 2
NP4 = NP4 + PTPAIRS(RD)
COUNT = COUNT + 1
NEXT RD
'points
FOR RD = 1 TO COUNT
'bottom
DEG1 = DEGB(RD): DEG2 = DEG1 + ARCB(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LB(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
X(CIRC) = (RADXB(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + XB(RD)
Z(CIRC) = (RADZB(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + ZB(RD)
IF INCB(RD) = 0 THEN Y(CIRC) = YB(RD): GOTO Myo10
YDEG = YDEG - INCB(RD)
YRAD = STREB(RD) * (COS((YDEG * 3.14159) / 180))
Y(CIRC) = (-1 * (YRAD)) + YB(RD)
Myo10:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
'top
DEG1 = DEGT(RD): DEG2 = DEG1 + ARCT(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LT(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
X(CIRC) = (RADXT(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + XT(RD)
Z(CIRC) = (RADZT(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + ZT(RD)
IF INCT(RD) = 0 THEN Y(CIRC) = YT(RD): GOTO Myo20
YDEG = YDEG - INCT(RD)
YRAD = STRET(RD) * (COS((YDEG * 3.14159) / 180))
Y(CIRC) = (-1 * (YRAD)) + YT(RD)
Myo20:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
NEXT RD
GOSUB CONNECTMXYZ
RL = RL - 1
NL8 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7)
RETURN
'---------------------------------------------------------
MyoERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 2
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' MZ-BAS
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
MZBAS :
READATA = 2
GOSUB WIPEVALUES
ON ERROR GOTO MzoERR1
OPEN "DATA\" + T$ + "-" + G$ + ".txt" FOR INPUT AS #2
GOSUB MzoREADDATA
GOSUB TRANSFORMATIONS
CLOSE #2
GOTO MAIN
'------------------------------
MzoREADDATA:
'---------------------------------------------
Do While TIPE$ <> "LIGHTDARK:"
Input #2, TIPE$
Loop
Input #2, LIGHT, DARKK
'---------------------------------------------
DO WHILE TIPE$ <> "WIRECOLORS:"
INPUT #2, TIPE$
LOOP
INPUT #2, BACK, K1, K2, K3, K4, K5, K6, K7, K8
'---------------------------------------------
Do While TIPE$ <> "BEGIN-END:"
Input #2, TIPE$
Loop
Input #2, XBEGINDATA, XENDDATA, YBEGINDATA, YENDDATA, ZBEGINDATA, ZENDDATA
'---------------------------------------------
GOSUB STANDARDPOINTSLINES
'==============================================
DO WHILE TIPE$ <> "AUTOCUBE200:"
INPUT #2, TIPE$
LOOP
P = 2001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 2001
INPUT #2, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROT, COLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
FOR AC = 200 TO ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 1: GOTO MzoB101
MzoB10:
IF AC = STOPREAD THEN GOTO MzoB11
NEXT AC
MzoB11:
'==============================================
DO WHILE TIPE$ <> "AUTOCUBE400:"
INPUT #2, TIPE$
LOOP
'---------------------------------------
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5)
NP2 = P - 2000
'---------------------------------------
P = 4001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 4001
FOR AC = 400 TO 599
BLOK = 2: GOTO MzoB100
MzoB20:
IF DUMMY% = 999 THEN EXIT FOR
NEXT AC
MzoB21:
'==============================================
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL7 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP3 = P - 4000
GOTO MzoJKREAD
MzoB100:
INPUT #2, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROT(AC), COLAC(AC)
IF DUMMY% = 999 THEN GOTO MzoB150
MzoB101:
GOSUB B101ASSIGNMENTS
IF BLOK = 2 THEN GOTO MzoSINGLES
GOSUB FMEMBERS
GOTO MzoB150
MzoSINGLES:
GOSUB LUCKY
MzoB150:
IF BLOK = 1 THEN GOTO MzoB10
IF BLOK = 2 THEN GOTO MzoB20
MzoJKREAD:
DO WHILE TIPE$ <> "AUTOPLANE:"
INPUT #2, TIPE$
LOOP
FOR RPL = 1 TO 8000
INPUT #2, DUMMY%, T1(RPL), B1(RPL), T2(RPL), B2(RPL), DIR(RPL), COLR(RPL)
IF DUMMY% = 999 THEN EXIT FOR
NEXT RPL
GOSUB FRAMINGSTMXYZ
'===================================================
P = 6001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + 1
RPL = 6001
CIRC = 6000: COUNT = 0
DO WHILE TIPE$ <> "DARKESTCOLOR:"
INPUT #2, TIPE$
LOOP
INPUT #2, DRKCOL
DO WHILE TIPE$ <> "CURVDATA:"
INPUT #2, TIPE$
LOOP
FOR RD = 1 TO 400 'up to 400 sections in accordance with DIM statements
INPUT #2, CURVPOINTS(RD)
INPUT #2, DEGB(RD), ARCB(RD), RADXB(RD), RADYB(RD)
INPUT #2, XB(RD), YB(RD), ZB(RD), LB(RD), INCB(RD), STREB(RD)
INPUT #2, DEGT(RD), ARCT(RD), RADXT(RD), RADYT(RD)
INPUT #2, XT(RD), YT(RD), ZT(RD), LT(RD), INCT(RD), STRET(RD)
IF CURVPOINTS(RD) = 999 THEN EXIT FOR
CURVEFINE(RD) = (CURVPOINTS(RD)) * .5
CURVINC(RD) = CURVEFINE(RD) - 1
PTPAIRS(RD) = CURVEFINE(RD) * 2
NP4 = NP4 + PTPAIRS(RD)
COUNT = COUNT + 1
NEXT RD
'points
FOR RD = 1 TO COUNT
'bottom
DEG1 = DEGB(RD): DEG2 = DEG1 + ARCB(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LB(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
X(CIRC) = (RADXB(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + XB(RD)
Y(CIRC) = (RADYB(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + YB(RD)
IF INCB(RD) = 0 THEN Z(CIRC) = ZB(RD): GOTO Mzo10
ZDEG = ZDEG - INCB(RD)
ZRAD = STREB(RD) * (COS((ZDEG * 3.14159) / 180))
Z(CIRC) = (-1 * (ZRAD)) + ZB(RD)
Mzo10:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
'top
DEG1 = DEGT(RD): DEG2 = DEG1 + ARCT(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
ZDEG = LT(RD)
FOR INC = 0 TO CURVINC(RD)
CIRC = CIRC + 1
X(CIRC) = (RADXT(RD) * COS(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + XT(RD)
Y(CIRC) = (RADYT(RD) * SIN(DEG1 + (INC / CURVINC(RD)) * (DEG1 - DEG2))) + YT(RD)
IF INCT(RD) = 0 THEN Z(CIRC) = ZT(RD): GOTO Mzo20
ZDEG = ZDEG - INCT(RD)
ZRAD = STRET(RD) * (COS((ZDEG * 3.14159) / 180))
Z(CIRC) = (-1 * (ZRAD)) + ZT(RD)
Mzo20:
XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
NEXT INC
NEXT RD
GOSUB CONNECTMXYZ
RL = RL - 1
NL8 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7)
RETURN
'-----------------------------------------------
MzoERR1:
GOSUB ERRORCODES
CLOSE #2
READATA = 2
GOTO MAIN
'=========================================================
'=========================================================
'=========================================================
'=========================================================
'
' TRANSFORM-MOD
'
'=========================================================
'=========================================================
'=========================================================
'=========================================================
TRANSFORMATIONS:
DO WHILE TIPE$ <> "TRAN"
INPUT #2, TIPE$
LOOP
INPUT #2, TIPE$
IF TIPE$ = "XTRANSFORMATIONS:" THEN GOTO XT
IF TIPE$ = "YTRANSFORMATIONS:" THEN GOTO YT
IF TIPE$ = "ZTRANSFORMATIONS:" THEN GOTO ZT
IF TIPE$ = "RESIZE:" THEN GOTO RESIZE
IF TIPE$ = "XROTATETRANSLATE:" THEN GOTO XROT
IF TIPE$ = "YROTATETRANSLATE:" THEN GOTO YROT
IF TIPE$ = "ZROTATETRANSLATE:" THEN GOTO ZROT
IF TIPE$ = "TRANSLATE:" THEN GOTO TRANSLATE
IF TIPE$ = "STEP10TRANSLATE:" THEN GOTO STEPTRAN
If TIPE$ = "XWRAP:" Then GoTo XWRAPIT
If TIPE$ = "YWRAP:" Then GoTo YWRAPIT
IF TIPE$ = "ZWRAP:" THEN GOTO ZWRAPIT
IF TIPE$ = "STOP" THEN GOTO RETOIN
RETOIN:
RETURN
XT:
FOR RD = 1 TO 10000
INPUT #2, R, ALUE
IF R = 999 THEN EXIT FOR
X(R) = ALUE: XR(R) = ALUE
NEXT RD
GOTO TRANSFORMATIONS
YT:
FOR RD = 1 TO 10000
INPUT #2, R, ALUE
IF R = 999 THEN EXIT FOR
Y(R) = ALUE: YR(R) = ALUE
NEXT RD
GOTO TRANSFORMATIONS
ZT:
FOR RD = 1 TO 10000
INPUT #2, R, ALUE
IF R = 999 THEN EXIT FOR
Z(R) = ALUE: ZR(R) = ALUE
NEXT RD
GOTO TRANSFORMATIONS
RESIZE:
FOR RD = 1 TO 10000
INPUT #2, FIRST, LAST, MULTX, MULTY, MULTZ
IF FIRST = 999 THEN EXIT FOR
FOR RESIZE = FIRST TO LAST
X(RESIZE) = X(RESIZE) * MULTX: XR(RESIZE) = X(RESIZE)
Y(RESIZE) = Y(RESIZE) * MULTY: YR(RESIZE) = Y(RESIZE)
Z(RESIZE) = Z(RESIZE) * MULTZ: ZR(RESIZE) = Z(RESIZE)
NEXT RESIZE
NEXT RD
GOTO TRANSFORMATIONS
XROT:
FOR RD = 1 TO 10000
INPUT #2, FIRST, LAST, XANGLE, TRANX, TRANY, TRANZ
IF FIRST = 999 THEN EXIT FOR
XANGLE = (XANGLE * 3.14159) / 180
FOR ROT = FIRST TO LAST
Y(ROT) = (YR(ROT) * COS(XANGLE)) - (ZR(ROT) * SIN(XANGLE)) + TRANY
Z(ROT) = (YR(ROT) * SIN(XANGLE)) + (ZR(ROT) * COS(XANGLE)) + TRANZ
X(ROT) = XR(ROT) + TRANX
XR(ROT) = X(ROT): YR(ROT) = Y(ROT): ZR(ROT) = Z(ROT)
NEXT ROT
NEXT RD
GOTO TRANSFORMATIONS
YROT:
FOR RD = 1 TO 10000
INPUT #2, FIRST, LAST, YANGLE, TRANX, TRANY, TRANZ
IF FIRST = 999 THEN EXIT FOR
YANGLE = (YANGLE * 3.14159) / 180
FOR ROT = FIRST TO LAST
Z(ROT) = (ZR(ROT) * COS(YANGLE)) - (XR(ROT) * SIN(YANGLE)) + TRANZ
X(ROT) = (ZR(ROT) * SIN(YANGLE)) + (XR(ROT) * COS(YANGLE)) + TRANX
Y(ROT) = YR(ROT) + TRANY
XR(ROT) = X(ROT): YR(ROT) = Y(ROT): ZR(ROT) = Z(ROT)
NEXT ROT
NEXT RD
GOTO TRANSFORMATIONS
ZROT:
FOR RD = 1 TO 10000
INPUT #2, FIRST, LAST, ZANGLE, TRANX, TRANY, TRANZ
IF FIRST = 999 THEN EXIT FOR
ZANGLE = (ZANGLE * 3.14159) / 180
FOR ROT = FIRST TO LAST
X(ROT) = (XR(ROT) * COS(ZANGLE)) - (YR(ROT) * SIN(ZANGLE)) + TRANX
Y(ROT) = (XR(ROT) * SIN(ZANGLE)) + (YR(ROT) * COS(ZANGLE)) + TRANY
Z(ROT) = ZR(ROT) + TRANZ
XR(ROT) = X(ROT): YR(ROT) = Y(ROT): ZR(ROT) = Z(ROT)
NEXT ROT
NEXT RD
GOTO TRANSFORMATIONS
TRANSLATE:
FOR RD = 1 TO 10000
INPUT #2, FIRST, LAST, TRANX, TRANY, TRANZ
IF FIRST = 999 THEN EXIT FOR
FOR TRAN = FIRST TO LAST
X(TRAN) = XR(TRAN) + TRANX: XR(TRAN) = X(TRAN)
Y(TRAN) = YR(TRAN) + TRANY: YR(TRAN) = Y(TRAN)
Z(TRAN) = ZR(TRAN) + TRANZ: ZR(TRAN) = Z(TRAN)
NEXT TRAN
NEXT RD
GOTO TRANSFORMATIONS
STEPTRAN:
FOR RD = 1 TO 10000
INPUT #2, FIRST, LAST, TRANX, TRANY, TRANZ
IF FIRST = 999 THEN EXIT FOR
FOR TRAN = FIRST TO LAST STEP 10
X(TRAN) = XR(TRAN) + TRANX: XR(TRAN) = X(TRAN)
Y(TRAN) = YR(TRAN) + TRANY: YR(TRAN) = Y(TRAN)
Z(TRAN) = ZR(TRAN) + TRANZ: ZR(TRAN) = Z(TRAN)
NEXT TRAN
NEXT RD
GOTO TRANSFORMATIONS
XWRAPIT:
For RD = 1 To 8000
Input #2, First, Last, wrapangle, wrapnum, liftinc
If First = 999 Then Exit For
wrapfirst = First - 10: wraplast = Last - 10
XANGLE = 0: xlift = 0: wrapangle = (wrapangle * 3.14159) / 180
For xwrap = 1 To wrapnum
xlift = xlift + liftinc
XANGLE = XANGLE + wrapangle
wrapfirst = wrapfirst + 10: wraplast = wraplast + 10
For ROTA = wrapfirst To wraplast
Y(ROTA) = (YR(ROTA) * Cos(XANGLE)) - (ZR(ROTA) * Sin(XANGLE))
Z(ROTA) = (YR(ROTA) * Sin(XANGLE)) + (ZR(ROTA) * Cos(XANGLE))
X(ROTA) = XR(ROTA) + xlift
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
Next xwrap
Next RD
GoTo TRANSFORMATIONS
YWRAPIT:
For RD = 1 To 8000
Input #2, First, Last, wrapangle, wrapnum, liftinc
If First = 999 Then Exit For
wrapfirst = First - 10: wraplast = Last - 10
YANGLE = 0: ylift = 0: wrapangle = (wrapangle * 3.14159) / 180
For ywrap = 1 To wrapnum
ylift = ylift + liftinc
YANGLE = YANGLE + wrapangle
wrapfirst = wrapfirst + 10: wraplast = wraplast + 10
For ROTA = wrapfirst To wraplast
Z(ROTA) = (XR(ROTA) * Sin(YANGLE)) + (ZR(ROTA) * Cos(YANGLE))
X(ROTA) = (XR(ROTA) * Cos(YANGLE)) - (ZR(ROTA) * Sin(YANGLE))
Y(ROTA) = YR(ROTA) + ylift
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
Next ywrap
Next RD
GoTo TRANSFORMATIONS
ZWRAPIT:
For RD = 1 To 8000
Input #2, First, Last, wrapangle, wrapnum, liftinc
If First = 999 Then Exit For
wrapfirst = First - 10: wraplast = Last - 10
ZANGLE = 0: zlift = 0: wrapangle = (wrapangle * 3.14159) / 180
For zwrap = 1 To wrapnum
zlift = zlift + liftinc
ZANGLE = ZANGLE + wrapangle
wrapfirst = wrapfirst + 10: wraplast = wraplast + 10
For ROTA = wrapfirst To wraplast
X(ROTA) = (XR(ROTA) * Cos(ZANGLE)) - (YR(ROTA) * Sin(ZANGLE))
Y(ROTA) = (XR(ROTA) * Sin(ZANGLE)) + (YR(ROTA) * Cos(ZANGLE))
Z(ROTA) = ZR(ROTA) + zlift
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
Next zwrap
Next RD
GoTo TRANSFORMATIONS
'original end of program
'-----------------------
'=========================================================
'=========================================================
'2023 02/02 added the following subroutines
' which now get called by various modules
' ======================
' =====================
' CALCULATOR SUBROUTINE
' =====================
' =====================
CALCSUB:
C1100:
W = ((A * A) + (B * B) + (C * C) - (A * X(G)) - (B * Y(G)) - (C * Z(G)))
R(G) = (((A * I) * (A - X(G))) + (B * B * X(G)) + (C * C * X(G)) -
(B * X(G) * Y(G)) - (C * X(G) * Z(G)) + ((B * J) * (A - X(G))) +
((C * K) * (A - X(G))) - ((B * Y(G)) * (A - X(G))) - ((C * Z(G)) *
(A - X(G)))) / W
S(G) = (((B * J) * (B - Y(G))) + (A * A * Y(G)) + (C * C * Y(G)) -
(A * Y(G) * X(G)) - (C * Y(G) * Z(G)) + ((A * I) * (B - Y(G))) +
((C * K) * (B - Y(G))) - ((A * X(G)) * (B - Y(G))) - ((C * Z(G)) *
(B - Y(G)))) / W
T(G) = (((C * K) * (C - Z(G))) + (A * A * Z(G)) + (B * B * Z(G)) -
(A * Z(G) * X(G)) - (B * Z(G) * Y(G)) + ((A * I) * (C - Z(G))) +
((B * J) * (C - Z(G))) - ((A * X(G)) * (C - Z(G))) - ((B * Y(G)) *
(C - X(G)))) / W
U(G) = (((R(G) - L) ^ 2) + ((S(G) - M) ^ 2) + ((T(G) - N) ^ 2)) ^ 0.5
V(G) = (((R(G) - L) * (R(10001) - L)) + ((S(G) - M) * (S(10001) - M)) +
((T(G) - N) * (T(10001) - N))) / (U(G) * ((((R(10001) - L) ^ 2) +
((S(10001) - M) ^ 2) + ((T(10001) - N) ^ 2)) ^ 0.5))
XX(G) = U(G) * V(G)
If V(G) > 0.99999 Or V(G) < -0.99999 Then YY(G) = 0: GoTo C1200
YY(G) = U(G) * ((1 - ((V(G)) ^ 2)) ^ 0.5)
If ((L * S(G)) - (M * R(G))) < 0 Then YY(G) = (-1 * YY(G))
C1200:
RETURN
' ======================
' ======================
' AUTOFRAMING ST MXYZ
' ======================
' ======================
FRAMINGSTMXYZ:
DO WHILE TIPE$ <> "AUTOFRAMING1:"
INPUT #2, TIPE$
LOOP
REM Reads plane number and number of framing lines
DO WHILE NFL <> 999
INPUT #2, PL, NFL
IF NFL = 999 THEN NFL = 0: AUTOFRM1(PL) = 0: EXIT DO
AUTOFRM1(PL) = NFL
LOOP
DO WHILE TIPE$ <> "AUTOFRAMING2:"
INPUT #2, TIPE$
LOOP
DO WHILE NFL <> 999
INPUT #2, PL, NFL
IF NFL = 999 THEN NFL = 0: AUTOFRM2(PL) = 0: EXIT DO
AUTOFRM2(PL) = NFL
LOOP
RETURN
' ======================
' ======================
' AUTOFRAMING AXYZ XYZ8
' ======================
' ======================
FRAMINGAXYZXYZ8:
Do While TIPE$ <> "AUTOFRAMING1:"
Input #2, TIPE$
Loop
Do While NFL <> 999
Input #2, SPL, EPL, NFL
If NFL = 999 Then NFL = 0: AUTOFRM1(PL) = 0: Exit Do
For PL = SPL To EPL Step 10
AUTOFRM1(PL) = NFL
Next PL
Loop
Do While TIPE$ <> "AUTOFRAMING2:"
Input #2, TIPE$
Loop
Do While NFL <> 999
Input #2, SPL, EPL, NFL
If NFL = 999 Then NFL = 0: AUTOFRM2(PL) = 0: Exit Do
For PL = SPL To EPL Step 10
AUTOFRM2(PL) = NFL
Next PL
Loop
RETURN
' ======================
' ======================
' STANDARDPOINTS LINES
' ======================
' ======================
STANDARDPOINTSLINES:
POINTS:
DO WHILE TIPE$ <> "STANDARD:"
INPUT #2, TIPE$
LOOP
FOR RW = 1 TO 10000
INPUT #2, DUMMY%, X(RW), Y(RW), Z(RW)
XR(RW) = X(RW): YR(RW) = Y(RW): ZR(RW) = Z(RW)
IF DUMMY% = 999 THEN
NP1 = RW - 1
EXIT FOR
END IF
NEXT RW
DO WHILE TIPE$ <> "LINEG1:"
INPUT #2, TIPE$
LOOP
FOR RL = 1 TO 20000
INPUT #2, FP(RL), SP(RL)
IF FP(RL) = 999 AND SP(RL) = 999 THEN
NL1 = RL - 1
EXIT FOR
END IF
NEXT RL
DO WHILE TIPE$ <> "LINEG2:"
INPUT #2, TIPE$
LOOP
FOR RL = (NL1 + 1) TO 20000
INPUT #2, FP(RL), SP(RL)
IF FP(RL) = 999 AND SP(RL) = 999 THEN
NL2 = RL - 1 - NL1
EXIT FOR
END IF
NEXT RL
DO WHILE TIPE$ <> "LINEG3:"
INPUT #2, TIPE$
LOOP
FOR RL = (NL1 + NL2 + 1) TO 20000
INPUT #2, FP(RL), SP(RL)
IF FP(RL) = 999 AND SP(RL) = 999 THEN
NL3 = RL - 1 - NL1 - NL2
EXIT FOR
END IF
NEXT RL
DO WHILE TIPE$ <> "LINEG4:"
INPUT #2, TIPE$
LOOP
FOR RL = (NL1 + NL2 + NL3 + 1) TO 20000
INPUT #2, FP(RL), SP(RL)
IF FP(RL) = 999 AND SP(RL) = 999 THEN
NL4 = RL - 1 - NL1 - NL2 - NL3
EXIT FOR
END IF
NEXT RL
DO WHILE TIPE$ <> "LINEG5:"
INPUT #2, TIPE$
LOOP
FOR RL = (NL1 + NL2 + NL3 + NL4 + 1) TO 20000
INPUT #2, FP(RL), SP(RL)
IF FP(RL) = 999 AND SP(RL) = 999 THEN
NL5 = RL - 1 - NL1 - NL2 - NL3 - NL4
EXIT FOR
END IF
NEXT RL
RETURN
' ======================
' ======================
' B101 ASSIGNMENTS
' ======================
' ======================
B101ASSIGNMENTS:
DX = X6 - X1: DY = Y6 - Y1: DZ = Z6 - Z1
X(P) = X1: Y(P) = Y1: Z(P) = Z1: P1 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1: Y(P) = Y1: Z(P) = Z1 + DZ: P2 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1: Y(P) = Y1 + DY: Z(P) = Z1: P3 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1: Y(P) = Y1 + DY: Z(P) = Z1 + DZ: P4 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1 + DX: Y(P) = Y1 + DY: Z(P) = Z1: P5 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X6: Y(P) = Y6: Z(P) = Z6: P6 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1 + DX: Y(P) = Y1: Z(P) = Z1: P7 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = X1 + DX: Y(P) = Y1: Z(P) = Z1 + DZ: P8 = P
XR(P) = X(P): YR(P) = Y(P): ZR(P) = Z(P): P = P + 1
X(P) = 0: Y(P) = 0: Z(P) = 0: P = P + 1
X(P) = 0: Y(P) = 0: Z(P) = 0: P = P + 1
FP(RL) = P1: SP(RL) = P2: RL = RL + 1
FP(RL) = P3: SP(RL) = P4: RL = RL + 1
FP(RL) = P5: SP(RL) = P6: RL = RL + 1
FP(RL) = P7: SP(RL) = P8: RL = RL + 1
FP(RL) = P1: SP(RL) = P3: RL = RL + 1
FP(RL) = P3: SP(RL) = P5: RL = RL + 1
FP(RL) = P5: SP(RL) = P7: RL = RL + 1
FP(RL) = P7: SP(RL) = P1: RL = RL + 1
FP(RL) = P2: SP(RL) = P4: RL = RL + 1
FP(RL) = P4: SP(RL) = P6: RL = RL + 1
FP(RL) = P6: SP(RL) = P8: RL = RL + 1
FP(RL) = P8: SP(RL) = P2: RL = RL + 1
RETURN
' ======================
' ======================
' T1B1T2B2 ASSIGNMENTS
' ======================
' ======================
T1B1T2B2:
T1(RPL) = P1: B1(RPL) = P2: T2(RPL) = P3: B2(RPL) = P4
DIR(RPL) = 1: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P3: B1(RPL) = P4: T2(RPL) = P5: B2(RPL) = P6
DIR(RPL) = 2: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P5: B1(RPL) = P6: T2(RPL) = P7: B2(RPL) = P8
DIR(RPL) = 3: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P7: B1(RPL) = P8: T2(RPL) = P1: B2(RPL) = P2
DIR(RPL) = 4: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P1: B1(RPL) = P3: T2(RPL) = P7: B2(RPL) = P5
DIR(RPL) = 5: COLR(RPL) = COLAC(AC): RPL = RPL + 1
T1(RPL) = P2: B1(RPL) = P4: T2(RPL) = P8: B2(RPL) = P6
DIR(RPL) = 6: COLR(RPL) = COLAC(AC): RPL = RPL + 5
RETURN
' ======================
' ======================
' FMEMBERS ASSIGNMENTS
' ======================
' ======================
FMEMBERS:
T1(RPL) = P1: B1(RPL) = P2: T2(RPL) = P3: B2(RPL) = P4
DIR(RPL) = 1: COLR(RPL) = COLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P3: B1(RPL) = P4: T2(RPL) = P5: B2(RPL) = P6
DIR(RPL) = 2: COLR(RPL) = COLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P5: B1(RPL) = P6: T2(RPL) = P7: B2(RPL) = P8
DIR(RPL) = 3: COLR(RPL) = COLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P7: B1(RPL) = P8: T2(RPL) = P1: B2(RPL) = P2
DIR(RPL) = 4: COLR(RPL) = COLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P1: B1(RPL) = P3: T2(RPL) = P7: B2(RPL) = P5
DIR(RPL) = 5: COLR(RPL) = COLAC: ROTAT(RPL) = 0: RPL = RPL + 1
T1(RPL) = P2: B1(RPL) = P4: T2(RPL) = P8: B2(RPL) = P6
DIR(RPL) = 6: COLR(RPL) = COLAC: ROTAT(RPL) = 0: RPL = RPL + 5
RETURN
' ======================
' ======================
' LUCKY ASSIGNMENTS
' ======================
' ======================
LUCKY:
T1(RPL) = P1: B1(RPL) = P2: T2(RPL) = P3: B2(RPL) = P4
DIR(RPL) = 1: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P3: B1(RPL) = P4: T2(RPL) = P5: B2(RPL) = P6
DIR(RPL) = 2: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P5: B1(RPL) = P6: T2(RPL) = P7: B2(RPL) = P8
DIR(RPL) = 3: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P7: B1(RPL) = P8: T2(RPL) = P1: B2(RPL) = P2
DIR(RPL) = 4: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROT(AC): RPL = RPL + 1
T1(RPL) = P1: B1(RPL) = P3: T2(RPL) = P7: B2(RPL) = P5
DIR(RPL) = 5: COLR(RPL) = COLAC(AC): ROTAT(RPL) = 0: RPL = RPL + 1
T1(RPL) = P2: B1(RPL) = P4: T2(RPL) = P8: B2(RPL) = P6
DIR(RPL) = 6: COLR(RPL) = COLAC(AC): ROTAT(RPL) = 0: RPL = RPL + 5
RETURN
' ======================
' ======================
' WIPEVALUES
' ======================
' ======================
WIPEVALUES:
NL1 = 0: NL2 = 0: NL3 = 0: NL4 = 0: NL5 = 0
NL6 = 0: NL7 = 0: NL8 = 0: NL9 = 0: NL10 = 0
NP1 = 0: NP2 = 0: NP3 = 0: NP4 = 0: NP5 = 0: NP6 = 0
For WIPE = 1 To 8000
X(WIPE) = 0: Y(WIPE) = 0: Z(WIPE) = 0
XR(WIPE) = 0: YR(WIPE) = 0: ZR(WIPE) = 0
T1(WIPE) = 0: T2(WIPE) = 0: B1(WIPE) = 0: B2(WIPE) = 0
AUTOFRM1(WIPE) = 0
AUTOFRM2(WIPE) = 0
TDIR(WIPE) = 0
ROTAT(WIPE) = 0
DIR(WIPE) = 0
COLR(WIPE) = 0
ROT(WIPE) = 0
Next WIPE
For WIPE = 1 To 80
COLAC(WIPE) = 0
Next WIPE
RETURN
' ======================
' ======================
' CONNECT POINTS PLANES
' ======================
' ======================
CONNECT:
FOR RD = 1 TO COUNT
IF RD = 1 THEN CP = 1: GOTO C30
RPREVIOUS = RD - 1
CP = CP + PTPAIRS(RPREVIOUS)
C30:
FOR CNT = 1 TO CURVEFINE(RD)
FP(RL) = CP: SP(RL) = CP + CURVEFINE(RD): RL = RL + 1: CP = CP + 1
NEXT CNT
CP = CP - CURVEFINE(RD)
FOR CNT = 1 TO CURVINC(RD)
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
NEXT CNT
CP = CP + 1
FOR CNT = 1 TO CURVINC(RD)
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
NEXT CNT
CP = (CP - PTPAIRS(RD)) + 1
NEXT RD
'planes
FOR RD = 1 TO COUNT
IF RD = 1 THEN PP = 1: RPL = 1: GOTO C40
RPREVIOUS = RD - 1
PP = PP + CURVEFINE(RPREVIOUS): RPL = RPL + CURVEFINE(RPREVIOUS)
C40:
FOR CNT = 1 TO CURVINC(RD)
B1(RPL) = PP: T1(RPL) = PP + 1
B2(RPL) = PP + CURVEFINE(RD): T2(RPL) = PP + CURVEFINE(RD) + 1
RPL = RPL + 1: PP = PP + 1
NEXT CNT
PP = PP + 1: RPL = RPL + 1
NEXT RD
RL = RL - 2
NL10 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9)
RETURN
' ===========================
' ===========================
' CONNECT mxyz POINTS PLANES
' ===========================
' ===========================
CONNECTMXYZ:
FOR RD = 1 TO COUNT
IF RD = 1 THEN CP = 6001: GOTO CM30
RPREVIOUS = RD - 1
CP = CP + PTPAIRS(RPREVIOUS)
CM30:
FOR CNT = 1 TO CURVEFINE(RD)
FP(RL) = CP: SP(RL) = CP + CURVEFINE(RD): RL = RL + 1: CP = CP + 1
NEXT CNT
CP = CP - CURVEFINE(RD)
FOR CNT = 1 TO CURVINC(RD)
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
NEXT CNT
CP = CP + 1
FOR CNT = 1 TO CURVINC(RD)
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
NEXT CNT
CP = (CP - PTPAIRS(RD)) + 1
NEXT RD
'planes
FOR RD = 1 TO COUNT
IF RD = 1 THEN PP = 6001: RPL = 6001: GOTO CM40
RPREVIOUS = RD - 1
PP = PP + CURVEFINE(RPREVIOUS): RPL = RPL + CURVEFINE(RPREVIOUS)
CM40:
FOR CNT = 1 TO CURVINC(RD)
B1(RPL) = PP: T1(RPL) = PP + 1
B2(RPL) = PP + CURVEFINE(RD): T2(RPL) = PP + CURVEFINE(RD) + 1
RPL = RPL + 1: PP = PP + 1
NEXT CNT
PP = PP + 1: RPL = RPL + 1
NEXT RD
RETURN
' ======================
' ======================
' AUTO SURFACING DIRDRAW
' ======================
' ======================
AUTODIRDRAW:
IF DIR(ORD(ORT)) = 5 THEN TDIR(ORD(ORT)) = 5
IF DIR(ORD(ORT)) = 6 THEN TDIR(ORD(ORT)) = 6
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 1
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 0 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 1
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 1 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 1
IF ROTAT(ORD(ORT)) = 2 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 1 THEN TDIR(ORD(ORT)) = 2
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 2 THEN TDIR(ORD(ORT)) = 3
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 3 THEN TDIR(ORD(ORT)) = 4
IF ROTAT(ORD(ORT)) = 3 AND DIR(ORD(ORT)) = 4 THEN TDIR(ORD(ORT)) = 1
IF COLR(ORD(ORT)) = 0 THEN COLR(ORD(ORT)) = 1
IF TDIR(ORD(ORT)) = LIGHT THEN COLR(ORD(ORT)) = COLR(ORD(ORT)) - 1
IF TDIR(ORD(ORT)) = DARKK THEN COLR(ORD(ORT)) = COLR(ORD(ORT)) + 1
COLOR COLR(ORD(ORT))
TT1 = T1(ORD(ORT))
TT2 = T2(ORD(ORT))
BB1 = B1(ORD(ORT))
BB2 = B2(ORD(ORT))
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(TT2) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(TT2) - GX(TT1)))
GYB = GY(BB1) + ((INS / (NUM)) * (GY(BB2) - GY(BB1)))
GXB = GX(BB1) + ((INS / (NUM)) * (GX(BB2) - GX(BB1)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
FOR INS = 0 TO NUM
GYT = GY(TT1) + ((INS / (NUM)) * (GY(BB1) - GY(TT1)))
GXT = GX(TT1) + ((INS / (NUM)) * (GX(BB1) - GX(TT1)))
GYB = GY(TT2) + ((INS / (NUM)) * (GY(BB2) - GY(TT2)))
GXB = GX(TT2) + ((INS / (NUM)) * (GX(BB2) - GX(TT2)))
LINE (GYT, GXT)-(GYB, GXB)
NEXT INS
RETURN
SUBQUICKCHANGE:
OPEN "data\start256.txt" FOR INPUT AS #2
Do While TIPE$ <> "HighZ(full)"
Input #2, TIPE$
Loop
Input #2, zfa, zfb, zfc, zfx, zfy, zfz, zfm, zfv, zfh
zfa = zfa - zfx: zfb = zfb - zfy: zfc = zfc - zfz
Do While TIPE$ <> "HighZ(zoom)"
Input #2, TIPE$
Loop
Input #2, zza, zzb, zzc, zzx, zzy, zzz, zzm, zzv, zzh
zza = zza - zzx: zzb = zzb - zzy: zzc = zzc - zzz
Do While TIPE$ <> "FarX(full)"
Input #2, TIPE$
Loop
Input #2, xfa, xfb, xfc, xfx, xfy, xfz, xfm, xfv, xfh
xfa = xfa - xfx: xfb = xfb - xfy: xfc = xfc - xfz
Do While TIPE$ <> "FarX(zoom)"
Input #2, TIPE$
Loop
Input #2, xza, xzb, xzc, xzx, xzy, xzz, xzm, xzv, xzh
xza = xza - xzx: xzb = xzb - xzy: xzc = xzc - xzz
Do While TIPE$ <> "FarY(full)"
Input #2, TIPE$
Loop
Input #2, yfa, yfb, yfc, yfx, yfy, yfz, yfm, yfv, yfh
yfa = yfa - yfx: yfb = yfb - yfy: yfc = yfc - yfz
Do While TIPE$ <> "FarY(zoom)"
Input #2, TIPE$
Loop
Input #2, yza, yzb, yzc, yzx, yzy, yzz, yzm, yzv, yzh
yza = yza - yzx: yzb = yzb - yzy: yzc = yzc - yzz
Do While TIPE$ <> "Perspective1"
Input #2, TIPE$
Loop
Input #2, p1a, p1b, p1c, p1x, p1y, p1z, p1m, p1v, p1h
p1a = p1a - p1x: p1b = p1b - p1y: p1c = p1c - p1z
Do While TIPE$ <> "Perspective2"
Input #2, TIPE$
Loop
Input #2, p2a, p2b, p2c, p2x, p2y, p2z, p2m, p2v, p2h
p2a = p2a - p2x: p2b = p2b - p2y: p2c = p2c - p2z
Do While TIPE$ <> "Perspective3"
Input #2, TIPE$
Loop
Input #2, p3a, p3b, p3c, p3x, p3y, p3z, p3m, p3v, p3h
p3a = p3a - p3x: p3b = p3b - p3y: p3c = p3c - p3z
Do While TIPE$ <> "Perspective4"
Input #2, TIPE$
Loop
Input #2, p4a, p4b, p4c, p4x, p4y, p4z, p4m, p4v, p4h
p4a = p4a - p4x: p4b = p4b - p4y: p4c = p4c - p4z
Do While TIPE$ <> "Perspective5"
Input #2, TIPE$
Loop
Input #2, p5a, p5b, p5c, p5x, p5y, p5z, p5m, p5v, p5h
p5a = p5a - p5x: p5b = p5b - p5y: p5c = p5c - p5z
Do While TIPE$ <> "Perspective6"
Input #2, TIPE$
Loop
Input #2, p6a, p6b, p6c, p6x, p6y, p6z, p6m, p6v, p6h
p6a = p6a - p6x: p6b = p6b - p6y: p6c = p6c - p6z
CLOSE #2
RETURN
' ======================
' ======================
' ERROR CODES
' ======================
' ======================
ERRORCODES:
SELECT CASE ERR
CASE 6
LOCATE 110, 172: PRINT "overflow"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE 9
LOCATE 110, 172: PRINT "subscript out of range"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE 53
LOCATE 110, 172: PRINT "file not found"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE 62
LOCATE 110, 172: PRINT "input past end of file"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE 11
LOCATE 110, 172: PRINT "division by zero"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE 13
LOCATE 110, 172: PRINT "type mismatch"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE 52
LOCATE 110, 172: PRINT "bad file name or number"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE 54
LOCATE 110, 172: PRINT "bad file mode"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE 64
LOCATE 110, 172: PRINT "bad file name"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE 75
LOCATE 110, 172: PRINT "path/file access error"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE 76
LOCATE 110, 172: PRINT "path not found"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
CASE ELSE
LOCATE 110, 172: PRINT "unknow error"
LOCATE 111, 172: PRINT "press spacebar"
WHILE INKEY$ = "": WEND
LOCATE 110, 172: PRINT " "
LOCATE 111, 172: PRINT " "
END SELECT
RESUME ENDERRORCODES
ENDERRORCODES :
RETURN
'-----------------------------------------------
'end of 02/02/2023 new subroutines
'=========================================================
' END OF PROGRAM
'=========================================================
RogCAD home
|