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.
Calculator kernel
(uses vectors to create a floating image plane;
the CAD user moves around a stationary object
by moving the image plane):
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 - Z(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
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:
'FOR DLY = 1 TO 500000
'NEXT DLY
viewport.Line (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN))), RGB(redd(cdex), green(cdex), blue(cdex))
1290 Next LN
-----------------------------------------------------------------------------------------
Curve generator
(uses sine function to make repeatable, deformable arcs):
Private Sub cxbas()
READATA = 3
NL1 = 0: NL2 = 0: NL3 = 0: NL4 = 0: NL5 = 0
NL6 = 0: NL7 = 0: NL8 = 0: NL9 = 0
NP1 = 0: NP2 = 0: NP3 = 0: NP4 = 0: NP5 = 0: NP6 = 0
rl = 1: CIRC = 0: rcount = 0
'On Error GoTo rcerr
Open "datah\" + groupname$ For Input As #2
GoSub READDATA
'--------------------
Call transform
Close #2
Call mainmod
GoTo rcend
'========================================
'========================================
READDATA:
Do While TIPE$ <> "WIRECOLORS:"
Input #2, TIPE$
Loop
Input #2, K10
Do While TIPE$ <> "CURVDATA:"
Input #2, TIPE$
Loop
'================================
For RD = 1 To 300 'up to 300 sections in accordance with DIM statements
Input #2, CURVPOINTS(RD), dummyplanes$
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) = 9999 Then Exit For
CURVEFINE(RD) = (CURVPOINTS(RD)) * 0.5
CURVINC(RD) = CURVEFINE(RD) - 1
PTPAIRS(RD) = (CURVPOINTS(RD))
NP6 = NP6 + PTPAIRS(RD)
rcount = rcount + 1
Next RD
'points
For RD = 1 To rcount
'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 10
XDEG = XDEG - INCB(RD)
XRAD = STREB(RD) * (Cos((XDEG * 3.14159) / 180))
X(CIRC) = (-1 * (XRAD)) + XB(RD)
10 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 20
XDEG = XDEG - INCT(RD)
XRAD = STRET(RD) * (Cos((XDEG * 3.14159) / 180))
X(CIRC) = (-1 * (XRAD)) + XT(RD)
20 XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
Next inc
Next RD
'Connect points
For RD = 1 To rcount
If RD = 1 Then CP = 1: GoTo 30
RPREVIOUS = RD - 1
CP = CP + PTPAIRS(RPREVIOUS)
30:
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 rcount
If RD = 1 Then PP = 1: RPL = 1: GoTo 40
RPREVIOUS = RD - 1
PP = PP + CURVEFINE(RPREVIOUS): RPL = RPL + CURVEFINE(RPREVIOUS)
40:
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
'-------------------------------------
rcerr:
Call oops
rcend:
End Sub
----------------------------------------------------------------------------
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.)
Private Sub scapenter_Click()
cap$ = capbox.Text
capbox.Text = ""
scapenter.Visible = False
capescapebtn.Visible = False
capcaplabel.Visible = False
capbox.Visible = False
Dim vcapture As scrncap
Open "caps\" + cap$ For Random As #1 Len = 10
CAPR = 1
For CAPCOL = 1 To 1465
capcolval = 0: curval = 0: caprepeat = 0: preval = 0
For caprow = 1 To 1036
caprepeat = caprepeat + 1
capcolval = viewport.Point(CAPCOL, caprow)
If caprow = 1 Then
caprepeat = 0
curval = capcolval
preval = capcolval
GoTo SKIP
End If
If caprow = 1036 And capcolval = curval Then GoTo PUTIT
If capcolval = curval Then GoTo SKIP
PUTIT: curval = capcolval
vcapture.colvall = preval
vcapture.repeatt = caprepeat
Put #1, CAPR, vcapture
If caprow = 1036 Then
CAPR = CAPR + 1
vcapture.colvall = capcolval
vcapture.repeatt = 1
Put #1, CAPR, vcapture
End If
preval = capcolval: caprepeat = 0
CAPR = CAPR + 1
SKIP: Next caprow
Next CAPCOL
Close #1
End Sub
Private Sub sset_Click()
capcaplabel.Visible = True
capbox.Visible = True
ssetenter.Visible = True
capescapebtn.Visible = True
capbox.SetFocus
End Sub
Private Sub ssetenter_Click()
cap$ = capbox.Text
capbox.Text = ""
ssetenter.Visible = False
capescapebtn.Visible = False
capcaplabel.Visible = False
capbox.Visible = False
Dim setit As scrnset
Open "caps\" + cap$ For Random As #1 Len = 10
CAPR = 0
For CAPCOL = 1 To 1465
CHANGE: reptot = 1
NEWREC: CAPR = CAPR + 1
Get #1, CAPR, setit
capcolval = setit.colvall
rep = setit.repeatt
capcolor$ = Str$(capcolval)
endrep = (reptot + rep) - 1
For caprow = reptot To endrep
viewport.PSet (CAPCOL, caprow), capcolor$
Next caprow
reptot = reptot + rep
If reptot = 1037 Then GoTo NCOL
GoTo NEWREC
NCOL: Next CAPCOL
Close #1
End Sub
----------------------------------------------------------------
RogCAD code, complete:
There are many sections of code that look almost identical to
other sections of code, due to having x, y and z direction versions
for stringed cubic elements and curved elements.
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 CP(20000): Public SP(20000): Public XR(10000): Public YR(10000): Public ZR(10000): Public XX(10000)
Public YY(10000): Public RR(10000): Public X(10000): Public Y(10000): Public FL(255): Public LL(255)
Public GY(10000): Public CX(10000): Public Z(10000): Public R(10000): Public S(10000)
Public T(10000): Public U(10000): Public V(10000): Public TEMX(10000): Public TEMY(10000): Public TEMZ(10000)
Public PN1(10000): Public PN2(10000): Public PN3(10000): Public PN4(10000)
Public T1(10000): Public T2(10000): Public B1(10000): Public B2(10000)
Public DIS1(10000): Public DIS2(10000): Public DIS3(10000): Public DIS4(10000): Public DIS(10000)
Public ORD(10000): Public AUTOFRM1(10000): Public AUTOFRM2(10000)
Public DIR(10000): Public TDIR(10000): Public ROT(10000): Public ROTAT(10000)
Public COLAC(10000): Public COLR(10000)
Public ICHK, RA, RB, RC, RIT
Public KLR(), MA, NL1, NL2, NL3, GB, K1, K2, K3
Public RES, QRES, ACHK, CV, G, DM, BACK, MM, A, B, C, L, M, N, I, J, K
Public TX, TY, TZ, VSH, HSH, CHK, AA, BB, CC, NP1, NP2, NP3, AP, PAST, MAG
Public P1, RT, CN, MN, SHIF, DRW, NP4, NP5, NL4, NL5, K4, K5
Public QPLN, RED(), GRN(), BLU()
Public P2, IFRM
Public R1, R2, R3, R4, REC
Public D, E, F, H, O, Q, FX(), FY(), FZ(), NL6, NL7, K6
Public K7, NP6, NP7, NP8, NP9, K8, K9, K10, NL8, NL9, NL10, A1
Public READSWITCH, PLA, READATA
Public ASWITCH, LINP1, LINP2, GSWITCH
Public S1, S2, S3, S4, S5, S6, S7, S8, S9, S10
' note changes in variable names below
Public SS1$, SS2$, SS3$, SS4$, SS5$, SS6$
Public MMM$, GRPSWI, GG$, TT$, GS
' end note
Public groupname$, iitem$(100), totalitems, grpname$(200)
Public grptype$(200), titem$(30), gtype$
Public RRRRA, RRRRB, RRRRC, PAL$
Public redval$, greenval$, blueval$
Public INCR, INCG, INCB
Public LEFTC, RIGHTC
Public pinc, finc, minc, PSW, iinc, MAD, VVA, VVB, VVC
Public FCH, INF, sinc, jump
Public DEGB(20), ARCB(20), RADXB(20), RADYB(20), FIN(20)
Public XB(20), YB(20), ZB(20), LB(20), INKB(20), STREB(20)
Public DEGT(20), ARCT(20), RADXT(20), RADYT(20)
Public XT(20), YT(20), ZT(20), LT(20), INCT(20), STRET(20)
Public RADZB(20), RADZT(20), cnt, cntb
Public ROOT, COOLAC, VB1, VB2, VT1, VT2, vrepeat, VCOL, VEECOLOR
Public LIGHTT As Integer, DARKK As Integer
Public vfcolor, vauto, vplane, PL, capcolor$, cap$
Public reddback, greenback, blueback
Public PNM
Public vsplane(10000), veplane(10000), vplaneinc(50), vscolor(255), vcolorinc(255)
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
' 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
Private Sub Form_Load()
incrementlist.AddItem "10000"
incrementlist.AddItem " "
incrementlist.AddItem "5000"
incrementlist.AddItem "2500"
incrementlist.AddItem "1000"
incrementlist.AddItem " "
incrementlist.AddItem "500"
incrementlist.AddItem "250"
incrementlist.AddItem "100"
incrementlist.AddItem " "
incrementlist.AddItem "50"
incrementlist.AddItem "25"
incrementlist.AddItem "10"
incrementlist.AddItem " "
incrementlist.AddItem "5"
incrementlist.AddItem "2.5"
incrementlist.AddItem "1"
incrementlist.AddItem " "
incrementlist.AddItem ".5"
incrementlist.AddItem ".25"
incrementlist.AddItem ".1"
incrementlist.AddItem " "
incrementlist.AddItem ".05"
incrementlist.AddItem ".025"
incrementlist.AddItem ".01"
incrementlist.AddItem " "
incrementlist.AddItem ".005"
incrementlist.AddItem ".0025"
incrementlist.AddItem ".001"
incrementlist.AddItem " "
cincrementlist.AddItem "60"
cincrementlist.AddItem "50"
cincrementlist.AddItem "40"
cincrementlist.AddItem "30"
cincrementlist.AddItem "20"
cincrementlist.AddItem "15"
cincrementlist.AddItem "10"
cincrementlist.AddItem " "
cincrementlist.AddItem "9"
cincrementlist.AddItem "8"
cincrementlist.AddItem "7"
cincrementlist.AddItem "6"
cincrementlist.AddItem "5"
cincrementlist.AddItem "4"
cincrementlist.AddItem "3"
cincrementlist.AddItem "2"
cincrementlist.AddItem "1"
cincrementlist.AddItem "0"
quickchange.AddItem "High Z (full)"
quickchange.AddItem "High Z (zoom)"
quickchange.AddItem " "
quickchange.AddItem "Far X (full)"
quickchange.AddItem "Far X (zoom)"
quickchange.AddItem " "
quickchange.AddItem "Far Y (full)"
quickchange.AddItem "Far Y (zoom)"
quickchange.AddItem " "
quickchange.AddItem "Perspective 1"
quickchange.AddItem "Perspective 2"
quickchange.AddItem "Perspective 3"
quickchange.AddItem "Perspective 4"
'User uses any naming convention for group name,
'but still specifies group type.
Open "datah\groupnames.txt" For Input As #1
Do While TIPE$ <> "GROUPNAMES:"
Input #1, TIPE$
Loop
For dex = 1 To 1000
Input #1, grpname$(dex)
groupnames.AddItem grpname$(dex)
If grpname$(dex) = "9999" Then Exit For
Next dex
Close #1
'reddback = 90
'greenback = 120
'blueback = 170
Call rogcadbas
End Sub
Private Sub palcapbtn_Click()
palettenamebox.Text = "File name?"
palcapenter.Visible = True
palcaptxt.Visible = True
palcaptxt.SetFocus
End Sub
Private Sub palcapenter_Click()
cap$ = palcaptxt.Text
palettenamebox.Text = ""
palcaptxt.Text = ""
palcaptxt.Visible = False
palcapenter.Visible = False
SavePicture colorchart.Image, ("pal-bmps\" + cap$)
End Sub
Private Sub oops()
colorprompt.Visible = True
colorprompt.Text = "Boo boo has occurred reading from data file. Click anywhere in this box to close this box."
End Sub
Private Sub colorprompt_Click()
colorprompt.Visible = False
End Sub
Private Sub groupbtn_Click()
groupnames.Visible = True
groupnames.SetFocus
End Sub
Private Sub groupnames_Click()
groupname$ = groupnames.Text + ".txt"
gtype$ = Left$(groupname$, 2)
groupnames.Visible = False
If gtype$ = "st" Then Call stbas
If gtype$ = "ac" Then Call acbas
If gtype$ = "ax" Then Call axbas
If gtype$ = "ay" Then Call aybas
If gtype$ = "az" Then Call azbas
If gtype$ = "cx" Then Call cxbas
If gtype$ = "cy" Then Call cybas
If gtype$ = "cz" Then Call czbas
End Sub
Private Sub drawcolorchart()
'color chart drawing
cdex = 1
blockdex = -100
For block = 1 To 10
blockdex = blockdex + 177
coldex = -21
For colnum = 1 To 5
coldex = coldex + 26
rowdex = blockdex
For rownum = 1 To 10
colorchart.Line (coldex, rowdex)-Step(23, 12), RGB(redd(cdex), green(cdex), blue(cdex)), BF
cdex = cdex + 1
If cdex = 237 Then GoTo endofloop
rowdex = rowdex + 15
spacer = spacer + 1
If spacer = 5 Then
spacer = 0
rowdex = rowdex + 3
End If
Next rownum
Next colnum
Next block
endofloop:
End Sub
Private Sub cincrementbtn_Click()
cincrementlist.Visible = True
End Sub
Private Sub cincrementlist_Click()
cincrementlist.Visible = False
End Sub
Private Sub capescapebtn_Click()
capbox.Text = ""
screencapenter.Visible = False
screensetenter.Visible = False
scapenter.Visible = False
ssetenter.Visible = False
capescapebtn.Visible = False
caplabel.Visible = False
capcaplabel.Visible = False
capbox.Text = ""
capbox.Visible = False
End Sub
Private Sub screencapbtn_Click()
caplabel.Visible = True
capbox.Visible = True
screencapenter.Visible = True
capescapebtn.Visible = True
capbox.SetFocus
End Sub
Private Sub screencapenter_Click()
cap$ = capbox.Text
capbox.Text = ""
screencapenter.Visible = False
capescapebtn.Visible = False
caplabel.Visible = False
capbox.Visible = False
SavePicture viewport.Image, ("bmps\" + cap$)
End Sub
Private Sub screensetbtn_Click()
caplabel.Visible = True
capbox.Visible = True
screensetenter.Visible = True
capescapebtn.Visible = True
capbox.SetFocus
End Sub
Private Sub screensetenter_Click()
cap$ = capbox.Text
capbox.Text = ""
screensetenter.Visible = False
capescapebtn.Visible = False
caplabel.Visible = False
capbox.Visible = False
Set viewport.Picture = LoadPicture("bmps\" + cap$)
End Sub
Private Sub scap_Click()
capcaplabel.Visible = True
capbox.Visible = True
scapenter.Visible = True
capescapebtn.Visible = True
capbox.SetFocus
End Sub
Private Sub scapenter_Click()
cap$ = capbox.Text
capbox.Text = ""
scapenter.Visible = False
capescapebtn.Visible = False
capcaplabel.Visible = False
capbox.Visible = False
Dim vcapture As scrncap
Open "caps\" + cap$ For Random As #1 Len = 10
CAPR = 1
For CAPCOL = 1 To 1465
capcolval = 0: curval = 0: caprepeat = 0: preval = 0
For caprow = 1 To 1036
caprepeat = caprepeat + 1
capcolval = viewport.Point(CAPCOL, caprow)
If caprow = 1 Then
caprepeat = 0
curval = capcolval
preval = capcolval
GoTo SKIP
End If
If caprow = 1036 And capcolval = curval Then GoTo PUTIT
If capcolval = curval Then GoTo SKIP
PUTIT: curval = capcolval
vcapture.colvall = preval
vcapture.repeatt = caprepeat
Put #1, CAPR, vcapture
If caprow = 1036 Then
CAPR = CAPR + 1
vcapture.colvall = capcolval
vcapture.repeatt = 1
Put #1, CAPR, vcapture
End If
preval = capcolval: caprepeat = 0
CAPR = CAPR + 1
SKIP: Next caprow
Next CAPCOL
Close #1
End Sub
Private Sub sset_Click()
capcaplabel.Visible = True
capbox.Visible = True
ssetenter.Visible = True
capescapebtn.Visible = True
capbox.SetFocus
End Sub
Private Sub ssetenter_Click()
cap$ = capbox.Text
capbox.Text = ""
ssetenter.Visible = False
capescapebtn.Visible = False
capcaplabel.Visible = False
capbox.Visible = False
Dim setit As scrnset
Open "caps\" + cap$ For Random As #1 Len = 10
CAPR = 0
For CAPCOL = 1 To 1465
CHANGE: reptot = 1
NEWREC: CAPR = CAPR + 1
Get #1, CAPR, setit
capcolval = setit.colvall
rep = setit.repeatt
capcolor$ = Str$(capcolval)
endrep = (reptot + rep) - 1
For caprow = reptot To endrep
viewport.PSet (CAPCOL, caprow), capcolor$
Next caprow
reptot = reptot + rep
If reptot = 1037 Then GoTo NCOL
GoTo NEWREC
NCOL: Next CAPCOL
Close #1
End Sub
Private Sub backcolor_Click()
chbotbtn.Visible = False
bgenter.Visible = True
bottomcolor.SetFocus
End Sub
Private Sub bgenter_Click()
reddback = redbottom.Text
greenback = greenbottom.Text
blueback = bluebottom.Text
bottomcolor.Text = ""
bgenter.Visible = False
chbotbtn.Visible = True
For bgr = 1 To 1037
viewport.Line (1, bgr)-(1465, bgr), RGB(reddback, greenback, blueback)
Next bgr
'viewport.backcolor = RGB(reddback, greenback, blueback)
'viewport.FillColor = RGB(reddback, greenback, blueback)
'viewport.ForeColor = RGB(reddback, greenback, blueback)
End Sub
Private Sub sreddec_Click()
inc = Val(cincrementlist.Text)
curcol$ = currentcol.Text
ccdex = Val(curcol$)
redd(ccdex) = redd(ccdex) - inc: If redd(ccdex) < 0 Then redd(ccdex) = 0
redval$ = Str$(redd(ccdex))
redtop.Text = redval$
Call drawcolorchart
End Sub
Private Sub sredinc_Click()
inc = Val(cincrementlist.Text)
curcol$ = currentcol.Text
ccdex = Val(curcol$)
redd(ccdex) = redd(ccdex) + inc: If redd(ccdex) > 255 Then redd(ccdex) = 255
redval$ = Str$(redd(ccdex))
redtop.Text = redval$
Call drawcolorchart
End Sub
Private Sub sbluedec_Click()
inc = Val(cincrementlist.Text)
curcol$ = currentcol.Text
ccdex = Val(curcol$)
blue(ccdex) = blue(ccdex) - inc: If blue(ccdex) < 0 Then blue(ccdex) = 0
blueval$ = Str$(blue(ccdex))
bluetop.Text = blueval$
Call drawcolorchart
End Sub
Private Sub sblueinc_Click()
inc = Val(cincrementlist.Text)
curcol$ = currentcol.Text
ccdex = Val(curcol$)
blue(ccdex) = blue(ccdex) + inc: If blue(ccdex) > 255 Then blue(ccdex) = 255
blueval$ = Str$(blue(ccdex))
bluetop.Text = blueval$
Call drawcolorchart
End Sub
Private Sub sgreendec_Click()
inc = Val(cincrementlist.Text)
curcol$ = currentcol.Text
ccdex = Val(curcol$)
green(ccdex) = green(ccdex) - inc: If green(ccdex) < 0 Then green(ccdex) = 0
greenval$ = Str$(green(ccdex))
greentop.Text = greenval$
Call drawcolorchart
End Sub
Private Sub sgreeninc_Click()
inc = Val(cincrementlist.Text)
curcol$ = currentcol.Text
ccdex = Val(curcol$)
green(ccdex) = green(ccdex) + inc: If green(ccdex) > 255 Then green(ccdex) = 255
greenval$ = Str$(green(ccdex))
greentop.Text = greenval$
Call drawcolorchart
End Sub
Private Sub ereddec_Click()
inc = Val(cincrementlist.Text)
curcol$ = bottomcolor.Text
ccdex = Val(curcol$)
redd(ccdex) = redd(ccdex) - inc: If redd(ccdex) < 0 Then redd(ccdex) = 0
redval$ = Str$(redd(ccdex))
redbottom.Text = redval$
Call drawcolorchart
End Sub
Private Sub eredinc_Click()
inc = Val(cincrementlist.Text)
curcol$ = bottomcolor.Text
ccdex = Val(curcol$)
redd(ccdex) = redd(ccdex) + inc: If redd(ccdex) > 255 Then redd(ccdex) = 255
redval$ = Str$(redd(ccdex))
redbottom.Text = redval$
Call drawcolorchart
End Sub
Private Sub ebluedec_Click()
inc = Val(cincrementlist.Text)
curcol$ = bottomcolor.Text
ccdex = Val(curcol$)
blue(ccdex) = blue(ccdex) - inc: If blue(ccdex) < 0 Then blue(ccdex) = 0
blueval$ = Str$(blue(ccdex))
bluebottom.Text = blueval$
Call drawcolorchart
End Sub
Private Sub eblueinc_Click()
inc = Val(cincrementlist.Text)
curcol$ = bottomcolor.Text
ccdex = Val(curcol$)
blue(ccdex) = blue(ccdex) + inc: If blue(ccdex) > 255 Then blue(ccdex) = 255
blueval$ = Str$(blue(ccdex))
bluebottom.Text = blueval$
Call drawcolorchart
End Sub
Private Sub egreendec_Click()
inc = Val(cincrementlist.Text)
curcol$ = bottomcolor.Text
ccdex = Val(curcol$)
green(ccdex) = green(ccdex) - inc: If green(ccdex) < 0 Then green(ccdex) = 0
greenval$ = Str$(green(ccdex))
greenbottom.Text = greenval$
Call drawcolorchart
End Sub
Private Sub egreeninc_Click()
inc = Val(cincrementlist.Text)
curcol$ = bottomcolor.Text
ccdex = Val(curcol$)
green(ccdex) = green(ccdex) + inc: If green(ccdex) > 255 Then green(ccdex) = 255
greenval$ = Str$(green(ccdex))
greenbottom.Text = greenval$
Call drawcolorchart
End Sub
Private Sub chtopbtn_Click()
ccdex = currentcol.Text
redd(ccdex) = redtop.Text
green(ccdex) = greentop.Text
blue(ccdex) = bluetop.Text
Call drawcolorchart
End Sub
Private Sub chbotbtn_Click()
ccdex = bottomcolor.Text
redd(ccdex) = redbottom.Text
green(ccdex) = greenbottom.Text
blue(ccdex) = bluebottom.Text
Call drawcolorchart
End Sub
Private Sub gradcolbtn_Click()
colorprompt.Visible = True
colorprompt.Text = " start color < end color start RGB's > end RGB's"
gradenterbtn.Visible = True
End Sub
Private Sub palescapebtn_Click()
palettenamebox.Text = ""
palcaptxt.Text = ""
palcaptxt.Visible = False
palcapenter.Visible = False
palettenamebox.Visible = False
paletteenterbtn.Visible = False
getpaletteenterbtn.Visible = False
currentcol.Text = ""
bottomcolor.Text = ""
colorprompt.Visible = False
gradenterbtn.Visible = False
redtop.Text = ""
bluetop.Text = ""
greentop.Text = ""
redbottom.Text = ""
bluebottom.Text = ""
greenbottom.Text = ""
End Sub
Private Sub gradenterbtn_Click()
LEFTC = currentcol.Text
RIGHTC = bottomcolor.Text
redd(LEFTC) = redtop.Text
blue(LEFTC) = bluetop.Text
green(LEFTC) = greentop.Text
redd(RIGHTC) = redbottom.Text
blue(RIGHTC) = bluebottom.Text
green(RIGHTC) = greenbottom.Text
pinc = ((redd(LEFTC) - redd(RIGHTC)) / (RIGHTC - LEFTC))
INCG = ((green(LEFTC) - green(RIGHTC)) / (RIGHTC - LEFTC))
INCB = ((blue(LEFTC) - blue(RIGHTC)) / (RIGHTC - LEFTC))
For D = LEFTC To (RIGHTC - 1)
If D = 236 Then GoTo endofgrad
redd(D + 1) = Int(redd(D) - pinc)
green(D + 1) = Int(green(D) - INCG)
blue(D + 1) = Int(blue(D) - INCB)
If redd(D + 1) < 0 Then redd(D + 1) = 0
If green(D + 1) < 0 Then green(D + 1) = 0
If blue(D + 1) < 0 Then blue(D + 1) = 0
If redd(D + 1) > 255 Then redd(D + 1) = 255
If green(D + 1) > 255 Then green(D + 1) = 255
If blue(D + 1) > 255 Then blue(D + 1) = 255
Next D
endofgrad:
gradenterbtn.Visible = False
colorprompt.Visible = False
Call drawcolorchart
End Sub
Private Sub savepalbtn_Click()
palettenamebox.Visible = True
paletteenterbtn.Visible = True
palettenamebox.SetFocus
End Sub
Private Sub paletteenterbtn_Click()
PAL$ = palettenamebox.Text
paletteenterbtn.Visible = False
palettenamebox.Text = ""
palettenamebox.Visible = False
Call savepalette
End Sub
Private Sub getpalbtn_Click()
palettenamebox.Visible = True
getpaletteenterbtn.Visible = True
palettenamebox.SetFocus
End Sub
Private Sub getpaletteenterbtn_Click()
PAL$ = palettenamebox.Text
getpaletteenterbtn.Visible = False
palettenamebox.Text = ""
palettenamebox.Visible = False
Call getpalette
End Sub
Sub savepalette()
Dim UHUH As UHUHED
Open "pals\" + PAL$ + ".pal" For Random As #1 Len = 8
For READCOL = 1 To 236
UHUH.BL = blue(READCOL)
UHUH.GR = green(READCOL)
UHUH.RE = redd(READCOL)
Put #1, READCOL, UHUH
Next READCOL
Close #1
End Sub
Sub getpalette()
Dim UHUHS As UHUHER
Open "pals\" + PAL$ + ".pal" For Random As #1 Len = 8
For READCOL = 1 To 236
Get #1, READCOL, UHUHS
blue(READCOL) = UHUHS.BL
green(READCOL) = UHUHS.GR
redd(READCOL) = UHUHS.RE
Next READCOL
Close #1
Call drawcolorchart
End Sub
Private Sub clsbtn_Click()
Set viewport.Picture = LoadPicture("")
End Sub
Private Sub fillscreen_Click()
For bgr = 1 To 1037
viewport.Line (1, bgr)-(1465, bgr), RGB(reddback, greenback, blueback)
Next bgr
End Sub
Private Sub exitbtn_Click()
End
End Sub
Private Sub rogcadbas()
Open "datah\start.txt" For Input As #1
Do While TIPE$ <> "DEFAULTVIEW:"
Input #1, TIPE$
Loop
Input #1, A, B, C, TX, TY, TZ, MM, VSH, HSH
Do While TIPE$ <> "HighZ(full)"
Input #1, TIPE$
Loop
Input #1, zfa, zfb, zfc, zfx, zfy, zfz, zfm, zfv, zfh
Do While TIPE$ <> "HighZ(zoom)"
Input #1, TIPE$
Loop
Input #1, zza, zzb, zzc, zzx, zzy, zzz, zzm, zzv, zzh
Do While TIPE$ <> "FarX(full)"
Input #1, TIPE$
Loop
Input #1, xfa, xfb, xfc, xfx, xfy, xfz, xfm, xfv, xfh
Do While TIPE$ <> "FarX(zoom)"
Input #1, TIPE$
Loop
Input #1, xza, xzb, xzc, xzx, xzy, xzz, xzm, xzv, xzh
Do While TIPE$ <> "FarY(full)"
Input #1, TIPE$
Loop
Input #1, yfa, yfb, yfc, yfx, yfy, yfz, yfm, yfv, yfh
Do While TIPE$ <> "FarY(zoom)"
Input #1, TIPE$
Loop
Input #1, yza, yzb, yzc, yzx, yzy, yzz, yzm, yzv, yzh
Do While TIPE$ <> "Perspective1"
Input #1, TIPE$
Loop
Input #1, p1a, p1b, p1c, p1x, p1y, p1z, p1m, p1v, p1h
Do While TIPE$ <> "Perspective2"
Input #1, TIPE$
Loop
Input #1, p2a, p2b, p2c, p2x, p2y, p2z, p2m, p2v, p2h
Do While TIPE$ <> "Perspective3"
Input #1, TIPE$
Loop
Input #1, p3a, p3b, p3c, p3x, p3y, p3z, p3m, p3v, p3h
Do While TIPE$ <> "Perspective4"
Input #1, TIPE$
Loop
Input #1, p4a, p4b, p4c, p4x, p4y, p4z, p4m, p4v, p4h
Do While TIPE$ <> "DEFAULTPAL:"
Input #1, TIPE$
Loop
Input #1, PAL$
Do While TIPE$ <> "BACKGROUNDCOLOR:"
Input #1, TIPE$
Loop
Input #1, reddback, greenback, blueback
Close #1
Call drawcolorchart
Open "datah\st-0.txt" For Input As #1
GoSub READDATA
Close #1
SS3$ = "AUTOMA"
READATA = 1: ' STD modules must have READATA = 1
Call getpalette
Call mainmod
READSWITCH = 2
GoTo rogcadbasend
READDATA:
POINTS:
Do While TIPE$ <> "STANDARD:"
Input #1, TIPE$
Loop
For RW = 1 To 10000
Input #1, DUMMY%, X(RW), Y(RW), Z(RW)
XR(RW) = X(RW): YR(RW) = Y(RW): ZR(RW) = Z(RW)
If DUMMY% = 9999 Then
NP1 = RW - 1
Exit For
End If
Next RW
LG1:
Do While TIPE$ <> "LINEG1:"
Input #1, TIPE$
Loop
For RL = 1 To 20000
Input #1, FP(RL), SP(RL)
If FP(RL) = 9999 And SP(RL) = 9999 Then
NL1 = RL - 1
Exit For
End If
Next RL
LG2:
Do While TIPE$ <> "LINEG2:"
Input #1, TIPE$
Loop
For RL = (NL1 + 1) To 20000
Input #1, FP(RL), SP(RL)
If FP(RL) = 9999 And SP(RL) = 9999 Then
NL2 = RL - 1 - NL1
Exit For
End If
Next RL
LG3:
Do While TIPE$ <> "LINEG3:"
Input #1, TIPE$
Loop
For RL = (NL1 + NL2 + 1) To 20000
Input #1, FP(RL), SP(RL)
If FP(RL) = 9999 And SP(RL) = 9999 Then
NL3 = RL - 1 - NL1 - NL2
Exit For
End If
Next RL
LG4:
Do While TIPE$ <> "LINEG4:"
Input #1, TIPE$
Loop
For RL = (NL1 + NL2 + NL3 + 1) To 20000
Input #1, FP(RL), SP(RL)
If FP(RL) = 9999 And SP(RL) = 9999 Then
NL4 = RL - 1 - NL1 - NL2 - NL3
Exit For
End If
Next RL
LG5:
Do While TIPE$ <> "LINEG5:"
Input #1, TIPE$
Loop
For RL = (NL1 + NL2 + NL3 + NL4 + 1) To 20000
Input #1, FP(RL), SP(RL)
If FP(RL) = 9999 And SP(RL) = 9999 Then
NL5 = RL - 1 - NL1 - NL2 - NL3 - NL4
Exit For
End If
Next RL
AUTOCUBE:
Do While TIPE$ <> "AUTOCUBE400:"
Input #1, TIPE$
Loop
BLOCKS:
'P is first pt number.
'RL is first line number.
'RPL is first pl number.
P = 4001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 4001
For AC = 400 To 599
BLOK = 1: GoTo B100
B10:
If DUMMY% = 9999 Then Exit For
Next AC
B11:
Do While TIPE$ <> "AUTOCUBE600:"
Input #1, TIPE$
Loop
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5)
NP3 = P - 4000
P = 601: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 6001
For AC = 600 To 799
BLOK = 2: GoTo B100
B20:
If DUMMY% = 9999 Then Exit For
Next AC
B21:
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL7 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP4 = P - 6000
GoTo JKREAD
B100:
Input #1, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROTT(AC), COLAC(AC)
If DUMMY% = 9999 Then GoTo B150
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) = ROTT(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) = ROTT(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) = ROTT(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) = ROTT(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
B150:
If BLOK = 1 Then GoTo B10
If BLOK = 2 Then GoTo B20
JKREAD:
Do While TIPE$ <> "AUTOPLANE:"
Input #1, TIPE$
Loop
For RPL = 1 To 7000
Input #1, DUMMY%, T1(RPL), B1(RPL), T2(RPL), B2(RPL), DIR(RPL), COLR(RPL)
If DUMMY% = 9999 Then Exit For
Next RPL
FRAMINGREAD1:
Do While TIPE$ <> "AUTOFRAMING1:"
Input #1, TIPE$
Loop
Rem Reads 800ne number and number of framing lines
Do While NFL <> 9999
Input #1, PL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM1(PL) = 0: Exit Do
AUTOFRM1(PL) = NFL
Loop
FRAMINGREAD2:
Do While TIPE$ <> "AUTOFRAMING2:"
Input #1, TIPE$
Loop
Do While NFL <> 9999
Input #1, PL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM2(PL) = 0: Exit Do
AUTOFRM2(PL) = NFL
Loop
Call transform
Return
rogcadbasend:
End Sub
Private Sub stbas()
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 7000
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
ROTT(WIPE) = 0
Next WIPE
For WIPE = 1 To 700
COLAC(WIPE) = 0
Next WIPE
'on error GoTo errsbas
Open "datah\" + groupname$ For Input As #1
'Open "..\datah\" + T$ + "-" + G$ + ".txt" For Input As #1
GoSub READDATA
Close #1
READATA = 1: ' STD modules must have READATA = 1
Call mainmod
GoTo sbasend
READDATA:
Do While TIPE$ <> "WIRECOLORS:"
Input #1, TIPE$
Loop
Input #1, K1, K2, K3, K4, K5, K6, K7
POINTS:
Do While TIPE$ <> "STANDARD:"
Input #1, TIPE$
Loop
For RW = 1 To 10000
Input #1, DUMMY%, X(RW), Y(RW), Z(RW)
XR(RW) = X(RW): YR(RW) = Y(RW): ZR(RW) = Z(RW)
If DUMMY% = 9999 Then
NP1 = RW - 1
Exit For
End If
Next RW
LG1:
Do While TIPE$ <> "LINEG1:"
Input #1, TIPE$
Loop
For RL = 1 To 20000
Input #1, FP(RL), SP(RL)
If FP(RL) = 9999 And SP(RL) = 9999 Then
NL1 = RL - 1
Exit For
End If
Next RL
LG2:
Do While TIPE$ <> "LINEG2:"
Input #1, TIPE$
Loop
For RL = (NL1 + 1) To 20000
Input #1, FP(RL), SP(RL)
If FP(RL) = 9999 And SP(RL) = 9999 Then
NL2 = RL - 1 - NL1
Exit For
End If
Next RL
LG3:
Do While TIPE$ <> "LINEG3:"
Input #1, TIPE$
Loop
For RL = (NL1 + NL2 + 1) To 20000
Input #1, FP(RL), SP(RL)
If FP(RL) = 9999 And SP(RL) = 9999 Then
NL3 = RL - 1 - NL1 - NL2
Exit For
End If
Next RL
LG4:
Do While TIPE$ <> "LINEG4:"
Input #1, TIPE$
Loop
For RL = (NL1 + NL2 + NL3 + 1) To 20000
Input #1, FP(RL), SP(RL)
If FP(RL) = 9999 And SP(RL) = 9999 Then
NL4 = RL - 1 - NL1 - NL2 - NL3
Exit For
End If
Next RL
LG5:
Do While TIPE$ <> "LINEG5:"
Input #1, TIPE$
Loop
For RL = (NL1 + NL2 + NL3 + NL4 + 1) To 20000
Input #1, FP(RL), SP(RL)
If FP(RL) = 9999 And SP(RL) = 9999 Then
NL5 = RL - 1 - NL1 - NL2 - NL3 - NL4
Exit For
End If
Next RL
AUTOCUBE:
Do While TIPE$ <> "AUTOCUBE400:"
Input #1, TIPE$
Loop
BLOCKS:
'P is first pt number.
'RL is first line number.
'RPL is first pl number.
P = 4001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 4001
For AC = 400 To 599
BLOK = 1: GoTo B100
B10:
If DUMMY% = 9999 Then Exit For
Next AC
B11:
Do While TIPE$ <> "AUTOCUBE600:"
Input #1, TIPE$
Loop
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5)
NP3 = P - 4000
P = 6001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 6001
For AC = 600 To 799
BLOK = 2: GoTo B100
B20:
If DUMMY% = 9999 Then Exit For
Next AC
B21:
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL7 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6)
NP4 = P - 6000
GoTo JKREAD
B100:
Input #1, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROTT(AC), COLAC(AC)
If DUMMY% = 9999 Then GoTo B150
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) = ROTT(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) = ROTT(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) = ROTT(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) = ROTT(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
B150:
If BLOK = 1 Then GoTo B10
If BLOK = 2 Then GoTo B20
JKREAD:
Do While TIPE$ <> "AUTOPLANE:"
Input #1, TIPE$
Loop
For RPL = 1 To 7000
Input #1, DUMMY%, T1(RPL), B1(RPL), T2(RPL), B2(RPL), DIR(RPL), COLR(RPL)
If DUMMY% = 9999 Then Exit For
Next RPL
FRAMINGREAD1:
Do While TIPE$ <> "AUTOFRAMING1:"
Input #1, TIPE$
Loop
Rem Reads plane number and number of framing lines
Do While NFL <> 9999
Input #1, PL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM1(PL) = 0: Exit Do
AUTOFRM1(PL) = NFL
Loop
FRAMINGREAD2:
Do While TIPE$ <> "AUTOFRAMING2:"
Input #1, TIPE$
Loop
Do While NFL <> 9999
Input #1, PL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM2(PL) = 0: Exit Do
AUTOFRM2(PL) = NFL
Loop
Call transform
Return
sbasend:
GoTo realsbasend
errsbas:
Call oops
realsbasend:
End Sub
Private Sub acbas()
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 7000
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
ROTT(WIPE) = 0
Next WIPE
For WIPE = 1 To 700
COLAC(WIPE) = 0
Next WIPE
'on error GoTo erracbas
Open "datah\" + groupname$ For Input As #1
'Open "..\datah\" + T$ + "-" + G$ + ".txt" For Input As #1
GoSub READDATA
Close #1
READATA = 2: ' AUTOCUBE modules must have READATA = 2
Call mainmod
GoTo acbasend
READDATA:
Do While TIPE$ <> "WIRECOLORS:"
Input #1, TIPE$
Loop
Input #1, K6, K7, K8, K9
AUTOCUBE:
'P is first pt number.
'RL is first line number.
'RPL is first pl number.
Do While TIPE$ <> "AUTOCUBE000:"
Input #1, TIPE$
Loop
P = 1: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 1
For AC = 0 To 199
BLOK = 1: GoTo B100
B10:
If DUMMY% = 9999 Then Exit For
Next AC
B11:
Do While TIPE$ <> "AUTOCUBE200:"
Input #1, 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
For AC = 200 To 399
BLOK = 2: GoTo B100
B20:
If DUMMY% = 9999 Then Exit For
Next AC
B21:
Do While TIPE$ <> "AUTOCUBE400:"
Input #1, 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
For AC = 400 To 599
BLOK = 3: GoTo B100
B30:
If DUMMY% = 9999 Then Exit For
Next AC
B31:
Do While TIPE$ <> "AUTOCUBE600:"
Input #1, 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
BLOK = 4: GoTo B100
B40:
If DUMMY% = 9999 Then Exit For
Next AC
B41:
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL9 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8)
NP4 = P - 6000
GoTo FRAMINGREAD1
B100:
Input #1, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROTT(AC), COLAC(AC)
If DUMMY% = 9999 Then GoTo B150
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) = ROTT(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) = ROTT(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) = ROTT(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) = ROTT(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
B150:
If BLOK = 1 Then GoTo B10
If BLOK = 2 Then GoTo B20
If BLOK = 3 Then GoTo B30
If BLOK = 4 Then GoTo B40
FRAMINGREAD1:
Do While TIPE$ <> "AUTOFRAMING1:"
Input #1, TIPE$
Loop
Rem Reads plane number and number of framing lines
Do While NFL <> 9999
Input #1, PL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM1(PL) = 0: Exit Do
AUTOFRM1(PL) = NFL
Loop
FRAMINGREAD2:
Do While TIPE$ <> "AUTOFRAMING2:"
Input #1, TIPE$
Loop
Do While NFL <> 9999
Input #1, PL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM2(PL) = 0: Exit Do
AUTOFRM2(PL) = NFL
Loop
Call transform
Return
acbasend:
GoTo realacbasend
erracbas:
Call oops
realacbasend:
End Sub
Private Sub axbas()
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 7000
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
ROTT(WIPE) = 0
Next WIPE
For WIPE = 1 To 700
COLAC(WIPE) = 0
Next WIPE
'on error GoTo erraxbas
Open "datah\" + groupname$ For Input As #1
'Open "..\datah\" + T$ + "-" + G$ + ".txt" For Input As #1
GoSub READDATA
Close #1
READATA = 2: ' AUTOCUBE modules must have READATA = 2
Call mainmod
GoTo axbasend
READDATA:
Do While TIPE$ <> "WIRECOLORS:"
Input #1, TIPE$
Loop
Input #1, K6, K7, K8, K9
Do While TIPE$ <> "AUTOCUBE000:"
Input #1, TIPE$
Loop
BLOCKS:
' P is first point number.
' RL is first line number.
' RPL is first plane number.
P = 1: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 1
Input #1, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROOT, COOLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 0 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 1: GoTo B101
B10:
If AC = STOPREAD Then GoTo B11
Next AC
B11:
Do While TIPE$ <> "AUTOCUBE100:"
Input #1, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 1001
RPL = 1001
Input #1, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROOT, COOLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 100 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 2: GoTo B101
B20:
If AC = STOPREAD Then GoTo B21
Next AC
B21:
Do While TIPE$ <> "AUTOCUBE200:"
Input #1, TIPE$
Loop
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5): Rem two blocks per line group
NP1 = P
P = 2001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 2001
Input #1, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROOT, COOLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 200 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 3: GoTo B101
B30:
If AC = STOPREAD Then GoTo B31
Next AC
B31:
Do While TIPE$ <> "AUTOCUBE300:"
Input #1, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 3001
RPL = 3001
Input #1, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROOT, COOLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 300 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 4: GoTo B101
B40:
If AC = STOPREAD Then GoTo B41
Next AC
B41:
Do While TIPE$ <> "AUTOCUBE400:"
Input #1, 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 #1, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROOT, COOLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 400 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 5: GoTo B101
B50:
If AC = STOPREAD Then GoTo B51
Next AC
B51:
Do While TIPE$ <> "AUTOCUBE500:"
Input #1, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 5001
RPL = 5001
Input #1, X1, Y1, Z1, X6, Y6, Z6, XINC, ENDCUBE, ROOT, COOLAC
X1 = X1 - XINC: X6 = X6 - XINC: STOPREAD = ENDCUBE + 1
For AC = 500 To ENDCUBE
X1 = X1 + XINC
X6 = X6 + XINC
BLOK = 6: GoTo B101
B60:
If AC = STOPREAD Then GoTo B61
Next AC
B61:
Do While TIPE$ <> "AUTOCUBE600:"
Input #1, 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 699: Rem cube numbers. (600-699)
BLOK = 7: GoTo B100
B70:
If DUMMY% = 9999 Then Exit For
Next AC
B71:
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL9 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8)
NP4 = P - 6000
GoTo FRAMINGREAD1
B100:
Input #1, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROTT(AC), COLAC(AC)
If DUMMY% = 9999 Then GoTo B150
B101: 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
If BLOK = 7 Then GoTo SINGLES
FMEMBERS:
T1(RPL) = P1: B1(RPL) = P2: T2(RPL) = P3: B2(RPL) = P4
DIR(RPL) = 1: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P3: B1(RPL) = P4: T2(RPL) = P5: B2(RPL) = P6
DIR(RPL) = 2: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P5: B1(RPL) = P6: T2(RPL) = P7: B2(RPL) = P8
DIR(RPL) = 3: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P7: B1(RPL) = P8: T2(RPL) = P1: B2(RPL) = P2
DIR(RPL) = 4: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P1: B1(RPL) = P3: T2(RPL) = P7: B2(RPL) = P5
DIR(RPL) = 5: COLR(RPL) = COOLAC: ROTAT(RPL) = 0: RPL = RPL + 1
T1(RPL) = P2: B1(RPL) = P4: T2(RPL) = P8: B2(RPL) = P6
DIR(RPL) = 6: COLR(RPL) = COOLAC: ROTAT(RPL) = 0: RPL = RPL + 5
GoTo B150
SINGLES:
T1(RPL) = P1: B1(RPL) = P2: T2(RPL) = P3: B2(RPL) = P4
DIR(RPL) = 1: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROTT(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) = ROTT(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) = ROTT(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) = ROTT(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
B150:
If BLOK = 1 Then GoTo B10
If BLOK = 2 Then GoTo B20
If BLOK = 3 Then GoTo B30
If BLOK = 4 Then GoTo B40
If BLOK = 5 Then GoTo B50
If BLOK = 6 Then GoTo B60
If BLOK = 7 Then GoTo B70
'---------------
FRAMINGREAD1:
Do While TIPE$ <> "AUTOFRAMING1:"
Input #1, TIPE$
Loop
Do While NFL <> 9999
Input #1, SPL, EPL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM1(PL) = 0: Exit Do
For PL = SPL To EPL Step 10
AUTOFRM1(PL) = NFL
Next PL
Loop
FRAMINGREAD2:
Do While TIPE$ <> "AUTOFRAMING2:"
Input #1, TIPE$
Loop
Do While NFL <> 9999
Input #1, SPL, EPL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM2(PL) = 0: Exit Do
For PL = SPL To EPL Step 10
AUTOFRM2(PL) = NFL
Next PL
Loop
Call transform
Return
axbasend:
GoTo realaxbasend
erraxbas:
Call oops
realaxbasend:
End Sub
Private Sub aybas()
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 7000
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
ROTT(WIPE) = 0
Next WIPE
For WIPE = 1 To 700
COLAC(WIPE) = 0
Next WIPE
'on error GoTo erray6bas
Open "datah\" + groupname$ For Input As #1
'Open "..\datah\" + T$ + "-" + G$ + ".txt" For Input As #1
GoSub READDATA
Close #1
READATA = 2: ' AUTOCUBE modules must have READATA = 2
Call mainmod
GoTo ay6basend
READDATA:
Do While TIPE$ <> "WIRECOLORS:"
Input #1, TIPE$
Loop
Input #1, K6, K7, K8, K9
Do While TIPE$ <> "AUTOCUBE000:"
Input #1, TIPE$
Loop
BLOCKS:
' P is first point number.
' RL is first line number.
' RPL is first plane number.
P = 1: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 1
Input #1, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROOT, COOLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 0 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 1: GoTo B101
B10:
If AC = STOPREAD Then GoTo B11
Next AC
B11:
Do While TIPE$ <> "AUTOCUBE100:"
Input #1, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 1001
RPL = 1001
Input #1, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROOT, COOLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 100 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 2: GoTo B101
B20:
If AC = STOPREAD Then GoTo B21
Next AC
B21:
Do While TIPE$ <> "AUTOCUBE200:"
Input #1, TIPE$
Loop
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5): Rem two blocks per line group
NP1 = P
P = 2001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 2001
Input #1, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROOT, COOLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 200 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 3: GoTo B101
B30:
If AC = STOPREAD Then GoTo B31
Next AC
B31:
Do While TIPE$ <> "AUTOCUBE300:"
Input #1, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 3001
RPL = 3001
Input #1, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROOT, COOLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 300 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 4: GoTo B101
B40:
If AC = STOPREAD Then GoTo B41
Next AC
B41:
Do While TIPE$ <> "AUTOCUBE400:"
Input #1, 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 #1, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROOT, COOLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 400 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 5: GoTo B101
B50:
If AC = STOPREAD Then GoTo B51
Next AC
B51:
Do While TIPE$ <> "AUTOCUBE500:"
Input #1, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 5001
RPL = 5001
Input #1, X1, Y1, Z1, X6, Y6, Z6, YINC, ENDCUBE, ROOT, COOLAC
Y1 = Y1 - YINC: Y6 = Y6 - YINC: STOPREAD = ENDCUBE + 1
For AC = 500 To ENDCUBE
Y1 = Y1 + YINC
Y6 = Y6 + YINC
BLOK = 6: GoTo B101
B60:
If AC = STOPREAD Then GoTo B61
Next AC
B61:
Do While TIPE$ <> "AUTOCUBE600:"
Input #1, 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 699: Rem cube numbers. (600-699)
BLOK = 7: GoTo B100
B70:
If DUMMY% = 9999 Then Exit For
Next AC
B71:
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL9 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8)
NP4 = P - 6000
GoTo FRAMINGREAD1
B100:
Input #1, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROTT(AC), COLAC(AC)
If DUMMY% = 9999 Then GoTo B150
B101: 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
If BLOK = 7 Then GoTo SINGLES
FMEMBERS:
T1(RPL) = P1: B1(RPL) = P2: T2(RPL) = P3: B2(RPL) = P4
DIR(RPL) = 1: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P3: B1(RPL) = P4: T2(RPL) = P5: B2(RPL) = P6
DIR(RPL) = 2: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P5: B1(RPL) = P6: T2(RPL) = P7: B2(RPL) = P8
DIR(RPL) = 3: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P7: B1(RPL) = P8: T2(RPL) = P1: B2(RPL) = P2
DIR(RPL) = 4: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P1: B1(RPL) = P3: T2(RPL) = P7: B2(RPL) = P5
DIR(RPL) = 5: COLR(RPL) = COOLAC: ROTAT(RPL) = 0: RPL = RPL + 1
T1(RPL) = P2: B1(RPL) = P4: T2(RPL) = P8: B2(RPL) = P6
DIR(RPL) = 6: COLR(RPL) = COOLAC: ROTAT(RPL) = 0: RPL = RPL + 5
GoTo B150
SINGLES:
T1(RPL) = P1: B1(RPL) = P2: T2(RPL) = P3: B2(RPL) = P4
DIR(RPL) = 1: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROTT(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) = ROTT(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) = ROTT(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) = ROTT(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
B150:
If BLOK = 1 Then GoTo B10
If BLOK = 2 Then GoTo B20
If BLOK = 3 Then GoTo B30
If BLOK = 4 Then GoTo B40
If BLOK = 5 Then GoTo B50
If BLOK = 6 Then GoTo B60
If BLOK = 7 Then GoTo B70
'---------------
FRAMINGREAD1:
Do While TIPE$ <> "AUTOFRAMING1:"
Input #1, TIPE$
Loop
Do While NFL <> 9999
Input #1, SPL, EPL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM1(PL) = 0: Exit Do
For PL = SPL To EPL Step 10
AUTOFRM1(PL) = NFL
Next PL
Loop
FRAMINGREAD2:
Do While TIPE$ <> "AUTOFRAMING2:"
Input #1, TIPE$
Loop
Do While NFL <> 9999
Input #1, SPL, EPL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM2(PL) = 0: Exit Do
For PL = SPL To EPL Step 10
AUTOFRM2(PL) = NFL
Next PL
Loop
Call transform
Return
ay6basend:
GoTo realay6basend
erray6bas:
Call oops
realay6basend:
End Sub
Private Sub azbas()
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 7000
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
ROTT(WIPE) = 0
Next WIPE
For WIPE = 1 To 700
COLAC(WIPE) = 0
Next WIPE
'on error GoTo erraz6bas
Open "datah\" + groupname$ For Input As #1
'Open "..\datah\" + T$ + "-" + G$ + ".txt" For Input As #1
GoSub READDATA
Close #1
READATA = 2: ' AUTOCUBE modules must have READATA = 2
Call mainmod
GoTo az6basend
READDATA:
Do While TIPE$ <> "WIRECOLORS:"
Input #1, TIPE$
Loop
Input #1, K6, K7, K8, K9
Do While TIPE$ <> "AUTOCUBE000:"
Input #1, TIPE$
Loop
BLOCKS:
' P is first point number.
' RL is first line number.
' RPL is first plane number.
P = 1: RL = NL1 + NL2 + NL3 + NL4 + NL5 + 1
RPL = 1
Input #1, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROOT, COOLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 0 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 1: GoTo B101
B10:
If AC = STOPREAD Then GoTo B11
Next AC
B11:
Do While TIPE$ <> "AUTOCUBE100:"
Input #1, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 1001
RPL = 1001
Input #1, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROOT, COOLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 100 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 2: GoTo B101
B20:
If AC = STOPREAD Then GoTo B21
Next AC
B21:
Do While TIPE$ <> "AUTOCUBE200:"
Input #1, TIPE$
Loop
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL6 = RL - (NL1 + NL2 + NL3 + NL4 + NL5): Rem two blocks per line group
NP1 = P
P = 2001: RL = NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + 1
RPL = 2001
Input #1, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROOT, COOLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 200 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 3: GoTo B101
B30:
If AC = STOPREAD Then GoTo B31
Next AC
B31:
Do While TIPE$ <> "AUTOCUBE300:"
Input #1, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 3001
RPL = 3001
Input #1, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROOT, COOLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 300 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 4: GoTo B101
B40:
If AC = STOPREAD Then GoTo B41
Next AC
B41:
Do While TIPE$ <> "AUTOCUBE400:"
Input #1, 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 #1, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROOT, COOLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 400 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 5: GoTo B101
B50:
If AC = STOPREAD Then GoTo B51
Next AC
B51:
Do While TIPE$ <> "AUTOCUBE500:"
Input #1, TIPE$
Loop
P = P - 1: RPL = RPL - 5
P = 5001
RPL = 5001
Input #1, X1, Y1, Z1, X6, Y6, Z6, ZINC, ENDCUBE, ROOT, COOLAC
Z1 = Z1 - ZINC: Z6 = Z6 - ZINC: STOPREAD = ENDCUBE + 1
For AC = 500 To ENDCUBE
Z1 = Z1 + ZINC
Z6 = Z6 + ZINC
BLOK = 6: GoTo B101
B60:
If AC = STOPREAD Then GoTo B61
Next AC
B61:
Do While TIPE$ <> "AUTOCUBE600:"
Input #1, 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 699: Rem cube numbers. (600-699)
BLOK = 7: GoTo B100
B70:
If DUMMY% = 9999 Then Exit For
Next AC
B71:
P = P - 1: RL = RL - 1: RPL = RPL - 5
NL9 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8)
NP4 = P - 6000
GoTo FRAMINGREAD1
B100:
Input #1, DUMMY%, X1, Y1, Z1, X6, Y6, Z6, ROTT(AC), COLAC(AC)
If DUMMY% = 9999 Then GoTo B150
B101: 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
If BLOK = 7 Then GoTo SINGLES
FMEMBERS:
T1(RPL) = P1: B1(RPL) = P2: T2(RPL) = P3: B2(RPL) = P4
DIR(RPL) = 1: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P3: B1(RPL) = P4: T2(RPL) = P5: B2(RPL) = P6
DIR(RPL) = 2: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P5: B1(RPL) = P6: T2(RPL) = P7: B2(RPL) = P8
DIR(RPL) = 3: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P7: B1(RPL) = P8: T2(RPL) = P1: B2(RPL) = P2
DIR(RPL) = 4: COLR(RPL) = COOLAC: ROTAT(RPL) = ROOT: RPL = RPL + 1
T1(RPL) = P1: B1(RPL) = P3: T2(RPL) = P7: B2(RPL) = P5
DIR(RPL) = 5: COLR(RPL) = COOLAC: ROTAT(RPL) = 0: RPL = RPL + 1
T1(RPL) = P2: B1(RPL) = P4: T2(RPL) = P8: B2(RPL) = P6
DIR(RPL) = 6: COLR(RPL) = COOLAC: ROTAT(RPL) = 0: RPL = RPL + 5
GoTo B150
SINGLES:
T1(RPL) = P1: B1(RPL) = P2: T2(RPL) = P3: B2(RPL) = P4
DIR(RPL) = 1: COLR(RPL) = COLAC(AC): ROTAT(RPL) = ROTT(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) = ROTT(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) = ROTT(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) = ROTT(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
B150:
If BLOK = 1 Then GoTo B10
If BLOK = 2 Then GoTo B20
If BLOK = 3 Then GoTo B30
If BLOK = 4 Then GoTo B40
If BLOK = 5 Then GoTo B50
If BLOK = 6 Then GoTo B60
If BLOK = 7 Then GoTo B70
'---------------
FRAMINGREAD1:
Do While TIPE$ <> "AUTOFRAMING1:"
Input #1, TIPE$
Loop
Do While NFL <> 9999
Input #1, SPL, EPL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM1(PL) = 0: Exit Do
For PL = SPL To EPL Step 10
AUTOFRM1(PL) = NFL
Next PL
Loop
FRAMINGREAD2:
Do While TIPE$ <> "AUTOFRAMING2:"
Input #1, TIPE$
Loop
Do While NFL <> 9999
Input #1, SPL, EPL, NFL
If NFL = 9999 Then NFL = 0: AUTOFRM2(PL) = 0: Exit Do
For PL = SPL To EPL Step 10
AUTOFRM2(PL) = NFL
Next PL
Loop
Call transform
Return
az6basend:
GoTo realaz6basend
erraz6bas:
Call oops
realaz6basend:
End Sub
Private Sub cxbas()
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
'on error GoTo errcxbas
Open "datah\" + groupname$ For Input As #1
'Open "..\datah\" + T$ + "-" + G$ + ".txt" For Input As #1
GoSub READDATA
Close #1
READATA = 3: ' CURV modules must have READATA = 3
Call mainmod
GoTo cxbasend
READDATA:
Do While TIPE$ <> "WIRECOLORS:"
Input #1, TIPE$
Loop
Input #1, K10
CIRC = 0: RL = 1: CP = -99: PP = -49: RPL = -49: cnt = 0:
Do While TIPE$ <> "CURVDATA:"
Input #1, TIPE$
Loop
For RD = 1 To 20
Input #1, FIN(RD)
Input #1, DEGB(RD), ARCB(RD), RADZB(RD), RADYB(RD)
Input #1, XB(RD), YB(RD), ZB(RD), LB(RD), INKB(RD), STREB(RD)
Input #1, DEGT(RD), ARCT(RD), RADZT(RD), RADYT(RD)
Input #1, XT(RD), YT(RD), ZT(RD), LT(RD), INCT(RD), STRET(RD)
If FIN(RD) = 9999 Then Exit For
NP6 = NP6 + 100
cnt = cnt + 1
Next RD
POINTS:
For RD = 1 To cnt
'bottom
DEG1 = DEGB(RD): DEG2 = DEG1 + ARCB(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
XDEG = LB(RD)
For inc = 0 To 49
CIRC = CIRC + 1
Z(CIRC) = (RADZB(RD) * Cos(DEG1 + (inc / 49) * (DEG1 - DEG2))) + ZB(RD)
Y(CIRC) = (RADYB(RD) * Sin(DEG1 + (inc / 49) * (DEG1 - DEG2))) + YB(RD)
If INKB(RD) = 0 Then X(CIRC) = XB(RD): GoTo 10
XDEG = XDEG - INKB(RD)
XRAD = STREB(RD) * (Cos((XDEG * 3.14159) / 180))
X(CIRC) = (-1 * (XRAD)) + XB(RD)
10 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
XDEG = LT(RD)
For inc = 0 To 49
CIRC = CIRC + 1
Z(CIRC) = (RADZT(RD) * Cos(DEG1 + (inc / 49) * (DEG1 - DEG2))) + ZT(RD)
Y(CIRC) = (RADYT(RD) * Sin(DEG1 + (inc / 49) * (DEG1 - DEG2))) + YT(RD)
If INCT(RD) = 0 Then X(CIRC) = XT(RD): GoTo 20
XDEG = XDEG - INCT(RD)
XRAD = STRET(RD) * (Cos((XDEG * 3.14159) / 180))
X(CIRC) = (-1 * (XRAD)) + XT(RD)
20 XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
Next inc
Next RD
'Connect points
' high res
' 1, 51, 2, 52, ... 50,100 parallels ( 50 lines)
' 1, 2, 2, 3, ... 49, 50 arcs (49 lines)
' low res (this version)
' 1, 11, 2, 12, ... 10,20 parallels ( 10 lines)
' 1, 2, 2, 3, ... 9, 10 arcs (9 lines)
CONNECT:
For CON = 1 To cnt
CP = CP + 100: ' (CP=1 on first loop) (+ 100 each loop)
For cntb = 1 To 50
FP(RL) = CP: SP(RL) = CP + 50: RL = RL + 1: CP = CP + 1
Next cntb
CP = CP - 50: ' (CP=1 on first loop) (+ 100 each loop)
For cntb = 1 To 49
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
Next cntb
CP = CP + 1: ' (CP=51 on first loop) (+ 100 each loop)
For cntb = 1 To 49
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
Next cntb
CP = CP - 99
Next CON
PLANES:
For CON = 1 To cnt
PP = PP + 50: RPL = RPL + 50
For cntb = 1 To 49
B1(RPL) = PP: T1(RPL) = PP + 1
B2(RPL) = PP + 50: T2(RPL) = PP + 51
RPL = RPL + 1: PP = PP + 1
Next cntb
PP = PP + 1: RPL = RPL + 1
Next CON
RL = RL - 2
NL10 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9)
Call transform
Return
cxbasend:
GoTo realcxbasend
errcxbas:
Call oops
realcxbasend:
End Sub
Private Sub cybas()
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
'on error GoTo errcybas
Open "datah\" + groupname$ For Input As #1
'Open "..\datah\" + T$ + "-" + G$ + ".txt" For Input As #1
GoSub READDATA
Close #1
READATA = 3: ' CURV modules must have READATA = 3
Call mainmod
GoTo cybasend
READDATA:
Do While TIPE$ <> "WIRECOLORS:"
Input #1, TIPE$
Loop
Input #1, K10
CIRC = 0: RL = 1: CP = -99: PP = -49: RPL = -49: cnt = 0:
Do While TIPE$ <> "CURVDATA:"
Input #1, TIPE$
Loop
For RD = 1 To 20
Input #1, FIN(RD)
Input #1, DEGB(RD), ARCB(RD), RADXB(RD), RADZB(RD)
Input #1, XB(RD), YB(RD), ZB(RD), LB(RD), INKB(RD), STREB(RD)
Input #1, DEGT(RD), ARCT(RD), RADXT(RD), RADZT(RD)
Input #1, XT(RD), YT(RD), ZT(RD), LT(RD), INCT(RD), STRET(RD)
If FIN(RD) = 9999 Then Exit For
NP6 = NP6 + 100
cnt = cnt + 1
Next RD
POINTS:
For RD = 1 To cnt
'bottom
DEG1 = DEGB(RD): DEG2 = DEG1 + ARCB(RD)
DEG1 = (DEG1 * 3.14159) / 180: DEG2 = (DEG2 * 3.14159) / 180
YDEG = LB(RD)
For inc = 0 To 49
CIRC = CIRC + 1
X(CIRC) = (RADXB(RD) * Sin(DEG1 + (inc / 49) * (DEG1 - DEG2))) + XB(RD)
Z(CIRC) = (RADZB(RD) * Cos(DEG1 + (inc / 49) * (DEG1 - DEG2))) + ZB(RD)
If INKB(RD) = 0 Then Y(CIRC) = YB(RD): GoTo 10
YDEG = YDEG - INKB(RD)
YRAD = STREB(RD) * (Cos((YDEG * 3.14159) / 180))
Y(CIRC) = (-1 * (YRAD)) + YB(RD)
10 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
YDEG = LT(RD)
For inc = 0 To 49
CIRC = CIRC + 1
X(CIRC) = (RADXT(RD) * Sin(DEG1 + (inc / 49) * (DEG1 - DEG2))) + XT(RD)
Z(CIRC) = (RADZT(RD) * Cos(DEG1 + (inc / 49) * (DEG1 - DEG2))) + ZT(RD)
If INCT(RD) = 0 Then Y(CIRC) = YT(RD): GoTo 20
YDEG = YDEG - INCT(RD)
YRAD = STRET(RD) * (Cos((YDEG * 3.14159) / 180))
Y(CIRC) = (-1 * (YRAD)) + YT(RD)
20 XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
Next inc
Next RD
'Connect points
' high res
' 1, 51, 2, 52, ... 50,100 parallels ( 50 lines)
' 1, 2, 2, 3, ... 49, 50 arcs (49 lines)
' low res (this version)
' 1, 11, 2, 12, ... 10,20 parallels ( 10 lines)
' 1, 2, 2, 3, ... 9, 10 arcs (9 lines)
CONNECT:
For CON = 1 To cnt
CP = CP + 100: ' (CP=1 on first loop) (+ 100 each loop)
For cntb = 1 To 50
FP(RL) = CP: SP(RL) = CP + 50: RL = RL + 1: CP = CP + 1
Next cntb
CP = CP - 50: ' (CP=1 on first loop) (+ 100 each loop)
For cntb = 1 To 49
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
Next cntb
CP = CP + 1: ' (CP=51 on first loop) (+ 100 each loop)
For cntb = 1 To 49
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
Next cntb
CP = CP - 99
Next CON
PLANES:
For CON = 1 To cnt
PP = PP + 50: RPL = RPL + 50
For cntb = 1 To 49
B1(RPL) = PP: T1(RPL) = PP + 1
B2(RPL) = PP + 50: T2(RPL) = PP + 51
RPL = RPL + 1: PP = PP + 1
Next cntb
PP = PP + 1: RPL = RPL + 1
Next CON
RL = RL - 2
NL10 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9)
Call transform
Return
cybasend:
GoTo realcybasend
errcybas:
Call oops
realcybasend:
End Sub
Private Sub czbas()
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
''on error GoTo errczbas
Open "datah\" + groupname$ For Input As #1
'Open "..\datah\" + T$ + "-" + G$ + ".txt" For Input As #1
GoSub READDATA
Close #1
READATA = 3: ' CURV modules must have READATA = 3
Call mainmod
GoTo czbasend
READDATA:
Do While TIPE$ <> "WIRECOLORS:"
Input #1, TIPE$
Loop
Input #1, K10
CIRC = 0: RL = 1: CP = -99: PP = -49: RPL = -49: cnt = 0:
Do While TIPE$ <> "CURVDATA:"
Input #1, TIPE$
Loop
For RD = 1 To 20
Input #1, FIN(RD)
Input #1, DEGB(RD), ARCB(RD), RADXB(RD), RADYB(RD)
Input #1, XB(RD), YB(RD), ZB(RD), LB(RD), INKB(RD), STREB(RD)
Input #1, DEGT(RD), ARCT(RD), RADXT(RD), RADYT(RD)
Input #1, XT(RD), YT(RD), ZT(RD), LT(RD), INCT(RD), STRET(RD)
If FIN(RD) = 9999 Then Exit For
NP6 = NP6 + 100
cnt = cnt + 1
Next RD
POINTS:
For RD = 1 To cnt
'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 49
CIRC = CIRC + 1
X(CIRC) = (RADXB(RD) * Cos(DEG1 + (inc / 49) * (DEG1 - DEG2))) + XB(RD)
Y(CIRC) = (RADYB(RD) * Sin(DEG1 + (inc / 49) * (DEG1 - DEG2))) + YB(RD)
If INKB(RD) = 0 Then Z(CIRC) = ZB(RD): GoTo 10
ZDEG = ZDEG - INKB(RD)
ZRAD = STREB(RD) * (Cos((ZDEG * 3.14159) / 180))
Z(CIRC) = (-1 * (ZRAD)) + ZB(RD)
10 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 49
CIRC = CIRC + 1
X(CIRC) = (RADXT(RD) * Cos(DEG1 + (inc / 49) * (DEG1 - DEG2))) + XT(RD)
Y(CIRC) = (RADYT(RD) * Sin(DEG1 + (inc / 49) * (DEG1 - DEG2))) + YT(RD)
If INCT(RD) = 0 Then Z(CIRC) = ZT(RD): GoTo 20
ZDEG = ZDEG - INCT(RD)
ZRAD = STRET(RD) * (Cos((ZDEG * 3.14159) / 180))
Z(CIRC) = (-1 * (ZRAD)) + ZT(RD)
20 XR(CIRC) = X(CIRC): YR(CIRC) = Y(CIRC): ZR(CIRC) = Z(CIRC)
Next inc
Next RD
'Connect points
' high res
' 1, 51, 2, 52, ... 50,100 parallels ( 50 lines)
' 1, 2, 2, 3, ... 49, 50 arcs (49 lines)
' low res (this version)
' 1, 11, 2, 12, ... 10,20 parallels ( 10 lines)
' 1, 2, 2, 3, ... 9, 10 arcs (9 lines)
CONNECT:
For CON = 1 To cnt
CP = CP + 100: ' (CP=1 on first loop) (+ 100 each loop)
For cntb = 1 To 50
FP(RL) = CP: SP(RL) = CP + 50: RL = RL + 1: CP = CP + 1
Next cntb
CP = CP - 50: ' (CP=1 on first loop) (+ 100 each loop)
For cntb = 1 To 49
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
Next cntb
CP = CP + 1: ' (CP=51 on first loop) (+ 100 each loop)
For cntb = 1 To 49
FP(RL) = CP: SP(RL) = CP + 1: RL = RL + 1: CP = CP + 1
Next cntb
CP = CP - 99
Next CON
PLANES:
For CON = 1 To cnt
PP = PP + 50: RPL = RPL + 50
For cntb = 1 To 49
B1(RPL) = PP: T1(RPL) = PP + 1
B2(RPL) = PP + 50: T2(RPL) = PP + 51
RPL = RPL + 1: PP = PP + 1
Next cntb
PP = PP + 1: RPL = RPL + 1
Next CON
RL = RL - 2
NL10 = RL - (NL1 + NL2 + NL3 + NL4 + NL5 + NL6 + NL7 + NL8 + NL9)
Call transform
Return
czbasend:
GoTo realczbasend
errczbas:
Call oops
realczbasend:
End Sub
Private Sub transform()
TRANSFORMATIONS:
Do While TIPE$ <> "TRAN"
Input #1, TIPE$
Loop
Input #1, 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$ = "ZWRAP:" Then GoTo ZWRAPIT
If TIPE$ = "XWRAP:" Then GoTo XWRAPIT
If TIPE$ = "YWRAP:" Then GoTo YWRAPIT
If TIPE$ = "STOP" Then GoTo RETOIN
XT:
For RD = 1 To 10000
Input #1, RRRRR, ALUE
If RRRRR = 9999 Then Exit For
X(RRRRR) = ALUE: XR(RRRRR) = ALUE
Next RD
GoTo TRANSFORMATIONS
YT:
For RD = 1 To 10000
Input #1, RRRRR, ALUE
If RRRRR = 9999 Then Exit For
Y(RRRRR) = ALUE: YR(RRRRR) = ALUE
Next RD
GoTo TRANSFORMATIONS
ZT:
For RD = 1 To 10000
Input #1, RRRRR, ALUE
If RRRRR = 9999 Then Exit For
Z(RRRRR) = ALUE: ZR(RRRRR) = ALUE
Next RD
GoTo TRANSFORMATIONS
RESIZE:
For RD = 1 To 7000
Input #1, First, Last, MULTX, MULTY, MULTZ
If First = 9999 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 7000
Input #1, First, Last, XANGLE, TRANX, TRANY, TRANZ
If First = 9999 Then Exit For
XANGLE = (XANGLE * 3.14159) / 180
For ROTA = First To Last
Y(ROTA) = (YR(ROTA) * Cos(XANGLE)) - (ZR(ROTA) * Sin(XANGLE)) + TRANY
Z(ROTA) = (YR(ROTA) * Sin(XANGLE)) + (ZR(ROTA) * Cos(XANGLE)) + TRANZ
X(ROTA) = XR(ROTA) + TRANX
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
Next RD
GoTo TRANSFORMATIONS
YROT:
For RD = 1 To 7000
Input #1, First, Last, YANGLE, TRANX, TRANY, TRANZ
If First = 9999 Then Exit For
YANGLE = (YANGLE * 3.14159) / 180
For ROTA = First To Last
Z(ROTA) = (ZR(ROTA) * Cos(YANGLE)) - (XR(ROTA) * Sin(YANGLE)) + TRANZ
X(ROTA) = (ZR(ROTA) * Sin(YANGLE)) + (XR(ROTA) * Cos(YANGLE)) + TRANX
Y(ROTA) = YR(ROTA) + TRANY
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
Next RD
GoTo TRANSFORMATIONS
ZROT:
For RD = 1 To 7000
Input #1, First, Last, ZANGLE, TRANX, TRANY, TRANZ
If First = 9999 Then Exit For
ZANGLE = (ZANGLE * 3.14159) / 180
For ROTA = First To Last
X(ROTA) = (XR(ROTA) * Cos(ZANGLE)) - (YR(ROTA) * Sin(ZANGLE)) + TRANX
Y(ROTA) = (XR(ROTA) * Sin(ZANGLE)) + (YR(ROTA) * Cos(ZANGLE)) + TRANY
Z(ROTA) = ZR(ROTA) + TRANZ
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
Next RD
GoTo TRANSFORMATIONS
TRANSLATE:
For RD = 1 To 7000
Input #1, First, Last, TRANX, TRANY, TRANZ
If First = 9999 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 7000
Input #1, First, Last, TRANX, TRANY, TRANZ
If First = 9999 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
ZWRAPIT:
For RD = 1 To 7000
Input #1, First, Last, wrapangle, wrapnum, liftmult, liftvalue
If First = 9999 Then Exit For
zmult = liftmult
wrapfirst = First - 10: wraplast = Last - 10
ZANGLE = 0: zlift = 0: wrapangle = (wrapangle * 3.14159) / 180
For zwrap = 1 To wrapnum
zlift = zlift + liftvalue
ZANGLE = ZANGLE + wrapangle
wrapfirst = wrapfirst + 10: wraplast = wraplast + 10
zmult = zmult + 1
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) + zmult * zlift
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
Next zwrap
Next RD
GoTo TRANSFORMATIONS
XWRAPIT:
For RD = 1 To 7000
Input #1, First, Last, wrapangle, wrapnum, liftmult, liftvalue
If First = 9999 Then Exit For
xmult = liftmult
wrapfirst = First - 10: wraplast = Last - 10
XANGLE = 0: xlift = 0: wrapangle = (wrapangle * 3.14159) / 180
For xwrap = 1 To wrapnum
xlift = xlift + liftvalue
XANGLE = XANGLE + wrapangle
wrapfirst = wrapfirst + 10: wraplast = wraplast + 10
xmult = xmult + 1
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) + xmult * 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 7000
Input #1, First, Last, wrapangle, wrapnum, liftmult, liftvalue
If First = 9999 Then Exit For
ymult = liftmult
wrapfirst = First - 10: wraplast = Last - 10
YANGLE = 0: ylift = 0: wrapangle = (wrapangle * 3.14159) / 180
For ywrap = 1 To wrapnum
ylift = ylift + liftvalue
YANGLE = YANGLE + wrapangle
wrapfirst = wrapfirst + 10: wraplast = wraplast + 10
ymult = ymult + 1
For ROTA = wrapfirst To wraplast
Z(ROTA) = (ZR(ROTA) * Cos(YANGLE)) - (XR(ROTA) * Sin(YANGLE))
X(ROTA) = (ZR(ROTA) * Sin(YANGLE)) + (XR(ROTA) * Cos(YANGLE))
Y(ROTA) = YR(ROTA) + ymult * ylift
XR(ROTA) = X(ROTA): YR(ROTA) = Y(ROTA): ZR(ROTA) = Z(ROTA)
Next ROTA
Next ywrap
Next RD
GoTo TRANSFORMATIONS
RETOIN:
End Sub
Private Sub hidebtn_Click()
hidebtn.Visible = False
showbtn.Visible = True
READSWITCH = 2
End Sub
Private Sub showbtn_Click()
showbtn.Visible = False
hidebtn.Visible = True
READSWITCH = 1
End Sub
Private Sub mainmod()
' main.mod
' rogcad2\nonuser
'last used S8, S5$
'If S7 = 1 Then S7 = 0: GoTo 1320
'If S4 = 1 Then S4 = 0: GoTo 1330 (colorswitch)
'If READSWITCH = 1 Or READSWITCH = 2 Then GoTo 50
'If AP = 0 And ICHK = 0 Then CLS
50:
'If AP = 1 Then GoTo 1100
'If ICHK = 1 Then GoTo 870
550:
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
jump = 1
End If
Call mainbody
End Sub
Private Sub mainbody()
If jump = 1 Then jump = 0: GoTo 690
570
'VSH = Val(fastv): HSH = Val(fasth)
'verttxt.Text = Str$(fastv)
'horiztxt.Text = Str$(fasth)
CHK = 0
600:
If SS3$ = "AUTOMA" Then
If TX = A And TY = B Then A = A * 0.997
If TX = A And TZ = C Then A = A * 0.998
If TY = B And TZ = C Then B = B * 0.999
If TY = 0 Then TY = 0.1
If TX = 0 Then TX = 0.1
If TZ = 0 Then TZ = 0.1
If A = 0 Then A = 0.1
If B = 0 Then B = 0.1
If C = 0 Then C = 0.1
If A / B = TX / TY Then A = A * 0.997
If A / C = TX / TZ Then A = A * 0.998
If B / C = TY / TZ Then B = B * 0.999
RA = A: RB = B: RC = C
SS3$ = "PROMPT": GoTo 685
End If
685:
MM = 10 * MM: MAG = MM
690 ' (keep this)
B690: 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 691
If READATA = 2 Then GoTo 692
If READATA = 3 Then GoTo 693
691:
For RRRR = 1 To NP1
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 4001 To 4000 + NP3
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 6001 To 6000 + NP4
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
GoTo 700
692:
For RRRR = 1 To NP1
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 2001 To 2000 + NP2
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 4001 To 4000 + NP3
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 6001 To 6000 + NP4
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
GoTo 700
693:
For RRRR = 1 To NP6
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
700 X(8001) = 0: Y(8001) = 0: Z(8001) = 1
GoTo 880
870:
For RRRR = 7001 To (2 * (LL(GB)) - 7000)
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
If ICHK = 1 Then GoTo 1040
880:
I = 0.94 * A
J = 0.94 * B
K = 0.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))
900:
'calculator
If CHK = 0 Then G = 8001: GoTo 1100
950:
If READSWITCH = 0 Then Cls
For GB = 1 To 10
If GB = 1 And NL1 = 0 Then GoTo 1310
If GB = 2 And NL2 = 0 Then GoTo 1310
If GB = 3 And NL3 = 0 Then GoTo 1310
If GB = 4 And NL4 = 0 Then GoTo 1310
If GB = 5 And NL5 = 0 Then GoTo 1310
If GB = 6 And NL6 = 0 Then GoTo 1310
If GB = 7 And NL7 = 0 Then GoTo 1310
If GB = 8 And NL8 = 0 Then GoTo 1310
If GB = 9 And NL9 = 0 Then GoTo 1310
If GB = 10 And NL10 = 0 Then GoTo 1310
If GB = 1 Then cdex = K1: GoTo 1040
If GB = 2 Then cdex = K2: GoTo 1040
If GB = 3 Then cdex = K3: GoTo 1040
If GB = 4 Then cdex = K4: GoTo 1040
If GB = 5 Then cdex = K5: GoTo 1040
If GB = 6 Then cdex = K6: GoTo 1040
If GB = 7 Then cdex = K7: GoTo 1040
If GB = 8 Then cdex = K8: GoTo 1040
If GB = 9 Then cdex = K9: GoTo 1040
If GB = 10 Then cdex = K10: GoTo 1040
1040 'calculator kernel
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)))
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 - Z(G)))) / W
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))
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
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:
'FOR DLY = 1 TO 500000
'NEXT DLY
viewport.Line (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN))), RGB(redd(cdex), green(cdex), blue(cdex))
1290 Next LN
'If ICHK = 1 Then ICHK = 0: CHAIN "ENHANCE.MOD"
1310 Next GB
'READSWITCH = 2
PSW = 0
AA = RA + TX: BB = RB + TY: CC = RC + TZ
MA = MM * 0.1: MAD = MA
perptxtx.Text = AA
perptxty.Text = BB
perptxtz.Text = CC
focustxtx.Text = TX
focustxty.Text = TY
focustxtz.Text = TZ
magtxt.Text = MAD
verttxt.Text = VSH
horiztxt.Text = HSH
GoTo mainbodyend
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)) = 9999: 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)) = 9999: 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
mainbodyend:
End Sub
Private Sub incrementbtn_Click()
incrementlist.Visible = True
End Sub
Private Sub incrementlist_Click()
incrementlist.Visible = False
End Sub
Private Sub arrowbtn_Click()
incrementlist.Visible = True
arrowbtn.Visible = False
incrementbtn.Visible = True
Call Refresh
End Sub
Private Sub refresher()
MAIN:
2000:
If READATA = 1 Then GoTo 2011
If READATA = 2 Then GoTo 2012
If READATA = 3 Then GoTo 2013
2011:
For RRRR = 1 To NP1
X(RRRR) = XR(RRRR): Y(RRRR) = YR(RRRR): Z(RRRR) = ZR(RRRR)
Next RRRR
For RRRR = 4001 To (NP3 + 4000)
X(RRRR) = XR(RRRR): Y(RRRR) = YR(RRRR): Z(RRRR) = ZR(RRRR)
Next RRRR
For RRRR = 6001 To (NP4 + 6000)
X(RRRR) = XR(RRRR): Y(RRRR) = YR(RRRR): Z(RRRR) = ZR(RRRR)
Next RRRR
GoTo 2100
2012:
For RRRR = 1 To NP1
X(RRRR) = XR(RRRR): Y(RRRR) = YR(RRRR): Z(RRRR) = ZR(RRRR)
Next RRRR
For RRRR = 2001 To 2000 + NP2
X(RRRR) = XR(RRRR): Y(RRRR) = YR(RRRR): Z(RRRR) = ZR(RRRR)
Next RRRR
For RRRR = 4001 To 4000 + NP3
X(RRRR) = XR(RRRR): Y(RRRR) = YR(RRRR): Z(RRRR) = ZR(RRRR)
Next RRRR
For RRRR = 6001 To 6000 + NP4
X(RRRR) = XR(RRRR): Y(RRRR) = YR(RRRR): Z(RRRR) = ZR(RRRR)
Next RRRR
GoTo 2100
2013:
For RRRR = 1 To NP6
X(RRRR) = XR(RRRR): Y(RRRR) = YR(RRRR): Z(RRRR) = ZR(RRRR)
Next RRRR
2100:
End Sub
Private Sub cventerbtn_Click()
S1 = 0
Call refresher
A = perptxtx.Text
B = perptxty.Text
C = perptxtz.Text
TX = focustxtx.Text
TY = focustxty.Text
TZ = focustxtz.Text
MM = magtxt.Text
If TX = A And TY = B Then A = A * 0.997
If TX = A And TZ = C Then A = A * 0.998
If TY = B And TZ = C Then B = B * 0.999
If TY = 0 Then TY = 0.1
If TX = 0 Then TX = 0.1
If TZ = 0 Then TZ = 0.1
If A = 0 Then A = 0.1
If B = 0 Then B = 0.1
If C = 0 Then C = 0.1
If A / B = TX / TY Then A = A * 0.997
If A / C = TX / TZ Then A = A * 0.998
If B / C = TY / TZ Then B = B * 0.999
RA = A: RB = B: RC = C
For bgr = 1 To 1037
viewport.Line (1, bgr)-(1465, bgr), RGB(reddback, greenback, blueback)
Next bgr
'Set viewport.Picture = LoadPicture("bmps\" + cap$)
Call mainbody
AA = RA + TX: BB = RB + TY: CC = RC + TZ
perptxtx.Text = Left$(AA, 5)
perptxty.Text = Left$(BB, 5)
perptxtz.Text = Left$(CC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$((MM / 10), 5)
verttxt.Text = Left$(VSH, 3)
horiztxt.Text = Left$(HSH, 3)
End Sub
Private Sub fastchange_Click()
quickchange.Visible = True
End Sub
Private Sub quickchange_Click()
fastchoice$ = quickchange.Text
If fastchoice$ = "High Z (full)" Then
A = zfa: B = zfb: C = zfc
TX = zfx: TY = zfy: TZ = zfz: MM = zfm
VSH = zfv: HSH = zfh
End If
If fastchoice$ = "High Z (zoom)" Then
A = zza: B = zzb: C = zzc
TX = zzx: TY = zzy: TZ = zzz: MM = zzm
VSH = zzv: HSH = zzh
End If
If fastchoice$ = "Far X (full)" Then
A = xfa: B = xfb: C = xfc
TX = xfx: TY = xfy: TZ = xfz: MM = xfm
VSH = xfv: HSH = xfh
End If
If fastchoice$ = "Far X (zoom)" Then
A = xza: B = xzb: C = xzc
TX = xzx: TY = xzy: TZ = xzz: MM = xzm
VSH = xzv: HSH = xzh
End If
If fastchoice$ = "Far Y (full)" Then
A = yfa: B = yfb: C = yfc
TX = yfx: TY = yfy: TZ = yfz: MM = yfm
VSH = yfv: HSH = yfh
End If
If fastchoice$ = "Far Y (zoom)" Then
A = yza: B = yzb: C = yzc
TX = yzx: TY = yzy: TZ = yzz: MM = yzm
VSH = yzv: HSH = yzh
End If
If fastchoice$ = "Perspective 1" Then
A = p1a: B = p1b: C = p1c
TX = p1x: TY = p1y: TZ = p1z: MM = p1m
VSH = p1v: HSH = p1h
End If
If fastchoice$ = "Perspective 2" Then
A = p2a: B = p2b: C = p2c
TX = p2x: TY = p2y: TZ = p2z: MM = p2m
VSH = p2v: HSH = p2h
End If
If fastchoice$ = "Perspective 3" Then
A = p3a: B = p3b: C = p3c
TX = p3x: TY = p3y: TZ = p3z: MM = p3m
VSH = p3v: HSH = p3h
End If
If fastchoice$ = "Perspective 4" Then
A = p4a: B = p4b: C = p4c
TX = p4x: TY = p4y: TZ = p4z: MM = p4m
VSH = p4v: HSH = p4h
End If
If TX = A And TY = B Then A = A * 0.997
If TX = A And TZ = C Then A = A * 0.998
If TY = B And TZ = C Then B = B * 0.999
If TY = 0 Then TY = 0.1
If TX = 0 Then TX = 0.1
If TZ = 0 Then TZ = 0.1
If A = 0 Then A = 0.1
If B = 0 Then B = 0.1
If C = 0 Then C = 0.1
If A / B = TX / TY Then A = A * 0.997
If A / C = TX / TZ Then A = A * 0.998
If B / C = TY / TZ Then B = B * 0.999
RA = A: RB = B: RC = C
For bgr = 1 To 1037
viewport.Line (1, bgr)-(1465, bgr), RGB(reddback, greenback, blueback)
Next bgr
Call mainbody
AA = RA + TX: BB = RB + TY: CC = RC + TZ
quickchange.Visible = False
End Sub
Private Sub pxdec_Click()
pinc = Val(incrementlist.Text)
A = A - pinc: RA = A
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub pydec_Click()
pinc = Val(incrementlist.Text)
B = B - pinc: RB = B
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub pzdec_Click()
pinc = Val(incrementlist.Text)
C = C - pinc: RC = C
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub pxinc_Click()
pinc = Val(incrementlist.Text)
A = A + pinc: RA = A
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub pyinc_Click()
pinc = Val(incrementlist.Text)
B = B + pinc: RB = B
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub pzinc_Click()
pinc = Val(incrementlist.Text)
C = C + pinc: RC = C
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub fxdec_Click()
finc = Val(incrementlist.Text)
TX = TX - finc: FCH = -1: A = A + finc: RA = A
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
If FCH = 1 Then pinc = finc
If FCH = -1 Then pinc = -finc
Call set3000
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub fydec_Click()
finc = Val(incrementlist.Text)
TY = TY - finc: FCH = -1: B = B + finc: RB = B
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
If FCH = 1 Then pinc = finc
If FCH = -1 Then pinc = -finc
Call set3020
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub fzdec_Click()
finc = Val(incrementlist.Text)
TZ = TZ - finc: FCH = -1: C = C + finc: RC = C
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
If FCH = 1 Then pinc = finc
If FCH = -1 Then pinc = -finc
Call set3040
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub fxinc_Click()
finc = Val(incrementlist.Text)
TX = TX + finc: FCH = 1: A = A - finc: RA = A
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
If FCH = 1 Then pinc = finc
If FCH = -1 Then pinc = -finc
Call set3000
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub fyinc_Click()
finc = Val(incrementlist.Text)
TY = TY + finc: FCH = 1: B = B - finc: RB = B
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
If FCH = 1 Then pinc = finc
If FCH = -1 Then pinc = -finc
Call set3020
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub fzinc_Click()
finc = Val(incrementlist.Text)
TZ = TZ + finc: FCH = 1: C = C - finc: RC = C
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
If FCH = 1 Then pinc = finc
If FCH = -1 Then pinc = -finc
Call set3040
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub magincreasebtn_Click()
minc = Val(incrementlist.Text)
MM = MM + (10 * minc)
MAD = 0.1 * MM
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub magdecreasebtn_Click()
minc = Val(incrementlist.Text)
MM = MM - (10 * minc)
MAD = 0.1 * MM
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
VVA = A + TX: VVB = B + TY: VVC = C + TZ
perptxtx.Text = Left$(VVA, 5)
perptxty.Text = Left$(VVB, 5)
perptxtz.Text = Left$(VVC, 5)
focustxtx.Text = Left$(TX, 5)
focustxty.Text = Left$(TY, 5)
focustxtz.Text = Left$(TZ, 5)
magtxt.Text = Left$(MAD, 4)
End Sub
Private Sub vertinc_Click()
sinc = Val(incrementlist.Text)
VSH = VSH + sinc
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
verttxt.Text = VSH
End Sub
Private Sub vertdec_Click()
sinc = Val(incrementlist.Text)
VSH = VSH - sinc
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
verttxt.Text = VSH
End Sub
Private Sub horizinc_Click()
sinc = Val(incrementlist.Text)
HSH = HSH + sinc
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
horiztxt.Text = HSH
End Sub
Private Sub horizdec_Click()
sinc = Val(incrementlist.Text)
HSH = HSH - sinc
CHK = 0
If PSW = 0 Then PSW = 1: Call reread
Call calculator
horiztxt.Text = HSH
End Sub
Private Sub set3000()
3000:
If READATA = 1 Then GoTo 3001
If READATA = 2 Then GoTo 3002
If READATA = 3 Then GoTo 3003
3001:
For RRRR = 1 To NP1
X(RRRR) = X(RRRR) - pinc
TEMX(RRRR) = X(RRRR)
Next RRRR
For RRRR = 4001 To (NP3 + 4000)
X(RRRR) = X(RRRR) - pinc
TEMX(RRRR) = X(RRRR)
Next RRRR
For RRRR = 6001 To (6000 + NP4)
X(RRRR) = X(RRRR) - pinc
TEMX(RRRR) = X(RRRR)
Next RRRR
Call calculator
GoTo end3000
3002:
For RRRR = 1 To NP1
X(RRRR) = X(RRRR) - pinc
TEMX(RRRR) = X(RRRR)
Next RRRR
For RRRR = 2001 To 2000 + NP2
X(RRRR) = X(RRRR) - pinc
TEMX(RRRR) = X(RRRR)
Next RRRR
For RRRR = 4001 To 4000 + NP3
X(RRRR) = X(RRRR) - pinc
TEMX(RRRR) = X(RRRR)
Next RRRR
For RRRR = 6001 To 6000 + NP4
X(RRRR) = X(RRRR) - pinc
TEMX(RRRR) = X(RRRR)
Next RRRR
Call calculator
GoTo end3000
3003:
For RRRR = 1 To NP6
X(RRRR) = X(RRRR) - pinc
TEMX(RRRR) = X(RRRR)
Next RRRR
Call calculator
end3000:
End Sub
Private Sub set3020()
3020:
If READATA = 1 Then GoTo 3021
If READATA = 2 Then GoTo 3022
If READATA = 3 Then GoTo 3023
3021:
For RRRR = 1 To NP1
Y(RRRR) = Y(RRRR) - pinc
TEMY(RRRR) = Y(RRRR)
Next RRRR
For RRRR = 4001 To (NP3 + 4000)
Y(RRRR) = Y(RRRR) - pinc
TEMY(RRRR) = Y(RRRR)
Next RRRR
For RRRR = 6001 To (6000 + NP4)
Y(RRRR) = Y(RRRR) - pinc
TEMY(RRRR) = Y(RRRR)
Next RRRR
Call calculator
GoTo end3020
3022:
For RRRR = 1 To NP1
Y(RRRR) = Y(RRRR) - pinc
TEMY(RRRR) = Y(RRRR)
Next RRRR
For RRRR = 2001 To 2000 + NP2
Y(RRRR) = Y(RRRR) - pinc
TEMY(RRRR) = Y(RRRR)
Next RRRR
For RRRR = 4001 To 4000 + NP3
Y(RRRR) = Y(RRRR) - pinc
TEMY(RRRR) = Y(RRRR)
Next RRRR
For RRRR = 6001 To 6000 + NP4
Y(RRRR) = Y(RRRR) - pinc
TEMY(RRRR) = Y(RRRR)
Next RRRR
Call calculator
GoTo end3020
3023:
For RRRR = 1 To NP6
Y(RRRR) = Y(RRRR) - pinc
TEMY(RRRR) = Y(RRRR)
Next RRRR
Call calculator
end3020:
End Sub
Private Sub set3040()
3040:
If READATA = 1 Then GoTo 3041
If READATA = 2 Then GoTo 3042
If READATA = 3 Then GoTo 3043
3041:
For RRRR = 1 To NP1
Z(RRRR) = Z(RRRR) - pinc
TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 4001 To (NP3 + 4000)
Z(RRRR) = Z(RRRR) - pinc
TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 6001 To (6000 + NP4)
Z(RRRR) = Z(RRRR) - pinc
TEMZ(RRRR) = Z(RRRR)
Next RRRR
Call calculator
GoTo end3040
3042:
For RRRR = 1 To NP1
Z(RRRR) = Z(RRRR) - pinc
TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 2001 To 2000 + NP2
Z(RRRR) = Z(RRRR) - pinc
TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 4001 To 4000 + NP3
Z(RRRR) = Z(RRRR) - pinc
TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 6001 To 6000 + NP4
Z(RRRR) = Z(RRRR) - pinc
TEMZ(RRRR) = Z(RRRR)
Next RRRR
Call calculator
GoTo end3040
3043:
For RRRR = 1 To NP6
Z(RRRR) = Z(RRRR) - pinc
TEMZ(RRRR) = Z(RRRR)
Next RRRR
Call calculator
end3040:
End Sub
Private Sub reread()
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 3691
If READATA = 2 Then GoTo 3692
If READATA = 3 Then GoTo 3693
3691:
For RRRR = 1 To NP1
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 4001 To 4000 + NP3
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 6001 To 6000 + NP4
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
Call calculator
GoTo endreread
3692:
For RRRR = 1 To NP1
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 2001 To 2000 + NP2
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 4001 To 4000 + NP3
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
For RRRR = 6001 To 6000 + NP4
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
Call calculator
GoTo endreread
3693:
For RRRR = 1 To NP6
X(RRRR) = X(RRRR) - TX: Y(RRRR) = Y(RRRR) - TY: Z(RRRR) = Z(RRRR) - TZ
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
Call calculator
endreread:
End Sub
Private Sub calculator()
CALC:
'viewport.Cls
For bgr = 2 To 1036
viewport.Line (2, bgr)-(1465, bgr), RGB(reddback, greenback, blueback)
Next bgr
'Set viewport.Picture = LoadPicture("bmps\" + cap$)
X(8001) = 0: Y(8001) = 0: Z(8001) = 1
I = 0.94 * A
J = 0.94 * B
K = 0.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))
3900:
'calculator
If CHK = 0 Then G = 8001: GoTo 4100
3950:
For GB = 1 To 10
If GB = 1 And NL1 = 0 Then GoTo 4310
If GB = 2 And NL2 = 0 Then GoTo 4310
If GB = 3 And NL3 = 0 Then GoTo 4310
If GB = 4 And NL4 = 0 Then GoTo 4310
If GB = 5 And NL5 = 0 Then GoTo 4310
If GB = 6 And NL6 = 0 Then GoTo 4310
If GB = 7 And NL7 = 0 Then GoTo 4310
If GB = 8 And NL8 = 0 Then GoTo 4310
If GB = 9 And NL9 = 0 Then GoTo 4310
If GB = 10 And NL10 = 0 Then GoTo 4310
If GB = 1 Then cdex = K1: GoTo 4040
If GB = 2 Then cdex = K2: GoTo 4040
If GB = 3 Then cdex = K3: GoTo 4040
If GB = 4 Then cdex = K4: GoTo 4040
If GB = 5 Then cdex = K5: GoTo 4040
If GB = 6 Then cdex = K6: GoTo 4040
If GB = 7 Then cdex = K7: GoTo 4040
If GB = 8 Then cdex = K8: GoTo 4040
If GB = 9 Then cdex = K9: GoTo 4040
If GB = 10 Then cdex = K10: GoTo 4040
4040 'calculator kernel
For LN = FL(GB) To LL(GB)
4045 iinc = 299
4050 If DT = 1 Then DT = 0: G = SP(LN): GoTo 4090
G = FP(LN): DT = 1
4070:
If ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N)) Then GoTo 5070
If DT = 1 Then GoTo 4100
4090:
If ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N)) Then GoTo 5120
4100:
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 - Z(G)))) / W
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))
XX(G) = U(G) * V(G)
If V(G) > 0.9999 Or V(G) < -0.9999 Then YY(G) = 0: GoTo 4200
YY(G) = U(G) * ((1 - ((V(G)) ^ 2)) ^ 0.5)
If ((L * S(G)) - (M * R(G))) < 0 Then YY(G) = (-1 * YY(G))
4200:
If CHK = 0 Then CHK = 1: GoTo 3950
If DT = 1 Then X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GoTo 4050
X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ
4250:
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
4280:
viewport.Line (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN))), RGB(redd(cdex), green(cdex), blue(cdex))
4290 Next LN
4310 Next GB
GoTo endofcalc
'end calculator kernel
'If PX = 1 Then Color 1: GoTo 2261
'If PY = 1 Then Color 1: GoTo 2281
'If PZ = 1 Then Color 1: GoTo 2301
'If FX = 1 Then Color 1: GoTo 2561
'If FY = 1 Then Color 1: GoTo 2581
'If FZ = 1 Then Color 1: GoTo 2601
'If MG = 1 Then Color 1: GoTo 2808
'INSIDE:
5070:
iinc = iinc - 1
If iinc = 0 Then iinc = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GX(FP(LN)) = 9999: GoTo 4290
X(G) = ((iinc / 299) * (TEMX(G) - X(SP(LN)))) + X(SP(LN))
Y(G) = ((iinc / 299) * (TEMY(G) - Y(SP(LN)))) + Y(SP(LN))
Z(G) = ((iinc / 299) * (TEMZ(G) - Z(SP(LN)))) + Z(SP(LN))
GoTo 4070
5120:
iinc = iinc - 1
If iinc = 0 Then iinc = 299: DT = 0: X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GX(SP(LN)) = 9999: GoTo 4290
X(G) = ((iinc / 299) * (TEMX(G) - X(FP(LN)))) + X(FP(LN))
Y(G) = ((iinc / 299) * (TEMY(G) - Y(FP(LN)))) + Y(FP(LN))
Z(G) = ((iinc / 299) * (TEMZ(G) - Z(FP(LN)))) + Z(FP(LN))
GoTo 4090
endofcalc:
End Sub
Private Sub p1btn_Click()
vauto = 1
lightlabel.Visible = True
darklabel.Visible = True
two1box.Visible = True
two2box.Visible = True
autoescapebtn.Visible = True
two1box.SetFocus
End Sub
Private Sub p2btn_Click()
vauto = 2
lightlabel.Visible = True
darklabel.Visible = True
two1box.Visible = True
two2box.Visible = True
autoescapebtn.Visible = True
two1box.SetFocus
End Sub
Private Sub p3btn_Click()
vauto = 3
lightlabel.Visible = True
darklabel.Visible = True
two1box.Visible = True
two2box.Visible = True
autoescapebtn.Visible = True
two1box.SetFocus
End Sub
Private Sub two2box_GotFocus()
darkenter.Visible = True
End Sub
Private Sub autoescapebtn_Click()
two1box.Text = ""
two2box.Text = ""
darkenter.Visible = False
lightlabel.Visible = False
darklabel.Visible = False
two1box.Visible = False
two2box.Visible = False
autoescapebtn.Visible = False
End Sub
Private Sub darkenter_Click()
LIGHTT = Val(two1box.Text)
DARKK = Val(two2box.Text)
two1box.Text = ""
two2box.Text = ""
darkenter.Visible = False
lightlabel.Visible = False
darklabel.Visible = False
two1box.Visible = False
two2box.Visible = False
autoescapebtn.Visible = False
If vauto = 1 Then Call hidpaint
If vauto = 2 Then Call hidpainf
If vauto = 3 Then Call hidpaina
End Sub
Private Sub hidpaint()
'Read distance to nearest point for each plane
For DPL = 1 To 7000
If T1(DPL) = 0 And T2(DPL) = 0 And B1(DPL) = 0 And B2(DL) = 0 Then GoTo NPL
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)
NPL:
Next DPL
'-------------------------------------------------
'Sort planes
SORT:
For ORV = 1 To 7000
If T1(ORV) = 0 And T2(ORV) = 0 And B1(ORV) = 0 And B2(ORV) = 0 Then GoTo NPL3
NEWMIN = 1000000
For OPL = 1 To 7000
If T1(OPL) = 0 And T2(OPL) = 0 And B1(OPL) = 0 And B2(OPL) = 0 Then GoTo NPL2
If DIS(OPL) < NEWMIN Then
NEWMIN = DIS(OPL)
ORD(ORV) = OPL
End If
NPL2:
Next OPL
DIS(ORD(ORV)) = 2000000: 'key step
NPL3:
Next ORV
'-------------------------------------------------
'Paint colors and draw framing lines
NUM = 3000
For ORT = 7000 To 1 Step -1
If T1(ORT) = 0 And T2(ORT) = 0 And B1(ORT) = 0 And B2(ORT) = 0 Then GoTo NPL4
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 TDIR(ORD(ORT)) = LIGHTT Then COLR(ORD(ORT)) = COLR(ORD(ORT)) - 1
If TDIR(ORD(ORT)) = DARKK Then COLR(ORD(ORT)) = COLR(ORD(ORT)) + 1
VEECOLOR = 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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VEECOLOR), green(VEECOLOR), blue(VEECOLOR))
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VEECOLOR), green(VEECOLOR), blue(VEECOLOR))
Next INS
'----------------
If AUTOFRM1(ORD(ORT)) = 0 And AUTOFRM2(ORD(ORT)) = 0 Then GoTo NPL4
VCOL = COLR(ORD(ORT)) + 1
If AUTOFRM1(ORD(ORT)) = 0 And AUTOFRM2(ORD(ORT)) > 0 Then GoTo FLIP2
If AUTOFRM1(ORD(ORT)) > 0 And AUTOFRM2(ORD(ORT)) = 0 Then GoTo FLIP1
If AUTOFRM1(ORD(ORT)) > 0 And AUTOFRM2(ORD(ORT)) > 0 Then vrepeat = 1: GoTo FLIP1
FLIP1:
VT1 = T1(ORD(ORT)): VT2 = T2(ORD(ORT)): VB1 = B1(ORD(ORT)): VB2 = B2(ORD(ORT)): NR = AUTOFRM1(ORD(ORT)): GoTo FRAMEIT
FLIP2:
VT1 = T1(ORD(ORT)): VT2 = B1(ORD(ORT)): VB1 = T2(ORD(ORT)): VB2 = B2(ORD(ORT)): NR = AUTOFRM2(ORD(ORT)): GoTo FRAMEIT
NPL4:
Next ORT
GoTo endofhidpaint
'Subs
'----------------------------------------------------
FRAMEIT:
GB = 11
3300 vfcolor = VCOL
viewport.Line (GY(VT2), GX(VT2))-(GY(VB2), GX(VB2)), RGB(redd(vfcolor), green(vfcolor), blue(vfcolor))
FL(GB) = 7001: LL(GB) = 7000 + NR
LA = 7000: INS = -1
For TI = 7001 To (7000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(VT1) + ((INS / (NR)) * (X(VT2) - X(VT1)))
Y(TI) = Y(VT1) + ((INS / (NR)) * (Y(VT2) - Y(VT1)))
Z(TI) = Z(VT1) + ((INS / (NR)) * (Z(VT2) - Z(VT1)))
FP(LA) = TI
Next TI
LA = 7000: INS = -1
For BI = (7001 + NR) To (7000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(VB1) + ((INS / (NR)) * (X(VB2) - X(VB1)))
Y(BI) = Y(VB1) + ((INS / (NR)) * (Y(VB2) - Y(VB1)))
Z(BI) = Z(VB1) + ((INS / (NR)) * (Z(VB2) - Z(VB1)))
SP(LA) = BI
Next BI
1040 'calculator kernel
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)))
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 - Z(G)))) / W
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))
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 DT = 1 Then X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GoTo 1050
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
1280:
viewport.Line (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN))), RGB(redd(vfcolor), green(vfcolor), blue(vfcolor))
1290 Next LN
If vrepeat = 1 Then vrepeat = 0: GoTo FLIP2
GoTo NPL4
'------------------------------------------
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)) = 9999: 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)) = 9999: 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
'FOR DLY = 1 TO 200000
'NEXT DLY
endofhidpaint:
End Sub
Private Sub hidpainf()
'Read distance to nearest point for each plane
For DPL = 1 To 7000
If T1(DPL) = 0 And T2(DPL) = 0 And B1(DPL) = 0 And B2(DL) = 0 Then GoTo NPL
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)
NPL:
Next DPL
'-------------------------------------------------
'Sort planes
SORT:
For ORV = 1 To 7000
If T1(ORV) = 0 And T2(ORV) = 0 And B1(ORV) = 0 And B2(ORV) = 0 Then GoTo NPL3
NEWMAX = 1
For OPL = 1 To 7000
If T1(OPL) = 0 And T2(OPL) = 0 And B1(OPL) = 0 And B2(OPL) = 0 Then GoTo NPL2
If DIS(OPL) > NEWMAX Then
NEWMAX = DIS(OPL)
ORD(ORV) = OPL
End If
NPL2:
Next OPL
DIS(ORD(ORV)) = 0: 'key step
NPL3:
Next ORV
'-------------------------------------------------
'Paint colors and draw framing lines
NUM = 3000
For ORT = 1 To 7000
If T1(ORT) = 0 And T2(ORT) = 0 And B1(ORT) = 0 And B2(ORT) = 0 Then GoTo NPL4
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 TDIR(ORD(ORT)) = LIGHTT Then COLR(ORD(ORT)) = COLR(ORD(ORT)) - 1
If TDIR(ORD(ORT)) = DARKK Then COLR(ORD(ORT)) = COLR(ORD(ORT)) + 1
VEECOLOR = 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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VEECOLOR), green(VEECOLOR), blue(VEECOLOR))
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VEECOLOR), green(VEECOLOR), blue(VEECOLOR))
Next INS
'----------------
If AUTOFRM1(ORD(ORT)) = 0 And AUTOFRM2(ORD(ORT)) = 0 Then GoTo NPL4
VCOL = COLR(ORD(ORT)) + 1
If AUTOFRM1(ORD(ORT)) = 0 And AUTOFRM2(ORD(ORT)) > 0 Then GoTo FLIP2
If AUTOFRM1(ORD(ORT)) > 0 And AUTOFRM2(ORD(ORT)) = 0 Then GoTo FLIP1
If AUTOFRM1(ORD(ORT)) > 0 And AUTOFRM2(ORD(ORT)) > 0 Then vrepeat = 1: GoTo FLIP1
FLIP1:
VT1 = T1(ORD(ORT)): VT2 = T2(ORD(ORT)): VB1 = B1(ORD(ORT)): VB2 = B2(ORD(ORT)): NR = AUTOFRM1(ORD(ORT)): GoTo FRAMEIT
FLIP2:
VT1 = T1(ORD(ORT)): VT2 = B1(ORD(ORT)): VB1 = T2(ORD(ORT)): VB2 = B2(ORD(ORT)): NR = AUTOFRM2(ORD(ORT)): GoTo FRAMEIT
NPL4:
Next ORT
GoTo endofhidpainf
'Subs
'----------------------------------------------------
FRAMEIT:
GB = 11
3300 vfcolor = VCOL
viewport.Line (GY(VT2), GX(VT2))-(GY(VB2), GX(VB2)), RGB(redd(vfcolor), green(vfcolor), blue(vfcolor))
FL(GB) = 7001: LL(GB) = 7000 + NR
LA = 7000: INS = -1
For TI = 7001 To (7000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(VT1) + ((INS / (NR)) * (X(VT2) - X(VT1)))
Y(TI) = Y(VT1) + ((INS / (NR)) * (Y(VT2) - Y(VT1)))
Z(TI) = Z(VT1) + ((INS / (NR)) * (Z(VT2) - Z(VT1)))
FP(LA) = TI
Next TI
LA = 7000: INS = -1
For BI = (7001 + NR) To (7000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(VB1) + ((INS / (NR)) * (X(VB2) - X(VB1)))
Y(BI) = Y(VB1) + ((INS / (NR)) * (Y(VB2) - Y(VB1)))
Z(BI) = Z(VB1) + ((INS / (NR)) * (Z(VB2) - Z(VB1)))
SP(LA) = BI
Next BI
1040 'calculator kernel
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)))
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 - Z(G)))) / W
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))
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 DT = 1 Then X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GoTo 1050
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
1280:
viewport.Line (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN))), RGB(redd(vfcolor), green(vfcolor), blue(vfcolor))
1290 Next LN
If vrepeat = 1 Then vrepeat = 0: GoTo FLIP2
GoTo NPL4
'------------------------------------------
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)) = 9999: 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)) = 9999: 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
'FOR DLY = 1 TO 200000
'NEXT DLY
endofhidpainf:
End Sub
Private Sub hidpaina()
'Read distance to nearest point for each plane
For DPL = 1 To 7000
If T1(DPL) = 0 And T2(DPL) = 0 And B1(DPL) = 0 And B2(DL) = 0 Then GoTo NPL
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) + DIS2(DPL) + DIS3(DPL) + DIS4(DPL)) / 4
NPL:
Next DPL
'-------------------------------------------------
'Sort planes
SORT:
For ORV = 1 To 7000
If T1(ORV) = 0 And T2(ORV) = 0 And B1(ORV) = 0 And B2(ORV) = 0 Then GoTo NPL3
NEWMAX = 1
For OPL = 1 To 7000
If T1(OPL) = 0 And T2(OPL) = 0 And B1(OPL) = 0 And B2(OPL) = 0 Then GoTo NPL2
If DIS(OPL) > NEWMAX Then
NEWMAX = DIS(OPL)
ORD(ORV) = OPL
End If
NPL2:
Next OPL
DIS(ORD(ORV)) = 0: 'key step
NPL3:
Next ORV
'-------------------------------------------------
'Paint colors and draw framing lines
NUM = 3000
For ORT = 1 To 7000
If T1(ORT) = 0 And T2(ORT) = 0 And B1(ORT) = 0 And B2(ORT) = 0 Then GoTo NPL4
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 TDIR(ORD(ORT)) = LIGHTT Then COLR(ORD(ORT)) = COLR(ORD(ORT)) - 1
If TDIR(ORD(ORT)) = DARKK Then COLR(ORD(ORT)) = COLR(ORD(ORT)) + 1
VEECOLOR = 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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VEECOLOR), green(VEECOLOR), blue(VEECOLOR))
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VEECOLOR), green(VEECOLOR), blue(VEECOLOR))
Next INS
'----------------
If AUTOFRM1(ORD(ORT)) = 0 And AUTOFRM2(ORD(ORT)) = 0 Then GoTo NPL4
VCOL = COLR(ORD(ORT)) + 1
If AUTOFRM1(ORD(ORT)) = 0 And AUTOFRM2(ORD(ORT)) > 0 Then GoTo FLIP2
If AUTOFRM1(ORD(ORT)) > 0 And AUTOFRM2(ORD(ORT)) = 0 Then GoTo FLIP1
If AUTOFRM1(ORD(ORT)) > 0 And AUTOFRM2(ORD(ORT)) > 0 Then vrepeat = 1: GoTo FLIP1
FLIP1:
VT1 = T1(ORD(ORT)): VT2 = T2(ORD(ORT)): VB1 = B1(ORD(ORT)): VB2 = B2(ORD(ORT)): NR = AUTOFRM1(ORD(ORT)): GoTo FRAMEIT
FLIP2:
VT1 = T1(ORD(ORT)): VT2 = B1(ORD(ORT)): VB1 = T2(ORD(ORT)): VB2 = B2(ORD(ORT)): NR = AUTOFRM2(ORD(ORT)): GoTo FRAMEIT
NPL4:
Next ORT
GoTo endofhidpaina
'Subs
'----------------------------------------------------
FRAMEIT:
GB = 11
3300 vfcolor = VCOL
viewport.Line (GY(VT2), GX(VT2))-(GY(VB2), GX(VB2)), RGB(redd(vfcolor), green(vfcolor), blue(vfcolor))
FL(GB) = 7001: LL(GB) = 7000 + NR
LA = 7000: INS = -1
For TI = 7001 To (7000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(VT1) + ((INS / (NR)) * (X(VT2) - X(VT1)))
Y(TI) = Y(VT1) + ((INS / (NR)) * (Y(VT2) - Y(VT1)))
Z(TI) = Z(VT1) + ((INS / (NR)) * (Z(VT2) - Z(VT1)))
FP(LA) = TI
Next TI
LA = 7000: INS = -1
For BI = (7001 + NR) To (7000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(VB1) + ((INS / (NR)) * (X(VB2) - X(VB1)))
Y(BI) = Y(VB1) + ((INS / (NR)) * (Y(VB2) - Y(VB1)))
Z(BI) = Z(VB1) + ((INS / (NR)) * (Z(VB2) - Z(VB1)))
SP(LA) = BI
Next BI
1040 'calculator kernel
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)))
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 - Z(G)))) / W
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))
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 DT = 1 Then X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GoTo 1050
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
1280:
viewport.Line (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN))), RGB(redd(vfcolor), green(vfcolor), blue(vfcolor))
1290 Next LN
If vrepeat = 1 Then vrepeat = 0: GoTo FLIP2
GoTo NPL4
'------------------------------------------
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)) = 9999: 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)) = 9999: 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
'FOR DLY = 1 TO 200000
'NEXT DLY
endofhidpaina:
End Sub
Private Sub ppbtn_Click()
vplane = 1
pplabel.Visible = True
one1box.Visible = True
ppenter.Visible = True
ppescapebtn.Visible = True
one1box.SetFocus
End Sub
Private Sub hpbtn_Click()
vplane = 2
pplabel.Visible = True
one1box.Visible = True
ppenter.Visible = True
ppescapebtn.Visible = True
one1box.SetFocus
End Sub
Private Sub ppescapebtn_Click()
one1box.Text = ""
pplabel.Visible = False
one1box.Visible = False
ppenter.Visible = False
ppescapebtn.Visible = False
End Sub
Private Sub ppenter_Click()
PL = Val(one1box.Text)
one1box.Text = ""
pplabel.Visible = False
one1box.Visible = False
ppenter.Visible = False
ppescapebtn.Visible = False
If vplane = 1 Then Call pplane
If vplane = 2 Then Call hplane
End Sub
Private Sub pplane()
NUM = 3000
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 TDIR(PL) = LIGHTT Then COLR(PL) = COLR(PL) - 1
If TDIR(PL) = DARKK Then COLR(PL) = COLR(PL) + 1
VEECOLOR = 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))))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VEECOLOR), green(VEECOLOR), blue(VEECOLOR))
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))))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VEECOLOR), green(VEECOLOR), blue(VEECOLOR))
Next INS
'----------------
If AUTOFRM1(PL) = 0 And AUTOFRM2(PL) = 0 Then GoTo NPL4
VCOL = COLR(PL) + 1
If AUTOFRM1(PL) = 0 And AUTOFRM2(PL) > 0 Then GoTo FLIP2
If AUTOFRM1(PL) > 0 And AUTOFRM2(PL) = 0 Then GoTo FLIP1
If AUTOFRM1(PL) > 0 And AUTOFRM2(PL) > 0 Then vrepeat = 1: GoTo FLIP1
FLIP1:
VT1 = T1(PL): VT2 = T2(PL): VB1 = B1(PL): VB2 = B2(PL): NR = AUTOFRM1(PL): GoTo FRAMEIT
FLIP2:
VT1 = T1(PL): VT2 = B1(PL): VB1 = T2(PL): VB2 = B2(PL): NR = AUTOFRM2(PL): GoTo FRAMEIT
NPL4:
GoTo endofpplane
'Subs
'----------------------------------------------------
FRAMEIT:
GB = 11
3300 vfcolor = VCOL
viewport.Line (GY(VT2), GX(VT2))-(GY(VB2), GX(VB2)), RGB(redd(vfcolor), green(vfcolor), blue(vfcolor))
FL(GB) = 7001: LL(GB) = 7000 + NR
LA = 7000: INS = -1
For TI = 7001 To (7000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(VT1) + ((INS / (NR)) * (X(VT2) - X(VT1)))
Y(TI) = Y(VT1) + ((INS / (NR)) * (Y(VT2) - Y(VT1)))
Z(TI) = Z(VT1) + ((INS / (NR)) * (Z(VT2) - Z(VT1)))
FP(LA) = TI
Next TI
LA = 7000: INS = -1
For BI = (7001 + NR) To (7000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(VB1) + ((INS / (NR)) * (X(VB2) - X(VB1)))
Y(BI) = Y(VB1) + ((INS / (NR)) * (Y(VB2) - Y(VB1)))
Z(BI) = Z(VB1) + ((INS / (NR)) * (Z(VB2) - Z(VB1)))
SP(LA) = BI
Next BI
1040 'calculator kernel
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)))
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 - Z(G)))) / W
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))
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 DT = 1 Then X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GoTo 1050
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))) + 500 + HSH
GX(FP(LN)) = (MM * (-15.2) * XX(FP(LN))) + 400 - VSH
GY(SP(LN)) = (MM * 15.2 * YY(SP(LN))) + 500 + HSH
GX(SP(LN)) = (MM * (-15.2) * XX(SP(LN))) + 400 - VSH
1280:
viewport.Line (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN))), RGB(redd(vfcolor), green(vfcolor), blue(vfcolor))
1290 Next LN
If vrepeat = 1 Then vrepeat = 0: GoTo FLIP2
GoTo NPL4
'------------------------------------------
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)) = 9999: 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)) = 9999: 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
'FOR DLY = 1 TO 200000
'NEXT DLY
endofpplane:
End Sub
Private Sub hide1btn_Click()
'Read distance to nearest point for each plane
For PL = 1 To 7000
If T1(PL) = 0 And T2(PL) = 0 And B1(PL) = 0 And B2(PL) = 0 Then GoTo NPL
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
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)
NPL:
Next PL
'-------------------------------------------------
'Sort planes
SORT:
For ORT = 1 To 7000
If T1(ORT) = 0 And T2(ORT) = 0 And B1(ORT) = 0 And B2(ORT) = 0 Then GoTo NPL3
NEWMIN = 1000000
For PL = 1 To 7000
If T1(PL) = 0 And T2(PL) = 0 And B1(PL) = 0 And B2(PL) = 0 Then GoTo NPL2
If DIS(PL) < NEWMIN Then
NEWMIN = DIS(PL)
ORD(ORT) = PL
End If
NPL2:
Next PL
DIS(ORD(ORT)) = 2000000: 'key step
NPL3:
Next ORT
'-------------------------------------------------
'Paint white with black border
NUM = 3000
For PL = 7000 To 1 Step -1
If T1(PL) = 0 And T2(PL) = 0 And B1(PL) = 0 And B2(PL) = 0 Then GoTo NPL4
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(255, 255, 255)
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(255, 255, 255)
Next INS
viewport.Line (GY(TT1), GX(TT1))-(GY(BB1), GX(BB1)), RGB(0, 0, 0)
viewport.Line (GY(TT2), GX(TT2))-(GY(BB2), GX(BB2)), RGB(0, 0, 0)
viewport.Line (GY(TT1), GX(TT1))-(GY(TT2), GX(TT2)), RGB(0, 0, 0)
viewport.Line (GY(BB1), GX(BB1))-(GY(BB2), GX(BB2)), RGB(0, 0, 0)
NPL4:
Next PL
End Sub
Private Sub hide2btn_Click()
'Read distance to furthest point for each plane
For PL = 1 To 7000
If T1(PL) = 0 And T2(PL) = 0 And B1(PL) = 0 And B2(PL) = 0 Then GoTo NPL
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
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)
NPL:
Next PL
'-------------------------------------------------
'Sort planes
SORT:
For ORT = 1 To 7000
If T1(ORT) = 0 And T2(ORT) = 0 And B1(ORT) = 0 And B2(ORT) = 0 Then GoTo NPL3
NEWMAX = 1
For PL = 1 To 7000
If T1(PL) = 0 And T2(PL) = 0 And B1(PL) = 0 And B2(PL) = 0 Then GoTo NPL2
If DIS(PL) > NEWMAX Then
NEWMAX = DIS(PL)
ORD(ORT) = PL
End If
NPL2:
Next PL
DIS(ORD(ORT)) = 0: 'key step
NPL3:
Next ORT
'-------------------------------------------------
'Paint white with black border
NUM = 3000
For PL = 1 To 7000
If T1(PL) = 0 And T2(PL) = 0 And B1(PL) = 0 And B2(PL) = 0 Then GoTo NPL4
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(255, 255, 255)
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(255, 255, 255)
Next INS
viewport.Line (GY(TT1), GX(TT1))-(GY(BB1), GX(BB1)), RGB(0, 0, 0)
viewport.Line (GY(TT2), GX(TT2))-(GY(BB2), GX(BB2)), RGB(0, 0, 0)
viewport.Line (GY(TT1), GX(TT1))-(GY(TT2), GX(TT2)), RGB(0, 0, 0)
viewport.Line (GY(BB1), GX(BB1))-(GY(BB2), GX(BB2)), RGB(0, 0, 0)
NPL4:
Next PL
PL = 1 'I have no idea why this is needed. It messes up the
're-reads for ax6bas when not included, but not the sbas.
End Sub
Private Sub hide3btn_Click()
'Read distance to average point for each plane
For PL = 1 To 7000
If T1(PL) = 0 And T2(PL) = 0 And B1(PL) = 0 And B2(PL) = 0 Then GoTo NPL
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
DIS(PL) = (DIS1(PL) + DIS2(PL) + DIS3(PL) + DIS4(PL)) / 4
NPL:
Next PL
'-------------------------------------------------
'Sort planes
SORT:
For ORT = 1 To 7000
If T1(ORT) = 0 And T2(ORT) = 0 And B1(ORT) = 0 And B2(ORT) = 0 Then GoTo NPL3
NEWMAX = 1
For PL = 1 To 7000
If T1(PL) = 0 And T2(PL) = 0 And B1(PL) = 0 And B2(PL) = 0 Then GoTo NPL2
If DIS(PL) > NEWMAX Then
NEWMAX = DIS(PL)
ORD(ORT) = PL
End If
NPL2:
Next PL
DIS(ORD(ORT)) = 0: 'key step
NPL3:
Next ORT
'-------------------------------------------------
'Paint white with black border
NUM = 3000
For PL = 1 To 7000
If T1(PL) = 0 And T2(PL) = 0 And B1(PL) = 0 And B2(PL) = 0 Then GoTo NPL4
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(255, 255, 255)
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(255, 255, 255)
Next INS
viewport.Line (GY(TT1), GX(TT1))-(GY(BB1), GX(BB1)), RGB(0, 0, 0)
viewport.Line (GY(TT2), GX(TT2))-(GY(BB2), GX(BB2)), RGB(0, 0, 0)
viewport.Line (GY(TT1), GX(TT1))-(GY(TT2), GX(TT2)), RGB(0, 0, 0)
viewport.Line (GY(BB1), GX(BB1))-(GY(BB2), GX(BB2)), RGB(0, 0, 0)
NPL4:
Next PL
PL = 1 'I have no idea why this is needed. It messes up the
're-reads for ax6bas when not included, but not the sbas.
End Sub
Private Sub hplane()
NUM = 1200
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))))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(255, 255, 255)
Next INS
viewport.Line (GY(T1(PL)), GX(T1(PL)))-(GY(B1(PL)), GX(B1(PL))), RGB(0, 0, 0)
viewport.Line (GY(T2(PL)), GX(T2(PL)))-(GY(B2(PL)), GX(B2(PL))), RGB(0, 0, 0)
viewport.Line (GY(T1(PL)), GX(T1(PL)))-(GY(T2(PL)), GX(T2(PL))), RGB(0, 0, 0)
viewport.Line (GY(B1(PL)), GX(B1(PL)))-(GY(B2(PL)), GX(B2(PL))), RGB(0, 0, 0)
End Sub
Private Sub jbtn_Click()
MMM$ = "J"
planenumber.Visible = True
planecolor.Visible = True
planenumberbox.Visible = True
planecolorbox.Visible = True
jayenter.Visible = True
jayescapebtn.Visible = True
planenumberbox.SetFocus
End Sub
Private Sub j1btn_Click()
MMM$ = "J1"
planenumber.Visible = True
planecolor.Visible = True
planenumberbox.Visible = True
planecolorbox.Visible = True
jay1enter.Visible = True
jayescapebtn.Visible = True
planenumberbox.SetFocus
End Sub
Private Sub j2btn_Click()
MMM$ = "J2"
planenumber.Visible = True
planecolor.Visible = True
planenumberbox.Visible = True
planecolorbox.Visible = True
jay2enter.Visible = True
jayescapebtn.Visible = True
planenumberbox.SetFocus
End Sub
Private Sub jayenter_Click()
PNM = Val(planenumberbox.Text)
VCOL = Val(planecolorbox.Text)
If VCOL < 1 Or VCOL > 236 Then
planenumberbox.Text = ""
planecolorbox.Text = ""
planenumber.Visible = False
planecolor.Visible = False
planenumberbox.Visible = False
planecolorbox.Visible = False
jayenter.Visible = False
jayescapebtn.Visible = False
GoTo endofjayenter
End If
planenumberbox.Text = ""
planecolorbox.Text = ""
planenumber.Visible = False
planecolor.Visible = False
planenumberbox.Visible = False
planecolorbox.Visible = False
jayenter.Visible = False
jayescapebtn.Visible = False
Call jkroutine
endofjayenter:
End Sub
Private Sub jay1enter_Click()
PNM = Val(planenumberbox.Text)
VCOL = Val(planecolorbox.Text)
If VCOL < 1 Or VCOL > 236 Then
planenumberbox.Text = ""
planecolorbox.Text = ""
planenumber.Visible = False
planecolor.Visible = False
planenumberbox.Visible = False
planecolorbox.Visible = False
jay1enter.Visible = False
jayescapebtn.Visible = False
GoTo endofjay1enter
End If
planenumberbox.Text = ""
planecolorbox.Text = ""
planenumber.Visible = False
planecolor.Visible = False
planenumberbox.Visible = False
planecolorbox.Visible = False
jay1enter.Visible = False
jayescapebtn.Visible = False
Call jkroutine
endofjay1enter:
End Sub
Private Sub jay2enter_Click()
PNM = Val(planenumberbox.Text)
VCOL = Val(planecolorbox.Text)
If VCOL < 1 Or VCOL > 236 Then
planenumberbox.Text = ""
planecolorbox.Text = ""
planenumber.Visible = False
planecolor.Visible = False
planenumberbox.Visible = False
planecolorbox.Visible = False
jay2enter.Visible = False
jayescapebtn.Visible = False
GoTo endofjay2enter
End If
planenumberbox.Text = ""
planecolorbox.Text = ""
planenumber.Visible = False
planecolor.Visible = False
planenumberbox.Visible = False
planecolorbox.Visible = False
jay2enter.Visible = False
jayescapebtn.Visible = False
Call jkroutine
endofjay2enter:
End Sub
Private Sub jayescapebtn_Click()
planenumberbox.Text = ""
planecolorbox.Text = ""
planenumber.Visible = False
planecolor.Visible = False
planenumberbox.Visible = False
planecolorbox.Visible = False
jayenter.Visible = False
jay1enter.Visible = False
jay2enter.Visible = False
jayescapebtn.Visible = False
End Sub
Private Sub jkroutine()
2045:
If MMM$ = "J" Then MMM$ = "": NUM = 500: GoTo 2060
If MMM$ = "J1" Then MMM$ = "": NUM = 2000: GoTo 2060
If MMM$ = "J2" Then MMM$ = "": NUM = 8000
2060:
VT1 = T1(PNM): VT2 = B1(PNM): VB1 = T2(PNM): VB2 = B2(PNM)
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VCOL), green(VCOL), blue(VCOL))
Next INS
VT1 = T1(PNM): VT2 = T2(PNM): VB1 = B1(PNM): VB2 = B2(PNM)
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VCOL), green(VCOL), blue(VCOL))
Next INS
End Sub
Private Sub stringjbtn_Click()
startplanelabel.Visible = True
startplane.Visible = True
endplanelabel.Visible = True
endplane.Visible = True
planeinclabel.Visible = True
planeinc.Visible = True
startcolorlabel.Visible = True
startcolor.Visible = True
stringcolorinclabel.Visible = True
stringcolorinc.Visible = True
sjbtn1.Visible = True
stringescapebtn.Visible = True
startplane.SetFocus
End Sub
Private Sub sjbtn1_Click()
NUM = 1200
SK1 = Val(startplane.Text)
SK2 = Val(endplane.Text)
SKINC = Val(planeinc.Text)
VCOL = Val(startcolor.Text)
VCOL = VCOL - 1
VCOLINC = Val(stringcolorinc.Text)
If VCOLINC < 0 Then VCOL = VCOL + 2
If VCOLINC = 0 Then VCOL = VCOL + 1
For PLNU = SK1 To SK2 Step SKINC
VT1 = T1(PLNU)
VT2 = T2(PLNU)
VB1 = B1(PLNU)
VB2 = B2(PLNU)
VCOL = VCOL + VCOLINC
If VCOL = 0 Then VCOL = 1
If VCOL = 237 Then VCOL = 236
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VCOL), green(VCOL), blue(VCOL))
Next INS
Next PLNU
VCOL = Val(startcolor.Text)
VCOL = VCOL - 1
VCOLINC = Val(stringcolorinc.Text)
If VCOLINC < 0 Then VCOL = VCOL + 2
If VCOLINC = 0 Then VCOL = VCOL + 1
For PLNU = SK1 To SK2 Step SKINC
VT1 = T1(PLNU)
VT2 = B1(PLNU)
VB1 = T2(PLNU)
VB2 = B2(PLNU)
VCOL = VCOL + VCOLINC
If VCOL = 0 Then VCOL = 1
If VCOL = 237 Then VCOL = 236
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VCOL), green(VCOL), blue(VCOL))
Next INS
Next PLNU
startplane.Text = ""
endplane.Text = ""
planeinc.Text = ""
startcolor.Text = ""
stringcolorinc.Text = ""
startplanelabel.Visible = False
startplane.Visible = False
endplanelabel.Visible = False
endplane.Visible = False
planeinclabel.Visible = False
planeinc.Visible = False
startcolorlabel.Visible = False
startcolor.Visible = False
stringcolorinclabel.Visible = False
stringcolorinc.Visible = False
sjbtn1.Visible = False
stringescapebtn.Visible = False
End Sub
Private Sub stringescapebtn_Click()
startplane.Text = ""
endplane.Text = ""
planeinc.Text = ""
startcolor.Text = ""
stringcolorinc.Text = ""
startplanelabel.Visible = False
startplane.Visible = False
endplanelabel.Visible = False
endplane.Visible = False
planeinclabel.Visible = False
planeinc.Visible = False
startcolorlabel.Visible = False
startcolor.Visible = False
stringcolorinclabel.Visible = False
stringcolorinc.Visible = False
sjbtn1.Visible = False
stringescapebtn.Visible = False
End Sub
Private Sub curvemacrobtn_Click()
'curvemacrobtn.Visible = False
Open "datah\cmacro.txt" For Input As #1
Do While TIPE$ <> groupname$
Input #1, TIPE$
Loop
For rm = 1 To 1000
Input #1, vsplane(rm), veplane(rm), vplaneinc(rm), vscolor(rm), vcolorinc(rm)
If vsplane(rm) = 9999 Then Exit For
Next rm
Close #1
rmm = rm - 1
NUM = 2000
For rm = 1 To rmm
SK1 = vsplane(rm)
SK2 = veplane(rm)
SKINC = vplaneinc(rm)
VCOL = vscolor(rm)
VCOL = VCOL - 1
VCOLINC = vcolorinc(rm)
If VCOLINC < 0 Then VCOL = VCOL + 2
If VCOLINC = 0 Then VCOL = VCOL + 1
For PLNU = SK1 To SK2 Step SKINC
VT1 = T1(PLNU)
VT2 = T2(PLNU)
VB1 = B1(PLNU)
VB2 = B2(PLNU)
VCOL = VCOL + VCOLINC
If VCOL = 0 Then VCOL = 1
If VCOL = 237 Then VCOL = 236
' draw line
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VCOL), green(VCOL), blue(VCOL))
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VCOL), green(VCOL), blue(VCOL))
Next INS
Next PLNU
Next rm
End Sub
Private Sub linebtn_Click()
lineescapebtn.Visible = True
lineenter.Visible = True
point1label.Visible = True
point2label.Visible = True
linecolorlabel.Visible = True
linebox1.Visible = True
linebox2.Visible = True
linecolorbox.Visible = True
linebox1.SetFocus
End Sub
Private Sub lineescapebtn_Click()
lineenter.Visible = False
point1label.Visible = False
point2label.Visible = False
linecolorlabel.Visible = False
linebox1.Text = ""
linebox2.Text = ""
linebox1.Visible = False
linebox2.Visible = False
linecolorbox.Visible = False
lineescapebtn.Visible = False
End Sub
Private Sub lineenter_Click()
VP1 = Val(linebox1.Text)
VP2 = Val(linebox2.Text)
VCOL = Val(linecolorbox.Text)
If VCOL < 1 Or VCOL > 236 Then
lineenter.Visible = False
point1label.Visible = False
point2label.Visible = False
linecolorlabel.Visible = False
linebox1.Text = ""
linebox2.Text = ""
linebox1.Visible = False
linebox2.Visible = False
linecolorbox.Visible = False
lineescapebtn.Visible = False
GoTo endoflineroutine
End If
lineenter.Visible = False
point1label.Visible = False
point2label.Visible = False
linecolorlabel.Visible = False
linebox1.Text = ""
linebox2.Text = ""
linebox1.Visible = False
linebox2.Visible = False
linecolorbox.Visible = False
lineescapebtn.Visible = False
viewport.Line (GY(VP1), GX(VP1))-(GY(VP2), GX(VP2)), RGB(redd(VCOL), green(VCOL), blue(VCOL))
endoflineroutine:
End Sub
Private Sub crossbtn_Click()
crhtescapebtn.Visible = True
crhtenter.Visible = True
t1label.Visible = True
b1label.Visible = True
t2label.Visible = True
b2label.Visible = True
crhtnumlabel.Visible = True
crhtcolorlabel.Visible = True
t1box.Visible = True
b1box.Visible = True
t2box.Visible = True
b2box.Visible = True
crhtnumbox.Visible = True
crhtcolorbox.Visible = True
t1box.SetFocus
End Sub
Private Sub crhtescapebtn_Click()
t1label.Visible = False
b1label.Visible = False
t2label.Visible = False
b2label.Visible = False
crhtnumlabel.Visible = False
crhtcolorlabel.Visible = False
t1box.Text = ""
b1box.Text = ""
t2box.Text = ""
b2box.Text = ""
t1box.Visible = False
b1box.Visible = False
t2box.Visible = False
b2box.Visible = False
crhtnumbox.Text = ""
crhtcolorbox.Text = ""
crhtnumbox.Visible = False
crhtcolorbox.Visible = False
crhtenter.Visible = False
crhtescapebtn.Visible = False
End Sub
Private Sub crhtenter_Click()
VT1 = Val(t1box.Text)
VB1 = Val(b1box.Text)
VT2 = Val(t2box.Text)
VB2 = Val(b2box.Text)
NUM = Val(crhtnumbox.Text)
VCOL = Val(crhtcolorbox.Text)
If VCOL < 1 Or VCOL > 236 Then
t1label.Visible = False
b1label.Visible = False
t2label.Visible = False
b2label.Visible = False
crhtnumlabel.Visible = False
crhtcolorlabel.Visible = False
t1box.Text = ""
b1box.Text = ""
t2box.Text = ""
b2box.Text = ""
t1box.Visible = False
b1box.Visible = False
t2box.Visible = False
b2box.Visible = False
crhtnumbox.Text = ""
crhtcolorbox.Text = ""
crhtnumbox.Visible = False
crhtcolorbox.Visible = False
crhtenter.Visible = False
crhtescapebtn.Visible = False
GoTo endofcrht
End If
t1label.Visible = False
b1label.Visible = False
t2label.Visible = False
b2label.Visible = False
crhtnumlabel.Visible = False
crhtcolorlabel.Visible = False
t1box.Text = ""
b1box.Text = ""
t2box.Text = ""
b2box.Text = ""
t1box.Visible = False
b1box.Visible = False
t2box.Visible = False
b2box.Visible = False
crhtnumbox.Text = ""
crhtcolorbox.Text = ""
crhtnumbox.Visible = False
crhtcolorbox.Visible = False
crhtenter.Visible = False
crhtescapebtn.Visible = False
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)))
viewport.Line (GYT, GXT)-(GYB, GXB), RGB(redd(VCOL), green(VCOL), blue(VCOL))
Next INS
endofcrht:
End Sub
Private Sub framebtn_Click()
framingenter.Visible = True
framingescapebtn.Visible = True
t1label.Visible = True
b1label.Visible = True
t2label.Visible = True
b2label.Visible = True
crhtnumlabel.Visible = True
crhtcolorlabel.Visible = True
t1box.Visible = True
b1box.Visible = True
t2box.Visible = True
b2box.Visible = True
crhtnumbox.Visible = True
crhtcolorbox.Visible = True
t1box.SetFocus
End Sub
Private Sub framingescapebtn_Click()
t1label.Visible = False
b1label.Visible = False
t2label.Visible = False
b2label.Visible = False
crhtnumlabel.Visible = False
crhtcolorlabel.Visible = False
t1box.Text = ""
b1box.Text = ""
t2box.Text = ""
b2box.Text = ""
t1box.Visible = False
b1box.Visible = False
t2box.Visible = False
b2box.Visible = False
crhtnumbox.Text = ""
crhtcolorbox.Text = ""
crhtnumbox.Visible = False
crhtcolorbox.Visible = False
framingenter.Visible = False
framingescapebtn.Visible = False
End Sub
Private Sub framingenter_Click()
VT1 = Val(t1box.Text)
VB1 = Val(b1box.Text)
VT2 = Val(t2box.Text)
VB2 = Val(b2box.Text)
NR = Val(crhtnumbox.Text)
VCOL = Val(crhtcolorbox.Text)
If VCOL < 1 Or VCOL > 236 Or NR > 100 Then
t1label.Visible = False
b1label.Visible = False
t2label.Visible = False
b2label.Visible = False
crhtnumlabel.Visible = False
crhtcolorlabel.Visible = False
t1box.Text = ""
b1box.Text = ""
t2box.Text = ""
b2box.Text = ""
t1box.Visible = False
b1box.Visible = False
t2box.Visible = False
b2box.Visible = False
crhtnumbox.Text = ""
crhtcolorbox.Text = ""
crhtnumbox.Visible = False
crhtcolorbox.Visible = False
framingenter.Visible = False
framingescapebtn.Visible = False
GoTo endofframing
End If
t1label.Visible = False
b1label.Visible = False
t2label.Visible = False
b2label.Visible = False
crhtnumlabel.Visible = False
crhtcolorlabel.Visible = False
t1box.Text = ""
b1box.Text = ""
t2box.Text = ""
b2box.Text = ""
t1box.Visible = False
b1box.Visible = False
t2box.Visible = False
b2box.Visible = False
crhtnumbox.Text = ""
crhtcolorbox.Text = ""
crhtnumbox.Visible = False
crhtcolorbox.Visible = False
framingenter.Visible = False
framingescapebtn.Visible = False
GB = 11
viewport.Line (GY(VT2), GX(VT2))-(GY(VB2), GX(VB2)), RGB(redd(VCOL), green(VCOL), blue(VCOL))
FL(GB) = 7001: LL(GB) = 7000 + NR
LA = 7000: INS = -1
For TI = 7001 To (7000 + NR)
LA = LA + 1: INS = INS + 1
X(TI) = X(VT1) + ((INS / (NR)) * (X(VT2) - X(VT1)))
Y(TI) = Y(VT1) + ((INS / (NR)) * (Y(VT2) - Y(VT1)))
Z(TI) = Z(VT1) + ((INS / (NR)) * (Z(VT2) - Z(VT1)))
FP(LA) = TI
Next TI
LA = 7000: INS = -1
For BI = (7001 + NR) To (7000 + NR + NR)
LA = LA + 1: INS = INS + 1
X(BI) = X(VB1) + ((INS / (NR)) * (X(VB2) - X(VB1)))
Y(BI) = Y(VB1) + ((INS / (NR)) * (Y(VB2) - Y(VB1)))
Z(BI) = Z(VB1) + ((INS / (NR)) * (Z(VB2) - Z(VB1)))
SP(LA) = BI
Next BI
For RRRR = 7001 To (2 * (LL(GB)) - 7000)
TEMX(RRRR) = X(RRRR): TEMY(RRRR) = Y(RRRR): TEMZ(RRRR) = Z(RRRR)
Next RRRR
1040 'calculator kernel
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)))
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 - Z(G)))) / W
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))
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 DT = 1 Then X(G) = XR(G) - TX: Y(G) = YR(G) - TY: Z(G) = ZR(G) - TZ: GoTo 1050
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
1280:
viewport.Line (GY(FP(LN)), GX(FP(LN)))-(GY(SP(LN)), GX(SP(LN))), RGB(redd(VCOL), green(VCOL), blue(VCOL))
1290 Next LN
GoTo endofframing
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)) = 9999: 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)) = 9999: 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
endofframing:
End Sub