Entries by Forklift_Fred/Wed. Workshop (SoCoder)

Forklift_Fred's Wednesday Workshop Entries
More of Forklift_Fred's stuff.
Blog, Profile, Showcases, Code snippets, Articles, W.W Entries, Recent Posts

Content posted during the past 12 weeks.

9 Entries Latest Entries First
Posty

Created for Workshop #160 | Comments (5) | No Votes

Grab the postbag, then collect all the letters.

Cursors

Click to Download this entry

Steady Hands

Created for Workshop #155 | Comments (0) | No Votes

Move the hoop over the line without touching it.

Mouse, scrollwheel to turn the hoop.

Click to Download this entry

Confetti

Created for Workshop #141 | Comments (0) | No Votes

Catch all the confetti

Mouse

Click to Download this entry

Rectangle Racer

Created for Workshop #141 | Comments (0) | No Votes

Make your way through the rectangular tunnel.

Cursors

Click to Download this entry

Heart Attack

Created for Workshop #138 | Comments (0) | No Votes

Shoot the arrows through the hearts.

Mouse (Stylus!)

Click to Download this entry

Time Leaks

Created for Workshop #127 | Comments (0) | No Votes

Catch the time leaks with the mouse.

Mouse

Show Sourcecode for this entry

Hide Sourcecode

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;										;;
;;			One Hour Challenge			;;
;;          ==================          ;;
;;                                      ;;
;;           By Forklift_Fred           ;;
;;   For SoCodor's Wednesday Workshop   ;;
;;      #127 (28/11/07 - 04/12/07)      ;;
;;	Start 	- 19:25						;;
;;	Finish	- 20:25						;;
;;                                      ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

AppTitle "60 Minutes"

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

Global time=MilliSecs()
Global rate=1000
Global advance=True
Global score=0

SeedRnd MilliSecs()

Type pixel
	Field x
	Field y
	Field age
	Field speed_x
	Field speed_y
End Type

Type clock
	Field x
	Field y
	Field direction
	Field rate
	Field prev
End Type

Cls
Text GraphicsWidth()/2,(GraphicsHeight()/2)-30,"Use your mouse shield to catch the time leaks",1,1
Text GraphicsWidth()/2,(GraphicsHeight()/2)-15,"Click to send a pulse but you must have enough power first",1,1
Text GraphicsWidth()/2,(GraphicsHeight()/2)+30,"Click to start",1,1
Text GraphicsWidth()/2,(GraphicsHeight()/2)+30,"______________",1,1

Flip
WaitMouse

Global start=MilliSecs()
CreateClock()
While Not KeyDown(1) Or MilliSecs()>start+60000
	Cls
	If MilliSecs()=>time+(rate/3) Then
		time=MilliSecs()
		advance=True
	Else
		advance=False
	End If
	UpdateClocks()
	UpdatePixels()
	UpdateShield()
	Color 128,128,255
	Text 10,10,score
	Flip
Wend
Color 255,0,0
Text GraphicsWidth()/2,(GraphicsHeight()/2)-15,"GAME OVER",1,1
Text GraphicsWidth()/2,(GraphicsHeight()/2)-15,"_________",1,1
Text GraphicsWidth()/2,(GraphicsHeight()/2),"You scored "+score,1,1
Text GraphicsWidth()/2,(GraphicsHeight()/2)+30,"(Click to exit)",1,1
Flip
WaitMouse()

End

Function UpdateShield()
	x=MouseX()
	y=MouseY()
	Color 255,128,128
	Oval x-25,y-25,50,50,0
End Function

Function CreateClock()
	clock.clock=New clock
	clock\x=Rnd(50,GraphicsWidth()-50)
	clock\y=Rnd(50,GraphicsHeight()-50)
	clock\direction=Rnd(360)
	clock\rate=Rnd(rate-200,rate+200)
	clock\prev=MilliSecs()
End Function

Function UpdateClocks()
	For clock.clock=Each clock
		clock\direction=clock\direction+1
		If clock\direction=361 Then clock\direction=0
		If MilliSecs()>clock\prev+clock\rate Then
			clock\prev=MilliSecs()
			SpawnPixel(clock\x,clock\y,clock\direction)
		End If
		Color 255,255,255
		Oval clock\x-25,clock\y-25,50,50,1
		Color 255,0,0
		Line clock\x,clock\y,clock\x+Cos(clock\direction)*25,clock\y+Sin(clock\direction)*25
	Next
End Function

Function UpdatePixels()
	For pixel.pixel=Each pixel
		pixel\x=pixel\x+pixel\speed_x
		pixel\y=pixel\y+pixel\speed_y
		If advance Then pixel\age=pixel\age-25
		If pixel\age<=0 Then
			Delete pixel
			Exit
		Else
			Color pixel\age,pixel\age,pixel\age
			Rect pixel\x,pixel\y,rate*4/1000,rate*4/1000
		End If
		If Abs(pixel\x-MouseX())<50 And Abs(pixel\y-MouseY())<50 Then
			score=score+pixel\age
			Delete pixel
			MoveMouse(Rnd(25,GraphicsWidth()-25),Rnd(25,GraphicsHeight()-25))
		End If
	Next
End Function

Function SpawnPixel(x,y,d)
	pixel.pixel=New pixel
	pixel\x=x+Cos(d)*25
	pixel\y=y+Sin(d)*25
	pixel\speed_x=(rate*Cos(d))/1000
	pixel\speed_y=(rate*Sin(d))/1000
	pixel\age=255
End Function

Catch A Cold

Created for Workshop #127 | Comments (0) | No Votes

Catch a Cold!

Cursors

Show Sourcecode for this entry

Hide Sourcecode

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;										;;
;;			One Hour Challenge			;;
;;          ==================          ;;
;;		   Take 2: Catch A Cold			;;
;;                                      ;;
;;           By Forklift_Fred           ;;
;;   For SoCodor's Wednesday Workshop   ;;
;;      #127 (28/11/07 - 04/12/07)      ;;
;;	Start 	- 19:15						;;
;;	Finish	- 20:24						;;
;;                                      ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

AppTitle "60 Minutes - Catch A Cold"

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

Type letter
	Field x
	Field y
	Field speed
	Field letter
	Field red
	Field green
	Field blue
End Type

Global fntArial,fntArialB,fntArialI,fntArialU 

; Load fonts to a file handle variables 
fntArial=LoadFont("Arial",24) 
fntArialB=LoadFont("Arial",18,True) 
fntArialI=LoadFont("Arial",32,False,True) 
fntArialU=LoadFont("Arial",14,False,False,True) 
SetFont fntArialB

SeedRnd MilliSecs()

t=MilliSecs()
dt=t+1000
player=400
time=100
wt=101

While Not KeyHit(1)
	Cls
	If MilliSecs()>dt Then
		t=dt
		dt=t+1000
		time=time-1
	End If
	If t>wt Then
		wt=t-Rnd(0,5)
		letter.letter=New letter
		letter\x=Rnd(0,600)
		letter\y=0
		letter\speed=Rnd(1,5)
		letter\letter=Rnd(65,90)
		letter\red=Rnd(10,245)
		letter\green=Rnd(10,245)
		letter\blue=Rnd(10,245)
	End If
	If KeyDown(203) Then player=player-3
	If KeyDown(205) Then player=player+3
	If player<0 Then player=0
	If player>800 Then player=800
	For letter.letter=Each letter
		letter\y=letter\y+letter\speed
		Color letter\red,letter\green,letter\blue
		Text letter\x,letter\y,Chr$(letter\letter),1,1
		If letter\y=>590 Then
			If letter\x>player-(StringWidth("___")/2) And letter\x<player+(StringWidth("___")/2) Then
				score=score+1
				If letter\letter=67 Then
					score=score+1
					c=c+1
					If c=10 Then c=9
				Else If letter\letter=79 Then
					score=score+1
					o=o+1
					If o=10 Then o=9
				Else If letter\letter=76 Then
					score=score+1
					l=l+1
					If l=10 Then l=9
				Else If letter\letter=68 Then
					score=score+1
					d=d+1
					If d=10 Then d=9
				End If
				If c>0 And o>0 And l>0 And d>0 Then
					c=c-1
					o=o-1
					l=l-1
					d=d-1
					score=score+1000
					colds=colds+1
				End If
				lastletter=letter\letter
				Delete letter
			End If
		End If
	Next
	Color 255,255,255
	Text player,590,"___",1,1
	Color 180,200,255
	Rect 0,0,800,22,1
	Color 0,0,0
	Text 3,3,time
	Text 793-StringWidth(RSet(score,4)),3,RSet(score,4)
	Color 0,0,255
	If c>0 Then Text 120,3,"C"
	If o>0 Then Text 130,3,"O"
	If l>0 Then Text 140,3,"L"
	If d>0 Then Text 150,3,"D"
	Color 255,255,255
	Text 120,20,c
	Text 130,20,o
	Text 140,20,l
	Text 150,20,d
	Color 255,0,0
	Text 400,3,"Last letter caught : "+Chr$(lastletter),1,0
	If time=0 Then
		Color 180,200,255
		Rect 300,250,200,140
		Color 255,0,0
		Text 400,280,"GAME OVER",1,1
		Text 400,305,"Your Score : "+score,1,1
		Text 400,330,"Colds Caught : "+colds,1,1
		Text 400,360,"Press Enter To Play Again",1,1
		Flip
		FlushKeys()
		While Not KeyDown(28)
		Wend
		time=100
		For letter.letter=Each letter
			Delete letter
		Next
		score=0
		c=0
		o=0
		l=0
		d=0
		colds=0
	End If
	Flip
Wend
End

Halloween Maze

Created for Workshop #122 | Comments (0) | No Votes

Guide the witch through the maze to grab all her ingredients. Pumpkins hold power-ups so be sure to smash them open! There's a clock that freezes time, a broomstick that lets you fly over the maze, a map of the maze (that sadly isn't working yet) and a large lantern for double visibility! Unfortunately for you, two pumpkins are empty, but there's nothing to lose.

Cursor Keys and Space to Smash.

Click to Download this entry

Think Pink

Created for Workshop #106 | Comments (0) | No Votes

Race against the clock to keep the other colours at bay...

Mouse

Show Sourcecode for this entry

Hide Sourcecode

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                      ;;
;;              Think Pink!             ;;
;;              ===========             ;;
;;                                      ;;
;;           By Forklift_Fred           ;;
;;   For SoCodor's Wednesday Workshop   ;;
;;      #106 (27/06/07 - 04/07/07)      ;;
;;                                      ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

AppTitle "Think Pink!"

Graphics 640,480,32,2
arial64=LoadFont("Arial",64,True,False,False)
arial32=LoadFont("Arial",32,True,False,False)
ClsColor 100,0,100
Cls
mode=0
SetFont arial64
Color 255,0,255
Text 320,100,"Select Screen Mode",1,0
SetFont arial32
Text 320,160,"(1=Full Screen, 2=Window)",1,0
While mode<49 Or mode>50
mode=GetKey()
Wend
Graphics 640,480,32,mode-48
ClsColor 100,0,100
arial32=LoadFont("Arial",32,True,False,False)
arial24=LoadFont("Arial",24,True,False,False)
arial64=LoadFont("Arial",64,True,False,False)



Type tile
Field x
Field y
Field colour
End Type

Type flippingtile
Field x
Field y
Field colour1
Field colour2
Field steps
End Type

Global score=0
Global tilesize
Global level=0
Global pink#,blank#,colour#,total#,ratio#
Global timerstep=1
Global highscore

point=CreateImage(12,21)
SetBuffer ImageBuffer(point)
For y=0 To 20
	For x=0 To 11
		Read n
		If n=3 Then Exit
		If n=0 Then Color 250,128,250
		If n=1 Then Color 128,50,128
		If n=2 Then Color 0,0,0
		Plot x,y
	Next
Next
MaskImage point,0,0,0

Global multi=CreateImage(60,480)
SetBuffer ImageBuffer(multi)
For y=0 To 480
	For x=0 To 60
		SetColour(Rnd(0,8))
		Plot x,y
	Next
Next

SetBuffer BackBuffer()
HidePointer

Dim sizes(15)
For n=1 To 15
Read sizes(n)
Next

Dim qtys(15)
For n=1 To 15
Read qtys(n)
Next

.intro
SetFont arial64
Cls
Color 255,0,255
Text 320,10,"Think Pink!",1
SetFont arial24
Text 320,100-10,"Race against the clock to keep the other colours at bay...",1,1
Text 320,125-10,"As the time ticks down, more squares will appear...",1,1
Text 320,150-10,"It is your job to click on them to flip them over to the pink side!",1,1
Text 320,190-10,"For every colour you change you will gain a point but...",1,1
Text 320,215-10,"Every pink square you click will change to another colour",1,1
Text 320,240-10,"and loose you 5 points!",1,1
Text 320,275-10,"Watch the bar on the right of the screen, if it drops below 50%",1,1
Text 320,300-10,"then you are in danger of failing the level and it's game over.",1,1
Text 320,325-10,"But if it reaches 100% (meaning all the squares are pink)",1,1
Text 320,350-10,"then you will gain bonus points. The longer it stays at 100%",1,1
Text 320,375-10,"then more bonus you gain!",1,1
Text 320,410-10,"Each level has smaller squares and more of them...",1,1
Text 320,435-5,"Have you got what it takes? Press a key to find out...",1,1
SetFont arial32
Color 255,128,255
Text 320,460,"Current highscore: "+highscore,1,1
Flip
WaitKey()


SetFont arial32
.start

SeedRnd MilliSecs()

level=level+1
If level=16 Then
	level=1
	timerstep=timerstep+1
End If
Global timer=30000/timerstep
Global newtime
Global oldtime=MilliSecs()
tilesize=sizes(level)
Global count=(480/tilesize)-1

Dim grid.tile(count,count)
Dim flippers.flippingtile(count,count)

For tile.tile=Each tile
	Delete tile
Next

For flippingtile.flippingtile=Each flippingtile
	Delete flippingtile
Next

For x=0 To count
	For y=0 To count
		grid(x,y)=New tile
		grid(x,y)\x=x
		grid(x,y)\y=y
		grid(x,y)\colour=0
	Next
Next

For n=1 To qtys(level)
	go=True
	While go
		x=Rand(0,count)
		y=Rand(0,count)
		If grid(x,y)\colour=0 Then
			grid(x,y)\x=x
			grid(x,y)\y=y
			grid(x,y)\colour=Rand(1,7)
			If grid(x,y)\colour=3 Then
				grid(x,y)\colour=0
				go=True
			Else
				go=False
			End If
		End If
	Wend
Next



While Not KeyHit(1)
Cls
CheckMouse(MouseX()/tilesize,MouseY()/tilesize)
UpdateTiles()
UpdateTimer()
DrawGrid()
DrawTimer()
UpdateRatio()
DrawImage point,MouseX(),MouseY()
If timer=<0 Then
	For x=0 To 25
		Color 0+(x*10),0,0+(x*10)
		Rect 200-25+x,190-25+x,240+50-x*2,100+50-x*2,0
	Next
	Color 0,0,0
	Rect 200,190,240,100,1
	Color 205,50,205
	Text 320,210,"TIME UP!",1,1
	If ratio<50 Then
		Text 320,241,"Level Failed!",1,1
	Else
		Text 320,241,"Level Complete!",1,1
	End If
	Text 320,272,"Level Bonus "+Int(ratio),1,1
	score=score+ratio
	Flip
	WaitKey
	If ratio<50 Then
		For x=0 To 25
			Color 0+(x*10),0,0+(x*10)
			Rect 200-25+x,190-25+x,240+50-x*2,100+50-x*2,0
		Next
		Color 0,0,0
		Rect 200,190,240,100,1
		Color 205,50,205
		Text 320,210,"Final Score",1,1
		Text 320,241,"(Level "+level*timerstep+")",1,1
		Text 320,272,score,1,1
		Flip
		WaitKey
		If score>highscore Then
			For x=0 To 25
				Color 0+(x*10),0,0+(x*10)
				Rect 200-25+x,190-25+x,240+50-x*2,100+50-x*2,0
			Next
			Color 0,0,0
			Rect 200,190,240,100,1
			Color 205,50,205
			Text 320,210,"New Highscore!",1,1
			Text 320,241,"(By "+(score-highscore)+" Points)",1,1
			Text 320,272,score,1,1
			Flip
			highscore=score
			WaitKey
		End If
		level=0
		score=0
		Goto intro
	End If
	Goto start
End If

Flip
Wend
WaitKey
End

Function CheckMouse(x,y)
If MouseHit(1) And x*tilesize<((count+1)*tilesize) Then
	If grid(x,y)<>Null And flippers(x,y)=Null Then FlipTile(x,y)
End If
End Function

Function UpdateTiles()
	For ftile.flippingtile=Each flippingtile
		ftile\steps=ftile\steps-(tilesize/10)
		If ftile\steps=<-tilesize Then
			grid(ftile\x,ftile\y)\x=ftile\x
			grid(ftile\x,ftile\y)\y=ftile\y
			grid(ftile\x,ftile\y)\colour=ftile\colour2
			Delete ftile
		End If
	Next
End Function

Function UpdateTimer()
newtime=MilliSecs()
dtime=oldtime-newtime
If Int(timer/1000)<>Int((timer+dtime)/1000) Then
	For n=1 To level
		FlipTile(Rand(0,count),Rand(0,count),False)
	Next
End If
timer=timer+dtime
oldtime=newtime
End Function

Function DrawGrid()
For y=0 To count
	For x=0 To count
		If grid(x,y)<>Null Then SetColour(grid(x,y)\colour)
		Rect x*tilesize,y*tilesize,tilesize,tilesize,1
	Next
Next
For ftile.flippingtile=Each flippingtile
	If ftile\steps>0 Then
	SetColour(ftile\colour1)
		Oval ftile\x*tilesize,(ftile\y*tilesize)+(tilesize-ftile\steps)/2,tilesize,ftile\steps,1
	Else
	SetColour(ftile\colour2)
		Oval ftile\x*tilesize,(ftile\y*tilesize)+(tilesize/2)+(ftile\steps/2),tilesize,Abs(ftile\steps),1
	End If
Next
End Function

Function DrawTimer()
timerlength=timer/72
For x=0 To 25
	Color 255,0+(x*10),255
	Rect 500+x,450-timerlength,52-x*2,timerlength,0
Next

Color 200,50,200
Text 526,450,Int(timer/1000),1
Text 500,0,score
End Function
	

Function UpdateRatio()
pink=0
blank=0
colour=0
total=0
For tile.tile=Each tile
	If tile\colour=3 Then
		pink=pink+1
	Else If tile\colour=0 Then
		blank=blank+1
	Else
		colour=colour+1
	End If
Next
total=pink+colour
ratio=(100/total)*pink
If ratio=100 Then score=score+(100*level)
DrawImage multi,600,0
length#=(4.8)*ratio
top#=480-length
Color 255,0,255
Rect 600,top,42,length,1
For x=0 To 12
	Color 0+(x*20),0,0+(x*20)
	Rect 600+x,top,42-x*2,length,0
Next
Color 255,128,255
Text 620,top+2,Int(ratio),1
End Function

Function FlipTile (x,y,sc=True)
	flippers(x,y)=New flippingtile
	flippers(x,y)\x=x
	flippers(x,y)\y=y
	flippers(x,y)\steps=tilesize+1
	flippers(x,y)\colour1=grid(x,y)\colour
	If grid(x,y)\colour=3 Then
		flippers(x,y)\colour2=Rand(1,7)
		If sc Then score=score-5
	Else If grid(x,y)\colour=0 Then
		If Not sc flippers(x,y)\colour2=Rand(1,7)
	Else
		flippers(x,y)\colour2=3
		If sc Then score=score+1
	End If
	grid(x,y)\colour=0
End Function

Function SetColour(n)
Select n
Case 1	; Blue
	Color 0,0,255
Case 2	; Red
	Color 255,0,0
Case 3	; Magenta
	Color 255,0,255
Case 4	; Green
	Color 0,255,0
Case 5	; Cyan
	Color 0,255,255
Case 6	; Yellow
	Color 255,255,0
Case 7	; White
	Color 255,255,255
Case 0	; "Black"
	Color 100,0,100
End Select
End Function

.pointer
Data 1,3
Data 1,1,3
Data 1,0,1,3
Data 1,0,0,1,3
Data 1,0,0,0,1,3
Data 1,0,0,0,0,1,3
Data 1,0,0,0,0,0,1,3
Data 1,0,0,0,0,0,0,1,3
Data 1,0,0,0,0,0,0,0,1,3
Data 1,0,0,0,0,0,0,0,0,1,3
Data 1,0,0,0,0,0,0,0,0,0,1,3
Data 1,0,0,0,0,0,0,1,1,1,1,1
Data 1,0,0,0,1,0,0,1,3
Data 1,0,0,1,1,0,0,1,3
Data 1,0,1,2,2,1,0,0,1,3
Data 1,1,2,2,2,1,0,0,1,3
Data 1,2,2,2,2,2,1,0,0,1,3
Data 2,2,2,2,2,2,1,0,0,1,3
Data 2,2,2,2,2,2,2,1,0,0,1,3
Data 2,2,2,2,2,2,2,1,0,0,1,3
Data 2,2,2,2,2,2,2,2,1,1,3

.sizes
Data 96,80,60,48,40,34,32,30,24,22,20,16,15,12,10
.qtys
Data 3,5,8,11,16,24,35,51,75,110,161,236,346,507,743