Wednesday Workshop

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0|455|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
The Random Game with Boxes

by mole for Workshop #125
Shoot the boxes
Mouse
;3 hour game
;Time limit: 3 hours
;Start time: 5:00
;I should stop wasting time commenting.
;This is going to be a "strem of consciousness game, i.e I'm writing random commands and seeing what it turns out. 

;//////////////////
;Start time: 17:00
;End time: 18:46
;Time elapsed: 1:46
;//////////////////

Const grx = 800, gry = 600
Const ENTER = 28
Const SPACE = 57
Graphics grx,gry,16,2
SetBuffer(BackBuffer())
SeedRnd(MilliSecs())

Type box ;Boxes are useful. My game shall have many.
	Field x,y,sx,sy ;position and dimensions
	Field dx,dy
	Field r,g,b
	Field alive
	Field image
End Type

Type player ;cant go without a player!
	Field x,y
	Field score
	Field lives
	Field alive
End Type

Type particle ;Yay! Colours!
	Field x,y,dx#,dy#,dv#
	Field r,g,b
	Field alive
End Type
	

Global p.player = New player
	p\x = grx/2
	p\y = gry/2
	p\score = 0
	p\lives = 3
	p\alive = 1
	
Global b.box
Global part.particle
Global NewEnemyTimer = MilliSecs()
Global mh1 = MouseHit(1)
Global mh2 = MouseHit(2)
Global gravity# = 3

Global Bgimage = CreateBackground(grx,gry,255,40,40)
Global intro = FadedImage(1)
Global game = FadedImage(2)
Global die = FadedImage(3)
Global instructions = FadedImage(4)
SetBuffer(BackBuffer())

While Not KeyHit(ENTER) ;title screen!
	Cls
		Title()
	Flip
Wend

ShowPointer()

While Not KeyDown(1)
	Cls
		DrawImage(game,0,0)
		mh1 = MouseHit(1)
		mh2 = MouseHit(2)
		UpdatePlayer()
		HandleMouse()
		UpdateBoxes()
		If MilliSecs() > NewEnemyTimer+Rand(2000,2750)
			CreateBox(Rand(1,3))
			NewEnemyTimer = MilliSecs()
		EndIf
		DrawHUD()
		UpdateParticles()
	Flip
Wend

Function Title()
	DrawImage(intro,0,0)
	
	Text grx*.5,gry*.3,"THE RANDOM GAME WITH BOXES",1,1
	Text grx*.5,gry*.55,"Hit ENTER to start",1,1
	Text grx*.5,gry*.55+(FontHeight()+10),"Hit ESC to exit",1,1
	Text grx*.5,gry*.8,"Hold down SPACE to see the instructions",1,1
	If KeyHit(1) Then End
		While KeyDown(SPACE)
			Cls
				DrawImage(instructions,0,0)
				Text grx*.5,gry*.3,"THE RANDOM GAME WITH BOXES",1,1
				Text grx*.5,gry*.4,"In this epic game of epic proportions, you must kill the onslaught",1,1
				Text grx*.5,(gry*.4)+(FontHeight()+2),"of boxes by clicking on them. With the mouse. Simple.",1,1
				Text grx*.5,(gry*.4)+(FontHeight()*2+2),"To exit, hit ESC.",1,1
			Flip
		Wend
End Function

Function UpdatePlayer()
	If p\alive = 1
		p\x = MouseX()
		p\y = MouseY()
		
		If p\lives <=0 Then p\alive = 0
	Else
		Dead()
	EndIf
End Function

Function HandleMouse()
	For b.box = Each box
		If b\alive = 1
			If BoxClicked(p\x,p\y,1,1,b\x,b\y,b\sx,b\sy) = True Then
				ParticleExplosion(10,b\x+(b\sx/2),b\y+(b\sy/2))
				b\alive = 0
				p\score = p\score + 10
			EndIf
		EndIf
	Next
End Function
		
	
Function BoxClicked(x1,y1,width1,height1,x2,y2,width2,height2)
	If x1 > x2 And x1 < (x2+width2) And y1 > y2 And y1 < (y2+height2) And mh1 Then
		Return True
	Else
		Return False
	EndIf
End Function

Function CreateBox(num%)
	For i = 0 To num%-1
		b.box = New box
			b\x = Rand(0,700)
			b\y = -15
			b\sx = Rand(20,60)
			b\sy = Rand(20,60)
			b\dx = Rand(-2,2)
			b\dy = Rand(2,4)
			b\r = Rand(20,255)
			b\g = Rand(20,255)
			b\b = Rand(20,255)
			b\alive = 1
			b\image = CreateBlockImage(b\sx,b\sy,Rand(20,255),Rand(20,255),Rand(20,255))
			SetBuffer(BackBuffer())
	Next
End Function

Function UpdateBoxes()
	For b.box = Each box
		If b\alive = 1 
			b\x = b\x + b\dx
			b\y = b\y + b\dy
				If b\x+b\sx > grx Then b\dx = -b\dx
				If b\x < 0 Then b\dx = -b\dx
				If b\y+sy > gry Then 
					p\lives = p\lives - 1
					b\alive = 0
				EndIf				
			Color b\r,b\g,b\b
			Rect b\x,b\y,b\sx,b\sy,1
		Else
			Delete b
		EndIf
	Next
End Function

Function Dead()

	While Not KeyHit(1)
		Cls
			DrawImage(die,0,0)
			Color 255,255,255
			Text grx*.5,gry*.2,"Oh noes!1!!1! You did not stop all of the boxes. Well, now they are going to",1,1
			Text grx*.5,(gry*.2)+(FontHeight()+2),"take over the world, or something equally evil.",1,1
			Text grx*.5,gry*.4,"By the way, you scored a whopping "+p\score+".",1,1
		Flip
	Wend
End Function

Function DrawHUD()
	Color 255,255,255
	Text 2,2,"Lives: "+p\lives
	Text 500,2,"Score "+p\score
End Function

; Functions for image independence
Function CreateBackground ( SizeX , SizeY,r,g,b )
	Image = CreateImage ( SizeX , SizeY )
		SetBuffer ImageBuffer ( Image )
			For x = 0 To SizeX/2-1
				c = (x*191/(SizeX/2)+64)
				Color c*2/3 , c*3/8 , c
				y = Float (x*SizeY)/((SizeX*2)+Sin(x))
				Rect x , y , (SizeX-x*2) , (SizeY-y*2) , True
			Next
		Return Image
End Function

Function ParticleExplosion(num%,x,y)
	For i = 0 To num*3
		part.particle = New particle
			part\x = x
			part\y = y
			part\dx# = Cos(angle)
			part\dy# = Sin(angle)
			part\dv# = Rand(1,3)
			part\alive = 1
			part\r = Rand(100,255)
			part\g = Rand(100,255)
			part\b = 0
			
			angle = angle+(360/num)
	Next
End Function

Function UpdateParticles()
	For part.particle = Each particle
		If part\alive = 1 Then
			Color part\r,part\g,part\b
			part\x = part\x + (part\dx * part\dv) 
			part\y = part\y + (part\dy * part\dv) 
			
			part\dy# = part\dy# + .1
			
			;Plot part\x,part\y
			Rect part\x,part\y,5,5,1
			
			
		Else
			Delete part
		EndIf
	Next
End Function

Function FadedImage(style)
	image = CreateImage(grx,gry)
		SetBuffer(ImageBuffer(image))
			For lines = 0 To gry-1
				Select style
					Case 1
						r = (lines/3)
						Color r,0,0
					Case 2
						g = (lines/3)
						Color 0,g,0
					Case 3
						bl = (lines/3)
						Color 0,0,bl
					Case 4
						r = lines/3
						g = lines/3
						bl = lines/3
						Color r,g,bl
				End Select
				Line 0,lines,grx,lines
			Next
		Return image
	SetBuffer(BackBuffer())
End Function
		
Function CreateBlockImage ( SizeX , SizeY,r,g,b )
	Image = CreateImage ( SizeX , SizeY )
		SetBuffer ImageBuffer ( Image )
			Color r , g , b
			Rect 0 , 0 , SizeX , SizeY , True
			Color r*2 , g*2 , b*2
			Line 0 , 0 , SizeX-2 , 0
			Line 0 , 0 , 0 , SizeY-2
			Color r/2 , g/2, b/2
			Line 0 , SizeY-1 , SizeX-1 , SizeY-1
			Line SizeX-1 , 0 , SizeX-1 , SizeY-1
			Color 255 , 255 , 255
			Plot 0 , 0
		Return Image
End Function