Wednesday Workshop - BlitzCoder.net

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0|509|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-

Find the Sixpence

by tobo for Workshop #027

Find the Sixpence, literally!

Cursors

AppTitle "Six pence","Merry crimbo every one!"
Graphics 600,600,32,2

SetBuffer BackBuffer()

instructions()

SeedRnd MilliSecs()

Type particle
	Field x#,y#
	Field angle#
	Field red,green,blue
End Type

Global x=100
Global y=320
Global x1=490
Global y1=320
Global xx1=-1
Global yy1=-1
Global ax1=290
Global ay1=520
Global axx1=-1
Global ayy1=-1
Global pudding
Global penny
Global px=Rnd(250)+175
Global py=Rnd(300)+175

drawpudding()
drawpenny()

While Not KeyDown(1)
	Cls
	
	DrawImage penny,px,py
	
	DrawImage pudding,100,100
		
	SetBuffer ImageBuffer(pudding)
		Color 0,0,0
		Rect x-100,y-100,10,10
		Rect x1-100,y1-100,10,10
		Rect ax1-100,ay1-100,10,10
	SetBuffer BackBuffer()
	
	If RectsOverlap(x,y,10,10,px,py,10,10) Then 
		boom
		foundpenny
	EndIf
	
	
	If RectsOverlap(x,y,10,10,x1,y1,10,10) Then 
		x=100
		y=100
	EndIf	
	
	Color 255,255,255
	Text x,y,"X"
	If KeyDown(205) And x<500 Then x=x+2
	If KeyDown(203) And x>100 Then x=x-2
	If KeyDown(200) And y>120 Then y=y-2
	If KeyDown(208) And y<520 Then y=y+2

	mouse1()
	mouse2()
	player1wins()
	player2wins()

Flip
Wend
End

;mouse1
Function mouse1()
	Color 255,255,0
	Text x1,y1,"X"
	x1=x1+xx1
	y1=y1+yy1
	If Int(Rnd(300))=5 Then xx1=Rnd(2)
	If x1<=100 Then xx1=1
	If x1>=490 Then xx1=-1
	If y1<=120 Then yy1=1
	If y1>=520 Then yy1=-1
End Function

;mouse2
Function mouse2()
	Color 0,255,0
	Text ax1,ay1,"X"
	ax1=ax1+axx1
	ay1=ay1+ayy1
	If Int(Rnd(200))=5 Then axx1=Rnd(2)
	If ax1<=100 Then axx1=1
	If ax1>=490 Then axx1=-1
	If ay1<=120 Then ayy1=1
	If ay1>=520 Then ayy1=-1
End Function



; christmas pud
Function drawpudding()
Color 255,255,255
Oval 100,100,400,400
icing=CreateImage(400,100)
GrabImage icing,100,100
Cls
Color 128,54,0
Oval 100,100,400,400
DrawImage icing,100,100
Color 255,255,255
Oval 128,170,75,75
Oval 200,170,75,75
Oval 272,170,75,75
Oval 340,170,75,75
Oval 397,170,75,75
Color 255,0,0
Oval 290,80,20,20
Oval 305,90,20,20
Color 0,255,0
For f=280 To 305
	Line 305,100,f,120
Next
For f=85 To 95
	Line 300,100,270,f
Next
FreeImage icing
pudding=CreateImage(400,450)
GrabImage pudding,100,70
Cls
End Function

; draw penny
Function drawpenny()
	penny=CreateImage(10,10)
	Color 255,255,0
	Oval 10,10,10,10
	GrabImage penny,10,10
End Function

Function boom()
	For f=1 To 30
		part.particle = New particle
		part\x#=x
		part\y#=y
		part\angle#=Rnd(360)
		part\red=Rnd(255)
		part\green=Rnd(255)
		part\blue=Rnd(255)
	Next
End Function

Function updateboom()
	For part.particle = Each particle
		part\x#=part\x# + Cos(part\angle#)*4
		part\y#=part\y# + Sin(part\angle#)*4
		Color (part\red),(part\green),(part\blue)
		Rect part\x#,part\y#,4,4
		If part\x# > 800 Or part\x#<0 Or part\y#>600 Or part\y#<0 Then Delete part
	Next
End Function

Function foundpenny()

	timer = MilliSecs()
		.wait2secs
		updateboom()
		Color 255,255,0
		Oval x-10,y-10,20,20
		Flip
		If timer+1500 > MilliSecs() Then Goto wait2secs

	For f=0 To 100
		Color Rnd(255),Rnd(255),Rnd(255)
		Text Rnd(500),Rnd(600),"MERRY CHRISTMAS"
		
		Flip
	Next
	FlushKeys
	Cls
	Color 255,255,255
	Text 220,300,"You found the six pence !"
	Flip
WaitKey
End
End Function

Function player1wins()
	If RectsOverlap(x1,y1,10,10,px,py,10,10) Then
		
			Color 255,255,0
			Oval px,py,10,10
			Flip
			Delay 500
			Oval px-25,py-25,60,60
			Flip
			Delay 500
			Oval px-50,py-50,110,110
			Flip
			Delay 500
			Oval px-75,py-75,160,160
			Flip
			Delay 500
			Oval px-100,py-100,210,210
			Color 0,0,0
			Text px-30,py,"Six Pence"
			Color 255,255,0
			Flip
			Delay 500
		
		Color 0,0,0
			For f=0 To 600 Step 10
				Rect 0,f,600,10
				Flip
			Next
		Color 255,255,255
		Text 260,300,"You lose"
		FlushKeys
		
		Flip
		WaitKey
		End
	EndIf
End Function

Function player2wins()
	If RectsOverlap(ax1,ay1,10,10,px,py,10,10) Then
			
			Color 255,255,0
			Oval px,py,10,10
			Flip
			Delay 500
			Oval px-25,py-25,60,60
			Flip
			Delay 500
			Oval px-50,py-50,110,110
			Flip
			Delay 500
			Oval px-75,py-75,160,160
			Flip
			Delay 500
			Oval px-100,py-100,210,210
			Color 0,0,0
			Text px-30,py,"Six Pence"
			Color 255,255,0
			Flip
			Delay 500
		
		
			Color 0,0,0
			For f=0 To 600 Step 10
				Rect 0,f,600,10
				Flip
			Next
		Color 255,255,255
		Text 260,300,"You lose"
		FlushKeys
		
		Flip
		WaitKey
		End
	EndIf
End Function

Function instructions()
Color 255,255,255
Cls
Text 10,50,"FIND THE SIXPENCE"
Color 255,255,0
Oval 160,50,10,10
Color 255,255,255
Text 10,100,"It's dinner, Christmas day, and the grown ups have left the table."
Text 10,115,"As usual, they're unable to finish off the Christmas pudding,"
Text 10,130,"having gorged themselves on too many brussel sprouts."
Text 10,160,"Wishing to join in the festivities, the resident house mice 'X' decide"
Text 10,175,"to embark on their own little party game."
Text 10,190,"Knowing there's a sixpence hidden somewhere in the pudding, they have"
Text 10,205,"a competition to see who can eat the pudding away to find it first."
Text 10,235,"You start on the left of the pudding and can move yourself around using"
Text 10,250,"(just for a change) the cursor keys. Be careful of one of the mice, as"
Text 10,265,"coming into contact with it will bounce you off the pudding to the side"
Text 10,280,"of the screen."
Text 10,310,"Press any key to start"
Text 80,580,"........Programmed in SINCLAIRSPECTRUMOVISION........"

FlushKeys
Flip
WaitKey
FlushKeys
Text 10,340,"....except that one."
Flip
WaitKey
Cls
End Function

S.T.I.N.K

by tobo for Workshop #029

Color the walls to match the ball.

Cursor keys

Graphics 800,600,32,2
SetBuffer BackBuffer()
HidePointer

SeedRnd MilliSecs()

Global rc1 = 255
Global rc2 = 255
Global rc3 = 0
Global bc1 = 255
Global bc2 = 0
Global bc3 = 0
Global lc1 = 0
Global lc2 = 255
Global lc3 = 0
Global tc1 = 0
Global tc2 = 0
Global tc3 = 255

Global x=400
Global y=300

Global xspeed = 1
Global yspeed = 1

Global xx=xspeed
Global yy=yspeed

Global balltimer = MilliSecs()
Global gametimer = MilliSecs()

Global ball1 = 255
Global ball2 = 255
Global ball3 = 255

Global score = 0

startgame()

While Not KeyHit(1)
Cls

	topborder()
	leftborder()
	bottomborder()
	rightborder()
	
	If KeyHit(205) Then changeright()
	If KeyHit(203) Then changeleft()
	If KeyHit(208) Then changebottom()
	If KeyHit(200) Then changetop()
		
	Color 255,255,255
	
	Text 0,0,"Time: "+score
	
	If MilliSecs()>gametimer+1000 Then 
		score=score+1
		gametimer=MilliSecs()
	End If
	
	If score = 20 Then
		xspeed=xspeed+1
		yspeed=yspeed+1
		score=score+1
	End If
	
	If score = 40 Then
		xspeed=xspeed+1
		yspeed=yspeed+1
		score=score+1
	End If
	
	If score = 60 Then wingame()

	balltime()
		
	Color ball1,ball2,ball3
	Rect x,y,20,20
	
	x=x+xx
	y=y+yy
	
	checkball()
	
Flip
Wend
End

; end game
Function endgame()
	For f=0 To 50
		Color ball1,ball2,ball3
		Rect Rnd(40)+x-10,Rnd(40)+y-10,4,4
		Flip
	Next
	Delay 500
	For f=0 To 600 Step 20
		Color 0,0,0
		Rect 0,f,800,10
		Flip
	Next
	For f=10 To 600 Step 20
		Color 0,0,0
		Rect 0,f,800,10
		Flip
	Next
	FlushKeys
	Cls
	Color 255,255,255
	Text 310,300,"Game Over"
	Text 310,320,"Your time was "+score+" seconds."
	Flip
	WaitKey
	End
End Function

;top
Function topborder()
	Color tc1,tc2,tc3
	Rect 0,0,800,30
End Function

;left
Function leftborder()
	Color lc1,lc2,lc3
	Rect 0,30,30,540
End Function

;bottom
Function bottomborder()
	Color bc1,bc2,bc3
	Rect 0,570,800,30
End Function

;right
Function rightborder()
	Color rc1,rc2,rc3
	Rect 770,30,30,540
End Function

;change right
Function changeright()
	If rc1=255 And rc2=0 And rc3=0 Then ;if red
		rc1=0:rc2=255:rc3=0 ;make green
		Else If	rc1=0 And rc2=255 And rc3=0 Then ;if green
			rc1=0:rc2=0:rc3=255 ;make blue
			Else If rc1=0 And rc2=0 And rc3=255 Then ;if blue
				rc1=255:rc2=255:rc3=0 ;make yellow
				Else If rc1=255 And rc2=255 And rc3=0 Then ;if yellow
					rc1=255:rc2=0:rc3=0 ;make red
	End If
End Function

;change left
Function changeleft()
	If lc1=255 And lc2=0 And lc3=0 Then ;if red
		lc1=0:lc2=255:lc3=0 ;make green
		Else If	lc1=0 And lc2=255 And lc3=0 Then ;if green
			lc1=0:lc2=0:lc3=255 ;make blue
			Else If lc1=0 And lc2=0 And lc3=255 Then ;if blue
				lc1=255:lc2=255:lc3=0 ;make yellow
				Else If lc1=255 And lc2=255 And lc3=0 Then ;if yellow
					lc1=255:lc2=0:lc3=0 ;make red
	End If
End Function

;change bottom
Function changebottom()
	If bc1=255 And bc2=0 And bc3=0 Then ;if red
		bc1=0:bc2=255:bc3=0 ;make green
		Else If	bc1=0 And bc2=255 And bc3=0 Then ;if green
			bc1=0:bc2=0:bc3=255 ;make blue
			Else If bc1=0 And bc2=0 And bc3=255 Then ;if blue
				bc1=255:bc2=255:bc3=0 ;make yellow
				Else If bc1=255 And bc2=255 And bc3=0 Then ;if yellow
					bc1=255:bc2=0:bc3=0 ;make red
	End If
End Function

;change top
Function changetop()
	If tc1=255 And tc2=0 And tc3=0 Then ;if red
		tc1=0:tc2=255:tc3=0 ;make green
		Else If	tc1=0 And tc2=255 And tc3=0 Then ;if green
			tc1=0:tc2=0:tc3=255 ;make blue
			Else If tc1=0 And tc2=0 And tc3=255 Then ;if blue
				tc1=255:tc2=255:tc3=0 ;make yellow
				Else If tc1=255 And tc2=255 And tc3=0 Then ;if yellow
					tc1=255:tc2=0:tc3=0 ;make red
	End If
End Function

;ball timer
Function balltime()
	If MilliSecs()>balltimer+1000 And x>200 And x<700 And y>200 And y<400 Then
		col=Int(Rnd(3)+1)
		Select col
			Case 1
			ball1 = 255
			ball2 = 0
			ball3 = 0
			Case 2
			ball1 = 0
			ball2 = 255
			ball3 = 0
			Case 3
			ball1 = 0
			ball2 = 0
			ball3 = 255
			Case 4
			ball1 = 255
			ball2 = 255
			ball3 = 0
		End Select
		balltimer=MilliSecs()
	End If
End Function

; check ball collision
Function checkball()

	;check top bounce
	If y<30 And tc1=ball1 And tc2=ball2 And tc3=ball3 Then
		yy=yspeed
		Else If y<30 Then
		endgame()
	End If
		
	;check right bounce
	If x>750 And rc1=ball1 And rc2=ball2 And rc3=ball3 Then
		xx=-xspeed
		Else If x>750 Then
		endgame()
	End If
	
	;check bottom bounce
	If y>550 And bc1=ball1 And bc2=ball2 And bc3=ball3 Then
		yy=-yspeed
		Else If y>550 Then
		endgame()
	End If
	
	;check left bounce
	If x<30 And lc1=ball1 And lc2=ball2 And lc3=ball3 Then
		xx=xspeed
		Else If x<30 Then
		endgame()
	End If
	
End Function

;start game
Function startgame()
FlushKeys
Cls
Color 255,255,255
Text 100,85,"S.T.I.N.K"
Text 100,115,"A variation on the Pong theme for the Wednesday Workshop #29."
Text 100,145,"As usual, a ball will bounce around the screen. As it does, it will change colour."
Text 100,160,"It will randomly pick from 4 colours, red, green, blue and yellow."
Text 100,190,"The walls are coloured in the same way. In order for the ball to bounce off of the"
Text 100,205,"walls, they need to be the same colour. the wall's colour can be changed using the"
Text 100,220,"relevant arrow key. They follow the above order of red, green, blue and yellow."
Text 100,250,"Try to last as long as is possible. Every 20 seconds, the game speed will increase"
Text 100,265,"and a second added to your time. Can you last a minute? ...I couldn't!"
Text 100,295,"Press H for a hint, or any other key to start the game."
Flip
WaitKey
	If KeyHit(35) Then
		Text 100,325,"Personally I found it easier to have all the walls coloured the same, and change"
		Text 100,340,"them all as required."
		Text 100,370,"Press any key to start."
		Flip
		FlushKeys
		WaitKey
	End If
End Function

;win game
Function wingame()
	For f=0 To 50
		Color 255,255,255
		Rect Rnd(40)+x-10,Rnd(40)+y-10,4,4
		Flip
	Next
	Delay 500
	For f=0 To 600 Step 20
		Color 0,0,0
		Rect 0,f,800,10
		Flip
	Next
	For f=10 To 600 Step 20
		Color 0,0,0
		Rect 0,f,800,10
		Flip
	Next
	FlushKeys
	Cls
	Color 255,255,255
	Text 310,300,"YOU LASTED A MINUTE !"
	Text 310,320,"Your time was "+score+" seconds."
	Flip
	WaitKey
	End
End Function