Author 
Topic: Pseudo 3D (Read 479 times) 

cundo
Guru
member is offline
Gender:
Posts: 626


Pseudo 3D
« Thread started on: Oct 16^{th}, 2016, 10:55am » 

I was reading this great article about pseudo 3d: Lou's Pseudo 3d Page The original QBASIC code, lost or removed because it's old, I got it and I made some modifications to make it work: Code:'*****************************************
'Road Demonstration Program by Louis Gorenfeld 2010
'*****************************************
' converted to LB by cundo 2016, find this code and discussion at : libertybasic.conforums.com
'*****************************************
'This program is intended to show concepts described at Lou's Pseudo 3d Page
'http://www.extentofthejam.com/pseudo/
'It defaults to generating 80 frames during which the road curves right,
'uncurves, and repeats.
'*****************************************
'not sure abou the colors
QBColors$(0)= "black"
QBColors$(1)= "darkblue"
QBColors$(2)= "darkgreen"
QBColors$(3)= "cyan"
QBColors$(4)= "red"
QBColors$(5)= "darkred"
QBColors$(6)= "brown"
QBColors$(7)= "lightgray"
QBColors$(8)= "darkgray"
QBColors$(9)= "blue"
QBColors$(10)= "green"
RoadLines = 99
ScrollSpeed = 10
RoadY = 1 'arbitrary
ResX = 320
ResY = 200
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 A
' 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 A
' 320x200x4bpp
nomainwin
WindowWidth = 320 : WindowHeight = 200
UpperLeftX = INT((DisplayWidthWindowWidth)/2)
UpperLeftY = INT((DisplayHeightWindowHeight)/2)
Open "Graphic" for graphics_nsb_nf as #main
#main "trapclose [quit]"
#main "down;fill white;flush"
' Draw the road
X =0
DX =0
DDX =0
HalfWidth =0
SegY =0
NextStretch$ = "Straight"
WidthStep = 1 'CONSTant ?
FOR A = 1 TO ResY  RoadLines
' LINE (0, A)(ResX  1, A), 9 ' line ([x1],[y1])  ([x2],[y2]), color number
#main "color BLUE"
#main "line 0 ";A1;" ";ResX1;" ";A1
NEXT A
TexOffset = 100
SegY = RoadLines
DX = 0
DDX = .02 ' This controls the steepness of the curve
FOR C = 1 TO 80
scan
' Set up the frame
X = ResX / 2
DX = 0
HalfWidth = 120
ScreenLine = ResY  1
FOR A = 1 TO RoadLines
IF (ZMap(A) + TexOffset) MOD 100 > 50 THEN
GrassColor = 10
RoadColor = 7
ELSE
GrassColor = 2
RoadColor = 8
END IF
' LINE (X  HalfWidth, ScreenLine)(X + HalfWidth, ScreenLine), RoadColor
' LINE (0, ScreenLine)(X  HalfWidth, ScreenLine), GrassColor
' LINE (X + HalfWidth, ScreenLine)(ResX  1, ScreenLine), GrassColor
#main "color ";QBColors$(RoadColor)
#main "line ";X  HalfWidth;" ";ScreenLine;" ";X + HalfWidth;" ";ScreenLine
#main "color ";QBColors$(GrassColor)
#main "line ";0 ;" ";ScreenLine;" ";X  HalfWidth;" ";ScreenLine
#main "color ";QBColors$(GrassColor)
#main "line ";X + HalfWidth ;" ";ScreenLine;" ";ResX1;" ";ScreenLine
HalfWidth = HalfWidth  WidthStep
ScreenLine = ScreenLine  1
select case NextStretch$
case "Straight"
IF A > SegY THEN
DX = DX + DDX
END IF
case "Curved"
IF A < SegY THEN
DX = DX + DDX
END IF
end select
X = X + DX
NEXT A
' Wrap positions (fractional):
TexOffset = TexOffset + ScrollSpeed
WHILE TexOffset >= 100
TexOffset = TexOffset  100
WEND
SegY = SegY  5 ' Decrease SegY by an arbitrary amount. Adjust to taste.
WHILE SegY < 0
SegY = SegY + RoadLines
select case NextStretch$
case "Curved"
NextStretch$ = "Straight"
case "Straight"
NextStretch$ = "Curved"
end select
WEND
NEXT C
[quit]
close #main : end
It is just a demo, an early one. It will work better using the lbgfx library.
What is a Pseudo 3D Game? Usually racing games from the classic videogames consoles, NES (Famicom), SEGA Genesis/Megadrive. Many also from Arcades. Some classics like F1Race from nintendo. F1 hero 2, also for the nintendo 8 bits. Outrun, Road Rash, Skitchin' for the Genesis.
I will list more later, because I'm a fan of Famicom, and because I spent my childhood playing Mario Bros.
I know Rod will like this !!


Logged

cundo



Rod
Global Moderator
member is offline
Graphics = goosebumps!
Gender:
Posts: 5543


Re: Pseudo 3D
« Reply #1 on: Oct 16^{th}, 2016, 2:12pm » 

Yes I will enjoy looking at this code. It has been a long term project of mine and it is not fit for public viewing but I have a nice road and some bikes winding about the country.
I will see if this code gives me any new ideas.


Logged




bluatigro
Guru
member is offline
cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]
Gender:
Posts: 918


Re: Pseudo 3D
« Reply #2 on: Oct 17^{th}, 2016, 06:23am » 

i tryed to make a left curve and a random road
fullscreen did not work right
it has errors jet Code:'*****************************************
'Road Demonstration Program by Louis Gorenfeld 2010
'*****************************************
' converted to LB by cundo 2016, find this code and discussion at : libertybasic.conforums.com
'*****************************************
'This program is intended to show concepts described at Lou's Pseudo 3d Page
'http://www.extentofthejam.com/pseudo/
'It defaults to generating 80 frames during which the road curves right,
'uncurves, and repeats.
'*****************************************
'not sure abou the colors
QBColors$(0)= "black"
QBColors$(1)= "darkblue"
QBColors$(2)= "darkgreen"
QBColors$(3)= "cyan"
QBColors$(4)= "red"
QBColors$(5)= "darkred"
QBColors$(6)= "brown"
QBColors$(7)= "lightgray"
QBColors$(8)= "darkgray"
QBColors$(9)= "blue"
QBColors$(10)= "green"
roadtype$ = "Straight Right Left"
road = 1
for i = 0 to 10
road$( i ) = word$( roadtype$ , range( 1 , 3 ) )
next i
RoadLines = WindowHeight / 2  1
ScrollSpeed = 10
RoadY = 1 'arbitrary
ResX = 640
ResY = 400
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 A
' 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 A
nomainwin
WindowWidth = ResX
WindowHeight = ResY
Open "Graphic" for graphics as #main
#main "trapclose [quit]"
#main "down"
#main "fill blue"
#main "flush"
' Draw the road
X = 0
DX = 0
DDX = 0
HalfWidth = ResX / 2
NextStretch$ = "Straight"
LastStretch$ = "Straight"
WidthStep = 1 'CONSTant ?
''FOR A = 1 TO ResY  RoadLines
' LINE (0, A)(ResX  1, A), 9 ' line ([x1],[y1])  ([x2],[y2]), color number
'' #main "color blue"
'' #main "line 0 ";A1;" ";ResX1;" ";A1
''NEXT A
TexOffset = 100
SegY = RoadLines
DX = 0
DDX = .02 ' This controls the steepness of the curve
while road < 10
scan
' Set up the frame
X = ResX / 2
DX = 0
ScreenLine = ResY  1
HalfWidth = ResX / 2
FOR A = 1 TO RoadLines
IF ( ZMap( A ) + TexOffset ) MOD 100 > 50 THEN
GrassColor = 10
RoadColor = 7
ELSE
GrassColor = 2
RoadColor = 8
END IF
' LINE (X  HalfWidth, ScreenLine)(X + HalfWidth, ScreenLine), RoadColor
' LINE (0, ScreenLine)(X  HalfWidth, ScreenLine), GrassColor
' LINE (X + HalfWidth, ScreenLine)(ResX  1, ScreenLine), GrassColor
#main "color " ; QBColors$( RoadColor )
#main "line " ; X  HalfWidth ; " " ; ScreenLine _
; " " ; X + HalfWidth ; " " ; ScreenLine
#main "color " ; QBColors$( GrassColor )
#main "line 0 " ; ScreenLine _
; " " ; X  HalfWidth ; " " ; ScreenLine
#main "color " ; QBColors$( GrassColor )
#main "line " ; X + HalfWidth ; " " ; ScreenLine _
; " " ; ResX  1 ; " " ; ScreenLine
HalfWidth = HalfWidth  WidthStep
ScreenLine = ScreenLine  1
select case NextStretch$
case "Straight"
if LastStretch$ = "Right" then
IF A > SegY THEN
DX = DX + DDX
END IF
end if
if LastStretch$ = "Left" then
if A > SegY then
DX = DX  DDX
end if
end if
case "Right"
select case LastStretch$
case "Straight"
IF A < SegY THEN
DX = DX + DDX
END IF
case "Right"
DX = DX + DDX
case "Left"
if A < SegY then
DX = DX  DDX
else
DX = DX + DDX
end if
end select
case "left"
select case LastStretch$
case "Straight"
IF A < SegY THEN
DX = DX  DDX
END IF
case "Left"
DX = DX  DDX
case "Right"
if A < SegY then
DX = DX + DDX
else
DX = DX  DDX
end if
end select
end select
X = X + DX
NEXT A
' Wrap positions (fractional):
TexOffset = TexOffset + ScrollSpeed
WHILE TexOffset >= 100
TexOffset = TexOffset  100
WEND
SegY = SegY  5 ' Decrease SegY by an arbitrary amount. Adjust to taste.
WHILE SegY < 0
SegY = SegY + RoadLines
LastStretch$ = NextStretch$
NextStretch$ = road$( road )
road = road + 1
WEND
wend
[quit]
close #main
end
function range( l , h )
range = int( rnd(0) * ( h  l ) + l + 0.9999 )
end function


Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty



bluatigro
Guru
member is offline
cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]
Gender:
Posts: 918


Re: Pseudo 3D
« Reply #3 on: Oct 17^{th}, 2016, 06:42am » 

update : fulscreen !!
its slow it needs lbgfx Code:'*****************************************
'Road Demonstration Program by Louis Gorenfeld 2010
'*****************************************
' converted to LB by cundo 2016, find this code and discussion at : libertybasic.conforums.com
'*****************************************
'This program is intended to show concepts described at Lou's Pseudo 3d Page
'http://www.extentofthejam.com/pseudo/
'It defaults to generating 80 frames during which the road curves right,
'uncurves, and repeats.
'*****************************************
'not sure abou the colors
QBColors$(0)= "black"
QBColors$(1)= "darkblue"
QBColors$(2)= "darkgreen"
QBColors$(3)= "cyan"
QBColors$(4)= "red"
QBColors$(5)= "darkred"
QBColors$(6)= "brown"
QBColors$(7)= "lightgray"
QBColors$(8)= "darkgray"
QBColors$(9)= "blue"
QBColors$(10)= "green"
roadtype$ = "Straight Right Left"
road = 1
for i = 0 to 10
road$( i ) = word$( roadtype$ , range( 1 , 3 ) )
next i
ScrollSpeed = 10
RoadY = 1 'arbitrary
ResX = DisplayWidth
ResY = DisplayHeight
RoadLines = ResY / 2  1
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 A
' 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 A
nomainwin
WindowWidth = ResX
WindowHeight = ResY
Open "Graphic" for graphics as #main
#main "trapclose [quit]"
#main "down"
#main "fill blue"
#main "flush"
' Draw the road
X = 0
DX = 0
DDX = 0
HalfWidth = ResX / 2
NextStretch$ = "Straight"
LastStretch$ = "Straight"
WidthStep = 1 'CONSTant ?
''FOR A = 1 TO ResY  RoadLines
' LINE (0, A)(ResX  1, A), 9 ' line ([x1],[y1])  ([x2],[y2]), color number
'' #main "color blue"
'' #main "line 0 ";A1;" ";ResX1;" ";A1
''NEXT A
TexOffset = 100
SegY = RoadLines
DX = 0
DDX = .02 ' This controls the steepness of the curve
while road < 10
scan
' Set up the frame
X = ResX / 2
DX = 0
ScreenLine = ResY  1
HalfWidth = ResX / 2
FOR A = 1 TO RoadLines
IF ( ZMap( A ) + TexOffset ) MOD 100 > 50 THEN
GrassColor = 10
RoadColor = 7
ELSE
GrassColor = 2
RoadColor = 8
END IF
' LINE (X  HalfWidth, ScreenLine)(X + HalfWidth, ScreenLine), RoadColor
' LINE (0, ScreenLine)(X  HalfWidth, ScreenLine), GrassColor
' LINE (X + HalfWidth, ScreenLine)(ResX  1, ScreenLine), GrassColor
#main "color " ; QBColors$( RoadColor )
#main "line " ; X  HalfWidth ; " " ; ScreenLine _
; " " ; X + HalfWidth ; " " ; ScreenLine
#main "color " ; QBColors$( GrassColor )
#main "line 0 " ; ScreenLine _
; " " ; X  HalfWidth ; " " ; ScreenLine
#main "color " ; QBColors$( GrassColor )
#main "line " ; X + HalfWidth ; " " ; ScreenLine _
; " " ; ResX  1 ; " " ; ScreenLine
HalfWidth = HalfWidth  WidthStep
ScreenLine = ScreenLine  1
select case NextStretch$
case "Straight"
if LastStretch$ = "Right" then
IF A > SegY THEN
DX = DX + DDX
END IF
end if
if LastStretch$ = "Left" then
if A > SegY then
DX = DX  DDX
end if
end if
case "Right"
select case LastStretch$
case "Straight"
IF A < SegY THEN
DX = DX + DDX
END IF
case "Right"
DX = DX + DDX
case "Left"
if A < SegY then
DX = DX  DDX
else
DX = DX + DDX
end if
end select
case "left"
select case LastStretch$
case "Straight"
IF A < SegY THEN
DX = DX  DDX
END IF
case "Left"
DX = DX  DDX
case "Right"
if A < SegY then
DX = DX + DDX
else
DX = DX  DDX
end if
end select
end select
X = X + DX
NEXT A
' Wrap positions (fractional):
TexOffset = TexOffset + ScrollSpeed
WHILE TexOffset >= 100
TexOffset = TexOffset  100
WEND
SegY = SegY  5 ' Decrease SegY by an arbitrary amount. Adjust to taste.
WHILE SegY < 0
SegY = SegY + RoadLines
LastStretch$ = NextStretch$
NextStretch$ = road$( road )
road = road + 1
WEND
wend
[quit]
close #main
end
function range( l , h )
range = int( rnd(0) * ( h  l ) + l + 0.9999 )
end function


Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty



tsh73
Board Moderator
member is offline
Anatoly (real name)
Gender:
Posts: 1684


Re: Pseudo 3D
« Reply #4 on: Oct 18^{th}, 2016, 08:53am » 

wow such a cool article. *just messed up light and dark lines... Will try again *


Logged

damned Dog in the Manger



cundo
Guru
member is offline
Gender:
Posts: 626


Re: Pseudo 3D
« Reply #5 on: Oct 18^{th}, 2016, 11:31am » 

We don't even need 1 pixel lines, in older consoles that was made directly on the screen, I think it is called raster. This is a two pixel line, so it is halved but no noticeable: Code:'*****************************************
'Road Demonstration Program by Louis Gorenfeld 2010
'*****************************************
' converted to LB by cundo 2016, find this code and discussion at : libertybasic.conforums.com
'*****************************************
'This program is intended to show concepts described at Lou's Pseudo 3d Page
'http://www.extentofthejam.com/pseudo/
'It defaults to generating 80 frames during which the road curves right,
'uncurves, and repeats.
'*****************************************
'not sure abou the colors
QBColors$(0)= "black"
QBColors$(1)= "darkblue"
QBColors$(2)= "darkgreen"
QBColors$(3)= "cyan"
QBColors$(4)= "red"
QBColors$(5)= "darkred"
QBColors$(6)= "brown"
QBColors$(7)= "lightgray"
QBColors$(8)= "darkgray"
QBColors$(9)= "blue"
QBColors$(10)= "green"
roadtype$ = "Straight Right Left"
road = 1
for i = 0 to 10
road$( i ) = word$( roadtype$ , range( 1 , 3 ) )
next i
ScrollSpeed = 10
RoadY = 1 'arbitrary
ResX = DisplayWidth
ResY = DisplayHeight
RoadLines = ResY/2  1
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 A
' 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 * 200 'in percents because QBasic's MOD is lame
FOR A = 1 TO RoadLines
ZMap( A ) = ZMap( A ) * b
NEXT A
nomainwin
WindowWidth = ResX
WindowHeight = ResY
Open "Graphic" for graphics as #main
#main "trapclose [quit]"
#main "down"
#main "fill blue;size 2"
#main "flush"
' Draw the road
X = 0
DX = 0
DDX = 0
HalfWidth = ResX / 2
NextStretch$ = "Straight"
LastStretch$ = "Straight"
WidthStep = 2
''FOR A = 1 TO ResY  RoadLines
' LINE (0, A)(ResX  1, A), 9 ' line ([x1],[y1])  ([x2],[y2]), color number
'' #main "color blue"
'' #main "line 0 ";A1;" ";ResX1;" ";A1
''NEXT A
TexOffset = 100
SegY = RoadLines
DX = 0
DDX = .02 ' This controls the steepness of the curve
while road < 10
scan
' Set up the frame
X = ResX / 2
DX = 0
ScreenLine = ResY  1
HalfWidth = ResX / 2
FOR A = 1 TO INT(RoadLines/2)
IF ( ZMap( A ) + TexOffset ) MOD 50 > 25 THEN
GrassColor = 10
RoadColor = 7
ELSE
GrassColor = 2
RoadColor = 8
END IF
' LINE (X  HalfWidth, ScreenLine)(X + HalfWidth, ScreenLine), RoadColor
' LINE (0, ScreenLine)(X  HalfWidth, ScreenLine), GrassColor
' LINE (X + HalfWidth, ScreenLine)(ResX  1, ScreenLine), GrassColor
#main "color " ; QBColors$( RoadColor )
#main "line " ; X  HalfWidth ; " " ; ScreenLine _
; " " ; X + HalfWidth ; " " ; ScreenLine
#main "color " ; QBColors$( GrassColor )
#main "line 0 " ; ScreenLine _
; " " ; X  HalfWidth ; " " ; ScreenLine
#main "color " ; QBColors$( GrassColor )
#main "line " ; X + HalfWidth ; " " ; ScreenLine _
; " " ; ResX  1 ; " " ; ScreenLine
HalfWidth = HalfWidth  WidthStep
ScreenLine = ScreenLine  2
select case NextStretch$
case "Straight"
if LastStretch$ = "Right" then
IF A > SegY THEN
DX = DX + DDX
END IF
end if
if LastStretch$ = "Left" then
if A > SegY then
DX = DX  DDX
end if
end if
case "Right"
select case LastStretch$
case "Straight"
IF A < SegY THEN
DX = DX + DDX
END IF
case "Right"
DX = DX + DDX
case "Left"
if A < SegY then
DX = DX  DDX
else
DX = DX + DDX
end if
end select
case "left"
select case LastStretch$
case "Straight"
IF A < SegY THEN
DX = DX  DDX
END IF
case "Left"
DX = DX  DDX
case "Right"
if A < SegY then
DX = DX + DDX
else
DX = DX  DDX
end if
end select
end select
X = X + DX
NEXT A
' Wrap positions (fractional):
TexOffset = TexOffset + ScrollSpeed
WHILE TexOffset >= 100
TexOffset = TexOffset  100
WEND
SegY = SegY  5 ' Decrease SegY by an arbitrary amount. Adjust to taste.
WHILE SegY < 0
SegY = SegY + RoadLines
LastStretch$ = NextStretch$
NextStretch$ = road$( road )
road = road + 1
WEND
wend
[quit]
close #main
end
function range( l , h )
range = int( rnd(0) * ( h  l ) + l + 0.9999 )
end function


Logged

cundo



cundo
Guru
member is offline
Gender:
Posts: 626


Re: Pseudo 3D
« Reply #6 on: Oct 18^{th}, 2016, 11:56am » 

Going left or right. Code:'*****************************************
'Road Demonstration Program by Louis Gorenfeld 2010
'*****************************************
' converted to LB by cundo 2016, find this code and discussion at : libertybasic.conforums.com
'*****************************************
'This program is intended to show concepts described at Lou's Pseudo 3d Page
'http://www.extentofthejam.com/pseudo/
'It defaults to generating 80 frames during which the road curves right,
'uncurves, and repeats.
'*****************************************
'not sure about the colors
dim QBColors$(20)
QBColors$(0)= "black"
QBColors$(1)= "darkblue"
QBColors$(2)= "darkgreen"
QBColors$(3)= "cyan"
QBColors$(4)= "red"
QBColors$(5)= "darkred"
QBColors$(6)= "brown"
QBColors$(7)= "lightgray"
QBColors$(8)= "darkgray"
QBColors$(9)= "blue"
QBColors$(10)= "green"
QBColors$(11)= "white"
RoadLines = 85
ScrollSpeed = 15
RoadY = 1 'arbitrary
ResZ = 320
ResY = 200
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 A
' 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 A
nomainwin
WindowWidth = 320 : WindowHeight = 240
UpperLeftZ = INT((DisplayWidthWindowWidth)/2)
UpperLeftY = INT((DisplayHeightWindowHeight)/2)
Open "Graphic" for graphics_nsb_nf as #main
#main "trapclose [quit]"
#main "down;fill white;flush"
' Draw the road
Z =0
DZ =0
DDZ =0
HalfWidth =0
SegY =0
NextStretch$ = "Straight"
WidthStep = .7
#main "fill cyan"
' no need for lines for just the background
'FOR A = 1 TO ResY  RoadLines
' ' LINE (0, A)(ResZ  1, A), 9 ' line ([x1],[y1])  ([x2],[y2]), color number
' #main "color BLUE"
' #main "line 0 ";A1;" ";ResZ1;" ";A1
'NEZT A
TexOffset = 100
SegY = RoadLines
DZ = 0
DDZ = .025 ' This controls the steepness of the curve
FOR C = 1 TO 100
scan
' Set up the frame
Z = ResZ / 2
DZ = 0
HalfWidth = 120
ScreenLine = ResY  1
FOR A = 1 TO RoadLines
IF (ZMap(A) + TexOffset) MOD 100 > 50 THEN
GrassColor = 10
RoadColor = 7
stripeColor = 11
ELSE
GrassColor = 2
RoadColor = 8
stripeColor = 7
END IF
' LINE (Z  HalfWidth, ScreenLine)(Z + HalfWidth, ScreenLine), RoadColor
' LINE (0, ScreenLine)(Z  HalfWidth, ScreenLine), GrassColor
' LINE (Z + HalfWidth, ScreenLine)(ResZ  1, ScreenLine), GrassColor
#main "color ";QBColors$(RoadColor)
#main "line ";Z  HalfWidth;" ";ScreenLine;" ";Z + HalfWidth;" ";ScreenLine
#main "color ";QBColors$(GrassColor)
#main "line ";0 ;" ";ScreenLine;" ";Z  HalfWidth;" ";ScreenLine
#main "line ";Z + HalfWidth ;" ";ScreenLine;" ";ResZ1;" ";ScreenLine
#main "color ";QBColors$(stripeColor)
#main "line ";Z  2;" ";ScreenLine;" ";Z +2;" ";ScreenLine
HalfWidth = HalfWidth  WidthStep
ScreenLine = ScreenLine  1
select case NextStretch$
case "Straight"
IF A > SegY THEN
DZ = DZ + DDZ
END IF
case "Curved"
IF A < SegY THEN
DZ = DZ + DDZ
END IF
end select
if LeftOrRight = 0 then
Z = Z + DZ
else
Z = Z  DZ
end if
NEXT A
' Wrap positions (fractional):
TexOffset = TexOffset + ScrollSpeed
WHILE TexOffset >= 100
TexOffset = TexOffset  100
WEND
SegY = SegY  ScrollSpeed/5 ' Decrease SegY by an arbitrary amount. Adjust to taste.
WHILE SegY < 0
SegY = SegY + RoadLines
select case NextStretch$
case "Curved"
NextStretch$ = "Straight"
LeftOrRight= abs(not(LefOrRight))+1
case "Straight"
NextStretch$ = "Curved"
end select
WEND
NEXT C
[quit]
close #main : end
The QBASIC code is just an idea, and the author moved from this to something more precise I believe. But it is a nice reading, the article brings back memories. We can even try using sprites instead of lines


Logged

cundo



cundo
Guru
member is offline
Gender:
Posts: 626


Re: Pseudo 3D
« Reply #7 on: Oct 18^{th}, 2016, 4:27pm » 

Another one Code:'*****************************************
'Road Demonstration Program by Louis Gorenfeld 2010
'*****************************************
' converted to LB by cundo 2016, find this code and discussion at : libertybasic.conforums.com
'*****************************************
'This program is intended to show concepts described at Lou's Pseudo 3d Page
'http://www.extentofthejam.com/pseudo/
'It defaults to generating 80 frames during which the road curves right,
'uncurves, and repeats.
'*****************************************
'not sure about the colors, but I like them this way
dim QBColors$(20)
QBColors$(0)= "black"
QBColors$(1)= "darkblue"
QBColors$(2)= "100 200 100"
QBColors$(3)= "cyan"
QBColors$(4)= "red"
QBColors$(5)= "darkred"
QBColors$(6)= "brown"
QBColors$(7)= "lightgray"
QBColors$(8)= "darkgray"
QBColors$(9)= "blue"
QBColors$(10)= "150 230 170"
QBColors$(11)= "white"
RoadLines = 30
ScrollSpeed = 5
RoadY = 1 'arbitrary
ResZ = 640
ResY = 480
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 A
' 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 * 1000 'in percents because QBasic's MOD is lame
FOR A = 1 TO RoadLines
ZMap(A) = ZMap(A) * b
NEXT A
nomainwin
WindowWidth = ResZ : WindowHeight = ResY+40
UpperLeftZ = INT((DisplayWidthWindowWidth)/2)
UpperLeftY = INT((DisplayHeightWindowHeight)/2)
Open "Graphic" for graphics_nsb_nf as #main
#main "trapclose [quit]"
#main "down;fill cyan;flush;size 4"
' Draw the road
Z =0
DZ =0
DDZ =0
HalfWidth =0
SegY =0
NextStretch$ = "Straight"
WidthStep = 4
' no need for lines for just the background
'FOR A = 1 TO ResY  RoadLines
' ' LINE (0, A)(ResZ  1, A), 9 ' line ([x1],[y1])  ([x2],[y2]), color number
' #main "color BLUE"
' #main "line 0 ";A1;" ";ResZ1;" ";A1
'NEZT A
TexOffset = 100
SegY = RoadLines
DZ = 0
DDZ = .25 ' This controls the steepness of the curve
FOR C = 1 TO 500
scan
' Set up the frame
Z = ResZ / 2
DZ = 0
HalfWidth = ResZ/4 + 1
ScreenLine = ResY  1
FOR A = 1 TO RoadLines
IF (ZMap(A) + TexOffset) MOD 50 > 25 THEN
GrassColor = 10
RoadColor = 7
stripeColor = 11
ELSE
GrassColor = 2
RoadColor = 8
stripeColor = 7
END IF
' LINE (Z  HalfWidth, ScreenLine)(Z + HalfWidth, ScreenLine), RoadColor
' LINE (0, ScreenLine)(Z  HalfWidth, ScreenLine), GrassColor
' LINE (Z + HalfWidth, ScreenLine)(ResZ  1, ScreenLine), GrassColor
#main "color ";QBColors$(RoadColor)
#main "line ";Z  HalfWidth;" ";ScreenLine;" ";Z + HalfWidth;" ";ScreenLine
#main "color ";QBColors$(GrassColor)
#main "line ";0 ;" ";ScreenLine;" ";Z  HalfWidth;" ";ScreenLine
#main "line ";Z + HalfWidth ;" ";ScreenLine;" ";ResZ1;" ";ScreenLine
#main "color ";QBColors$(stripeColor)
#main "line ";Z  HalfWidth 1;" ";ScreenLine;" ";Z  HalfWidth +1;" ";ScreenLine
#main "line ";Z + HalfWidth 1;" ";ScreenLine;" ";Z + HalfWidth +1;" ";ScreenLine
HalfWidth = HalfWidth  WidthStep
ScreenLine = ScreenLine  4
select case NextStretch$
case "Straight"
IF A > SegY THEN
DZ = DZ + DDZ
END IF
case "Curved"
IF A < SegY THEN
DZ = DZ + DDZ
END IF
end select
if LeftOrRight = 0 then
Z = Z + DZ
else
Z = Z  DZ
end if
NEXT A
' Wrap positions (fractional):
TexOffset = TexOffset + ScrollSpeed
WHILE TexOffset >= 100
TexOffset = TexOffset  100
WEND
SegY = SegY  ScrollSpeed/20 ' Decrease SegY by an arbitrary amount. Adjust to taste.
WHILE SegY < 0
SegY = SegY + RoadLines
select case NextStretch$
case "Curved"
NextStretch$ = "Straight"
LeftOrRight= not(LeftOrRight)
case "Straight"
NextStretch$ = "Curved"
end select
WEND
NEXT C
[quit]
close #main : end


Logged

cundo



bluatigro
Guru
member is offline
cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]
Gender:
Posts: 918


Re: Pseudo 3D
« Reply #8 on: Oct 19^{th}, 2016, 04:35am » 

@ cundo : size 2 lines are indeed faster
update : i made a fixed data road and a diagnose print to see WHERE it goes wrong
error : the road "jumps" somtimes
i want strait roads in it to
thinking aboud hils [ no ideas jet ]
Code:'*****************************************
'Road Demonstration Program by Louis Gorenfeld 2010
'*****************************************
' converted to LB by cundo 2016, find this code and discussion at : libertybasic.conforums.com
'*****************************************
'This program is intended to show concepts described at Lou's Pseudo 3d Page
'http://www.extentofthejam.com/pseudo/
'It defaults to generating 80 frames during which the road curves right,
'uncurves, and repeats.
'*****************************************
global pi
pi = atn( 1 ) * 4
'not sure abou the colors
QBColors$(0)= "black"
QBColors$(1)= "darkblue"
QBColors$(2)= "darkgreen"
QBColors$(3)= "cyan"
QBColors$(4)= "red"
QBColors$(5)= "darkred"
QBColors$(6)= "brown"
QBColors$(7)= "lightgray"
QBColors$(8)= "darkgray"
QBColors$(9)= "blue"
QBColors$(10)= "green"
roadtype$ = "Straight Right Left"
road = 1
for i = 0 to 10
read r
road$( i ) = word$( roadtype$ , r )
next i
''i think i got al combinations
data 1,1,2,2,3,3,1,3,2,1,3
ScrollSpeed = 10
RoadY = 1 'arbitrary
ResX = DisplayWidth
ResY = DisplayHeight
RoadLines = ResY / 2  1
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 A
' 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 A
nomainwin
WindowWidth = ResX
WindowHeight = ResY
Open "Graphic" for graphics as #main
#main "trapclose [quit]"
#main "down"
#main "fill blue"
#main "flush"
' Draw the road
X = 0
DX = 0
DDX = 0
HalfWidth = ResX / 2
NextStretch$ = "Straight"
LastStretch$ = "Straight"
WidthStep = 2 'CONSTant ?
''FOR A = 1 TO ResY  RoadLines
' LINE (0, A)(ResX  1, A), 9 ' line ([x1],[y1])  ([x2],[y2]), color number
'' #main "color blue"
'' #main "line 0 ";A1;" ";ResX1;" ";A1
''NEXT A
TexOffset = 100
SegY = RoadLines
DX = 0
DDX = .02 ' This controls the steepness of the curve
#main "size 2"
while road < 10
scan
' Set up the frame
X = ResX / 2
DX = 0
ScreenLine = ResY  1
HalfWidth = ResX / 2
''this stuf is there to show when it goes wrong
#main "color yellow"
#main "backcolor blue"
#main "goto 0 50"
#main "\last = " ; LastStretch$ + " "
#main "goto 0 100"
#main "\next = " ; NextStretch$ + " "
FOR A = 1 TO RoadLines step 2
IF ( ZMap( A ) + TexOffset ) MOD 100 > 50 THEN
GrassColor = 10
RoadColor = 7
ELSE
GrassColor = 2
RoadColor = 8
END IF
' LINE (X  HalfWidth, ScreenLine)(X + HalfWidth, ScreenLine), RoadColor
' LINE (0, ScreenLine)(X  HalfWidth, ScreenLine), GrassColor
' LINE (X + HalfWidth, ScreenLine)(ResX  1, ScreenLine), GrassColor
#main "down"'
#main "color " ; QBColors$( RoadColor )
#main "line " ; X  HalfWidth ; " " ; ScreenLine _
; " " ; X + HalfWidth ; " " ; ScreenLine
#main "color " ; QBColors$( GrassColor )
#main "line 0 " ; ScreenLine _
; " " ; X  HalfWidth ; " " ; ScreenLine
#main "color " ; QBColors$( GrassColor )
#main "line " ; X + HalfWidth ; " " ; ScreenLine _
; " " ; ResX  1 ; " " ; ScreenLine
#main "up"
HalfWidth = HalfWidth  WidthStep
ScreenLine = ScreenLine  2
''parts of this are wrong
select case NextStretch$
case "Straight"
if LastStretch$ = "Right" then
IF A > SegY THEN
DX = DX + DDX
END IF
end if
if LastStretch$ = "Left" then
if A > SegY then
DX = DX  DDX
end if
end if
case "Right"
select case LastStretch$
case "Straight"
IF A < SegY THEN
DX = DX + DDX
END IF
case "Right"
DX = DX + DDX
case "Left"
if A < SegY then
DX = DX  DDX
else
DX = DX + DDX
end if
end select
case "left"
select case LastStretch$
case "Straight"
IF A < SegY THEN
DX = DX  DDX
END IF
case "Left"
DX = DX  DDX
case "Right"
if A < SegY then
DX = DX + DDX
else
DX = DX  DDX
end if
end select
end select
X = X + DX
NEXT A
' Wrap positions (fractional):
TexOffset = TexOffset + ScrollSpeed
WHILE TexOffset >= 100
TexOffset = TexOffset  100
WEND
SegY = SegY  5 ' Decrease SegY by an arbitrary amount. Adjust to taste.
WHILE SegY < 0
SegY = SegY + RoadLines
LastStretch$ = NextStretch$
NextStretch$ = road$( road )
road = road + 1
WEND
''motercycle
#main "size 20"
qx = 0
qy = 100
select case LastStretch$
case "Left"
call rotate qx , qy , 40
case "Right"
call rotate qx , qy , 40
case else
end select
#main "down"
#main "color red"
#main "line ";ResX/2;" ";ResY50;" ";ResX/2+qx;" ";ResYqy50
#main "up"
wend
[quit]
close #main
end
function range( l , h )
range = int( rnd(0) * ( h  l ) + l + 0.9999 )
end function
sub rotate byref k , byref l , deg
s = sin( deg * pi / 180 )
c = cos( deg * pi / 180 )
hk = k * c  l * s
hl = k * s + l * c
k = hk
l = hl
end sub


Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty



cundo
Guru
member is offline
Gender:
Posts: 626


Re: Pseudo 3D
« Reply #9 on: Oct 20^{th}, 2016, 10:21am » 

Using boxfilled instead of line.
Code:'*****************************************
'Road Demonstration Program by Louis Gorenfeld 2010
'*****************************************
' converted to LB by cundo 2016, find this code and discussion at : libertybasic.conforums.com
'*****************************************
'This program is intended to show concepts described at Lou's Pseudo 3d Page
'http://www.extentofthejam.com/pseudo/
'It defaults to generating 80 frames during which the road curves right,
'uncurves, and repeats.
'*****************************************
'not sure about the colors, but I like them this way
dim QBColors$(20)
QBColors$(0)= "black"
QBColors$(1)= "darkblue"
QBColors$(2)= "100 200 100"
QBColors$(3)= "cyan"
QBColors$(4)= "red"
QBColors$(5)= "darkred"
QBColors$(6)= "brown"
QBColors$(7)= "190 190 190"
QBColors$(8)= "150 150 150"
QBColors$(9)= "blue"
QBColors$(10)= "150 230 170"
QBColors$(11)= "white"
RoadLines = 30
ScrollSpeed = 10
RoadY = 1 'arbitrary
ResZ = 640
ResY = 500
PlrLine = 8 'What line is the player sprite on?
DIM ZMap(RoadLines)
' Initialize ZMap
FOR A = 1 TO RoadLines
ZMap(A) = RoadY / (A  (ResY/10))
NEXT A
' Normalize ZMap so the line with the player on it is scale=1 (or would be
' If we had a player sprite :))
b = 4 / ZMap(PlrLine)
b = b * 100 'in percents because QBasic's MOD is lame
FOR A = 1 TO RoadLines
ZMap(A) = ZMap(A) * b
NEXT A
nomainwin
WindowWidth = ResZ : WindowHeight = ResY+44
UpperLeftX = INT((DisplayWidthWindowWidth)/2)
UpperLeftY = INT((DisplayHeightWindowHeight)/2)
Open "Graphic" for graphics_nsb_nf as #main
#main "trapclose [quit]"
#main "down;fill cyan;flush;size 1"
' Draw the road
Z =0
DZ =0
DDZ =0
HalfWidth =0
SegY =0
NextStretch$ = "Straight"
WidthStep = 4
' no need for lines for just the background
'FOR A = 1 TO ResY  RoadLines
' ' LINE (0, A)(ResZ  1, A), 9 ' line ([x1],[y1])  ([x2],[y2]), color number
' #main "color BLUE"
' #main "line 0 ";A1;" ";ResZ1;" ";A1
'NEZT A
TexOffset = 100
SegY = RoadLines
DZ = 0
DDZ = .25 ' This controls the steepness of the curve
FOR C = 1 TO 500
scan
' Set up the frame
Z = ResZ / 2
DZ = 0
HalfWidth = ResZ/5
ScreenLine = ResY  1
FOR A = 1 TO RoadLines
IF (ZMap(A) + TexOffset) MOD 100 > 50 THEN
GrassColor = 10
RoadColor = 7
stripeColor = 4
ELSE
GrassColor = 2
RoadColor = 8
stripeColor = 11
END IF
' LINE (Z  HalfWidth, ScreenLine)(Z + HalfWidth, ScreenLine), RoadColor
' LINE (0, ScreenLine)(Z  HalfWidth, ScreenLine), GrassColor
' LINE (Z + HalfWidth, ScreenLine)(ResZ  1, ScreenLine), GrassColor
pixhigh = 3
#main "color "; QBColors$(RoadColor)
#main "backcolor "; QBColors$(RoadColor)
'#main "backcolor "; QBColors$(RoadColor)
' #main "line ";Z  HalfWidth;" ";ScreenLine;" ";Z + HalfWidth;" ";ScreenLine
call RECT Z  HalfWidth ,ScreenLine,Z + HalfWidth (Z  HalfWidth), pixhigh
#main "color ";QBColors$(GrassColor)
#main "backcolor "; QBColors$(GrassColor)
' #main "backcolor "; QBColors$(RoadColor)
'#main "line ";0 ;" ";ScreenLine;" ";Z  HalfWidth;" ";ScreenLine
call RECT 0 , ScreenLine, Z  HalfWidth, pixhigh
'#main "line ";Z + HalfWidth ;" ";ScreenLine;" ";ResZ1;" ";ScreenLine
#main "color ";QBColors$(GrassColor)
#main "backcolor "; QBColors$(GrassColor)
'#main "backcolor "; QBColors$(RoadColor)
call RECT Z + HalfWidth, ScreenLine, ResZ(Z + HalfWidth), pixhigh
#main "color ";QBColors$(stripeColor)
#main "backcolor "; QBColors$(stripeColor)
' #main "backcolor "; QBColors$(RoadColor)
' #main "line ";Z  HalfWidth 1;" ";ScreenLine;" ";Z  HalfWidth +1;" ";ScreenLine
' #main "line ";Z + HalfWidth 1;" ";ScreenLine;" ";Z + HalfWidth +1;" ";ScreenLine
call RECT Z  HalfWidth 3, ScreenLine, 3 , pixhigh
call RECT Z + HalfWidth 3, ScreenLine, 3 , pixhigh
HalfWidth = HalfWidth  WidthStep
ScreenLine = ScreenLine pixhigh '  changeView
select case NextStretch$
case "Straight"
IF A > SegY THEN
DZ = DZ + DDZ
END IF
case "Curved"
IF A < SegY THEN
DZ = DZ + DDZ
END IF
end select
if LeftOrRight = 0 then
Z = Z + DZ
else
Z = Z  DZ
end if
NEXT A
' Wrap positions (fractional):
TexOffset = TexOffset + ScrollSpeed
WHILE TexOffset >= 100
TexOffset = TexOffset  100
WEND
SegY = SegY  ScrollSpeed/20 ' Decrease SegY by an arbitrary amount. Adjust to taste.
WHILE SegY < 0
SegY = SegY + RoadLines
select case NextStretch$
case "Curved"
NextStretch$ = "Straight"
LeftOrRight= not(LeftOrRight)
case "Straight"
NextStretch$ = "Curved"
end select
WEND
changeView=changeView + .01
if changeView>3 then changeView=3
NEXT C
[quit]
close #main : end
SUB RECT x1,y1,x2,y2
#main "place ";x1;" ";y1
#main "BOXFILLED "; x1 + x2 ;" ";y1 + y2
END SUB

« Last Edit: Oct 22^{nd}, 2016, 3:56pm by cundo » 
Logged

cundo



cundo
Guru
member is offline
Gender:
Posts: 626


Re: Pseudo 3D
« Reply #10 on: Oct 22^{nd}, 2016, 3:44pm » 

Again 80 lines but each pass will show only 40. So it is 40+40, interlaced. Code:'*****************************************
'Road Demonstration Program by Louis Gorenfeld 2010
'This program is intended to show concepts described at Lou's Pseudo 3d Page
'http://www.extentofthejam.com/pseudo/
'It defaults to generating 80 frames during which the road curves right,
'uncurves, and repeats.
'*****************************************
' LB version by cundo 2016, find this code, updates and discussion at : libertybasic.conforums.com
' Find also bluatigro's modifications there.
' Tested on 1280x960
'not sure about the colors, but I like them this way
dim QBColors$(20)
QBColors$(0)= "black"
QBColors$(1)= "darkblue"
QBColors$(2)= "green"
QBColors$(3)= "cyan"
QBColors$(4)= "red"
QBColors$(5)= "darkred"
QBColors$(6)= "brown"
QBColors$(7)= "180 180 180"
QBColors$(8)= "150 150 150"
QBColors$(9)= "blue"
QBColors$(10)= "darkgreen"
QBColors$(11)= "white"
QBColors$(12)= "yellow"
RoadLines = 80
ScrollSpeed = 10
RoadY = 1 'arbitrary
ResZ = DisplayWidth
ResY = DisplayHeight126
PlrLine = 8 'What line is the player sprite on?
DIM ZMap(RoadLines)
' Initialize ZMap
FOR A = 1 TO RoadLines
ZMap(A) = RoadY / (A  (ResY/9))
NEXT A
' 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 A
nomainwin
WindowWidth = DisplayWidth : WindowHeight = DisplayHeight
UpperLeftX = INT((DisplayWidthWindowWidth)/2)
UpperLeftY = INT((DisplayHeightWindowHeight)/2)
graphicbox #main.gb ,0,0,ResZ,ResY
Open "Road" for window_nf as #main
#main "trapclose [quit]"
#main.gb "down; size 1; fill black;color yellow; backcolor black"
#main.gb "Font COURIER_NEW 32 50 BOLD"
#main.gb ""
#main.gb " LBRACE"
#main.gb " INSERT COIN "
#main.gb ""
#main.gb " TOP SCORES"
' Draw the road
Z =0
DZ =0
DDZ =0
HalfWidth =0
SegY =0
NextStretch$ = "Straight"
WidthStep = 5
' no need for lines for just the background
FOR A = 1 TO ResY/1.25 + 1 step 3
' LINE (0, A)(ResZ  1, A), 9 ' line ([x1],[y1])  ([x2],[y2]), color number
r = 80 + int(A/5)
g = 110 + int(A/20)
b = 210  int(A/10)
#main.gb "color ";r ;" ";g ;" ";b
#main.gb "line 0 ";A1;" ";ResZ1;" ";A1
NEXT A
#main.gb " flush ;size 2"
TexOffset = 100
SegY = RoadLines
DZ = 0
DDZ = .1 ' This controls the steepness of the curve
FOR C = 1 TO 400
scan
' Set up the frame
Z = ResZ/2
DZ = 0
HalfWidth = ResZ/2.7
ScreenLine = ResY  1
pixhigh =2
GrassColor=2
RoadColor = 8
' between lines interpolation for faster drawing ... well don't know how to call this
' draw the even and odd in two different passes...
between = not(between)
FOR A = 1 TO RoadLines
if between then
if A mod 2 = 0 then [jmp]
else
if A mod 2 <> 0 then [jmp]
end if
IF (ZMap(A) + TexOffset) MOD 100 > 50 THEN
GrassColor = 10
RoadColor = 7
else
GrassColor = 2
RoadColor = 8
END IF
stripeColor = 11
IF (ZMap(A) + TexOffset) MOD 50 >= 25 THEN stripeColor = 4
' LINE (Z  HalfWidth, ScreenLine)(Z + HalfWidth, ScreenLine), RoadColor
' LINE (0, ScreenLine)(Z  HalfWidth, ScreenLine), GrassColor
' LINE (Z + HalfWidth, ScreenLine)(ResZ  1, ScreenLine), GrassColor
' ROAD
#main.gb "color "; QBColors$(RoadColor)
#main.gb "backcolor "; QBColors$(RoadColor)
'#main "backcolor "; QBColors$(RoadColor)
' #main "line ";Z  HalfWidth;" ";ScreenLine;" ";Z + HalfWidth;" ";ScreenLine
call RECT Z  HalfWidth , ScreenLine, HalfWidth*2, pixhigh
' GRASS
#main.gb "color ";QBColors$(GrassColor)
#main.gb "backcolor "; QBColors$(GrassColor)
' #main "backcolor "; QBColors$(RoadColor)
'#main "line ";0 ;" ";ScreenLine;" ";Z  HalfWidth;" ";ScreenLine
call RECT 0 , ScreenLine, Z  HalfWidth1, pixhigh
'#main "line ";Z + HalfWidth ;" ";ScreenLine;" ";ResZ1;" ";ScreenLine
'#main "backcolor "; QBColors$(RoadColor)
call RECT Z + HalfWidth+1, ScreenLine, ResZ(Z + HalfWidth), pixhigh
' THE THINGS LIKE STRIPES
#main.gb "color ";QBColors$(stripeColor)
#main.gb "backcolor ";QBColors$(stripeColor)
' #main "backcolor "; QBColors$(RoadColor)
' #main "line ";Z  HalfWidth 1;" ";ScreenLine;" ";Z  HalfWidth +1;" ";ScreenLine
' #main "line ";Z + HalfWidth 1;" ";ScreenLine;" ";Z + HalfWidth +1;" ";ScreenLine
call RECT Z  HalfWidth 3, ScreenLine, int(HalfWidth/10) , pixhigh
call RECT Z + HalfWidth 3, ScreenLine, int(HalfWidth/10) , pixhigh
' CAR
' #main.gb "color BLACK"
' #main.gb "backcolor RED"
' call RECT ResZ/240,ResY80, 80, pixhigh*4
' call RECT ResZ/250,ResY(80pixhigh*4), 100, pixhigh*10
[jmp]
select case NextStretch$
case "Straight"
IF A > SegY THEN DZ = DZ + DDZ
case "Curved"
IF A < SegY THEN DZ = DZ + DDZ
end select
if LeftOrRight = 0 then
Z = Z + DZ
else
Z = Z  DZ
end if
HalfWidth = HalfWidth  WidthStep
ScreenLine = ScreenLine  pixhigh*1.25
NEXT A
' Wrap positions (fractional):
TexOffset = TexOffset + ScrollSpeed
WHILE TexOffset >= 100
TexOffset = TexOffset  100
WEND
SegY = SegY  ScrollSpeed/10 ' Decrease SegY by an arbitrary amount. Adjust to taste.
WHILE SegY < 0
SegY = SegY + RoadLines
select case NextStretch$
case "Curved"
NextStretch$ = "Straight"
LeftOrRight= not(LeftOrRight)
case "Straight"
NextStretch$ = "Curved"
end select
WEND
NEXT C
[quit]
close #main : end
SUB RECT x1,y1,x2,y2
#main.gb "place ";x1;" ";y1
#main.gb "BOXFILLED "; x1 + x2 ;" ";y1 + y2
END SUB

« Last Edit: Oct 22^{nd}, 2016, 4:04pm by cundo » 
Logged

cundo



cundo
Guru
member is offline
Gender:
Posts: 626


Re: Pseudo 3D
« Reply #11 on: Oct 22^{nd}, 2016, 4:12pm » 

800x600 Code:'*****************************************
'Road Demonstration Program by Louis Gorenfeld 2010
'This program is intended to show concepts described at Lou's Pseudo 3d Page
'http://www.extentofthejam.com/pseudo/
'It defaults to generating 80 frames during which the road curves right,
'uncurves, and repeats.
'*****************************************
' LB version by cundo 2016, find this code, updates and discussion at : libertybasic.conforums.com
' Find also bluatigro's modifications there.
' Tested on 1280x960
'not sure about the colors, but I like them this way
dim QBColors$(20)
QBColors$(0)= "black"
QBColors$(1)= "darkblue"
QBColors$(2)= "green"
QBColors$(3)= "cyan"
QBColors$(4)= "red"
QBColors$(5)= "darkred"
QBColors$(6)= "brown"
QBColors$(7)= "170 170 170"
QBColors$(8)= "120 120 120"
QBColors$(9)= "blue"
QBColors$(10)= "darkgreen"
QBColors$(11)= "white"
QBColors$(12)= "yellow"
RoadLines = 80
ScrollSpeed = 10
RoadY = 1 'arbitrary
ResZ = 800
ResY = 600100
PlrLine = 8 'What line is the player sprite on?
DIM ZMap(RoadLines)
' Initialize ZMap
FOR A = 1 TO RoadLines
ZMap(A) = RoadY / (A  (ResY/5))
NEXT A
' 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 A
nomainwin
WindowWidth = 800 : WindowHeight = 600
UpperLeftX = INT((DisplayWidthWindowWidth)/2)
UpperLeftY = INT((DisplayHeightWindowHeight)/2)
graphicbox #main.gb ,0,0,ResZ,ResY
Open "Road" for window_nf as #main
#main "trapclose [quit]"
#main.gb "down; size 1; fill black;color yellow; backcolor black"
#main.gb "Font COURIER_NEW 10 32 BOLD"
#main.gb ""
#main.gb " LBRACE"
#main.gb " INSERT COIN "
#main.gb ""
#main.gb " TOP SCORES"
for i = 1 to 5
#main.gb " ";int(rnd(0)*8999)+1000;
next
' Draw the road
Z =0
DZ =0
DDZ =0
HalfWidth =0
SegY =0
NextStretch$ = "Straight"
WidthStep = 5
' no need for lines for just the background
FOR A = 1 TO ResY/1.25 + 1 step 3
' LINE (0, A)(ResZ  1, A), 9 ' line ([x1],[y1])  ([x2],[y2]), color number
r = 90 + int(A/3)
g = 100 + int(A/15)
b = 222  int(A/15)
#main.gb "color ";r ;" ";g ;" ";b
#main.gb "line 0 ";A1;" ";ResZ1;" ";A1
NEXT A
#main.gb " flush ;size 1"
TexOffset = 100
SegY = RoadLines
DZ = 0
DDZ = .1 ' This controls the steepness of the curve
FOR C = 1 TO 400
scan
' Set up the frame
Z = ResZ/2
DZ = 0
HalfWidth = ResZ/1.9
ScreenLine = ResY  1
pixhigh =2
GrassColor=2
RoadColor = 8
' between lines interpolation for faster drawing ... well don't know how to call this
' draw the even and odd in two different passes...
between = not(between)
FOR A = 1 TO RoadLines
if between then
if A mod 2 = 0 then [jmp]
else
if A mod 2 <> 0 then [jmp]
end if
IF (ZMap(A) + TexOffset) MOD 100 > 50 THEN
GrassColor = 10
RoadColor = 7
else
GrassColor = 2
RoadColor = 8
END IF
stripeColor = 11
IF (ZMap(A) + TexOffset) MOD 50 >= 25 THEN stripeColor = 4
' LINE (Z  HalfWidth, ScreenLine)(Z + HalfWidth, ScreenLine), RoadColor
' LINE (0, ScreenLine)(Z  HalfWidth, ScreenLine), GrassColor
' LINE (Z + HalfWidth, ScreenLine)(ResZ  1, ScreenLine), GrassColor
' ROAD
#main.gb "color "; QBColors$(RoadColor)
#main.gb "backcolor "; QBColors$(RoadColor)
'#main "backcolor "; QBColors$(RoadColor)
' #main "line ";Z  HalfWidth;" ";ScreenLine;" ";Z + HalfWidth;" ";ScreenLine
call RECT Z  HalfWidth , ScreenLine, HalfWidth*2, pixhigh
' GRASS
#main.gb "color ";QBColors$(GrassColor)
#main.gb "backcolor "; QBColors$(GrassColor)
' #main "backcolor "; QBColors$(RoadColor)
'#main "line ";0 ;" ";ScreenLine;" ";Z  HalfWidth;" ";ScreenLine
call RECT 0 , ScreenLine, Z  HalfWidth1, pixhigh
'#main "line ";Z + HalfWidth ;" ";ScreenLine;" ";ResZ1;" ";ScreenLine
'#main "backcolor "; QBColors$(RoadColor)
call RECT Z + HalfWidth+1, ScreenLine, ResZ(Z + HalfWidth), pixhigh
' THE THINGS LIKE STRIPES
#main.gb "color ";QBColors$(stripeColor)
#main.gb "backcolor ";QBColors$(stripeColor)
' #main "backcolor "; QBColors$(RoadColor)
' #main "line ";Z  HalfWidth 1;" ";ScreenLine;" ";Z  HalfWidth +1;" ";ScreenLine
' #main "line ";Z + HalfWidth 1;" ";ScreenLine;" ";Z + HalfWidth +1;" ";ScreenLine
call RECT Z  HalfWidth 3, ScreenLine, int(HalfWidth/10) , pixhigh
call RECT Z + HalfWidth 3, ScreenLine, int(HalfWidth/10) , pixhigh
' CAR
' #main.gb "color BLACK"
' #main.gb "backcolor RED"
' call RECT ResZ/240,ResY80, 80, pixhigh*4
' call RECT ResZ/250,ResY(80pixhigh*4), 100, pixhigh*10
[jmp]
select case NextStretch$
case "Straight"
IF A > SegY THEN DZ = DZ + DDZ
case "Curved"
IF A < SegY THEN DZ = DZ + DDZ
end select
if LeftOrRight = 0 then
Z = Z + DZ
else
Z = Z  DZ
end if
HalfWidth = HalfWidth  WidthStep
ScreenLine = ScreenLine  pixhigh
NEXT A
' Wrap positions (fractional):
TexOffset = TexOffset + ScrollSpeed
WHILE TexOffset >= 100
TexOffset = TexOffset  100
WEND
SegY = SegY  ScrollSpeed/10 ' Decrease SegY by an arbitrary amount. Adjust to taste.
WHILE SegY < 0
SegY = SegY + RoadLines
select case NextStretch$
case "Curved"
NextStretch$ = "Straight"
LeftOrRight= not(LeftOrRight)
case "Straight"
NextStretch$ = "Curved"
end select
WEND
NEXT C
[quit]
close #main : end
SUB RECT x1,y1,x2,y2
#main.gb "place ";x1;" ";y1
#main.gb "BOXFILLED "; x1 + x2 ;" ";y1 + y2
END SUB


Logged

cundo



G. Rahman
Guru
member is offline
Gender:
Posts: 1146


Re: Pseudo 3D
« Reply #12 on: Sep 28^{th}, 2017, 08:29am » 

Hi,
I'm pretty sure that I downloaded a complete "game" here. I miss the link?
Gordon

« Last Edit: Sep 28^{th}, 2017, 08:29am by G. Rahman » 
Logged

Gordon Rahman
http://www.libertybasic.nl



