Initial commit

Shape.pbi

@@ -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