--------------------------------------------------------------------------- Regards, FidoNet : 2:254/292.3 Richard Griffiths Email : Rich@TheArc.CrayBBS.co.uk CoSysop of Burp's BBS UK Burp's BBS: ++44 (0)181 405 4164 --------------------------------------------------------------------------- .!. a HANDBRAKE!! Handbrake skids galore! :) The game is up to --- The Ripped one * Origin: D - A - V - E C - A - R - T - E - R FOR R - E - C! (2:254/292.3) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F2N00014 Date: 02/17/98 From: MIKE GINGER Time: 07:30am \/To: TIKA CARR (Read 3 times) Subj: CD-ROM Drive Functions -=> Quoting Tika Carr to All on 10 Feb 98 13:39:00 <=- Hi Tika, Unfortunately, your code (below) caused my PC's Windoze 95 to crash. I thought you may like to try my CD-ROM code (see below) but it does not test to see if the drive is ready. I've tested it on my Windoze 95 PC without any crashes. TC> Here's some stuff I wrote up. It's also in a large library I'm writing TC> for QuickBasic (a compilation of stuff I gathered and some stuff I TC> wrote). I'm still working on this huge library though, but thought this TC> bit of code would be useful to some. You'll need QuickBasic 4.5 and TC> load it with /L QB.QLB. TC> =======>8 Snip 8<======= TC> 'CD-ROM Drive Routines TC> 'by Tika Carr 02-09-1998 TC> 'Public Domain: No warranties or guarantees are expressed or implied. TC> DEFINT A-Z TC> '$INCLUDE: 'QB.BI' TC> 'Returns Number of drives, First letter of CD-ROM drive TC> 'DO NOT use with DOS 4.0 GRAPHICS.COM or with any INTERLNK installed. TC> DECLARE SUB CDList (NumDrives%, FirstCD$) TC> 'Returns the CD-ROM driver version TC> DECLARE FUNCTION CDVersion! () TC> 'Checks to see if CD-ROM drive is "ready". Returns that it's not ready TC> 'if an audio CD is inserted (also takes longer to check). TC> DECLARE FUNCTION CheckCD% (drive$) TC> '**** CD DEMO TC> CLS : CDList nd, CD$ TC> FOR i = ASC(CD$) TO ASC(CD$) + nd - 1 TC> IF CheckCD(CHR$(i)) = 0 THEN prt$ = " " ELSE prt$ = " not " TC> PRINT "CD-ROM Drive "; CHR$(i); " is"; prt$; "ready" TC> NEXT TC> cv! = CDVersion! TC> IF cv! = 2.95 THEN prt$ = " Windows 95" ELSE prt$ = STR$(CDVersion!) TC> PRINT : PRINT "CD-ROM Driver Version:"; prt$ TC> '**** END CD DEMO TC> SUB CDList (NumDrives, FirstCD$) TC> DIM regs AS RegType TC> regs.ax = &H1500: regs.bx = 0: INTERRUPT &H2F, regs, regs TC> NumDrives = regs.bx: FirstCD$ = CHR$(regs.cx + 65) TC> END SUB TC> FUNCTION CDVersion! TC> DIM regs AS RegType TC> regs.ax = &H150C: regs.bx = 0: INTERRUPT &H2F, regs, regs TC> majv = VAL("&H" + LEFT$(HEX$(regs.bx), 1)) TC> minv! = VAL("&H" + RIGHT$(HEX$(regs.bx), 1)) TC> z = LEN(LTRIM$(RTRIM$(STR$(minv!)))) TC> IF z = 0 THEN deci! = .1 ELSE deci! = VAL("." + STRING$(z - 1, "0") + TC> "1") TC> CDVersion! = majv + minv! * deci! TC> END FUNCTION TC> FUNCTION CheckCD (drive$) TC> DIM InRegs AS RegTypeX, Outregs AS RegTypeX TC> InRegs.cx = ASC(drive$) - 65: InRegs.dx = 0: InRegs.ax = &H1505: TC> InRegs.bx = VARSEG(Buffer$): InRegs.es = VARPTR(Buffer$) TC> INTERRUPTX &H2F, InRegs, Outregs TC> IF (Outregs.flags AND 1) THEN CheckCD = Outregs.ax ELSE CheckCD = 0 TC> END FUNCTION TC> =======>8 Snip 8<======= ======================== Begin ========================================= DEFINT A-Z DECLARE FUNCTION CDRomInstalled% () DECLARE FUNCTION CDRomMSCDEXVer! () DECLARE FUNCTION CDRomDrives% () DECLARE FUNCTION CDRomFirstDrive$ () ' $INCLUDE: 'QB.BI' DIM SHARED inReg AS RegTypeX, outreg AS RegTypeX CLS PRINT "Is a CD-ROM Drive installed? "; IF CDRomInstalled% THEN PRINT "Yes" PRINT "MSCDEX CD-Rom Driver Version"; CDRomMSCDEXVer! PRINT "Number of CD-ROM units "; CDRomDrives% PRINT "First CD-ROM drive "; CDRomFirstDrive$ ELSE PRINT "No" END IF FUNCTION CDRomDrives% inReg.ax = &H1500 inReg.bx = &H0 INTERRUPTX &H2F, inReg, outreg CDRomDrives% = outreg.bx END FUNCTION FUNCTION CDRomFirstDrive$ inReg.ax = &H1500 inReg.bx = &H0 INTERRUPTX &H2F, inReg, outreg CDRomFirstDrive$ = CHR$(65 + outreg.cx) END FUNCTION FUNCTION CDRomInstalled% inReg.ax = &H1100 CALL INTERRUPTX(&H2F, inReg, outreg) IF (outreg.ax AND 255) = &HFF THEN ' MSCDEX is there CDRomInstalled% = 1 ' Set FUNCTION to True END IF END FUNCTION FUNCTION CDRomMSCDEXVer! inReg.ax = &H150C CALL INTERRUPTX(&H2F, inReg, outreg) IF outreg.bx > 0 THEN Min = outreg.bx AND 255: Maj = outreg.bx / 256 ELSE Maj = 1 END IF CDRomMSCDEXVer! = ((100 * Maj) + Min) / 100 END FUNCTION ======================== End =========================================== Hope this helps, Mike -- **************************************************************** * FidoNet: Mike Ginger, 2:251/21 e-mail: MikeGinger@aol.com * **************************************************************** --- GEcho/32 1.20/Pro * Origin: METRIC BBS * 01705 871471 * Multi Line * V34 28k8 * (2:251/21) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F2N00015 Date: 02/17/98 From: MIKE GINGER Time: 07:30am \/To: TIKA CARR (Read 3 times) Subj: CD-ROM Drive: Is it Ready? Hi Tika, Here's some code (that I never quite managed to get around to finishing - to test for the presence of an Audio CD) that you may like to test: ======================== CUT HERE ================================ ' Check to see if CD-ROM Drive is ready DECLARE FUNCTION CDRomReady% (CDRomDrive$) '$INCLUDE: 'qb.bi' INPUT "CD Rom Drive to test "; CDDrive$ CDRomDrive$ = UCASE$(CDDrive$) PRINT ASC(CDRomDrive$) IF CDRomReady%(CDRomDrive$) THEN PRINT "CD-ROM is Ready " ELSE PRINT "CD-ROM Not Ready or Non-Data CD" END IF PRINT CDRomReady%(CDRomDrive$) PRINT CDRomDrive$ FUNCTION CDRomReady% (CDRomDrive$) DIM regsx AS RegTypeX buffer$ = SPACE$(2048) BEEP CDRomDrive$ = UCASE$(CDRomDrive$) CDDrive% = ASC(CDRomDrive$) - 65 regsx.ax = &H1508 regsx.es = VARSEG(buffer$) 'segment of buffer regsx.bx = SADD(buffer$) 'offset of buffer regsx.cx = CDDrive% 'CD drive letter regsx.si = 1 'starting.. regsx.di = 2 ' ..sector regsx.dx = 1 'sectors to read interruptx &H2F, regsx, regsx IF regsx.flags AND 1 THEN CDRomReady% = 0 'CD-Rom not ready ELSE CDRomReady% = 1 'CD-Rom is ready END IF END FUNCTION ======================== CUT HERE ================================ Hope this helps, Mike -- **************************************************************** * FidoNet: Mike Ginger, 2:251/21 e-mail: MikeGinger@aol.com * **************************************************************** --- GEcho/32 1.20/Pro * Origin: METRIC BBS * 01705 871471 * Multi Line * V34 28k8 * (2:251/21) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F2N00016 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: ALL (Read 3 times) Subj: SOLID5.BAS 1/10 '>>> Page 1 of SOLID5.BAS begins here. TYPE:BAS 'Page 1 of SOLID5.BAS begins here. 'Shaded 3-D animation with shadows [solid5.bas] for QB4.5/PDS 'By Rich Geldreich 1992 'Notes... ' This version uses some floating point math in the initialization 'code for shading, but after initialization floating point math is not 'used at all. ' The shading employs Lambert's Law to determine the intensity of 'each visible polygon. Three simple lookup tables are calculated at 'initialization time which are used to eliminate multiples and 'divides in the main animation code. ' The hidden face detection algorithm was made by Dave Cooper. 'It's fast, and does not require any multiples and divides under most 'cases. The "standard" way of detecting hidden faces, by finding the 'dot product of the normal of each polygon and the viewing vector, 'was not just good (or fast) enough for me! ' The PolyFill routine is the major bottleneck of this program. 'QB's LINE command isn't as fast as I would like it to be... On my '286-10, the speed isn't that bad (after all, this is all-QB!). On a '386 or 486, this thing should fly... [hopefully] ' The shadows are calculated by projecting a line with the light 'source's vector through each of the points on the solid. Where this 'line hits the ground plane(which has a constant Y coordinate) is 'where the new shadow point is plotted. ' This program is 100% public domain- but of course please give 'some credit if you use anything from this program. Thanks! DEFINT A-Z DECLARE SUB CullPolygons () DECLARE SUB DrawLine (xs%, ys%, xe%, ye%, EdgeList() AS ANY) DECLARE SUB DrawObject () DECLARE SUB DrawShadows () DECLARE SUB EdgeFill (EdgeList() AS ANY, YLow%, YHigh%, C%) DECLARE SUB FindNormals () DECLARE SUB PolyFill (x1%, y1%, x2%, y2%, x3%, y3%, C%) DECLARE SUB RotatePoints () DECLARE SUB ShadePolygons () CONST True = -1, False = 0 TYPE EdgeType '| for fast polygon_ ' rasterization Low AS INTEGER High AS INTEGER END TYPE TYPE PointType XObject AS INTEGER '| original cooridinate YObject AS INTEGER ZObject AS INTEGER '| rotated coodinated XWorld AS INTEGER YWorld AS INTEGER ZWorld AS INTEGER XView AS INTEGER '| rotated & translated_ ' coordinate YView AS INTEGER XShadow AS INTEGER '| coordinates projected onto_ ' the ground plane YShadow AS INTEGER END TYPE TYPE PolyType P1 AS INTEGER '| 3 points which make up the_ ' polygon(they point P2 AS INTEGER '| to the point list array) P3 AS INTEGER Culled AS INTEGER '| True if plane not visible ZCenter AS INTEGER '| Z center of polygon ZOrder AS INTEGER '| Used in the shell sort of_ ' the ZCenters Intensity AS INTEGER '| Intensity of polygon WorldXN AS INTEGER '| Contains the coordinates of_ ' the point WorldYN AS INTEGER '| which is both perpendicular_ ' and a constant WorldZN AS INTEGER '| distance from the polygon NormalX AS INTEGER '| Normal of polygon -128 to 128 NormalY AS INTEGER '| (used for fast Lambert_ ' shading) NormalZ AS INTEGER END TYPE TYPE LineType P1 AS INTEGER '| Used for shadow projection P2 AS INTEGER END TYPE '>>> Page 1 of SOLID5.BAS ends here. Continued on next page. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F2N00017 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: ALL (Read 3 times) Subj: SOLID5.BAS 2/10 '>>> Page 2 of SOLID5.BAS begins here. DIM SHARED EdgeList(199) AS EdgeType DIM SHARED SineTable(359 + 90) AS LONG '| cos(x)=sin(x+90) DIM SHARED R1, R2, R3, ox, oy, oz DIM SHARED MaxPoints, MaxPolys, MaxLines DIM SHARED lines(100) AS LineType DIM SHARED Polys(100) AS PolyType DIM SHARED Points(100) AS PointType DIM SHARED lx(256), ly(256), lz(256) '| lookup tables for Lambert_ ' shading DIM SHARED s, XLow(1), XHigh(1), YLow(1), YHigh(1) DIM SHARED ShadowXLow(1), ShadowXHigh(1), ShadowYLow(1), ShadowYHigh(1) DIM SHARED lx, ly, lz PRINT "QuickBASIC/PDS 3-D Solid Animation" PRINT "By Rich Geldreich 1992" PRINT PRINT "Keys: [Turn NUMLOCK on]" PRINT "Left.....................Angle 1 -" PRINT "Right....................Angle 1 +" PRINT "Up.......................Angle 2 -" PRINT "Down.....................Angle 2 +" PRINT "-........................Angle 3 -" PRINT "+........................Angle 3 +" PRINT "5........................Rotation Stop" PRINT "0........................Rotation Reset" PRINT "Up Arrow.................Forward" PRINT "Down Arrow...............Backward" PRINT "Left Arrow...............Left" PRINT "Right Arrow..............Right" PRINT PRINT "Initializing..." MaxPoints = 4 '| Pyramid. 'Points follow... DATA -100,0,100, -100,0,-100, 100,0,-100, 100,0,100, 0,-290,0 MaxPolys = 5 'Polygons follow (they must be specified in counterclockwise 'order for correct hidden face removal and shading) DATA 4,0,3, 4,3,2, 4,1,0, 4,2,1, 3,0,1, 3,1,2 MaxLines = 7 'Lines follow for shadow computation... DATA 4,0, 4,1, 4,2, 4,3, 0,1, 1,2, 2,3, 3,0 'MaxPoints = 7 'Cube. 'DATA -100,100,100 'DATA 100,100,100 'DATA 100,100,-100 'DATA -100,100,-100 'DATA -100,-100,100 'DATA 100,-100,100 'DATA 100,-100,-100 'DATA -100,-100,-100 'MaxPolys = 11 'DATA 5,4,0, 5,0,1 'DATA 6,2,3, 3,7,6 'DATA 6,5,1, 6,1,2 'DATA 7,0,4, 7,3,0 'DATA 6,7,4, 6,4,5 'DATA 0,3,2, 1,0,2 'MaxLines = 11 'DATA 0,1, 1,2, 2,3, 3,0 'DATA 4,5, 5,6, 6,7, 7,4 'DATA 4,0, 5,1, 6,2, 7,3 'MaxPoints = 15 'Wierd pencil-like shape... 'DATA 0,0,0, 250,0,0, 400,40,0, 400,60,0, 250,100,0, 0,100,0, -20,90,0,_ ' -20,10,0 'DATA 0,0,-50, 250,0,-50, 400,40,-50, 400,60,-50, 250,100,-50, 0,100_ ',-50, -20,90,-50, -20,10,-50 'MaxPolys = 27 'DATA 1,0,7, 1,7,2, 2,7,6, 2,6,3, 3,6,4, 4,6,5 'DATA 9,15,8, 9,10,15, 10,14,15, 10,11,14, 11,13,14, 11,12,13 'DATA 8,7,0, 8,15,7, 8,0,1, 9,8,1, 9,1,2, 10,9,2, 10,2,3, 11,10,3 'DATA 12,11,4, 11,3,4, 4,5,13, 4,13,12 'DATA 5,6,14, 5,14,13, 14,6,7, 14,7,15 'MaxLines = 23 '>>> Page 2 of SOLID5.BAS ends here. Continued on next page. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F2N00018 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: ALL (Read 3 times) Subj: SOLID5.BAS 3/10 '>>> Page 3 of SOLID5.BAS begins here. 'DATA 0,1, 1,2, 2,3, 3,4, 4,5, 5,6, 6,7, 7,0 'DATA 8,9, 9,10, 10,11, 11,12, 12,13, 13,14, 14,15, 15,0 'DATA 0,8, 1,9, 2,10, 3,11, 4,12, 5,13, 6,14, 7,15 FOR a = 0 TO MaxPoints READ Points(a).XObject, Points(a).YObject, Points(a).ZObject X = X + Points(a).XObject Y = Y + Points(a).YObject Z = Z + Points(a).ZObject NEXT 'Center the object X = X \ (MaxPoints + 1) Y = Y \ (MaxPoints + 1) Z = Z \ (MaxPoints + 1) FOR a = 0 TO MaxPoints Points(a).XObject = Points(a).XObject - X Points(a).YObject = Points(a).YObject - Y Points(a).ZObject = Points(a).ZObject - Z NEXT FOR a = 0 TO MaxPolys READ Polys(a).P1, Polys(a).P2, Polys(a).P3 NEXT FOR a = 0 TO MaxLines READ lines(a).P1, lines(a).P2 NEXT 'Precalculate the normal point of each polygon for fast Lambert shading FindNormals 'Precalculate the sine table a = 0 FOR a! = 0 TO (359 + 90) / 57.29 STEP 1 / 57.29 SineTable(a) = SIN(a!) * 1024 a = a + 1 NEXT 'Some light source configurations won't work that great! l1 = 70 '| light source's spherical_ ' coordinates l2 = 40 a1! = l1 / 57.29 a2! = l2 / 57.29 s1! = SIN(a1!) c1! = COS(a1!) s2! = SIN(a2!) c2! = COS(a2!) lx = 128 * s1! * c2! '| convert spherical_ ' coordinates to a vector ly = 128 * s1! * s2! '| scale up by 128 for integer_ ' math lz = 128 * c1! FOR a = -128 TO 128 '| precalculate the three light_ ' source tables lx(a + 128) = lx * a '| for fast Lambert shading ly(a + 128) = ly * a lz(a + 128) = lz * a NEXT PRINT "Strike a key..." DO LOOP WHILE INKEY$ = "" R1 = 0 '| three angles of rotation R2 = 0 R3 = 0 ox = 0 '| object's origin (this_ ' program cannot currently oy = -50 oz = 1100 '| handle the object when it_ ' goes behind the viewer!) s = 1 t = 0 SCREEN 7, , 0, 0 OUT &H3C8, 0 '| set 16 shades FOR a = 0 TO 15 '>>> Page 3 of SOLID5.BAS ends here. Continued on next page. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F2N00019 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: ALL (Read 3 times) Subj: SOLID5.BAS 4/10 '>>> Page 4 of SOLID5.BAS begins here. OUT &H3C9, (a * 34) \ 10 OUT &H3C9, (a * 212) \ 100 OUT &H3C9, (a * 4) \ 10 IF a = 7 THEN OUT &H3C7, 16 OUT &H3C8, 16 END IF NEXT LINE (0, 100)-(319, 199), 9, BF LINE (0, 0)-(319, 99), 3, BF SCREEN 7, , 1, 0 LINE (0, 100)-(319, 199), 9, BF LINE (0, 0)-(319, 99), 3, BF YHigh(0) = -32768 ShadowYHigh(0) = -32768 YHigh(1) = -32768 ShadowYHigh(1) = -32768 DO '| Flip active and work pages_ ' so user doesn't see our messy drawing SCREEN 7, , s, t SWAP s, t '| Wait for vertical retrace to_ ' reduce flicker WAIT &H3DA, 8 '| Erase the old image from the_ ' screen IF YHigh(s) <> -32768 THEN IF YHigh(s) < 100 THEN LINE (XLow(s), YLow(s))-(XHigh(s), YHigh(s)), 3, BF ELSEIF YLow(s) < 100 THEN LINE (XLow(s), YLow(s))-(XHigh(s), 99), 3, BF LINE (XLow(s), 100)-(XHigh(s), YHigh(s)), 9, BF ELSE LINE (XLow(s), YLow(s))-(XHigh(s), YHigh(s)), 9, BF END IF END IF IF ShadowYHigh(s) <> -32768 THEN LINE (ShadowXLow(s), ShadowYLow(s))-(ShadowXHigh(s),_ ShadowYHigh(s)), 9, BF END IF RotatePoints CullPolygons ShadePolygons XLow(s) = 32767 XHigh(s) = -32768 YLow(s) = 32767 YHigh(s) = -32768 DrawShadows DrawObject R1 = (R1 + D1) MOD 360 IF R1 < 0 THEN R1 = R1 + 360 R2 = (R2 + D2) MOD 360 IF R2 < 0 THEN R2 = R2 + 360 R3 = (R3 + D3) MOD 360 IF R3 < 0 THEN R3 = R3 + 360 oz = oz + dz ox = ox + dx IF oz < 600 THEN oz = 600 dz = 0 ELSEIF oz > 8000 THEN oz = 8000 dz = 0 END IF IF ox < -4000 THEN ox = -4000 dx = 0 ELSEIF ox > 4000 THEN ox = 4000 dx = 0 END IF a$ = INKEY$ SELECT CASE a$ CASE "4" D1 = D1 - 2 CASE "6" D1 = D1 + 2 '>>> Page 4 of SOLID5.BAS ends here. Continued on next page. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F2N00020 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: ALL (Read 3 times) Subj: SOLID5.BAS 5/10 '>>> Page 5 of SOLID5.BAS begins here. CASE "8" D2 = D2 - 2 CASE "2" D2 = D2 + 2 CASE "5" D1 = 0 D2 = 0 D3 = 0 CASE "0" R1 = 0 R2 = 0 R3 = 0 D1 = 0 D2 = 0 D3 = 0 CASE "+" D3 = D3 + 2 CASE "-" D3 = D3 - 2 CASE CHR$(27) END CASE CHR$(0) + CHR$(72) dz = dz - 20 CASE CHR$(0) + CHR$(80) dz = dz + 20 CASE CHR$(0) + CHR$(77) dx = dx - 20 CASE CHR$(0) + CHR$(75) dx = dx + 20 END SELECT LOOP '"Culls" the polygons which aren't visible to the viewer. Also shades 'each polygon using Lambert's law. SUB CullPolygons 'This algorithm for removing hidden faces was developed by Dave Cooper. 'There is another method, by finding the dot product of the 'plane's normal and the viewing vector, but this algorithm is 'much faster because of its simplicity(and lack of floating point 'calculations). FOR a = 0 TO MaxPolys P1 = Polys(a).P1 P2 = Polys(a).P2 P3 = Polys(a).P3 IF Points(P1).YView <= Points(P2).YView THEN IF Points(P3).YView < Points(P1).YView THEN PTop = P3 PNext = P1 PLast = P2 ELSE PTop = P1 PNext = P2 PLast = P3 END IF ELSE IF Points(P3).YView < Points(P2).YView THEN PTop = P3 PNext = P1 PLast = P2 ELSE PTop = P2 PNext = P3 PLast = P1 END IF END IF XLow = Points(PTop).XView YLow = Points(PTop).YView XNext = Points(PNext).XView XLast = Points(PLast).XView IF XNext <= XLow AND XLast >= XLow THEN Polys(a).Culled = True ELSEIF XNext >= XLow AND XLast <= XLow THEN Polys(a).Culled = False ELSE YNext = Points(PNext).YView YLast = Points(PLast).YView '>>> Page 5 of SOLID5.BAS ends here. Continued on next page. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F2N00021 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: ALL (Read 3 times) Subj: SOLID5.BAS 6/10 '>>> Page 6 of SOLID5.BAS begins here. IF ((YNext - YLow) * 256&) \ (XNext - XLow) < ((YLast -_ YLow) * 256&) \ (XLast - XLow) THEN Polys(a).Culled = False ELSE Polys(a).Culled = True END IF END IF NEXT END SUB 'Enters a line into the edge list. For each scan line, the line's 'X coordinate is found. Notice the lack of floating point math in this 'subroutine. SUB DrawLine (xs, ys, xe, ye, EdgeList() AS EdgeType) IF ys > ye THEN SWAP xs, xe SWAP ys, ye END IF IF ye < 0 OR ys > 199 THEN EXIT SUB IF ys < 0 THEN xs = xs + ((xe - xs) * -ys) \ (ye - ys) ys = 0 END IF xd = xe - xs yd = ye - ys IF yd <> 0 THEN xi = xd \ yd xrs = ABS(xd MOD yd) END IF xr = -yd \ 2 IF ye > 199 THEN ye = 199 xdirect = SGN(xd) + xi FOR Y = ys TO ye IF xs < EdgeList(Y).Low THEN EdgeList(Y).Low = xs IF xs > EdgeList(Y).High THEN EdgeList(Y).High = xs xr = xr + xrs IF xr > 0 THEN xr = xr - yd xs = xs + xdirect ELSE xs = xs + xi END IF NEXT END SUB SUB DrawObject 'Find the center of each visible polygon, and prepare the order list. NumPolys = 0 FOR a = 0 TO MaxPolys IF Polys(a).Culled = False THEN '| is this polygon visible? Polys(NumPolys).ZOrder = a NumPolys = NumPolys + 1 Polys(a).ZCenter = Points(Polys(a).P1).ZWorld +_ Points(Polys(a).P2).ZWorld + Points(Polys(a).P3).ZWorld END IF NEXT 'Sort the visible polygons by their Z center using a shell sort. NumPolys = NumPolys - 1 Mid = (NumPolys + 1) \ 2 DO FOR a = 0 TO NumPolys - Mid CompareLow = a CompareHigh = a + Mid DO WHILE Polys(Polys(CompareLow).ZOrder).ZCenter <_ Polys(Polys(CompareHigh).ZOrder).ZCenter SWAP Polys(CompareLow).ZOrder, Polys(CompareHigh).ZOrder '>>> Page 6 of SOLID5.BAS ends here. Continued on next page. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509)