Entries by mike_g/Wed. Workshop (SoCoder)

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

Content posted during the past 12 weeks.

6 Entries Latest Entries First
Game of Life

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

Game of Life.. Not the board game. The "Not much of a game, is it!!?" one..

It's a screensaver!!!!!

Click to Download this entry

Shoot-Em-All

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

Shoot the Invaders!

Cursors and Spacebar

Show Sourcecode for this entry

Hide Sourcecode

Graphics 320, 240, 32, 2
SetBuffer BackBuffer()

Const NUM_STARS = 120
Const DARKEN = 10
Const TRAIL_SIZE = 5
Const PIC_PLAYER = 1
Const PIC_GREENIE =2 
Const PLAYER_SPEED =2

Const SHOT_BULLET = 0
Const SHOT_FLAME = 1
Const SHOT_LASER = 2

Dim pics(4) ;Image Handles

Type star
	Field x#, y#, z
End Type

Type alien
	Field x, y
	Field health
	Field pic
End Type
Global a_counter, a_inc=1

Type fire
	Field x, y
	Field side
	Field spd
	Field kind
End Type

Type player
	Field x, y
	Field counter
	Field lives
	Field level 
	Field score
	Field shot
End Type

Type frag
	Field x#[TRAIL_SIZE]
	Field y#[TRAIL_SIZE]
	Field direction
	Field speed
	Field falloff
End Type 

Dim palette(256)
For i = 0 To 256
	r=r+5:	g=g+3:	b=b+2
	If r > 255 Then r=255
	If g > 255 Then g=255
	If b > 255 Then b=255
	palette(i) = (r Shl 16)+(g Shl 8)+b
Next

Dim sine#(360), cosine#(360)
For i = 0 To 360
	sine#(i)=Sin(i)
	cosine#(i)=Cos(i)
Next

InitStarField()
CreateSprites()
InitGame()
InitLevel()

Repeat
	Cls 
	StarField(4)
	DrawSprites()
	DrawShots()
	Collision()
	DrawExplosions()
	MoveSprites()
	PlayerInput()
	UpdatePlayer()
	Flip
Forever

;------------------------------------------------;
;************** STAR FIELD **********************; 
;------------------------------------------------;
Function StarField(speed#)
	LockBuffer
	For s.star = Each star
		s\y# = s\y# + Float(s\z) / 500.0 * speed#
		If s\y# > GraphicsHeight()-1
			s\y#=-1
			s\x#=Rnd(0, GraphicsWidth()-1)
			s\z=Rand(0, 255)
		Else
			WuPixel(s\x#, s\y#, s\z)
		EndIf 
	Next	
	UnlockBuffer
End Function

Function InitStarField()
	For i = 1 To NUM_STARS
		s.star = New star 
		s\y#=Rnd(0, GraphicsHeight()-1)
		s\x#=Rnd(0, GraphicsWidth()-1)
		s\z=Rand(0, 255)		
	Next
End Function 

Function WuPixel(x_pos#, y_pos#, brightness)
	Local i_x% = Floor(x_pos#)
	Local i_y% = Floor(y_pos#)
	Local f_x# = x_pos# - i_x
	Local f_y# = y_pos# - i_y
	Local t_l% = (1.0 - f_x#) * (1.0 - f_y#) * brightness
	Local t_r% = f_x# * (1 - f_y#) * brightness
	Local b_l% = (1.0 - f_x#) * f_y# * brightness
	Local b_r% = f_x# * f_y# * brightness
	
	WritePixel(i_x, i_y, t_l + (t_l Shl 8) + (t_l Shl 16))
	WritePixel(i_x+1, i_y, t_r + (t_r Shl 8) + (t_r Shl 16))
	WritePixel(i_x, i_y+1, b_l + (b_l Shl 8) + (b_l Shl 16))
	WritePixel(i_x+1, i_y+1, b_r + (b_r Shl 8) + (b_r Shl 16))
End Function 
;------------------------------------------------;
;************** LOAD IMAGES *********************; 
;------------------------------------------------;
Function CreateSprites()
	pics(1) = CreateImage(12, 12)
	MakeSprite(pics(1), $FFAAAAAA)
	pics(2) = CreateImage(12, 12)
	MakeSprite(pics(2), $FF2222AA)
	pics(3) = CreateImage(12, 12)
	MakeSprite(pics(3), $FF779922)
	pics(4) = CreateImage(12, 12)
	MakeSprite(pics(4), $FF772299)
End Function 

Function MakeSprite(sprite_han, col)
	For y=0 To 11
		bit=1
		Read scan_line 
		col = Darken(col)
		For x=0 To 11
			If scan_line And bit Then WritePixel(x, y, col, ImageBuffer(sprite_han)) 
			bit = bit Shl 1	
		Next
	Next
End Function

Function Darken(col)
	r = ((col Shr 16) And 255) - DARKEN
	If r < 0 Then r = 0
	g = ((col Shr 8) And 255) - DARKEN
	If g < 0 Then g = 0
	b = (col And 255) - DARKEN
	If b < 0 Then b = 0
	Return (r Shl 16) + (g Shl 8) +b
End Function

Data 96, 240, 144, 1170, 1434, 1530, 4095, 3315, 4095, 2046, 924, 780    ;Player
Data 240, 504, 1020, 1266, 3315, 4095, 4095, 1020, 504, 1020, 1782, 2709 ;Invader
Data 2049, 2289, 2046, 1638, 2046, 3591, 3075, 3075, 3591, 1542, 780, 408;Biter
Data 504, 3069, 3069, 4095, 3171, 3687, 4095, 3075, 3591, 3069, 3069, 504;Blocker

;------------------------------------------------;
;************** INIT STUFF **********************; 
;------------------------------------------------;
Function InitGame()
	p.player = New player
	p\lives = 3: p\level = 1: p\score = 0
	
End Function 

Function InitLevel()
	p.player = First player 
	p\x = 154: p\y = 210
	For y=0 To 5+level
		For x=0 To 14
			a.alien = New alien	
			a\x=x*16+2: a\y=y*16+2
			If y < 2
				a\health = 3
				a\pic=pics(2)
			Else If y < 4
				a\health = 2
				a\pic=pics(3)
			Else
				a\health = 2
				a\pic = pics(4)
			EndIf 
		Next
	Next
End Function
;------------------------------------------------;
;**************** SPRITES ***********************; 
;------------------------------------------------;
Function DrawSprites()
	For a.alien = Each alien
		DrawImage a\pic, a\x, a\y
	Next
	For p.player = Each player
		DrawImage pics(1), p\x, p\y 
	Next
End Function 

Function DrawShots()
	LockBuffer
	For f.fire = Each fire
		Select f\kind
		Case SHOT_FLAME
			WritePixel f\x, f\y, $FF22FF88
			WritePixel f\x, f\y+1, $FF228844
		Case SHOT_BULLET
			FlameShot(f\x, f\y)
		End Select
		f\y = f\y + f\spd
		If f\y < 0 Or f\y > 239 Then Delete f.fire 
	Next
	UnlockBuffer 
End Function 

Function FlameShot(x_pos, y_pos)
	For y = 0 To 3
		For x=0 To 5
			WritePixel(x_pos+x, y_pos-(x/2)+y, palette(120-(y*40)))
			WritePixel(x_pos+6+x, y_pos-(2-x/2)+y, palette(120-(y*40)))
		Next
	Next
End Function 

Function Collision()
	For a.alien = Each alien
		For f.fire = Each fire
			If f\side = 0
				If ImageRectCollide(a\pic, a\x, a\y, 0, f\x, f\y, 1, 1)
					a\health = a\health-1
					Delete f.fire
					If a\health < 1
						NewExplosion(a\x+6, a\y+6, Rand(50, 250), 5)
						Delete a.alien
						Exit 
					EndIf 
				EndIf  
			EndIf 
		Next 
	Next
End Function

Function MoveSprites()
	For a.alien =Each alien 
		a\x=a\x+a_inc
	Next
	a_counter = a_counter + a_inc
	If a_counter > 80 Or a_counter < 0  
		a_inc =-a_inc
		For a.alien = Each alien 
			a\y = a\y + 2
		Next
	EndIf
End Function

Function UpdatePlayer()
	p.player = First player 
	If p\x < 0 Then p\x = 0
	If p\x > 308 Then p\x=308
	p\counter = p\counter + 1
End Function 
;------------------------------------------------;
;**************** INPUT *************************; 
;------------------------------------------------;
Function PlayerInput()
	p.player = First player 
	If KeyDown(203) p\x=p\x-PLAYER_SPEED
	If KeyDown(205) p\x=p\x+PLAYER_SPEED
	If KeyDown(57) PlayerShoot(p.player)
	If KeyHit(25) Pause()
	If KeyHit(1) End
End Function 

Function Pause()
	Text 130, 100, "PAUSED"
	Text 70, 120, "Press Space to resume" 
	Flip  
	FlushKeys 
	While Not KeyHit(57)
		Delay(5)
		If KeyHit(1) End
	Wend
End Function 

Function PlayerShoot(p.player)
	p\counter = p\counter + 1
	If p\counter > 39
		p\counter = 0
		Select p\shot
		Case SHOT_FLAME
			f.fire = New fire
			f\x=p\x+1: f\y=p\y+5: f\spd=-3
			f.fire = New fire
			f\x=p\x+10: f\y=p\y+5: f\spd=-3
		Case SHOT_BULLET
			f.fire = New fire
			f\x=p\x: f\y=p\y+3: f\spd=-2			
		End Select 
	EndIf 
End Function 

;------------------------------------------------;
;**************** EXPLOSIONS ********************; 
;------------------------------------------------;
Function NewExplosion(x, y, frags, range)
	For i = 1 To frags
		e.frag = New frag
		e\direction = Rand(0, 359)
		e\x#[0] = x +cosine#(e\direction)*range
		e\y#[0] = y +sine#(e\direction)*range
		e\falloff = Rand(10, 50)
		e\speed = Rand(1, 2)
	Next
End Function

Function DrawExplosions()
	LockBuffer 
	For e.frag = Each frag
		;DRAW FRAG
		For i = 0 To TRAIL_SIZE
			col = (e\falloff*3)-(i*20) ;/TRAIL_SIZE
			If col < 0 Then col = 0
			WritePixel(e\x#[i], e\y#[i], palette(col)) 
		Next
		
		;MOVE FRAG
		For i = 1 To TRAIL_SIZE-1
			e\x#[TRAIL_SIZE-i]=e\x#[TRAIL_SIZE-i-1]
			e\y#[TRAIL_SIZE-i]=e\y#[TRAIL_SIZE-i-1]
		Next
		
		e\x#[0] = e\x#[0] + cosine#(e\direction)*e\speed	
		e\y#[0] = e\y#[0] + sine#(e\direction)*e\speed

		;FALLOFF
		e\falloff = e\falloff -1
		If e\falloff = 0 Then Delete e.frag	
	Next
	UnlockBuffer 
End Function

Znaxish

Created for Workshop #085 | Comments (1) | Rating 100%

Find rectangles whose corners are 4 alike shapes.

Mouse

Show Sourcecode for this entry

Hide Sourcecode

AppTitle "Znaxish"
Graphics 640, 480, 8, 2
SeedRnd MilliSecs()

Dim grid(12, 12)
Dim sel_x(4), sel_y(4)
Global x_pos, y_pos
Global num_select = 1
Global removal
Global score, hiscore=2000 
Global state 
Const  game_time=180000

Global tiles = CreateImage(96, 32)
SetBuffer ImageBuffer(tiles)
Color 150, 30, 30
Rect 0, 0, 95, 31
Color 30, 150, 30
;Tile 1
Oval 2, 2, 27, 27, 1
;Tile 2
Rect 34, 2, 12, 12, 1
Rect 34, 16, 12, 12, 1
Rect 48, 2, 12, 12, 1
Rect 48, 16, 12, 12, 1
;Tile 3
For x = 0 To 25   	
	Line 80-(x/2), 28-x, 80+(x/2), 28-x 
Next

INITIALIZE()
SetBuffer BackBuffer()
font = LoadFont("Verdana", 16, True, False, False) 
SetFont font 

While Not KeyHit(1)
	Cls 
	If state = 0		;TITLE SCREEN
		TITLE_SCREEN()
		start_time = MilliSecs()
	Else If state = 1	;IN GAME
		DRAW_BLOCKS()
		MOUSE_CLICK()
		DISPLAY_TEXT(start_time)
	Else 				;GAME OVER
		GAME_OVER()
	EndIf 
	Flip 
Wend 

FreeImage tiles
FreeFont font
End 

;--------------------------;
Function INITIALIZE()
For x = 1 To 12
	For y = 1 To 12
		grid(x, y) = Rand(0, 2)
	Next
Next	
End Function
;--------------------------;
Function DRAW_BLOCKS()

;IF SQUARES ARE BEING REMOVED GET START AND END X/Y POSITIONS
If removal > 0
	start_x = 100
	end_x = 0
	For i = 1 To 4
		If sel_x(i) < start_x Then start_x = sel_x(i)
		If sel_x(i) > end_x Then end_x = sel_x(i)
	Next 

	start_y = 100
	end_y = 0
	For i = 1 To 4
		If sel_y(i) < start_y Then start_y = sel_y(i)
		If sel_y(i) > end_y Then end_y = sel_y(i)
	Next 
EndIf 

;FOR EACH SQUARE: DRAW IT!
Color 150, 30, 30
For x = 1 To 12
	For y = 1 To 12
		If grid(x, y) = 0 
			;Color 150, 30, 30
			frame = 0
		Else If grid(x, y) = 1
			frame = 1
			;Color 150, 150, 30
		Else
			frame = 2
			;Color 50, 150, 30
		EndIf 
			
		
		If removal = 0
			For i = 1 To 4
				If sel_x(i) = x And sel_y(i)= y
					selected = 1
					Exit
				EndIf 	
			Next	
			If selected = 1
				Rect 20+(x*32), 20+(y*32), 30, 30, 0					
				Rect 21+(x*32), 21+(y*32), 28, 28, 0
				Rect 22+(x*32), 22+(y*32), 26, 26, 0				
			Else
				DrawImageRect tiles, 20+(x*32), 20+(y*32), frame*32, 0, 30, 30 
			EndIf
		Else 
			;If in an area to remove
			If x >= start_x And x <= end_x And y >= start_y And y <= end_y		
				Rect 20+(x*32)+removal, 20+(y*32)+removal, 30-(removal*2), 30-(removal*2), 1
			Else
				DrawImageRect tiles, 20+(x*32), 20+(y*32),frame*32, 0, 32, 32 
				;Rect 20+(x*32), 20+(y*32), 30, 30, 1
			EndIf		
		EndIf 	
		selected =0 
	Next
Next 

If removal > 0
	removal = removal + 1
	If removal > 15 
		RESET_SELECT()
		GENERATE_NEW(start_x, end_x, start_y, end_y)
		removal = 0 
	EndIf 
EndIf 


End Function 
;-------------------------;
Function MOUSE_CLICK()
If MouseHit(1)
	x_pos = ((MouseX() - 20)/32)
	y_pos = ((MouseY() - 20)/32)
	

	If x_pos > 0 And x_pos < 13 And y_pos > 0 And y_pos < 13
		If num_select = 1
			sel_x(1) = x_pos
			sel_y(1) = y_pos
			num_select=2
		Else If num_select = 2
			sel_x(2) = x_pos
			sel_y(2) = y_pos			
			;Check if tile is same colour as previously selected tile 
			If CHECK_COLOUR(num_select) = True 
				num_select = 3
			Else 
				RESET_SELECT()
			EndIf 
		Else If num_select = 3
			sel_x(3) = x_pos
			sel_y(3) = y_pos				
			;Check if tile is same colour as previously selected tile 
			If CHECK_COLOUR(num_select) = True 
				num_select = 3
			Else 
				RESET_SELECT()
				Return False
			EndIf 
			
			;Check if tile is aligned in square in relation to other selections
			If sel_x(3) = sel_x(1) And sel_x(3) <> sel_x(2)
				If DIAGONAL() = True
					If sel_y(3) = sel_y(2) And sel_y(3) <> sel_y(1)
						num_select = 4
					Else
						RESET_SELECT()
						Return False					
					EndIf 
				Else 
					num_select = 4
				EndIf 			
			Else If sel_x(3) = sel_x(2) And sel_x(3) <> sel_x(1)
				If DIAGONAL() = True
					If sel_y(3) = sel_y(1) And sel_y(3) <> sel_y(2)
						num_select = 4
					Else
						RESET_SELECT()
						Return False					
					EndIf 					
				Else
					num_select = 4				
				EndIf 
			Else If sel_y(3) = sel_y(1) And sel_y(3) <> sel_y(2)
				If DIAGONAL() = True
					If sel_x(3) = sel_x(2) And sel_x(3) <> sel_y(1)
						num_select = 4
					Else
						RESET_SELECT()
						Return False					
					EndIf 
				Else
					num_select = 4				
				EndIf 			
			Else If sel_y(3) = sel_y(2) And sel_y(3) <> sel_y(1)	
				If DIAGONAL() = True
					If sel_x(3) = sel_x(1) And sel_x(3) <> sel_x(2)
						num_select = 4
					Else
						RESET_SELECT()
						Return False					
					EndIf 
				Else
					num_select = 4				
				EndIf 
			Else 
				RESET_SELECT()
				Return False			
			EndIf 
		Else If num_select = 4
			sel_x(4) = x_pos
			sel_y(4) = y_pos
			If CHECK_COLOUR(num_select) = True
				If GET_MISSING_X() = True And GET_MISSING_Y() = True 
					;REMOVE SELECTION
					removal = 1
					;SCORE POINTS
				Else  
					RESET_SELECT()
				EndIf 			
			Else 
				RESET_SELECT()
			EndIf 		
		EndIf 		
	EndIf 
EndIf 
End Function

Function CHECK_COLOUR(i)
If grid(sel_x(1), sel_y(1)) = grid(sel_x(i), sel_y(i)) Return True 
End Function 

Function RESET_SELECT()
For i = 1 To 4
	sel_x(i)=0
	sel_y(i)=0
Next
num_select = 1
End Function 

Function DIAGONAL()
If sel_x(1) <> sel_x(2) And sel_y(1) <> sel_y(2) Return True 
End Function 

Function GET_MISSING_X()
If sel_x(1) = sel_x(2) And sel_x(3) = sel_x(4) 
	Return True
Else If sel_x(2) = sel_x(3) And sel_x(1) = sel_x(4)
	Return True
Else If sel_x(1) = sel_x(3) And sel_x(2) = sel_x(4)
	Return True 
Else  
	Return False
EndIf 
End Function

Function GET_MISSING_Y()
If sel_y(1) = sel_y(2) And sel_y(3) = sel_y(4) 
	Return True
Else If sel_y(2) = sel_y(3) And sel_y(1) = sel_y(4)
	Return True
Else If sel_y(1) = sel_y(3) And sel_y(2) = sel_y(4)
	Return True 
Else  
	Return False
EndIf 
End Function 

Function GENERATE_NEW(x1, x2, y1, y2)
For y = y1 To y2
	For x = x1 To x2
		grid(x, y) = Rand(0, 2)
	Next
Next

x_squares = x2-x1+1
y_squares = y2-y1+1
score = score + (x_squares * y_squares)
End Function 

Function DISPLAY_TEXT(start_time)
seconds_left = ((start_time+game_time-MilliSecs())/1000)
If seconds_left <= 0 
	state = 2
	FlushMouse()
EndIf 
minutes_left = seconds_left /60
seconds_left = seconds_left Mod 60
Color 150, 30, 30
If seconds_left > 9
	Text 480, 60, "TIME   "+minutes_left+":"+seconds_left
Else 
	Text 480, 60, "TIME   "+minutes_left+":0"+seconds_left
EndIf 
Text 480, 80, "HIGH   "+hiscore
Color 30, 150, 30
Text 480, 100, "SCORE  "+score
End Function 

Function TITLE_SCREEN()
Color 30, 150, 30
Text 100, 100, "AIM OF THE GAME:"
Color 150, 30, 30
Text 100, 120, "Select tiles by clicking on them with the mouse."
Text 100, 140, "Form a rectangle by selecting 4 tiles of the same colour."
Text 100, 160, "Only the corners of the rectangle need to be the same colour."
Text 100, 180, "Tiles in between can be of any colour."
Text 100, 200, "When this is done tiles within the rectangle will be removed."
Text 100, 220, "You score 1 point for each tile removed."
Text 100, 240, "Removed tiles are then replaced by new tiles."
Text 100, 260, "When the time is up the game ends." 
Color 30, 150, 30
Text 100, 320, "CLICK MOUSE TO BEGIN!"
Flip
WaitMouse 
state = 1
FlushMouse
End Function 

Function GAME_OVER()
Color 150, 30, 30
Text 100, 100, "GAME OVER"	
Color 30, 150, 30
Text 100, 120, "YOU SCORED: "+score+" POINTS"
If score > hiscore Then hiscore = score
Flip 
WaitMouse
INITIALIZE()
RESET_SELECT()
state = 0
score = 0
removal = 0
FlushMouse
End Function

Mega Glider

Created for Workshop #078 | Comments (3) | Rating 75%

Fly you glider as far as you can!

Right to go Right, Up to go Up

Show Sourcecode for this entry

Hide Sourcecode

AppTitle"Mega Glider"
glider = CreateImage(32, 32)
SetBuffer ImageBuffer(glider)
Color 150, 50, 50
For i = 1 To 16
	Line i, 0+i, i, 32-i
Next
SetBuffer BackBuffer()
py=18 
While Not KeyHit(1)
	Cls	
	Color 100, 100, 20: Rect 0-px, 50, 100, 300
	Color 30, 120, 30:	Rect 0-px, 50, 102, 6
	Color 20, 50, 120:	Rect 0, 260, 400, 40  
	DrawImage glider, px-s, py
	If KeyDown(205) px = px+1
	If px > 52
		If KeyDown(205) s=s+1
 		py = py +1
	EndIf
	If KeyHit(200) Then py = py -4
	Flip  	
	If py > 260
		Cls
		Print"GAME OVER"
		Print"YOU MADE IT "+px +"METERS"
		Print"PRESS ESC TO QUIT"
		Flip 
		While Not KeyHit(1)
		Wend
		End
	EndIf 
Wend

Turn Based Game

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

Move your men and attack.

Mouse + Cursors to move, A to Attack, H to show Health bars. Space ends your turn.

Click to Download this entry

Window Cleaner Delux

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

You live in a very big house. The seagulls have been at the bins and are making a mess of it. Even worse is that you have a giant mutant ape bouncing around on your roof. Climb to the top of your house cleaning windows on you way and defeat the boss when you reach the top.

Cursors and Mouse

Click to Download this entry