---------------
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