naja, nicht ein fertiges Spiel, es fehlen die Punktezählung, Levels, grafische Gestalltung etc. Es ist eigentlich nur das Grundgerüst in Endlosmodus.
Ich hab mich immer gewundert, wie man eine schnelle Abfrage bei einen "hexagon"-Spielfeld (wie in Puzzle-Bobble) machen kann, ohne tausend Kanten zu überprüfen. Der Gag kam mir erst letztens in einen Video zu einen anderen Spiel, das statt Kugeln einfach Quadrate nahm. Dann sieht man sofort den Trick: Jede zweite Zeile ist einfach um eine halbe Kästchenbreite verschoben! Und das ist sehr schnell und einfach umgesetzt.
Hier der Quellcode, vielleicht mag es ja wer zu einen vollwertigen Spiel ausbauen.
Und nur ein Tip, falls es wer macht: Die Zielhilfe sollte nicht dauerhaft aktiv sein. Und der Pfeil unten sollte nicht auf den Mauszeiger zeigen. Am besten die Maus unsichtbar machen und mit links/rechts-Bewegung den Winkel des Pfeils ändern - feintuning mit Mausrad. Ich wollte in der Demo nicht den Mauszeiger einfangen. Zum testen eher Unpraktisch.
Code: Alles auswählen
EnableExplicit
UsePNGImageEncoder()
CompilerIf Not Defined(Point,#PB_Structure)
Structure Point
x.i
y.i
EndStructure
CompilerEndIf
DeclareModule Game
EnableExplicit
#MaxColor=9
CompilerIf Not Defined(Point,#PB_Structure)
Structure Point
x.i
y.i
EndStructure
CompilerEndIf
Enumeration GameRule
#Rule_MaxColor
#Rule_AddLines
#Rule_LowerTop
#Rule_TopReflect
EndEnumeration
Enumeration GameEvent
#GameEvent_None
#GameEvent_Win
#GameEvent_Loose
#GameEvent_Continue
EndEnumeration
Declare New()
Declare Free()
Declare SetActive(*x)
Declare GetActive()
Declare GetArrowPos(*screen.Point)
Declare GameEvent(isClick,Angel.f)
Declare Set(MaxX=8, MaxY=11, SmallerLines=1, Size=32, ArrowOffset=32*2)
Declare StartEndless(lines=5,MaxColor=#MaxColor)
Declare StartLevel(LevelData.s,BallList.s="")
Declare SetGameRule(what,value)
Declare GetGameRule(what)
EndDeclareModule
Module game;-- GAME!
Declare AddLine(WallEnable=#False)
#MaxDuckPhase=4
Enumeration type
#Type_Empty
#Type_Wall
#Type_Top
#Type_Stone
#Type_BallShrink
#Type_BallFall
#Type_DuckRest
#Type_DuckGrabNextcolor
#Type_DuckLoadBall
EndEnumeration
Structure sField
type.i
color.i
EndStructure
Structure sBallAnimation
type.i
count.i
x.f
y.f
ax.f
ay.f
color.i
EndStructure
Enumeration State
#State_None
#State_AtArrow
#State_Flying
#State_GrabBall
#State_LoadBall
#State_BallLoaded
#State_GrabBallPreview
#State_GrabBallDuck
#State_GrabBallLoaded
EndEnumeration
Structure sBall
color.i
state.i
x.f
y.f
ax.f
ay.f
EndStructure
#Gravity=0.3
#ShakeCount=10
#MaxNeighbor=5
#DuckSlowAnimation=2*16 ; skip 2 frames
#MaxPopAnimation=10
Structure _scField
MaxX.i
MaxY.i
SmallerLines.i
OffsetX.i
OffsetY.i
Width.i
Height.i
FullHeight.i
BottomLimit.i
BorderSize.i
EndStructure
Structure _scStone
Size.i
Radius.i
Height.i
Speed.i
Collision.f
Collision45.f
EndStructure
Structure _scArrow
Offset.i
X.i
Y.i
Size.i
EndStructure
Structure _sDuck
phase.i
slow.i
grab.i
AnimationType.i
EndStructure
Enumeration specialcolor
#ColorTop=#MaxColor+1
#ColorWall
#lastColor
EndEnumeration
Structure sGame ;- sGame
cField._scField
cStone._scStone
cArrow._scArrow
ForcedBallList.s
Oddoffset.i
FieldOffsetY.i
NextColorState.i
MaxColor.i
Ball.sBall
Duck._sDuck
SetBalls.i
NextColor.i
AddLines.i
AddTop.i
LowerTop.i
TopReflect.i
TopLevel.i
ArrowSprite.i
FieldBackSprite.i
DotSprite.i
Array DuckSprite.i(#MaxDuckPhase,1,1);phase,grab,fore/back
Array StoneSprite.i(#lastColor)
Array PopStoneSprite.i(#MaxColor,#MaxPopAnimation)
Array Field.SField(1,1)
Array ShadowField.i(1,1)
List BallAnimation.sBallAnimation()
EndStructure
Global *game.sGame
Global Dim Color(#MaxColor)
Procedure MyRGB(rgb,rgb2,pro.f,int=255)
Protected r=Red(rgb) * (1.0-pro)+Red(rgb2)*pro
Protected g=Green(rgb) * (1.0-pro)+Green(rgb2)*pro
Protected b=Blue(rgb)* (1.0-pro)+Blue(rgb2)*pro
If r>255:r=255:EndIf
If g>255:g=255:EndIf
If b>255:b=255:EndIf
ProcedureReturn RGBA(r,g,b,int)
EndProcedure
Procedure Poly(x=-65000,y=-65000,rgb=-1)
Static oldx,oldy
If rgb=-1:rgb=RGBA(255,255,255,255):EndIf
If x<>-65000 And y<>-65000
If oldx=-65000 Or oldy=-65000
Plot(x,y,rgb)
Else
LineXY(oldx,oldy,x,y,rgb)
EndIf
EndIf
oldx=x:oldy=y
EndProcedure
Procedure CreateFieldBack()
Protected img
img=CreateImage(#PB_Any,*game\cField\Width + *game\cField\BorderSize*2, *game\cField\FullHeight + *game\cField\BorderSize*2,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(*game\cField\BorderSize, *game\cField\BorderSize, *game\cField\Width, *game\cField\FullHeight, RGBA(30,30,30,128))
Line(*game\cField\BorderSize, *game\cField\BorderSize + *game\cField\BottomLimit , *game\cField\Width ,1,RGBA(60,60,60,255))
Line(*game\cField\BorderSize-1,*game\cField\BorderSize-1, 1, *game\cField\FullHeight+2, RGBA(255,255,255,255))
Line(*game\cField\BorderSize-1,*game\cField\BorderSize-1, *game\cField\Width+2,1, RGBA(255,255,255,255))
Line(*game\cField\BorderSize+*game\cField\Width,*Game\cField\BorderSize-1, 1, *game\cField\FullHeight+2, RGBA(255,255,255,255))
StopDrawing()
*game\FieldBackSprite=CreateSprite(#PB_Any,*game\cField\Width + *game\cField\BorderSize*2, *game\cField\FullHeight + *game\cField\BorderSize*2,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(*game\FieldBackSprite))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(img),0,0)
StopDrawing()
FreeImage(img)
EndProcedure
Procedure CreateDot()
Protected size=64
Protected img
img=CreateImage(#PB_Any,size,size,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_AllChannels)
Circle(size/2,size/2,size/10,RGBA(0,0,0,128))
Circle(size/2,size/2,size/10-4,RGBA(255,255,255,128))
StopDrawing()
*game\DotSprite=CreateSprite(#PB_Any,*game\cStone\Size,*game\cStone\Size,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(*game\DotSprite))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(img),0,0,*game\cStone\Size,*game\cStone\Size)
StopDrawing()
FreeImage(img)
EndProcedure
Procedure CreateArrow()
Protected size=64
Protected img
img=CreateImage(#PB_Any,size*2,size*2,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_AllChannels)
Circle(size,size,size*4/5,RGBA(128,128,128,128))
Circle(size,size,size*4/5-4,RGBA(0,0,0,0))
poly()
poly(size/2,size,RGBA(255,255,255,255))
poly(size,0,RGBA(255,255,255,255))
poly(size+size/2,size,RGBA(255,255,255,255))
poly(size/2,size,RGBA(255,255,255,255))
FillArea(size,size/2,RGB(255,255,255),RGBA(255,255,255,255))
StopDrawing()
*game\ArrowSprite=CreateSprite(#PB_Any,*game\cArrow\Size*2,*game\cArrow\Size*2,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(*game\ArrowSprite))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(img),0,0,*game\cArrow\Size*2,*game\cArrow\Size*2)
StopDrawing()
FreeImage(img)
EndProcedure
Procedure CreateDruck()
Protected sprFore,sprBack
Protected size=64;*game\cStone\Size
Protected x=size*2
Protected y=size*2
Protected phase,grab
Protected BallX,BallY
Protected img
img=CreateImage(#PB_Any,size*4,size*3,32,#PB_Image_Transparent)
For grab=0 To 1
For phase=0 To #MaxDuckPhase
BallX =x-*game\cStone\Size*(1.0-2.0*phase/4.0)
BallY = y
If *game\DuckSprite(phase,grab,0)
FreeSprite(*game\DuckSprite(phase,grab,0))
EndIf
If *game\DuckSprite(phase,grab,1)
FreeSprite(*game\DuckSprite(phase,grab,1))
EndIf
;Background
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0,0,size*4,size*3,RGBA(0,0,0,0))
DrawingMode(#PB_2DDrawing_AllChannels )
Ellipse(x,y,size*0.60,size*0.45, RGBA(255,255,0,255) )
If grab
Circle(BallX , BallY, *game\cStone\Radius/3, RGBA(255,0,255,255))
EndIf
;Head
Protected headx=x-size*0.2 + size*0.4*phase/4
Protected heady=y-size*0.7
Circle(headx,heady,size*0.5, RGBA(255,255,0,255) )
;auge links
If phase>0
Ellipse(headx-size* (0.2- 0.6*phase/4.0) ,heady-size*0.2,size*0.1,size*0.2,RGBA(255,255,255,255))
DrawingMode(#PB_2DDrawing_Outlined)
Ellipse(headx-size* (0.2- 0.6*phase/4.0),heady-size*0.2,size*0.1,size*0.2,RGBA(0,0,0,255))
DrawingMode(#PB_2DDrawing_Default)
Ellipse(headx-size* (0.2- 0.6*phase/4.0),heady-size*0.1,size*0.1,size*0.1,RGBA(0,0,0,255))
EndIf
;schnabel
DrawingMode(#PB_2DDrawing_AllChannels)
Ellipse(headx-size*(0.6 - 1.2*phase/4.0) ,heady+size*0.2,size*0.3,size*0.2,RGBA(255,64,0,255) )
;auge rechts
If phase<4
Ellipse(headx-size* (0.4- 0.6*phase/4.0) ,heady-size*0.2,size*0.1,size*0.2,RGBA(255,255,255,255))
DrawingMode(#PB_2DDrawing_Outlined)
Ellipse(headx-size* (0.4- 0.6*phase/4.0) ,heady-size*0.2,size*0.1,size*0.2,RGBA(0,0,0,255))
DrawingMode(#PB_2DDrawing_Default)
Ellipse(headx-size* (0.4- 0.6*phase/4.0),heady-size*0.1,size*0.1,size*0.1,RGBA(0,0,0,255))
EndIf
StopDrawing()
*game\DuckSprite(phase,grab,0)=CreateSprite(#PB_Any,*game\cStone\Size*4,*game\cStone\Size*3,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(*game\DuckSprite(phase,grab,0)))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(img),0,0,*game\cStone\Size*4,*game\cStone\Size*3)
StopDrawing()
;Foreground
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0,0,size*4,size*3,RGBA(0,0,0,0))
DrawingMode(#PB_2DDrawing_AllChannels)
Circle(headx,heady,size*0.5, RGBA(255,255,0,255) )
;auge links
If phase>0
Ellipse(headx-size* (0.2- 0.6*phase/4.0) ,heady-size*0.2,size*0.1,size*0.2,RGBA(255,255,255,255))
DrawingMode(#PB_2DDrawing_Outlined)
Ellipse(headx-size* (0.2- 0.6*phase/4.0),heady-size*0.2,size*0.1,size*0.2,RGBA(0,0,0,255))
DrawingMode(#PB_2DDrawing_Default)
Ellipse(headx-size* (0.2- 0.6*phase/4.0),heady-size*0.1,size*0.1,size*0.1,RGBA(0,0,0,255))
EndIf
;schnabel
DrawingMode(#PB_2DDrawing_AllChannels)
Ellipse(headx-size*(0.6 - 1.2*phase/4.0) ,heady+size*0.2,size*0.3,size*0.2,RGBA(255,64,0,255) )
;auge rechts
If phase<4
Ellipse(headx-size* (0.4- 0.6*phase/4.0) ,heady-size*0.2,size*0.1,size*0.2,RGBA(255,255,255,255))
DrawingMode(#PB_2DDrawing_Outlined)
Ellipse(headx-size* (0.4- 0.6*phase/4.0) ,heady-size*0.2,size*0.1,size*0.2,RGBA(0,0,0,255))
DrawingMode(#PB_2DDrawing_Default)
Ellipse(headx-size* (0.4- 0.6*phase/4.0),heady-size*0.1,size*0.1,size*0.1,RGBA(0,0,0,255))
EndIf
StopDrawing()
*game\DuckSprite(phase,grab,1)=CreateSprite(#PB_Any,*game\cStone\Size*4,*game\cStone\Size*3,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(*game\DuckSprite(phase,grab,1)))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(img),0,0,*game\cStone\Size*4,*game\cStone\Size*3)
StopDrawing()
Next
Next
FreeImage(img)
EndProcedure
Procedure CreateStone()
Protected i,rgb,a
Protected size=64
Protected img,img2
img=CreateImage(#PB_Any,size,size,32,#PB_Image_Transparent )
img2=CreateImage(#PB_Any,size*2,size*2,32,#PB_Image_Transparent )
For i=0 To #MaxColor
rgb=Color(i)
If *game\StoneSprite(i)
FreeSprite(*game\StoneSprite(i))
EndIf
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_Default)
Box(0,0,size,size,myrgb(rgb,RGB(0,0,0),0.5))
Circle( size/2.6,size/2.6,size/2.5,rgb)
Circle( size/4,size/4,size/4,myrgb(rgb,RGB(255,255,255),0.5))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0,0,size,size,RGBA(0,0,0,0))
Circle(size/2,size/2,size/2-1,RGBA(255,255,255,255))
StopDrawing()
*game\StoneSprite(i)=CreateSprite(#PB_Any,*game\cStone\Size,*game\cStone\Size,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(*game\StoneSprite(i)))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(img),0,0,*game\cStone\Size,*game\cStone\Size)
StopDrawing()
For a=0 To #MaxPopAnimation
If *game\PopStoneSprite(i,a)
FreeSprite(*game\PopStoneSprite(i,a))
EndIf
StartDrawing(ImageOutput(img2))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0,0,size*2,size*2,RGBA(0,0,0,0))
DrawingMode(#PB_2DDrawing_AllChannels )
Circle(size,size, size/2+(size/2)*a/#MaxPopAnimation, MyRGB(rgb,RGB(255,255,255),0.5,255-255 *a/#MaxPopAnimation))
Circle(size,size, size/2+(size/2)*a/#MaxPopAnimation-1, MyRGB(rgb,0,0,255-255 *a/#MaxPopAnimation))
Circle(size,size, size/2+(size/2)*a/#MaxPopAnimation-2, MyRGB(rgb,RGB(0,0,0),0.5,255-255 *a/#MaxPopAnimation))
Circle(size,size, size/2+(size/2)*a/#MaxPopAnimation-3, RGBA(0,0,0,0))
StopDrawing()
*game\PopStoneSprite(i,a)=CreateSprite(#PB_Any,*game\cStone\Size*2,*game\cStone\Size*2,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(*game\PopStoneSprite(i,a)))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(img2),0,0,*game\cStone\Size*2,*game\cStone\Size*2)
StopDrawing()
Next
Next
If *game\StoneSprite(#ColorWall)
FreeSprite(*game\StoneSprite(#ColorWall))
EndIf
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0,0,size*2,size*2,RGBA(0,0,0,0))
DrawingMode(#PB_2DDrawing_AllChannels )
poly()
poly(size/2-*game\cStone\Collision ,size/2)
poly(size/2-*game\cStone\Collision45,size/2-*game\cStone\Collision45)
poly(size/2+*game\cStone\Collision45,size/2-*game\cStone\Collision45)
poly(size/2+*game\cStone\Collision ,size/2)
poly(size/2+*game\cStone\Collision45,size/2+*game\cStone\Collision45)
poly(size/2-*game\cStone\Collision45,size/2+*game\cStone\Collision45)
poly(size/2-*game\cStone\Collision ,size/2)
StopDrawing()
*game\StoneSprite(#ColorWall)=CreateSprite(#PB_Any,*game\cStone\Size,*game\cStone\Size,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(*game\StoneSprite(#ColorWall)))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(img),0,0,*game\cStone\Size,*game\cStone\Size)
StopDrawing()
If *game\StoneSprite(#ColorTop)
FreeSprite(*game\StoneSprite(#ColorTop))
EndIf
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0,0,size,size,RGBA(0,0,0,0))
DrawingMode(#PB_2DDrawing_AllChannels )
Protected r=size/2 -1
Protected dx=Cos(Radian(30))* r
Protected dy=Sin(Radian(30))* r
Circle(size/2,size/2,r,RGBA(128,128,128,255))
Circle(size/2,size/2,r-1,RGBA(0,0,0,0))
poly()
poly(size/2 ,size/2-r)
poly(size/2+dx ,size/2-dy)
poly(size/2+dx ,size/2+dy)
poly(size/2 ,size/2+r)
poly(size/2-dx ,size/2+dy)
poly(size/2-dx ,size/2-dy)
poly(size/2 ,size/2-r)
StopDrawing()
*game\StoneSprite(#ColorTop)=CreateSprite(#PB_Any,*game\cStone\Size,*game\cStone\Size,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(*game\StoneSprite(#ColorTop)))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(img),0,0,*game\cStone\Size,*game\cStone\Size)
StopDrawing()
FreeImage(img)
FreeImage(img2)
EndProcedure
Procedure DrawSprite(spr,x,y,int=255)
;ClipSprite(spr, *game\cField\OffsetX, *game\cField\OffsetY, *game\cField\Width, *game\cField\Height + *game\cArrow\Offset)
ClipSprite(spr,#PB_Default,#PB_Default,#PB_Default,#PB_Default)
Protected h=*game\cField\FullHeight
Protected w=*game\cField\Width
Protected sh=SpriteHeight(spr),sy=0
Protected sw=SpriteWidth(spr),sx=0
Protected xx=x,yy=y
xx-*game\cField\OffsetX
yy-*game\cField\Offsety
If xx>w
sw=0
ElseIf xx+sw>w
sw-( xx+sw - w)
EndIf
If yy>h
sh=0
ElseIf yy+sh>h
sh-( yy+sh - h)
EndIf
If xx+sw<=0
sw=0
ElseIf xx<=0
x-xx
sx=-xx
sw+xx
EndIf
If yy+sh<=0
sh=0
ElseIf yy<=0
y-yy
sy=-yy
sh+yy
EndIf
;If xx+sw> *game\cField\Width
; sw=(xx+sw) -*game\cField\Width +1
;EndIf
If sw>0 And sh>0 And sx>=0 And sy>=0
ClipSprite(spr,sx,sy,sw,sh)
DisplayTransparentSprite(spr,x,y,int)
EndIf
EndProcedure
Procedure DrawSpriteCenter(spr,x,y,int=255)
ClipSprite(spr,#PB_Default,#PB_Default,#PB_Default,#PB_Default)
x-SpriteWidth(spr)/2
y-SpriteHeight(spr)/2
DrawSprite(spr,x,y,int)
EndProcedure
Procedure DrawSpriteCenterUnclip(spr,x,y,int=255)
x-SpriteWidth(spr)/2
y-SpriteHeight(spr)/2
DisplayTransparentSprite(spr,x,y,int)
EndProcedure
Procedure Init()
Color(0)=RGBA(32,32,32,255)
Color(1)=RGBA(255,255,255,255)
Color(2)=RGBA(0,0,255,255)
Color(3)=RGBA(0,128,0,255)
Color(4)=RGBA(255,255,0,255)
Color(5)=RGBA(255,0,255,255)
Color(6)=RGBA(255,0,0,255)
Color(7)=RGBA(255,128,0,255)
Color(8)=RGBA(0,255,255,255)
Color(9)=RGBA(200,128,255,255)
EndProcedure
Init()
Procedure New()
*game=AllocateStructure(sGame)
ProcedureReturn *game
EndProcedure
Procedure Free()
FreeStructure(*game)
*game=#Null
EndProcedure
Procedure SetActive(*x)
*game=*x
EndProcedure
Procedure GetActive()
ProcedureReturn *game
EndProcedure
Procedure Set(MaxX=8, MaxY=11, SmallerLines=1, Size=32, ArrowOffset=32*2)
*game\cField\MaxX = MaxX
*game\cField\MaxY = MaxY
*game\cField\SmallerLines = SmallerLines
*game\cStone\Size = Size
*game\cStone\Radius = Size/2
*game\cStone\Height =(Sqr(3.0)/2.0)*(size)
*game\cStone\Speed = Size /3
*game\cStone\Collision = Size /2 - (Size - *game\cStone\Height)
*game\cStone\Collision45 = *game\cStone\Collision * 0.70710678118654746 ; 45 angel
Dim *game\Field(MaxX+1, MaxY)
Dim *game\Shadowfield(MaxX+1,MaxY)
*game\OddOffset=0
*game\FieldOffsetY=0
*game\cField\Height = MaxY * *game\cStone\Height
*game\cField\Width = MaxX * Size + (1 - SmallerLines) * Size/2
*game\cField\FullHeight = *game\cField\Height + ArrowOffset + size
*game\cField\BottomLimit = *game\cField\Height -*game\cStone\Height + (*game\cStone\Size-*game\cStone\Height)
*game\cField\OffsetX = (ScreenWidth() - *game\cField\Width) / 2
*game\cField\OffsetY = (ScreenHeight() - *game\cField\FullHeight) /2
*game\cfield\BorderSize=size
*game\cArrow\Offset = ArrowOffset
*game\cArrow\x = *game\cField\Width/2 + *game\cField\OffsetX
*game\cArrow\y = *game\cField\Height + ArrowOffset + *game\cField\OffsetY -1
*game\cArrow\Size = Size
CreateStone()
CreateDruck()
CreateArrow()
CreateDot()
CreateFieldBack()
*game\Duck\phase=#MaxDuckPhase/2
EndProcedure
Procedure GetArrowPos(*screen.Point)
*screen\x=*game\cArrow\x
*screen\y=*game\cArrow\y
EndProcedure
Macro OddY(cy): ((cy+*game\OddOffset)%2) : EndMacro
Macro OddX(cy): (*game\cField\SmallerLines * OddY(cy)) : EndMacro
Procedure InField(cx,cy)
ProcedureReturn Bool( cx>=1 And cx <= *game\cField\MaxX - OddX(cy) And cy >= 0 And cy <= *game\cField\MaxY )
EndProcedure
Procedure InitField()
Protected x,y
*game\OddOffset=1
*game\FieldOffsetY=0
If *game\TopReflect
For x=0 To *game\cField\MaxX+1
*game\Field(x,0)\type=#Type_Wall
Next
Else
For x=0 To *game\cField\MaxX+1
*game\Field(x,0)\type=#Type_Top
Next
EndIf
For y=1 To *game\cField\MaxY
*game\Field(0,y)\type=#Type_Wall
For x=1 To *game\cField\MaxX - OddX(y)
*game\Field(x,y)\type=#Type_Empty
Next
If OddX(y)
*game\Field( *game\cField\MaxX ,y )\type=#Type_Wall
EndIf
*game\Field( *game\cField\MaxX+1 ,y )\type=#Type_Wall
Next
*game\TopLevel=*game\cStone\Height/2
EndProcedure
Procedure StartEndless(lines=5,MaxColor=#MaxColor)
Protected i
InitField()
*game\AddLines=0
*game\AddTop=0
*game\SetBalls=0
*game\NextColor=-1
*game\Ball\state=#State_None
*game\NextColorState=#State_GrabBall
*game\Duck\grab=#State_GrabBallPreview
If MaxColor<0 : MaxColor=0 : ElseIf MaxColor>#MaxColor : MaxColor=#MaxColor : EndIf
*game\MaxColor=MaxColor
*game\ForcedBallList=""
If lines>=1
For i=1 To lines
AddLine()
Next
If *game\TopReflect
*game\Field(1,1)\type=#Type_Top
*game\Field(*game\cField\MaxX- OddX(1),1)\type=#type_top
EndIf
EndIf
EndProcedure
Procedure StartLevel(LevelData.s,BallList.s="")
Protected x,y
Protected line.s,char,MaxInsertY=0
LevelData=ReplaceString(LevelData," ","")
BallList=ReplaceString(BallList," ","")
InitField()
*game\AddLines=0
*game\AddTop=0
*game\SetBalls=0
*game\NextColor=-1
*game\Ball\state=#State_None
*game\NextColorState=#State_GrabBall
*game\Duck\grab=#State_GrabBallPreview
*game\MaxColor=#MaxColor
*game\ForcedBallList=BallList
For y=1 To *game\cField\MaxY-1
line=StringField(LevelData,y,"|")
For x=1 To *game\cField\MaxX - OddX(y)
char=Asc(Mid(line,x,1))
Select char
Case '0' To '9'
*game\Field(x,y)\type=#Type_Stone
*game\Field(x,y)\color=char-'0'
MaxInsertY=y
EndSelect
Next
Next
*game\FieldOffsetY= *game\cStone\Height * MaxInsertY
EndProcedure
Procedure SetGameRule(what,value)
Select what
Case #Rule_MaxColor: *game\MaxColor=value
Case #Rule_AddLines: *game\AddLines=value
Case #Rule_LowerTop: *game\LowerTop=value
Case #Rule_TopReflect: *game\TopReflect=value
EndSelect
EndProcedure
Procedure GetGameRule(what)
Select what
Case #Rule_MaxColor: ProcedureReturn *game\MaxColor
Case #Rule_AddLines: ProcedureReturn *game\AddLines
Case #Rule_LowerTop: ProcedureReturn *game\LowerTop
Case #Rule_TopReflect: ProcedureReturn *game\TopReflect
EndSelect
EndProcedure
Procedure GetRandomColor()
Protected x,y,i,rnd,ret
If *game\ForcedBallList<>""
rnd=Asc(*game\ForcedBallList)
*game\ForcedBallList=Mid(*game\ForcedBallList,2)
Select rnd
Case '0' To '9'
ProcedureReturn rnd-'0'
EndSelect
EndIf
Dim CountColors(#MaxColor)
For x=1 To *game\cField\MaxX
For y=1 To *game\cField\MaxY
If *game\Field(x,y)\type=#Type_Stone
CountColors( *game\Field(x,y)\color ) +1
EndIf
Next
Next
Protected count=0
For i=0 To #MaxColor
If CountColors(i)>0
count+1
EndIf
Next
If count=0
ProcedureReturn Random(*game\MaxColor)
EndIf
rnd=Random(count,1)
For i=0 To #MaxColor
If CountColors(i)>0
rnd-1
If rnd=0
ret=i
Break
EndIf
EndIf
Next
ProcedureReturn ret
EndProcedure
Procedure Neighbor(*org.Point, *coor.Point, nb)
CopyStructure(*org,*coor, Point)
Select nb
Case 0:*coor\x-1
Case 1:*coor\x-(-OddY(*coor\y)+1):*coor\y-1
Case 2:*coor\x-(-OddY(*coor\y) ):*coor\y-1
Case 3:*coor\x+1
Case 4:*coor\x-(-OddY(*coor\y) ):*coor\y+1
Case 5:*coor\x-(-OddY(*coor\y)+1):*coor\y+1
EndSelect
If Not InField(*coor\x,*coor\y)
*coor\x=0:*coor\y=0
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure ScreenToCoord(sx, sy,*coor.point)
sx - *game\cField\OffsetX
sy - *game\cField\OffsetY
If sx>=0 And sx<=*game\cField\Width
*coor\y = (sy+ *game\cStone\Height) / *game\cStone\Height
*coor\x = (sx+*game\cStone\Size - OddY(*coor\y) * *game\cStone\Radius) / *game\cStone\Size
If *coor\x<1
*coor\x=1
ElseIf *coor\x>*game\cField\MaxX-OddX(*coor\y)
*coor\x=*game\cField\MaxX-OddX(*coor\y)
EndIf
Else
*coor\x=0
*coor\y=0
ProcedureReturn #False
EndIf
If InField(*coor\x,*coor\y)
ProcedureReturn #True
EndIf
*coor\x=0
*coor\y=0
ProcedureReturn #False
EndProcedure
Procedure CoordToScreen(cx,cy,*Screen.point)
*Screen\x = (cx-1) * *game\cStone\Size + OddY(cy) * *game\cStone\Radius + *game\cField\OffsetX
*Screen\y = (cy-1) * *game\cStone\Height + *game\cField\OffsetY
EndProcedure
Procedure CornerCollision(bx.f,by.f)
Protected coord.point
If ScreenToCoord(bx,by,Coord)
ProcedureReturn Bool( *game\field(Coord\x,Coord\y)\type <> #Type_Empty )
EndIf
ProcedureReturn #False
EndProcedure
Procedure CheckCollision(bx.f,by.f)
ProcedureReturn Bool( CornerCollision(bx- *game\cStone\Collision,by) Or
CornerCollision(bx+ *game\cStone\Collision,by) Or
CornerCollision(bx,by- *game\cStone\Collision) Or
CornerCollision(bx,by+ *game\cStone\Collision) Or
CornerCollision(bx+ *game\cStone\Collision45,by+ *game\cStone\Collision45) Or
CornerCollision(bx- *game\cStone\Collision45,by+ *game\cStone\Collision45) Or
CornerCollision(bx+ *game\cStone\Collision45,by- *game\cStone\Collision45) Or
CornerCollision(bx- *game\cStone\Collision45,by- *game\cStone\Collision45) )
EndProcedure
Procedure CheckGameOver()
Protected x,ret=#False
For x=1 To *game\cField\MaxX-OddY(*game\cField\MaxY)
If *game\Field(x,*game\cField\MaxY)\type <> #Type_Empty
ret=#True
Break
EndIf
Next
ProcedureReturn ret
EndProcedure
Procedure CheckWin()
Protected x,y,ret=#True
For x=1 To *game\cField\MaxX
For y=1 To *game\cField\MaxY
If *game\Field(x,y)\type=#Type_Stone
ret=#False
Break 2
EndIf
Next
Next
ProcedureReturn ret
EndProcedure
Procedure.f AngelToScreen(deg.f)
ProcedureReturn Radian(deg+270)
EndProcedure
Procedure DrawBackGround()
DisplayTransparentSprite(*game\FieldBackSprite, *game\cField\OffsetX - *game\cField\BorderSize, *game\cField\OffsetY - *game\cField\BorderSize)
EndProcedure
Procedure DrawField(shakeit)
Protected x,y,screen.point,rgb,ox,oy
Protected quake=0
;StartDrawing(ScreenOutput())
Select shakeit
Case 1:quake=6
Case 2:quake=4
Case 3:quake=2
EndSelect
For y=1 To *game\cField\MaxY
For x=1 To *game\cField\MaxX -OddX(y)
CoordToScreen(x,y,screen)
;DrawingMode(#PB_2DDrawing_Outlined)
;Circle(screen\x +#StoneSize/2, screen\y +#StoneSize/2,#StoneSize/2,RGB(60,60,60))
rgb=0
If quake
ox=Random(quake)-quake/2
oy=Random(quake)-quake/2
EndIf
Select *game\Field(x,y)\type
Case #Type_Top: RGB=*game\StoneSprite(#ColorTop):ox=0:oy=0
Case #Type_Wall: RGB=*game\StoneSprite(#ColorWall):ox=0:oy=0
Case #Type_Stone: rgb=*game\StoneSprite(*game\Field(x,y)\color)
EndSelect
If rgb
;MyCircle(screen\x + *game\cStone\Radius +ox, screen\y + *game\cStone\Radius +oy - *game\FieldOffsetY, *game\cStone\Radius, rgb)
DrawSprite(rgb,screen\x+ox, screen\y+oy - *game\FieldOffsetY)
EndIf
;DrawingMode(#PB_2DDrawing_Transparent)
;DrawText(screen\x, screen\y +#StoneSize/3,""+Hex(x)+"x"+Hex(y),RGB(70,70,70))
Next
Next
;StopDrawing()
EndProcedure
Procedure DrawArrow(Angel.f)
;ZoomSprite(*game\ArrowSprite, #PB_Default , #PB_Default )
;RotateSprite(*game\ArrowSprite,0,#PB_Absolute)
;ZoomSprite(*game\ArrowSprite,*game\cArrow\Size*2, *game\cArrow\Size*2 )
RotateSprite(*game\ArrowSprite,Angel,#PB_Absolute)
DrawSpriteCenterUnclip(*game\ArrowSprite,*game\cArrow\X, *game\cArrow\y )
EndProcedure
Procedure DrawBall(x,y,color,light=#False)
If color>=0 And color<=#MaxColor
; StartDrawing(ScreenOutput())
; If light
; DrawingMode(#PB_2DDrawing_Outlined)
; EndIf
; MyCircle(x,y,*game\cStone\Radius ,color(color))
; StopDrawing()
DrawSpriteCenter(*game\StoneSprite(color),x,y,255-Light*128)
EndIf
EndProcedure
Procedure ClearShadowField()
Protected x,y
For x=0 To *game\cField\MaxX+1
For y=0 To *game\cField\MaxY
*game\ShadowField(x,y)=#Null
Next
Next
EndProcedure
Procedure CountSameColor(x,y,color)
Protected coord.point,Neighbor.point
Protected i
Protected count
If Not InField(x,y) Or *game\ShadowField(x,y)<>#Null
ProcedureReturn 0
EndIf
coord\x=x
coord\y=y
*game\ShadowField(x,y)=1
For i=0 To #MaxNeighbor
If Neighbor(coord, Neighbor, i)
If *game\ShadowField(Neighbor\x,Neighbor\y)=#Null
If *game\Field(Neighbor\x,Neighbor\y)\type=#Type_Stone And *game\Field(Neighbor\x,Neighbor\y)\color=color
count + CountSameColor(Neighbor\x,Neighbor\y,color)
Else
*game\ShadowField(Neighbor\x,Neighbor\y)=-1
EndIf
EndIf
EndIf
Next
ProcedureReturn count+1
EndProcedure
Procedure ClearSameColor()
Protected x,y,Screen.Point
For x=1 To *game\cField\MaxX
For y=1 To *game\cField\MaxY
If *game\ShadowField(x,y)>0 And *game\Field(x,y)\type=#Type_Stone
*game\Field(x,y)\type=#Type_Empty
CoordToScreen(x,y,Screen)
AddElement(*game\BallAnimation())
*game\BallAnimation()\x=Screen\x + *game\cStone\Radius
*game\BallAnimation()\y=Screen\y + *game\cStone\Radius
*game\BallAnimation()\color=*game\Field(x,y)\color
*game\BallAnimation()\type=#Type_BallShrink
EndIf
Next
Next
EndProcedure
Procedure FindLooseStones(x,y)
Protected i
Protected Coord.Point,Neighbor.Point
If *game\ShadowField(x,y)=#True Or *game\Field(x,y)\type = #Type_Empty
ProcedureReturn
EndIf
Coord\x=x
Coord\y=y
*game\ShadowField(x,y)=#True
For i=0 To #MaxNeighbor
If Neighbor(Coord,Neighbor,i)
If *game\ShadowField(Neighbor\x,Neighbor\y)=#Null And (*game\Field(Neighbor\x,Neighbor\y)\type=#Type_Stone Or *game\Field(Neighbor\x,Neighbor\y)\type=#Type_Top)
FindLooseStones(Neighbor\x,Neighbor\y)
EndIf
EndIf
Next
EndProcedure
Procedure ClearLooseStone()
Protected x,y,Screen.Point,count
For x=1 To *game\cField\MaxX
For y=1 To *game\cField\MaxY
If *game\ShadowField(x,y)=#Null And *game\Field(x,y)\type=#Type_Stone
*game\Field(x,y)\type=#Type_Empty
count+1
CoordToScreen(x,y,Screen)
AddElement(*game\BallAnimation())
*game\BallAnimation()\x = Screen\x + *game\cStone\Radius
*game\BallAnimation()\y = Screen\y + *game\cStone\Radius
*game\BallAnimation()\color = *game\Field(x,y)\color
*game\BallAnimation()\ay = (Random(10)-5) /10.0
*game\BallAnimation()\ax = (Random(10)-5) /10.0
*game\BallAnimation()\type = #Type_BallFall
EndIf
Next
Next
ProcedureReturn count
EndProcedure
Procedure PlaceStone(x,y,color)
Protected count,xi,yi
If InField(x,y) And *game\Field(x,y)\type=#Type_Empty
*game\field(x,y)\type=#Type_Stone
*game\field(x,y)\color=color
;3 same color
ClearShadowField()
count=CountSameColor(x,y,color)
If count>=3
ClearSameColor()
ClearShadowField()
For yi=0 To *game\cField\MaxY
For xi=1 To *game\cField\MaxX+OddY(yi)
If *game\ShadowField(xi,yi)=#Null And *game\Field(xi,yi)\type=#Type_Top
FindLooseStones(xi,yi)
EndIf
Next
Next
ClearLooseStone()
EndIf
EndIf
EndProcedure
Procedure DoBall(*ball.sBall)
Protected nx.f,ny.f
Protected isCollision
nx=*ball\x + *ball\ax
ny=*ball\y + *ball\ay
isCollision=#False
If *ball\ax<0 And nx< *game\cField\OffsetX + *game\cStone\Radius
*ball\ax = -*ball\ax
nx=*ball\x + *ball\ax
ElseIf *ball\ax>0 And nx> *game\cField\OffsetX + *game\cField\Width - *game\cStone\Radius
*ball\ax = -*ball\ax
nx=*ball\x + *ball\ax
EndIf
If ny< *game\cField\OffsetY + *game\TopLevel
If *game\TopReflect
*ball\ay=-*ball\ay
ny=*ball\y + *ball\ay
Else
isCollision=#True
EndIf
ElseIf ny> *game\cField\OffsetY + *game\cfield\Height + *game\cArrow\Offset
isCollision=#True
EndIf
If CheckCollision(nx,ny)
isCollision=#True
EndIf
If Not CornerCollision(nx,ny)
*ball\x=nx
*ball\y=ny
Else
isCollision=#True
EndIf
ProcedureReturn isCollision
EndProcedure
Procedure DrawBallAnimation()
Protected x,y
;StartDrawing(ScreenOutput())
;ClipOutput(*game\cField\OffsetX,*game\cField\Offsety,*game\cField\Width,*game\cField\Height)
ForEach *game\BallAnimation()
Select *game\BallAnimation()\type
Case #Type_BallShrink
*game\BallAnimation()\count +1
If *game\BallAnimation()\count=>0 And *game\BallAnimation()\count<=#MaxPopAnimation
DrawSpriteCenter(*game\PopStoneSprite( *game\BallAnimation()\color, *game\BallAnimation()\count), *game\BallAnimation()\x, *game\BallAnimation()\y)
Else
DeleteElement(*game\BallAnimation())
EndIf
Case #Type_BallFall
*game\BallAnimation()\x + *game\BallAnimation()\ax
*game\BallAnimation()\y + *game\BallAnimation()\ay
*game\BallAnimation()\ay + #Gravity
x=*game\BallAnimation()\x - *game\cField\OffsetX
y=*game\BallAnimation()\y - *game\cField\OffsetY
If x>-*game\cStone\Radius And x<*game\cField\Width+ *game\cStone\Radius And y>0 And y< *game\cArrow\y + *game\cStone\Radius
;MyCircle(*game\BallAnimation()\x,*game\BallAnimation()\y, *game\cStone\Radius, color(*game\BallAnimation()\color))
DrawBall(*game\BallAnimation()\x,*game\BallAnimation()\y,*game\BallAnimation()\color)
Else
DeleteElement(*game\BallAnimation())
EndIf
Default
DeleteElement(*game\BallAnimation())
EndSelect
Next
;StopDrawing()
EndProcedure
Procedure DrawHelpLine()
Protected HelperLine.sBall
Protected Coord.Point,Screen.Point
CopyStructure(*game\Ball,HelperLine,sBall)
If HelperLine\ay<-0.5
Repeat
If Not DoBall(HelperLine)
DrawSpriteCenterUnclip(*game\DotSprite,HelperLine\x,HelperLine\y)
Else
Break
EndIf
ForEver
ScreenToCoord(HelperLine\x,HelperLine\y,Coord)
CoordToScreen(Coord\x,Coord\y,Screen)
Screen\x=Screen\x+ *game\cStone\Radius
Screen\y=Screen\y+ *game\cStone\Radius
DrawBall(Screen\x,Screen\y,HelperLine\color,#True)
EndIf
EndProcedure
Structure sSortColor
count.i
realColor.i
EndStructure
Procedure AddLine(WallEnable=#False)
Protected y,x
Protected i,rnd
Dim ColorTable.sSortColor(#MaxColor)
For x=1 To *game\cField\MaxX
For y=1 To *game\cField\MaxY
If *game\Field(x,y)\type=#Type_Stone
ColorTable( *game\Field(x,y)\color )\count +1
EndIf
Next
Next
For i=0 To #MaxColor
ColorTable(i)\realColor=i
If ColorTable(i)\count>0
ColorTable(i)\count+100
Else
ColorTable(i)\count+Random(50)
EndIf
Next
SortStructuredArray(ColorTable(),#PB_Sort_Descending,OffsetOf(sSortColor\count),#PB_Integer)
For y=*game\cField\MaxY To 2 Step -1
For x=1 To *game\cField\MaxX
CopyStructure(*game\Field(x,y-1),*game\Field(x,y),sField)
Next
Next
*game\OddOffset=(*game\OddOffset+1)%2
*game\Field(0,1)\type=#Type_Wall
For x=1 To *game\cField\MaxX -OddX(1)
If WallEnable
If *game\TopReflect
*game\Field(x,1)\type=#Type_Wall
Else
*game\Field(x,1)\type=#Type_Top
EndIf
Else
*game\Field(x,1)\type=#Type_Stone
*game\Field(x,1)\color=ColorTable(Random(*game\MaxColor))\realColor
EndIf
Next
If OddX(1)
*game\Field(*game\cField\MaxX,1)\type=#Type_Wall
EndIf
*game\Field(*game\cField\MaxX+1,1)\type=#Type_Wall
*game\FieldOffsetY + *game\cStone\Height
If WallEnable
*game\TopLevel + *game\cStone\Height
EndIf
EndProcedure
Procedure DrawDuck(x,y,phase,BallColor=-1)
Protected size=*game\cStone\Size
y+size/2*1.5
Protected BallX=x-*game\cStone\Size*(1.0-2.0*phase/4.0)
Protected BallY=y
x-size*2
y-size*2
If BallColor>=0
DrawSprite(*game\DuckSprite(phase,1,0),x,y)
DrawSpriteCenter(*game\StoneSprite(BallColor),BallX,BallY)
DrawSprite(*game\DuckSprite(phase,1,1),x,y)
Else
DrawSprite(*game\DuckSprite(phase,0,0),x,y)
DrawSprite(*game\DuckSprite(phase,0,1),x,y)
EndIf
EndProcedure
Procedure GameEvent(isClick,Angel.f)
Protected isGameOver
Protected rad.f
Protected coord.Point
DrawBackGround()
; ScreenToCoord(WindowMouseX(MainWindow), WindowMouseY(MainWindow), Coord)
; If InField(Coord\x, Coord\y)
; StartDrawing(ScreenOutput())
; DrawingMode(#PB_2DDrawing_Outlined)
; CoordToScreen(Coord\x,Coord\y,Screen)
; Circle(Screen\x +#StoneSize/2, Screen\y +#StoneSize/2, #StoneSize/2-2, RGB(255,255,255))
; For i=0 To 5
; Neighbor(Coord,Neighbor,i)
; If InField(Neighbor\x, Neighbor\y)
; CoordToScreen(Neighbor\x, Neighbor\y, Screen)
; Circle(Screen\x +#StoneSize/2, Screen\y +#StoneSize/2, #StoneSize/4-2, RGB(i*50,255,255))
; EndIf
; Next
; StopDrawing()
; EndIf
If *game\AddLines>0
*game\AddLines -1
AddLine()
If CheckGameOver()
isGameOver=#True
EndIf
EndIf
If *game\AddTop>0
*game\AddTop -1
AddLine(#True)
If CheckGameOver()
isGameOver=#True
EndIf
EndIf
Select *game\Ball\state
Case #State_None
If *game\Duck\grab = #State_GrabBallLoaded
*game\Ball\state=#State_AtArrow
*game\Duck\grab=#State_GrabBallPreview
*game\Ball\color=*game\NextColor
*game\Ball\x = *game\cArrow\x
*game\Ball\y = *game\cArrow\y
*game\NextColor=-1
EndIf
Case #State_AtArrow
rad=AngelToScreen(Angel)
*game\Ball\ax=Cos(rad)* *game\cStone\Speed
*game\Ball\ay=Sin(rad)* *game\cStone\Speed
If isClick
If *game\Ball\ay<-0.5
*game\Ball\state=#State_Flying
*game\NextColorState=#State_GrabBall
EndIf
Else
DrawHelpLine()
EndIf
Case #State_Flying
If DoBall(*game\Ball)
*game\Ball\state=#State_None
If ScreenToCoord(*game\Ball\x, *game\Ball\y, Coord)
PlaceStone(Coord\x, Coord\y, *game\Ball\color)
EndIf
*game\SetBalls+1
If *game\SetBalls>=#ShakeCount
*game\SetBalls=0
If *game\LowerTop
*game\AddTop+1
Else
*game\AddLines+1
EndIf
EndIf
If CheckGameOver()
isGameOver=#True
EndIf
EndIf
EndSelect
If *game\FieldOffsetY>0
*game\FieldOffsetY - *game\cStone\Speed
If *game\FieldOffsetY<0
*game\FieldOffsetY=0
EndIf
EndIf
DrawArrow(Angel)
If *game\Ball\state = #State_AtArrow Or *game\Ball\state = #State_Flying
DrawBall(*game\Ball\x,*game\Ball\y,*game\Ball\color)
EndIf
DrawField(#ShakeCount-*game\SetBalls)
DrawBallAnimation()
If *game\NextColor<0
*game\NextColor=GetRandomColor()
EndIf
If *game\Duck\slow < ElapsedMilliseconds()
*game\Duck\slow=ElapsedMilliseconds() + #DuckSlowAnimation
Select *game\NextColorState
Case #State_None
If *game\Duck\phase>#MaxDuckPhase/2
*game\Duck\phase-1
ElseIf *game\Duck\phase<#MaxDuckPhase/2
*game\Duck\phase+1
EndIf
;DrawBall(*game\cArrow\x + *game\cStone\Size*3 ,*game\cArrow\y,*game\NextColor)
Case #State_GrabBall
If *game\Duck\phase<#MaxDuckPhase
*game\Duck\phase+1
Else
*game\NextColorState=#State_LoadBall
*game\Duck\grab=#State_GrabBallDuck
EndIf
;
Case #State_LoadBall
If *game\Duck\phase>0
*game\Duck\phase-1
Else
*game\NextColorState=#State_BallLoaded
*game\Duck\grab=#State_GrabBallLoaded
EndIf
Case #State_BallLoaded
If *game\Duck\phase>#MaxDuckPhase/2
*game\Duck\phase-1
ElseIf *game\Duck\phase<#MaxDuckPhase/2
*game\Duck\phase+1
Else
*game\NextColorState=#State_None
EndIf
EndSelect
EndIf
Select *game\Duck\grab
Case #State_GrabBallPreview
DrawBall(*game\cArrow\x + *game\cStone\Size*3 ,*game\cArrow\y + *game\cStone\Radius ,*game\NextColor)
DrawDuck(*game\cArrow\x+*game\cStone\Size *1.5 ,*game\cArrow\y -*game\cStone\Radius,*game\Duck\phase)
Case #State_GrabBallDuck
DrawDuck(*game\cArrow\x+*game\cStone\Size *1.5 ,*game\cArrow\y -*game\cStone\Radius,*game\Duck\phase , *game\NextColor)
Case #State_GrabBallLoaded
DrawBall(*game\cArrow\x ,*game\cArrow\y,*game\NextColor)
DrawDuck(*game\cArrow\x+*game\cStone\Size *1.5 ,*game\cArrow\y -*game\cStone\Radius,*game\Duck\phase)
EndSelect
If isGameOver
ClearShadowField()
ClearLooseStone()
ProcedureReturn #GameEvent_Loose
ElseIf CheckWin()
ProcedureReturn #GameEvent_Win
EndIf
ProcedureReturn #GameEvent_None
EndProcedure
EndModule
Global MainWindow,PauseWindow
Global GadPause
Enumeration MyEvents
#MyEvents=#PB_Event_FirstCustomValue
EndEnumeration
Macro FailCheck(check,message)
If check=0
MessageRequester("Error",message)
End
EndIf
EndMacro
Procedure CenterPauseWindow()
Protected x=(WindowWidth(MainWindow)-WindowWidth(PauseWindow))/2 +WindowX(MainWindow)
Protected y=(WindowHeight(MainWindow)-WindowHeight(PauseWindow))/2 +WindowY(MainWindow)
ResizeWindow(PauseWindow,x,y,#PB_Ignore,#PB_Ignore)
EndProcedure
CompilerIf #PB_Compiler_OS=#PB_OS_Windows
Procedure WindowCallback(WindowId,Message,wParam,lParam)
Select Message
Case #WM_MOVING, #WM_SIZING
CenterPauseWindow()
EndSelect
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
CompilerEndIf
DeclareModule Control
Enumeration
#Keyboard
#Mouse
EndEnumeration
Declare Init(type)
Declare UnLock(x)
Declare Examine()
Declare DeltaX()
Declare DeltaY()
Declare Wheel()
Declare Fire()
Declare Escape()
EndDeclareModule
Module Control
Global ctrl
Procedure Init(type)
ctrl=type
Select ctrl
Case #Mouse:ProcedureReturn InitMouse()
Case #Keyboard:ProcedureReturn InitKeyboard()
EndSelect
EndProcedure
Procedure UnLock(x)
Select ctrl
Case #Mouse
ReleaseMouse(x)
EndSelect
EndProcedure
Procedure Examine()
Select ctrl
Case #Mouse : ProcedureReturn ExamineMouse()
Case #Keyboard : ProcedureReturn ExamineKeyboard()
EndSelect
EndProcedure
Procedure DeltaX()
Select ctrl
Case #Mouse:ProcedureReturn MouseDeltaX()
Case #Keyboard
If KeyboardPushed(#PB_Key_Left)
If KeyboardPushed(#PB_Key_LeftControl) Or KeyboardPushed(#PB_Key_RightControl)
ProcedureReturn -1
Else
ProcedureReturn -10
EndIf
ElseIf KeyboardPushed(#PB_Key_Right)
If KeyboardPushed(#PB_Key_LeftControl) Or KeyboardPushed(#PB_Key_RightControl)
ProcedureReturn 1
Else
ProcedureReturn 10
EndIf
EndIf
EndSelect
ProcedureReturn 0
EndProcedure
Procedure DeltaY()
Select ctrl
Case #Mouse:ProcedureReturn MouseDeltaY()
Case #Keyboard
If KeyboardPushed(#PB_Key_Up)
ProcedureReturn -1
ElseIf KeyboardPushed(#PB_Key_Down)
ProcedureReturn 1
EndIf
EndSelect
ProcedureReturn 0
EndProcedure
Procedure Wheel()
Select ctrl
Case #Mouse:ProcedureReturn MouseWheel()
Case #Keyboard
If KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_PageUp)
ProcedureReturn -1
ElseIf KeyboardPushed(#PB_Key_RightShift) Or KeyboardPushed(#PB_Key_PageDown)
ProcedureReturn 1
EndIf
EndSelect
ProcedureReturn 0
EndProcedure
Procedure Fire()
Select ctrl
Case #Mouse: ProcedureReturn MouseButton(#PB_MouseButton_Left)
Case #Keyboard
If KeyboardPushed(#PB_Key_Space) Or KeyboardPushed(#PB_Key_Return)
ProcedureReturn #True
EndIf
EndSelect
ProcedureReturn #False
EndProcedure
Procedure Escape()
Select ctrl
Case #Mouse: ProcedureReturn MouseButton(#PB_MouseButton_Right)
Case #Keyboard
If KeyboardPushed(#PB_Key_Escape)
ProcedureReturn #True
EndIf
EndSelect
ProcedureReturn #False
EndProcedure
EndModule
FailCheck(InitSprite(), "Can't open screen & sprite environment!")
MainWindow=OpenWindow(#PB_Any, 0, 0,800, 600, "Balls", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CompilerIf #PB_Compiler_OS=#PB_OS_Windows
SetWindowCallback(@WindowCallback(),MainWindow)
CompilerEndIf
FailCheck(MainWindow,"Can't open main window")
FailCheck(OpenWindowedScreen(WindowID(MainWindow), 0, 0,DesktopScaledX(WindowWidth(MainWindow)), DesktopScaledY(WindowHeight(MainWindow))),"Can't open windowed screen!")
PauseWindow=OpenWindow(#PB_Any,0,0,200,50,"pause",#PB_Window_BorderLess|#PB_Window_Invisible,WindowID(MainWindow))
FailCheck(PauseWindow,"Can't open pause window")
GadPause=ButtonGadget(#PB_Any,0,0,WindowWidth(PauseWindow),WindowHeight(PauseWindow),"PAUSE")
FailCheck(Control::Init(Control::#Keyboard),"Can't init control!")
SetWindowColor(MainWindow,RGB(0,255,0))
SetFrameRate(60)
Define event
Define mx,my,mw,oldmw
Define Screen.Point
Define isClick,Angel.f
Define maxColor=3
Define MouseGrab,leftHold
Define Pause=#False
Define timer
Define LevelData.s="6 6 4 4 2 2 3 3|"+
" 6 6 4 4 2 2 3|"+
"2 2 3 3 6 6 4 4|"+
" 2 3 3 6 6 4 4|"+
"- - - - - - - -|"+
" - - - - - - -|"+
"- - - - - - - -|"+
" - - - - - - -|"+
"- - - - - - - -|"+
" - - - - - - -|"
Define BallList.s=""
#ScaleAngel=0.1
#LimitAngel=80
Game::New()
Game::Set(8,11,1,DesktopScaledX(32));defaultvalues
Game::SetGameRule(Game::#Rule_LowerTop,#True)
;Game::SetGameRule(Game::#Rule_TopReflect,#True)
;Game::StartEndless(1,maxColor)
Game::StartLevel(LevelData,BallList)
Control::UnLock(#False):MouseGrab=#True
timer=AddWindowTimer(MainWindow,#PB_Any,2)
Define fpsTimer=ElapsedMilliseconds()
Define fpsDelay
Repeat
isClick=#False
Repeat
event=WaitWindowEvent()
If Pause
EndIf
Select event
Case #PB_Event_Timer
Break
Case #PB_Event_LeftClick
;isClick=#True
Case #PB_Event_CloseWindow
End
Case #PB_Event_ActivateWindow
If pause And EventWindow()=MainWindow
SetActiveWindow(PauseWindow)
SetActiveGadget(GadPause)
EndIf
Case #PB_Event_MoveWindow,#PB_Event_SizeWindow
If EventWindow()=MainWindow
CenterPauseWindow()
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case GadPause
Pause=#False
HideWindow(PauseWindow,#True)
EndSelect
EndSelect
ForEver
If Not pause
If MouseGrab And Control::Examine()
If Control::Escape()
Control::UnLock(#True)
MouseGrab=#False
Pause=#True
CenterPauseWindow()
HideWindow(PauseWindow,#False)
EndIf
If Control::Fire()
If leftHold=#False
isClick=#True
leftHold=#True
EndIf
Else
leftHold=#False
EndIf
mx=Control::DeltaX()
my=Control::DeltaY()
mw=Control::Wheel()
If mw And oldmw<>0
mw=0
Else
oldmw=mw
EndIf
If mw
If mw<0
Angel+#ScaleAngel
If Angel>#LimitAngel
Angel=#LimitAngel
EndIf
Else
Angel-#ScaleAngel
If Angel<-#LimitAngel
Angel=-#LimitAngel
EndIf
EndIf
ElseIf Abs(mx)>Abs(my)
Angel+mx*#ScaleAngel
If Angel > #LimitAngel
Angel=#LimitAngel
ElseIf Angel<-#LimitAngel
Angel=-#LimitAngel
EndIf
Else
If my<0
If Angel<0
Angel-my*#ScaleAngel
If Angel>0
Angel=0
EndIf
Else
Angel+my*#ScaleAngel
If Angel<0
Angel=0
EndIf
EndIf
Else
If Angel<0
Angel-my*#ScaleAngel
If Angel<-#LimitAngel
Angel=-#LimitAngel
EndIf
Else
Angel+my*#ScaleAngel
If Angel>#LimitAngel
Angel=#LimitAngel
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
ClearScreen(RGB(0,0,0))
Select game::GameEvent(isClick,Angel)
Case game::#GameEvent_Win
maxColor+1
Game::StartEndless(5,maxColor)
Case game::#GameEvent_Loose
Game::StartEndless(5,maxColor)
EndSelect
fpsDelay=15-(ElapsedMilliseconds()-fpsTimer)
;Debug fpsDelay
If fpsDelay>0
Delay(fpsDelay)
EndIf
FlipBuffers()
fpsTimer=ElapsedMilliseconds()
If IsScreenActive()
If Not MouseGrab
Control::UnLock(#False)
MouseGrab=#True
EndIf
Else
If MouseGrab
Control::UnLock(#True)
MouseGrab=#False
EndIf
EndIf
ForEver