thyphoon/LoopzRemix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial commit

Browse Source
This commit is contained in:
Yann Lebrun
2025-07-17 20:36:20 +02:00
commit 069402c4ec
37 changed files with 7849 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
AltonFont.dat Normal file
View File

Binary file not shown.

BIN
AltonFont2.dat Normal file
View File

Binary file not shown.

368
BitmapText.pbi Normal file
View File

@@ -0,0 +1,368 @@
;-NewBitmap
Structure myFontData
x.l
y.l
Width.l
Height.l
EndStructure
Structure BitmapFont
SpriteId.i
FirstClipSpriteId.l
AsciiStart.c
AsciiEnd.c
Array Tab.l(10)
Array FontData.myFontData(1)
EndStructure
Global NewList BitmapFont.BitmapFont()
Procedure.i CatchBitmapFont(FirstClipSpriteId.l,FontFileName.S)
Protected z.l
Protected *Mem,*Dat
*Mem=AddElement(BitmapFont())
BitmapFont()\FirstClipSpriteId=FirstClipSpriteId
*Dat=ReadDataPackage("Datas.pck",FontFileName+".dat")
BitmapFont()\AsciiStart=PeekB(*Dat)
BitmapFont()\AsciiEnd=PeekB(*Dat+1)
;Debug BitmapFont()\AsciiStart
;Debug BitmapFont()\AsciiEnd
;ShowMemoryViewer(*Dat,MemorySize(*Dat))
;End
ReDim BitmapFont()\FontData(BitmapFont()\AsciiEnd-BitmapFont()\AsciiStart)
CopyMemory(*Dat+2,@BitmapFont()\FontData(),SizeOf(myFontData)*ArraySize(BitmapFont()\FontData()))
FreeMemory(*Dat)
; If OpenFile(0,"Datas/"+FileName+".dat")
; BitmapFont()\AsciiStart=ReadCharacter(0,#PB_Ascii)
; BitmapFont()\AsciiEnd=ReadCharacter(0,#PB_Ascii)
; ReDim BitmapFont()\FontData(BitmapFont()\AsciiEnd-BitmapFont()\AsciiStart)
; ReadData(0,@BitmapFont()\FontData(),SizeOf(myFontData)*ArraySize(BitmapFont()\FontData()))
; CloseFile(0)
; EndIf
BitmapFont()\SpriteId=CatchSpriteFromPackage(#PB_Any,FontFileName+".png");LoadSprite(#PB_Any,"Datas/"+FileName+".png",#PB_Sprite_AlphaBlending)
If IsSprite(BitmapFont()\SpriteId)
For z=0 To ArraySize(BitmapFont()\FontData())
RecordSprite(FirstClipSpriteId+z,BitmapFont()\SpriteId,BitmapFont()\FontData(z)\x,BitmapFont()\FontData(z)\y,BitmapFont()\FontData(z)\Width,BitmapFont()\FontData(z)\Height,BitmapFont()\FontData(z)\Width/BitmapFont()\FontData(z)\Height, 1)
Next
Else
Debug "error load font"
End
EndIf
ProcedureReturn *Mem
EndProcedure
Procedure.i LoadBitmapFont(FirstClipSpriteId.l,FileName.s="MonoFont")
Protected z.l
Protected *Mem
*Mem=AddElement(BitmapFont())
BitmapFont()\FirstClipSpriteId=FirstClipSpriteId
If OpenFile(0,"Datas/"+FileName+".dat")
BitmapFont()\AsciiStart=ReadCharacter(0,#PB_Ascii)
BitmapFont()\AsciiEnd=ReadCharacter(0,#PB_Ascii)
ReDim BitmapFont()\FontData(BitmapFont()\AsciiEnd-BitmapFont()\AsciiStart)
ReadData(0,@BitmapFont()\FontData(),SizeOf(myFontData)*ArraySize(BitmapFont()\FontData()))
CloseFile(0)
EndIf
Debug FileName+".png"
BitmapFont()\SpriteId=LoadSprite(#PB_Any,"Datas/"+FileName+".png",#PB_Sprite_AlphaBlending)
If IsSprite(BitmapFont()\SpriteId)
For z=0 To ArraySize(BitmapFont()\FontData())
RecordSprite(FirstClipSpriteId+z,BitmapFont()\SpriteId,BitmapFont()\FontData(z)\x,BitmapFont()\FontData(z)\y,BitmapFont()\FontData(z)\Width,BitmapFont()\FontData(z)\Height,BitmapFont()\FontData(z)\Width/BitmapFont()\FontData(z)\Height, 1)
Next
Else
Debug "error load font"
End
EndIf
ProcedureReturn *Mem
EndProcedure
Procedure TextBitmapWidth(string.s)
Protected l.l,c.l,n.l,width.l,size.l=0
Protected tabIndex.l=0
For l=0 To Len(String)-1
c=Asc(Mid(String,l+1,1));-BitmapFont()\AsciiStart
width=0
If c=9 ; TAB
Width=BitmapFont()\Tab(tabIndex) -Size
tabIndex=tabIndex+1
ElseIf c=32; Espace and _
Width=GUI\HalfBlockSize
Else
c=c-BitmapFont()\AsciiStart
If c>=1 And c<BitmapFont()\AsciiEnd
Width=(BitmapFont()\FontData(c)\Width)*GUI\BlockSize/BitmapFont()\FontData(0)\Height*0.85
Else
Width=GUI\HalfBlockSize
EndIf
EndIf
size=size+Width
Next
ProcedureReturn size
EndProcedure
Procedure DrawingBitmapFont(FontId)
If FontId>-1 And FontID<ListSize(BitmapFont())
SelectElement(BitmapFont(),FontId)
EndIf
EndProcedure
Procedure DrawBitmapText(X.l,Y.l,String.s,Alpha.l=255)
Protected l.l,p.l,c.l,Spr.l,width.l
Protected tabIndex.l=0
For l=0 To Len(String)-1
c=Asc(Mid(String,l+1,1))
width=0
If c=9 ;TAB
Width=BitmapFont()\Tab(tabIndex) -X
tabIndex=tabIndex+1
ElseIf c=32; Espace
Width=GUI\HalfBlockSize
Else
c=c-BitmapFont()\AsciiStart
If c>=1 Or c<BitmapFont()\AsciiEnd
spr=BitmapFont()\FirstClipSpriteId+c
DisplayClipSprite(Spr,X ,Y,Alpha)
Width=(BitmapFont()\FontData(c)\Width) * GUI\BlockSize/BitmapFont()\FontData(0)\Height*0.85
Else
Width=GUI\HalfBlockSize
EndIf
EndIf
X=X+Width
Next
EndProcedure
Structure TextTitle
FondId.l
Text.s
Alpha.l
Selected.b
EndStructure
Structure Titles
List Title.TextTitle()
ScrollY.f ;Must be Float to scroll with low resolution
StartTime.q
LineSpacing.f
Alpha.f
Center.b ; #True center Text #False No center
Event.l ;
Speed.l ;6000
EndStructure
Structure TextData
FontId.l
String.s
X.l
Y.l
Width.l
Height.l
Opacity.l
Align.c
Depth.l
Autodestroy.b
EndStructure
Global NewList Texts.TextData()
Procedure NewText(FontId.l,String.s,X.l,Y.l,Opacity.l=255,Depth.l=#Spr_Depth_Front,Align=9)
Protected *Mem
*Mem=AddElement(Texts())
Texts()\FontId=FontId
Texts()\String=String
Texts()\X=X
Texts()\Y=Y
Texts()\Opacity=Opacity
Texts()\Depth=Depth
Texts()\Align=Align
DrawingBitmapFont(FontId)
Texts()\Width=TextBitmapWidth(String)
Texts()\Height=GUI\BlockSize
ProcedureReturn *Mem
EndProcedure
Procedure ChangeText(*TextData.TextData,String.s)
*TextData\String=String
DrawingBitmapFont(*TextData\FontId)
*TextData\Width=TextBitmapWidth(String)
EndProcedure
Procedure DisplayText(*Text.TextData)
Protected X.l
Protected Y.l
If *Text\Align & #Align_Hor_Left = #Align_Hor_Left
X=*Text\X
EndIf
If *Text\Align & #Align_Hor_Middle = #Align_Hor_Middle
X=*Text\X-*Text\Width/2;* Texts()\Size
EndIf
If *Text\Align & #Align_Hor_Right = #Align_Hor_Right
X=*Text\X-*Text\Width ;* Texts()\Size
EndIf
If *Text\Align & #Align_Ver_Top = #Align_Ver_Top
Y=*Text\Y
EndIf
If *Text\Align & #Align_Ver_Middle=#Align_Ver_Middle
Y=*Text\Y-*Text\Height/2;* Texts()\Size
EndIf
If *Text\Align & #Align_Ver_Bottom= #Align_Ver_Bottom
Y=*Text\Y-*Text\Height;* Texts()\Size
EndIf
DrawingBitmapFont(*Text\FontId)
DrawBitmapText(X,Y,*Text\String,*Text\Opacity)
;Debug Str(*Text\FontId)+" "+*Text\String
EndProcedure
Procedure DisplayTexts(Depth.l=#Spr_ALL)
Debug ListSize(Texts())
ForEach Texts()
If Depth=#Spr_ALL Or Texts()\Depth=Depth
DisplayText(Texts())
EndIf
Next
EndProcedure
Procedure ClearAllText()
ClearList(Texts())
EndProcedure
;-Tilte
Global Titles.Titles
Procedure ClearTitles()
ClearList(Titles\Title())
Titles\Event=-1
Titles\ScrollY=0
Titles\Speed=6000
Titles\StartTime=ElapsedMilliseconds()
EndProcedure
Procedure TitlesCenter(Center.b=#True)
Titles\Center=Center
EndProcedure
Procedure TitlesEvent(Event.l);todo Je suis rendu là
Titles\Event=Event
EndProcedure
Procedure AddTitle(Text.s,FontId=-1,Alpha.l=255,Selected.b=#False)
AddElement(Titles\Title())
Titles\Title()\Text=Text
Titles\Title()\FondId=FontId
Titles\Title()\Alpha=Alpha
Titles\Title()\Selected=Selected
EndProcedure
;-####################################
;AddElement(Title()):Title()="Copyright 1990 Software LTD"
Procedure DisplayTitles()
If Titles\StartTime=0:Titles\StartTime=ElapsedMilliseconds():EndIf
If ListSize(Titles\Title())>0
Protected RealLineSpacing=Titles\LineSpacing*GUI\BlockSize
Protected LineHeight.f=GUI\BlockSize+RealLineSpacing
Titles\ScrollY=Titles\ScrollY+ ScreenHeight()*(ElapsedMilliseconds()-Titles\StartTime)/Titles\Speed ;6000
If Titles\ScrollY>ScreenHeight()+ ListSize(Titles\Title())* LineHeight
If Titles\Event>-1:
PostEventGUI(Titles\Event)
EndIf
Titles\ScrollY=0
EndIf
ForEach Titles\Title()
DrawingBitmapFont(Titles\Title()\FondId)
Protected.l Y=ScreenHeight() + ListIndex(Titles\Title()) * LineHeight - Titles\ScrollY
If Y>-LineHeight And Y<ScreenHeight()
Protected X.l
If Titles\Center=#True
X=(ScreenWidth()-TextBitmapWidth(Titles\Title()\Text))/2
Else
X=0
EndIf
Protected Alpha.l
If Titles\Title()\Alpha=255
Alpha=Titles\Alpha
Else
Alpha=Titles\Title()\Alpha * Titles\Alpha / 255
EndIf
If Titles\Title()\Selected=#True
DisplayClipSprite(#Spr_White,0,Y,200,1,ScreenWidth(),GUI\BlockSize)
EndIf
DrawBitmapText(X,Y,Titles\Title()\Text,Alpha)
EndIf
Next
Titles\StartTime=ElapsedMilliseconds()
EndIf
EndProcedure
;- Message
Structure Message
String.s
Font.l
StartTime.q
Duration.l
FadeDuration.l
MessStep.l
EndStructure
Global NewList Message.Message()
Procedure NewMessage(String.s,Font.l=0,Duration.l=2000,FadeDuration.l=500)
AddElement(Message())
Message()\String=String
Message()\Font=Font
Message()\Duration=Duration
Message()\FadeDuration=FadeDuration
EndProcedure
Procedure DisplayMessage()
If FirstElement(Message())
Protected Fade.l
Select Message()\MessStep
Case 0;In
If Message()\StartTime=0:Message()\StartTime=ElapsedMilliseconds()+Message()\FadeDuration:EndIf
Fade=255-Int((Message()\StartTime-ElapsedMilliseconds())*255/Message()\FadeDuration)
If ElapsedMilliseconds()>Message()\StartTime
Message()\MessStep=Message()\MessStep+1
Message()\StartTime=0
EndIf
Case 1; Display
If Message()\StartTime=0:Message()\StartTime=ElapsedMilliseconds()+Message()\Duration:EndIf
If ElapsedMilliseconds()>Message()\StartTime
Message()\MessStep=Message()\MessStep+1
Message()\StartTime=0
EndIf
Fade=255
Case 2;
If Message()\StartTime=0:Message()\StartTime=ElapsedMilliseconds()+Message()\FadeDuration:EndIf
Fade=Int((Message()\StartTime-ElapsedMilliseconds())*255/Message()\FadeDuration)
If ElapsedMilliseconds()>Message()\StartTime
Message()\MessStep=Message()\MessStep+1
Message()\StartTime=0
EndIf
Case 3
EndSelect
DrawingBitmapFont(Message()\Font)
Protected Width.l=TextBitmapWidth(Message()\String)
DrawBitmapText((ScreenWidth()-Width)/2,GUI\BenchY+GUI\BenchHeight,Message()\String,Fade)
If Message()\MessStep=3
DeleteElement(Message())
EndIf
EndIf
EndProcedure
; IDE Options = PureBasic 6.11 LTS (Windows - x64)
; CursorPosition = 255
; FirstLine = 255
; Folding = ---
; EnableXP

371
Bonus.pbi Normal file
View File

@@ -0,0 +1,371 @@
; Moved to GameStructure
; Enumeration BonusType
; #Bonus_Health ; Add Health
; #Bonus_Time ; Slowest Time
; #Bonus_EarthQuake ; Check Bench and pieces Fall
; #Bonus_Dead ; All points X2
; #Bonus_X2 ; All points X4
; #Bonus_JewelBlue ;
; #Bonus_JewelRed ;
; #Bonus_Eye
; #Bonus_End
; EndEnumeration
Structure DisplayedBonus
Type.l ;see BonusType Enumeration
X.l
Y.l
State.l
Alpha.l
StartTime.l
Duration.l
EndStructure
Structure Bonus
List DisplayedBonus.DisplayedBonus()
Dead_StartTimer.q
EyeEnable.b
HammerEnable.b
BonusScrollDisplayed.b
Hammer_StartTime.q
Random_StartTime.q
Random_Duration.l
RemoveEnable.b
Remove_StartTime.q
X2Enable.b
FreezeEnable.b
FreezeStartTime.q
FreezeTimer.l
FreezeAlpha.l
EndStructure
Global Bonus.Bonus
Procedure NewBonus(BonusType.l,Bx.l=-1,By.l=-1)
Protected TmpX.l,TmpY.l
Protected Authorization.b=#False
Protected Count.l=0
Protected Quit.b=#False
Debug "_____NewBonus()____"
If BonusType<>#Bonus_X2 Or (BonusType=#Bonus_X2 And Bonus\X2Enable<3) ;No Over x8
If Bx=-1
Protected BonusCase.l
Repeat
Count=Count+1
BonusCase.l=RandUniq()
TmpX=BonusCase%(#MaxTableWidth+1)
TmpY=BonusCase/(#MaxTableWidth+1)
Debug "Test New Bonus "+Str(TmpX)+","+Str(TmpY)+" BonusType="+Str(BonusType)
If BonusType=#Bonus_Dead:Debug "Add Dead Bonus":EndIf
If Game\GameTable(TmpX,TmpY)\BonusOnThisCase=#False
If (TmpX=Game\BlockMouseX And TmpY=Game\BlockMouseY)
Debug "Bonus Under Mouse "
Quit=#True
Else
Authorization=#True
Quit=#True
EndIf
EndIf
If Count=4 And Game\GameTable(TmpX,TmpY)\BonusOnThisCase=#True
Quit=#True
EndIf
Until Quit=#True
Else
If Bx=Game\BlockMouseX And By=Game\BlockMouseY
Debug "Bonus Under Mouse Bis"
Else
Authorization=#True
TmpX=Bx
TmpY=By
EndIf
EndIf
If Authorization=#True And Game\GameTable(TmpX,TmpY)\BonusOnThisCase=#False
AddElement(Bonus\DisplayedBonus())
Bonus\DisplayedBonus()\Type=BonusType
Bonus\DisplayedBonus()\X=TmpX
Bonus\DisplayedBonus()\Y=TmpY
Bonus\DisplayedBonus()\StartTime=ElapsedMilliseconds()
Game\GameTable(TmpX,TmpY)\BonusOnThisCase=#True
Select BonusType
Case #Bonus_Health
Bonus\DisplayedBonus()\Duration=4000
Case #Bonus_Time ; Slowest Time
Bonus\DisplayedBonus()\Duration=Random(4000,2500)
Case #Bonus_EarthQuake ; Check Bench and pieces Fall
Bonus\DisplayedBonus()\Duration=4000
Case #Bonus_Dead ; Dead
Bonus\DisplayedBonus()\Duration=Game\Difficulty(Game\ScoreData\Difficulty)\DeadBonusDuration
Bonus\Dead_StartTimer=ElapsedMilliseconds()
Case #Bonus_X2 ; All points X2
Bonus\DisplayedBonus()\Duration=4000
Case #Bonus_Eye
Bonus\DisplayedBonus()\Duration=4000
If Game\ScoreData\Difficulty<2
Bonus\DisplayedBonus()\Type=#Bonus_Time
EndIf
Case #Bonus_JewelBlue,#Bonus_JewelRed ; Jewel
Bonus\DisplayedBonus()\Duration=Random(6000,3000)
Case #Bonus_Gravity
Bonus\DisplayedBonus()\Duration=4000
Bonus\BonusScrollDisplayed=#True
Case #Bonus_Freeze
Bonus\DisplayedBonus()\Duration=4000
Default
Bonus\DisplayedBonus()\Duration=4000
EndSelect
PlaySound(#Snd_Woosh)
Else
Debug "Lost Bonus No empty Case"
EndIf
EndIf
EndProcedure
Procedure NewBonus_old(BonusType.l,Bx.l=-1,By.l=-1)
AddElement(Bonus\DisplayedBonus())
Bonus\DisplayedBonus()\Type=BonusType
;Loop to never put Bonus on Mouse Cursor
If Bx=-1
Repeat
Protected BonusCase.l
BonusCase.l=RandUniq(); RandUniq() function is GameStructure.pbi
Bonus\DisplayedBonus()\X=BonusCase%(#MaxTableWidth+1)
Bonus\DisplayedBonus()\Y=BonusCase/(#MaxTableWidth+1)
Debug "New Bonus "+Str(Bonus\DisplayedBonus()\X)+","+Str(Bonus\DisplayedBonus()\Y)
Until (Bonus\DisplayedBonus()\X>Game\BlockMouseX+1 Or Bonus\DisplayedBonus()\X<Game\BlockMouseX-1) Or (Bonus\DisplayedBonus()\Y>Game\BlockMouseY+1 Or Bonus\DisplayedBonus()\Y<Game\BlockMouseY-1)
Else
Bonus\DisplayedBonus()\X=Bx
Bonus\DisplayedBonus()\Y=By
EndIf
Bonus\DisplayedBonus()\StartTime=ElapsedMilliseconds()
Select BonusType
Case #Bonus_Health
Bonus\DisplayedBonus()\Duration=4000
Case #Bonus_Time ; Slowest Time
Bonus\DisplayedBonus()\Duration=Random(4000,2500)
Case #Bonus_EarthQuake ; Check Bench and pieces Fall
Bonus\DisplayedBonus()\Duration=4000
Case #Bonus_Dead ; Dead
Bonus\DisplayedBonus()\Duration=Game\Difficulty(Game\ScoreData\Difficulty)\DeadBonusDuration
Bonus\Dead_StartTimer=ElapsedMilliseconds()
Case #Bonus_X2 ; All points X2
Bonus\DisplayedBonus()\Duration=4000
Case #Bonus_Eye
Bonus\DisplayedBonus()\Duration=4000
If Game\ScoreData\Difficulty<2
Bonus\DisplayedBonus()\Type=#Bonus_Time
EndIf
Case #Bonus_JewelBlue,#Bonus_JewelRed ; Jewel
Bonus\DisplayedBonus()\Duration=Random(6000,3000)
Case #Bonus_Gravity
Bonus\DisplayedBonus()\Duration=4000
Bonus\BonusScrollDisplayed=#True
Case #Bonus_Freeze
Bonus\DisplayedBonus()\Duration=4000
Default
Bonus\DisplayedBonus()\Duration=4000
EndSelect
PlaySound(#Snd_Woosh)
EndProcedure
Procedure DisplayBonus()
Protected TmpX.l
Protected TmpY.l
Protected During.l
Protected Alpha.l
ForEach Bonus\DisplayedBonus()
TmpX=Bonus\DisplayedBonus()\X * GUI\BlockSize + GUI\BenchX + EarthQuake\DeltaX
TmpY=Bonus\DisplayedBonus()\Y * GUI\BlockSize + GUI\BenchY + EarthQuake\DeltaY
During.l=ElapsedMilliseconds()-Bonus\DisplayedBonus()\StartTime
If During<2000
Bonus\DisplayedBonus()\Alpha=Int(During/4)
EndIf
If During>Bonus\DisplayedBonus()\Duration-500
Bonus\DisplayedBonus()\Alpha=Int((Bonus\DisplayedBonus()\Duration-During)/2)
Else
Bonus\DisplayedBonus()\Alpha=255
EndIf
If During>Bonus\DisplayedBonus()\Duration
If Bonus\DisplayedBonus()\Type=#Bonus_Gravity
Bonus\BonusScrollDisplayed=#False
EndIf
Game\GameTable(Bonus\DisplayedBonus()\X,Bonus\DisplayedBonus()\Y)\BonusOnThisCase=#False
DeleteElement(Bonus\DisplayedBonus())
Else
DisplayClipSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,TmpX,TmpY,Bonus\DisplayedBonus()\Alpha)
;DrawBitmapText(TmpX,TmpY,Str(Bonus\DisplayedBonus()\Alpha)) ; Display Tansparency on Bonus
EndIf
Next
EndProcedure
; Procedure ScrollLeft()
; Protected Bx.l,By.l
; For By=0 To #MaxTableHeight
; Protected EmptyCase.l=-1
; For Bx=0 To #MaxTableWidth
; If Game\GameTable(Bx,By)\Sprite>0
; If EmptyCase>-1
; Game\GameTable(EmptyCase,By)\Sprite=Game\GameTable(Bx,By)\Sprite
; Game\GameTable(EmptyCase,By)\Selected=Game\GameTable(Bx,By)\Selected
; Game\GameTable(Bx,By)\Sprite=0
; Game\GameTable(Bx,By)\Selected=0
; EmptyCase=EmptyCase+1
; EndIf
; ElseIf Game\GameTable(Bx,By)\Sprite=0
; If EmptyCase=-1:EmptyCase=Bx:EndIf
; EndIf
; Next
; Next
; EndProcedure
Procedure ScrollDown()
Protected Bx.l,By.l
For Bx=0 To #MaxTableWidth
Protected EmptyCase.l=#MaxTableHeight+1
For By=#MaxTableHeight To 0 Step -1
If Game\GameTable(Bx,By)\Sprite=0
If EmptyCase=#MaxTableHeight+1:EmptyCase=By:EndIf
Else
If EmptyCase<#MaxTableHeight+1
Game\GameTable(Bx,EmptyCase)\Sprite=Game\GameTable(Bx,By)\Sprite
Game\GameTable(By,EmptyCase)\Selected=Game\GameTable(Bx,By)\Selected
Game\GameTable(Bx,By)\Sprite=0
Game\GameTable(Bx,By)\Selected=0
EmptyCase=EmptyCase-1
EndIf
EndIf
Next
Next
EndProcedure
Procedure TakeBonus(Bx.l,By.l)
;-Mouse Take Bonus
If ListSize(Bonus\DisplayedBonus())>0
ForEach Bonus\DisplayedBonus()
If Bx=Bonus\DisplayedBonus()\X And By=Bonus\DisplayedBonus()\Y And Bonus\DisplayedBonus()\Alpha>90
Debug "Bonus "+Str(Bx)+","+Str(By)+" Type="+Str(Bonus\DisplayedBonus()\Type)
Game\GameTable(BX,BY)\BonusOnThisCase=#False
Protected *Obj_Sprite.SpriteData
;Param\game\Stats\NbBonus(Bonus\DisplayedBonus()\Type)=Param\game\Stats\NbBonus(Bonus\DisplayedBonus()\Type)+1
Select Bonus\DisplayedBonus()\Type
Case #Bonus_Health ; Add Health
;Game\Life=Game\Life+1 ;Moved to Event in Game.pbi Gamemode()
PlaySound(#Snd_GetBonus)
*Obj_Sprite=NewSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,Bx,By,1,1,255,1,#Spr_Depth_Front,9)
AddItemToDisplayEngine(*Obj_Sprite,#Type_Sprite)
AddmoveToEngine(@*Obj_Sprite\X,#PB_Float,0,1000,BX+1,19,#Easing_BackEaseIn)
AddmoveToEngine(@*Obj_Sprite\Y,#PB_Float,0,1000,BY+1,0,#Easing_BackEaseIn,#EventGui_AddHealth,@*Obj_Sprite\AutoDestroy)
Case #Bonus_Time ; Slowest Time
PlaySound(#Snd_GetBonus)
Game\Timer=Game\Timer+400
Game\NextTime=ElapsedMilliseconds()+Game\Timer
Case #Bonus_EarthQuake ; Check Bench and pieces Fall
StartEarthQuake() ; Do Earth Quake
Case #Bonus_Dead ; All points X2
PlaySound(#Snd_DeadBonus)
*Obj_Sprite=NewSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,Bx+0.5,By+0.5,1,1,255,1,#Spr_Depth_Front,#Align_Hor_Middle|#Align_Ver_Middle)
AddItemToDisplayEngine(*Obj_Sprite,#Type_Sprite)
AddmoveToEngine(@*Obj_Sprite\Size,#PB_Float,0,1000,1,100,#Easing_Linear,#EventGui_Dead,@*Obj_Sprite\AutoDestroy)
AddmoveToEngine(@*Obj_Sprite\X,#PB_Float,0,1000,Bx+1.5,GUI\ScreenWidth/2,#Easing_Linear)
AddmoveToEngine(@*Obj_Sprite\Y,#PB_Float,0,1000,By+1.5,GUI\ScreenHeight/2,#Easing_Linear)
NewMessage("DEAD",0)
Debug "DEAD"+Str(ListSize(Bonus\DisplayedBonus()))
Game\WaitTimer=ElapsedMilliseconds()+1000
Case #Bonus_X2 ; All points X4
If Bonus\X2Enable<3 ;No Over x8
PlaySound(#Snd_GetBonus2)
*Obj_Sprite=NewSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,Bx,By,1,1,255,1,#Spr_Depth_Front,9)
AddItemToDisplayEngine(*Obj_Sprite,#Type_Sprite)
Debug "X2"
AddmoveToEngine(@*Obj_Sprite\X,#PB_Float,0,1000,BX+1,5,#Easing_BackEaseIn)
AddmoveToEngine(@*Obj_Sprite\Y,#PB_Float,0,1000,BY+1,0,#Easing_BackEaseIn,#EventGui_AddX2,@*Obj_Sprite\AutoDestroy)
Debug "___"
EndIf
Case #Bonus_JewelBlue
;Game\Bonus_JewelBlue=Game\Bonus_JewelBlue+1 ;Moved to Event in Game.pbi Gamemode()
PlaySound(#Snd_GetJewel)
*Obj_Sprite=NewSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,Bx,By,1,1,255,1,#Spr_Depth_Front,9)
AddItemToDisplayEngine(*Obj_Sprite,#Type_Sprite)
AddmoveToEngine(@*Obj_Sprite\X,#PB_Float,0,1000,BX+1,8,#Easing_BackEaseIn)
AddmoveToEngine(@*Obj_Sprite\Y,#PB_Float,0,1000,BY+1,0,#Easing_BackEaseIn,#EventGui_AddJewelBlue,@*Obj_Sprite\AutoDestroy)
Case #Bonus_JewelRed ; Jewel
;Game\Bonus_JewelRed=Game\Bonus_JewelRed+1 ;Moved to Event in Game.pbi Gamemode()
PlaySound(#Snd_GetJewel)
*Obj_Sprite=NewSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,Bx,By,1,1,255,1,#Spr_Depth_Front,9)
AddItemToDisplayEngine(*Obj_Sprite,#Type_Sprite)
AddmoveToEngine(@*Obj_Sprite\X,#PB_Float,0,1000,BX+1,11,#Easing_BackEaseIn)
AddmoveToEngine(@*Obj_Sprite\Y,#PB_Float,0,1000,BY+1,0,#Easing_BackEaseIn,#EventGui_AddJewelRed,@*Obj_Sprite\AutoDestroy)
Case #Bonus_JewelGreen
;Game\Bonus_JewelBlue=Game\Bonus_JewelBlue+1 ;Moved to Event in Game.pbi Gamemode()
PlaySound(#Snd_GetJewel)
*Obj_Sprite=NewSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,Bx,By,1,1,255,1,#Spr_Depth_Front,9)
AddItemToDisplayEngine(*Obj_Sprite,#Type_Sprite)
AddmoveToEngine(@*Obj_Sprite\X,#PB_Float,0,1000,BX+1,14,#Easing_BackEaseIn)
AddmoveToEngine(@*Obj_Sprite\Y,#PB_Float,0,1000,BY+1,0,#Easing_BackEaseIn,#EventGui_AddJewelGreen,@*Obj_Sprite\AutoDestroy)
Case #Bonus_Eye
PlaySound(#Snd_GetBonus2)
*Obj_Sprite=NewSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,Bx,By,1,1,255,1,#Spr_Depth_Front,9)
AddItemToDisplayEngine(*Obj_Sprite,#Type_Sprite)
AddmoveToEngine(@*Obj_Sprite\X,#PB_Float,0,1000,BX+1,14.5,#Easing_BackEaseIn)
AddmoveToEngine(@*Obj_Sprite\Y,#PB_Float,0,1000,BY+1,8,#Easing_BackEaseIn,#EventGui_EnableEye,@*Obj_Sprite\AutoDestroy)
Case #Bonus_Gravity
ScrollDown()
;ScrollLeft()
PlaySound(#Snd_Collapse)
Case #Bonus_Hammer
PlaySound(#Snd_GetBonus2)
*Obj_Sprite=NewSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,Bx,By,1,1,255,1,#Spr_Depth_Front,9)
AddItemToDisplayEngine(*Obj_Sprite,#Type_Sprite)
AddmoveToEngine(@*Obj_Sprite\X,#PB_Float,0,1000,BX+1,3,#Easing_BackEaseIn)
AddmoveToEngine(@*Obj_Sprite\Y,#PB_Float,0,1000,BY+1,0,#Easing_BackEaseIn,#EventGui_EnableHammer,@*Obj_Sprite\AutoDestroy)
Game\WaitTimer=ElapsedMilliseconds()+1000
Case #Bonus_Remove
PlaySound(#Snd_GetBonus2)
*Obj_Sprite=NewSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,Bx,By,1,1,255,1,#Spr_Depth_Front,9)
AddItemToDisplayEngine(*Obj_Sprite,#Type_Sprite)
AddmoveToEngine(@*Obj_Sprite\X,#PB_Float,0,1000,BX+1,3,#Easing_BackEaseIn)
AddmoveToEngine(@*Obj_Sprite\Y,#PB_Float,0,1000,BY+1,0,#Easing_BackEaseIn,#EventGui_EnableRemover,@*Obj_Sprite\AutoDestroy)
Game\WaitTimer=ElapsedMilliseconds()+1000
Case #Bonus_Freeze
PlaySound(#Snd_GetBonus2)
*Obj_Sprite=NewSprite(#Spr_Health+Bonus\DisplayedBonus()\Type,Bx,By,1,1,255,1,#Spr_Depth_Front,9)
AddItemToDisplayEngine(*Obj_Sprite,#Type_Sprite)
AddmoveToEngine(@*Obj_Sprite\X,#PB_Float,0,1000,BX+1,10,#Easing_BackEaseIn)
AddmoveToEngine(@*Obj_Sprite\Y,#PB_Float,0,1000,BY+1,9,#Easing_BackEaseIn,#EventGui_EnableFreeze,@*Obj_Sprite\AutoDestroy)
Game\WaitTimer=ElapsedMilliseconds()+1000
EndSelect
DeleteElement(Bonus\DisplayedBonus())
EndIf
Next
EndIf
EndProcedure
; IDE Options = PureBasic 6.11 LTS (Windows - x64)
; CursorPosition = 129
; FirstLine = 57
; Folding = -
; EnableXP
; DPIAware

126
Cinematic.pbi Normal file
View File

@@ -0,0 +1,126 @@
Structure Cinestep
Value.SpriteObj
Duration.l
EasingH.l
EasingV.l
EndStructure
Structure Cinematic
*Value.SpriteObj
StartTime.q
Duration.l
StepIndex.l
Loob.b
EventGUI.l
List Cinestep.Cinestep()
EndStructure
Global NewList Cinematic.Cinematic()
Procedure AddCinematicStep(*C.Cinematic,Duration,EasingV.l,EasingH.l)
Protected *Step.CineStep
*Step=AddElement(*C\Cinestep())
*Step\Duration=Duration
*Step\EasingH=EasingH
*Step\EasingV=EasingV
ProcedureReturn *Step
EndProcedure
Procedure SetCinematicStepValue(*Step.Cinestep,X.f,Y.f,Width.f=-1,Height.f=-1,Opacity=255,Size.f=1)
*Step\Value\X=X
*Step\Value\Y=Y
*Step\Value\Width=Width
*Step\Value\Height=Height
*Step\Value\Opacity=Opacity
*Step\Value\Size=Size
EndProcedure
Procedure NewCinematic(*SpriteObj,EventGUI=-1)
Protected *Cine.Cinematic
*Cine=AddElement(Cinematic())
*Cine\Value=*SpriteObj
*Cine\StartTime=-1 ; No Started
*Cine\StepIndex=-1
*Cine\EventGUI=EventGUI
*Cine\Duration=0
ProcedureReturn *Cine
EndProcedure
Procedure RenderCinematics()
Protected ElapsedTime.q
Protected *Start.Cinestep
Protected *Target.Cinestep
ForEach Cinematic()
If Cinematic()\StartTime<>-1
ElapsedTime=ElapsedMilliseconds()-Cinematic()\StartTime
If ElapsedTime>Cinematic()\Duration
Cinematic()\StepIndex=Cinematic()\StepIndex+1
Cinematic()\StartTime=ElapsedMilliseconds()
If Cinematic()\StepIndex>ListSize(Cinematic()\CineStep())-2
Debug "End"
If Cinematic()\EventGUI>0
Debug "PostEventGUI="+Str(Cinematic()\EventGUI)
PostEventGUI(Cinematic()\EventGUI)
EndIf
If Cinematic()\Loob=#True
Cinematic()\StepIndex=0
Else
Cinematic()\StartTime=-1
Cinematic()\StepIndex=-1
EndIf
EndIf
EndIf
If ListSize(Cinematic()\CineStep())>0 And Cinematic()\StepIndex>=0 And Cinematic()\StepIndex<ListSize(Cinematic()\CineStep())-1
SelectElement(Cinematic()\CineStep(),Cinematic()\StepIndex)
*Start=Cinematic()\CineStep()
SelectElement(Cinematic()\CineStep(),Cinematic()\StepIndex+1)
*Target=Cinematic()\CineStep()
Cinematic()\Duration=*Target\Duration
If Cinematic()\StartTime<>-1
Cinematic()\Value\X=GetEasingPosValue(*Start\Value\X, *Target\Value\X,Cinematic()\StartTime, *Target\Duration, *Target\EasingH)
Cinematic()\Value\Y=GetEasingPosValue(*Start\Value\Y, *Target\Value\Y,Cinematic()\StartTime, *Target\Duration, *Target\EasingV)
If *Target\Value\Width<>-1
Cinematic()\Value\Width=GetEasingPosValue(*Start\Value\Width, *Target\Value\Width,Cinematic()\StartTime, *Target\Duration, *Target\EasingH)
EndIf
If *Target\Value\Height<>-1
Cinematic()\Value\Height=GetEasingPosValue(*Start\Value\Height, *Target\Value\Height,Cinematic()\StartTime, *Target\Duration, *Target\EasingV)
EndIf
If *Target\Value\Opacity<>-1
Cinematic()\Value\Opacity=GetEasingPosValue(*Start\Value\Opacity, *Target\Value\Opacity,Cinematic()\StartTime, *Target\Duration, 0)
EndIf
If *Target\Value\Size<>-1
Cinematic()\Value\Size=GetEasingPosValue(*Start\Value\Size, *Target\Value\Size,Cinematic()\StartTime, *Target\Duration, 0)
EndIf
EndIf
EndIf
EndIf
Next
EndProcedure
Procedure StartCinematic(*C.Cinematic=0)
If *C=0
ForEach Cinematic()
Cinematic()\StartTime=ElapsedMilliseconds()
Cinematic()\StepIndex=-1
Next
Else
*C\StartTime=ElapsedMilliseconds()
*C\StepIndex=-1
EndIf
EndProcedure
Procedure FreeAllCinematics()
ForEach Cinematic()
ClearList(Cinematic()\Cinestep())
Next
ClearList(Cinematic())
EndProcedure
; IDE Options = PureBasic 6.00 Beta 5 (Windows - x64)
; CursorPosition = 74
; FirstLine = 37
; Folding = --
; EnableXP

128
Cinematic_Old.pbi Normal file
View File

@@ -0,0 +1,128 @@
;- Cinematic
Enumeration
#CV_X
#CV_Y
#CV_Width
#CV_Height
#CV_Opacity
#CV_Size
#CV_End
EndEnumeration
Structure CineValue
Value.f
Easing.l
EndStructure
Structure CineStep
Array CineValue.CineValue(#CV_End-1)
Duration.l
EndStructure
Structure Cinematic
StartTime.q
StepIndex.l
Duration.l
Array *TargetValue.Long(#CV_End-1)
Loop.b
List CineStep.CineStep()
EndStructure
Global NewList Cinematic.Cinematic()
Procedure.i NewCinematic()
Protected *c.Cinematic=AddElement(Cinematic())
*c\StartTime=-1
ProcedureReturn *c
EndProcedure
Procedure StartCinematic(*C.Cinematic)
*C\StartTime=ElapsedMilliseconds()
Cinematic()\StepIndex=-1
Cinematic()\Duration=-1
EndProcedure
Procedure AddCinematicStep(*c.Cinematic,Duration.l)
Protected *Step.CineStep=AddElement(*c\CineStep())
*Step\Duration=Duration
Protected n.l
For n=0 To #CV_End-1
*Step\CineValue(n)\Value=-1
Next
ProcedureReturn *Step
EndProcedure
Procedure FreeCinematicStep(*c.Cinematic)
ClearList(*c\CineStep())
EndProcedure
Procedure AddCinematicValue(*c.Cinematic,ValueIndex.l,*Value)
*c\TargetValue(ValueIndex)=*Value
EndProcedure
Procedure AddCinematicStepValue(*Step.CineStep,ValueIndex.l,Value.f,Easing.l)
*Step\CineValue(ValueIndex)\Value=Value
*Step\CineValue(ValueIndex)\Easing=Easing
EndProcedure
Procedure RenderCinematics()
Protected *Start.CineStep
Protected *Target.CineStep
Protected CurrentPos.CineStep
Protected ElapsedTime.q
Protected n.l
ForEach Cinematic()
If Cinematic()\StartTime<>-1
ElapsedTime=ElapsedMilliseconds()-Cinematic()\StartTime
If ElapsedTime>Cinematic()\Duration
Cinematic()\StepIndex=Cinematic()\StepIndex+1
Cinematic()\StartTime=ElapsedMilliseconds()
ElapsedTime=0
EndIf
If Cinematic()\StepIndex>=0 And Cinematic()\StepIndex<ListSize(Cinematic()\CineStep())-1
SelectElement(Cinematic()\CineStep(),Cinematic()\StepIndex)
*Start=Cinematic()\CineStep()
Debug "*Start="+Str(*Start)
SelectElement(Cinematic()\CineStep(),Cinematic()\StepIndex+1)
*Target=Cinematic()\CineStep()
Debug "*Target="+Str(*Target)
Cinematic()\Duration=*Target\Duration
For n=0 To #CV_End-1
If Cinematic()\TargetValue(n)<>0 And Cinematic()\TargetValue(n)\l<>-1
Cinematic()\TargetValue(n)\l=GetEasingPosValue(*Start\CineValue(n)\Value, *Target\CineValue(n)\Value ,Cinematic()\StartTime, *Target\Duration, *Target\CineValue(n)\Easing)
;Cinematic()\SpriteObj\Size=*Start\Size + ( ElapsedTime * ( *Target\Size - *Start\Size ) / *Target\Duration)
If n= #CV_Height
Debug Cinematic()\TargetValue(n)\l
EndIf
EndIf
Next
Else ; If End Cinematic
SelectElement(Cinematic()\CineStep(),ListSize(Cinematic()\CineStep())-1)
*Target=Cinematic()\CineStep()
For n=0 To #CV_End-1
If Cinematic()\TargetValue(n)<>0
Cinematic()\TargetValue(n)\l=*Target\CineValue(n)\Value
EndIf
Next
If Cinematic()\Loop=#True
StartCinematic(Cinematic())
EndIf
EndIf
EndIf
Next
EndProcedure
; IDE Options = PureBasic 6.00 Beta 5 (Windows - x64)
; CursorPosition = 100
; Folding = --
; EnableXP

91
Create Package.pb Normal file
View File

@@ -0,0 +1,91 @@

Procedure WriteDataPackage(List File.s(),FileName.s="Data.pck")
Protected Size.i,Adr.i
If CreateFile(0, FileName)
WriteLong(0,ListSize(File()))
Adr=ListSize(File())*4*2+4
;WriteCatalogue
Debug "Catalogue"
ForEach File()
Size=FileSize(File())
If Size<0:
Debug "Error File :"+File()
CloseFile(0)
End
EndIf
WriteLong(0,Adr)
Debug Str(ListIndex(File()))+") Adr="+Str(Adr)+" Size="+Str(Size)
WriteLong(0,Size)
Adr=Adr+Size
Next
;WriteFile
ForEach File()
Size=FileSize(File())
Debug Str(ListIndex(File()))+":"+Str(Loc(0))
If ReadFile(1, File())
*Mem=AllocateMemory(Size)
ReadData(1,*Mem,Size)
CloseFile(1)
WriteData(0,*Mem,Size)
FreeMemory(*Mem)
EndIf
Next
CloseFile(0)
Else
Debug "ERRO"
EndIf
EndProcedure
NewList File.s()
AddElement(File()):File()=GetCurrentDirectory()+"Datas\SpriteSheetx192.png"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\LoopzFont.png"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\LoopzFont.dat"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\MonoFont.png"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\MonoFont.dat"
AddElement(File()):File()=GetCurrentDirectory()+"Modules/Loopz03V2.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules/Loopz01.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules/Loopz02.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules/LoopzGameOver01.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules/LoopzGameOver03.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules/LoopzHighScore01.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules/Loopz10.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-bonus-earned-in-video-game-2058.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-explainer-video-game-alert-sweep-236.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-extra-bonus-in-a-video-game-2045.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-video-game-retro-click-237.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-fast-small-sweep-transition-166.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-fairy-magic-sparkle-871.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-erupting-volcano-lava-2442.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\My-Dead-Snd-Effect.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\Metal-hammer.wav"
WriteDataPackage(File())
Procedure.i ReadDataPackage(FileName.s,FileNumber.l)
Protected NbFile.l,Adr.i,Size.i, *Mem
If OpenFile(0,Filename)
NbFile=ReadLong(0)
Adr=4+FileNumber*4*2
FileSeek(0, Adr)
Adr=ReadLong(0)
Size=ReadLong(0)
Debug Str(FileNumber)+") Adr="+Str(Adr)+" Size="+Str(Size)
*Mem=AllocateMemory(Size)
FileSeek(0,Adr)
ReadData(0,*Mem,Size)
CloseFile(0)
ProcedureReturn *Mem
EndIf
EndProcedure
ReadDataPackage("Data.pck",3)
; IDE Options = PureBasic 6.00 Beta 6 (Windows - x64)
; CursorPosition = 63
; FirstLine = 18
; Folding = -
; EnableXP

327
Database.pbi Normal file
View File

@@ -0,0 +1,327 @@
Procedure HallofFamelistToTitle(LastInsertId.l=-1)
Protected String.s
Protected Minutes.l
Protected Seconds.l
Protected Selected.b
Addtitle("Rank"+Chr(9)+" Name"+Chr(9)+"Score"+Chr(9)+"Pieces"+Chr(9)+"Loops"+Chr(9)+"Time",0,128)
ForEach Game\HoF()
String=Str(ListIndex(Game\HoF())+1)
String+Chr(9)+Game\HoF()\Pseudo
String+Chr(9)+Game\HoF()\Score
String+Chr(9)+StrF(ValF(Game\Hof()\PiecesPerMinute),2)+"/Min"
String+Chr(9)+StrF(ValF(Game\Hof()\LoopsPerMinute),2)+"/Min"
Minutes=(Val(Game\Hof()\Duration)/1000)/60
Seconds=(Val(Game\Hof()\Duration)/1000)%60
String+Chr(9)+Str(Minutes)+":"+Str(Seconds)
If Val(Game\HoF()\Id)=LastInsertId
Selected=#True
Else
Selected=#False
EndIf
Addtitle(String,0,255,Selected)
Next
AddTitle("More info on https://loopz.thyphoon.net/",0,255)
Titles\Speed=15000 ; Speed
EndProcedure
;-################
;-Local Database
UseSQLiteDatabase()
#Db=0
Procedure DbError(Sql.s)
MessageRequester("Error", "Can't execute the query:"+Chr(13)+Sql+Chr(13)+Chr(13)+DatabaseError())
EndProcedure
Procedure CheckDatabaseUpdate(Database, Query$)
Protected Result.i
Result = DatabaseUpdate(Database, Query$)
If Result = 0
DbError(Query$)
EndIf
ProcedureReturn Result
EndProcedure
Procedure.s addslashes(txt.s)
txt = ReplaceString(txt, "'", "''")
ProcedureReturn txt
EndProcedure
;Une petite fonction qui manque pour connaitre le dernier ID
Procedure DatabaseLastInsertRowId()
Protected Sql.s
Sql.s = "Select last_insert_rowid()"
If DatabaseQuery(#Db, Sql) = 0
DbError(Sql.s)
ProcedureReturn 0
Else
NextDatabaseRow(#Db)
ProcedureReturn GetDatabaseLong(#Db, 0)
EndIf
EndProcedure
Procedure SaveScoreToLocalDB()
Protected Sql.s
If IsDatabase(#Db)
With Game\ScoreData
Sql.s = "INSERT INTO [Scores] ('Pseudo','Difficulty','Score','Duration','PiecesPerMinute','LoopsPerMinute','AveragePiecesPerLoop','NbLoop'"
sql+",'BigestLoopSize','Bonus_JewelBlue','Bonus_JewelRed','Bonus_JewelGreen','EmptyBench','FPS_Max','FPS_Min','Resolution','Date') VALUES"
Sql+" ('" + addslashes(\Pseudo) + "','" + Str(\Difficulty) + "','" + Str(\Score) + "','" + Str(\Duration) + "','"+StrF(\PiecesPerMinute)+"','"+StrF(\LoopsPerMinute)+"','"+StrF(\AveragePiecesPerLoop)
Sql+"','"+StrF(\NbLoop)+"','"+StrF(\BigestLoopSize)+"','"+StrF(\Bonus_JewelBlue)+"','"+StrF(\Bonus_JewelRed)+"','"+StrF(\Bonus_JewelGreen)+"','"+StrF(\BenchIsEmpty)
Sql+"','"+Str(\Fps_Max)+"','"+Str(\Fps_Min)+"','"+Str(ScreenWidth())+"x"+Str(ScreenHeight())
Sql+"',datetime('now'))"
If DatabaseUpdate(#Db, Sql.s);
Game\LastInsertIdLocal=DatabaseLastInsertRowId()
Debug "LastInsertIdLocal="+Str(Game\LastInsertIdLocal)
Else
DbError(Sql.s)
EndIf
Else
DisplayWarning("SaveScoreToLocalDB() DB not Ready")
EndIf
EndWith
EndProcedure
Procedure LoadHallOfFame(Difficulty.l)
If IsDatabase(#Db)
If DatabaseQuery(#Db, "SELECT Pseudo,Score,PiecesPerMinute,LoopsPerMinute,Duration,Id FROM Scores WHERE Difficulty="+Str(Difficulty)+" order by Score Desc Limit 0,25")
Addtitle("Rank"+Chr(9)+" Name"+Chr(9)+"Score"+Chr(9)+"Pieces"+Chr(9)+"Loops"+Chr(9)+"Time",0,128)
Protected Index.l=0
Protected Minutes.l
Protected Seconds.l
Protected Selected.l
While NextDatabaseRow(#Db) ; Loop for each records
Index=Index+1
Minutes=(GetDatabaseLong(#Db, 4)/1000)/60
Seconds=(GetDatabaseLong(#Db, 4)/1000)%60
If GetDatabaseLong(#Db,5)=Game\LastInsertIdLocal
Selected=#True
Else
Selected=#False
EndIf
Addtitle(Str(Index)+Chr(9)+GetDatabaseString(#Db, 0)+Chr(9)+GetDatabaseString(#Db, 1)+Chr(9)+StrF(GetDatabaseFloat(#Db, 2),2)+"/Min"+Chr(9)+StrF(GetDatabaseFloat(#Db, 3),2)+"/Min"+Chr(9)+Str(Minutes)+":"+Str(Seconds),0,255,Selected)
Wend
FinishDatabaseQuery(#Db)
EndIf
Else
DisplayWarning("LoadHallOfFame() DB not Ready")
EndIf
EndProcedure
;TODO verifier la version de la base de donnée rajouter une table pour les info ou a voir
;TODO Ajouter la saisie du PlayerKey et chargement des scores
Procedure InitDatabase()
If FileSize(GetPDataDirectory(""))<>-2
If CreateDirectory(GetPDataDirectory(""))
Debug "Create Directory"
Else
Debug "ERROR Create Directory"
EndIf
EndIf
Protected DBFileName.s = GetPDataDirectory("HighScore.Dat")
Debug "InitDatabase() "+DBFileName
If FileSize(DBFileName)=-1
Debug "Create DATABASE"
If CreateFile(0,DBFileName)
CloseFile(0)
If OpenDatabase(#Db, DBFileName, "", "", #PB_Database_SQLite) = 0
MessageRequester("Error", "Impossible d'ouvir la base de donnée")
End
ElseIf DatabaseUpdate(#Db, "BEGIN TRANSACTION");
Protected Sql.s
Sql.s="CREATE TABLE [Scores] ("
Sql+"[Id] INTEGER NULL PRIMARY KEY AUTOINCREMENT,"
Sql+"[Pseudo] VARCHAR( 8),"
Sql+"[Difficulty] INTEGER NULL,"
Sql+"[Score] INTEGER NULL,"
Sql+"[Duration] INTEGER NULL,"
Sql+"[PiecesPerMinute] INTEGER NULL,"
Sql+"[LoopsPerMinute] INTEGER NULL,"
Sql+"[AveragePiecesPerLoop] INTEGER NULL,"
Sql+"[NbLoop] INTEGER NULL,"
Sql+"[BigestLoopSize] INTEGER NULL,"
Sql+"[Bonus_JewelBlue] INTEGER NULL,"
Sql+"[Bonus_JewelRed] INTEGER NULL,"
Sql+"[Bonus_JewelGreen] INTEGER NULL,"
Sql+"[EmptyBench] INTEGER NULL,"
Sql+"[Date] Text,"
Sql+"[FPS_Max] INTEGER NULL,"
Sql+"[FPS_Min] INTEGER NULL,"
Sql+"[Resolution] Text NULL"
Sql+")";
Debug Sql
If DatabaseUpdate(#Db,Sql) = 0
DbError(Sql.s)
EndIf
If DatabaseUpdate(#Db, "COMMIT")=0
DbError(Sql.s)
EndIf
EndIf
EndIf
Else
If OpenDatabase(#Db, DBFileName, "", "", #PB_Database_SQLite) = 0
MessageRequester("Error", "Impossible d'ouvir la base de donnée")
End
Else
Debug "DATABASE INIT OK"
If Not DatabaseUpdate(#Db,"Select Bonus_JewelGreen from Scores")
Debug "OLD Database ...i update";
DatabaseUpdate(#Db,"ALTER TABLE [Scores] ADD [AveragePiecesPerLoop] INTEGER NULL")
DatabaseUpdate(#Db,"ALTER TABLE [Scores] ADD [Bonus_JewelGreen] INTEGER NULL")
EndIf
EndIf
EndIf
EndProcedure
;-################
;-Server Database
Procedure.s TalkToServer(Action.s,Json.s)
Protected HttpRequest.i
Protected ClientKey.s="KaLkug1265"
Protected Send.s
Protected Checksum.s
Protected StatusCode.s
Protected reponse.s
NewMap Header$()
;Header$("Content-Type") = "text/plain"
Header$("User-Agent") = "Loopz"
Send.s="Action="+Action
Send+"&Data="+Json
Checksum=StringFingerprint(ClientKey+Json, #PB_Cipher_MD5)
Send+"&CheckSum="+Checksum
Send+"&Version="+#Version
CompilerIf #UsePreProdServer=#True
Send+"&OnlyToTest=0"
CompilerElse
Send+"&OnlyToTest=0"
CompilerEndIf
Debug Send
Debug "Server:"+Game\ServerAddress
HttpRequest = HTTPRequest(#PB_HTTP_Post, Game\ServerAddress, Send,0,Header$())
If HttpRequest
;Debug HTTPInfo(HTTPRequest, #PB_HTTP_Headers)
StatusCode=HTTPInfo(HTTPRequest, #PB_HTTP_StatusCode)
Reponse=HTTPInfo(HTTPRequest, #PB_HTTP_Response)
Debug "StatusCode: " +StatusCode
Debug "Response: " + Reponse
Debug "___"
FinishHTTP(HTTPRequest)
If StatusCode="200"
ProcedureReturn Reponse
EndIf
Else
DisplayWarning("Http Request creation failed")
EndIf
DisplayWarning("Server Error "+Statuscode+Chr(13)+ reponse)
ProcedureReturn ""
EndProcedure
Procedure.s GetAnyValue(Value)
Select JSONType(Value)
Case #PB_JSON_Null: ProcedureReturn "null"
Case #PB_JSON_String: ProcedureReturn GetJSONString(Value)
Case #PB_JSON_Number: ProcedureReturn StrD(GetJSONDouble(Value))
Case #PB_JSON_Boolean: ProcedureReturn Str(GetJSONBoolean(Value))
Case #PB_JSON_Array: ProcedureReturn "array"
Case #PB_JSON_Object: ProcedureReturn "object"
EndSelect
EndProcedure
Procedure SaveScoreToServerDB()
Protected Json.s
Protected Reponse.s
Game\ScoreData\Resolution=GetCurrentResolution()
Game\ScoreData\Os=#CompileVersion
Game\ScoreData\GameVersion=#Version
Game\ScoreData\ComputerName=ComputerName()
Game\ScoreData\UserName=UserName()
If CreateJSON(0)
InsertJSONStructure(JSONValue(0), @Game\ScoreData, ScoreData)
Json=ComposeJSON(0, #PB_JSON_PrettyPrint)
FreeJSON(0)
EndIf
Reponse=TalkToServer("SendScore",Json)
Protected NewMap JsonAnswer()
If Reponse<>""
If ParseJSON(0, Reponse)
If JSONType(JSONValue(0))=#PB_JSON_Object
ExtractJSONMap(JSONValue(0),JsonAnswer())
If FindMapElement(JsonAnswer(),"Id")
Game\LastInsertIdServer=JsonAnswer("Id")
EndIf
If FindMapElement(JsonAnswer(),"Rank")
Debug " Rank="+JsonAnswer("Rank")
EndIf
ProcedureReturn #True
Else
DisplayWarning("ERROR JSON is not Object:"+Chr(13)+Reponse)
ProcedureReturn #False
EndIf
FreeJSON(0)
Else
Debug "JSon Repond From Server:"+JSONErrorMessage()+Chr(13)+Reponse
DisplayWarning("ERROR Can't Parse JSON :"+Chr(13)+Reponse)
ProcedureReturn #False
EndIf
EndIf
EndProcedure
Procedure LoadHallOfFameFromServer(Difficulty.l)
Protected Json.s
Protected Reponse.s
Protected ObjectValue.i
Protected Result.b
ClearList(Game\Hof())
If CreateJSON(0)
ObjectValue = SetJSONObject(JSONValue(0))
SetJSONInteger(AddJSONMember(ObjectValue, "Difficulty"), Difficulty)
SetJSONInteger(AddJSONMember(ObjectValue, "LastInsertId"), Game\LastInsertIdServer)
Debug "LastInsertIDServer="+Str(Game\LastInsertIdServer)
Json=ComposeJSON(0, #PB_JSON_PrettyPrint)
FreeJSON(0)
EndIf
Reponse=TalkToServer("GetHallOfFame",Json)
If reponse<>"" And ParseJSON(0, Reponse)
ObjectValue = JSONValue(0)
;Get HoF
If GetJSONMember(JSONValue(0), "HoF") And JSONType(GetJSONMember(JSONValue(0), "HoF"))=#PB_JSON_Array
ExtractJSONList(GetJSONMember(JSONValue(0) , "HoF"), Game\Hof())
Result=#True
EndIf
;Get Error
Protected Error.s
If GetJSONMember(JSONValue(0), "Error")
Error.s=GetJSONString(GetJSONMember(JSONValue(0), "Error"))
If Error<>""
DisplayWarning("Server ERROR :"+Error)
EndIf
EndIf
FreeJSON(0)
ProcedureReturn Result
Else
DisplayWarning("ERROR Can't Parse JSON :"+Chr(13)+Reponse)
ProcedureReturn #False
EndIf
EndProcedure
; IDE Options = PureBasic 6.12 beta 4 LTS (Windows - x64)
; CursorPosition = 22
; Folding = ---
; EnableXP

BIN
Datas/LoopzFont.dat Normal file
View File

Binary file not shown.

BIN
Datas/MonoFont.dat Normal file
View File

Binary file not shown.

114
EarthQuake.pbi Normal file
View File

@@ -0,0 +1,114 @@
Structure EQE
X.l
Y.l
Sprite.l
EndStructure
Structure EarthQuake
WaitStartTime.i ;Start with ElapsedMilliseconds()
StartTime.i ;0 Stoped / Time run
State.b ;0 start 1 break 2 Stop
Sprite.l
DeltaX.l
DeltaY.l
List FallElement.EQE()
EndStructure
Global EarthQuake.EarthQuake
Procedure NewEarthQuake()
EarthQuake\StartTime=ElapsedMilliseconds()
;SetMessage("Earth Quake")
EndProcedure
Procedure StartEarthQuake()
EarthQuake\WaitStartTime=ElapsedMilliseconds()-Game\Difficulty(Game\ScoreData\Difficulty)\EarthQuakeTimer
EndProcedure
Procedure RunEarthQuake()
Protected.l n,Bx,By
If ElapsedMilliseconds()-EarthQuake\WaitStartTime>Game\Difficulty(Game\ScoreData\Difficulty)\EarthQuakeTimer
EarthQuake\StartTime=ElapsedMilliseconds()
NewMessage("Earth Quake")
PlaySound(#Snd_EarthQuake)
EarthQuake\WaitStartTime=ElapsedMilliseconds()
EndIf
If EarthQuake\StartTime>0
Protected Time.l=ElapsedMilliseconds()-EarthQuake\StartTime
Protected QuakeSize.l
Select EarthQuake\State
Case 0
QuakeSize.l=GUI\QuarterBlockSize*Time/800
If Time>800
EarthQuake\State=1
EarthQuake\StartTime=ElapsedMilliseconds()
EndIf
Case 1
QuakeSize.l=GUI\QuarterBlockSize
If Time>800
EarthQuake\State=2
EarthQuake\StartTime=ElapsedMilliseconds()
EndIf
Case 2
QuakeSize.l=GUI\QuarterBlockSize-(GUI\QuarterBlockSize*Time/800)
If Time>800
EarthQuake\State=0
EarthQuake\StartTime=0
EarthQuake\DeltaX=0
EarthQuake\DeltaY=0
EndIf
EndSelect
If QuakeSize<0:QuakeSize=0:EndIf ; Random(): Max Value can't be negative.
EarthQuake\DeltaX=Random(QuakeSize)
EarthQuake\DeltaY=Random(QuakeSize)
EndIf
If EarthQuake\State=1 And ListSize(EarthQuake\FallElement())=0
For n=0 To Game\Difficulty(Game\ScoreData\Difficulty)\NbPieceEarthQuake
Bx=Random(17)
By=Random(7)
If Game\GameTable(Bx,By)\Selected=0 And Game\GameTable(Bx,By)\Sprite>0
AddElement(EarthQuake\FallElement())
EarthQuake\FallElement()\X=GUI\BenchX+Bx*GUI\BlockSize
EarthQuake\FallElement()\Y=GUI\BenchY+By*GUI\BlockSize
EarthQuake\FallElement()\Sprite=Game\GameTable(Bx,By)\Sprite
Game\GameTable(Bx,By)\Sprite=0
EndIf
Next
EarthQuake\State=2
EndIf
EndProcedure
Procedure DisplayEarthQuakeFall()
If ListSize(EarthQuake\FallElement())>0
Protected.l TmpX,TmpY,Spr
ForEach(EarthQuake\FallElement())
EarthQuake\FallElement()\Y=EarthQuake\FallElement()\Y+GUI\QuarterBlockSize
TmpX=EarthQuake\FallElement()\X
TmpY=EarthQuake\FallElement()\Y
Spr=EarthQuake\FallElement()\Sprite
DisplayClipSprite(#Spr_Black,TmpX,TmpY,255)
DisplayClipSprite(Spr,TmpX,TmpY,255)
If EarthQuake\FallElement()\Y>ScreenHeight()
DeleteElement(EarthQuake\FallElement())
If ListSize(EarthQuake\FallElement())=0
EarthQuake\State=2
EndIf
EndIf
Next
EndIf
EndProcedure
; IDE Options = PureBasic 6.00 Beta 7 (Windows - x64)
; CursorPosition = 33
; FirstLine = 22
; Folding = -
; EnableXP

753
Easing.pbi Normal file
View File

@@ -0,0 +1,753 @@
;- Easing
Enumeration
#Easing_Linear
#Easing_ExpoEaseOut
#Easing_ExpoEaseIn
#Easing_ExpoEaseInOut
#Easing_ExpoEaseOutIn
#Easing_QuadEaseOut
#Easing_QuadEaseIn
#Easing_QuadEaseInOut
#Easing_QuadEaseOutIn
#Easing_CubicEaseOut
#Easing_CubicEaseIn
#Easing_CubicEaseInOut
#Easing_CubicEaseOutIn
#Easing_QuartEaseOut
#Easing_QuartEaseIn
#Easing_QuartEaseInOut
#Easing_QuartEaseOutIn
#Easing_QuintEaseOut
#Easing_QuintEaseIn
#Easing_QuintEaseInOut
#Easing_QuintEaseOutIn
#Easing_CircEaseOut
#Easing_CircEaseIn
#Easing_CircEaseInOut
#Easing_CircEaseOutIn
#Easing_SineEaseOut
#Easing_SineEaseIn
#Easing_SineEaseInOut
#Easing_SineEaseOutIn
#Easing_ElasticEaseOut
#Easing_ElasticEaseIn
#Easing_ElasticEaseInOut
#Easing_ElasticEaseOutIn
#Easing_BounceEaseOut
#Easing_BounceEaseIn
#Easing_BounceEaseInOut
#Easing_BounceEaseOutIn
#Easing_BackEaseOut
#Easing_BackEaseIn
#Easing_BackEaseInOut
#Easing_BackEaseOutIn
#Easing_End
EndEnumeration
#MAX_EASING=$10000
Global Dim EASING.f(#Easing_End-1, #MAX_EASING)
;-Expo
CompilerIf Defined(Easing_ExpoEaseOut, #PB_Constant) Or Defined(Easing_ExpoEaseOutIn,#PB_Constant)
Procedure.f ExpoEaseOut(Fraction.f)
If Fraction=1 : ProcedureReturn 1 : Else : ProcedureReturn (-Pow(2, -10 * Fraction) + 1) : EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_ExpoEaseIn,#PB_Constant) Or Defined(Easing_ExpoEaseOutIn,#PB_Constant)
; Easing equation function for an exponential (2^t) easing in:
; accelerating from zero velocity.
Procedure.f ExpoEaseIn(Fraction.f)
If Fraction=0 : ProcedureReturn 0 : Else : ProcedureReturn Pow(2, 10 * (Fraction-1)) : EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_ExpoEaseInOut,#PB_Constant)
; Easing equation function for an exponential (2^t) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f ExpoEaseInOut(Fraction.f)
If (Fraction=0)
ProcedureReturn 0
ElseIf (Fraction=1)
ProcedureReturn 1
EndIf
Fraction * 2
If (Fraction<1)
ProcedureReturn 0.5 * Pow(2, 10 * (Fraction - 1))
Else
ProcedureReturn 0.5 * (-Pow(2, -10 * (Fraction - 1)) + 2)
EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_ExpoEaseOutIn,#PB_Constant)
; Easing equation function for an exponential (2^t) easing out/in:
; deceleration until halfway, then acceleration.
Procedure.f ExpoEaseOutIn(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5 * ExpoEaseOut(2*Fraction)
Else
ProcedureReturn 0.5 + 0.5 * ExpoEaseIn(2*Fraction - 1)
EndIf
EndProcedure
CompilerEndIf
;-Quadratic
CompilerIf Defined(Easing_QuadEaseOut,#PB_Constant) Or Defined(Easing_QuadEaseOutIn,#PB_Constant)
; Easing equation function for a quadratic (t^2) easing out:
; decelerating from zero velocity.
Procedure.f QuadEaseOut(Fraction.f)
ProcedureReturn -Fraction * (Fraction - 2)
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_QuadEaseIn,#PB_Constant) Or Defined(Easing_QuadEaseOutIn,#PB_Constant)
; Easing equation function for a quadratic (t^2) easing in:
; accelerating from zero velocity.
Procedure.f QuadEaseIn(Fraction.f)
ProcedureReturn Fraction * Fraction
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_QuadEaseInOut,#PB_Constant)
; Easing equation function for a quadratic (t^2) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f QuadEaseInOut(Fraction.f)
Fraction * 2
If (Fraction<1)
ProcedureReturn 0.5 * Fraction * Fraction
Else
Fraction-1
ProcedureReturn -0.5 * (Fraction * (Fraction - 2) - 1)
EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_QuadEaseOutIn,#PB_Constant)
; Easing equation function for a quadratic (t^2) easing out/in:
; deceleration until halfway, then acceleration.
Procedure.f QuadEaseOutIn(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5 * QuadEaseOut(Fraction * 2);
Else
ProcedureReturn 0.5 + 0.5 * QuadEaseIn((Fraction * 2) - 1)
EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_CubicEaseOut,#PB_Constant) Or Defined(Easing_CubicEaseOutIn,#PB_Constant)
; Easing equation function for a cubic (t^3) easing out:
; decelerating from zero velocity.
Procedure.f CubicEaseOut(Fraction.f)
Fraction - 1
ProcedureReturn Fraction * Fraction * Fraction + 1
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_CubicEaseIn,#PB_Constant) Or Defined(Easing_CubicEaseOutIn,#PB_Constant)
; Easing equation function for a cubic (t^3) easing in:
; accelerating from zero velocity.
Procedure.f CubicEaseIn(Fraction.f)
ProcedureReturn Fraction * Fraction * Fraction
EndProcedure
CompilerEndIf
; Easing equation function for a cubic (t^3) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f CubicEaseInOut(Fraction.f)
Fraction * 2
If (Fraction<1)
ProcedureReturn 0.5 * Fraction * Fraction * Fraction
Else
Fraction - 2
ProcedureReturn 0.5 * (Fraction * Fraction * Fraction + 2)
EndIf
EndProcedure
CompilerIf Defined(Easing_CubicEaseOutIn,#PB_Constant)
; Easing equation function for a cubic (t^3) easing out/in:
; deceleration until halfway, then acceleration.
Procedure.f CubicEaseOutIn(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5 * CubicEaseOut(Fraction * 2)
Else
ProcedureReturn 0.5 + 0.5 * CubicEaseIn((Fraction * 2) - 1)
EndIf
EndProcedure
CompilerEndIf
;-Quartic
CompilerIf Defined(Easing_QuartEaseOut,#PB_Constant) Or Defined(Easing_QuartEaseOutIn,#PB_Constant)
; Easing equation function for a quartic (t^4) easing out:
; decelerating from zero velocity.
Procedure.f QuartEaseOut(Fraction.f)
Fraction - 1
ProcedureReturn -(Fraction * Fraction * Fraction * Fraction - 1)
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_QuartEaseIn,#PB_Constant) Or Defined(Easing_QuartEaseOutIn,#PB_Constant)
; Easing equation function for a quartic (t^4) easing in:
; accelerating from zero velocity.
Procedure.f QuartEaseIn(Fraction.f)
ProcedureReturn Fraction * Fraction * Fraction * Fraction
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_QuartEaseInOut,#PB_Constant)
; Easing equation function for a quartic (t^4) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f QuartEaseInOut(Fraction.f)
Fraction * 2
If (Fraction<1)
ProcedureReturn 0.5 * Fraction * Fraction * Fraction * Fraction
Else
Fraction - 2
ProcedureReturn -0.5 * (Fraction * Fraction * Fraction * Fraction - 2)
EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_QuartEaseOutIn,#PB_Constant)
; Easing equation function for a quartic (t^4) easing out/in:
; deceleration until halfway, then acceleration.
Procedure.f QuartEaseOutIn(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5 * QuartEaseOut(Fraction * 2)
Else
ProcedureReturn 0.5 + 0.5 * QuartEaseIn((Fraction * 2) - 1)
EndIf
EndProcedure
CompilerEndIf
;-Quintic
CompilerIf Defined(Easing_QuintEaseOut,#PB_Constant) Or Defined(Easing_QuintEaseOutIn,#PB_Constant)
; Easing equation function for a quintic (t^5) easing out:
; decelerating from zero velocity.
Procedure.f QuintEaseOut(Fraction.f)
Fraction - 1
ProcedureReturn (Fraction * Fraction * Fraction * Fraction * Fraction + 1)
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_QuintEaseIn,#PB_Constant) Or Defined(Easing_QuintEaseOutIn,#PB_Constant)
; Easing equation function for a quintic (t^5) easing in:
; accelerating from zero velocity.
Procedure.f QuintEaseIn(Fraction.f)
ProcedureReturn Fraction * Fraction * Fraction * Fraction * Fraction
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_QuintEaseInOut,#PB_Constant)
; Easing equation function for a quintic (t^5) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f QuintEaseInOut(Fraction.f)
Fraction * 2
If (Fraction<1)
ProcedureReturn 0.5 * Fraction * Fraction * Fraction * Fraction * Fraction
Else
Fraction - 2
ProcedureReturn 0.5 * (Fraction * Fraction * Fraction * Fraction * Fraction + 2)
EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_QuintEaseOutIn,#PB_Constant)
; Easing equation function for a quintic (t^5) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f QuintEaseOutIn(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5*QuintEaseOut(Fraction * 2);
Else
ProcedureReturn 0.5 + 0.5*QuintEaseIn((Fraction * 2) - 1)
EndIf
EndProcedure
CompilerEndIf
;- Circular
CompilerIf Defined(Easing_CircEaseOut,#PB_Constant) Or Defined(Easing_CircEaseOutIn,#PB_Constant)
; Easing equation function for a circular (sqrt(1-t^2)) easing out:
; decelerating from zero velocity.
Procedure.f CircEaseOut(Fraction.f)
Fraction - 1
ProcedureReturn Sqr(1 - Fraction * Fraction)
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_CircEaseIn,#PB_Constant) Or Defined(Easing_CircEaseOutIn,#PB_Constant)
; Easing equation function for a circular (sqrt(1-t^2)) easing in:
; accelerating from zero velocity.
Procedure.f CircEaseIn(Fraction.f)
ProcedureReturn - (Sqr(1 - Fraction * Fraction) - 1)
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_CircEaseInOut,#PB_Constant)
; Easing equation function for a circular (sqrt(1-t^2)) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f CircEaseInOut(Fraction.f)
Fraction * 2
If (Fraction<1)
ProcedureReturn -0.5 * (Sqr(1 - Fraction * Fraction) - 1)
Else
Fraction - 2
ProcedureReturn 0.5 * (Sqr(1 - Fraction * Fraction) + 1)
EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_CircEaseOutIn,#PB_Constant)
; Easing equation function for a circular (sqrt(1-t^2)) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f CircEaseOutIn(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5*CircEaseOut(Fraction * 2)
Else
ProcedureReturn 0.5 + 0.5*CircEaseIn((Fraction * 2) - 1)
EndIf
EndProcedure
CompilerEndIf
;-Sine
CompilerIf Defined(Easing_SineEaseOut,#PB_Constant) Or Defined(Easing_SineEaseOutIn,#PB_Constant)
; Easing equation function for a sinusoidal (sin(t)) easing out:
; decelerating from zero velocity.
Procedure.f SineEaseOut(Fraction.f)
ProcedureReturn Sin(Fraction * (#PI / 2))
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_SineEaseIn,#PB_Constant) Or Defined(Easing_SineEaseOutIn,#PB_Constant)
; Easing equation function for a sinusoidal (sin(t)) easing in:
; accelerating from zero velocity.
Procedure.f SineEaseIn(Fraction.f)
ProcedureReturn - Cos(Fraction * (#PI / 2)) + 1
EndProcedure
CompilerEndIf
; Easing equation function for a sinusoidal (sin(t)) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f SineEaseInOut(Fraction.f)
ProcedureReturn -0.5 * (Cos(Fraction*#PI) - 1)
EndProcedure
CompilerIf Defined(Easing_SineEaseOutIn,#PB_Constant)
; Easing equation function for a sinusoidal (sin(t)) easing in/out:
; deceleration until halfway, then acceleration.
Procedure.f SineEaseOutIn(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5*SineEaseOut(Fraction * 2)
Else
ProcedureReturn 0.5 + 0.5*SineEaseIn((Fraction * 2) - 1)
EndIf
EndProcedure
CompilerEndIf
;-Elastic
CompilerIf Defined(Easing_ElasticEaseOut,#PB_Constant) Or Defined(Easing_ElasticEaseOutIn,#PB_Constant)
; Easing equation function for an elastic (exponentially decaying sine wave) easing out:
; decelerating from zero velocity.
Procedure.f ElasticEaseOut(Fraction.f)
If (Fraction=1)
ProcedureReturn 1
EndIf
Protected p.f=0.3
Protected s.f=p / 4
ProcedureReturn Pow(2, -10 * Fraction) * Sin((Fraction - s) * (2 * #PI) / p) + 1
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_ElasticEaseIn,#PB_Constant) Or Defined(Easing_ElasticEaseOutIn,#PB_Constant)
; Easing equation function for an elastic (exponentially decaying sine wave) easing in:
; accelerating from zero velocity.
Procedure.f ElasticEaseIn(Fraction.f)
If (Fraction=1)
ProcedureReturn 1
EndIf
Protected p.f=0.3
Protected s.f=p / 4
Fraction - 1
ProcedureReturn -Pow(2, 10 * Fraction) * Sin((Fraction - s) * (2 * #PI) / p)
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_ElasticEaseInOut,#PB_Constant)
; Easing equation function for an elastic (exponentially decaying sine wave) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f ElasticEaseInOut(Fraction.f)
Fraction * 2
If (Fraction=2)
ProcedureReturn 1
EndIf
Protected p.f=(0.3 * 1.5)
Protected s.f=p / 4
If (Fraction<1)
Fraction - 1
ProcedureReturn -0.5 * (Pow(2, 10 * Fraction) * Sin((Fraction - s) * (2 * #PI) / p))
Else
Fraction - 1
ProcedureReturn 0.5 * (Pow(2, -10 * Fraction) * Sin((Fraction - s) * (2 * #PI) / p)) + 1
EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_ElasticEaseOutIn,#PB_Constant)
; Easing equation function for an elastic (exponentially decaying sine wave) easing out/in:
; deceleration until halfway, then acceleration.
Procedure.f ElasticEaseOutIn(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5*ElasticEaseOut(Fraction * 2)
Else
ProcedureReturn 0.5 + 0.5*ElasticEaseIn((Fraction * 2) - 1)
EndIf
EndProcedure
CompilerEndIf
;-Bounce
CompilerIf Defined(Easing_BounceEaseOut,#PB_Constant) Or Defined(Easing_BounceEaseOutIn,#PB_Constant) Or Defined(Easing_BounceEaseInOut,#PB_Constant)
; Easing equation function for a bounce (exponentially decaying parabolic bounce) easing out:
; decelerating from zero velocity.
Procedure.f BounceEaseOut(Fraction.f)
If (Fraction<(1 / 2.75))
ProcedureReturn (7.5625 * Fraction * Fraction)
ElseIf (Fraction<(2 / 2.75))
Fraction - (1.5 / 2.75)
ProcedureReturn (7.5625 * Fraction * Fraction + 0.75)
ElseIf (Fraction<(2.5 / 2.75))
Fraction - (2.25 / 2.75)
ProcedureReturn (7.5625 * Fraction * Fraction + 0.9375)
Else
Fraction - (2.625 / 2.75)
ProcedureReturn (7.5625 * Fraction * Fraction + 0.984375)
EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_BounceEaseIn,#PB_Constant) Or Defined(Easing_BounceEaseOutIn,#PB_Constant) Or Defined(Easing_BounceEaseInOut,#PB_Constant)
; Easing equation function for a bounce (exponentially decaying parabolic bounce) easing in:
; accelerating from zero velocity.
Procedure.f BounceEaseIn(Fraction.f)
ProcedureReturn 1 - BounceEaseOut(1 - Fraction)
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_BounceEaseInOut,#PB_Constant)
; Easing equation function for a bounce (exponentially decaying parabolic bounce) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f BounceEaseInOut(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5*BounceEaseIn(Fraction * 2)
Else
ProcedureReturn 0.5 + 0.5*BounceEaseOut((Fraction * 2) - 1)
EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_BounceEaseOutIn,#PB_Constant)
; Easing equation function for a bounce (exponentially decaying parabolic bounce) easing out/in:
; deceleration until halfway, then acceleration.
Procedure.f BounceEaseOutIn(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5*BounceEaseOut(Fraction * 2)
EndIf
ProcedureReturn 0.5 + 0.5*BounceEaseIn(Fraction * 2 - 1)
EndProcedure
CompilerEndIf
;-Back
CompilerIf Defined(Easing_BackEaseOut,#PB_Constant) Or Defined(Easing_BackEaseOutIn,#PB_Constant)
; Easing equation function for a back (overshooting cubic easing: (s+1)*t^3 - s*t^2) easing out:
; decelerating from zero velocity.
Procedure.f BackEaseOut(Fraction.f)
Fraction - 1
ProcedureReturn Fraction * Fraction * ((1.70158 + 1) * Fraction + 1.70158) + 1
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_BackEaseIn,#PB_Constant) Or Defined(Easing_BackEaseOutIn,#PB_Constant)
; Easing equation function for a back (overshooting cubic easing: (s+1)*t^3 - s*t^2) easing in:
; accelerating from zero velocity.
Procedure.f BackEaseIn(Fraction.f)
ProcedureReturn Fraction * Fraction * ((1.70158 + 1) * Fraction - 1.70158)
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_BackEaseInOut,#PB_Constant)
; Easing equation function for a back (overshooting cubic easing: (s+1)*t^3 - s*t^2) easing in/out:
; acceleration until halfway, then deceleration.
Procedure.f BackEaseInOut(Fraction.f)
Protected s.f=1.70158
Fraction * 2
If (Fraction<1)
s * (1.525)
ProcedureReturn 0.5 * (Fraction * Fraction * ((s + 1) * Fraction - s))
Else
Fraction - 2
s * (1.525)
ProcedureReturn 0.5 * (Fraction * Fraction * ((s + 1) * Fraction + s) + 2)
EndIf
EndProcedure
CompilerEndIf
CompilerIf Defined(Easing_BackEaseOutIn,#PB_Constant)
; Easing equation function for a back (overshooting cubic easing: (s+1)*t^3 - s*t^2) easing out/in:
; deceleration until halfway, then acceleration.
Procedure.f BackEaseOutIn(Fraction.f)
If (Fraction<0.5)
ProcedureReturn 0.5*BackEaseOut(Fraction * 2)
EndIf
ProcedureReturn 0.5 + 0.5*BackEaseIn((Fraction * 2) - 1)
EndProcedure
CompilerEndIf
;-FIN procedure
Procedure InitEase()
Protected i
For i=0 To #MAX_EASING
CompilerIf Defined(Easing_Linear, #PB_Constant)
EASING(#Easing_Linear,i)=i/#MAX_EASING
CompilerEndIf
CompilerIf Defined(Easing_ExpoEaseOut,#PB_Constant)
EASING(#Easing_ExpoEaseOut,i)=ExpoEaseOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_ExpoEaseIn,#PB_Constant)
EASING(#Easing_ExpoEaseIn,i)=ExpoEaseIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_ExpoEaseInOut,#PB_Constant)
EASING(#Easing_ExpoEaseInOut,i)=ExpoEaseInOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_ExpoEaseOutIn,#PB_Constant)
EASING(#Easing_ExpoEaseOutIn,i)=ExpoEaseOutIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_ExpoEaseOutIn,#PB_Constant)
EASING(#Easing_ExpoEaseOutIn,i)=ExpoEaseOutIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuadEaseOut,#PB_Constant)
EASING(#Easing_QuadEaseOut,i)=QuadEaseOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuadEaseIn,#PB_Constant)
EASING(#Easing_QuadEaseIn,i)=QuadEaseIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuadEaseInOut,#PB_Constant)
EASING(#Easing_QuadEaseInOut,i)=QuadEaseInOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuadEaseOutIn,#PB_Constant)
EASING(#Easing_QuadEaseOutIn,i)=QuadEaseOutIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_CubicEaseOut,#PB_Constant)
EASING(#Easing_CubicEaseOut,i)=CubicEaseOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_CubicEaseIn,#PB_Constant)
EASING(#Easing_CubicEaseIn,i)=CubicEaseIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_CubicEaseInOut,#PB_Constant)
EASING(#Easing_CubicEaseInOut,i)=CubicEaseInOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_CubicEaseOutIn,#PB_Constant)
EASING(#Easing_CubicEaseOutIn,i)=CubicEaseOutIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuartEaseOut,#PB_Constant)
EASING(#Easing_QuartEaseOut,i)=QuartEaseOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuartEaseIn,#PB_Constant)
EASING(#Easing_QuartEaseIn,i)=QuartEaseIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuartEaseInOut,#PB_Constant)
EASING(#Easing_QuartEaseInOut,i)=QuartEaseInOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuartEaseOutIn,#PB_Constant)
EASING(#Easing_QuartEaseOutIn,i)=QuartEaseOutIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuintEaseOut,#PB_Constant)
EASING(#Easing_QuintEaseOut,i)=QuintEaseOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuintEaseIn,#PB_Constant)
EASING(#Easing_QuintEaseIn,i)=QuintEaseIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuintEaseInOut,#PB_Constant)
EASING(#Easing_QuintEaseInOut,i)=QuintEaseInOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_QuintEaseOutIn,#PB_Constant)
EASING(#Easing_QuintEaseOutIn,i)=QuintEaseOutIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_CircEaseOut,#PB_Constant)
EASING(#Easing_CircEaseOut,i)=CircEaseOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_CircEaseIn,#PB_Constant)
EASING(#Easing_CircEaseIn,i)=CircEaseIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_CircEaseInOut,#PB_Constant)
EASING(#Easing_CircEaseInOut,i)=CircEaseInOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_CircEaseOutIn,#PB_Constant)
EASING(#Easing_CircEaseOutIn,i)=CircEaseOutIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_SineEaseOut,#PB_Constant)
EASING(#Easing_SineEaseOut,i)=SineEaseOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_SineEaseIn,#PB_Constant)
EASING(#Easing_SineEaseIn,i)=SineEaseIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_SineEaseInOut,#PB_Constant)
EASING(#Easing_SineEaseInOut,i)=SineEaseInOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_SineEaseOutIn,#PB_Constant)
EASING(#Easing_SineEaseOutIn,i)=SineEaseOutIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_ElasticEaseOut,#PB_Constant)
EASING(#Easing_ElasticEaseOut,i)=ElasticEaseOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_ElasticEaseIn,#PB_Constant)
EASING(#Easing_ElasticEaseIn,i)=ElasticEaseIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_ElasticEaseInOut,#PB_Constant)
EASING(#Easing_ElasticEaseInOut,i)=ElasticEaseInOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_ElasticEaseOutIn,#PB_Constant)
EASING(#Easing_ElasticEaseOutIn,i)=ElasticEaseOutIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_BounceEaseOut,#PB_Constant)
EASING(#Easing_BounceEaseOut,i)=BounceEaseOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_BounceEaseIn,#PB_Constant)
EASING(#Easing_BounceEaseIn,i)=BounceEaseIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_BounceEaseInOut,#PB_Constant)
EASING(#Easing_BounceEaseInOut,i)=BounceEaseInOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_BounceEaseOutIn,#PB_Constant)
EASING(#Easing_BounceEaseOutIn,i)=BounceEaseOutIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_BackEaseOut,#PB_Constant)
EASING(#Easing_BackEaseOut,i)=BackEaseOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_BackEaseIn,#PB_Constant)
EASING(#Easing_BackEaseIn,i)=BackEaseIn(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_BackEaseInOut,#PB_Constant)
EASING(#Easing_BackEaseInOut,i)=BackEaseInOut(i/#MAX_EASING)
CompilerEndIf
CompilerIf Defined(Easing_BackEaseOutIn,#PB_Constant)
EASING(#Easing_BackEaseOutIn,i)=BackEaseOutIn(i/#MAX_EASING)
CompilerEndIf
; CompilerIf Defined(Easing_ElasticEaseOut, #PB_Constant)
; EASING(#Easing_ElasticEaseOut,i)=ElasticEaseOut(i/#MAX_EASING)
; CompilerEndIf
Next
EndProcedure
InitEase()
Procedure.F FractionTimer(ExecutionTime, IsPingPong=#False, Duration=1000, LoopDuration=0)
If ExecutionTime<0 ; Determines if timer has started
ExecutionTime=0
ElseIf ExecutionTime>Duration ; Determines if timer has ended
ExecutionTime=Duration
EndIf
Protected Fraction.f
;Convert to Loop if necessary
If LoopDuration
Fraction=Mod(ExecutionTime, LoopDuration) / LoopDuration
Else
Fraction=ExecutionTime / Duration
EndIf
;Convert to PingPong if necessary
If IsPingPong
Fraction=1-Abs(2*Fraction-1)
EndIf
ProcedureReturn Fraction
EndProcedure
Procedure.f GetEasingPosValue(StartValue.f, FinishValue.f,StartTime.q, Duration.l, Easing.l)
Protected CurrentTime.q=ElapsedMilliseconds()-StartTime
Protected i=#MAX_EASING*CurrentTime/Duration
Protected Result.f,Distance.f
If i<0
Result=0
ElseIf i>#MAX_EASING
Result=1
Else
Result=EASING(Easing, i);#MAX_EASING
EndIf
Distance=FinishValue-StartValue
Protected.f Position=StartValue+Distance*Result
ProcedureReturn Position
EndProcedure
; IDE Options = PureBasic 6.00 Beta 6 (Windows - x64)
; CursorPosition = 739
; FirstLine = 676
; Folding = ---------------------
; EnableXP

95
Fontcreator.pb Normal file
View File

@@ -0,0 +1,95 @@
UsePNGImageEncoder()
UsePNGImageDecoder()
font.i= LoadFont(#PB_Any,"Arial",96)
Structure myFontData
x.l
y.l
Width.l
Height.l
EndStructure
Dim myFontData.myFontData(256)
AsciiStart.c=33
AsciiEnd.c=122
;Repeat
;Until
If IsFont(font)
MaxWidth=0
MaxHeight=0
CreateImage(0,1024,1024,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(0))
DrawingFont(FontID(font))
For a=AsciiStart To AsciiEnd
myFontData(a)\Width=TextWidth(Chr(a))
myFontData(a)\Height=TextHeight(Chr(a))
If myFontData(a)\Width>MaxWidth:MaxWidth=myFontData(a)\Width:EndIf
If myFontData(a)\Height>MaxHeight:MaxHeight=myFontData(a)\Height:EndIf
Next
StopDrawing()
FreeImage(0)
;Classique ;
If MaxWidth>MaxHeight
Max=MaxWidth
Else
Max=MaxHeight
EndIf
Debug "Size="+Str(Max)
Marg=4
CreateImage(0,(Max+Marg*2)*10,(Max+Marg*2)*10,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(0))
DrawingFont(FontID(font))
x.l=0:y.l=0
For a=AsciiStart To AsciiEnd
DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Outlined )
Box(x,y,Max+Marg*2,Max+Marg*2,RGBA(0,255,0,128))
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AlphaBlend)
DrawText(x+Marg,y+Marg,Chr(a),RGBA(255,255,255,255))
Line(x+Marg+myFontData(a)\Width,y,1,Max,RGBA(255,0,0,200))
Debug Chr(a)+" width="+Str(myFontData(a)\Width)
x=x+Max+Marg*2
If x+Max+Marg*2>ImageWidth(0):x=0:y=y+Max+Marg*2:EndIf
Next
StopDrawing()
SaveImage(0,"Fonts.png",#PB_ImagePlugin_PNG)
FreeImage(0)
;optimized
CreateImage(0,(Max+Marg*2)*10,(Max+Marg*2)*10,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(0))
DrawingFont(FontID(font))
x.l=0:y.l=0
Dim finalFont.myFontData(90)
For a=AsciiStart To 122
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AlphaBlend)
If x+myFontData(a)\Width+Marg*2>ImageWidth(0)
x=0:Y=Y+MaxHeight+Marg*2
EndIf
DrawText(x+Marg,y+Marg,Chr(a),RGBA(255,255,255,255))
finalFont(a-33)\x=x
finalFont(a-33)\y=y
finalFont(a-33)\Width=myFontData(a)\Width+Marg*2
finalFont(a-33)\Height=MaxHeight+Marg*2
x=x+myFontData(a)\Width+Marg*2
Next
Y=Y+MaxHeight+Marg*2
Line(0,Y,ImageWidth(0),1,RGBA(255,0,0,255))
StopDrawing()
SaveImage(0,"FontsCompress.png",#PB_ImagePlugin_PNG)
If CreateFile(0,"FontsCompress.dat")
WriteCharacter(0,AsciiStart,#PB_Ascii)
WriteCharacter(0,AsciiEnd,#PB_Ascii)
WriteData(0,@finalFont(),SizeOf(myFontData)*ArraySize(finalFont()))
CloseFile(0)
EndIf
EndIf
; IDE Options = PureBasic 6.00 Beta 5 (Windows - x64)
; CursorPosition = 85
; FirstLine = 18
; EnableXP

79
GUI.pbi Normal file
View File

@@ -0,0 +1,79 @@
;- Init Game param Structure
#MaxTableWidth=17
#MaxTableHeight=6
Structure GUIParam
FullScreen.l ; #True = Fullscreen / #False = WindowScreen (not .b use .l to be compatible with Option menu)
ScreenResolutionWidth.l ; Width Resolution in FullScreen
ScreenResolutionHeight.l ; Height Resolution in FullScreen
ScreenResolutionDepth.l
List ScreenResolution.s()
ScreenResolutionIndex.l
WindowResolutionWidth.l ; Width Résolution in WindowScreen
WindowResolutionHeight.l ; Height Résolution in WindowScreen
List WindowResolution.s()
WindowResolutionIndex.l
WindowX.l
WindowY.l
FPS.l ;FPS
fpsValue.l ;Current FPS Value
;Unit to Display GUI
BlockSize.l ; 1 Unit
HalfBlockSize.l ; 1/2 Unit
DoubleBlockSize.l ; 2 Unit
QuarterBlockSize.l ; 1/4 Unit
ScreenWidth.f
ScreenHeight.f
JewelRed_X.f
JewelBlue_X.f
;Bench Position Init in IniScreen()
BenchX.l
BenchY.l
BenchWidth.l
BenchHeight.l
;Timer Position Init in IniScreen()
TimerX.l
TimerY.l
TimerWidth.l
EndStructure
Global GUI.GUIParam
GUI\FullScreen=#True
;Get All Screen Resolution
If ExamineScreenModes()
ClearList(GUI\ScreenResolution())
AddElement(GUI\ScreenResolution())
GUI\ScreenResolution()="Auto"
While NextScreenMode()
If ScreenModeRefreshRate()>=60
AddElement(GUI\ScreenResolution())
GUI\ScreenResolution()=Str(ScreenModeWidth())+"x"+Str(ScreenModeHeight())+"x"+Str(ScreenModeDepth())+"@"+Str(ScreenModeRefreshRate())+"Hz"
EndIf
Wend
EndIf
;Get Window Resolution
ClearList(GUI\WindowResolution())
;4/3
AddElement(GUI\WindowResolution()):GUI\WindowResolution()="640x480"
AddElement(GUI\WindowResolution()):GUI\WindowResolution()="800x600";, 960×720, 1024×768, 1280×960, 1400×1050, 1440×1080 , 1600×1200, 1856×1392, 1920×1440, And 2048×1536
;16/9
AddElement(GUI\WindowResolution()):GUI\WindowResolution()="1024x576"
AddElement(GUI\WindowResolution()):GUI\WindowResolution()="1152x648"
AddElement(GUI\WindowResolution()):GUI\WindowResolution()="1280x720"
AddElement(GUI\WindowResolution()):GUI\WindowResolution()="1366x768"
AddElement(GUI\WindowResolution()):GUI\WindowResolution()="1600x900"
AddElement(GUI\WindowResolution()):GUI\WindowResolution()="1920x1080"
AddElement(GUI\WindowResolution()):GUI\WindowResolution()="2560x1440"
AddElement(GUI\WindowResolution()):GUI\WindowResolution()="3840x2160"
; IDE Options = PureBasic 6.00 LTS (Windows - x64)
; CursorPosition = 48
; FirstLine = 2
; EnableXP

1824
Game.pbi Normal file
View File

File diff suppressed because it is too large Load Diff

478
GameStructure.pbi Normal file
View File

@@ -0,0 +1,478 @@

; Bonus Enumeration Order must be the same like #Spr_
Enumeration BonusType
#Bonus_Health ; Add Health
#Bonus_Time ; Slowest Time
#Bonus_EarthQuake ; Check Bench and pieces Fall
#Bonus_Dead ; All points X2
#Bonus_JewelBlue ;
#Bonus_JewelRed ;
#Bonus_JewelGreen ;
#Bonus_Eye
#Bonus_Hammer
#Bonus_Remove
#Bonus_Gravity
#Bonus_Freeze
#Bonus_X2 ; All points X4
#Bonus_End
EndEnumeration
Enumeration Level
#Level_Novice
#Level_Normal
#Level_Hard
#Level_Madness
EndEnumeration
Enumeration Mode
#Mode_record
#Mode_Intro
#Mode_Menu
#Mode_Options
#Mode_Graphics
#Mode_Audios
#Mode_Game_Init
#Mode_Game_Run
#Mode_Game_Wait
#Mode_GameOver
#Mode_GameOver_End
#Mode_EnterYourName
#Mode_HallOfFame
#Mode_Credits
#Mode_JukeBox
EndEnumeration
Structure Table
Sprite.l
Selected.l
BonusOnThisCase.b
EndStructure
Structure Difficulty
NbLife.l
Timer.l
TimerDownValue.l
WaitMissed.l
EarthQuakeTimer.l
NbPieceEarthQuake.l
DeadBonusWaitTimer.l
DeadBonusDuration.l
BonusHammerDuration.l
BonusRemoveDuration.l
NbLittlePiece.l
DeadCounter.l ;
EndStructure
Structure HoF
Pseudo.s
Score.s
PiecesPerMinute.s
LoopsPerMinute.s
Duration.s
Id.s
EndStructure
Structure ScoreData
Pseudo.s
Difficulty.l ;Before DifficultyMode
Score.l
Duration.l
PiecesPerMinute.f
LoopsPerMinute.f
AveragePiecesPerLoop.f
NbLoop.l
BigestLoopSize.l
Bonus_JewelBlue.l
Bonus_JewelRed.l
Bonus_JewelGreen.l
BenchIsEmpty.l
Fps_Max.l
Fps_Min.l
Resolution.s
Os.s
GameVersion.s
ComputerName.s
UserName.s
PlayerKey.s
EndStructure
Structure Path
BX.l
BY.l
EndStructure
Global NewList LoopPath.Path()
Structure Game
;DifficultyMode.l
Array Difficulty.Difficulty(#Level_Madness)
Array GameTable.Table(#MaxTableWidth+1,#MaxTableHeight+1)
BlockMouseX.l ;
BlockMouseY.l ;
FluidCursor.l ; #True or #False (not .b use .l to be compatible with Option menu)
VolumeMusic.l
VolumeSfx.l
CurrentMusic.l ; Music Id played
NextShape.l
SelectedShape.l
Mode.l ;See enumeration mode
ComeFromMode.l ;Last Mode
ToggleMode.l
LastChangeModeTimer.l
WaitTimer.l
DisplayMouse.b ; #True or #False
Timer.l
NextTime.l
;Server
ConnectToServer.l ;#True / #False
ServerAddress.s
List Hof.Hof()
LastInsertIdLocal.l
LastInsertIdServer.l
;Score
ScoreData.ScoreData
Life.l
Combo.l
NbPiecesOnBench.l
UnfinishedLoopCount.l
NbCross.l
;Display Part
DrawMenu.b
DrawScore.b
DrawBench.b
DisplayEarthQuakeFall.b
DrawBonus.b
DrawTimer.b
DisplayMessage.b
DisplayCursor.b
;Other
DisplayFps.b
CaptureMouse.b
JukeBoxIndex.l
HallOfFameDifficultyMode.l
LittlePieceCounter.l
StartCalculBonus.b ; #False / #True Wait End Game Over Animation Before Calcul Bonus
Warning.s ; Contain Error et Important Message See Mode #Mode_Warning
WarningBackMode.l
*ObjetVinyl.SpriteData
*ObjetBlueJewel.SpriteData
*ObjetBlueJewelValue.TextData
*ObjetRedJewel.SpriteData
*ObjetRedJewelValue.TextData
*ObjetGreenJewel.SpriteData
*ObjetGreenJewelValue.TextData
*ObjetText.TextData[10]
EndStructure
Global Game.Game
Game\LastInsertIdLocal=13
Game\ScoreData\Difficulty=#Level_Normal
Game\Difficulty(#Level_Novice)\NbLife=5
Game\Difficulty(#Level_Novice)\Timer=6000
Game\Difficulty(#Level_Novice)\TimerDownValue=20
Game\Difficulty(#Level_Novice)\WaitMissed=3000
Game\Difficulty(#Level_Novice)\EarthQuakeTimer=100000
Game\Difficulty(#Level_Novice)\NbPieceEarthQuake=5 ;Max Nb Piece Fall after EarthQuake
Game\Difficulty(#Level_Novice)\DeadBonusWaitTimer=60000
Game\Difficulty(#Level_Novice)\DeadBonusDuration=10000
Game\Difficulty(#Level_Novice)\BonusHammerDuration=20000
Game\Difficulty(#Level_Novice)\BonusRemoveDuration=10000
Game\Difficulty(#Level_Novice)\NbLittlePiece=5
Game\Difficulty(#Level_Novice)\DeadCounter=100
Game\Difficulty(#Level_Normal)\NbLife=3
Game\Difficulty(#Level_Normal)\timer=5000
Game\Difficulty(#Level_Normal)\TimerDownValue=20
Game\Difficulty(#Level_Normal)\WaitMissed=2000
Game\Difficulty(#Level_Normal)\EarthQuakeTimer=60000
Game\Difficulty(#Level_Normal)\NbPieceEarthQuake=10 ;Max Nb Piece Fall after EarthQuake
Game\Difficulty(#Level_Normal)\DeadBonusWaitTimer=45000
Game\Difficulty(#Level_Normal)\DeadBonusDuration=20000
Game\Difficulty(#Level_Normal)\BonusHammerDuration=10000
Game\Difficulty(#Level_Normal)\BonusRemoveDuration=8000
Game\Difficulty(#Level_Normal)\NbLittlePiece=4
Game\Difficulty(#Level_Normal)\DeadCounter=60
Game\Difficulty(#Level_Hard)\NbLife=2
Game\Difficulty(#Level_Hard)\timer=4200
Game\Difficulty(#Level_Hard)\TimerDownValue=50
Game\Difficulty(#Level_Hard)\WaitMissed=1000
Game\Difficulty(#Level_Hard)\EarthQuakeTimer=45000
Game\Difficulty(#Level_Hard)\NbPieceEarthQuake=15 ;Max Nb Piece Fall after EarthQuake
Game\Difficulty(#Level_Hard)\DeadBonusWaitTimer=30000
Game\Difficulty(#Level_Hard)\DeadBonusDuration=30000
Game\Difficulty(#Level_Hard)\BonusHammerDuration=10000
Game\Difficulty(#Level_Hard)\BonusRemoveDuration=6000
Game\Difficulty(#Level_Hard)\NbLittlePiece=3
Game\Difficulty(#Level_Hard)\DeadCounter=30
Game\Difficulty(#Level_Madness)\NbLife=1
Game\Difficulty(#Level_Madness)\timer=3800
Game\Difficulty(#Level_Madness)\TimerDownValue=50
Game\Difficulty(#Level_Madness)\WaitMissed=500
Game\Difficulty(#Level_Madness)\EarthQuakeTimer=30000
Game\Difficulty(#Level_Madness)\NbPieceEarthQuake=20 ;Max Nb Piece Fall after EarthQuake
Game\Difficulty(#Level_Madness)\DeadBonusWaitTimer=20000
Game\Difficulty(#Level_Madness)\DeadBonusDuration=25000
Game\Difficulty(#Level_Madness)\BonusHammerDuration=5000
Game\Difficulty(#Level_Madness)\BonusRemoveDuration=4000
Game\Difficulty(#Level_Madness)\NbLittlePiece=2
Game\Difficulty(#Level_Madness)\DeadCounter=10
Structure Stats
StartGameTimer.q
StartLoopTimer.q
List PieceTime.l()
List LoopTime.l()
List NbPieces.l()
Array NbItemByGroup.l(7)
Array NbBonus.l(#Bonus_End)
;To calcul Bonus
BigestLoopSize.l
NbLoop.l
Bonus_JewelBlue.l
Bonus_JewelRed.l
Bonus_JewelGreen.l
BenchIsEmpty.l
EndStructure
Global Stats.Stats
Procedure.s BoolToString(B.b)
If B=#True
ProcedureReturn "True"
Else
ProcedureReturn "False"
EndIf
EndProcedure
Procedure.b StringToBool(String.s)
String=Trim(UCase(String))
If String="YES" Or String="1" Or String="ENABLE" Or String="TRUE"
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure InitNewResolution()
If SelectElement(GUI\ScreenResolution(),GUI\ScreenResolutionIndex)
Debug "InitNewReoslution() Screenresolution:"+GUI\ScreenResolution()
If LCase(GUI\ScreenResolution())="auto"
If ExamineScreenModes()
While NextScreenMode()
GUI\ScreenResolutionWidth=ScreenModeWidth()
GUI\ScreenResolutionHeight=ScreenModeHeight()
GUI\ScreenResolutionDepth=ScreenModeDepth()
Wend
EndIf
Else
GUI\ScreenResolutionWidth=Val(StringField(GUI\ScreenResolution(),1,"x"))
GUI\ScreenResolutionHeight=Val(StringField(GUI\ScreenResolution(),2,"x"))
GUI\ScreenResolutionDepth=Val(StringField(StringField(GUI\ScreenResolution(),1,"@"),3,"x"))
EndIf
EndIf
If SelectElement(GUI\WindowResolution(),GUI\WindowResolutionIndex)
GUI\WindowResolutionWidth=Val(StringField(GUI\WindowResolution(),1,"x"))
GUI\WindowResolutionHeight=Val(StringField(GUI\WindowResolution(),2,"x"))
EndIf
EndProcedure
Procedure.s GetScreenPrint()
Protected n.l
Protected string.s=""
For n=0 To ExamineDesktops()-1
string+DesktopName(n)+":"+DesktopWidth(n)+"x"+DesktopHeight(n)+"x"+DesktopDepth(n)+"@"+DesktopFrequency(n)+"PosX="+DesktopX(n)+"&PosY="+DesktopY(n)
Next
ProcedureReturn StringFingerprint(string, #PB_Cipher_MD5)
EndProcedure
Procedure LoadPrefs()
If FileSize(GetPDataDirectory("Loopz.ini"))=-1
If CreatePreferences(GetPDataDirectory("Loopz.ini"))
Debug "LoadPrefs() Create Loopz.ini >"+GetPDataDirectory("Loopz.ini")
WritePreferenceString("FullScreen","True")
WritePreferenceString("ScreenResolution","Auto")
WritePreferenceString("VolumeMusic","70")
WritePreferenceString("VolumeSfx","100")
WritePreferenceLong("LastInsertIdServer",-1)
WritePreferenceLong("LastInsertIdLocal",-1)
WritePreferenceString ("LastPseudoUsed","")
WritePreferenceString ("PlayerKey","")
ClosePreferences()
Else
Debug "LoadPrefs() Can't Create Loopz.ini >"+GetPDataDirectory("Loopz.ini")
EndIf
EndIf
If OpenPreferences(GetPDataDirectory("Loopz.ini"))
Debug "LoadPrefs() Load Loopz.ini >"+GetPDataDirectory("Loopz.ini")
GUI\FullScreen=StringToBool(ReadPreferenceString("FullScreen","True"))
Protected.l ScreenResolution.s,WindowResolution.s
ScreenResolution=ReadPreferenceString("ScreenResolution","Auto")
Game\FluidCursor=StringToBool(ReadPreferenceString("FluidCursor","True"))
Game\VolumeMusic=Int(ReadPreferenceLong("VolumeMusic",100)/10)
Game\VolumeSfx=Int(ReadPreferenceLong("VolumeSfx",100)/10)
Game\LastInsertIdServer=ReadPreferenceLong("LastInsertIdServer",-1)
Game\LastInsertIdLocal=ReadPreferenceLong("LastInsertIdLocal",-1)
Game\ScoreData\Pseudo=ReadPreferenceString ("LastPseudoUsed","")
Game\ScoreData\PlayerKey=ReadPreferenceString ("PlayerKey","")
;Set Resolution
If LCase(ScreenResolution)="auto"
Protected.l SWidth,SHeight,SDepth,SFreq
If ExamineScreenModes()
;Select Last ScreenMode (Higer)
While NextScreenMode()
SWidth=ScreenModeWidth()
SHeight=ScreenModeHeight()
SDepth=ScreenModeDepth()
SFreq=ScreenModeRefreshRate()
Wend
EndIf
ScreenResolution=Str(SWidth)+"x"+Str(SHeight)+"x"+Str(SDepth)+"@"+Str(SFreq)+"Hz"
GUI\ScreenResolutionIndex=0
;If resolution is defined Like WidthxHeightxDepth@FreqHz
Else
GUI\ScreenResolutionIndex=-1
;Check If resolution exist in
ForEach GUI\ScreenResolution()
If LCase(GUI\ScreenResolution())=LCase(ScreenResolution)
GUI\ScreenResolutionIndex=ListIndex(GUI\ScreenResolution())
Break
EndIf
Next
;If No ScreenResolution No Found
If GUI\ScreenResolutionIndex=-1
GUI\ScreenResolutionIndex=0
EndIf
EndIf
If SelectElement(GUI\ScreenResolution(),GUI\ScreenResolutionIndex)
Debug "LoadPrefs() Screenresolution:"+GUI\ScreenResolution()
Else
Debug "LoadPrefs() Screenresolution:Error"
EndIf
;Window
PreferenceGroup("ConfigScreens:"+GetScreenPrint())
GUI\WindowX=Val(ReadPreferenceString ("WindowX","-1" ))
GUI\WindowY=Val(ReadPreferenceString("WindowY","-1" ))
Debug "LoadPrefs() WindowX="+Str(GUI\WindowX)
Debug "LoadPrefs() WindowY="+Str(GUI\WindowY)
WindowResolution=ReadPreferenceString("WindowResolution","1024x576")
GUI\WindowResolutionIndex=-1
ForEach GUI\WindowResolution()
If LCase(GUI\WindowResolution())=LCase(WindowResolution)
GUI\WindowResolutionIndex=ListIndex(GUI\WindowResolution())
Break
EndIf
Next
If GUI\WindowResolutionIndex=-1
GUI\WindowResolutionIndex=2 ; default 1024x576
EndIf
PreferenceGroup("Server")
CompilerIf #UsePreProdServer=#True
Game\ServerAddress=#PreProdServerURL
CompilerElse
Game\ServerAddress=ReadPreferenceString ("URL","https://loopzdb.thyphoon.net/LoopzServer.php" )
CompilerEndIf
Game\ConnectToServer=StringToBool(ReadPreferenceString ("ConnectToServer","True" ))
InitNewResolution()
ClosePreferences()
EndIf
EndProcedure
Procedure SavePrefs()
Debug "SavePref():"+GetPDataDirectory("Loopz.ini")
If OpenPreferences(GetPDataDirectory("Loopz.ini"))
WritePreferenceString ("FullScreen", BoolToString(GUI\FullScreen))
If SelectElement(GUI\ScreenResolution(),GUI\ScreenResolutionIndex)
WritePreferenceString ("ScreenResolution", GUI\ScreenResolution())
Debug "SavePrefs() ScreenResolution="+GUI\ScreenResolution()
Else
Debug "ERROR: SavePrefs() GUI\ScreenResolutionIndex="+Str(GUI\ScreenResolutionIndex)
EndIf
WritePreferenceString ("FluidCursor", BoolToString(Game\FluidCursor))
WritePreferenceLong("VolumeMusic",Game\VolumeMusic*10)
WritePreferenceLong("VolumeSfx",Game\VolumeSfx*10)
WritePreferenceLong("LastInsertIdServer",Game\LastInsertIdServer)
WritePreferenceLong("LastInsertIdLocal",Game\LastInsertIdLocal)
WritePreferenceString ("LastPseudoUsed",Game\ScoreData\Pseudo)
PreferenceGroup("ConfigScreens:"+GetScreenPrint())
Debug "Prefs ScreenPrint:"+GetScreenPrint()
If SelectElement(GUI\WindowResolution(),GUI\WindowResolutionIndex)
WritePreferenceString ("WindowResolution", GUI\WindowResolution())
Debug "SavePrefs() WindowResolution="+GUI\WindowResolution()
Else
Debug "ERROR: SavePrefs() GUI\WindowResolutionIndex="+Str(GUI\WindowResolutionIndex)
EndIf
WritePreferenceLong ("WindowX", GUI\WindowX)
WritePreferenceLong("WindowY", GUI\WindowY)
PreferenceGroup("Server")
WritePreferenceString ("URL",Game\ServerAddress)
WritePreferenceString ("ConnectToServer",BoolToString(Game\ConnectToServer))
ClosePreferences()
Else
MessageRequester("Prefs Error","Can't Save "+GetPDataDirectory("Loopz.ini"))
EndIf
EndProcedure
;Bonus random Position
; https://stackoverflow.com/questions/196017/unique-non-repeating-random-numbers-in-o1
#TableWidht=#MaxTableWidth+1
#TableHeight=#MaxTableHeight+1
#TableIndexMax=#TableWidht*#TableHeight-1
Structure RandomUniq
Array DataList.l(#TableIndexMax)
Index.l
EndStructure
Global RandomUniq.RandomUniq
Procedure RandUniq()
;Randomize datas
Protected Max.l,Index.l
If RandomUniq\Index=0
For Max=#TableIndexMax To 0 Step -1
Swap RandomUniq\DataList(Max),RandomUniq\DataList(Random(#TableIndexMax))
Next
RandomUniq\Index=#TableIndexMax
EndIf
Index=RandomUniq\Index
RandomUniq\Index-1
ProcedureReturn RandomUniq\DataList(Index)
EndProcedure
Define n.l
For n=0 To #TableIndexMax
RandomUniq\DataList(n)=n
Next
; IDE Options = PureBasic 6.11 LTS (Windows - x64)
; CursorPosition = 398
; FirstLine = 394
; Folding = --
; EnableXP
; DPIAware

260
Linux_Screen3DMousePatch.pbi Normal file
View File

@@ -0,0 +1,260 @@
;-TOP
; Comment : Linux Screen3DMousePatch
; Author : mk-soft
; Version : v1.03.2
; Create : 02.09.2022
; Update : 10.09.2022
; Link : https://www.purebasic.fr/english/viewtopic.php?t=79766
; Info:
;
; - Call InitWindowMouse after OpenScreen or OpenWindowedScreen
; - Call RestoreMouse at end of program to restore desktop mouse cursor (Needs only with OpenScreen)
; - Call FrameDelay for save cpu usage (Needs only with OpenWindowedScreen)
; - Enumeration of cursor type:
; * Link: "https://docs.gtk.org/gdk3/enum.CursorType.html"
; * Blank: -2
;
; - ScrollRange:
; * Auto scrolling range for mouse delta
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
ImportC ""
gtk_widget_get_window(widget)
gdk_get_default_root_window()
gdk_window_get_cursor(window)
EndImport
Structure udtMouseData
IsWindow.i
Window.i
WindowID.i
WindowGDK.i
IsMenu.i
CursorDefault.i
CursorScreen.i
CursorState.i
x.l
y.l
lastX.l
lastY.l
deltaX.l
deltaY.l
menuHeight.l
scrollRange.l
screenWidth.l
screenHeight.l
EndStructure
Global MyMouseData.udtMouseData
Procedure InitWindowMouse(Window = 0, CursorDefault = 0, CursorScreen = 130, ScrollRange = 25)
Protected PosX.l, PosY.l
With MyMouseData
; Get Window Data
If IsWindow(Window)
\IsWindow = #True
\Window = Window
\WindowID = WindowID(Window)
\WindowGDK = gtk_widget_get_window(\WindowID)
If IsMenu(0)
\IsMenu = #True
\menuHeight = MenuHeight()
EndIf
Else
\WindowGDK = gdk_get_default_root_window()
EndIf
; Define Cursor Data
If CursorDefault
\CursorDefault = gdk_cursor_new_(CursorDefault)
Else
\CursorDefault = gdk_window_get_cursor(\WindowGDK)
EndIf
\CursorScreen = gdk_cursor_new_(CursorScreen); Blank = -2
gdk_window_set_cursor_(\WindowGDK, \CursorScreen)
; Scroll Range
\scrollRange = ScrollRange
\screenWidth = ScreenWidth()
\screenHeight = ScreenHeight()
; Get Positions
If IsWindow(Window)
gtk_widget_get_pointer_(\WindowID, @PosX, @PosY)
\lastX = PosX
\lastY = PosY
Else
\x = DesktopMouseX()
\y = DesktopMouseY()
\lastX = \x
\lastY = \y
EndIf
EndWith
ProcedureReturn #True
EndProcedure
Procedure RestoreMouse()
Protected window, cursor
If OpenWindow(0, 0, 0, 0, 0, "Restore Mouse Cursor", #PB_Window_Invisible)
window = gdk_get_default_root_window()
cursor = gdk_cursor_new_(68)
If window
gdk_window_set_cursor_(window, cursor)
EndIf
EndIf
EndProcedure
; ----
Procedure.f MyMouseX()
ProcedureReturn MyMouseData\x
EndProcedure
Procedure.f MyMouseY()
ProcedureReturn MyMouseData\y
EndProcedure
Procedure.f MyMouseDeltaX()
ProcedureReturn MyMouseData\deltaX
EndProcedure
Procedure.f MyMouseDeltaY()
ProcedureReturn MyMouseData\deltaY
EndProcedure
Procedure MyReleaseMouse(State)
With MyMouseData
\CursorState = State
If \WindowGDK
If State
gdk_window_set_cursor_(\WindowGDK, \CursorDefault)
Else
gdk_window_set_cursor_(\WindowGDK, \CursorScreen)
EndIf
EndIf
EndWith
EndProcedure
Procedure MyExamineMouse()
Protected PosX.l, PosY.l
With MyMouseData
If \IsWindow
gtk_widget_get_pointer_(\WindowID, @PosX, @PosY)
If \IsMenu
PosY - \menuHeight
EndIf
If PosX < 0
PosX = 0
ElseIf PosX >= \screenWidth
PosX = \screenWidth - 1
EndIf
If PosY < 0
PosY = 0
ElseIf PosY >= \screenHeight
PosY = \screenHeight - 1
EndIf
Else
PosX = DesktopMouseX()
PosY = DesktopMouseY()
EndIf
\x = PosX
\y = PosY
If \CursorState
\deltaX = 0
\deltaY = 0
Else
\deltaX = PosX - \lastX
\deltaY = PosY - \lastY
EndIf
\lastX = PosX
\lastY = PosY
If PosX < \scrollRange
\lastX = \scrollRange
If \deltaX > \scrollRange
\deltaX = \scrollRange
EndIf
ElseIf PosX > \screenWidth - \scrollRange
\lastX = \screenWidth - \scrollRange
If \deltaX < -\scrollRange
\deltaX = -\scrollRange
EndIf
Else
\lastX = PosX
EndIf
If PosY < \scrollRange
\lastY = \scrollRange
If \deltaY > \scrollRange
\deltaY = \scrollRange
EndIf
ElseIf PosY > \screenHeight - \scrollRange
\lastY = \screenHeight - \scrollRange
If \deltaY < -\scrollRange
\deltaY = -\scrollRange
EndIf
Else
\lastY = PosY
EndIf
EndWith
ProcedureReturn #True
EndProcedure
;-- Macros
Macro MouseX()
MyMouseX()
EndMacro
Macro MouseY()
MyMouseY()
EndMacro
Macro MouseDeltaX()
MyMouseDeltaX()
EndMacro
Macro MouseDeltaY()
MyMouseDeltaY()
EndMacro
Macro ReleaseMouse(State)
MyReleaseMouse(State)
EndMacro
Macro ExamineMouse()
MyExamineMouse()
EndMacro
CompilerElse
Procedure InitWindowMouse(Window = 0, CursorDefault = 0, CursorScreen = 130, ScrollRange = 25)
; do nothing
EndProcedure
Procedure RestoreMouse()
; do nothing
EndProcedure
CompilerEndIf
Procedure FrameDelay(Frames = 30)
Static time
Protected diff_time, delay_time
If time
diff_time = ElapsedMilliseconds() - time
delay_time = (1000 / Frames) - diff_time
If delay_time > 0
Delay(delay_time)
EndIf
EndIf
time = ElapsedMilliseconds()
EndProcedure
;-- End
; IDE Options = PureBasic 6.00 LTS (Linux - x64)
; CursorPosition = 253
; FirstLine = 174
; Folding = ----
; EnableXP
; DPIAware

BIN
LoopzFont.dat Normal file
View File

Binary file not shown.

450
Main.pb Normal file
View File

@@ -0,0 +1,450 @@
;*******************************
; Free Loopz
;
; By Yann LEBRUN (Thyphoon)
; Mars 2022
;*******************************
#MajorVersion="1"
#BuildVersion="2"
#GamePlayVersion="2" ;Change when gameplay change
#Version=#MajorVersion+"."+#GamePlayVersion+"."+#BuildVersion+"."+#PB_Editor_CompileCount
;-Config
#UsePreProdServer=#False
#PreProdServerURL="https://loopzdb.thyphoon.net/LoopzServer-pp.php"
#UsePackFile=#True ; True load file From Data.pck / False load file directly
#DebugCheckLoopVerbose=#True; see CheckLoop()
#DebugPackageVerbose=#False ; see Package.pbi
#TestServer=#False ;See >TEST SERVEUR
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Linux
CompilerSelect #PB_Compiler_Processor
CompilerCase#PB_Processor_x86
#CompileVersion="Linuxx86"
CompilerCase#PB_Processor_x64
#CompileVersion="Linuxx64"
CompilerCase#PB_Processor_Arm32
#CompileVersion="LinuxArm32"
CompilerCase#PB_Processor_Arm64
#CompileVersion="LinuxArm64"
CompilerEndSelect
CompilerCase #PB_OS_MacOS
CompilerSelect #PB_Compiler_Processor
CompilerCase#PB_Processor_x86
#CompileVersion="MacOsx86"
CompilerCase#PB_Processor_x64
#CompileVersion="MacOsx64"
CompilerCase#PB_Processor_Arm32
#CompileVersion="MacOsArm32"
CompilerCase#PB_Processor_Arm64
#CompileVersion="MacOsArm64"
CompilerEndSelect
CompilerCase #PB_OS_Windows
CompilerSelect #PB_Compiler_Processor
CompilerCase#PB_Processor_x86
#CompileVersion="Windowsx86"
CompilerCase#PB_Processor_x64
#CompileVersion="Windowsx64"
CompilerCase#PB_Processor_Arm32
#CompileVersion="WindowsArm32"
CompilerCase#PB_Processor_Arm64
#CompileVersion="WindowsArm64"
CompilerEndSelect
CompilerEndSelect
EnableExplicit
UsePNGImageDecoder()
UsePNGImageEncoder() ; To Take ScreenShoot
UseMD5Fingerprint()
;Hide cursor Code from Shardik
;src : https://www.purebasic.fr/english/viewtopic.php?f=15&t=71173&start=4
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
#GDK_BLANK_CURSOR = -2
;ImportC ""
;gtk_widget_get_window(*Widget.GtkWidget)
;EndImport
CompilerEndIf
Procedure HideCursor(HideCursor.I = #True)
Protected Cursor.I
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Linux
;If HideCursor
;; Cursor = gdk_cursor_new_(#GDK_BLANK_CURSOR)
;Else
; Cursor = 0
;EndIf
;gdk_window_set_cursor_(gtk_widget_get_window(WindowID(0)), Cursor)
CompilerCase #PB_OS_MacOS
If HideCursor
;CocoaMessage(0, 0, "NSCursor hide")
Else
;CocoaMessage(0, 0, "NSCursor unhide")
EndIf
CompilerCase #PB_OS_Windows
If HideCursor
ShowCursor_(#False)
Else
ShowCursor_(#True)
EndIf
CompilerEndSelect
EndProcedure
Procedure.s GetPDataDirectory(File.s)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
ProcedureReturn GetUserDirectory(#PB_Directory_AllUserData)+"LoopzRemix\"+File
CompilerCase #PB_OS_MacOS
ProcedureReturn GetCurrentDirectory()+File
CompilerCase #PB_OS_Linux
ProcedureReturn GetCurrentDirectory()+File
CompilerEndSelect
EndProcedure
Procedure.b GetLeftMouseClick()
Static Mb.l
If MouseButton(#PB_MouseButton_Left)
If Mb=#False
Debug "MOUSE 1"
Mb=#True
ProcedureReturn #True
EndIf
Else
Mb=#False
EndIf
ProcedureReturn #False
EndProcedure
CompilerIf #PB_Compiler_OS<>#PB_OS_Windows
Procedure.s KeyboardInkeyEx()
Protected key.s
key = KeyboardInkey()
If KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift)
key = UCase(key)
EndIf
ProcedureReturn key
EndProcedure
CompilerEndIf
;-Event GUI
Enumeration Event
#EventGui_Empty
#EventGui_PlayJukeBox
#EventGui_ChangeVinyl
#EventGui_AddJewelBlue
#EventGui_AddJewelRed
#EventGui_AddJewelGreen
#EventGui_EnableHammer
#EventGui_EnableRemover
#EventGui_EnableEye
#EventGui_AddHealth
#EventGui_AddX2
#EventGui_Dead
#EventGui_EnableFreeze
#EventGui_NextHallOfFame
#EventGui_NewResolution
#EventGui_ChangeMusicVolume
#EventGui_ChangeSfxVolume
#EventGui_StartCalculBonus
EndEnumeration
Global NewList myEventGUI.l()
Procedure PostEventGUI(Event.l)
AddElement(myEventGUI())
myEventGUI()=Event
EndProcedure
Procedure EventGUI()
Protected Event.l
If ListSize(myEventGUI())>0
FirstElement(myEventGUI())
Event=myEventGUI()
DeleteElement(myEventGUI())
Else
Event=0
EndIf
ProcedureReturn Event
EndProcedure
Procedure.s MyFormatNumber(Base.s,Value.l)
Protected ValueTxt.s=Str(Value)
ProcedureReturn Left(Base,Len(Base)-Len(ValueTxt))+ValueTxt
EndProcedure
;- Init Library
If InitSprite() = 0 Or InitKeyboard()=0 Or InitMouse()=0 Or InitSound()=0
MessageRequester("Erreur", "Can't Init Sprite() Or Keyboard() Or Mouse() Or Sound()", 0)
End
EndIf
Declare InitGameMode(Mode.l)
Declare AddmoveToEngine(*Value,ValueType.l,StartTime.l,Duration.l,StartValue.f,EndValue.f,Easing.l,Event.l=-1,*AutoDestroy=0)
Declare AddItemToDisplayEngine(*Pointer,Type.l,InsertIndex.l=-1)
Declare myDisplaySprite(*Sprite)
Declare DisplayText(*Text)
Declare DisplayMenu()
Declare DisplayTitles()
Declare DisplayBench()
Declare DisplayCursor()
Declare DisplayScore()
Declare DisplayMessage()
Declare DisplayBonus()
Declare DisplayEarthQuakeFall()
Declare DisplayTimer()
Declare DisplayWarning(Warning.s,BackMode.l=-1)
XIncludeFile("Linux_Screen3DMousePatch.pbi")
XIncludeFile("Easing.pbi")
XIncludeFile("GUI.pbi")
XIncludeFile("Package.pb") ;XIncludeFile("Package.pbi")
XIncludeFile("GameStructure.pbi")
XIncludeFile("Sprite.pbi")
XIncludeFile("SpritesObj.pbi")
XIncludeFile("BitmapText.pbi")
XIncludeFile("MoveEngine.pbi")
XIncludeFile("Sound.pbi")
XIncludeFile("Screen.pbi")
XIncludeFile("EarthQuake.pbi")
XIncludeFile("Bonus.pbi")
XIncludeFile("Database.pbi")
XIncludeFile("Shape.pbi")
XIncludeFile("Menu.pbi")
XIncludeFile("Game.pbi")
;- TEST SERVEUR
CompilerIf #TestServer=#True
;to test server
LoadPrefs()
If OpenWindow(0, 0, 0, 640, 480, "Loopz "+#Version, #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, 640, 480)
Game\ScoreData\Pseudo="Thy"
Game\ScoreData\Difficulty=1
Game\ScoreData\Score=Random(10000,800)
Game\ScoreData\Duration=168059
Game\ScoreData\PiecesPerMinute=27.0539970398
Game\ScoreData\LoopsPerMinute=1.440633893
Game\ScoreData\AveragePiecesPerLoop=16.33
Game\ScoreData\NbLoop=3
Game\ScoreData\BigestLoopSize=32
Game\ScoreData\Bonus_JewelBlue=13
Game\ScoreData\Bonus_JewelRed=1
Game\ScoreData\BenchIsEmpty=0
Game\ScoreData\Fps_Max=61
Game\ScoreData\Fps_Min=60
EndIf
;The function you want to test
;LoadHallOfFameFromServer(1)
SaveScoreToServerDB()
End
CompilerEndIf
Procedure Quit()
If IsDatabase(#DB)
CloseDatabase(#DB)
SavePrefs()
HideCursor(#False)
EndIf
End
EndProcedure
Procedure DisplayWarning(Warning.s,BackMode.l=-1)
Debug Warning
If BackMode=-1
BackMode=#Mode_Menu
EndIf
Game\Warning=Warning
EndProcedure
Procedure Main()
;- Load Sound
CompilerIf #UsePackFile=#True
CatchSoundFromPackage(#Snd_PutPiece,"mixkit-explainer-video-game-alert-sweep-236.wav")
CatchSoundFromPackage(#Snd_CanTPutPiece,"mixkit-video-game-retro-click-237.wav")
CatchSoundFromPackage(#Snd_DoALoop,"mixkit-extra-bonus-in-a-video-game-2045.wav")
CatchSoundFromPackage(#Snd_GetBonus,"mixkit-bonus-earned-in-video-game-2058.wav")
CatchSoundFromPackage(#Snd_GetBonus2,"322897-rhodesmas-connected-01.wav") ; https://freesound.org/people/rhodesmas/sounds/322897/
CatchSoundFromPackage(#Snd_DeletePiece,"mixkit-fast-small-sweep-transition-166.wav")
CatchSoundFromPackage(#Snd_GetJewel,"mixkit-fairy-magic-sparkle-871.wav")
CatchSoundFromPackage(#Snd_EarthQuake,"mixkit-erupting-volcano-lava-2442.wav")
CatchSoundFromPackage(#Snd_DeadBonus,"My-Dead-Snd-Effect.wav")
CatchSoundFromPackage(#Snd_MetalHammer,"Metal-hammer.wav")
CatchSoundFromPackage(#Snd_Woosh,"Woosh 06.wav") ;old moogy73_woosh-medium-short-01.wav
CatchSoundFromPackage(#Snd_Collapse,"434897-thebuilder15-collapse.wav")
CatchSoundFromPackage(#Snd_Freeze,"446112-justinvoke-freeze.wav")
CatchSoundFromPackage(#Snd_Jukebox,"jukebox.wav")
CatchSoundFromPackage(#Snd_WaterDrop,"Goutte 03.wav")
CompilerElse
LoadSound(#Snd_PutPiece,"Datas\mixkit-explainer-video-game-alert-sweep-236.wav") ; Put piece
LoadSound(#Snd_CanTPutPiece,"Datas\mixkit-video-game-retro-click-237.wav") ; Can't put Piece
LoadSound(#Snd_DoALoop,"Datas\mixkit-extra-bonus-in-a-video-game-2045.wav") ; I Have a Loop
LoadSound(#Snd_GetBonus,"Datas\mixkit-bonus-earned-in-video-game-2058.wav") ; Get Bonus
LoadSound(#Snd_GetBonus2,"Datas\322897-rhodesmas-connected-01.wav")
LoadSound(#Snd_DeletePiece,"Datas\mixkit-fast-small-sweep-transition-166.wav")
LoadSound(#Snd_GetJewel,"Datas\mixkit-fairy-magic-sparkle-871.wav") ; Edited
LoadSound(#Snd_EarthQuake,"Datas\mixkit-erupting-volcano-lava-2442.wav")
LoadSound(#Snd_DeadBonus,"Datas\My-Dead-Snd-Effect.wav")
LoadSound(#Snd_MetalHammer,"Datas\Metal-hammer.wav")
LoadSound(#Snd_Woosh,"Datas\Woosh 06.wav") ;425706__moogy73__woosh-medium-short-01.wav
LoadSound(#Snd_WaterDrop,"Datas\Goutte 03.wav")
LoadSound(#Snd_Collapse,"Datas\434897-thebuilder15-collapse.wav")
LoadSound(#Snd_Freeze,"Datas\446112-justinvoke-freeze.wav")
LoadSound(#Snd_Jukebox,"Datas\jukebox.wav")
;271401__ylearkisto__levyautomaatti-kolikko-aukkoon-vanha-jukebox-old-coin-into-the-slot-mechanism-starts-To-buzz.wav
CompilerEndIf
Protected n.l=0
For n=0 To #Snd_DeadBonus
If Not IsSound(n)
MessageRequester("Sound Error","Can't use sound "+Str(n))
End
EndIf
Next
;-Load Music
Game\CurrentMusic=-1
CompilerIf #UsePackFile=#True
CatchMusicFromPackage(#Music_Intro,"Loopz03V2.mod")
CatchMusicFromPackage(#Music_GameA,"Loopz01.mod")
CatchMusicFromPackage(#Music_GameB,"Loopz02.mod")
CatchMusicFromPackage(#Music_Missed,"LoopzGameOver01.mod")
CatchMusicFromPackage(#Music_GameOver,"LoopzGameOver03.mod")
CatchMusicFromPackage(#Music_HighScore,"LoopzHighScore01V2.mod")
CatchMusicFromPackage(#Music_Credits,"Loopz10.mod")
CompilerElse
LoadMusic(#Music_Intro,"Modules/Loopz03V2.mod")
LoadMusic(#Music_GameA,"Modules/Loopz01.mod")
LoadMusic(#Music_GameB,"Modules/Loopz02.mod")
LoadMusic(#Music_Missed,"Modules/LoopzGameOver01.mod")
LoadMusic(#Music_GameOver,"Modules/LoopzGameOver03.mod")
LoadMusic(#Music_HighScore,"Modules/LoopzHighScore01V2.mod")
LoadMusic(#Music_Credits,"Modules/Loopz10.mod")
CompilerEndIf
LoadPrefs()
;-Init Volume SFX / MUSIC
For n=0 To #Music_End-1
MusicVolume(n,Game\VolumeMusic*10)
Next
;SoundVolume(#PB_All,Game\VolumeSfx*10)
For n=0 To #Snd_End-1
SoundVolume(n,Game\VolumeSfx*10)
Next
;-Load Sprite
; in InitScreen because you must to reload all sprite when you change resolution in game (Option resolution)
InitScreen()
Protected Event.i
InitDatabase()
InitGameMode(#Mode_Intro)
;InitGameMode(#Mode_record)
HideCursor(#True)
MouseLocate(ScreenWidth()/2,(GUI\BenchHeight+GUI\BenchY)/2)
Protected MouseOutScreen.b=#False
Repeat
;Loop for window Mode
If GUI\FullScreen=#False And IsWindow(0)
Repeat
Event = WindowEvent()
Select Event
Case #PB_Event_CloseWindow
Quit()
Case #PB_Event_MoveWindow
GUI\WindowX=WindowX(0)
GUI\WindowY=WindowY(0)
EndSelect
Until Event = 0
EndIf
ExamineKeyboard()
ExamineMouse()
;- Mouse IN/OUT
If GUI\FullScreen=#False
;Debug "MouseOutScreen="+Str(MouseOutScreen)+" WindowMouseX(0)="+Str(WindowMouseX(0))+ " ScreenWidth()="+Str(ScreenWidth())
If MouseOutScreen=#True And WindowMouseX(0) > 2 And WindowMouseY(0) > 2 And WindowMouseX(0) < ScreenWidth()-2 And WindowMouseY(0) < ScreenHeight() -2
Debug "Mouse IN"
ReleaseMouse(0)
MouseLocate(WindowMouseX(0), WindowMouseY(0))
;MouseLocate(ScreenWidth()/2, ScreenHeight() / 2)
HideCursor(#True)
MouseOutScreen = #False
ElseIf MouseOutScreen=#False And (MouseX() <2 Or MouseY() < 2 Or MouseX() > ScreenWidth() -2 Or MouseY() > ScreenHeight() -2)
Debug "Mouse OUT"
ReleaseMouse(1)
HideCursor(#False)
MouseOutScreen = #True
EndIf
Else
MouseOutScreen=#False
ReleaseMouse(0)
EndIf
;- Switch FullScreen / Window
If Game\Mode<>#Mode_Game_Run And KeyboardPushed(#PB_Key_LeftAlt) And KeyboardPushed(#PB_Key_Return)
DeInitScreen()
GUI\FullScreen=1-GUI\FullScreen
InitScreen()
InitGameMode(#Mode_Menu)
EndIf
;- Quit Game
If KeyboardReleased(#PB_Key_Escape)
If Game\Mode=#Mode_Menu
Quit()
Else
InitGameMode(#Mode_Menu)
EndIf
EndIf
If KeyboardPushed(#PB_Key_Add)
Debug Str(ElapsedMilliseconds())+ " "+Str(ListSize(MoveEngine()))
EndIf
FlipBuffersAndRetrieveFPS()
ClearScreen(RGB(32,32,32))
CheckMusic()
GameMode()
If MouseOutScreen=#True
DisplayClipSprite(#Spr_White,0,0,128,1,ScreenWidth(),ScreenHeight())
Else
If Game\DisplayCursor=#True
DisplayClipSprite(#Spr_Pointer,MouseX(),MouseY(),255,1)
EndIf
EndIf
If Game\DisplayFps=#True
Debug Str(GUI\fpsValue)+" Fps"
EndIf
Delay(1)
ForEver
EndProcedure
Main()
; IDE Options = PureBasic 6.11 LTS (Windows - x64)
; CursorPosition = 15
; FirstLine = 15
; Folding = ---
; EnableXP
; DisableDebugger
; EnableCompileCount = 158
; EnableBuildCount = 0
; EnableExeConstant

178
Menu.pbi Normal file
View File

@@ -0,0 +1,178 @@
Declare InitGameMode(Mode.l)
Structure MenuOption
X.f
Y.f
Width.l
*ChoiceIndex.Long
String.s
Choices.s
GoToMode.l
SendGUIEvent.l
EndStructure
Structure Menu
MenuTitle.s
*Obj
X.f
Y.f
Width.l
OptionIndex.l
List MenuOption.MenuOption()
EndStructure
Global Menu.Menu
Procedure NewMenu(MenuTitle.s,DefaultOptionIndex.l=0)
Menu\MenuTitle=MenuTitle
Menu\OptionIndex=DefaultOptionIndex
ClearList(Menu\MenuOption())
Menu\Obj=NewSprite(-1,0,0,0,0,255,1)
EndProcedure
Procedure AddMenuOption(String.s,GoToMode.l=-1,SendGUIEvent.l=-1,Choices.s="",*ChoiceIndex=-1)
Protected *MenuOption=AddElement(Menu\MenuOption())
Menu\MenuOption()\String=String
Menu\MenuOption()\Choices=Choices
Menu\MenuOption()\ChoiceIndex=*ChoiceIndex
Menu\MenuOption()\GoToMode=GoToMode
Menu\MenuOption()\SendGUIEvent=SendGUIEvent
ProcedureReturn *MenuOption
EndProcedure
Procedure StartMenu()
AddmoveToEngine(@Menu\Y,#PB_Float,0,1500,ScreenHeight(),GUI\BlockSize*2,#Easing_ElasticEaseOut)
Protected Spacing.l,StartY.l
Spacing=((GUI\ScreenHeight-5)/ListSize(Menu\MenuOption()))*GUI\BlockSize
If Spacing>GUI\BlockSize:Spacing=GUI\BlockSize:EndIf
StartY=(ScreenHeight()-5*GUI\BlockSize-ListSize(Menu\MenuOption())*Spacing)/2
ForEach Menu\MenuOption()
DrawingBitmapFont(0)
Protected String.s=Menu\MenuOption()\String
If Menu\MenuOption()\Choices<>""
If Menu\MenuOption()\ChoiceIndex<>-1
String=String+" : "+StringField(Menu\MenuOption()\Choices,Menu\MenuOption()\ChoiceIndex\l+1,"|")
Else
String=String+" Error ChoiceIndex"
EndIf
EndIf
Menu\MenuOption()\Width=TextBitmapWidth(String)
Menu\MenuOption()\X=(ScreenWidth()-Menu\MenuOption()\Width)/2
Menu\MenuOption()\Y=3*GUI\BlockSize+StartY+ListIndex(Menu\MenuOption())*Spacing
If ListIndex(Menu\MenuOption())%2
AddmoveToEngine(@Menu\MenuOption()\X,#PB_Float,0,1500,ScreenWidth(),Menu\MenuOption()\X,#Easing_ElasticEaseOut)
Else
AddmoveToEngine(@Menu\MenuOption()\X,#PB_Float,0,1500,-Menu\MenuOption()\Width,Menu\MenuOption()\X,#Easing_ElasticEaseOut)
EndIf
Next
;StartMove(Menu\Obj)
EndProcedure
Procedure FinalizeMenu()
DrawingBitmapFont(1)
Menu\Width=TextBitmapWidth(Menu\MenuTitle)
Menu\X=(ScreenWidth()-Menu\Width)/2
DrawingBitmapFont(0)
StartMenu()
EndProcedure
Procedure EndMenu(Mode.l=-1)
If Mode<>-1
Mode=1000+Mode
EndIf
AddmoveToEngine(@Menu\Y,#PB_Float,0,500,GUI\BlockSize*2,ScreenHeight(),#Easing_SineEaseOut,Mode)
ForEach Menu\MenuOption()
If ListIndex(Menu\MenuOption())%2
AddmoveToEngine(@Menu\MenuOption()\X,#PB_Float,0,500,Menu\MenuOption()\X,ScreenWidth(),#Easing_SineEaseOut)
Else
AddmoveToEngine(@Menu\MenuOption()\X,#PB_Float,0,500,Menu\MenuOption()\X,-Menu\MenuOption()\Width,#Easing_SineEaseOut)
EndIf
Next
EndProcedure
Procedure DisplayMenu()
Protected.l X,Y,Width,Alpha
Protected String.s
Static MB.l
DrawingBitmapFont(1)
DrawBitmapText(Menu\X,Menu\Y,Menu\MenuTitle)
DrawingBitmapFont(0)
ForEach Menu\MenuOption()
If MouseX()>Menu\MenuOption()\X And MouseX()<Menu\MenuOption()\X+Menu\MenuOption()\Width And MouseY()>Menu\MenuOption()\Y And MouseY()<Menu\MenuOption()\Y+GUI\BlockSize
Menu\OptionIndex=ListIndex(Menu\MenuOption())
EndIf
String=Menu\MenuOption()\String
If Menu\MenuOption()\Choices<>""
String=String+" : "+StringField(Menu\MenuOption()\Choices,Menu\MenuOption()\ChoiceIndex\l+1,"|")
EndIf
If Menu\OptionIndex=ListIndex(Menu\MenuOption())
Alpha=255
If GetLeftMouseClick() Or KeyboardReleased(#PB_Key_Space) ;Or (KeyboardReleased(#PB_Key_Return) And KeyboardPushed(#PB_Key_LeftAlt)=0)
PlaySound(#Snd_WaterDrop)
;If MB=#False
;MB=#True
If Menu\MenuOption()\Choices<>"" And Menu\MenuOption()\ChoiceIndex<>-1
Menu\MenuOption()\ChoiceIndex\l=Menu\MenuOption()\ChoiceIndex\l+1
If Menu\MenuOption()\ChoiceIndex\l>CountString(Menu\MenuOption()\Choices,"|")
Menu\MenuOption()\ChoiceIndex\l=0
EndIf
Debug "Drawmenu() Space Index:"+Str(Menu\MenuOption()\ChoiceIndex\l)
ElseIf Menu\MenuOption()\GoToMode>0
EndMenu(Menu\MenuOption()\GoToMode)
EndIf
If Menu\MenuOption()\SendGUIEvent>-1
Debug "DrawMenu() PosteEventGUI("+Str(Menu\MenuOption()\SendGUIEvent)
PostEventGUI(Menu\MenuOption()\SendGUIEvent)
EndIf
;EndIf
;Else
; MB=#False
EndIf
If Menu\MenuOption()\Choices<>""
If KeyboardReleased(#PB_Key_Left) And Menu\MenuOption()\ChoiceIndex\l>0
PlaySound(#Snd_WaterDrop)
Menu\MenuOption()\ChoiceIndex\l=Menu\MenuOption()\ChoiceIndex\l-1
If Menu\MenuOption()\SendGUIEvent>-1
PostEventGUI(Menu\MenuOption()\SendGUIEvent)
EndIf
Debug "Drawmenu() Left Index:"+Str(Menu\MenuOption()\ChoiceIndex\l)
EndIf
If KeyboardReleased(#PB_Key_Right) And Menu\MenuOption()\ChoiceIndex\l<CountString(Menu\MenuOption()\Choices,"|")
PlaySound(#Snd_WaterDrop)
Menu\MenuOption()\ChoiceIndex\l=Menu\MenuOption()\ChoiceIndex\l+1
If Menu\MenuOption()\SendGUIEvent>-1
PostEventGUI(Menu\MenuOption()\SendGUIEvent)
EndIf
Debug "Drawmenu() Right Index:"+Str(Menu\MenuOption()\ChoiceIndex\l)
EndIf
EndIf
Else
Alpha=100
EndIf
DrawBitmapText(Menu\MenuOption()\X,Menu\MenuOption()\Y,String,Alpha)
Next
If KeyboardReleased(#PB_Key_Up) And Menu\OptionIndex>0
PlaySound(#Snd_WaterDrop)
Menu\OptionIndex=Menu\OptionIndex-1
EndIf
If KeyboardReleased(#PB_Key_Down) And Menu\OptionIndex<ListSize(Menu\MenuOption())-1
PlaySound(#Snd_WaterDrop)
Menu\OptionIndex=Menu\OptionIndex+1
EndIf
EndProcedure
; IDE Options = PureBasic 6.00 Beta 6 (Windows - x64)
; CursorPosition = 118
; FirstLine = 108
; Folding = --
; EnableXP

161
Menu_old.pbi Normal file
View File

@@ -0,0 +1,161 @@
Declare InitGameMode(Mode.l)
Structure MenuOption
X.f
Y.f
Width.l
*ChoiceIndex
ChoiceIndexType.l
String.s
Choices.s
GoToMode.l
SendGUIEvent.l
EndStructure
Structure Menu
MenuTitle.s
*Obj
X.f
Y.f
Width.l
OptionIndex.l
List MenuOption.MenuOption()
EndStructure
Global Menu.Menu
Procedure NewMenu(MenuTitle.s,DefaultOptionIndex.l=0)
Menu\MenuTitle=MenuTitle
Menu\OptionIndex=DefaultOptionIndex
ClearList(Menu\MenuOption())
Menu\Obj=NewSprite(-1,0,0,0,0,255,1)
EndProcedure
Procedure AddMenuOption(String.s,GoToMode.l=-1,SendGUIEvent.l=-1,Choices.s="",*ChoiceIndex=-1,ChoiceIndexType.l=#PB_Long)
Protected *MenuOption=AddElement(Menu\MenuOption())
Menu\MenuOption()\String=String
Menu\MenuOption()\Choices=Choices
Menu\MenuOption()\ChoiceIndex=*ChoiceIndex
Menu\MenuOption()\ChoiceIndexType=ChoiceIndexType
Menu\MenuOption()\GoToMode=GoToMode
Menu\MenuOption()\SendGUIEvent=SendGUIEvent
ProcedureReturn *MenuOption
EndProcedure
Procedure StartMenu()
Addmove(Menu\Obj,0,@Menu\Y,ScreenHeight(),GUI\BlockSize*2,2000,#Easing_ElasticEaseOut)
Protected Spacing.l,StartY.l
Spacing=((GUI\ScreenHeight-5)/ListSize(Menu\MenuOption()))*GUI\BlockSize
If Spacing>GUI\BlockSize:Spacing=GUI\BlockSize:EndIf
StartY=(ScreenHeight()-5*GUI\BlockSize-ListSize(Menu\MenuOption())*Spacing)/2
Protected ChoiceIndex.l
ForEach Menu\MenuOption()
ChoiceIndex=1
DrawingBitmapFont(0)
Protected String.s=Menu\MenuOption()\String
If Menu\MenuOption()\Choices<>""
String=String+" : "+StringField(Menu\MenuOption()\Choices,ChoiceIndex+1,"|")
EndIf
Menu\MenuOption()\Width=TextBitmapWidth(String)
Menu\MenuOption()\X=(ScreenWidth()-Menu\MenuOption()\Width)/2
Menu\MenuOption()\Y=3*GUI\BlockSize+StartY+ListIndex(Menu\MenuOption())*Spacing
If ListIndex(Menu\MenuOption())%2
Addmove(Menu\Obj,0,@Menu\MenuOption()\X,ScreenWidth(),Menu\MenuOption()\X,2000,#Easing_ElasticEaseOut)
Else
Addmove(Menu\Obj,0,@Menu\MenuOption()\X,-Menu\MenuOption()\Width,Menu\MenuOption()\X,2000,#Easing_ElasticEaseOut)
EndIf
Next
StartMove(Menu\Obj)
EndProcedure
Procedure FinalizeMenu()
DrawingBitmapFont(1)
Menu\Width=TextBitmapWidth(Menu\MenuTitle)
Menu\X=(ScreenWidth()-Menu\Width)/2
DrawingBitmapFont(0)
StartMenu()
EndProcedure
Procedure EndMenu(Mode.l=-1)
If Mode<>-1
Mode=1000+Mode
EndIf
Addmove(Menu\Obj,0,@Menu\Y,GUI\BlockSize*2,ScreenHeight(),2000,#Easing_ElasticEaseOut,Mode)
ForEach Menu\MenuOption()
If ListIndex(Menu\MenuOption())%2
Addmove(Menu\Obj,0,@Menu\MenuOption()\X,Menu\MenuOption()\X,ScreenWidth(),2000,#Easing_ElasticEaseOut)
Else
Addmove(Menu\Obj,0,@Menu\MenuOption()\X,Menu\MenuOption()\X,-Menu\MenuOption()\Width,2000,#Easing_ElasticEaseOut)
EndIf
Next
StartMove(Menu\Obj)
EndProcedure
Procedure DrawMenu()
Protected.l X,Y,Width,Alpha,ChoiceIndex
Protected String.s
DrawingBitmapFont(1)
DrawBitmapText(Menu\X,Menu\Y,Menu\MenuTitle)
DrawingBitmapFont(0)
ForEach Menu\MenuOption()
String=Menu\MenuOption()\String
ChoiceIndex=1;ChoiceIndex
If Menu\MenuOption()\Choices<>""
String=String+" : "+StringField(Menu\MenuOption()\Choices,ChoiceIndex+1,"|")
EndIf
If Menu\OptionIndex=ListIndex(Menu\MenuOption())
Alpha=255
If KeyboardReleased(#PB_Key_Space)
If Menu\MenuOption()\Choices<>""
ChoiceIndex=ChoiceIndex+1
If ChoiceIndex>CountString(Menu\MenuOption()\Choices,"|")
ChoiceIndex=0
EndIf
ElseIf Menu\MenuOption()\GoToMode>0
EndMenu(Menu\MenuOption()\GoToMode)
EndIf
If Menu\MenuOption()\SendGUIEvent>-1
PostEventGUI(Menu\MenuOption()\SendGUIEvent)
EndIf
EndIf
If Menu\MenuOption()\Choices<>""
If KeyboardReleased(#PB_Key_Left) ;And ChoiceIndex>0
;TODO
ChoiceIndex=ChoiceIndex-1
If Menu\MenuOption()\SendGUIEvent>-1
PostEventGUI(Menu\MenuOption()\SendGUIEvent)
EndIf
EndIf
If KeyboardReleased(#PB_Key_Right) ;And ChoiceIndex<CountString(Menu\MenuOption()\Choices,"|")
ChoiceIndex=ChoiceIndex+1
If Menu\MenuOption()\SendGUIEvent>-1
PostEventGUI(Menu\MenuOption()\SendGUIEvent)
EndIf
EndIf
EndIf
Else
Alpha=100
EndIf
DrawBitmapText(Menu\MenuOption()\X,Menu\MenuOption()\Y,String,Alpha)
Next
If KeyboardReleased(#PB_Key_Up) And Menu\OptionIndex>0
Menu\OptionIndex=Menu\OptionIndex-1
EndIf
If KeyboardReleased(#PB_Key_Down) And Menu\OptionIndex<ListSize(Menu\MenuOption())-1
Menu\OptionIndex=Menu\OptionIndex+1
EndIf
EndProcedure
; IDE Options = PureBasic 6.00 Beta 6 (Windows - x64)
; CursorPosition = 50
; FirstLine = 39
; Folding = --
; EnableXP

BIN
MonoFont.dat Normal file
View File

Binary file not shown.

181
MoveEngine.pbi Normal file
View File

@@ -0,0 +1,181 @@
Structure MoveEngine
MoveStartTime.q
StartValue.f
EndValue.f
StartTime.l
Duration.l
Easing.l
Event.l
AutoDestroySprites.b
ValueType.l ; #PB_Long / #PB_Float
*ValueL.Long; Each field (Long, Float resides at the
*ValueF.Float ; same address in memory.
*AutoDestroy.Byte ;
EndStructure
Global NewList MoveEngine.MoveEngine()
Procedure AddmoveToEngine(*Value,ValueType.l,StartTime.l,Duration.l,StartValue.f,EndValue.f,Easing.l,Event.l=-1,*AutoDestroy=0)
AddElement(MoveEngine())
MoveEngine()\ValueType=ValueType
Select MoveEngine()\ValueType
Case #PB_Long
MoveEngine()\ValueL=*Value
;Debug "AddmoveToEngine() Long Value="+Str(*Value)
Case #PB_Float
MoveEngine()\ValueF=*Value
;Debug "AddmoveToEngine() Float Value="+Str(*Value)
EndSelect
MoveEngine()\StartTime=StartTime
MoveEngine()\Duration=Duration
MoveEngine()\StartValue=StartValue
MoveEngine()\EndValue=EndValue
MoveEngine()\Easing=Easing
MoveEngine()\Event=Event
MoveEngine()\AutoDestroy=*AutoDestroy
EndProcedure
Procedure RunMoveEngine()
Protected ThisStartTime.q
Protected ThisEndTime.q
Protected ElapsedTime.l
If ListSize(MoveEngine())>0
ForEach MoveEngine()
If MoveEngine()\MoveStartTime=0
MoveEngine()\MoveStartTime=ElapsedMilliseconds()
EndIf
ThisStartTime=MoveEngine()\MoveStartTime+MoveEngine()\StartTime
ThisEndTime=ThisStartTime+MoveEngine()\Duration
If ElapsedMilliseconds()>=ThisStartTime And ElapsedMilliseconds()<=ThisEndTime
ElapsedTime=ElapsedMilliseconds()-ThisStartTime
If MoveEngine()\ValueL<>0 Or MoveEngine()\ValueF<>0
Select MoveEngine()\ValueType
Case #PB_Long
MoveEngine()\ValueL\l=GetEasingPosValue(MoveEngine()\StartValue, MoveEngine()\EndValue,ThisStartTime, MoveEngine()\Duration, MoveEngine()\Easing)
Case #PB_Float
MoveEngine()\ValueF\f=GetEasingPosValue(MoveEngine()\StartValue, MoveEngine()\EndValue,ThisStartTime, MoveEngine()\Duration, MoveEngine()\Easing)
EndSelect
EndIf
;At the End
ElseIf ElapsedMilliseconds()>=ThisEndTime
If MoveEngine()\ValueL<>0 Or MoveEngine()\ValueF<>0
Select MoveEngine()\ValueType
Case #PB_Long
MoveEngine()\ValueL\l=MoveEngine()\EndValue
Case #PB_Float
MoveEngine()\ValueF\f=MoveEngine()\EndValue
EndSelect
EndIf
;new Event
If MoveEngine()\Event>-1
PostEventGUI(MoveEngine()\Event)
MoveEngine()\Event=-1
EndIf
If MoveEngine()\AutoDestroy<>0
MoveEngine()\AutoDestroy\b=#True
EndIf
DeleteElement(MoveEngine())
EndIf
Next
EndIf
EndProcedure
Procedure ClearMoveEngine()
ClearList(MoveEngine())
EndProcedure
Enumeration
#Type_Sprite
#Type_BitmapText
#Type_DisplayMenu
#Type_DisplayTitle
#Type_DisplayBench
#Type_DisplayCursor
#Type_DisplayScore
#Type_DisplayMessage
#Type_DisplayBonus
#Type_DisplayEarthQuakeFall
#Type_DisplayTimer
EndEnumeration
Structure DisplayEngine
Type.l
*Pointer
EndStructure
Global NewList DisplayEngine.DisplayEngine()
Procedure RenderingDisplayEngine()
Protected *SprPointer.SpriteData
Protected *TxtPointer.TextData
ForEach DisplayEngine()
Select DisplayEngine()\Type
Case #Type_Sprite
*SprPointer=DisplayEngine()\Pointer
If *SprPointer\AutoDestroy=#True
ForEach Sprites()
If Sprites()=*SprPointer
DeleteElement(Sprites())
Debug "DeleteElement(Sprites())"
Break;
EndIf
Next
DeleteElement(DisplayEngine())
Debug "DeleteElement(DisplayEngine())"
Else
myDisplaySprite(DisplayEngine()\Pointer)
EndIf
Case #Type_BitmapText
*TxtPointer=DisplayEngine()\Pointer
If *TxtPointer\AutoDestroy=#True
ForEach Sprites()
If Sprites()=*TxtPointer
DeleteElement(Sprites())
Break;
EndIf
Next
DeleteElement(DisplayEngine())
Else
DisplayText(DisplayEngine()\Pointer)
EndIf
Case #Type_DisplayMenu
DisplayMenu()
Case #Type_DisplayTitle
DisplayTitles()
Case #Type_DisplayBench
DisplayBench()
Case #Type_DisplayCursor
DisplayCursor()
Case #Type_DisplayScore
DisplayScore()
Case #Type_DisplayMessage
DisplayMessage()
Case #Type_DisplayBonus
DisplayBonus()
Case #Type_DisplayEarthQuakeFall
DisplayEarthQuakeFall()
Case #Type_DisplayTimer
DisplayTimer()
EndSelect
Next
EndProcedure
Procedure AddItemToDisplayEngine(*Pointer,Type.l,InsertIndex.l=-1)
AddElement(DisplayEngine())
DisplayEngine()\Pointer=*Pointer
DisplayEngine()\Type=Type
ProcedureReturn ListIndex(DisplayEngine())
EndProcedure
Procedure ClearDisplayEngine()
ClearList(DisplayEngine())
EndProcedure
; IDE Options = PureBasic 6.00 Beta 6 (Windows - x64)
; CursorPosition = 27
; FirstLine = 18
; Folding = --
; EnableXP

BIN
MyFont.dat Normal file
View File

Binary file not shown.

56
Network.pbi Normal file
View File

@@ -0,0 +1,56 @@
EnableExplicit
If InitNetwork() = 0
MessageRequester("Error", "Can't initialize the network !", 0)
End
EndIf
Procedure NetworkLoop()
Protected Port.l = 80
Protected *Buffer = AllocateMemory(1000)
Protected Cnx.i = OpenNetworkConnection("82.64.24.137", Port)
Protected NEvent.i
Protected Quit=#False
If Cnx
Debug "connextion"
SendNetworkString(Cnx, "An hello from a client !!! :-)", #PB_UTF8)
Debug "envoye"
Repeat
NEvent=NetworkClientEvent(Cnx)
If NEvent
Select NEvent
Case #PB_NetworkEvent_None
Debug "A new client has connected !"
Case #PB_NetworkEvent_Data
Debug " has send a packet !"
ReceiveNetworkData(Cnx, *Buffer, 1000)
If PeekS(*Buffer, -1, #PB_UTF8)="ok"
Quit=#True
EndIf
Case #PB_NetworkEvent_Disconnect
Debug "has closed the connection..."
Quit = #True
EndSelect
EndIf
Delay(1)
Until Quit=1
EndIf
Debug "on a quitter"
End
EndProcedure
NetworkLoop()
; IDE Options = PureBasic 6.00 Beta 6 (Windows - x64)
; CursorPosition = 34
; FirstLine = 1
; Folding = -
; EnableXP

29
NewBitmap.pbi Normal file
View File

@@ -0,0 +1,29 @@
Structure myFontData
x.l
y.l
Width.l
Height.l
EndStructure
Structure BitmapFont
Array FontData.myFontData(90)
EndStructure
Global NewList BitmapFont.BitmapFont()
Procedure LoadBitmapFont()
AddElement(BitmapFont())
If OpenFile(0,"FontsCompress.dat")
ReadData(0,@BitmapFont()\FontData(),SizeOf(myFontData)*ArraySize(BitmapFont()\FontData()))
CloseFile(0)
EndIf
For z=0 To 90
Debug "Width="+Str(BitmapFont()\FontData(z)\Width)
Next
EndProcedure
; IDE Options = PureBasic 6.00 Beta 5 (Windows - x64)
; CursorPosition = 24
; Folding = -
; EnableXP

BIN
Pack.dat Normal file
View File

Binary file not shown.

123
Package.pb Normal file
View File

@@ -0,0 +1,123 @@
UseBriefLZPacker()
CompilerIf #PB_Compiler_IsMainFile
Global NewList File.s()
AddElement(File()):File()=GetCurrentDirectory()+"Datas\SpriteSheetx192.png"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\LoopzFont.png"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\LoopzFont.dat"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\MonoFont.png"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\MonoFont.dat"
AddElement(File()):File()=GetCurrentDirectory()+"Modules\Loopz03V2.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules\Loopz01.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules\Loopz02.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules\LoopzGameOver01.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules\LoopzGameOver03.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules\LoopzHighScore01V2.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Modules\Loopz10.mod"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-bonus-earned-in-video-game-2058.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-explainer-video-game-alert-sweep-236.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-extra-bonus-in-a-video-game-2045.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-video-game-retro-click-237.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-fast-small-sweep-transition-166.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-fairy-magic-sparkle-871.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\mixkit-erupting-volcano-lava-2442.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\My-Dead-Snd-Effect.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\Metal-hammer.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\322897-rhodesmas-connected-01.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\Woosh 06.wav"; moogy73_woosh-medium-short-01.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\Goutte 05.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\434897-thebuilder15-collapse.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\446112-justinvoke-freeze.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\jukebox.wav"
AddElement(File()):File()=GetCurrentDirectory()+"Datas\Goutte 03.wav"
#DebugPackageVerbose=#True
CompilerIf #DebugPackageVerbose=#True
Debug "Create Package";
CompilerEndIf
If CreatePack(0, "Datas.pck")
ForEach File()
CompilerIf #DebugPackageVerbose=#True
Debug "Add "+GetFilePart(File())
CompilerEndIf
If FileSize(File())
AddPackFile(0, File(), GetFilePart(File()))
Else
MessageRequester("No find File",File())
End
EndIf
Next
ClosePack(0)
CompilerIf #DebugPackageVerbose=#True
Debug "Finish"
CompilerEndIf
Else
MessageRequester("Package Error","Can't Create Package")
EndIf
End
CompilerEndIf
Procedure ReadDataPackage(PackFile.s,FileName.S)
Protected *Mem
If FileSize(PackFile) And OpenPack(0,PackFile)
ExaminePack(0)
While NextPackEntry(0)
If PackEntryName(0)=FileName
*Mem=AllocateMemory(PackEntrySize(0))
CompilerIf #DebugPackageVerbose=#True
Debug "UnPack "+PackEntryName(0)+" size:"+Str(PackEntrySize(0))
CompilerEndIf
If UncompressPackMemory(0, *Mem, PackEntrySize(0))<>-1
ProcedureReturn *Mem
Else
MessageRequester("Data Pack Error","Can't uncompress File "+FileName+" From "+PackFile)
End
EndIf
EndIf
Wend
MessageRequester("Data Pack Error","Can't Find File "+FileName+" From "+PackFile)
End
Else
MessageRequester("Data Pack Error","Can't Load File "+FileName+" From "+PackFile)
End
EndIf
EndProcedure
Procedure.i CatchSpriteFromPackage(Sprite.i,FileName.s,PackFile.s="Datas.pck")
Protected *Mem
Protected Result.i
*Mem=ReadDataPackage(PackFile,FileName)
Result=CatchSprite(Sprite,*Mem,#PB_Sprite_AlphaBlending)
FreeMemory(*Mem)
ProcedureReturn Result
EndProcedure
Procedure.i CatchMusicFromPackage(Music.i,FileName.s,PackFile.s="Datas.pck")
Protected *Mem
Protected Result.i
*Mem=ReadDataPackage(PackFile,FileName)
Result=CatchMusic(Music,*Mem,MemorySize(*Mem))
FreeMemory(*Mem)
ProcedureReturn Result
EndProcedure
Procedure.i CatchSoundFromPackage(Snd.i,FileName.s,PackFile.s="Datas.pck")
Protected *Mem
Protected Result.i
*Mem=ReadDataPackage(PackFile,FileName)
If *Mem>0
Result=CatchSound(Snd,*Mem,MemorySize(*Mem))
FreeMemory(*Mem)
ProcedureReturn Result
Else
MessageRequester("Error","Can't Load Pack "+PackFile+" File name "+FileName)
End
EndIf
EndProcedure
; IDE Options = PureBasic 6.00 Beta 9 (Windows - x64)
; CursorPosition = 32
; Folding = --
; EnableXP

155
Screen.pbi Normal file
View File

@@ -0,0 +1,155 @@
Procedure.s GetCurrentResolution()
If GUI\FullScreen=#True
ProcedureReturn "FullScreen:"+Str(ScreenWidth())+"x"+Str(ScreenHeight())
Else
ProcedureReturn "Window:"+Str(ScreenWidth())+"x"+Str(ScreenHeight())
EndIf
EndProcedure
Structure ScreenModeInfo
width.i
height.i
depth.i
hz.i
EndStructure
Procedure InitScreen()
ExamineDesktops()
Protected.l SWidth,SHeight,SDepth
;Fullscreen
If GUI\FullScreen=#True
;Default Screen Resolution
If GUI\ScreenResolutionWidth=0
If ExamineScreenModes()
NewList modes.ScreenModeInfo()
;Select Last ScreenMode (Higer)
While NextScreenMode()
If AddElement(modes())
modes()\width = ScreenModeWidth()
modes()\height = ScreenModeHeight()
modes()\depth = ScreenModeDepth()
modes()\hz = ScreenModeRefreshRate()
EndIf
SortStructuredList( modes(), #PB_Sort_Descending, OffsetOf(ScreenModeInfo\hz), #PB_Integer)
SortStructuredList( modes(), #PB_Sort_Descending, OffsetOf(ScreenModeInfo\width), #PB_Integer)
SortStructuredList( modes(), #PB_Sort_Descending, OffsetOf(ScreenModeInfo\height), #PB_Integer)
FirstElement(modes())
SWidth=modes()\width
SHeight=modes()\height
SDepth=modes()\depth
Debug Str(Swidth)+"x"+Str(SHeight)+"@"+Str(Sdepth)
Wend
EndIf
End
;Use Screen Parameters Resolution
Else
SWidth=GUI\ScreenResolutionWidth
SHeight=GUI\ScreenResolutionHeight
SDepth=GUI\ScreenResolutionDepth
EndIf
Debug "Fullscreen:"+Str(SWidth)+"x"+Str(SHeight)
If Not OpenScreen(SWidth,SHeight,SDepth,"Loopz Remix "+#Version);,#PB_Screen_NoSynchronization
MessageRequester("Erreur", "Impossible d'ouvrir un écran "+Str(SWidth)+"x"+Str(SHeight), 0)
End
EndIf
; Windows
Else
;Default Window Resolution
If GUI\WindowResolutionWidth=0
SWidth=720*2
SHeight=480*2
;Use Window Parameters Resolution
Else
SWidth=GUI\WindowResolutionWidth
SHeight=GUI\WindowResolutionHeight
EndIf
Debug "Window:"+Str(SWidth)+"x"+Str(SHeight)
Protected Flags.l
If GUI\WindowX<>-1 And GUI\WindowY<>-1
Flags=#PB_Window_SystemMenu
Else
Flags=#PB_Window_SystemMenu|#PB_Window_ScreenCentered
EndIf
If OpenWindow(0, GUI\WindowX, GUI\WindowY, DesktopUnscaledX(SWidth), DesktopUnscaledY(SHeight), "Loopz Remix "+#Version, Flags)
If Not OpenWindowedScreen(WindowID(0), 0, 0, SWidth, SHeight)
MessageRequester("Erreur", "Impossible d'ouvrir un écran dans la fenêtre!", 0)
End
EndIf
EndIf
EndIf
;GameOriginalWidth=720
;GameOriginalHeight=405
;GameoriginalBlockWidth=32
;GameHigestWidth=3840
;GameHigestBlockHeight=128
GUI\ScreenWidth=20
GUI\BlockSize=ScreenWidth()/GUI\ScreenWidth
GUI\ScreenHeight=ScreenHeight()/GUI\BlockSize
GUI\HalfBlockSize=GUI\BlockSize/2
GUI\QuarterBlockSize=GUI\BlockSize/4
GUI\DoubleBlockSize=GUI\BlockSize*2
GUI\BenchWidth=(#MaxTableWidth+1)*GUI\BlockSize
GUI\BenchHeight=(#MaxTableHeight+1)*GUI\BlockSize
GUI\BenchX=(ScreenWidth()-GUI\BenchWidth)/2
GUI\BenchY=GUI\BlockSize
GUI\JewelBlue_X=10.5*GUI\BlockSize
GUI\JewelRed_X=13*GUI\BlockSize
GUI\TimerWidth=GUI\BlockSize * 8
GUI\TimerX=GUI\BenchX+(GUI\BenchWidth - GUI\TimerWidth ) /2
GUI\TimerY=GUI\BenchY+GUI\BenchHeight+GUI\BlockSize
LoadSpriteSheet()
CompilerIf #UsePackFile=#True
CatchBitmapFont(#Spr_FontA,"MonoFont")
CatchBitmapFont(#Spr_FontB,"LoopzFont")
CompilerElse
LoadBitmapFont(#Spr_FontA,"MonoFont")
LoadBitmapFont(#Spr_FontB,"LoopzFont")
CompilerEndIf
EndProcedure
Procedure DeInitScreen()
CloseScreen()
If IsWindow(0)
CloseWindow(0)
EndIf
EndProcedure
Macro FlipBuffersAndRetrieveFPS()
Static fpsCounter
Static fpsStartTime
If FlipBuffers()
fpsCounter + 1
EndIf
If (ElapsedMilliseconds()-fpsStartTime)>=1000
GUI\fpsValue=fpsCounter
fpsCounter=0
fpsStartTime=ElapsedMilliseconds()
If GUI\fpsValue<Game\ScoreData\Fps_Min
Game\ScoreData\Fps_Min=GUI\fpsValue
EndIf
If GUI\fpsValue>Game\ScoreData\Fps_Max
Game\ScoreData\Fps_Max=GUI\fpsValue
EndIf
EndIf
EndMacro
; IDE Options = PureBasic 6.00 LTS (Linux - x64)
; CursorPosition = 38
; Folding = -
; EnableXP

597
Shape.pbi Normal file
View File

@@ -0,0 +1,597 @@
;-Shape
Global Dim SpGroup.l(8)
SpGroup(0) = 239
SpGroup(1) = SpGroup(0)+210
SpGroup(2) = SpGroup(1)+175
SpGroup(3) = SpGroup(2)+182
SpGroup(4) = SpGroup(3)+85
SpGroup(5) = SpGroup(4)+85
SpGroup(6) = SpGroup(5)+10
SpGroup(7) = SpGroup(6)+10
Structure Sp
Cx.l
Cy.l
NextId.l
Array Table.l(2,2)
EndStructure
Global Dim Sp.Sp(26)
Procedure InitShape(Id.l,NextId.l,X.l,Y.l,A1.l=0,A2.l=0,A3.l=0,B1.l=0,B2.l=0,B3.l=0,C1.l=0,C2.l=0,C3.l=0)
Sp(Id)\NextId=NextId
Sp(Id)\Cx=X
Sp(Id)\Cy=Y
Sp(Id)\Table(0,0)=A1
Sp(Id)\Table(1,0)=A2
Sp(Id)\Table(2,0)=A3
Sp(Id)\Table(0,1)=B1
Sp(Id)\Table(1,1)=B2
Sp(Id)\Table(2,1)=B3
Sp(Id)\Table(0,2)=C1
Sp(Id)\Table(1,2)=C2
Sp(Id)\Table(2,2)=C3
EndProcedure
;0 L
InitShape(0,1,0,0,#Spr_RD)
InitShape(1,2,0,0,#Spr_DL)
InitShape(2,3,0,0,#Spr_LU)
InitShape(3,0,0,0,#Spr_UR)
;1 I
InitShape(4,5,0,0,#Spr_UD)
InitShape(5,4,0,0,#Spr_LR)
;2 ---
InitShape(6,7,1,1,0,#Spr_UD,0,0,#Spr_UD,0,0,#Spr_UD,0)
InitShape(7,6,1,1,0,0,0,#Spr_LR,#Spr_LR,#Spr_LR)
;3 Big L
InitShape(8,9,0,0,#Spr_RD,#Spr_LR,0,#Spr_UD)
InitShape(9,10,1,0,#Spr_LR,#Spr_DL,0,0,#Spr_UD)
InitShape(10,11,1,1,0,#Spr_UD,0,#Spr_LR,#Spr_LU)
InitShape(11,8,0,1,#Spr_UD,0,0,#Spr_UR,#Spr_LR)
;4 U
InitShape(12,13,1,1,0,#Spr_RD,#Spr_LR,0,#Spr_UD,0,0,#Spr_UR,#Spr_LR)
InitShape(13,14,1,1,0,0,0,#Spr_RD,#Spr_LR,#Spr_DL,#Spr_UD,0,#Spr_UD)
InitShape(14,15,1,1,#Spr_LR,#Spr_DL,0,0,#Spr_UD,0,#Spr_LR,#Spr_LU)
InitShape(15,12,1,1,#Spr_UD,0,#Spr_UD,#Spr_UR,#Spr_LR,#Spr_LU)
;5 Z
InitShape(16,17,1,1,0,0,#Spr_UD,0,#Spr_RD,#Spr_LU,0,#Spr_UD)
InitShape(17,18,1,1,0,0,0,#Spr_LR,#Spr_DL,0,0,#Spr_UR,#Spr_LR)
InitShape(18,19,1,1,0,#Spr_UD,0,#Spr_RD,#Spr_LU,0,#Spr_UD)
InitShape(19,16,1,1,#Spr_LR,#Spr_DL,0,0,#Spr_UR,#Spr_LR)
InitShape(20,21,1,1,#Spr_UD,0,0,#Spr_UR,#Spr_DL,0,0,#Spr_UD)
InitShape(21,22,1,1,0,#Spr_RD,#Spr_LR,#Spr_LR,#Spr_LU)
InitShape(22,23,1,1,0,#Spr_UD,0,0,#Spr_UR,#Spr_DL,0,0,#Spr_UD)
InitShape(23,20,1,1,0,0,0,0,#Spr_RD,#Spr_LR,#Spr_LR,#Spr_LU)
;+
InitShape(24,24,0,0,#Spr_Cross)
;O
InitShape(25,25,0,0,#Spr_Locked)
;TODO Finish
Procedure DrawShape(TmpX.l,TmpY.l,Id.l,A.l=255,Scale.f=1)
Protected Size.l=GUI\BlockSize*Scale
Protected.l X,Y,Spr
For X=0 To 2
For Y=0 To 2
Spr=Sp(Id)\Table(X,Y)
If Spr>0
DisplayClipSprite(#Spr_White,TmpX + ( X - Sp(Id)\Cx) * Size , TmpY + ( Y - Sp(Id)\Cy ) * Size,A,1,Size,Size)
DisplayClipSprite(Spr,TmpX + ( X - Sp(Id)\Cx) * Size , TmpY + ( Y - Sp(Id)\Cy ) * Size,A,1,Size,Size)
Else
;DisplaySprite(#Spr_Cursor,TmpX + ( X - Sp(Id)\Cx) * Param\BlockSize , TmpY + ( Y - Sp(Id)\Cy ) * Param\BlockSize)
EndIf
Next
Next
EndProcedure
Procedure.b TestShapeToBench(Bx.l,By.l,Id)
Protected X.l
Protected Y.l
Protected Sp.l
Protected TmpBx.l
Protected TmpBy.l
For X=0 To 2
For Y=0 To 2
Sp=Sp(Id)\Table(X,Y)
TmpBx=Bx+x-Sp(Id)\Cx
TmpBy=By+y-Sp(Id)\CY
If TmpBx>=0 And TmpBy>=0 And TmpBx<=#MaxTableWidth And TmpBy<=#MaxTableHeight
If Game\GameTable(TmpBx,TmpBy)\Sprite>0 And Sp<>0
ProcedureReturn #False
EndIf
ElseIf Sp<>0
ProcedureReturn #False
EndIf
Next
Next
ProcedureReturn #True
EndProcedure
Enumeration
#Shape_None
#Shape_Up
#Shape_Down
#Shape_Left
#Shape_Right
#Shape_PosEnd
EndEnumeration
;Global Dim ShapeCompatible.b(#Spr_Pointer,#Shape_PosEnd,#Spr_Pointer)
;Global Dim ShapePath.l(#Spr_Pointer,#Shape_PosEnd)
CompilerIf #DebugCheckLoopVerbose=#True
Procedure.s GetDirection(Direction.l)
Select Direction
Case #Shape_None
ProcedureReturn "#Shape_None"
Case #Shape_Up
ProcedureReturn "#Shape_Up"
Case #Shape_Down
ProcedureReturn "#Shape_Down"
Case #Shape_Left
ProcedureReturn "#Shape_Left"
Case #Shape_Right
ProcedureReturn "#Shape_Right"
Case #Shape_PosEnd
ProcedureReturn "#Shape_PosEnd"
EndSelect
EndProcedure
Procedure.s GetShapeName(Sprite.l)
Select Sprite
Case #Spr_UD
ProcedureReturn "#Spr_UD"
Case #Spr_LR
ProcedureReturn "#Spr_LR"
Case #Spr_RD
ProcedureReturn "#Spr_RD"
Case #Spr_DL
ProcedureReturn "#Spr_DL"
Case #Spr_LU
ProcedureReturn "#Spr_LU"
Case #Spr_UR
ProcedureReturn "#Spr_UR"
Case #Spr_Cross
ProcedureReturn "#Spr_Cross"
Case #Spr_Locked
ProcedureReturn "#Spr_Locked"
EndSelect
EndProcedure
CompilerEndIf
Procedure.b InsertShapeToBench(Bx.l,By.l,Id)
Protected X.l
Protected Y.l
Protected Sp.l
Protected TmpBx.l
Protected TmpBy.l
For X=0 To 2
For Y=0 To 2
Sp=Sp(Id)\Table(X,Y)
TmpBx=Bx+x-Sp(Id)\Cx
TmpBy=By+y-Sp(Id)\CY
If TmpBx>=0 And TmpBy>=0 And TmpBx<=#MaxTableWidth And TmpBy<=#MaxTableHeight
If Sp>0 ;no write if empty case
Game\GameTable(TmpBx,TmpBy)\Sprite=Sp
EndIf
EndIf
Next
Next
ProcedureReturn #True
EndProcedure
Procedure.b CheckBenchIsEmpty(SelectElement.b=#False)
Debug "CheckBenchIsEmpty()"
Protected.l Bx,By
For By=0 To #MaxTableHeight
For Bx=0 To #MaxTableWidth
If Game\GameTable(Bx,By)\Sprite>0 And Game\GameTable(Bx,By)\Selected=0 And Game\GameTable(Bx,By)\Sprite<>#Spr_Locked
Debug Str(Bx)+","+Str(By)+" Is not Empty"
ProcedureReturn #False
EndIf
Next
Next
Debug "Empty"
ProcedureReturn #True
EndProcedure
;####################################################################################
;# New CheckLoop #
;####################################################################################
Procedure.l GetShapeDirection(CurrentSprite.l,InternalDirection.l)
Protected ExternalDirection.l
Select CurrentSprite
Case 0 ; no Sprite
ExternalDirection=#Shape_None
Case #Spr_UD
Select InternalDirection
Case #Shape_Down
ExternalDirection=#Shape_Down
Case #Shape_Up
ExternalDirection=#Shape_Up
Default
ExternalDirection=#Shape_None
EndSelect
Case #Spr_LR
Select InternalDirection
Case #Shape_Right
ExternalDirection=#Shape_Right
Case #Shape_Left
ExternalDirection=#Shape_Left
Default
ExternalDirection=#Shape_None
EndSelect
Case #Spr_RD
Select InternalDirection
Case #Shape_Left
ExternalDirection=#Shape_Down
Case #Shape_Up
ExternalDirection=#Shape_Right
Default
ExternalDirection=#Shape_None
EndSelect
Case #Spr_DL
Select InternalDirection
Case #Shape_Up
ExternalDirection=#Shape_Left
Case #Shape_Right
ExternalDirection=#Shape_Down
Default
ExternalDirection=#Shape_None
EndSelect
Case #Spr_LU
Select InternalDirection
Case #Shape_Down
ExternalDirection=#Shape_Left
Case #Shape_Right
ExternalDirection=#Shape_Up
Default
ExternalDirection=#Shape_None
EndSelect
Case #Spr_UR
Select InternalDirection
Case #Shape_Down
ExternalDirection=#Shape_Right
Case #Shape_Left
ExternalDirection=#Shape_Up
Default
ExternalDirection=#Shape_None
EndSelect
Case #Spr_Cross
Select InternalDirection
Case #Shape_Down
ExternalDirection=#Shape_Down
Case #Shape_Up
ExternalDirection=#Shape_Up
Case #Shape_Right
ExternalDirection=#Shape_Right
Case #Shape_Left
ExternalDirection=#Shape_Left
EndSelect
Case #Spr_Locked
ExternalDirection=#Shape_None
EndSelect
ProcedureReturn ExternalDirection
EndProcedure
Procedure CheckLoop(StartX.l,StartY.l,OnlyLoop.b=#True,Onepiece.b=#False)
Protected.l Bx,By
Protected.b Quit=#False
Protected.b FindLoop=#False
Protected.l InternalDirection=-1 ;#Shape_Up/#Shape_Down/#Shape_Right/#Shape_Left/#Shape_None
Protected.l CountPass.l=0
Protected.l MaxPass.l=0
Protected.l CurrentSprite
Protected.l CountPiece=0
Protected.l Over=0
Dim ReverseInternalDirection.l(4)
Dim CrossCounter.b(#MaxTableWidth,#MaxTableHeight)
NewList Path.Path()
Debug "###### CheckLoop ######"
If OnlyLoop=#False
Debug "NO LOOP select"
EndIf
;Init First Piece
Bx=StartX
By=StartY
Game\NbCross=0
Repeat
CurrentSprite=Game\GameTable(Bx,By)\Sprite
Debug "["+Str(Bx)+","+Str(By)+"] "+Str(CurrentSprite)+">"+GetShapeName(CurrentSprite)
If CrossCounter(Bx,By)=0 ;Count only One time piece like Cross
CountPiece=CountPiece+1
AddElement(Path())
Path()\BX=BX
Path()\BY=BY
EndIf
If CurrentSprite=#Spr_Cross And CountPass=0
CrossCounter(Bx,By)=CrossCounter(Bx,By)+1
Debug "CrossCounter("+Str(Bx)+","+Str(By)+")="+Str(CrossCounter(Bx,By))
If CrossCounter(Bx,By)=2
Game\NbCross+1
EndIf
EndIf
;Chose first Direction
If InternalDirection=-1
Select CurrentSprite
Case 0
InternalDirection=#Shape_None
MaxPass=0
ReverseInternalDirection(1)=#Shape_None
Case #Spr_UD
InternalDirection=#Shape_Up
MaxPass=2
ReverseInternalDirection(1)=#Shape_Down
Case #Spr_LR
InternalDirection=#Shape_Right
MaxPass=2
ReverseInternalDirection(1)=#Shape_Left
Case #Spr_RD
InternalDirection=#Shape_Up
MaxPass=2
ReverseInternalDirection(1)=#Shape_Left
Case #Spr_DL
InternalDirection=#Shape_Down
MaxPass=2
ReverseInternalDirection(1)=#Shape_Right
Case #Spr_LU
InternalDirection=#Shape_Right
MaxPass=2
ReverseInternalDirection(1)=#Shape_Down
Case #Spr_UR
InternalDirection=#Shape_Down
MaxPass=2
ReverseInternalDirection(1)=#Shape_Left
Case #Spr_Cross
InternalDirection=#Shape_Up
MaxPass=4
ReverseInternalDirection(1)=#Shape_Down
ReverseInternalDirection(2)=#Shape_Right
ReverseInternalDirection(3)=#Shape_Left
Case #Spr_Locked
ProcedureReturn #False
EndSelect
EndIf
InternalDirection=GetShapeDirection(CurrentSprite,InternalDirection)
Select InternalDirection
Case #Shape_Right
Bx=Bx+1
Case #Shape_Left
Bx=Bx-1
Case #Shape_Up
By=By-1
Case #Shape_Down
By=By+1
Case #Shape_None ; No direction
EndSelect
If Bx<0 Or By<0 Or Bx>#MaxTableWidth Or By>#MaxTableHeight
Debug "STOP OUT BENCH"
If CountPass<MaxPass
CountPass=CountPass+1
;Reset Path
Debug "Reset Find Path "+Str(CountPass)
Bx=StartX
By=StartY
CrossCounter(Bx,By)=0
InternalDirection=ReverseInternalDirection(CountPass)
Debug "ReverseInternalDirection("+Str(CountPass)+")="+GetDirection(InternalDirection)
CountPiece=CountPiece-2 ; 1 avant
FirstElement(Path())
DeleteElement(Path())
Else
Debug "countPass>=MaxPass"
Quit=#True
FindLoop=#False
EndIf
ElseIf InternalDirection=#Shape_None
Debug "STOP Bad Shape"
Debug "CountPass="+Str(CountPass)
If CountPass<MaxPass
CountPass=CountPass+1
;Reset Path
Debug "Reset Find Path "+Str(CountPass)
Bx=StartX
By=StartY
CrossCounter(Bx,By)=0
InternalDirection=ReverseInternalDirection(CountPass)
Debug "ReverseInternalDirection("+Str(CountPass)+")="+GetDirection(InternalDirection)
CountPiece=CountPiece-2 ; 1 avant
If ListSize(Path())>1
DeleteElement(Path())
EndIf
FirstElement(Path())
DeleteElement(Path())
Else
Debug "countPass>=MaxPass"
Quit=#True
FindLoop=#False
EndIf
Else
Debug "BX="+Str(Bx)+"/"+Str(StartX)+" BY="+Str(By)+"/"+Str(StartY)+" CountPiece="+Str(CountPiece)
If Bx=StartX And By=StartY And CountPiece>2
Debug "CrossCounter("+Str(Bx)+","+Str(By)+")="+Str(CountPiece)
Debug "MaxPass="+Str(MaxPass)
Debug "CountPass="+Str(CountPass)
If (MaxPass<>4 Or CrossCounter(Bx,By)>=2 Or CountPass=2) ;
Debug "Find Loop on MaxPass="+Str(MaxPass)+" and CrossCounter="+Str(CrossCounter(Bx,By))
Debug "Find Loop"
Quit=#True
FindLoop=#True
Else
Debug "NO LOOP"
EndIf
EndIf
EndIf
;EndIf
Over=Over+1
If Over=250
Debug "OVER"
End
EndIf
Until Quit=#True
If FindLoop=#True
ForEach Path()
Game\GameTable(Path()\BX,Path()\BY)\Selected=#True
Next
;Copy Path To LoopPath (Used to add Jewels)
CopyList(Path(),LoopPath())
ElseIf OnlyLoop=#False
ForEach Path()
Game\GameTable(Path()\BX,Path()\BY)\Selected=#True
Next
Else
CountPiece=0
EndIf
;
FreeList(Path())
If OnlyLoop=#False
;End
EndIf
ProcedureReturn CountPiece
EndProcedure
;####################################################################################
Procedure.l SelectNextElementOnBench()
Protected Bx.l
Protected By.l
Protected Length.l
For By=0 To #MaxTableHeight
For Bx=0 To #MaxTableWidth
If Game\GameTable(Bx,By)\Sprite>0 And Game\GameTable(Bx,By)\Sprite<>#Spr_Locked
Length=CheckLoop(Bx,By,#False)
ProcedureReturn Length
EndIf
Next
Next
ProcedureReturn 0
EndProcedure
Procedure EraseSelectedPieceOnBench()
Protected Bx.l
Protected By.l
Protected Count.l
For By=0 To #MaxTableHeight
For Bx=0 To #MaxTableWidth
If Game\GameTable(Bx,By)\Selected=#True
Game\GameTable(Bx,By)\Sprite=0
Game\GameTable(Bx,By)\Selected=#False
Count+1
EndIf
Next
Next
ProcedureReturn Count
EndProcedure
Procedure RandomShape()
Static Lastgroup.l
If Bonus\EyeEnable=#True
Game\SelectedShape=Game\NextShape
EndIf
Repeat
Protected R.l
Protected Group.l
R=Random(1000)
Protected Shape.l
Protected n.l
For n=0 To ArraySize(SpGroup())-1
If R<SpGroup(n):Group=n:Break:EndIf
Next
If Game\NbPiecesOnBench>70
Game\LittlePieceCounter+1
If Game\LittlePieceCounter<Game\Difficulty(Game\ScoreData\Difficulty)\NbLittlePiece
Group=Random(1)
Else
Group=Random(3,2)
Game\LittlePieceCounter=0
EndIf
EndIf
If Group=Lastgroup
Debug "Same Shape !!!"
EndIf
Until Group<>Lastgroup
Lastgroup=Group
;Add to Stats
Stats\NbItemByGroup(Group)=Stats\NbItemByGroup(Group)+1
Select Group
Case 0
Shape=Random(3,0)
Case 1
Shape=Random(5,4)
Case 2
Shape=Random(7,6)
Case 3
Shape=Random(11,8)
Case 4
Shape=Random(15,12)
Case 5
Shape=Random(23,16)
Case 6
Shape=24
Case 7
Shape=25
EndSelect
Debug "Rand="+Str(R)+" Group="+Str(Group)+" Shape="+Str(Shape)
If Bonus\EyeEnable=#True
Game\NextShape=Shape
Else
Game\SelectedShape=Shape
EndIf
;First Methode
;Param\Game\SelectedShape=Random(10,1)
EndProcedure
; IDE Options = PureBasic 6.00 LTS (Windows - x64)
; CursorPosition = 403
; FirstLine = 534
; Folding = ---
; EnableXP

76
Sound.pbi Normal file
View File

@@ -0,0 +1,76 @@
Enumeration
#Snd_PutPiece
#Snd_CanTPutPiece
#Snd_DoALoop
#Snd_GetBonus
#Snd_GetBonus2
#Snd_DeletePiece
#Snd_GetJewel
#Snd_EarthQuake
#Snd_DeadBonus
#Snd_MetalHammer
#Snd_WaterDrop
#Snd_Woosh
#Snd_Collapse
#Snd_Freeze
#Snd_Jukebox
#Snd_End
EndEnumeration
Enumeration
#Music_Intro
#Music_GameA
#Music_GameB
#Music_Missed
#Music_GameOver
#Music_HighScore
#Music_Credits
#Music_End
EndEnumeration
Procedure StartMusic(Mus.l,Reset.b=#True)
If Mus<>Game\CurrentMusic
Protected n.l
For n=0 To #Music_End
If IsMusic(n):StopMusic(n):EndIf
Next
If IsMusic(Mus)
Game\CurrentMusic=Mus
If Reset=#True
SetMusicPosition(Mus,0)
EndIf
;TODO remove ";"
If Game\VolumeMusic>0
PlayMusic(Mus)
Else
Debug "NO MUS"
EndIf
EndIf
EndIf
EndProcedure
Procedure CheckMusic()
If Game\CurrentMusic=#Music_Missed
If Game\Mode=#Mode_Game_Run And GetMusicPosition(#Music_Missed)=0 And GetMusicRow(#Music_Missed)>=16
;Debug"######################"
StopMusic(#Music_Missed)
If Game\ScoreData\Difficulty<2
StartMusic(#Music_GameA,#False)
Else
StartMusic(#Music_GameB,#False)
EndIf
EndIf
EndIf
EndProcedure
; IDE Options = PureBasic 6.00 LTS (Windows - x64)
; CursorPosition = 50
; Folding = -
; EnableXP

143
Sprite.pbi Normal file
View File

@@ -0,0 +1,143 @@
;-Sprite
Enumeration
#Spr_Black
#Spr_White
#Spr_Cursor
#Spr_SelectedBackground
#Spr_DelCursor
#Spr_BenchA
#Spr_BenchB
#Spr_BenchC
#Spr_BckgrndFadeUp
#Spr_BckgrndFadeDown
#Spr_UD
#Spr_LR
#Spr_RD
#Spr_DL
#Spr_LU
#Spr_UR
#Spr_Cross
#Spr_Locked
#Spr_Pointer
#Spr_Health
#Spr_Timer
#Spr_EarthBreak
#Spr_Dead
#Spr_JewelBlue
#Spr_JewelRed
#Spr_JewelGreen
#Spr_Eye
#Spr_Hammer
#Spr_Remove
#Spr_Gravity
#Spr_Freeze
#Spr_X2
#Spr_X4
#Spr_X8
#Spr_Logo
#Spr_Sc
#Spr_Remix
#Spr_Thy
#Spr_Frozen
#Spr_Vinyl
#Spr_FontA
#Spr_FontA_End = #Spr_FontA+90
#Spr_FontB
#Spr_FontB_End= #Spr_FontB+90
#Spr_End
EndEnumeration
Structure GameSprite
SpriteId.i
ClipX.l
ClipY.l
ClipWidth.l
ClipHeight.l
DisplayWidth.f
DisplayHeight.f
EndStructure
Global Dim GameSprite.GameSprite(#Spr_End)
Procedure RecordSprite(SpriteNo.l,SpriteId.i,ClipX.l,ClipY.l,ClipWidth.l,ClipHeight.l,DisplayWidth.f, DisplayHeight.f)
GameSprite(SpriteNo)\SpriteId=SpriteId
GameSprite(SpriteNo)\ClipX=ClipX
GameSprite(SpriteNo)\ClipY=ClipY
GameSprite(SpriteNo)\ClipWidth=ClipWidth
GameSprite(SpriteNo)\ClipHeight=ClipHeight
GameSprite(SpriteNo)\DisplayWidth=DisplayWidth
GameSprite(SpriteNo)\DisplayHeight=DisplayHeight
EndProcedure
Procedure DisplayClipSprite(SpriteNo.i,X.l,Y.l,Opacity.l=255,GameScale.f=1,BckWidth.f=-1,BckHeight.f=-1)
If IsSprite(GameSprite(SpriteNo)\SpriteId)
ClipSprite(GameSprite(SpriteNo)\SpriteId,GameSprite(SpriteNo)\ClipX,GameSprite(SpriteNo)\ClipY,GameSprite(SpriteNo)\ClipWidth,GameSprite(SpriteNo)\ClipHeight)
If BckWidth=-1
BckWidth=GameSprite(SpriteNo)\DisplayWidth*GameScale*GUI\BlockSize
EndIf
If BckHeight=-1
BckHeight=GameSprite(SpriteNo)\DisplayHeight*GameScale*GUI\BlockSize
EndIf
ZoomSprite(GameSprite(SpriteNo)\SpriteId,BckWidth,BckHeight)
DisplayTransparentSprite(GameSprite(SpriteNo)\SpriteId,X,Y,Opacity)
Else
Debug "Error with sprite"
EndIf
EndProcedure
Procedure LoadSpriteSheet()
Protected n.l
CompilerIf #UsePackFile=#True
CatchSpriteFromPackage(0,"SpriteSheetx192.png")
CompilerElse
LoadSprite(0,"Datas\SpriteSheetx192.png",#PB_Sprite_AlphaBlending)
CompilerEndIf
If IsSprite(0)
Protected SpriteSize.l=SpriteWidth(0)/10
For n=0 To 9
RecordSprite(#Spr_Black+n,0,n*SpriteSize,0,SpriteSize,SpriteSize,1,1)
Next
;Piepeline
For n=0 To 7
RecordSprite(#Spr_UD+n,0,n*SpriteSize,SpriteSize,SpriteSize,SpriteSize,1,1)
Next
;Pointer
RecordSprite(#Spr_Pointer,0,8*SpriteSize,SpriteSize,SpriteSize,SpriteSize,1,1)
; Bonus
For n=0 To 9
RecordSprite(#Spr_Health+n,0,n*SpriteSize,SpriteSize*2,SpriteSize,SpriteSize,1,1)
Next
For n=0 To 5
RecordSprite(#Spr_Gravity+n,0,n*SpriteSize,SpriteSize*3,SpriteSize,SpriteSize,1,1)
Next
RecordSprite(#Spr_Logo,0,0,SpriteSize*4,SpriteSize*7,SpriteSize*2,7,2)
RecordSprite(#Spr_Remix,0,0,SpriteSize*6,SpriteSize*4,SpriteSize,4,1)
RecordSprite(#Spr_Thy,0,SpriteSize*7,SpriteSize*3,SpriteSize*3,SpriteSize*3,3,3)
RecordSprite(#Spr_Frozen,0,0,SpriteSize*7,SpriteSize*8,SpriteSize,8,1)
RecordSprite(#Spr_Sc,0,0,SpriteSize*8,SpriteSize*3,SpriteSize*2,3,2)
RecordSprite(#Spr_Vinyl,0,SpriteSize*8,SpriteSize*6,SpriteSize*2,SpriteSize*4,2,4)
Else
MessageRequester("Error", "Can't Load SpriteSheet ", 0)
End
EndIf
EndProcedure
; IDE Options = PureBasic 6.00 LTS (Windows - x64)
; CursorPosition = 117
; FirstLine = 59
; Folding = -
; EnableXP

259
SpritesObj.pbi Normal file
View File

@@ -0,0 +1,259 @@
EnumerationBinary
#Align_Hor_Left
#Align_Hor_Middle
#Align_Hor_Right
#Align_Ver_Top
#Align_Ver_Middle
#Align_Ver_Bottom
EndEnumeration
Structure SpriteMove
StartValue.f
EndValue.f
*Value.FLoat
StartTime.l
Duration.l
Easing.l
Event.l
AutoDestroySprites.b
EndStructure
Enumeration
#Spr_Depth_Background
#Spr_Depth_Middle
#Spr_Depth_Front
#Spr_ALL
EndEnumeration
Structure SpriteData
SpriteNo.l
X.f
Y.f
Width.f
Height.f
Opacity.f
Size.f
Align.c
Depth.l
List Move.SpriteMove()
MoveStartTime.q
AutoDestroy.b ;if #true autodestroy the sprite (From DisplayEngine())
EndStructure
Global NewList Sprites.SpriteData()
Procedure.i NewSprite(SpriteNo.l,X.f,Y.f,Width.f,Height.f,Opacity.l,Size.f,Depth.l=#Spr_Depth_Front,Align.b=9)
Protected *Mem
*Mem=AddElement(Sprites())
Sprites()\SpriteNo=SpriteNo
Sprites()\X=X
Sprites()\Y=Y
Sprites()\Width=Width
Sprites()\Height=Height
Sprites()\Opacity=Opacity
Sprites()\Size=Size
Sprites()\MoveStartTime=-1
Sprites()\Align=Align
Sprites()\AutoDestroy=#False
Sprites()\Depth=Depth
ProcedureReturn *Mem
EndProcedure
Procedure _Addmove(*Sprite.SpriteData,ThisStartTime.l,*Value,StartValue.f,EndValue.f,Duration.l,Easing.l,Event.l=-1)
AddElement(*Sprite\Move())
*Sprite\Move()\Value=*Value
*Sprite\Move()\StartTime=ThisStartTime
*Sprite\Move()\StartValue=StartValue
*Sprite\Move()\EndValue=EndValue
*Sprite\Move()\Duration=Duration
*Sprite\Move()\Easing=Easing
*Sprite\Move()\Event=Event
EndProcedure
Procedure ClearMove(*Sprite.SpriteData)
ClearList(*Sprite\Move())
EndProcedure
Procedure StartMove(*Sprite.SpriteData,StartTime.q=0)
If StartTime=0
*Sprite\MoveStartTime=ElapsedMilliseconds()
Else
*Sprite\MoveStartTime=StartTime
EndIf
EndProcedure
Procedure StartAllMove()
Protected StartTime.q=ElapsedMilliseconds()
ForEach Sprites()\Move()
;Sprites()\Move()\StartTime=StartTime
Next
EndProcedure
Procedure myDisplaySprite(*Sprite.SpriteData)
;Display
Protected X.f
Protected Y.f
Protected Width.f
Protected Height.f
Protected RealWidth.l
Protected RealHeight.l
If *Sprite\SpriteNo>0 And IsSprite(GameSprite(*Sprite\SpriteNo)\SpriteId)
ClipSprite(GameSprite(*Sprite\SpriteNo)\SpriteId,GameSprite(*Sprite\SpriteNo)\ClipX,GameSprite(*Sprite\SpriteNo)\ClipY,GameSprite(*Sprite\SpriteNo)\ClipWidth,GameSprite(*Sprite\SpriteNo)\ClipHeight)
If *Sprite\Width<>-1
Width=*Sprite\Width
Else
Width=GameSprite(*Sprite\SpriteNo)\DisplayWidth
EndIf
If *Sprite\Height<>-1
Height=*Sprite\Height
Else
Height=GameSprite(*Sprite\SpriteNo)\DisplayHeight
EndIf
RealWidth=Width * GUI\BlockSize
RealHeight=Height * GUI\BlockSize
If Not (*Sprite\Opacity=0 Or Height=0 Or Width=0)
ZoomSprite(GameSprite(*Sprite\SpriteNo)\SpriteId,RealWidth * *Sprite\Size,RealHeight * *Sprite\Size)
If *Sprite\Align & #Align_Hor_Left = #Align_Hor_Left
X=*Sprite\X
EndIf
If *Sprite\Align & #Align_Hor_Middle = #Align_Hor_Middle
X=*Sprite\X-Width/2* *Sprite\Size
EndIf
If *Sprite\Align & #Align_Hor_Right = #Align_Hor_Right
X=*Sprite\X-Width* *Sprite\Size
EndIf
If *Sprite\Align & #Align_Ver_Top = #Align_Ver_Top
Y=*Sprite\Y
EndIf
If *Sprite\Align & #Align_Ver_Middle=#Align_Ver_Middle
Y=*Sprite\Y-Height/2* *Sprite\Size
EndIf
If *Sprite\Align & #Align_Ver_Bottom= #Align_Ver_Bottom
Y=*Sprite\Y-Height* *Sprite\Size
EndIf
X=X * GUI\BlockSize
Y=Y * GUI\BlockSize
DisplayTransparentSprite(GameSprite(*Sprite\SpriteNo)\SpriteId,X,Y,*Sprite\Opacity)
EndIf
Else
;Debug "Error with sprite"
EndIf
EndProcedure
Procedure DisplaySprites(Depth.l=#Spr_ALL)
Protected SpriteNo.l
Protected ThisStartTime.q
Protected ThisEndTime.q
Protected ElapsedTime.l
Protected AutodestroySprite.b
ForEach Sprites()
If Depth=#Spr_ALL Or Sprites()\Depth=Depth
;Move
If Sprites()\MoveStartTime>-1
If ListSize(Sprites()\Move())>0
ForEach Sprites()\Move()
ThisStartTime=Sprites()\MoveStartTime+Sprites()\Move()\StartTime
ThisEndTime=ThisStartTime+Sprites()\Move()\Duration
If ElapsedMilliseconds()>=ThisStartTime And ElapsedMilliseconds()<=ThisEndTime
ElapsedTime.l=ElapsedMilliseconds()-ThisStartTime
Sprites()\Move()\Value\f=GetEasingPosValue(Sprites()\Move()\StartValue, Sprites()\Move()\EndValue,ThisStartTime, Sprites()\Move()\Duration, Sprites()\Move()\Easing)
;Debug StrF(ListIndex(Sprites()\Move())) +" Value:"+StrF( Sprites()\Move()\Value\f)+" Elapestime:"+Str(ElapsedTime)
;At the End
ElseIf ElapsedMilliseconds()>=ThisEndTime
Sprites()\Move()\Value\f=Sprites()\Move()\EndValue
;new Event
If Sprites()\Move()\Event>-1
PostEventGUI(Sprites()\Move()\Event)
Sprites()\Move()\Event=-1
EndIf
DeleteElement(Sprites()\Move())
EndIf
Next
Else
;AutodestroySprite=Sprites()\AutoDestroySprites
EndIf
EndIf
;Display
myDisplaySprite(Sprites())
; SpriteNo=Sprites()\SpriteNo
; If SpriteNo>0 And IsSprite(GameSprite(SpriteNo)\SpriteId)
; ClipSprite(GameSprite(SpriteNo)\SpriteId,GameSprite(SpriteNo)\ClipX,GameSprite(SpriteNo)\ClipY,GameSprite(SpriteNo)\ClipWidth,GameSprite(SpriteNo)\ClipHeight)
;
; If Sprites()\Width<>-1
; Width=Sprites()\Width
; Else
; Width=GameSprite(SpriteNo)\DisplayWidth
; EndIf
;
; If Sprites()\Height<>-1
; Height=Sprites()\Height
; Else
; Height=GameSprite(SpriteNo)\DisplayHeight
; EndIf
;
; RealWidth=Width * GUI\BlockSize
; RealHeight=Height * GUI\BlockSize
; If Not (Sprites()\Opacity=0 Or Height=0 Or Width=0)
; ZoomSprite(GameSprite(SpriteNo)\SpriteId,RealWidth * Sprites()\Size,RealHeight * Sprites()\Size)
;
; If Sprites()\Align & #Align_Hor_Left = #Align_Hor_Left
; X=Sprites()\X
; EndIf
;
; If Sprites()\Align & #Align_Hor_Middle = #Align_Hor_Middle
; X=Sprites()\X-Width/2* Sprites()\Size
; EndIf
;
; If Sprites()\Align & #Align_Hor_Right = #Align_Hor_Right
; X=Sprites()\X-Width* Sprites()\Size
; EndIf
;
; If Sprites()\Align & #Align_Ver_Top = #Align_Ver_Top
; Y=Sprites()\Y
; EndIf
;
; If Sprites()\Align & #Align_Ver_Middle=#Align_Ver_Middle
; Y=Sprites()\Y-Height/2* Sprites()\Size
; EndIf
; If Sprites()\Align & #Align_Ver_Bottom= #Align_Ver_Bottom
; Y=Sprites()\Y-Height* Sprites()\Size
; EndIf
; X=X * GUI\BlockSize
; Y=Y * GUI\BlockSize
; DisplayTransparentSprite(GameSprite(SpriteNo)\SpriteId,X,Y,Sprites()\Opacity)
; EndIf
; Else
; ;Debug "Error with sprite"
; EndIf
If ListSize(Sprites()\Move())=0 And AutodestroySprite=#True
DeleteElement(Sprites())
EndIf
EndIf
Next
EndProcedure
Procedure ClearAllSprite()
ClearList(Sprites())
EndProcedure
; IDE Options = PureBasic 6.00 Beta 6 (Windows - x64)
; CursorPosition = 183
; FirstLine = 134
; Folding = --
; EnableXP

166
ThyBitmapFontCreator.pb Normal file
View File

@@ -0,0 +1,166 @@
Structure myFontData
x.l
y.l
Width.l
Height.l
EndStructure
Structure BitmapFont
SpriteId.i
AsciiStart.c
AsciiEnd.c
Array FontData.myFontData(1)
EndStructure
Global NewList BitmapFont.BitmapFont()
Global Dim FinalFont.myFontData(1)
Enumeration
#Win_Main
#Gdt_Canvas
#Gdt_Marg
#Gdt_Save
EndEnumeration
Procedure MyLoadFont(Font.l,Name.s,Size.l,Flag=0)
Taille=1;
Img=CreateImage(#PB_Any,1,1);Creation d'une image pour travailler
Repeat
If IsFont(Font)
FreeFont(Font)
EndIf
Taille+1
LoadFont(Font, Name, Taille,Flag)
StartDrawing(ImageOutput(Img))
DrawingFont(FontID(Font))
If TextHeight("@")>Size Or TextWidth("@")>Size
Taille-1
Quit=1
EndIf
StopDrawing()
Until Quit=1 Or Taille>500
Debug "Taille="+Str(Taille)
FreeImage(Img)
EndProcedure
Procedure SelectFont(*BitmapFont.BitmapFont)
Police$ = "Arial" ; Police initiale (peut aussi être nulle)
TaillePolice = 96 ; Taille initiale (peut aussi être nulle)
Resultat = FontRequester(Police$, TaillePolice, #PB_FontRequester_Effects)
If Resultat
Debug SelectedFontName()
MyLoadFont(0,SelectedFontName(),SelectedFontSize(),SelectedFontStyle())
EndIf
*BitmapFont\AsciiStart=32
*BitmapFont\AsciiEnd=122
ReDim *BitmapFont\FontData(*BitmapFont\AsciiEnd-*BitmapFont\AsciiStart)
Debug "ArraySize="+Str(ArraySize(*BitmapFont\FontData()))
EndProcedure
Procedure RefreshImage(*BitmapFont.BitmapFont,WithBorder.b=#True)
Marg=GetGadgetState(#Gdt_Marg)
If IsImage(*BitmapFont\SpriteId):FreeImage(*BitmapFont\SpriteId):EndIf
If IsFont(0)
Protected.l MaxWidth=0,MaxHeight=0
*BitmapFont\SpriteId=CreateImage(#PB_Any,96*10,96*10,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(*BitmapFont\SpriteId))
DrawingFont(FontID(0))
Debug "___"
Debug *BitmapFont\AsciiStart
Debug *BitmapFont\AsciiEnd
Debug "___"
For a=*BitmapFont\AsciiStart To *BitmapFont\AsciiEnd
c=a-*BitmapFont\AsciiStart
*BitmapFont\FontData(c)\Width=TextWidth(Chr(a))
Debug Str(a)+" width="+Str(TextWidth(Chr(a)))
*BitmapFont\FontData(c)\Height=TextHeight(Chr(a))
If *BitmapFont\FontData(c)\Width>MaxWidth:MaxWidth=*BitmapFont\FontData(c)\Width:EndIf
If *BitmapFont\FontData(c)\Height>MaxHeight:MaxHeight=*BitmapFont\FontData(c)\Height:EndIf
Next
Debug MaxWidth
Debug MaxHeight
Else
Debug "ERRROR"
EndIf
StopDrawing()
If MaxWidth>MaxHeight
Max=MaxWidth
Else
Max=MaxHeight
EndIf
StartDrawing(ImageOutput(*BitmapFont\SpriteId))
DrawingFont(FontID(font))
x.l=0:y.l=0
ReDim FinalFont(*BitmapFont\AsciiEnd-*BitmapFont\AsciiStart)
;Dim finalFont.myFontData(90)
For a=*BitmapFont\AsciiStart To *BitmapFont\AsciiEnd
c=a-*BitmapFont\AsciiStart
If x+*BitmapFont\FontData(c)\Width+Marg*2>ImageWidth(*BitmapFont\SpriteId)
x=0:Y=Y+MaxHeight+Marg*2
EndIf
If WithBorder=#True
DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Outlined )
Box(x,y,*BitmapFont\FontData(c)\Width+Marg*2,Max+Marg*2,RGBA(0,255,0,128))
;Line(x+Marg+*BitmapFont\FontData(c)\Width,y,1,Max,RGBA(255,0,0,200))
EndIf
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AlphaBlend)
DrawText(x+Marg,y+Marg,Chr(a),RGBA(255,255,255,255))
finalFont(c)\x=x
finalFont(c)\y=y
finalFont(c)\Width=*BitmapFont\FontData(c)\Width+Marg*2
finalFont(c)\Height=MaxHeight+Marg*2
x=x+*BitmapFont\FontData(c)\Width+Marg*2
Next
Y=Y+MaxHeight+Marg*2
Line(0,Y,ImageWidth(*BitmapFont\SpriteId),1,RGBA(255,0,0,255))
StopDrawing()
StartDrawing(CanvasOutput(#Gdt_Canvas))
DrawImage(ImageID(*BitmapFont\SpriteId),0,0,768,768)
StopDrawing()
EndProcedure
If OpenWindow(#Win_Main, 0, 0, 1024, 768, "Thy Font Bitmap Creator", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(#Gdt_Canvas, 0, 0, 768, 768)
SpinGadget(#Gdt_Marg, 800, 10, 100, 25, 0,50,#PB_Spin_Numeric )
ButtonGadget(#Gdt_Save,800,740,75,25,"Save")
*f.BitmapFont=AddElement(BitmapFont())
SelectFont(*f)
RefreshImage(*f)
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case #Gdt_Marg
RefreshImage(*f)
Case #Gdt_Save
RefreshImage(*f,#False)
SaveImage(BitmapFont()\SpriteId,"FontsCompress.png",#PB_ImagePlugin_
)
If CreateFile(0,"FontsCompress.dat")
WriteCharacter(0,BitmapFont()\AsciiStart,#PB_Ascii)
WriteCharacter(0,BitmapFont()\AsciiEnd,#PB_Ascii)
WriteData(0,@finalFont(),SizeOf(myFontData)*ArraySize(finalFont()))
CloseFile(0)
EndIf
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
CloseWindow(0)
EndIf
; IDE Options = PureBasic 6.00 Beta 5 (Windows - x64)
; CursorPosition = 146
; FirstLine = 88
; Folding = -
; EnableXP

123
ThyBitmapFontCreator2.pb Normal file
View File

@@ -0,0 +1,123 @@
Structure LoadedFont
FontID.i
AsciiStart.l
AsciiEnd.l
EndStructure
Global NewList LoadedFont.LoadedFont()
Structure Output
MaxSize.l
MarginTop.l
MarginRight.l
MarginBottom.l
MarginLeft.l
ImageWidth.l
ImageHeight.l
EndStructure
Global Output.Output
Procedure MyLoadFont(Font.l,Name.s,Size.l,Flag=0)
Debug Name
Taille=1;
Img=CreateImage(#PB_Any,1,1);Creation d'une image pour travailler
Repeat
If IsFont(Font)
FreeFont(Font)
EndIf
Taille+1
Font=LoadFont(#PB_Any, Name, Taille,Flag)
If IsFont(Font)
StartDrawing(ImageOutput(Img))
DrawingFont(FontID(Font))
If TextHeight("@")>Size Or TextWidth("@")>Size
Taille-1
Quit=1
EndIf
StopDrawing()
Else
Debug "Error Load Font "+Name
End
EndIf
Until Quit=1 Or Taille>500
Debug "Taille="+Str(Taille)
FreeImage(Img)
ProcedureReturn Font
EndProcedure
Procedure AddFont(Name.s,Size.l,Flag.l,AsciiStart.l,AsciiEnd.l)
AddElement(LoadedFont())
LoadedFont()\FontID=MyLoadFont(#PB_Any,Name.s,Size.l,Flag)
LoadedFont()\AsciiStart=AsciiStart
LoadedFont()\AsciiEnd=AsciiEnd
EndProcedure
Structure myFontData
x.l
y.l
Width.l
Height.l
EndStructure
Procedure ExportFont(Name.s)
Protected Image.i=CreateImage(#PB_Any,Output\ImageWidth,Output\ImageHeight,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(Image))
Protected.l a,x,y,ChrWidth,MaxHeight=Output\MaxSize
Protected.c AsciiStart,AsciiEnd
FirstElement(LoadedFont())
AsciiStart=LoadedFont()\AsciiStart
LastElement(LoadedFont())
AsciiEnd=LoadedFont()\AsciiEnd
Debug "AsciiStart="+Str(AsciiStart)
Debug "AsciiEnd="+Str(AsciiEnd)
Dim FontData.myFontData(AsciiEnd-AsciiStart)
ForEach LoadedFont()
;Circle(x,y,5,RGBA(255,0,0,255))
For a=LoadedFont()\AsciiStart To LoadedFont()\AsciiEnd
ChrWidth=Output\MarginLeft+TextWidth(Chr(a))+Output\MarginRight
If x+ChrWidth>ImageWidth(Image)
x=0:y=y+MaxHeight
EndIf
Debug Chr(a)
DrawingFont(FontID(LoadedFont()\FontID))
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AlphaBlend)
FontData(a-AsciiStart)\x=x
FontData(a-AsciiStart)\y=y
FontData(a-AsciiStart)\Width=ChrWidth
FontData(a-AsciiStart)\Height=MaxHeight
DrawText(x+Output\MarginLeft,y+Output\MarginTop,Chr(a),RGBA(255,255,255,255))
x=x+ChrWidth
Next
Next
StopDrawing()
SaveImage(Image,Name+".png",#PB_ImagePlugin_PNG)
If CreateFile(0,Name+".dat")
WriteCharacter(0,AsciiStart,#PB_Ascii)
WriteCharacter(0,AsciiEnd,#PB_Ascii)
WriteData(0,@FontData(),SizeOf(myFontData)*ArraySize(FontData()))
CloseFile(0)
EndIf
EndProcedure
UsePNGImageEncoder()
Output\MaxSize=20
Output\MarginTop=2
Output\MarginBottom=2
Output\MarginLeft=2
Output\MarginRight=2
Output\ImageWidth=Output\MaxSize*10
Output\ImageHeight=Output\MaxSize*10
Size=Output\MaxSize-Output\MarginLeft-Output\MarginRight
;AddFont("Langith RegPersonal",Size,0,32,43)
;AddFont("MonoFonto",size,0,44,59)
;AddFont("Langith RegPersonal",Size,0,60,122)
AddFont("Alton Trial",size,0,32,122)
ExportFont("AltonFont2")
; IDE Options = PureBasic 6.00 LTS (Windows - x64)
; CursorPosition = 108
; FirstLine = 45
; Folding = -
; EnableXP

4
score.pbi Normal file
View File

@@ -0,0 +1,4 @@

; IDE Options = PureBasic 6.00 Beta 6 (Windows - x64)
; EnableXP

134
test.pb Normal file
View File

@@ -0,0 +1,134 @@

Procedure CheckLoop(StartX.l,StartY.l,OnlyLoop.b=#True,Onepiece.b=#False)
Protected OutDirection.l=-1
Protected.l CountPass=0
Protected.l Bx,By
NewList Path.Path()
Bx=StartX
By=StartY
Protected.l ChangeDirection=-1
Protected.b FindLoop=#False
Protected.b EndSearch=#False
Repeat
CurrentSprite=Game\GameTable(Bx,By)\Sprite
If CurrentSprite=0
ProcedureReturn #False
EndIf
;Chose first Direction
If OutDirection=-1
Select CurrentSprite
Case #Spr_UD
OutDirection=#Shape_Up
ChangeDirection=#Shape_Down
Case #Spr_LR
OutDirection=#Shape_Right
ChangeDirection=#Shape_Left
Case #Spr_RD
OutDirection=#Shape_Left
ChangeDirection=#Shape_Up
Case #Spr_DL
OutDirection=#Shape_Up
ChangeDirection=#Shape_Right
Case #Spr_LU
OutDirection=#Shape_Down
ChangeDirection=#Shape_Right
Case #Spr_UR
OutDirection=#Shape_Down
ChangeDirection=#Shape_Left
Case #Spr_Cross
OutDirection=#Shape_Up
ChangeDirection=#Shape_Down
Case #Spr_Locked
ProcedureReturn #False
EndSelect
EndIf
OutDirection=ShapeDirection(CurrentSprite,OutDirection)
Select ShapeDirection
Case #Shape_Right
Bx=Bx+1
Case #Shape_Left
Bx=Bx-1
Case #Shape_Up
By=By-1
Case #Shape_Down
By=By+1
EndSelect
If ShapeDirection=#Shape_None ;If no Way
If CountPass=0 ; If first pass I start at the beginning in reverse direction
Bx=StartX
By=StartY
OutDirection=ChangeDirection
CountPass=CountPass+1
Else
ProcedureReturn #False
EndIf
Else
If Bx<0 Or By<0 Or Bx>#MaxTableWidth Or By>#MaxTableHeight
CompilerIf #DebugCheckLoopVerbose=#True:Debug"Out of GamePath "+Str(CountPiece):CompilerEndIf
OutBench=#True
EndSearch=#True
Else
NextSprite=Game\GameTable(Bx,By)\Sprite
If NextSprite=0
CompilerIf #DebugCheckLoopVerbose=#True:Debug"Empty Case"+Str(CountPiece):CompilerEndIf
EndSearch=#True
ElseIf CheckShapeCompatible(CurrentSprite,ShapeDirection,NextSprite)=#True
;If Back to first Piece it's a Loop
If BX=StartX And BY=StartY
If NextSprite<>#Spr_Cross Or (NextSprite=#Spr_Cross And CrossCounter(BX,BY)=2)
EndSearch=#True
FindLoop=#True
EndIf
EndIf
EndIf
EndIf
EndIf
Until EndSearch=#True
Debug "OnlyLoop="+Str(OnlyLoop)
If OnlyLoop=#True
If FindLoop=#False
CompilerIf #DebugCheckLoopVerbose=#True:Debug"Loop Stoped by bad piece"+GetShapeName(NewSprite)+" "+Str(CountPiece):CompilerEndIf
FreeList(Path())
Debug "CheckLoop() Return #False"
ProcedureReturn #False
EndIf
EndIf
CompilerIf #DebugCheckLoopVerbose=#True:Debug "YEeeeeeeeeeeeeeeah":CompilerEndIf
ForEach Path()
Game\GameTable(Path()\BX,Path()\BY)\Selected=#True
Next
CopyList(Path(),LoopPath())
Protected LoopSize.l=ListSize(Path())
FreeList(Path())
CompilerIf #DebugCheckLoopVerbose=#True:Debug "Result:"+Str(LoopSize)+"/"+Str(CountPiece):CompilerEndIf
Debug "CheckLoop() Return "+Str(LoopSize)
Debug "#######"
ProcedureReturn LoopSize
EndProcedure
; IDE Options = PureBasic 6.00 LTS (Windows - x64)
; Folding = --
; EnableXP
; DPIAware