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 #151 items

 3d Fire Lines - PlayBasic Edition

By: Kevin Picone Added: April 17th, 2022

Category: All,3d,Vector


     I originally wrote this demo 20 years ago in #DarkBASIC so it's fitting today to bring to #PlayBasic in full glory

     The code is basically the same; visually i've added alpha addition to the lines and a globe to the line head with an alpha multiply pass to fade previous pixel date away.

     I did tweak the line logic also so that rather than randomly jump between directions it'll interpolate between them. Giving a more curved motion the lines..

     In this edition we've added smoother motion of the fire lines with alpha addition and rendering a circle to show the head of the line as well as a pass of alpha multiply.


Video:




Download: Login to Download




 Word heap - Dictionary Searching

By: Kevin Picone Added: March 24th, 2022

Category: All,Searching,Heap

    WordHeap - Used to keep a Dictionary of words / strings


    The Example test code (bellow)  loads the PlayBasic keywords file and adds all the PB commands to a heap (a static dictionary) and then does a search for each word.  The idea head is that we can build a dictionary of known words and then search if they exist or not.    While the test assumes we're cataloging words (in this case PlayBasic command names), it also support none alphanumeric characters too.  


PlayBasic Code:
; PROJECT : PlayBasic - KeyWord - Bucket
; AUTHOR  : Kev PIcone - PlayBasic TUTOR - Http://PlayBasic.com
; CREATED : 24/03/2022
; EDITED  : 25/03/2022
; ---------------------------------------------------------------------


	// Compute the location of the PlayBasic command listing
	// so we have a big list of words for something to load and test
	file$=GetPlayBasicKeyWordsPath$()

	// Load the keywords textfile to a string
	All_KeyWords$=LoadFileToString(file$)
	

	// Scan this block of text looking for the section named [Commands]
	// and then return it
	Command_KEyWords$ = GetKeywordsUnderHeading(All_KeyWords$,"[Commands]")


	//  Test adding PlayBasic keywords to our WordHeap
	Test_KeyWord_Heap(Command_KeyWords$)
	
	
	// 
	print "Test Complete - Press Space To End"
	
	; refresh display and wait for a key press before ending
	sync
	waitkey
	end
	
	
	
Function Test_KeyWord_Heap(KeyWords$)
	
	
		; Dim a string array called WORDS with an initial size of 1000
		dim Words$(1000)

		Result$	=replace$(KeyWords$,Chr$(13)+Chr$(10),",")
		count		=splittoarray(Result$,",",Words$())


		// --------------------------------------------------
		//  Add each word to the Word Heap / Dictionary
		// --------------------------------------------------
		For lp=0 to count-1
				word$		=words$(lp)
			   WordHeap_Add(Word$)
		next


		// --------------------------------------------------
		// Do a search for all the added keywords
		// --------------------------------------------------
		print " Searching For #"+Str$(Count)+" Keywords"
		starttime=timer()
		For lp=0 to count-1
				word$		=words$(lp)
				Status=WordHeap_FIND(Word$)
				#print digits$(Status,2)+">>>"+word$
				Matches+=Status
		next
		StartTime=Timer()-StartTime	
		print "Found Keywords #"+Str$(Matches)
		print ""
		print "Search Time #"+Str$(StartTime)+"  milliseconds"
		print ""
		print ""


EndFunction





Function GetKeywordsUnderHeading(KeyWords$,Heading$)
	
	cr$=Chr$(13)+chr$(10)
	Tag$=Heading$+cr$

	// Lookgfor the TAG plus the linefeed / end of line within the string
	StartPOS=instring(keywords$,tag$)
	if StartPos
		
		// If the tag is found, we step the found position to the end
		// of the found location plus the tag size in characters
		StartPos+=Len(tag$)
		
		//  search for tbhe first empty line beyond where the starting tag
		// was founf
		EndPos 		=instring(KeyWords$,Cr$+cr$,StartPos)
		
		// Check if the closing tag position was indeed after the start?
		if EndPos>StartPOs
			//  use MID$() to return this block of text from the keyword string		
			Result$		=mid$(Keywords$,StartPos,EndPos-StartPOs)
		endif
	endif
	
EndFunction  Result$





Function LoadFileToString(file$)
	if FIleexist(file$)
		local size=filesize(file$)
		local f=readnewfile(file$)
			result$=readchr$(f,size)
		closefile f
	endif
EndFunction Result$




LinkDll "shell32"
   zPriv_SHGetFolderPath(hWndOwner,nFolder,hToken,dwFlags,pszPath) Alias "SHGetFolderPathA"  as integer
EndLinkDll




Function zPriv_Highlighter_GetSpecialFolderPath(nFolderID)
   // Alloc a bank of 1024 bytes for the function to return the path in
   local Size=1024
   local ThisBank=newbank(Size)
   local Ptr=GetBankPtr(thisBank)
   local Status=zPriv_SHGetFolderPath(0,nFolderID,0,0,ptr)
   if Status=0
         // if status is 0 then the function worked
         Path$=PeekString(ptr,0)   ; peek a null termed string         
   else
         #print "error polling GetSpeicalFolderpath"
   endif
   Deletebank ThisBank
EndFunction path$




PSUB GetPlayBasicKeyWordsPath$()
		KeyWordsFile$=""

		;	constant CSIDL_LOCAL_APPDATA = $1C          ;{user}\Local App Data Settings _
		local folder$=zPriv_Highlighter_GetSpecialFolderPath($1C)
		if folderexist(folder$)
				// Get the Absolute location of the PlayBasic keywords file
				 KeyWordsFile$=Folder$+"\PlayBasic\Info\KeyWords.txt"
				if fileexist(KeyWordsFile$)=false
						KeyWordsFile$=""
				endif	
		endif
EndPSUB KeyWordsFile$






 Download

      Attached to post bellow


Download: Login to Download




 Object Echoes - Object Motion Blur

By: Kevin Picone Added: November 14th, 2021

Category: All,Effects

Object Echoes / Object Motion Blur

  Today we'll take a look a one approach for creation echo or motion blur styled effect using nothing more than some variable addition alpha blending.

PlayBasic Code:
; PROJECT : Echo or Motion Effect
; AUTHOR  : Kev Picone - http://PlayBasic.com
; CREATED : 14/11/2021
; EDITED  : 14/11/2021
; ---------------------------------------------------------------------



	// -------------------------------------------------------
	// ---------------------- MAIN LOOP ----------------------
	// -------------------------------------------------------



	type tobject
		X#(10)
		Y#(10)
		
		SpeedX#
		SpeedY#
		Colour
	endtype	

	Dim Objects(35) as tobject

	for lp=1 to getarrayelements(Objects())
			Objects(lp)= new tobject
			x#=rnd(800)
			y#=rnd(600)
			
			
			for poslp=0 to 10
				Objects(lp).x#(poslp) = x#
				Objects(lp).y#(poslp)= y#
			next
			
			Speed#=rndrange#(10,20)
			Angle#=Rnd(360)
			Objects(lp).speedx#=cos(Angle#)*Speed#
			Objects(lp).speedy#=sin(Angle#)*Speed#
			Objects(lp).Colour =rndrgb()
	next




	Screen=Newfximage(GetScreenWidth(),GetScreenheight())
	

	// -------------------------------------------------------
	do	// -------------------- MAIN LOOP ---------------------
	// -------------------------------------------------------



				for lp=1 to getarrayelements(Objects())
					x#=Objects(lp).x#(0)
					y#=Objects(lp).y#(0)

					x#+=Objects(lp).speedx#
					y#+=Objects(lp).speedy#

					//  scroll old positions down
					for oldpos=10 to 1 step -1
						Objects(lp).x#(oldpos)=Objects(lp).x#(oldpos-1)						
						Objects(lp).y#(oldpos)=Objects(lp).y#(oldpos-1)						
					next	

					if x#<0 		then x#=0 	: Objects(lp).speedx#*= -1
					if x#>800 	then x#=800 : Objects(lp).speedx#*= -1
					if y#<0 		then y#=0 	: Objects(lp).speedy#*= -1
					if y#>600 	then y#=600 : Objects(lp).speedy#*= -1

					Objects(lp).x#(0)=x#
					Objects(lp).y#(0)=y#
					
				next

		
		
		rendertoimage Screen
		cls 0
				// render 
				lockbuffer			
				; set ink pen drawing mode to Alpha Addition / Alpha ADD	
				inkmode 1+64
				
				; step through the objects and the draw the oldest ones first
				; looping to the last down to first.
				for pass=10 to 0 step -1	
					blendlevel#=cliprange#(pass/10.0,0,1)
										
					BlendColour =255-(255*BlendLevel#)
					BlendColour=Rgb(BlendColour,BlendColour,BlendColour)


					//  Draw all the objects from this pass in one group
					for lp=1 to getarrayelements(Objects())
						x#=Objects(lp).x#(pass)
						y#=Objects(lp).y#(pass)

						//  Compute the objects colour with the fade level
						ThisRGB = rgbAlphamult (Objects(lp).Colour, BlendColour)
						
						// draw it as a circle
						circlec x#,y#,32,true,ThisRGB
					next
				next
			
				unlockbuffer				
	
				; set inkmode back to normal
				inkmode 1	
				rendertoscreen
				drawimage screen,0,0,false
				
	
		sync
		wait 10		
	loop spacekey()

 


PlayBasic LIVE - Overview of Object Echo / Motion Blur Example - (2021-11-16)

 





 Point On Line - Line Hit Point - Point Intersect Line

By: Kevin Picone Added: October 4th, 2021

Category: All,Maths,Collisions,Intersection

    Point On Line / Line Hit Point /  Point Intersect Line

    This code defines a tLines data type that consists of four floating point numbers (x1#, y1#, x2#, y2#). It then creates an array of 100 elements of this data type called Lines.

    It then initializes each element of the Lines array by assigning random values to its x1#, y1#, x2#, and y2# fields.

    Afterwards, the code enters an infinite loop that does the following:

     Clears the screen

     Gets the current mouse position and assigns it to variables mx# and my#

     Iterates through each element lp in the Lines array and does the following:

     Assigns the x1#, y1#, x2#, and y2# fields of the current element to local variables x1#, y1#, x2#, and y2#, respectively

     Calls the Point_On_Line function, passing it mx#, my#, x1#, y1#, x2#, and y2# as arguments. The return value of this function is a boolean that indicates whether the point (mx#, my#) is on the line defined by the points (x1#, y1#) and (x2#, y2#).

     If the return value of Point_On_Line is True, it sets the current drawing color to a random RGB value.

     It then draws a line between the points (x1#, y1#) and (x2#, y2#) using the current drawing color.

     Waits for the vertical blanking interval (to prevent tearing)

     Loops back to the beginning if the space key is not pressed

    The code then defines the Point_On_Line function, which takes six floating point arguments: pointx#, pointy#, x1#, y1#, x2#, and y2#. It returns a boolean value indicating whether the point (pointx#, pointy#) is on the line defined by the points (x1#, y1#) and (x2#, y2#).

    The function first checks if the point (pointx#, pointy#) is at least parallel to the line defined by the points (x1#, y1#) and (x2#, y2#). If it is, it calculates the nearest point on the line to (pointx#, pointy#) and checks if the distance between the two points is within a certain tolerance (1 in this case). If the distance is within the tolerance, the function returns True, otherwise it returns False. If the point (pointx#, pointy#) was not parallel to the line, the function immediately returns False.

PlayBasic Code:
; PROJECT : POint On Line
; AUTHOR  : PlayBasic TUTOR
; CREATED : 4/10/2021
; EDITED  : 5/10/2021
; ---------------------------------------------------------------------

	type tlines
		x1#,y1#,x2#,y2#
	endtype

	Dim Lines(100) as tLines	

	for lp =0 to 100
		
			Lines(lp).x1 = rnd(800)
			Lines(lp).y1 = rnd(600)
			Lines(lp).x2 = rnd(800)
			Lines(lp).y2 = rnd(600)


	next

	do
		cls		
		
				mx#=mousex()
				my#=mousey()
		
				for lp =0 to 100
					
						x1#=lines(lp).x1
						y1#=lines(lp).y1
						x2#=lines(lp).x2
						y2#=lines(lp).y2
						ink -1
						if Point_On_line(mx#,my#,x1#,y1#,x2#,y2#)		
									ink rndrgb()		
						endif
						line x1#,y1#,x2#,y2#
				next

		sync		
loop spacekey()

end	




function Point_On_line(pointx#,pointy#,x1#,y1#,x2#,y2#)
	
		// compute nearest point along the line		
	   dx31#=PointX#-x1#
	   dx21#=x2#-x1#
	   dy31#=PointY#-y1#
	   dy21#=y2#-y1#
	
		l#=((dx31#*dx21#)+(dy31#*dy21#)) / ((dx21#*dx21#)+(dy21#*dy21#))
				
		// see if our point at least lies parallel with our line
		status = l#>=0 and L#<=1	
		if Status

				// if so, we compute the nearest point on the line
				x#=x1#+(dx21#*l#)
				y#=y1#+(dy21#*l#)

				// then get the distance from the line to our point.  
				Dist# = getdistance2d(x#,y#,pointx#,pointy#)

				//  check if it's within a tolerance of 1, might need
				// to be tweaked  
				Status = Dist#<=1
		
		endif
	
EndFunction status





COMMANDS USED: DIM | RND | CLS | MOUSEX | MOUSEY | INK | RNDRGB | LINE | SYNC | SPACEKEY | AND | GETDISTANCE2D |




 Destructible Aliens From Space

By: Kevin Picone Added: March 21st, 2021

Category: All,Arcade,Games,Collision,Sprite Collision,Sprites


(Destructible) Aliens From Space - (2021-03-31 )

Destructible Aliens From Space is Space Invaders Styled game with destructible player , aliens and bunkers.. Destroy them pixel by pixel.




Download: Login to Download




 Twitch Face 2006

By: Kevin Picone Added: July 13th, 2020

Category: All,Sprite,effect,Alpha Blending


PlayBasic LIVE - Revisiting Twitch Face Demo - (2020-07-14 )

Here we're taking a look back a demo called Twitch Face from way back in February of 2006. The demo is various stacked blends that 'twitch' or are offset from each other.


Video:





Download:


Get Source Code





 MakeMaskedCircleImage Function

By: Kevin Picone Added: July 5th, 2020

Category: All,Image

MakeMaskedCircleImage Function

     This function grabs a chunk from another image, then draws a circle to alpha channel to mask out the bits we want, giving up a 007 sort of circle reveal effect.


Video:



PlayBasic Code:
	screen = makeBackDrop()
	
	setfps 30
	
	do	
		cls $304050
		
		
		
		mx=mousex()
		my=mousey()

		rendertoimage screen		
		mask=MakeMaskedCircleImage(mx,my,50,5)
		rendertoscreen
		
		drawimage mask,mx,my,true

		deleteimage mask

		sync
	loop spacekey()

	
	
	
	
Function MakeMaskedCircleImage(Xpos,Ypos,Size,Pad=5)

		oldinkmode =GetInkmode()		
	
		RadiusX=Size
		RadiusY=Size
		Width	=Pad+(RadiusX*2)+Pad
		Height=Pad+(RadiusY*2)+Pad	
	
		Mask=NewFximage(Width,height,true)
		OldSurface=getsurface()


		Xpos-=Pad
		Ypos-=Pad

		copyrect OldSurface,xpos,ypos,Xpos+Width*2,Ypos+Height,Mask,0,0
	
		rendertoimage Mask
			inkmode 1+512
			Circlec Width/2,Height/2,Size,true,$ff000000	
		
		rendertoimage OldSurface	
		inkmode OldInkMode	
	



EndFunction Mask






Function MakeBackDrop()
	
			Screen=NewFXImage(800,600)
		rendertoimage Screen
		shadebox 0,0,800,600,$112233,$445566,$aa88bb,$332288
		
		loadfont  "veranda",2,100,0
		setfont 2
		centertext 400,240,"Hello World"
		setfont 1
		rendertoscreen
		
		
		rgbmaskimage Screen,$00ffffff
EndFunction Screen
	







 Get Array Handle (HandleOf function)

By: Kevin Picone Added: June 27th, 2020

Category: All,Arrays,Source Code

Get Array Handle (HandleOf function)

     This function returns the HANDLE (The unique bank ID) from any Integer array that's passed into it.

PlayBasic Code:
		dim table(100)
		
		print handleof(table())
		
		sync
		waitkey
		
		
		
Psub  HandleOf(me())
EndPsub Me()




COMMANDS USED: DIM | PRINT | SYNC | WAITKEY |




Viewing Page [2] of [19]



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]