Liberty BASIC Community Forum
« Pseudo 3D »

Welcome Guest. Please Login or Register.
Oct 18th, 2017, 08:05am


Rules|Home|Help|Search|Recent Posts|Notification


« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Pseudo 3D  (Read 479 times)
cundo
Guru
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 626
xx Pseudo 3D
« Thread started on: Oct 16th, 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((DisplayWidth-WindowWidth)/2)
    UpperLeftY = INT((DisplayHeight-WindowHeight)/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 ";A-1;" ";ResX-1;" ";A-1
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;" ";ResX-1;" ";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 video-games consoles, NES (Famicom), SEGA Genesis/Megadrive. Many also from Arcades.
Some classics like F1-Race 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 !!


User IP Logged

cundo
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5543
xx Re: Pseudo 3D
« Reply #1 on: Oct 16th, 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.


User Image
User IP Logged

bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 918
xx Re: Pseudo 3D
« Reply #2 on: Oct 17th, 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 ";A-1;" ";ResX-1;" ";A-1
''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
 
User IP Logged

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


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 918
xx Re: Pseudo 3D
« Reply #3 on: Oct 17th, 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 ";A-1;" ";ResX-1;" ";A-1
''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


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

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1684
xx Re: Pseudo 3D
« Reply #4 on: Oct 18th, 2016, 08:53am »

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

damned Dog in the Manger
cundo
Guru
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 626
xx Re: Pseudo 3D
« Reply #5 on: Oct 18th, 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 ";A-1;" ";ResX-1;" ";A-1
''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





 
User IP Logged

cundo
cundo
Guru
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 626
xx Re: Pseudo 3D
« Reply #6 on: Oct 18th, 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((DisplayWidth-WindowWidth)/2)
    UpperLeftY = INT((DisplayHeight-WindowHeight)/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 ";A-1;" ";ResZ-1;" ";A-1
'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;" ";ResZ-1;" ";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
User IP Logged

cundo
cundo
Guru
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 626
xx Re: Pseudo 3D
« Reply #7 on: Oct 18th, 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((DisplayWidth-WindowWidth)/2)
    UpperLeftY = INT((DisplayHeight-WindowHeight)/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 ";A-1;" ";ResZ-1;" ";A-1
'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;" ";ResZ-1;" ";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
 
User IP Logged

cundo
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 918
xx Re: Pseudo 3D
« Reply #8 on: Oct 19th, 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 ";A-1;" ";ResX-1;" ";A-1
''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;" ";ResY-50;" ";ResX/2+qx;" ";ResY-qy-50
  #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


 
User IP Logged

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


member is offline

Avatar




PM

Gender: Male
Posts: 626
xx Re: Pseudo 3D
« Reply #9 on: Oct 20th, 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((DisplayWidth-WindowWidth)/2)
    UpperLeftY = INT((DisplayHeight-WindowHeight)/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 ";A-1;" ";ResZ-1;" ";A-1
'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;" ";ResZ-1;" ";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 22nd, 2016, 3:56pm by cundo » User IP Logged

cundo
cundo
Guru
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 626
xx Re: Pseudo 3D
« Reply #10 on: Oct 22nd, 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 = DisplayHeight-126
 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((DisplayWidth-WindowWidth)/2)
    UpperLeftY = INT((DisplayHeight-WindowHeight)/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 "| LB-RACE"
        #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 ";A-1;" ";ResZ-1;" ";A-1
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 - HalfWidth-1, pixhigh
   '#main "line ";Z + HalfWidth ;" ";ScreenLine;" ";ResZ-1;" ";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/2-40,ResY-80, 80, pixhigh*4
  '  call RECT  ResZ/2-50,ResY-(80-pixhigh*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 22nd, 2016, 4:04pm by cundo » User IP Logged

cundo
cundo
Guru
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 626
xx Re: Pseudo 3D
« Reply #11 on: Oct 22nd, 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 = 600-100
 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((DisplayWidth-WindowWidth)/2)
    UpperLeftY = INT((DisplayHeight-WindowHeight)/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 "| LB-RACE"
        #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 ";A-1;" ";ResZ-1;" ";A-1
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 - HalfWidth-1, pixhigh
   '#main "line ";Z + HalfWidth ;" ";ScreenLine;" ";ResZ-1;" ";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/2-40,ResY-80, 80, pixhigh*4
  '  call RECT  ResZ/2-50,ResY-(80-pixhigh*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



 
User IP Logged

cundo
G. Rahman
Guru
ImageImageImageImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 1146
xx Re: Pseudo 3D
« Reply #12 on: Sep 28th, 2017, 08:29am »


Hi,

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

Gordon
« Last Edit: Sep 28th, 2017, 08:29am by G. Rahman » User IP Logged

Gordon Rahman

http://www.libertybasic.nl
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls