`Ashingda27 - Falling Objects Reations
 
set display mode 640,480,16
sync on
sync rate 60
 
 
gosub Initialize
 
 
do
	gosub Game
	ink rgb(255,255,255),0
	text 0,0,"FPS "+str$(screen fps())
	copy bitmap 1,0
	sync
	cls
loop
 
 
 
	Initialize:
		randomize timer()
		for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			ink rgb(c,c,c),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 1,0,0,17,17,1
 
		for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			c2 = c/3
			ink rgb(c,c2,c2),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 2,0,0,17,17,1
 
 
		for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			c2 = c/1.5
			ink rgb(c2,c2,c),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 3,0,0,17,17,1
 
 
		for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			c2 = c/1.5
			ink rgb(c2,c,c2),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 4,0,0,17,17,1
 
 
		for lp = 8 to 0 step -1
			c = 255/((lp/4.0)+1)
			ink rgb(c,c/2,c/2),0
			box 8-lp,0,8+lp,16
		next lp
		get image 200,0,0,16,16,1
 
		for lp = 8 to 0 step -1
			c = 255/((lp/4.0)+1)
			ink rgb(c,c,c),0
			box 8-lp,0,8+lp,16
		next lp
		get image 201,0,0,16,16,1
 
		cls
		ink rgb(255,255,255),0
		for lp = 0 to 2
			r = lp*8
			line r,0,16-r,16
			line 0,r,16,16-r
		next lp
		get image 400,0,0,16,16,1
 
 
 
 
 
 
		MapX = 29
		MapY = 19
		dim Unit(MapX,MapY)
 
		dim MaxBall(0)
		m = 200
		MaxBall(0) = m
		dim Ball(m)
		dim BallX(m)
		dim BallY(m)
		dim Act(m)
		dim MoveX(m)
		dim MoveY(m)
		dim Smash(m)
		dim Dr(m)
 
 
		dim Tube(2)
		dim TubeX(2)
		dim TubeC(2)
 
		TubeX(1) = (rnd(454)+16)/16
		TubeX(2) = (rnd(454)+16)/16
 
		ink rgb(240,200,180),0
		box 0,0,15,15
		ink rgb(70,50,40),0
		box 1,1,15,15
		ink rgb(140,100,80),0
		box 1,1,14,14
		get image 300,0,0,16,16,1
 
		for lpy = 0 to MapY
		for lpx = 0 to MapX
			if lpx = 0 or lpx = MapX or lpy = MapY
				Unit(lpx,lpy) = 300
			endif
		next lpx
		next lpy
 
		create bitmap 2,480,336
		create bitmap 1,640,480
	return
 
	Game:
		gosub GameHandle
		gosub GameDisplay
	return
 
 
		GameHandle:
			mx = mousex()
			my = mousey()
			mc = mouseclick()
 
 
			for lp = 0 to 2
				if lp = 0
					TubeX(lp) = mx/16
				  else
					if TubeC(lp) > 0
						TubeC(lp) = TubeC(lp) - 1
					  else
						TubeX(lp) = TubeX(lp) + (rnd(2)-1)
						TubeC(lp) = rnd(50)
						if rnd(25)/25 = 1 then TubeX(lp) = (rnd(454)+16)/16
					endif
				endif
 
				if TubeX(lp) < 1 then TubeX(lp) = 1
				if TubeX(lp) > MapX-1 then TubeX(lp) = MapX-1
 
			next lp
 
			if Spawn > 0
				dec Spawn
			else
				Spawn = 8
 
				if mc = 1
					tx = TubeX(0)
					CreateBall(tx,2)
				endif
 
				for lp = 1 to 2
					select rnd(2)
						case 0 : c = 1 : endcase
						case 1 : c = 3 : endcase
						case 2 : c = 4 : endcase
						case default : c = 1 : endcase
					endselect
					tx = TubeX(lp)
					CreateBall(tx,c)
				next lp
			endif
 
			for lp = 1 to MaxBall(0)
 
				if Ball(lp)
					if Act(lp) = 0
						if Ball(lp) = 1
							MoveD(lp)
							if rnd(1)
								MoveL(lp)
								MoveR(lp)
							else
								MoveR(lp)
								MoveL(lp)
							endif
						endif
						if Ball(lp) = 2
							MoveD2(lp)
						endif
						if Ball(lp) = 3
							MoveD(lp)
							if Dr(lp)
								MoveRU(lp)
								MoveLU(lp)
							else
								MoveLU(lp)
								MoveRU(lp)
							endif
						endif
						if Ball(lp) = 4
							MoveD(lp)
							if Dr(lp)
								MoveR4(lp)
								MoveL4(lp)
							else
								MoveL4(lp)
								MoveR4(lp)
							endif
						endif
					endif
 
					if Act(lp)
						Act(lp) = Act(lp) - 2
					endif
				endif
 
			next lp
 
 
 
		return
 
 
		GameDisplay:
			gosub DisplayTerrain
			gosub DisplayObjects
		return
 
 
			DisplayTerrain:
				if TerrainFlag = 0
					TerrainFlag = 1
					set current bitmap 2
						for lp = 1 to 336
							lpm# = 1+(lp/100.0)
							ink rgb(80/lpm#,100/lpm#,120/lpm#),0
							box 0,336-(lp-1),479,336-(lp-1)
						next lp
 
						for lpy = 0 to MapY
						for lpx = 0 to MapX
							x = lpx*16
							y = 16+lpy*16
							if Unit(lpx,lpy) = 300
								paste image Unit(lpx,lpy),x,y,1
							endif
						next lpx
						next lpy
					set current bitmap 1
				endif
				copy bitmap 2,0,0,479,335, 1,0,0,479,335
			return
 
			DisplayObjects:
				for lp = 1 to MaxBall(0)
					if Ball(lp)
						x = BallX(lp)*16 - MoveX(lp)*Act(lp)-1
						y = 15 + BallY(lp)*16 - MoveY(lp)*Act(lp)
						paste image Ball(lp),x,y,1
						if smash(lp)
							r = 16-Act(lp)
							circle x+8,y+24-r,r
						endif
					endif
				next lp
 
 
				for lp = 1 to MaxBall(0)
					if Ball(lp)
						x = BallX(lp)*16 - MoveX(lp)*Act(lp)-1
						y = 15 + BallY(lp)*16 - MoveY(lp)*Act(lp)
						if smash(lp)
							r = 16-Act(lp)
							c = 255/(1+r/10.0)
							ink rgb(c,c,c),0
							circle x+8,y+24-r,r
						endif
					endif
				next lp
 
				for lp = 1 to 2
					x = TubeX(lp)
					paste image 201,TubeX(lp)*16,0
					paste image 201,TubeX(lp)*16,16
				next lp
 
				x = TubeX(0)
				paste image 200,TubeX(0)*16,0
				paste image 200,TubeX(0)*16,8
			return
 
Function CreateBall(x,b)
	if Unit(x,1) = 0
		for lp = 1 to MaxBall(0)
			if Ball(lp) = 0
				Ball(lp) = b
				if lp = MaxBall(0) then Ball(lp) = 2
				BallX(lp) = x
				BallY(lp) = 0
				Unit(BallX(lp),BallY(lp)) = lp
				MoveX(lp) = 0
				MoveY(lp) = 0
				Act(lp) = 0
				Smash(lp) = 0
				Dr(lp) = rnd(1)
				lp = MaxBall(0)
			endif
		next lp
	endif
EndFunction
 
 
 
Function MoveD(lp)
	if Unit(BallX(lp),BallY(lp)+1) = 0
		Act(lp) = 16
		MoveX(lp) = 0 : MoveY(lp) = 1
		Unit(BallX(lp),BallY(lp)) = 0
		BallY(lp) = BallY(lp) + 1
		Unit(BallX(lp),BallY(lp)) = lp
	endif
EndFunction
 
Function MoveD2(lp)
	if Unit(BallX(lp),BallY(lp)+1) < MaxBall(0)
		Smash(lp) = 0
		if Unit(BallX(lp),BallY(lp)+1) > 0
			Ball(Unit(BallX(lp),BallY(lp)+1)) = 0
			Smash(lp) = 1
		endif
		Act(lp) = 16
		MoveX(lp) = 0 : MoveY(lp) = 1
		Unit(BallX(lp),BallY(lp)) = 0
		BallY(lp) = BallY(lp) + 1
		Unit(BallX(lp),BallY(lp)) = lp
	else
		Ball(lp) = 0
		Unit(BallX(lp),BallY(lp)) = 0
	endif
EndFunction
 
Function MoveL(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)-1,BallY(lp)+1) = 0
		if Unit(BallX(lp)-1,BallY(lp)) = 0
			Act(lp) = 16
			MoveX(lp) = -1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) - 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
		endif
	endif
EndFunction
 
Function MoveR(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)+1,BallY(lp)+1) = 0
		if Unit(BallX(lp)+1,BallY(lp)) = 0
			Act(lp) = 16
			MoveX(lp) = 1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) + 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
		endif
	endif
EndFunction
 
 
Function MoveLU(lp)
	if Act(lp) = 0 
		if BallY(lp) > 0
			if Unit(BallX(lp)-1,BallY(lp)) = 0
			if Unit(BallX(lp)-1,BallY(lp)-1) = 0
				Act(lp) = 16
				Dr(lp) = 0
				MoveX(lp) = -1 : MoveY(lp) = -1
				Unit(BallX(lp),BallY(lp)) = 0
				BallX(lp) = BallX(lp) - 1
				BallY(lp) = BallY(lp) - 1
				Unit(BallX(lp),BallY(lp)) = lp
			endif
			endif
		endif
	endif
EndFunction
 
Function MoveRU(lp)
	if Act(lp) = 0 
		if BallY(lp) > 0
			if Unit(BallX(lp)+1,BallY(lp)) = 0
			if Unit(BallX(lp)+1,BallY(lp)-1) = 0
				Act(lp) = 16
				Dr(lp) = 1
				MoveX(lp) = 1 : MoveY(lp) = -1
				Unit(BallX(lp),BallY(lp)) = 0
				BallX(lp) = BallX(lp) + 1
				BallY(lp) = BallY(lp) - 1
				Unit(BallX(lp),BallY(lp)) = lp
			endif
			endif
		endif
	endif
EndFunction
 
 
 
Function MoveL4(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)-1,BallY(lp)) = 0
			Act(lp) = 16
			Dr(lp) = 0
			MoveX(lp) = -1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) - 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
	endif
EndFunction
 
Function MoveR4(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)+1,BallY(lp)) = 0
			Dr(lp) = 1
			Act(lp) = 16
			MoveX(lp) = 1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) + 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
	endif
EndFunction