PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Pseudo 3D code

https://www.purebasic.fr/english/viewtopic.php?t=59694

Page 1 of 1

Pseudo 3D code

Posted: Fri Jun 20, 2014 10:37 pm
by BurpyMcFistyGuts
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: Select all

#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/x1zx8x ... utine_tech

Re: Pseudo 3D code

Posted: Fri Jun 20, 2014 10:50 pm
by Fred
Why not using the 3D engine ?

Re: Pseudo 3D code

Posted: Fri Jun 20, 2014 10:52 pm
by BurpyMcFistyGuts
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 :)

Re: Pseudo 3D code

Posted: Fri Jun 20, 2014 10:54 pm
by STARGÅTE
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)

Re: Pseudo 3D code

Posted: Fri Jun 20, 2014 10:56 pm
by BurpyMcFistyGuts
That'll be worth trying at some point!

Re: Pseudo 3D code

Posted: Sat Jun 21, 2014 1:49 am
by J. Baker
Very nice! ;)

Re: Pseudo 3D code

Posted: Sat Jun 21, 2014 12:18 pm
by BurpyMcFistyGuts
Thanks!

Re: Pseudo 3D code

Posted: Sat Jun 21, 2014 11:20 pm
by BurpyMcFistyGuts
Ah, thanks - I'll try that
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited