EXAMPLE SOURCE CODES


     This is a small collection of mostly game example source codes. These source codes are made available to help PlayBasic programmers kick start their game programming journey. Looking for more source code / tutorials & media, then remember to visit the PlayBasic Resource board on our forums.

Found #1 item in Gouraud category by Kevin Picone

 Gouraud Shaded Torus - Blitz Basic 2D Port

By: Kevin Picone Added: January 7th, 2023

Category: All,3D,Gouraud,Torus,BlitzBASIC

  3D Gouraud Shaded Torus  - 14th March 2022

    This example rendering  spinning gouraud shaded torus in 3D, purely in software.  The code is translation of an old Blitz BASIC program that was converted and tweaked to run in PlayBasic.


   Note:  Download attachment for the FULL code it's too big for a snippet


 



 
PlayBasic Code:
; PROJECT : 3d_v2_Torus_PB_Version
; AUTHOR  : Paul Rene J?rgensen  & Kev Picone
; CREATED : 12/03/2022
; EDITED  : 14/03/2022
; ---------------------------------------------------------------------

;--------------------------------------------------------------------------------
	#include "BlitzWrapper.pba"
;--------------------------------------------------------------------------------


; 3d
;
;       Author : Paul Rene J?rgensen, <>
;  Last update : 20. February, 2001
;
; 9 Muls rotator, Mergesort, Gourad shader,
; Backface-culling, Vector based lightsource


Global numvertex,numpoly
Global width=640
Global height=480

BB_Graphics width,height,32,2
BB_AppTitle("Gourad shading")

BB_SetBuffer BB_BackBuffer()

Dim xpos(height,2)
Dim zpos(height,2)
Dim rpos(height,2)
Dim gpos(height,2)
Dim bpos(height,2)

Type tlightsource
   x,y,z
EndType

Type tvertex
   x,y,z
   xr,yr,zr
   nx,ny,nz
   nxr,nyr,nzr
   x2d,y2d
EndType

Type tpoly
   v0,v1,v2,v3
   order
EndType

Restore MyObject
	numvertex = Readdata()
	numpoly		=ReadData()

Dim zcenter(numpoly)
Dim zworking(numpoly)
Dim ordertable(numpoly)
Dim oworking(numpoly)

Restore coords
Dim vertex(numvertex) as tvertex
For n=0 To numvertex-1
  vertex(n)=New tvertex
  vertex(n).x = Readdata()
  vertex(n).y= Readdata()
  vertex(n).z= Readdata()
Next
Restore pnorms
For n=0 To numvertex-1
  vertex(n).nx = Readdata()
  vertex(n).ny = Readdata()
  vertex(n).nz = Readdata()
Next

Restore polys
Dim poly(numpoly) as tpoly
For n=0 To numpoly-1
  poly(n)=New tpoly
 ; BB_Read dum,dum
  dum = Readdata()
  dum = Readdata()
  poly(n).v0 = Readdata()
  poly(n).v1 = Readdata()
  poly(n).v2 = Readdata()
  poly(n).v3 = Readdata()
Next

Dim lightsource(2) as tlightsource
lightsource(0)=New tlightsource
lightsource(0).x=256
lightsource(0).y=256
lightsource(0).z=-256


x_angle=0
y_angle=0
z_angle=0

;setfps 31.7

global RenderMethod =0 

While Not BB_KeyDown(1)

	if enterKey()
		RenderMethod++
		if RenderMethod>2 then RenderMethod=0
		flushkeys
	endif

	select RenderMethod
			case 0
				Render_Method_Name$ ="fastDot inner loop"
			case 1
				Render_Method_Name$ ="gouraud strip inner loop"
			case 2
				Render_Method_Name$ ="gouraud triangle"
	endselect

  rotate_transform_vertices(x_angle,y_angle,z_angle)
  sort_polys()
  BB_Cls()
  draw_polys()
 ; draw_vertices()
  lfps=(1000/(BB_MilliSecs()-t))
  t=BB_MilliSecs()
  Text 10,10,"Current FPS : "+str$(lfps)
  Text 10,30,"Highest FPS : "+str$(hfps)
  Text 10,40,"Average FPS : "+str$(afps#)
  Text 10,50," Lowest FPS : "+str$(lfps)
  Text 10,60,"     Render : "+Render_Method_Name$
 
  Text 210,10,"  Points : "+str$(numvertex)
  Text 210,20,"Polygons : "+str$(numpoly)
 
  
  If hfps=0 Then hfps=lfps
  If lfps=0 Then lfps=lfps
  If afps#=0 Then afps#=lfps : afpscount=1
  If lfps>hfps Then hfps=lfps
  If lfps<lfps Then lfps=lfps
  afps#=((afps#*afpscount)+lfps)/(afpscount+1)
  afpscount=afpscount+1
  BB_Flip()
  x_angle=x_angle+1
  y_angle=y_angle+2
  z_angle=z_angle+4
  If x_angle>360 Then x_angle=x_angle-360
  If y_angle>360 Then y_angle=y_angle-360
  If z_angle>360 Then z_angle=z_angle-360


	if Spacekey() then end
	quittime=quittime+1
	If quittime> 25000 Then End
EndWhile



Function draw_polys()
  lockbuffer
    ThisRGB = point(0,0)
		
	  For n=0 To numpoly-1
	  index=ordertable(n)	
    v0=poly(index).v0
    v1=poly(index).v1
    v2=poly(index).v2

    x1=vertex(v0).x2d
    y1=vertex(v0).y2d
    nx=vertex(v0).nxr
    ny=vertex(v0).nyr
    nz=vertex(v0).nzr
    c1=((nx*lightsource(0).x)+(ny*lightsource(0).y)+(nz*lightsource(0).z))/256
    If c1<0 Then c1=0
    If c1>255 Then c1=255

    x2=vertex(v1).x2d
    y2=vertex(v1).y2d
    nx=vertex(v1).nxr
    ny=vertex(v1).nyr
    nz=vertex(v1).nzr
    c2=((nx*lightsource(0).x)+(ny*lightsource(0).y)+(nz*lightsource(0).z))/256
   ; If c2<0 Then c2=0
   ; If c2>255 Then c2=255
	c2=cliprange(c2,0,255)
		

    x3=vertex(v2).x2d
    y3=vertex(v2).y2d
    nx=vertex(v2).nxr
    ny=vertex(v2).nyr
    nz=vertex(v2).nzr
    c3=((nx*lightsource(0).x)+(ny*lightsource(0).y)+(nz*lightsource(0).z))/256
    If c3<0 Then c3=0
    If c3>255 Then c3=255
 
    ; Back-face culling
    If (x3-x1)*(y2-y1)-(x2-x1)*(y3-y1)>=0
    	Select RenderMethod
    			case 0
		     		 gpolygon(x1,y1,c1,c1,c1,x2,y2,c2,c2,c2,x3,y3,c3,c3,c3)
    			case 1
		     		 gpolygon1(x1,y1,c1,c1,c1,x2,y2,c2,c2,c2,x3,y3,c3,c3,c3)
    			case 2
		     		 gpolygon2(x1,y1,c1,c1,c1,x2,y2,c2,c2,c2,x3,y3,c3,c3,c3)
	  endselect
     ; Line vertex(v0).x2d,vertex(v0).y2d,vertex(v1).x2d,vertex(v1).y2d
;      Line vertex(v1)\x2d,vertex(v1)\y2d,vertex(v2)\x2d,vertex(v2)\y2d
;      Line vertex(v2)\x2d,vertex(v2)\y2d,vertex(v0)\x2d,vertex(v0)\y2d
    EndIf
  Next
  unlockbuffer
EndFunction 0


Function draw_vertices()
  BB_LockBuffer 0
  lRGB=(255 << 16)+(255 << 8)+255
  For n=0 To numvertex-1
    BB_WritePixel vertex(n).x2d,vertex(n).y2d,lRGB,0
  Next
  BB_UnlockBuffer 0
EndFunction 0



Function sort_polys()
  For n=0 To numpoly-1
    v0=poly(n).v0
    v1=poly(n).v1
    v2=poly(n).v2
    z1=vertex(v0).zr
    z2=vertex(v1).zr
    z3=vertex(v2).zr
    z=z1+z2+z3
    zcenter(n)=z
    ordertable(n)=n    
  Next
  mergesort(0,numpoly-1)
EndFunction 0

Function mergesort(lo,hi)
  ; Base case
  If lo=hi Then ExitFUNCTION 0

  ; Recurse
  length=hi-lo+1
  pivot=(lo+hi)/2
  mergesort(lo,pivot)
  mergesort(pivot+1,hi)

  ; Merge
  For i=0 To length-1
    zworking(i)=zcenter(lo+i)
    oworking(i)=ordertable(lo+i)
  Next
  m1=0
  m2=pivot-lo+1
  For i=0 To length-1
    If m2<=(hi-lo)
      If m1<=(pivot-lo)
        If zworking(m1)<zworking(m2)
          ordertable(i+lo)=oworking(m2)
          zcenter(i+lo)=zworking(m2)
          m2=m2+1
        Else
          ordertable(i+lo)=oworking(m1)
          zcenter(i+lo)=zworking(m1)
          m1=m1+1
        EndIf
      Else
        ordertable(i+lo)=oworking(m2)
        zcenter(i+lo)=zworking(m2)
        m2=m2+1
      EndIf
    Else
      ordertable(i+lo)=oworking(m1)
      zcenter(i+lo)=zworking(m1)
      m1=m1+1
    EndIf
  Next
EndFunction 0  // Assumed Integer return


Function rotate_transform_vertices(x_angle,y_angle,z_angle)
  ; 9 muls rotator
  c1#=Cos(x_angle)
  c2#=Cos(y_angle)
  c3#=Cos(z_angle)
  s1#=Sin(x_angle)
  s2#=Sin(y_angle)
  s3#=Sin(z_angle)
  xx#=c2#*c1#
  xy#=c2#*s1#
  xz#=s2#
  yx#=c3#*s1#+s3#*s2#*c1#
  yy#=-c3#*c1#+s3#*s2#*s1#
  yz#=-s3#*c2#
  zx#=s3#*s1#-c3#*s2#*c1#
  zy#=-s3#*c1#-c3#*s2#*s1#
  zz#=c3#*c2#
width2=width/2
height2=height/2
widthbyheight=(width/height)*256
  For n=0 To numvertex-1
    ; Vertices
    vertex(n).xr=xx#*vertex(n).x+xy#*vertex(n).y+xz#*vertex(n).z
    vertex(n).yr=yx#*vertex(n).x+yy#*vertex(n).y+yz#*vertex(n).z
    vertex(n).zr=zx#*vertex(n).x+zy#*vertex(n).y+zz#*vertex(n).z
    ; Vertice Normals
    vertex(n).nxr=xx#*vertex(n).nx+xy#*vertex(n).ny+xz#*vertex(n).nz
    vertex(n).nyr=yx#*vertex(n).nx+yy#*vertex(n).ny+yz#*vertex(n).nz
    vertex(n).nzr=zx#*vertex(n).nx+zy#*vertex(n).ny+zz#*vertex(n).nz
    ; 3d -> 2d transformation
    vertex(n).x2d=(widthbyheight*vertex(n).xr)/(vertex(n).zr+1024)+width2
    vertex(n).y2d=(256*vertex(n).yr)/(vertex(n).zr+1024)+height2
  Next
EndFunction 0


Function gpolygon(x1,y1,r1,g1,b1,x2,y2,r2,g2,b2,x3,y3,r3,g3,b3)
	
  For n=0 To height : xpos(n,0)=0 : xpos(n,1)=0 : Next
  drawedge(x1,y1,r1,g1,b1,x2,y2,r2,g2,b2)
  drawedge(x2,y2,r2,g2,b2,x3,y3,r3,g3,b3)
  drawedge(x3,y3,r3,g3,b3,x1,y1,r1,g1,b1)
  miny=y1
  If(miny>y2) Then miny=y2
  If(miny>y3) Then miny=y3
  maxy=y1
  If(maxy<y2) Then maxy=y2
  If(maxy<y3) Then maxy=y3
  minx=x1
  If(minx>x2) Then minx=x2
  If(minx>x3) Then minx=x3
  maxx=x1
  If(maxx<x2) Then maxx=x2
  If(maxx<x3) Then maxx=x3
  For y=miny To maxy
    horizontalline(xpos(y,0),xpos(y,1),y)
  Next
EndFunction 0





Function gpolygon1(x1,y1,r1,g1,b1,x2,y2,r2,g2,b2,x3,y3,r3,g3,b3)
  For n=0 To height : xpos(n,0)=0 : xpos(n,1)=0 : Next
  drawedge(x1,y1,r1,g1,b1,x2,y2,r2,g2,b2)
  drawedge(x2,y2,r2,g2,b2,x3,y3,r3,g3,b3)
  drawedge(x3,y3,r3,g3,b3,x1,y1,r1,g1,b1)
  miny=y1
  If(miny>y2) Then miny=y2
  If(miny>y3) Then miny=y3
  maxy=y1
  If(maxy<y2) Then maxy=y2
  If(maxy<y3) Then maxy=y3
  minx=x1
  If(minx>x2) Then minx=x2
  If(minx>x3) Then minx=x3
  maxx=x1
  If(maxx<x2) Then maxx=x2
  If(maxx<x3) Then maxx=x3
  For y=miny To maxy
    x1=xpos(y,0)
    x2=xpos(y,1)
    r1=rpos(y,0)
    r2=rpos(y,1)
    g1=gpos(y,0)
    g2=gpos(y,1)
    b1=bpos(y,0)
    b2=bpos(y,1)
    
    gouraudstriph x1,rgb(r1,g1,b1) , x2, rgb(r2,b2,g2), y
    
  Next
EndFunction 



Function gpolygon2(x1,y1,r1,g1,b1,x2,y2,r2,g2,b2,x3,y3,r3,g3,b3)
	rgb1=rgb(r1,g1,b1)	
	rgb2=rgb(r2,g2,b2)	
	rgb3=rgb(r3,g3,b3)	
	gouraudtri x1,y1,rgb1,x2,y2,rgb2,x3,y3,rgb3
EndFunction 


Function horizontalline(x1,x2,y)
  If(x1<>x2) ;Then 
    r1=rpos(y,0)
    r2=rpos(y,1)
    g1=gpos(y,0)
    g2=gpos(y,1)
    b1=bpos(y,0)
    b2=bpos(y,1)
    If(x1>x2) ;Then
      temp=x1
      x1=x2
      x2=temp
      temp=r1
      r1=r2
      r2=temp
      temp=g1
      g1=g2
      g2=temp
      temp=b1
      b1=b2
      b2=temp
    EndIf
    rslope=((r2-r1) << 8)/(x2-x1)
    gslope=((g2-g1) << 8)/(x2-x1)
    bslope=((b2-b1) << 8)/(x2-x1)
    r=r1 << 8
    g=g1 << 8
    b=b1 << 8
    
    For x=x1 To x2
      rt=r >> 8
      gt=g >> 8
      bt=b >> 8
 ;     lRGB=(rt << 16)+(gt << 8)+bt
      ;BB_WritePixel x,y,lRGB,BB_BackBuffer()
;      Dotc x,y,lRGB
      fastdot x,y,RGB(rt,gt,bt)
      r=r+rslope
      g=g+gslope
      b=b+bslope
    Next
    
  EndIf
EndFunction 0


Function drawedge(x1,y1,r1,g1,b1,x2,y2,r2,g2,b2)
  side=0
  If(y1<>y2) ;Then
    If(y1>=y2) ;Then
      side=1
      temp=x1
      x1=x2
      x2=temp
      temp=y1
      y1=y2
      y2=temp
      temp=r1
      r1=r2
      r2=temp
      temp=g1
      g1=g2
      g2=temp
      temp=b1
      b1=b2
      b2=temp
    EndIf
    
    Scaler = (1 << 8)
    xslope=((x2-x1) << 8)/(y2-y1)
    rslope=((r2-r1) << 8)/(y2-y1)
    gslope=((g2-g1) << 8)/(y2-y1)
    bslope=((b2-b1) << 8)/(y2-y1)
    x=(x1 << 8)+xslope
    r=(r1 << 8)+rslope
    g=(g1 << 8)+gslope
    b=(b1 << 8)+bslope
    For y=y1+1 To y2
      xpos(y,side)=x >> 8
      rpos(y,side)=r >> 8
      gpos(y,side)=g >> 8
      bpos(y,side)=b >> 8
      x=x+xslope
      r=r+rslope
      g=g+gslope
      b=b+bslope
    Next
  EndIf
EndFunction 0


   //  Object Data removed..  Download full code bellow
COMMANDS USED: DIM | RESTORE | READDATA | NEW | NOT | ENTERKEY | FLUSHKEYS | TEXT | STR$ | SPACEKEY | LOCKBUFFER | POINT | CLIPRANGE | UNLOCKBUFFER | COS | SIN | GOURAUDSTRIPH | RGB | GOURAUDTRI | FASTDOT |


  Related Links:

       -  Convert BlitzBASIC Source To PlayBasic
       -  3D Development Forum


  Download:

       Code attached bellow
Download: Login to Download




Viewing Page [1] of [0]



Want More Source Codes?:



Release Type: The source code & tutorials found on this site are released as license ware for PlayBasic Users. No Person or Company may redistribute any file (tutorial / source code or media files) from this site, without explicit written permission.

 

  
     
 
       

(c) Copyright 2002 / 2024 Kevin Picone , UnderwareDesign.com  - Privacy Policy   Site: V0.99a [Alpha]