Initial commit

2025-07-17 20:36:20 +02:00
commit 069402c4ec
37 changed files with 7849 additions and 0 deletions
--- a/test.pb
+++ b/test.pb
@@ -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