Hi!
Here is a nice road demo. Have fun! (It would be nice to have a hws source deposit in any form, where we can share sources categorized.)
Let me know what do you think about this!
Code: Select all
/*
Road Demonstration Program by Louis Gorenfeld 2010
Hollywood port by Lazi
This program is intended To show concepts described at Lou's
Pseudo 3d Page
http://www.gorenfeld.net/lou/pseudo
It defaults To generating 80 frames during which the road
curves right,
uncurves, and repeats. It lasts several seconds running
under DOSBox at
12000 cycles and 0 frameskip on a Mac Mini 2.0GHz dual core
I've left much detail off of the road. You can draw them in
around Line 70!
Happy coding! :)
*/
@DISPLAY {width=320, height=200}
BeginDoubleBuffer
Const #RoadLines = 89
ScrollSpeed = 10
Const #RoadY = -1 ;arbitrary
Const #ResX = 320
Const #ResY = 200
Const #PlrLine = 8 ;What line is the player sprite on?
Dim ZMap[#RoadLines]
;Initialize ZMap
For A = 1 To #RoadLines
ZMap[A] = #RoadY / (A - (#ResY / 2))
Next
; Normalize ZMap so the Line with the player on it is
scale=1 (or would be
; If we had a player sprite :))
b = 1 / ZMap[#PlrLine]
b = b * 100 ;in percents because QBasic's MOD is lame
For A = 1 To #RoadLines
ZMap[A] = ZMap[A] * b
Next
; Draw the road
NextStretch$ = "Straight"
Const #WidthStep = 1
SetFillStyle(#FILLCOLOR)
Box(0,0,#ResX,#ResY-#RoadLines,#BLUE)
TexOffset = 100
SegY = #RoadLines
DDX = .03 ; This controls the steepness of the curve
CreateBrush(1,320,1,#GRAY)
SelectBrush(1)
Line(0,0,20,0,#WHITE)
Line(300,0,320,0,#WHITE)
EndSelect
CreateBrush(2,320,1,#GRAY)
SelectBrush(2)
Line(0,0,20,0,#RED)
Line(300,0,320,0,#RED)
Line(158,0,162,0,#WHITE)
EndSelect
Function p_road()
; Set up the frame
X = #ResX / 2
DX = 0
HalfWidth = 120
ScreenLine = #ResY
For A = 0 To #RoadLines
If (ZMap[A] + TexOffset) % 100 > 50
GrassColor = #GREEN
RoadColor = #GRAY
br=1
ELSE
GrassColor = #OLIVE
RoadColor = #SILVER
br=2
EndIf
sx=((X + HalfWidth)-(X - HalfWidth))/320
DisplayBrush (br,X - HalfWidth, ScreenLine, {scalex=sx,smoothscale=False})
Line (0, ScreenLine, X - HalfWidth, ScreenLine, GrassColor)
Line (X + HalfWidth, ScreenLine, #ResX - 1, ScreenLine, GrassColor)
HalfWidth = HalfWidth - #WidthStep
ScreenLine = ScreenLine - 1
If NextStretch$ = "Straight"
If A > SegY
;DX = DX - DDX
EndIf
ElseIf NextStretch$ = "Curved"
If A < SegY
;DX = DX - DDX
EndIf
EndIf
MX=(MouseX()-160)/160
X = X + DX + MX
Next
; Wrap positions (fractional):
TexOffset=Wrap(TexOffset + ScrollSpeed, 0, 100)
SegY = SegY - 5 ; Decrease SegY by an arbitrary amount.
Adjust to taste.
WHILE SegY < 0
SegY = SegY + #RoadLines
If NextStretch$ = "Curved"
NextStretch$ = "Straight"
ElseIf NextStretch$ = "Straight"
NextStretch$ = "Curved"
EndIf
WEND
Flip
EndFunction
Function p_key(msg)
If IsKeyDown("UP")
scrollspeed=Min(scrollspeed*1.1,40)
Else
scrollspeed=Max(scrollspeed-.5,10)
EndIf
EndFunction
SetInterval(2,p_key,1000/10)
SetInterval(1,p_road,1000/30)
Repeat
WaitEvent
Forever