--------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F2N00022 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: ALL (Read 3 times) Subj: SOLID5.BAS 7/10 '>>> Page 7 of SOLID5.BAS begins here. CompareHigh = CompareLow CompareLow = CompareLow - Mid IF CompareLow < 0 THEN EXIT DO LOOP NEXT Mid = Mid \ 2 LOOP WHILE Mid > 0 '| Plot the visible polygons. FOR Z = 0 TO NumPolys a = Polys(Z).ZOrder '| which polygon do we plot? P1 = Polys(a).P1 P2 = Polys(a).P2 P3 = Polys(a).P3 PolyFill (Points(P1).XView), (Points(P1).YView), (Points(P2)_ .XView), (Points(P2).YView), (Points(P3).XView), (Points(P3).YView),_ (Polys(a).Intensity) NEXT END SUB SUB DrawShadows YLow = 32767 YHigh = -32768 XLow = 32767 XHigh = -32768 FOR a = 0 TO MaxPoints 'Project the 3-D point onto the ground plane... temp& = (Points(a).YWorld - 200) X = Points(a).XWorld - (temp& * lx) \ ly Y = 200 '| ground plane has a constant_ ' Y coordinate Z = Points(a).ZWorld - (temp& * lz) \ ly 'Put the point into perspective xTemp = 160 + (X * 400&) \ Z yTemp = 100 + (Y * 300&) \ Z Points(a).XShadow = xTemp Points(a).YShadow = yTemp 'Find the lowest & highest X Y coordinates IF yTemp < YLow THEN YLow = yTemp IF yTemp > YHigh THEN YHigh = yTemp IF xTemp < XLow THEN XLow = xTemp IF xTemp > XHigh THEN XHigh = xTemp NEXT 'Store lowest & highest coordinates for later erasing... ShadowXLow(s) = XLow ShadowYLow(s) = YLow ShadowXHigh(s) = XHigh ShadowYHigh(s) = YHigh IF XHigh < 0 OR XLow > 319 OR YLow > 199 OR YHigh < 0 THEN EXIT SUB IF YHigh > 199 THEN YHigh = 199 IF YLow < 0 THEN YLow = 0 'Initialize the edge list FOR a = YLow TO YHigh EdgeList(a).Low = 32767 EdgeList(a).High = -32768 NEXT 'Enter the lines into the edge list FOR a = 0 TO MaxLines P1 = lines(a).P1 P2 = lines(a).P2 DrawLine (Points(P1).XShadow), (Points(P1).YShadow),_ (Points(P2).XShadow), (Points(P2).YShadow), EdgeList() 'LINE ((Points(P1).XShadow), (Points(P1).YShadow))-((Points(P2)_ '.XShadow), (Points(P2).YShadow)), 0 NEXT 'Fill the polygon EdgeFill EdgeList(), YLow, YHigh, 3 '>>> Page 7 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: F2N00023 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: ALL (Read 3 times) Subj: SOLID5.BAS 8/10 '>>> Page 8 of SOLID5.BAS begins here. END SUB SUB EdgeFill (EdgeList() AS EdgeType, YLow, YHigh, C) FOR a = YLow TO YHigh LINE (EdgeList(a).Low, a)-(EdgeList(a).High, a), C NEXT END SUB 'This routine initializes the data required by the fast Lambert shading 'algorithm. It calculates the point which is both perpendicular 'and a constant distance from each polygon and stores it. This point 'is then rotated with the rest of the points. When it comes time for 'shading, the normal to the polygon is looked up in a simple lookup 'table for maximum speed. SUB FindNormals FOR a = 0 TO MaxPolys P1 = Polys(a).P1 P2 = Polys(a).P2 P3 = Polys(a).P3 'find the vectors of 2 lines inside the polygon ax! = Points(P2).XObject - Points(P1).XObject ay! = Points(P2).YObject - Points(P1).YObject az! = Points(P2).ZObject - Points(P1).ZObject bx! = Points(P3).XObject - Points(P2).XObject by! = Points(P3).YObject - Points(P2).YObject bz! = Points(P3).ZObject - Points(P2).ZObject 'find the cross product of the 2 vectors nx! = ay! * bz! - az! * by! ny! = az! * bx! - ax! * bz! nz! = ax! * by! - ay! * bx! 'normalize the vector so it ranges from -1 to 1 M! = SQR(nx! * nx! + ny! * ny! + nz! * nz!) IF M! <> 0 THEN nx! = nx! / M! ny! = ny! / M! nz! = nz! / M! END IF 'store the vector for later rotation(notice that it is scaled 'up by 128 so it can be stored as an integer variable) Polys(a).WorldXN = nx! * 128 + Points(P1).XObject Polys(a).WorldYN = ny! * 128 + Points(P1).YObject Polys(a).WorldZN = nz! * 128 + Points(P1).ZObject NEXT END SUB 'Draws a polygon to the screen. Simply finds the start and stop X 'coordinates for each scan line within the polygon and uses the 'LINE command for filling. 'for QB 4.5 guys SUB PolyFill (x1, y1, x2, y2, x3, y3, C) 'find lowest and high X & Y coordinates IF y1 < y2 THEN YLow = y1 ELSE YLow = y2 IF y3 < YLow THEN YLow = y3 IF y1 > y2 THEN YHigh = y1 ELSE YHigh = y2 IF y3 > YHigh THEN YHigh = y3 IF x1 < x2 THEN XLow = x1 ELSE XLow = x2 IF x3 < XLow THEN XLow = x3 IF x1 > x2 THEN XHigh = x1 ELSE XHigh = x2 IF x3 > XHigh THEN XHigh = x3 IF YLow < 0 THEN YLow = 0 IF YHigh > 199 THEN YHigh = 199 IF XLow < XLow(s) THEN XLow(s) = XLow IF XHigh > XHigh(s) THEN XHigh(s) = XHigh IF YLow < YLow(s) THEN YLow(s) = YLow IF YHigh > YHigh(s) THEN YHigh(s) = YHigh '>>> Page 8 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: F2N00024 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: ALL (Read 3 times) Subj: SOLID5.BAS 9/10 '>>> Page 9 of SOLID5.BAS begins here. 'check for polygons which cannot be visible IF YHigh < 0 OR YLow > 199 OR XLow > 319 OR XHigh < 0 THEN EXIT SUB 'initialize the edge list FOR a = YLow TO YHigh EdgeList(a).Low = 32767 EdgeList(a).High = -32768 NEXT 'Remember the lowest & highest X and Y coordinates drawn to the 'screen for later erasing 'Find the start and stop X coodinates for each scan line DrawLine (x1), (y1), (x2), (y2), EdgeList() DrawLine (x2), (y2), (x3), (y3), EdgeList() DrawLine (x3), (y3), (x1), (y1), EdgeList() EdgeFill EdgeList(), YLow, YHigh, C END SUB 'Rotates the points of the object and the object's normals. 'Avoids floating point math for speed. SUB RotatePoints 'lookup the sine and cosine of each angle... s1& = SineTable(R1) c1& = SineTable(R1 + 90) s2& = SineTable(R2) c2& = SineTable(R2 + 90) s3& = SineTable(R3) c3& = SineTable(R3 + 90) 'rotate the points of the object FOR a = 0 TO MaxPoints xo = Points(a).XObject yo = Points(a).YObject zo = Points(a).ZObject GOSUB Rotate3D Points(a).XView = 160 + (x2 * 400&) \ z3 Points(a).YView = 100 + (y3 * 300&) \ z3 'IF y3 > 300 THEN STOP Points(a).XWorld = x2 Points(a).YWorld = y3 Points(a).ZWorld = z3 NEXT 'rotate the normals of each polygon... FOR a = 0 TO MaxPolys xo = Polys(a).WorldXN yo = Polys(a).WorldYN zo = Polys(a).WorldZN GOSUB Rotate3D P1 = Polys(a).P1 'unorigin the point x2 = x2 - Points(P1).XWorld y3 = y3 - Points(P1).YWorld z3 = z3 - Points(P1).ZWorld 'check the bounds just in case of a round off error IF x2 < -128 THEN x2 = -128 ELSE IF x2 > 128 THEN x2 = 128 IF y3 < -128 THEN y3 = -128 ELSE IF y3 > 128 THEN y3 = 128 IF z3 < -128 THEN z3 = -128 ELSE IF z3 > 128 THEN z3 = 128 'store the normal back; it's now ready for the shading 'calculations (which are simplistic now) Polys(a).NormalX = x2 + 128 Polys(a).NormalY = y3 + 128 Polys(a).NormalZ = z3 + 128 NEXT EXIT SUB '>>> Page 9 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: F2N00025 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: ALL (Read 3 times) Subj: SOLID5.BAS 10/10 '>>> Page 10 of SOLID5.BAS begins here. ROTATE3D: x1 = (xo * c1& - zo * s1&) \ 1024 '| yaw z1 = (xo * s1& + zo * c1&) \ 1024 '| pitch z3 = (z1 * c3& - yo * s3&) \ 1024 + oz y2 = (z1 * s3& + yo * c3&) \ 1024 '| roll x2 = (x1 * c2& + y2 * s2&) \ 1024 + ox y3 = (y2 * c2& - x1 * s2&) \ 1024 + oy RETURN END SUB 'Shades the polygons using Lambert shading. Notice the total lack of 'floating point math- only 1 divide is required for each polygon shaded. '(This divide can be eliminated, but the shading won't be as accurate.) SUB ShadePolygons FOR a = 0 TO MaxPolys IF Polys(a).Culled = False THEN 'lookup the polygon's normal for shading '(128*128)\15 = 1092 Intensity = (lx(Polys(a).NormalX) + ly(Polys(a).NormalY) +_ lz(Polys(a).NormalZ)) \ 1092 IF Intensity < 0 THEN Intensity = 0 Intensity = Intensity + 5 IF Intensity > 15 THEN Intensity = 15 Polys(a).Intensity = Intensity END IF NEXT END SUB '>>> Page 10 of SOLID5.BAS ends here. Last 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: F2N00026 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: TED CRAMER (Read 3 times) Subj: BBS Doors Greetings and felicitations Ted, TR-> I have created a progrma in Qbasic and have basically gotten rid of TR-> all the bugs (ya right).. I have one slight problem.. The program TR-> i wrote was to be a BBS door.. I have NO clue on how to make it a TR-> bbs door.. Could someone be kind enough to tell me how to send all TR-> of the charactors to the local screen (my computer) AND the callers TR-> computer? I have NO purpose for a drop file as it is a note to the TR-> next user wall and it doesn't matter.. I just need to know how to TC> Hang on for a day or so and I'll post the port opening info for you TC> and others who may have the need. I have to find the code for the TC> door I wrote several years ago and will post that portion. I hope you don't mind Ted, but I have a little suggestion to make here. How about posting the whole thing as a tutorial for others who wish to write door programs? If it's too big to send all at once, you could always send out bits with explanatory text, over a number of weeks. I'm sure that a lot of people would be interested in it, I know that I for one would be. It's just a suggestion. Byeee, Nigel. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F2N00027 Date: 02/17/98 From: NIGEL TRAVES Time: 01:09pm \/To: KEN KUEBLER (Read 3 times) Subj: LOADANSI.BAS 3/3 Greetings and felicitations Ken, KK> Thanks for all the help but i found a simpler way to do it..But some KK> of the info in your files will be helpful for future programs.. Well, just to finish it off (and at the risk of over-kill), I thought I would let you have this bit of old code that I found, just in case you find it useful. -------------------------------CUT-HERE------------------------------- From: Mark Olson To: All Msg #551, Aug-28-92 12:55:00 Subject: Re: Ansi Graphics JA>> there any way to "redirect" them to ANSI.SYS instead of writing the JA>> decoding routines myself? All Right I've read a couple of replies and most are correct as far as displaying ANSI graphics, but just to throw in my two cents... ANSI graphis is the use of Escape codes to change Text Display Atributes and Display Related functions. There are several ways of doing this. The one I have seen here is the use of CON: or the Standard Output Device (Console). There is nothing wrong with that aprroach BUT there is another avenue which access ANSI.SYS Directly Via Interrupt 21h sub-function 40h. ' ----------------------------- Ansi Routine --------------------------- ' QuickBasic 4.5 & PDS 7.X Modifications ' Use of Ansi.sys to display Ansi graphics at the current cursor ' location. Using Int 21H Sub-Function 40H. DECLARE SUB AnsiWrite (Text$) 'Use QB.exe /L To load the quickbasic library QB.qbl 'Use QBX.exe /L To load the PDS 7.X Library QBX.qbl '$INCLUDE: 'QB.BI' ' Use $include: QBX.bi for PDS 7.X DIM SHARED RegsX AS RegTypeX Esc$ = CHR$(27) ' Escape Character Temp$ = "" White$ = Esc$ + "[0m" + Esc$ + "[37m" BrYellow$ = Esc$ + "[1m" + Esc$ + "[33m" Temp$ = White$ + "This is a " + BrYellow$ + "Example " + White$ + "of ANSI!" CLS AnsiWrite (Temp$) ' --------------------------------------------------------------- SUB AnsiWrite (Text$) RegsX.ax = &H4000 'AH = 40H RegsX.bx = 1 'FILE HANDLE RegsX.cx = LEN(Text$) 'Number of Bytes to Write RegsX.ds = VARSEG(Text$) 'Segment for the string 'Use SSEG(Text$) Vice VARSEG(Text$) for PDS 7.1 RegsX.dx = SADD(Text$) 'Segment offset(address) of string CALL InterruptX(&H21, RegsX, RegsX) END SUB '------------------------------------------------------------------ well hope this helps anyone. l8r Mark Olson