Code archives/Miscellaneous/Columns Clone
This code has been declared by its author to be Public Domain code.
Download source code
| I made one... With fruit! Anyway, it's not graphically great, but it is an enjoyable little game! :) Keys:- Left/Right/Down : Associated Arrow Keys Toggle Fruits Up : A Toggle Fruits Down : Z Toggle Grid On/Off : G Exit : ESC The code below uses Chris's JuicyFonts system, so you'll need his Blitz lib file to play it (Find JuicyFonts in the Toolbox section):- Anyway, hope you have fun playing it... Dabz |
Include "LIB_juicy_fonts.bb" Graphics 640,480,16,1 ;Create grid Const gridWidth = 6 Const gridHeight = 13 Dim grid((gridWidth-1),(gridHeight-1)) Dim gridRow(gridWidth-1) ;Misc Program variables Global bx#,by# ;Variables for movable box Const frameOffset = 20 ;Grid frameOffset Const boxspeedy# = 1 Global score = 0 Global gamespeed = 0 Const dir$="Media/" Global gridflag = -1 Global showGrid = True Global scoreX = 400,scoreY = 100 ;Fonts Global score_font = jf_load_font(dir$+"TutFont.png") Global small_font = jf_load_font(dir$+"TutFontSmall.png") ;Global 'Block' variables Global topBlock Global middleBlock Global bottomBlock Global message$ Global nextTopBlock Global nextMiddleBlock Global nextBottomBlock ;Seed random numbers SeedRnd (MilliSecs()) ;Load grid cells Global gridblocks = LoadAnimImage(dir$+"gridTiles(1).bmp",32,32,0,7) MaskImage gridblocks,255,0,255 ;load playing border Global playBorder = LoadImage(dir$+"playBorder.bmp") MaskImage playborder,255,0,255 ;Set the drawing buffer SetBuffer BackBuffer() ;Load Sound & music Global ingameMusic=PlayMusic(dir$+"ingame.mid") ;ChannelVolume ingameMusic,.5 ;Global beep = LoadSound(dir$+"beep.wav") ;Global row = LoadSound(dir$+"row.wav") ;Global boing = LoadSound(dir$+"cork_pop.wav") Global beep = LoadSound(dir$+"beep.wav") Global row = LoadSound(dir$+"cork_pop.wav") Global boing = LoadSound(dir$+"row.wav") ;Main Game nextTopBlock = Rand(1,6) nextMiddleBlock = Rand(1,6) nextBottomBlock = Rand(1,6) ResetBlocks() timer = CreateTimer(60) ;Mainloop Repeat WaitTimer(timer) For speed = 0 To gamespeed ProcessGame() processGrid() Next Draw() Forever Function ProcessGame() If KeyHit(203) If bx > 0 PlaySound beep If grid(bx-1,(by Shr 5)+1) = 0 bx=bx-1;Left If bx<0 Then bx=0 End If End If End If If KeyHit(205) If bx < 5 PlaySound beep If grid(bx+1,(by Shr 5)+1) = 0 bx=bx+1;Right If bx>5 Then bx=5 End If End If End If If KeyDown(208) by=by+8 Else by=by+1 End If If (by Shr 5) > 11 by = by Shr 5 grid(bx,by) = BottomBlock grid(bx,by-1) = middleBlock grid(bx,by-2) = topBlock ResetBlocks() End If If KeyHit(57) gamespeed = gamespeed + 1 End If If KeyHit(1) GameOver() End If If KeyHit(30) ToggleBlocks(True) End If If KeyHit(44) ToggleBlocks(False) End If If KeyHit(34) showGrid = -showGrid End If If grid(bx,(by Shr 5)+1) <> 0 by = (by Shr 5) If (by-1) < 0 Then GameOver() grid(bx,by) = BottomBlock grid(bx,by-1) = middleBlock grid(bx,by-2) = topBlock ResetBlocks() End If End Function ;Draw Background Function Draw(showBlocks = True) Cls ClsColor 255,197,138 ;Draw border DrawBlock playborder,frameOffset-10,frameOffset-10 ;DrawGrid For loopy = 0 To gridHeight-1 For loopx = 0 To gridWidth-1 If showGrid = True DrawImage gridblocks,(frameOffset+(loopx Shl 5)),(frameOffset+(loopy Shl 5)),grid(loopx,loopy) Else If grid(loopx,loopy) <> 0 DrawImage gridblocks,(frameOffset+(loopx Shl 5)),(frameOffset+(loopy Shl 5)),grid(loopx,loopy) End If End If Next Next If showBlocks = True DrawImage gridblocks,(frameOffset+(bx Shl 5)),(frameOffset+(by)),BottomBlock DrawImage gridblocks,(frameOffset+(bx Shl 5)),(frameOffset+((by-32))),middleBlock DrawImage gridblocks,(frameOffset+(bx Shl 5)),(frameOffset+((by-64))),topBlock nextBlockY = 5 Shl 5 DrawImage gridblocks,(frameOffset+(9 Shl 5)),(frameOffset+(nextBlockY)),nextBottomBlock DrawImage gridblocks,(frameOffset+(9 Shl 5)),(frameOffset+((nextBlockY-32))),nextMiddleBlock DrawImage gridblocks,(frameOffset+(9 Shl 5)),(frameOffset+((nextBlockY-64))),nextTopBlock End If jf_text(score_font,scoreX,scoreY,score,1,1,500) UpdateExplosion() move() Text 0,0,message$ Flip End Function Function ProcessGrid() ;Check horizontal blocks For loopy = 0 To gridHeight-1 For loopx = 0 To gridWidth-1 If grid(loopx,loopy) <> 0 block = grid(loopx,loopy) countBlock = 0 For loop = loopx To gridWidth-1 If grid(loop,loopy) = block countBlock = countBlock + 1 Else Exit End If Next .label If countBlock > 2 PlaySound row tempScore = (countBlock)*10 For deleteBlockx = loopx To (loopx+countBlock-1) makeexplosion((deleteBlockx Shl 5)+17,(loopY Shl 5)+16,10,1,block) Next For deleteBlockx = loopx To (loopx+countBlock-1) setPath((deleteBlockx Shl 5)+32,(loopy Shl 5)+32,scoreX,scoreY,tempScore) ;score = score + 10 grid(deleteBlockx,loopy) = 0 showRow=MilliSecs() While MilliSecs() < showRow + 200 Draw() Wend Next End If End If Next Next ;Vertical For loopx = 0 To gridWidth-1 For loopy = 0 To gridHeight-1 If grid(loopx,loopy) <> 0 block = grid(loopx,loopy) countBlock = 0 For loop = loopy To gridHeight-1 If grid(loopx,loop) = block countBlock = countBlock + 1 Else Exit End If Next If countBlock > 2 tempScore = (countBlock)*10 PlaySound row For deleteBlocky = loopy To (loopy+countBlock-1) makeexplosion((loopx Shl 5)+17,(deleteBlocky Shl 5)+16,10,1,block) Next For deleteBlocky = loopy To (loopy+countBlock-1) grid(loopx,deleteBlocky) = 0 setPath((loopx Shl 5)+32,(deleteBlocky Shl 5)+32,scoreX,scoreY,tempScore) grid(deleteBlockx,loopy) = 0 showRow=MilliSecs() While MilliSecs() < showRow + 100 Draw() Wend Next End If End If Next Next ;Diagnal right-down checking This was a bastard to write For loopy = 0 To gridHeight-1 For loopx = 0 To gridWidth-1 If grid(loopx,loopy) <> 0 block = grid(loopx,loopy) checkloopx = loopx+1 checkloopy = loopy+1 BlockCount = 0 Repeat If checkloopx > gridWidth-1 Then Exit If checkloopy > gridHeight-1 Then Exit If grid(checkloopx,checkloopy) = block checkloopx = checkloopx + 1 checkloopy = checkloopy + 1 BlockCount = BlockCount + 1 Else Exit End If Forever If BlockCount > 1 tempScore = (blockCount+1)*10 PlaySound row makeexplosion((loopx Shl 5)+16,(loopy Shl 5)+16,10,1,block) checkloopx = loopx+1 checkloopy = loopy+1 For loop = 0 To BlockCount-1 If checkloopx > gridWidth-1 Then Exit If checkloopy > gridHeight-1 Then Exit makeexplosion((checkloopx Shl 5)+16,(checkloopy Shl 5)+16,10,1,block) checkloopx = checkloopx + 1 checkloopy = checkloopy + 1 Next grid(loopx,loopy) = 0 setPath((loopx Shl 5)+32,(loopy Shl 5)+32,scoreX,scoreY,tempScore) checkloopx = loopx+1 checkloopy = loopy+1 For loop = 0 To BlockCount-1 If checkloopx > gridWidth-1 Then Exit If checkloopy > gridHeight-1 Then Exit grid(checkloopx,checkloopy) = 0 setPath((checkloopx Shl 5)+32,(checkloopy Shl 5)+32,scoreX,scoreY,tempScore) checkloopx = checkloopx + 1 checkloopy = checkloopy + 1 Next End If End If Next Next For loopy = 0 To gridHeight-1 For loopx = 0 To gridWidth-1 If grid(loopx,loopy) <> 0 block = grid(loopx,loopy) checkloopx = loopx-1 checkloopy = loopy+1 BlockCount = 0 Repeat If checkloopx < 0 Then Exit If checkloopy > gridHeight-1 Then Exit If grid(checkloopx,checkloopy) = block checkloopx = checkloopx - 1 checkloopy = checkloopy + 1 BlockCount = BlockCount + 1 Else Exit End If Forever If BlockCount > 1 tempScore = (blockCount+1)*10 PlaySound row makeexplosion((loopx Shl 5)+16,(loopy Shl 5)+16,10,1,block) checkloopx = loopx-1 checkloopy = loopy+1 For loop = 0 To BlockCount-1 If checkloopx < 0 Then Exit If checkloopy > gridHeight-1 Then Exit makeexplosion((checkloopx Shl 5)+16,(checkloopy Shl 5)+16,10,1,block) checkloopx = checkloopx - 1 checkloopy = checkloopy + 1 Next grid(loopx,loopy) = 0 setPath((loopx Shl 5)+32,(loopy Shl 5)+32,scoreX,scoreY,tempScore) checkloopx = loopx-1 checkloopy = loopy+1 For loop = 0 To BlockCount-1 If checkloopx < 0 Then Exit If checkloopy > gridHeight-1 Then Exit grid(checkloopx,checkloopy) = 0 setPath((checkloopx Shl 5)+32,(checkloopy Shl 5)+32,scoreX,scoreY,tempScore) checkloopx = checkloopx - 1 checkloopy = checkloopy + 1 Next End If End If Next Next .retryCells For loopy = 0 To gridHeight-2 For loopx = 0 To gridWidth-1 If grid(loopx,loopy) <> 0 If grid(loopx,loopy+1) = 0 grid(loopx,loopy+1) = grid(loopx,loopy) grid(loopx,loopy) = 0 showRow=MilliSecs() While MilliSecs() < showRow + 100 Draw() Wend Goto retryCells End If End If Next Next End Function Function ToggleBlocks(flag) tempBotBlock = BottomBlock tempmidBlock = middleBlock temptopBlock = topBlock If flag = True BottomBlock = temptopBlock middleBlock = tempBotBlock topBlock = tempmidBlock Else BottomBlock = tempmidBlock middleBlock = temptopBlock topBlock = tempBotBlock End If End Function Function ResetBlocks() BottomBlock = nextBottomBlock middleBlock = nextMiddleBlock topBlock = nextTopBlock nextTopBlock = Rand(1,6) nextMiddleBlock = Rand(1,6) nextBottomBlock = Rand(1,6) bx = 3 by = 0 End Function Function GameOver() For loopy = 0 To gridHeight-1 For loopx = 0 To gridWidth-1 If grid(loopx,loopy) = 0 grid(loopx,loopy) = Rand(1,5) showRow=MilliSecs() While MilliSecs() < showRow + 25 Draw(False) Wend End If Next Next For loopy = gridHeight-1 To 0 Step -1 For loopx = gridWidth-1 To 0 Step -1 grid(loopx,loopy) = 0 showRow=MilliSecs() While MilliSecs() < showRow + 20 Draw(False) Wend Next Next End End Function Type Frag ;particles Field x#,y#,xs#,ys# Field cell End Type Function makeexplosion(xe,ye,Inten,part,block) For k=1 To part f.Frag=New Frag f\x=xe an=Rnd(0,359) f\y=ye f\xs=0 f\ys=Sin( an ) * -2 f\cell = block Next End Function Function UpdateExplosion() For f.Frag=Each Frag f\xs=f\xs*0.99 f\ys=f\ys*0.99 f\x=f\x+f\xs f\y=f\y+f\ys f\ys=f\ys+0.06 Color 255,255,255 DrawImage gridblocks,f\x,f\y,f\cell If f\x<0 Or f\x>=640 Or f\y>=480 Delete f EndIf Next End Function Type moveObject Field x,y Field px,py Field score End Type Function move() For loopObjects.moveObject = Each moveObject ang#=0 ang=ATan2(loopObjects\py-loopObjects\y,loopObjects\px-loopObjects\x) loopObjects\x=loopObjects\x+Cos(ang)*3 loopObjects\y=loopObjects\y+Sin(ang)*3 jf_text(small_font,loopObjects\x,loopObjects\y,loopObjects\score,1,1,500) If Abs(loopObjects\x-loopObjects\px)<2 And Abs(loopObjects\y-loopObjects\py)<2 Then score = score + loopObjects\score PlaySound boing Delete loopObjects End If Next End Function Function setPath(x,y,futureX,futureY,objectScore) createPath.moveObject = New moveObject createPath\x = x createPath\y = y createPath\px = futureX createPath\py = futureY createPath\score = objectScore End Function |