RogCAD home Calculator kernel Curve generator Screen capture RogCAD code complete All the math and code was developed by RogCAD (Roger Luebeck). The code was originally written in GW-BASIC. It was re-coded in QuickBASIC, then VisualBASIC. Calculator kernel Vector cross-product is used to create a floating image plane with a normal vector that passes through the origin of the xyz axes. (The focal point can be shifted away from the origin in any manner by the CAD user.) Vector dot-product is used to test which side of the z-axis each projected point stems from. RogCAD's point-pair system allows the calculator kernel to clip lines (thus planes) which land outside the computer screen, thus enabling surface-rendering even when the perspective point is moved inside an object. The CAD user moves around a stationary object by moving the image plane. the code: For LN = FL(GB) To LL(GB) 1045 inc = 299 1050 If DT = 1 Then DT = 0: G = SP(LN): GoTo 1090 G = FP(LN): DT = 1 1070: If ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N)) Then GoTo 3070 If DT = 1 Then GoTo 1100 1090: If ((X(G) * L) + (Y(G) * M) + (Z(G) * N)) > ((L * L) + (M * M) + (N * N)) Then GoTo 3120 1100: W = ((A * A) + (B * B) + (C * C) - (A * X(G)) - (B * Y(G)) - (C * Z(G))) [ W is then the denominator in the following three equations. ] R(G) = (((A * I) * (A - X(G))) + (B * B * X(G)) + (C * C * X(G)) - (B * X(G) * Y(G)) - (C * X(G) * Z(G)) + ((B * J) * (A - X(G))) + ((C * K) * (A - X(G))) - ((B * Y(G)) * (A - X(G))) - ((C * Z(G)) * (A - X(G)))) / W S(G) = (((B * J) * (B - Y(G))) + (A * A * Y(G)) + (C * C * Y(G)) - (A * Y(G) * X(G)) - (C * Y(G) * Z(G)) + ((A * I) * (B - Y(G))) + ((C * K) * (B - Y(G))) - ((A * X(G)) * (B - Y(G))) - ((C * Z(G)) * (B - Y(G)))) / W T(G) = (((C * K) * (C - Z(G))) + (A * A * Z(G)) + (B * B * Z(G)) - (A * Z(G) * X(G)) - (B * Z(G) * Y(G)) + ((A * I) * (C - Z(G))) + ((B * J) * (C - Z(G))) - ((A * X(G)) * (C - Z(G))) - ((B * Y(G)) * (C - 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 ----------------------------------------------------------------------------------------- end of calculator kernel / wireframe image projection ----------------------------------------------------------------------------------------- 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 RogCAD home