It is currently Thu Dec 12, 2019 4:36 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 8 posts ] 
Author Message
 Post subject: Pseudo 3D code
PostPosted: Fri Jun 20, 2014 10:37 pm 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
This code is converted from Code Incompete javascript pseudo 3D road routine, with hills and curves. I haven't added the billboards and cars (yet).

Code:
#PLAYER_STRAIGHT                      =       0
#PLAYER_LEFT                          =       1
#PLAYER_RIGHT                         =       2
#PLAYER_UPHILL_STRAIGHT                        =       3
#PLAYER_UPHILL_LEFT                        =       4
#PLAYER_UPHILL_RIGHT                       =       5

#ROAD_LENGTH_NONE                     =       0
#ROAD_LENGTH_SHORT                    =       25
#ROAD_LENGTH_MEDIUM                   =       50
#ROAD_LENGTH_LONG                     =       100

#ROAD_HILL_NONE                       =       0
#ROAD_HILL_LOW                        =       20
#ROAD_HILL_MEDIUM                     =       40
#ROAD_HILL_HIGH                       =       60

#ROAD_CURVE_NONE                      =       0
#ROAD_CURVE_EASY                      =       2
#ROAD_CURVE_MEDIUM                    =       4
#ROAD_CURVE_HARD                      =       6

Structure tScreen
   scale.f
   x.f
   y.f
   w.f
EndStructure

Structure tCamera
   x.f
   y.f
   z.f
EndStructure

Structure tWorld
   x.f
   y.f
   z.f
EndStructure

Structure tColour
   rumble.l
   road.l
   grass.l
   lane.l
EndStructure

Structure tPart
   world.tWorld
   camera.tCamera
   screen.tScreen
   rumbleWidth.f
EndStructure

Structure tSegment
   index.l
   colour.tColour
   p1.tPart
   p2.tPart
   curve.f
   rumbleWidth.f
EndStructure

Declare renderFrame()
Declare resetRoad()
Declare addSegment(curve.f,y.f)
Declare segment(width.l,lanes.l,fog.f,*segment.tSegment)
Declare update(dt.f)
Declare.f increase(start.f,increment.f,maxV.f)
Declare.f accelerate(v.f,accel.f,dt.f)
Declare Min(a,b)
Declare Max(a,b)
Declare.f limit(value.f,minV.f,maxV.f)
Declare addRoad(enter.l,hold.l,leave.l,curve.f,y.f)
Declare addStraight(num.l=25)
Declare addCurve(num.l,curve.f)
Declare addHill(num.l, height.l)
Declare easeIn(a.f,b.f,percent.f)
Declare easeOut(a.f,b.f,percent.f)
Declare easeInOut(a.f,b.f,percent.f)
Declare.f percentRemaining(n.l,total.l)
Declare.f interpolate(a.f,b.f,percent.f)

Global Dim segments.tSegment(0)
Global trackLength.l
Global segmentLength.l   =   200
Global rumbleLength.l = 3
Global width.l   = 640
Global height.l   =   480
Global position.f   =   0.0
Global drawDistance.l    =   500
Global cameraDepth.f      =   0.0
Global cameraHeight.f    =   1500.0
Global roadWidth.f         =   2000.0
Global playerX.f            =   0.0
Global fieldOfView.f    = 100.0
Global speed.f          = 0.0
Global playerX.f          = 0.0
Global lanes.l          = 3
Global playerZ.f        = 0.0
Global DARK_ROAD.tColour
Global LIGHT_ROAD.tColour

Define now.f,last.f,gdt.f,stp.f

InitSprite()
InitKeyboard()

DARK_ROAD\road=6908265
DARK_ROAD\grass=39424
DARK_ROAD\rumble=12303291
DARK_ROAD\lane=0

LIGHT_ROAD\road=7039851
LIGHT_ROAD\grass=1092112
LIGHT_ROAD\rumble=5592405
LIGHT_ROAD\lane=13421772

cameraDepth=1.0 / Tan(Radian(fieldOfView/2.0))
playerZ=cameraHeight * cameraDepth

now=0.0
last=0.0
gdt=0.0
stp=0.025

If OpenScreen(width,height,32,"Pseudo 3D Test 1") 
     Debug "Setting up"
     SetFrameRate(75)
      resetRoad()
      Debug "Finished setting up"
      
      FlipBuffers()
      
      Repeat
        ClearScreen(RGB(0,0,0))     
      RenderFrame()
   
        ; Inverse the buffers (the back become the front (visible)... And we can do the rendering on the back)           
           
        now=ElapsedMilliseconds()
        dt=Min(1.0,(now-last)/1000.0)
        gdt+dt
       
        While gdt>stp
          gdt-stp
          update(stp)
        Wend
       
        update(stp)
           
        ExamineKeyboard()
        FlipBuffers()
    Until KeyboardPushed(#PB_Key_Escape)
  EndIf
  CloseScreen()

Procedure resetRoad()
  Dim segments.tSegment(0)
 
  addStraight(50)
  addCurve(25,#ROAD_CURVE_MEDIUM)
  addHill(25,#ROAD_HILL_HIGH)
  addCurve(25,#ROAD_CURVE_EASY)
  addStraight(50)
  addHill(25,-#ROAD_HILL_LOW)
  addHill(25,#ROAD_HILL_MEDIUM)
  addHill(25,-#ROAD_HILL_HIGH)
  addCurve(25,-#ROAD_CURVE_MEDIUM)
  addCurve(25,#ROAD_CURVE_HARD)
  addHill(25,#ROAD_HILL_HIGH)
  addHill(25,#ROAD_HILL_HIGH)
  addHill(25,-#ROAD_HILL_HIGH)
  addStraight(10)
  addHill(25,-#ROAD_HILL_HIGH)
  addStraight(100)
  addCurve(25,#ROAD_CURVE_HARD)
  addCurve(25,#ROAD_CURVE_HARD)
  addCurve(25,#ROAD_CURVE_HARD)
  addHill(100,-#ROAD_HILL_HIGH)
  addHill(200,#ROAD_HILL_HIGH)
  addHill(10,#ROAD_HILL_HIGH)
  addHill(15,#ROAD_HILL_HIGH)
  addHill(30,-#ROAD_HILL_HIGH)
  addStraight(100)
  trackLength=ArraySize(segments())*segmentLength 
EndProcedure

Procedure.f lastY()
  Define index.l
 
  index=ArraySize(segments())
  If index<=0
    ProcedureReturn 0.0
  Else   
    ProcedureReturn segments(index-1)\p2\world\y
  EndIf
EndProcedure

Procedure addSegment(curve.f,y.f)
   Define n.l
   Define prevY.f
   
   prevY=lastY()
   n=ArraySize(segments())
   ReDim segments.tSegment(n+1)
   
  Debug "Array count : "+n
  segments(n)\curve=curve
   segments(n)\index=n
   segments(n)\p1\world\x=0.0
   segments(n)\p1\world\y=prevY
   segments(n)\p1\world\z=n*segmentLength      
   segments(n)\p1\camera\x=0.0
   segments(n)\p1\camera\y=0.0
   segments(n)\p1\camera\z=0.0
   
   segments(n)\p2\world\x=0.0
   segments(n)\p2\world\y=y
   segments(n)\p2\world\z=(n+1)*segmentLength
   segments(n)\p2\camera\x=0.0
   segments(n)\p2\camera\y=0.0
   segments(n)\p2\camera\z=0.0
   
   segments(n)\rumbleWidth=2
   
   Debug "Seg 1 Y :"
   Debug segments(n)\p1\world\y
   
   Debug "Seg 2 Y :"
   Debug segments(n)\p2\world\y
   
   
   If n % 2
      segments(n)\colour=LIGHT_ROAD
   Else
      segments(n)\colour=DARK_ROAD
   EndIf
   
   segments(n)\colour\lane=RGB(255,255,255)   
EndProcedure

Procedure findSegment(z.f,*store.tSegment)
  Define index.l
 
  ; Debug "Z:"+StrF(z,4)+" "+Str(segmentLength)+" "+StrF(z/segmentLength,4)
  index=Round(z/segmentLength,#PB_Round_Down)
  CopyStructure(segments(index),*store,tSegment)
EndProcedure
   
Procedure project(*p.tPart,cameraX.f,cameraY.f,cameraZ.f,cameraDepth.f,width.l,height.l,roadWidth.l,rumbleWidth.l)
      *p\camera\x=*p\world\x-cameraX
      *p\camera\y=*p\world\y-cameraY
      *p\camera\z=*p\world\z-cameraZ
      
      If *p\camera\z<>0.0
         *p\screen\scale=cameraDepth/*p\camera\z
      Else
         *p\screen\scale=0.0
      EndIf
      
      *p\screen\x=(width/2.0)+((*p\screen\scale* *p\camera\x*width)/2.0)
      *p\screen\y=(height/2.0)-((*p\screen\scale* *p\camera\y*height)/2.0)
      *p\screen\w=*p\screen\scale*roadWidth*width/2.0
      *p\rumbleWidth=*p\screen\w/rumbleWidth
;      Debug "Screen X : "+*p\screen\x
;      Debug "Screen Y : "+*p\screen\y
   EndProcedure
   
   Procedure render()
     Define baseSegment.tSegment
     Define playerSegment.tSegment
     Define basePercent.f
      Define maxy.l,n.l
      Define segment.tSegment
      Define x.f,dx.f
      Define playerY.f
      Define playerPercent.f
           
      maxy=height
      findSegment(Int(position),@baseSegment)
        basePercent=percentRemaining(position, segmentLength)
        findSegment(position+playerZ,@playerSegment)
        playerPercent=percentRemaining(position+playerZ,segmentLength)
        playerY=interpolate(playerSegment\p1\world\y,playerSegment\p2\world\y,playerPercent)
       
   ;     Debug "Player Y : "
      ;  Debug playerY
       ; Debug "Player % : "
        ;Debug playerPercent
        ;Debug "P2 : "
        ;Debug playerSegment\p1\world\y
        ;Debug playerSegment\p2\world\y
        ;Debug playerSegment\index
        Debug "P1 Y : "+StrF(playerSegment\p1\world\y,4)+" P2 Y : "+StrF(playerSegment\p2\world\y,4)
        Debug "Player Percent : "+StrF(playerPercent,4)+" Y : "+StrF(playerY,4)+" Index : "+Str(playerSegment\index)
       
         x=0.0
         dx=-baseSegment\curve*basePercent
         
         For n=0 To drawDistance-1
            segment=segments((baseSegment\index+n) % ArraySize(segments()))
            ;Debug "Current index : "+*segment\index            
            
            ; *segment\clip=maxy
            
            project(@segment\p1,(playerX*roadWidth)-x,playerY+cameraHeight,position,cameraDepth,width,height,roadWidth,segment\rumbleWidth)
            project(@segment\p2,(playerX*roadWidth)-x-dx,playerY+cameraHeight,position,cameraDepth,width,height,roadWidth,segment\rumbleWidth)
            
;            Debug segment\index
   ;         Debug segment\p1\camera\z
      ;      Debug position
            ; Debug cameraDepth
            x+dx
            dx+segment\curve
            
            If segment\p1\camera\z<=cameraDepth Or segment\p2\screen\y>=segment\p1\screen\y Or segment\p2\screen\y>=maxy
;               Debug "Z1:"+*segment\p1\camera\z
   ;            Debug "Z2:"+cameraDepth
      ;         Debug "segment\p1\screen\y:"+*segment\p2\screen\y
         ;      Debug "segment\p2\screen\y:"+maxy
;               Debug "Continuing"
               Continue
            Else
   ;           Debug "Plotting"
             
             
               segment(width,lanes,1.0,segment)
            EndIf
            
            maxy=segment\p1\screen\y
         Next
   EndProcedure
   
   Procedure.f rumbleWidth(projectedRoadWidth.l,lanes.l)
      ProcedureReturn projectedRoadWidth/MAX(6,2*lanes)
   EndProcedure
   
   Procedure.f laneMarkerWidth(projectedRoadWidth.l,lanes.l)
      ProcedureReturn projectedRoadWidth/MAX(32,8*lanes)
   EndProcedure
   
   Procedure.f percentRemaining(n.l,total.l)
     ProcedureReturn Mod(n,total)/total
   EndProcedure
   
   Procedure.f interpolate(a.f,b.f,percent.f)
     ProcedureReturn a+(b-a)*percent
   EndProcedure
    
   Procedure addRoad(enter.l,hold.l,leave.l,curve.f,y.f)
     Define n.l
     Define startY.f,endY.f
     Define total.l
    
     startY=lastY()
     endY=startY+(Int(y)*segmentLength)
     total=enter+hold+leave
     
     For n=0 To enter-1
       addSegment(easeIn(0,curve,n/enter),easeInOut(startY,endY,n/total))
     Next
    
     For n=0 To hold-1
       addSegment(curve,easeInOut(startY,endY,(enter+n)/total))
     Next
    
     For n=0 To leave-1
       addSegment(easeInOut(curve,0,n/leave),easeInOut(startY,endY,(enter+hold+n)/total))
     Next
   EndProcedure
   
   Procedure easeIn(a.f,b.f,percent.f)
     ProcedureReturn a+(b-a)*Pow(percent,2)
   EndProcedure
   
   Procedure easeOut(a.f,b.f,percent.f)
     ProcedureReturn a+(b-a)*(1.0-Pow(1.0-percent,2))
   EndProcedure
   
   Procedure easeInOut(a.f,b.f,percent.f)
     ProcedureReturn a+(b-a)*((-Cos(percent*#PI)/2)+0.5)
   EndProcedure
 
   Procedure addStraight(num.l=25)
     addRoad(num,num,num,0.0,0.0)
   EndProcedure
    
   Procedure addCurve(num.l,curve.f)
     addRoad(num,num,num,curve,0.0)
   EndProcedure
   
   Procedure addHill(num.l, height.l)
     addRoad(num,num,num,0,height)
   EndProcedure
     
   Procedure polygon(x1.f,y1.f,x2.f,y2.f,x3.f,y3.f,x4.f,y4.f,colour.l)      
     LineXY(x1,y1,x2,y2,colour)
     ; LineXY(x1,y1,x3,y3,colour)
     ;LineXY(x2,y2,x4,y3,colour)
     ;Linext(
     ; LineXY(0,0,100,100,RGB(255,0,0))
     ; LineXY(segment\p2\screen\x,segment\p2\screen\y,x3,y3,colour)
      ; LineXY(segment\p2\screen\x,segment\p2\screen\y,x3,y3,colour)
      ;LineXY(x3,y3,x4,y4,colour)
      ; LineXY(x4,y4,segment\p1\screen\x,segment\p1\screen\y,colour)
   ;   LineXY(x3,y3,x4,y4,colour)
      ;LineXY(x4,y4,segment\p1\screen\x,segment\p1\screen\y,colour)
   EndProcedure
   
   Procedure segment(width.l,lanes.l,fog.f,*segment.tSegment)
    
    polygon(*segment\p1\screen\x-*segment\p1\screen\w-*segment\p1\rumbleWidth, *segment\p1\screen\y, *segment\p1\screen\x-*segment\p1\screen\w, *segment\p1\screen\y, *segment\p2\screen\x-w2, *segment\p2\screen\y, *segment\p2\screen\x-w2-*segment\p2\rumbleWidth, *segment\p2\screen\y, *segment\colour\rumble)
    polygon(*segment\p1\screen\x+*segment\p1\screen\w+*segment\p1\rumbleWidth, *segment\p1\screen\y, *segment\p1\screen\x+*segment\p1\screen\w, *segment\p1\screen\y, *segment\p2\screen\x+w2, *segment\p2\screen\y, *segment\p2\screen\x+w2+*segment\p2\rumbleWidth, *segment\p2\screen\y, *segment\colour\rumble)
    polygon(*segment\p1\screen\x-*segment\p1\screen\w, *segment\p1\screen\y, *segment\p1\screen\x+*segment\p1\screen\w, *segment\p1\screen\y, *segment\p2\screen\x+w2, *segment\p2\screen\y, *segment\p2\screen\x-w2, *segment\p2\screen\y, *segment\colour\road)
;    Box(0,*segment\p2\screen\y,width,*segment\p1\screen\y-*segment\p2\screen\y,*segment\colour\grass)
  EndProcedure
 
  Procedure RenderFrame()     
     If StartDrawing(ScreenOutput())
        render()
        
       StopDrawing()
     ;Else
     ;  Debug "Failed"
     EndIf
  EndProcedure
 
  Procedure update(dt.f)
    position=increase(position,speed,trackLength)
    ; position+0.5
   
    speed+accelerate(speed,45.0,dt)
    speed=limit(speed,0.0,5.0)
  EndProcedure
 
  Procedure Min(a,b)
    If a<b
      ProcedureReturn a
    Else
      ProcedureReturn b
    EndIf
  EndProcedure
 
  Procedure Max(a,b)
    If a>b
      ProcedureReturn a
    Else
      ProcedureReturn b
    EndIf
  EndProcedure
 
  Procedure.f increase(start.f,increment.f,maxV.f)
    Define result.f
   
    result=start+increment
    While result>=maxV
      result-maxV
    Wend
   
    While result<0
      result+maxV
    Wend
   
    ProcedureReturn result
  EndProcedure
 
  Procedure.f accelerate(v.f,accel.f,dt.f)
    ProcedureReturn v+(accel*dt)
  EndProcedure
 
  Procedure.f limit(value.f,minV.f,maxV.f)
    ProcedureReturn Max(minV,Min(value,maxV))
  EndProcedure 


If anyone has a polygon drawing routine, then that is needed really to create a solid road.

A video : http://www.dailymotion.com/video/x1zx8xl_purebasic-pseudo-3d-road-routine_tech


Last edited by BurpyMcFistyGuts on Fri Jun 20, 2014 10:51 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Pseudo 3D code
PostPosted: Fri Jun 20, 2014 10:50 pm 
Offline
Administrator
Administrator

Joined: Fri May 17, 2002 4:39 pm
Posts: 13657
Location: France
Why not using the 3D engine ?


Top
 Profile  
Reply with quote  
 Post subject: Re: Pseudo 3D code
PostPosted: Fri Jun 20, 2014 10:52 pm 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
Aside from the fact that I have no 3D editor, I will be converting it to SpiderBasic, and which, as you previously mentioned, has no 3D engine :)


Last edited by BurpyMcFistyGuts on Fri Jun 20, 2014 10:54 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Pseudo 3D code
PostPosted: Fri Jun 20, 2014 10:54 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jan 10, 2008 1:30 pm
Posts: 1244
Location: Germany, Glienicke
I have written a Drawing3D-Include:
Drawing3D - Draw commands for 3D Scenes
(to run the code with PB 5.20+, delete "Structure Drawing3D_Object" line 69, it's not needed)

_________________
ImageImage


Top
 Profile  
Reply with quote  
 Post subject: Re: Pseudo 3D code
PostPosted: Fri Jun 20, 2014 10:56 pm 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
That'll be worth trying at some point!


Top
 Profile  
Reply with quote  
 Post subject: Re: Pseudo 3D code
PostPosted: Sat Jun 21, 2014 1:49 am 
Offline
Addict
Addict
User avatar

Joined: Sun Apr 27, 2003 8:12 am
Posts: 2004
Location: USA
Very nice! ;)

_________________
www.posemotion.com

PureBasic Tools for OS X: PureMonitor, plist Tool, Data Maker & App Chef

Mac: 10.13.6 / 1.4GHz Core 2 Duo / 2GB DDR3 / Nvidia 320M
PC: Win 7 / AMD 64 4000+ / 3GB DDR / Nvidia 720GT


Even the vine knows it surroundings but the man with eyes does not.


Top
 Profile  
Reply with quote  
 Post subject: Re: Pseudo 3D code
PostPosted: Sat Jun 21, 2014 12:18 pm 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
Thanks!


Top
 Profile  
Reply with quote  
 Post subject: Re: Pseudo 3D code
PostPosted: Sat Jun 21, 2014 11:20 pm 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
Ah, thanks - I'll try that


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 8 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 4 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye