TGC Codebase Backup



Dark Cubes by Richard Davey

12th Sep 2003 13:17
Summary

A complete 3D puzzle game! Use the numeric pad to try and lower all of the blocks. Some have effects on others.



Description

==========================================================
A Screaming Product Of The DARKFORGE (www.darkforge.co.uk)
==========================================================

Title

DarkCubes

Version

1.0

Date

February 8th 2001

Files

darkcubes.dba 3642 Bytes
darkcubes.gif 31,412 Bytes

Programmer

Richard Davey
rich@fatal-design.co.uk

DB Version

DarkBasic v1.07 (Registered)

License

Public Domain

Comments

A complete 3D puzzle game! Use the numeric pad to try and
lower all of the blocks. Some have effects on others.

==========================================================
(c) www.darkforge.co.uk 2001
==========================================================



Code
                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    `	-------------------------------------------------------------------------
`	DarkCubes                                  DarkForge Mini-Game (8/2/2001)
`	-------------------------------------------------------------------------
`	This is a complete stand-alone 3D puzzle game written in DB 1.07

sync rate 0
sync on
hide mouse

`	Object Creation

dim cubes(9)
dim cubesy(9)

for a = 1 to 9

	make object box a,13,13,13
	color object a,rgb(50,90,200)

next a

`	Environment

for a = 1 to 4

	make light a
	position light a,rnd(22),0,rnd(22)
	color light a,100+rnd(155),50+rnd(200),100

next a

color backdrop 0
set ambient light 25

`	Camera

position camera 15,29,-40
xrotate camera 20

`	Main Loop

Instructions()
SetCubes()

do

	x = 0
	z = 0
	t = 0

`	Position the cubes according to the array

	for a = 1 to 9

		if cubes(a) = 0
			y = cubesy(a)
			if y > 0
				dec y
				cubesy(a) = y
				inc t
			endif
		else
			y = cubesy(a)
			if y <= 10
				inc y
				cubesy(a) = y
				inc t
			endif
		endif

		position object a,x,y,z
		inc x,15
		if x=45
			inc z,15
			x=0
		endif
	
	next a

`	T is our trigger code, if the blocks are moving then don't check
`	for a keypress

	if t = 0
		s = scancode()
		if s = 71 then ToggleGrid(7)
		if s = 72 then ToggleGrid(8)
		if s = 73 then ToggleGrid(9)
		if s = 75 then ToggleGrid(4)
		if s = 76 then ToggleGrid(5)
		if s = 77 then ToggleGrid(6)
		if s = 79 then ToggleGrid(1)
		if s = 80 then ToggleGrid(2)
		if s = 81 then ToggleGrid(3)
		if s = 19 then RandomCubes()
	endif

	paste image 1,0,0
	paste image 2,480,465

	sync

loop

`	This function will handle the cube effect logic

Function ToggleGrid(obj)

	if obj = 1
		ToggleObject(1)
		ToggleObject(2)
		ToggleObject(4)
	endif

	if obj = 2
		ToggleObject(2)
		ToggleObject(5)
		ToggleObject(1)
		ToggleObject(3)
	endif

	if obj = 3
		ToggleObject(3)
		ToggleObject(2)
		ToggleObject(6)
	endif

	if obj = 4
		ToggleObject(4)
		ToggleObject(7)
		ToggleObject(1)
		ToggleObject(5)
	endif

	if obj = 5
		ToggleObject(5)
		ToggleObject(4)
		ToggleObject(6)
		ToggleObject(2)
		ToggleObject(8)
	endif

	if obj = 6
		ToggleObject(6)
		ToggleObject(9)
		ToggleObject(3)
		ToggleObject(5)
	endif

	if obj = 7
		ToggleObject(7)
		ToggleObject(4)
		ToggleObject(8)
	endif

	if obj = 8
		ToggleObject(8)
		ToggleObject(5)
		ToggleObject(7)
		ToggleObject(9)
	endif

	if obj = 9
		ToggleObject(9)
		ToggleObject(8)
		ToggleObject(6)
	endif

Endfunction

`	Toggle a cube up or down

Function ToggleObject(obj)

	if cubes(obj) = 0
		cubes(obj) = 1
		cubesy(obj) = 0
	else
		cubes(obj) = 0
		cubesy(obj) = 10
	endif

Endfunction


`	Set the initial status of the cubes

Function SetCubes()

	cubes(3) = 1
	cubes(4) = 1
	cubes(7) = 1
	cubes(8) = 1
	cubes(9) = 1

Endfunction

`	Generate random cubes status

Function RandomCubes()

	for a = 1 to 9
		cubes(a) = rnd(1)
	next a

	wait 100

Endfunction

`	Creates the instructions screen and web site url

Function Instructions()

	set text font "Courier"
	ink rgb(255,255,255),0
	set text to bold
	text 0,0,"DarkCubes"
	set text to normal
	text 10,28,"The objective is simple."
	text 10,42,"Just lower all the cubes."
	text 10,56,"Toggle their status using the"
	text 10,70,"numeric keypad, keys 1 to 9."
	text 10,84,"Press R to randomise them all."
	text 10,112,"Good luck!"
	text 0,140,"www.darkforge.co.uk"
	
	get image 1,0,0,260,130
	get image 2,0,140,160,156
	cls

Endfunction