I want to do a program which plots a vehicle running on the ground with a square grid from driver's point of view. I don't need drawing the vehicle but I would want draw the track as it is traveled.
The grid has to rotate and move freely.
Can anyone help me?
This is a modified version of a moving 3d objet. It may be useful.
Code: Select all
'Shaded 3-D animation with shadows [solid5.bas] for QB4.5/PDS
'By Rich Geldreich 1992
'Modified by Palmering 2007 (sorry Rich!)
'Notes...
' 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]
' 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 DrawLine (xs%, ys%, xe%, ye%, EdgeList() AS ANY)
DECLARE SUB DrawObject ()
DECLARE SUB EdgeFill (EdgeList() AS ANY, YLow%, YHigh%, C%)
DECLARE SUB PolyFill (x1%, y1%, x2%, y2%, x3%, y3%, C%)
DECLARE SUB RotatePoints ()
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 coordinate
ZObject AS INTEGER 'rotated coordinate
XWorld AS INTEGER
ZWorld AS INTEGER
XView AS INTEGER 'rotated & translated coordinate
YView AS INTEGER
END TYPE
TYPE PolyType
P1 AS INTEGER '3 points which make up the polygon (points
P2 AS INTEGER 'to the point list array)
P3 AS INTEGER
END TYPE
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 Polys(100) AS PolyType
DIM SHARED Points(100) AS PointType
DIM SHARED s, XLow(1), XHigh(1), YLow(1), YHigh(1)
MaxPoints = 7 'Surface
'Points follow...
DATA -100,-100, -100,100, -1,100, -1,-100
DATA 1,-100, 1,100, 100,100, 100,-100
MaxPolys = 3
DATA 3,0,1, 3,1,2, 7,4,5, 7,5,6
FOR a = 0 TO MaxPoints
READ Points(a).XObject, Points(a).ZObject
NEXT
FOR a = 0 TO MaxPolys
READ Polys(a).P1, Polys(a).P2, Polys(a).P3
NEXT
'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
PRINT "Strike a key...": DO: LOOP WHILE INKEY$ = ""
R1 = 0: R2 = 0: R3 = 330 'three angles of rotation
ox = 0: oy = 0: oz = 300 'object's origin (this program cannot
'currently 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
OUT &H3C9, (a * 255) \ 15 'R
OUT &H3C9, (a * 255) \ 15 'G
OUT &H3C9, (a * 255) \ 15 'B
IF a = 7 THEN OUT &H3C7, 16: OUT &H3C8, 16
NEXT
SCREEN 7, , 1, 0
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)), 0, BF
ELSEIF YLow(s) < 100 THEN
LINE (XLow(s), YLow(s))-(XHigh(s), 99), 0, BF
LINE (XLow(s), 100)-(XHigh(s), YHigh(s)), 0, BF
ELSE
LINE (XLow(s), YLow(s))-(XHigh(s), YHigh(s)), 0, BF
END IF
END IF
RotatePoints
XLow(s) = 32767: XHigh(s) = -32768
YLow(s) = 32767: YHigh(s) = -32768
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: oy = oy + dy
IF oz < 300 THEN 'determina limite acercamiento zoom
oz = 300: dz = 0
ELSEIF oz > 8000 THEN 'determina limite alejamiento zoom
oz = 8000: dz = 0
END IF
IF ox <4000> 4000 THEN
ox = 4000: dx = 0
END IF
a$ = INKEY$
SELECT CASE a$
CASE "4"
D1 = D1 - 1
CASE "6"
D1 = D1 + 1
CASE "8"
D2 = D2 - 1
CASE "2"
D2 = D2 + 1
CASE "5"
D1 = 0: D2 = 0: D3 = 0
CASE "0"
R1 = 0: R2 = 0: R3 = 0
D1 = 0: D2 = 0: D3 = 0
oz = 500: ox = 0: oy = 0
dx = 0: dz = 0: dy = 0
CASE "+"
D3 = D3 + 1
CASE "-"
D3 = D3 - 1
CASE "/"
dy = dy + 1
CASE "*"
dy = dy - 1
CASE CHR$(27)
END
CASE CHR$(0) + CHR$(72)
dz = dz + 5
CASE CHR$(0) + CHR$(80)
dz = dz - 5
CASE CHR$(0) + CHR$(77)
dx = dx + 5
CASE CHR$(0) + CHR$(75)
dx = dx - 5
END SELECT
LOOP
'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
IF ye <0> 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> 199 THEN ye = 199
xdirect = SGN(xd) + xi
FOR Y = ys TO ye
IF xs <EdgeList> 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
'Plot the polygons.
FOR a = 0 TO MaxPolys
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), 15 '(Polys(a).Intensity)
NEXT
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
'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.
SUB PolyFill (x1, y1, x2, y2, x3, y3, C) 'for QB 4.5 guys
'find lowest and high X & Y coordinates
IF y1 < y2 THEN YLow = y1 ELSE YLow = y2
IF y3 <YLow> 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> x2 THEN XHigh = x1 ELSE XHigh = x2
IF x3 > XHigh THEN XHigh = x3
IF YLow <0> 199 THEN YHigh = 199
IF XLow <XLow> XHigh(s) THEN XHigh(s) = XHigh
IF YLow <YLow> YHigh(s) THEN YHigh(s) = YHigh
'check for polygons which cannot be visible
IF YHigh <0> 199 OR XLow > 319 OR XHigh <0> 300 THEN STOP
Points(a).XWorld = x2
Points(a).ZWorld = z3
NEXT
EXIT SUB
Rotate3D:
x1 = (xo * c1& - zo * s1&) \ 1024 'yaw
z1 = (xo * s1& + zo * c1&) \ 1024
z3 = (z1 * c3& - yo * s3&) \ 1024 + oz 'pitch
y2 = (z1 * s3& + yo * c3&) \ 1024
x2 = (x1 * c2& + y2 * s2&) \ 1024 + ox 'roll
y3 = (y2 * c2& - x1 * s2&) \ 1024 + oy
RETURN
END SUB