thyphoon/LoopzRemix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
LoopzRemix/Shape.pbi
Yann Lebrun 069402c4ec Initial commit
2025-07-17 20:36:20 +02:00

597 lines
16 KiB
Plaintext
Raw Permalink Blame History

;-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
Reference in New Issue View Git Blame Copy Permalink