Puzzle

Spiele, Demos, Grafikzeug und anderes unterhaltendes.
Benutzeravatar
dige
Beiträge: 1182
Registriert: 08.09.2004 08:53

Puzzle

Beitrag von dige »

Bild

Code: Alles auswählen

; by dige 10/2016

InitSprite()
InitMouse()

UsePNGImageDecoder()
UseJPEGImageDecoder()

Structure _PUZZLE
  id.i
  x.i
  y.i
  z.i
  
  cr.i
  cx.i
  cy.i
  
  status.i
EndStructure

Global NewList Puzzles._PUZZLE()

If LoadImage(0, "C:\Temp\Endurotraining-original-135.jpg") = 0
  CreateImage(0, 800, 600)
  If StartDrawing(ImageOutput(0))
    DrawingMode(#PB_2DDrawing_Gradient)      
    BackColor($00FFFF)
    FrontColor($FF0000)
    BoxedGradient(0, 0, OutputWidth(), OutputHeight())
    Box(0, 0, OutputWidth(), OutputHeight())
    StopDrawing()
  EndIf
Else
  ResizeImage(0, 800, 600)
EndIf

Procedure Puzzle_Z_Order ()
  Protected n = 0
  
  SortStructuredList( Puzzles(), #PB_Sort_Ascending, OffsetOf(_PUZZLE\z), TypeOf(_PUZZLE\z))
  
  ForEach Puzzles()
    
    
    If Puzzles()\status = 1
      Puzzles()\z = 0
    Else
      n + 1
      Puzzles()\z = n
    EndIf
   
  Next
  
EndProcedure  

Procedure Puzzle_Solved()
  Protected result = 0
  Protected n = 0
  
  ForEach Puzzles()
    If Puzzles()\status = 1
      n + 1
    EndIf
  Next
  
  If n = ListSize(Puzzles())
    result = 1
  EndIf
  
  ProcedureReturn result
EndProcedure


Procedure Puzzle_Home()
  Protected result = 0
  
  If Puzzles()\cr = 0
    If Abs(Puzzles()\x - Puzzles()\cx) < 10 And Abs(Puzzles()\y - Puzzles()\cy) < 10
      Puzzles()\cx = Puzzles()\x
      Puzzles()\cy = Puzzles()\y
      result = 1
    EndIf
  EndIf
  
  ProcedureReturn result
EndProcedure

Procedure DrawPuzzle(bgr = 0)
  
  FlipBuffers()
  ClearScreen(RGB(42,42,42))
  
  If StartDrawing(ScreenOutput())
    If bgr
      DrawAlphaImage(ImageID(0), 0, 0, 100)
    Else
      Box(25, 25, 760, 510, 0)
    EndIf
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText( 300, 560, "Little puzzle game by dige", #White )
    StopDrawing()
  EndIf  
  
  ForEach Puzzles()
    With Puzzles()
      RotateSprite(\id, \cr, #PB_Absolute)
      DisplayTransparentSprite(\id, \cx, \cy)
    EndWith
  Next
  
EndProcedure

Procedure CreatePuzzleTile (Size, FillImgID, Pattern.i, SpriteID, x, y)
  
  Protected ImgID = CreateImage(#PB_Any, Size, Size, 32, #PB_Image_Transparent)
  Protected peak.i = (Size * 15) / 100
  Protected gap.i  = (Size * 25) / 100
  Protected length.i = Size - ( 2 * peak )
  
  ; 	       
  ; Pattern: 1-tongue|2-groove Bits from upper to right to bottom to left
  ; Edge Tile upper left = 00011000 (groove right, tongue bottom)
  
  
 If StartVectorDrawing(ImageVectorOutput(ImgID))
   
   ;TranslateCoordinates(peak, peak)
   
   MovePathCursor(peak, peak)
   
   ;{ Check upper side (Cursor Upper Left)
   If Pattern & %11 
     AddPathLine(peak + length/2 - gap/2, peak)
     
     If Pattern & %1 ; tongue
        AddPathCurve(0, 0, size, 0,  peak + length/2 + gap/2, peak)    ; Tongue
       Else
        AddPathCurve(0, 2*peak, size, 2*peak,  peak + length/2 + gap/2, peak)    ; Groove
      EndIf
   EndIf  
   AddPathLine(size-peak, peak)
   ;} 
   
   ;{ Check right side (Cursor Upper Right)
   If Pattern & %1100
     AddPathLine(size-peak, peak + length/2 - gap/2)
     
     If Pattern & %0100 ; tongue
        AddPathCurve(size, 0, size, size, size - peak, peak + length/2 + gap/2)    ; Tongue
       Else
        AddPathCurve(length, 0, length, size, size - peak, peak + length/2 + gap/2)    ; Groove
      EndIf
   EndIf  
   AddPathLine(size-peak, size-peak)
   ;}
   
   ;{ Check bottom side (Cursor bottom Right)
   If Pattern & %110000
     AddPathLine(peak + length/2 + gap/2, size - peak)
     
     If Pattern & %010000 ; tongue
        AddPathCurve(size, size, 0, size, peak + length/2 - gap/2, size - peak)    ; Tongue
       Else
        AddPathCurve(size, size - 2*peak, 0, size - 2*peak, peak + length/2 - gap/2, size - peak)    ; Tongue
      EndIf
   EndIf  
   AddPathLine(peak, size-peak)
   ;}
   
   
   ;{ Check left side (Cursor bottom left)
   If Pattern & %11000000
     AddPathLine(peak, peak + length/2 + gap/2)
     
     If Pattern & %01000000 ; tongue
        AddPathCurve(0, size, 0, 0, peak, peak + length/2 - gap/2)
       Else
        AddPathCurve(2*peak, size, 2*peak, 0, peak, peak + length/2 - gap/2) 
      EndIf
   EndIf  
   AddPathLine(peak, peak)
   ;}
   

   
   ClosePath()
   VectorSourceImage(ImageID(FillImgID), 255, ImageWidth(FillImgID), ImageHeight(FillImgID))
   
   ; Fill the tile shape with the image contents. keep the path
   FillPath(#PB_Path_Preserve)
 
   ; Select a solid color and draw the outline of the tile as well
   VectorSourceColor(RGBA(100, 100, 100, 255))   
   StrokePath(2)   
   StopVectorDrawing()
 EndIf
 
  
  CreateSprite(SpriteID, Size, Size, #PB_Sprite_AlphaBlending|#PB_Sprite_PixelCollision)
  If StartDrawing(SpriteOutput(SpriteID))
     DrawingMode(#PB_2DDrawing_AlphaChannel)
     Box(0,0,size,size,128)
     DrawingMode(#PB_2DDrawing_AlphaBlend)
     DrawAlphaImage(ImageID(ImgID), 0, 0 )
     DrawText(50, 50, Str(SpriteID))
     StopDrawing()
   EndIf
   AddElement( Puzzles())
   With Puzzles()
     \id = SpriteID
     \x  = x
     \y  = y
     \cx = x
     \cy = y
     \cr = 0
   EndWith  
  
 FreeImage(ImgID) 
 
 ProcedureReturn length
EndProcedure

  w = 800
  h = 600


If OpenWindow(0, 0, 0, w, h, "Puzzle Game - Start with Space key", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(0), 0, 0, w, h)
  
  tilesize = 180
  x = 0
  y = 0
  l = 0
  
  ; First Row
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %00011000, 0, 0, 0)
  x + l
  
  GrabImage(0, 3, x, 0, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %01100100, 1, 1*l, 0)
  x + l
  
  GrabImage(0, 3, x, 0, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %10011000, 2, 2*l, 0)
  x + l
  
  GrabImage(0, 3, x, 0, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %01100100, 3, 3*l, 0)
  x + l
  
  GrabImage(0, 3, x, 0, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %10011000, 4, 4*l, 0)
  x + l
  
  GrabImage(0, 3, x, 0, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %01100000, 5, 5*l, 0)
  
  ; Second Row
  x = 0
  y + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %00100110, 6, 0, l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %10011001, 7, 1*l, l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %01100110, 8, 2*l, l)
  x + l

  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %10011001, 9, 3*l, l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %01100110, 10, 4*l, l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %10010001, 11, 5*l, l)
  
  ; Third Row
  x = 0
  y + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %00011001, 12, 0, 2*l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %01100110, 13, 1*l, 2*l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %10011001, 14, 2*l, 2*l)
  x + l

  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %01100110, 15, 3*l, 2*l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %10011001, 16, 4*l, 2*l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %01100010, 17, 5*l, 2*l)
  
 ; Last Row
  x = 0
  y + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %00000110, 18, 0, 3*l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %10001001, 19, 1*l, 3*l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %01000110, 20, 2*l, 3*l)
  x + l

  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %10001001, 21, 3*l, 3*l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %01000110, 22, 4*l, 3*l)
  x + l
  
  GrabImage(0, 3, x, y, tilesize, tilesize)
  l = CreatePuzzleTile (tilesize, 3, %10000001, 23, 5*l, 3*l)
  
  DrawPuzzle(1)
  
  
; Mouse Pointer
  CreateSprite(24, 16, 16, #PB_Sprite_PixelCollision|#PB_Sprite_AlphaBlending)
  If StartDrawing(SpriteOutput(24))
    DrawingMode(#PB_2DDrawing_AlphaChannel)
    Box(0,0,16,16,128)
    
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    
    Circle(8, 8, 7, RGBA(255, 255, 255, 255))
    Circle(8, 8, 6, RGBA(100, 100, 100, 255))
    StopDrawing()
  EndIf
  
  Puzzle_Z_Order ()
  move = #PB_Any
  
  Repeat
    
    Event = WaitWindowEvent(10) 
    
    If ExamineMouse()
      
      If MouseButton(#PB_MouseButton_Left) Or MouseButton(#PB_MouseButton_Right)
        
        If move = #PB_Any
          n = #PB_Any
          
          ; Find highest machting Sprite
          ForEach Puzzles()
            With Puzzles()
              If SpriteCollision(\id, \cx, \cy, 24, MouseX(), MouseY())
                If SpritePixelCollision(\id, \cx, \cy, 24, MouseX(), MouseY())
                  n = ListIndex(Puzzles())
                EndIf
              EndIf
            EndWith
          Next
          
          If n <> #PB_Any
            SelectElement(Puzzles(), n)
            
            If Puzzles()\status <> 1
              
              Puzzles()\z = 999
              
              If MouseButton(#PB_MouseButton_Right)
                b = Puzzles()\cr
                c = b + 90
                
                For a = b To c Step 10
                  SelectElement(Puzzles(), n)
                  Puzzles()\cr = a
                  DrawPuzzle(0)
                Next
                
                Puzzles()\cr = c
                
                If Puzzles()\cr > 270
                  Puzzles()\cr = 0
                EndIf
                
              Else
                move    = Puzzles()\id
                OffsetX = Puzzles()\cx - MouseX()
                OffsetY = Puzzles()\cy - MouseY()
                
              EndIf
              
              
              Puzzle_Z_Order()

              
            EndIf
          EndIf
          
        Else
          
          ; Still moving..
          ForEach Puzzles()
            If move = Puzzles()\id  
              Puzzles()\cx = MouseX() + OffsetX
              Puzzles()\cy = MouseY() + OffsetY
              
              Puzzle_Home()
              
              Break
            EndIf
          Next
        EndIf
        
      ElseIf move <> #PB_Any
        ; Moving finished
        ForEach Puzzles()
          If move = Puzzles()\id
            If Puzzle_Home()
              Puzzles()\status = 1
              Puzzles()\z      = 0
              
              Puzzle_Z_Order()
              Break
            EndIf
          EndIf
        Next
        
        move = #PB_Any
        OffsetX = 0
        OffsetY = 0
        
        If Puzzle_Solved()
          SetWindowTitle(0, "Start new game with Space Key")  
          MessageRequester( "Congratulations ! :-)", "Time: " + Str(Date() - duration) + " sec.")
        EndIf
        
      EndIf ; MouseButton(#PB_MouseButton_Left)
      
      DrawPuzzle(0)
      DisplayTransparentSprite(24, MouseX(), MouseY())

    EndIf  
    
    If Event = #WM_KEYDOWN
      ForEach Puzzles()
        With Puzzles()
          Select Random(3)
            Case 0 : \cr = 0
            Case 1 : \cr = 90
            Case 2 : \cr = 180
            Case 3 : \cr = 270
          EndSelect
          
          \cx = Random(w - tilesize)
          \cy = Random(h - tilesize)
          
          \status = 0

        EndWith
      Next
      DrawPuzzle(0)
      
      duration = Date()
      SetWindowTitle(0, "Game is running...")
    EndIf
    
  Until Event = #PB_Event_CloseWindow 

EndIf
"Papa, mein Wecker funktioniert nicht! Der weckert immer zu früh."
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: Puzzle

Beitrag von ts-soft »

:allright:
Gut gemacht, lediglich mit dem Beenden hatte ich Probleme, da Maus gefangen.
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Puzzle

Beitrag von RSBasic »

Sieht gut aus und funktioniert. :allright:
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
man-in-black
Beiträge: 362
Registriert: 21.08.2006 17:39

Re: Puzzle

Beitrag von man-in-black »

moinsen,
... und funktioniert
Ich wollte eigentlich nichts schreiben, darüber musste ich dann doch schmunzeln. :lol:

@dige:
Schaut ganz nett aus, aber magst du noch Esc als Beenden einbauen?
Ich wollte eigentlich ausm Spiel raus und musste dann nochmal puzzlen... und nochmal ... und nochmal ... ;)

Vielleicht ist auch ein kleiner Ablagebereich ganz nett. Aktuell nimmt das Puzzle den gesamten Bildschirm ein,
ich habe es jetzt nicht probiert, aber kann man so nicht auch versehentlich Puzzleteile unter "fertige" verstecken/übersehen?

UND ich würde wie in deinem anderen Thread angedeutet, das Greifen von Steinchennasen umsetzen. Einige Klicks haben
mir dann doch das falsche Teil an die Maus gepinnt. Alternativ reicht vielleicht auch schon ein Hover-Effekt?

und ein Cheat-Modus für die faulen^^

MFG
MIB
(hab alles, kann alles, weiß alles!!^^)

Bild
True29
Beiträge: 283
Registriert: 18.08.2012 19:18
Computerausstattung: Windows 8 64bit .Profan x2,Purebasic 5.5
Wohnort: Worms
Kontaktdaten:

Re: Puzzle

Beitrag von True29 »

hab mir es auch mal angeschaut .

vorschläge:

vielelicht wäre es ganz nett wenn man sehen würde wieviel züge man aktuell hat bzw wie lange man für das puzzle braucht ;)
so könnte man sich auch verbessern.

mehrere schwierigekeiten einbauen evnentuell ? also je schwieriger um so kleiner werden die puzzle teile.

gefundene fehler:
beenden über maus oder tastatur nicht möglich.
manchmal kommt es vor das wenn man ein neues teil dreht er das alte wieder resettet also nicht die position beibehält.

grüße.
i7,12gb ram , Windows 10 ,Purebasic 5.50
Benutzeravatar
dige
Beiträge: 1182
Registriert: 08.09.2004 08:53

Re: Puzzle

Beitrag von dige »

Code: Alles auswählen

; Puzzel Spiel v1.1
; by Dige

CompilerIf #PB_Compiler_IsMainFile
  InitSprite()
  InitMouse()
  
  UsePNGImageDecoder()
  UseJPEGImageDecoder()
  UsePNGImageEncoder()
  
  Procedure.b isLMouseButton()
    If GetAsyncKeyState_( #VK_LBUTTON ) & $8000
      ProcedureReturn #TRUE
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  Procedure.b isRMouseButton()
    If GetAsyncKeyState_( #VK_RBUTTON ) & $8000
      ProcedureReturn #TRUE
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
CompilerEndIf

Structure _SYMETRICS
  ArrayX.i
  ArrayY.i
  
  Size.i
  peak.i
  gap.i
  Length.i

  Level.i
  Area.RECT
  Status.i
EndStructure

Structure _PUZZLE
  id.i
  x.i
  y.i
  z.i
  
  fx.f
  fy.f
  fr.f
  
  cr.i
  cx.i
  cy.i
  
  Status.i
EndStructure

Global NewList Puzzles._PUZZLE()
Global P_Sym._SYMETRICS
Global P_FontID_Big = LoadFont(#PB_Any, "Verdana", 70)
Global P_FontID_Sml = LoadFont(#PB_Any, "Courier", 30, #PB_Font_Bold)
Global P_duration.i, Pm_duration.i, P_Moves.i


Procedure Get_Puzzle_Style (x, y)
  
  ; Zunächst mal Typ 1 oder 2 ermitteln
  ; Typ 1     Typ 2
  ;  -/\-     -\/-
  ;  >  <    <    >
  ;  -\/-     -/\-
  
  If (Mod(y, 2) = 0 And Mod(x, 2) = 0) Or (Mod(y, 2) <> 0 And Mod(x, 2) <> 0)
    Result = %10011001 ; Typ1
  Else
    Result = %01100110 ; Typ 2
  EndIf
  
  ; Upper Border
  If y = 0
    Result & %11111100
    
  ; Bottom Border  
  ElseIf y = P_Sym\ArrayY
    
    Result & %11001111
  EndIf
  
  ; Left Border  
  If x = 0  
    Result & %00111111
    
  ; Right Border
  ElseIf x = P_Sym\ArrayX
    Result & %11110011
    ; Debug "rexchs"
  EndIf
  
  ; Debug "(x, y) : " + Str(x) + ", " + Str(y) + " | " + Str(P_Sym\ArrayX)
  
  ProcedureReturn Result
EndProcedure

Procedure Puzzle_Init (Size, ArrayX, ArrayY)
  P_Sym\Size   = Size
  P_Sym\peak   = (Size * 15) / 100
  P_Sym\gap    = (Size * 25) / 100
  P_Sym\Length = Size - ( 2 * P_Sym\peak )
  
  P_Sym\Area\left = P_Sym\peak
  P_Sym\Area\top = P_Sym\peak
  P_Sym\Area\right = (ArrayX + 1) * P_Sym\Length
  P_Sym\Area\bottom = (ArrayY + 1) * P_Sym\Length
  
  P_Sym\Status = 1
  P_Sym\ArrayX = ArrayX
  P_Sym\ArrayY = ArrayY
  
EndProcedure

Procedure Puzzle_Z_Order ()
  Protected n = 0
  
  SortStructuredList( Puzzles(), #PB_Sort_Ascending, OffsetOf(_PUZZLE\z), TypeOf(_PUZZLE\z))
  
  ForEach Puzzles()
    
    
    If Puzzles()\Status = 1
      Puzzles()\z = 0
    Else
      n + 1
      Puzzles()\z = n
    EndIf
   
  Next
  
EndProcedure  

Procedure Puzzle_Solved()
  Protected Result = 0
  Protected n = 0
  
  ForEach Puzzles()
    If Puzzles()\Status = 1
      n + 1
    EndIf
  Next
  
  If n = ListSize(Puzzles())
    Result = 1
    Pm_duration = Date() - P_duration
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure Puzzle_Home()
  Protected Result = 0
  
  If Puzzles()\cr = 0
    If Abs(Puzzles()\x - Puzzles()\cx) < 10 And Abs(Puzzles()\y - Puzzles()\cy) < 10
      Puzzles()\cx = Puzzles()\x
      Puzzles()\cy = Puzzles()\y
      Result = 1
    EndIf
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure Puzzle_Draw(ImgID = #PB_Any)
  Protected txt.s, l
  
  FlipBuffers()
  ClearScreen(RGB(42,42,42))
  
  
  If StartDrawing(ScreenOutput())
    
    
    If P_Sym\Status = 2 ; Game solved
      DrawAlphaImage(ImageID(0), 0, 0, 255)
      
    Else  
      Box(P_Sym\Area\left, P_Sym\Area\top, P_Sym\Area\right, P_Sym\Area\bottom, 0)
    EndIf
    
    DrawingMode(#PB_2DDrawing_Transparent)
    
    If P_duration > 0
      
      txt = FormatDate( "%ii:%ss", Date() - P_duration ) + " " + Str(P_Moves)
    Else
      
      txt = "00:00"
    EndIf
    
    DrawingFont(FontID(P_FontID_Big))
    
    txt + " "
    
    If P_Sym\Status = 2
      txt = FormatDate( "%ii:%ss", Pm_duration )
      DrawText( OutputWidth() - TextWidth(txt), OutputHeight()-TextHeight(txt), txt, #White)
    Else
      DrawText( OutputWidth() - TextWidth(txt), OutputHeight()-TextHeight(txt), txt, #Gray)
    EndIf
    
    StopDrawing()
  EndIf  
  
  If P_Sym\Status = 2
    ProcedureReturn 
  EndIf  
  
  If ListSize(Puzzles()) > 0
    With Puzzles()
      ForEach Puzzles()
        If P_Sym\Status = 1
          RotateSprite(\id, 0, #PB_Absolute)
          DisplayTransparentSprite(\id, \x, \y, 50)
        EndIf
        
        RotateSprite(\id, \cr, #PB_Absolute)
        
        If \Status = 1
          DisplayTransparentSprite(\id, \cx, \cy, 200)
        Else
          DisplayTransparentSprite(\id, \cx, \cy)
        EndIf
      Next
      
      ; Active Puzzle with Shadow
      If \Status <> 1 And P_duration > 0
        DisplayTransparentSprite(\id, \cx + 3 , \cy + 3, 200, $101010)
        DisplayTransparentSprite(\id, \cx, \cy)
      EndIf
  
    EndWith
  EndIf
  
  If P_duration <= 0 And P_Sym\Status <> 2
    If StartDrawing(ScreenOutput())
    
      DrawingFont(FontID(P_FontID_Sml))
      DrawingMode(#PB_2DDrawing_Transparent)
      
      l = TextHeight("A")
      Select P_Sym\Level
        Case 0 : txt = "Easy"
        Case 1 : txt = "Medium"
        Case 2 : txt = "Strong"
      EndSelect
      
      DrawText( P_Sym\Area\left, P_Sym\Area\top + 2 * l , "<Space> - Start Game", #White )
      DrawText( P_Sym\Area\left, P_Sym\Area\top + 4 * l , "<+>     - More Puzzles", #White )
      DrawText( P_Sym\Area\left, P_Sym\Area\top + 6 * l , "<->     - Less Puzzles", #White )
      DrawText( P_Sym\Area\left, P_Sym\Area\top + 8 * l , "<S>     - Save Tileset", #White )
      DrawText( P_Sym\Area\left, P_Sym\Area\top + 10* l , "<D>     - Difficulty: " + txt, #White )
      DrawText( P_Sym\Area\left, P_Sym\Area\top + 12* l , "<F1>    - Show Background", #White )
      DrawText( P_Sym\Area\left, P_Sym\Area\top + 14* l , "<Esc>   - Quit Game", #White )
      
      StopDrawing()
    EndIf
  EndIf
  
EndProcedure

Procedure Puzzle_Mix(WinID, tilesize)
  P_Sym\Status = 0
  frames = 60
  P_Moves = 0
  
  w = WindowWidth(WinID)
  h = WindowHeight(WinID)
  
  ForEach Puzzles()
    With Puzzles()
      \cr = 0
      
      If P_Sym\Level > 1
        Select Random(3)
          Case 0 : \cr = 0
          Case 1 : \cr = 90
          Case 2 : \cr = 180
          Case 3 : \cr = 270
        EndSelect
      EndIf
      
      \cx = Random(w - tilesize)
      \cy = Random(h - tilesize)
      
      \fx = (\cx - \x) / frames
      \fy = (\cy - \y) / frames
      \fr = \cr / frames
      
      \Status = 0
      
    EndWith
  Next
  
  For n = 1 To frames
    ForEach Puzzles()
      With Puzzles()
        \cx = \x + (n * \fx)
        \cy = \y + (n * \fy)
        \cr = (n * \fr)
      EndWith
    Next            
    Puzzle_Draw(ImgID)
  Next
  
  P_duration = Date()
  SetWindowTitle(WinID, "Game is running...")
  
EndProcedure

Procedure CreatePuzzleTile (Pattern.i, SpriteID, x, y, FillImgID)
  
  Protected Size = P_Sym\Size
  Protected peak.i = P_Sym\peak
  Protected gap.i  = P_Sym\gap
  Protected Length.i = P_Sym\Length
  
  Protected ImgID = CreateImage(#PB_Any, Size, Size, 32, #PB_Image_Transparent)
  
  ; 	       
  ; Pattern: 1-tongue|2-groove Bits from upper to right to bottom to left
  ; Edge Tile upper left = 00011000 (groove right, tongue bottom)
  
  
 If StartVectorDrawing(ImageVectorOutput(ImgID))
   
   ;TranslateCoordinates(peak, peak)
   
   MovePathCursor(peak, peak)
   
   ;{ Check upper side (Cursor Upper Left)
   If Pattern & %11 
     AddPathLine(peak + Length/2 - gap/2, peak)
     
     If Pattern & %1 ; tongue
        AddPathCurve(0, 0, Size, 0,  peak + Length/2 + gap/2, peak)    ; Tongue
       Else
        AddPathCurve(0, 2*peak, Size, 2*peak,  peak + Length/2 + gap/2, peak)    ; Groove
      EndIf
   EndIf  
   AddPathLine(Size-peak, peak)
   ;} 
   
   ;{ Check right side (Cursor Upper Right)
   If Pattern & %1100
     AddPathLine(Size-peak, peak + Length/2 - gap/2)
     
     If Pattern & %0100 ; tongue
        AddPathCurve(Size, 0, Size, Size, Size - peak, peak + Length/2 + gap/2)    ; Tongue
       Else
        AddPathCurve(Length, 0, Length, Size, Size - peak, peak + Length/2 + gap/2)    ; Groove
      EndIf
   EndIf  
   AddPathLine(Size-peak, Size-peak)
   ;}
   
   ;{ Check bottom side (Cursor bottom Right)
   If Pattern & %110000
     AddPathLine(peak + Length/2 + gap/2, Size - peak)
     
     If Pattern & %010000 ; tongue
        AddPathCurve(Size, Size, 0, Size, peak + Length/2 - gap/2, Size - peak)    ; Tongue
       Else
        AddPathCurve(Size, Size - 2*peak, 0, Size - 2*peak, peak + Length/2 - gap/2, Size - peak)    ; Tongue
      EndIf
   EndIf  
   AddPathLine(peak, Size-peak)
   ;}
   
   
   ;{ Check left side (Cursor bottom left)
   If Pattern & %11000000
     AddPathLine(peak, peak + Length/2 + gap/2)
     
     If Pattern & %01000000 ; tongue
        AddPathCurve(0, Size, 0, 0, peak, peak + Length/2 - gap/2)
       Else
        AddPathCurve(2*peak, Size, 2*peak, 0, peak, peak + Length/2 - gap/2) 
      EndIf
   EndIf  
   AddPathLine(peak, peak)
   ;}
   

   ClosePath()
   VectorSourceImage(ImageID(FillImgID), 255, ImageWidth(FillImgID), ImageHeight(FillImgID))
   
   ; Fill the tile shape with the image contents. keep the path
   FillPath(#PB_Path_Preserve)
 
   ; Select a solid color and draw the outline of the tile as well
   VectorSourceColor(RGBA(100, 100, 100, 255))   
   StrokePath(2)   
   StopVectorDrawing()
 EndIf
 
  If SpriteID <> #PB_Ignore
    CreateSprite(SpriteID, Size, Size, #PB_Sprite_AlphaBlending|#PB_Sprite_PixelCollision)
    
    If StartDrawing(SpriteOutput(SpriteID))
      
      DrawingMode(#PB_2DDrawing_AlphaChannel)
      Box(0,0,Size,Size,128)
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      DrawAlphaImage(ImageID(ImgID), 0, 0 )
      Debug P_Sym\Level
      If P_Sym\Level = 0
        DrawText(Size/2, Size/2, Str(SpriteID), RGBA(255, 255, 255, 200), RGBA(0, 0, 0, 100))
      EndIf
      StopDrawing()
    EndIf
    
    AddElement( Puzzles())
    With Puzzles()
       \id = SpriteID
       \x  = x
       \y  = y
       \cx = x
       \cy = y
       \cr = 0
    EndWith  
  
    FreeImage(ImgID) 
  Else
    Length = ImgID
  EndIf
 
 ProcedureReturn Length
EndProcedure

Procedure Puzzle_TiteSet (tilesize, file.s, Bgr_ImgID)
  
  ; Create TileSet
    
  x = 0
  y = 0
  l = 0
  i = 0
  
  TileSet = CreateImage(#PB_Any, (P_Sym\ArrayX + 1) * (P_Sym\Size - P_Sym\peak), (P_Sym\ArrayY + 1) * (P_Sym\Size - P_Sym\peak), 32, #PB_Image_Transparent)
  Puzzle  = CreateImage(#PB_Any, (P_Sym\ArrayX + 1) * P_Sym\Length, (P_Sym\ArrayY + 1) * P_Sym\Length, 32, #PB_Image_Transparent)
  
  For b = 0 To P_Sym\ArrayY ; Y
    For a = 0 To P_Sym\ArrayX ; X
      
      FillImgID = GrabImage(Bgr_ImgID, #PB_Any, x, y, tilesize, tilesize)
      ImgID = CreatePuzzleTile (Get_Puzzle_Style(a, b), #PB_Ignore, a*P_Sym\Length, b*P_Sym\Length, FillImgID)
      FreeImage(FillImgID)
      
      x + P_Sym\Length
      
      If StartDrawing(ImageOutput(TileSet))
        DrawAlphaImage(ImageID(ImgID), a * (P_Sym\Size - P_Sym\peak) - P_Sym\peak/2, b * (P_Sym\Size - P_Sym\peak) - P_Sym\peak/2, 255)
        StopDrawing()
      EndIf
      
      If StartDrawing(ImageOutput(Puzzle))
        DrawAlphaImage(ImageID(ImgID), a * P_Sym\Length - P_Sym\peak, b * P_Sym\Length - P_Sym\peak, 255)
        StopDrawing()
      EndIf
      
      SaveImage(ImgID, file + "_" + RSet(Str(a), 2, "0") + "-" + RSet(Str(b), 2, "0") + ".png", #PB_ImagePlugin_PNG )
      FreeImage(ImgID)
    Next 
    x = 0
    y + P_Sym\Length
  Next  
  
  SaveImage(TileSet, file + "_1.png", #PB_ImagePlugin_PNG )
  SaveImage(Puzzle, file + "_2.png", #PB_ImagePlugin_PNG )
  
  FreeImage( TileSet )
  FreeImage( Puzzle )
EndProcedure

Procedure Puzzle_Create (tilesize, WinX, WinY, ImgID)
  
  ; Vorhandene Sprites löschen
  
  ForEach Puzzles()
    If IsSprite(Puzzles()\id)
      FreeSprite(Puzzles()\id)
    EndIf
  Next
  
  ClearList( Puzzles() )

  If tilesize = #PB_Any Or IsImage(ImgID) = 0
    ProcedureReturn
  EndIf
  
  w = WinX
  h = WinY
  
  w = ImageWidth(ImgID)
  h = ImageHeight(ImgID)

  P_duration = 0
  
  If w > h
    x = WinX
    y = x*h/w
    
    If y < WinY
      y = WinY
      x = y*w/h
    EndIf  
  Else
    y = WinY
    x = y*w/h
    If x < WinX
      x = WinX
      y = x*h/w
    EndIf
  EndIf
    
  ResizeImage(ImgID, x, y)
      
  If x <> WinX Or y <> WinY
    Img_Copy = CreateImage(#PB_Any, WinX, WinY)
    If StartDrawing(ImageOutput(Img_Copy))
      Box(0, 0, WinX, WinY, #Gray )
      DrawImage(ImageID(ImgID), WinX/2 - x/2, WinY/2 - y/2)
      StopDrawing()
    EndIf
    FreeImage(ImgID)
    CopyImage(Img_Copy, ImgID)
    FreeImage(Img_Copy)
  EndIf
 
  ; Pre Init
  Puzzle_Init (tilesize, WinX / tilesize, WinY / tilesize )
  
  x = (WinX - (2*P_Sym\peak) - P_Sym\Length) / P_Sym\Length
  y = (WinY - (2*P_Sym\peak) - P_Sym\Length) / P_Sym\Length
  
  ; Exaxkt 
  Puzzle_Init (tilesize, x, y )
  
  x = 0
  y = 0
  l = 0
  i = 0
  
  For b = 0 To P_Sym\ArrayY ; Y
    For a = 0 To P_Sym\ArrayX ; X
      
      i + 1
      
      FillImgID = GrabImage(ImgID, #PB_Any, x, y, tilesize, tilesize)
      l = CreatePuzzleTile (Get_Puzzle_Style(a, b), i, a*l, b*l, FillImgID)
      FreeImage(FillImgID)
      
      x + l
      
    Next 
    x = 0
    y + l
  Next  
EndProcedure

Procedure Puzze_Game (WinID = #PB_Any, ImgID = #PB_Any)
  
  Protected w, h, t, tilesize, move, x, y, n
  
  If WinID = #PB_Any
    If ExamineDesktops()
      WinX = DesktopWidth(0)
      WinY = DesktopHeight(0)
    EndIf
  Else
    WinX = WindowWidth(WinID)
    WinY = WindowHeight(WinID)
  EndIf

  w = WinX
  h = WinY
  t = 4
  
  If WinID = #PB_Any
    WinID = OpenWindow(#PB_Any, 0, 0, w, h, "Puzzle Game - Start with any key", #PB_Window_BorderLess|#PB_Window_ScreenCentered)
  EndIf
  
  OpenWindowedScreen(WindowID(WinID), 0, 0, w, h)
  
  ; Mouse Pointer
  CreateSprite(0, 2, 2, #PB_Sprite_PixelCollision|#PB_Sprite_AlphaBlending)
  If StartDrawing(SpriteOutput(0))
    DrawingMode(#PB_2DDrawing_AlphaChannel)
    Box(0,0,2,2,128)
    
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    Box(0, 0, 2, 2, RGBA(255, 255, 255, 255))
    
    ;Circle(8, 8, 3, RGBA(255, 255, 255, 255))
    ;Circle(8, 8, 4, RGBA(100, 100, 100, 255))
    StopDrawing()
  EndIf
  
  If ImgID = #PB_Any
    file.s = ProgramParameter()
  
    If file = "" Or FileSize(file) <= 0
      file = OpenFileRequester( "Open image", "", "Images (*.jpg, *.png)|*.jpg;*.png|All files (*.*)|*.*", 0)
    EndIf
  
    ImgID = 0
    If file= "" Or LoadImage(ImgID, file) = 0
      CreateImage(ImgID, WinX, WinY)
      If StartDrawing(ImageOutput(ImgID))
        DrawingMode(#PB_2DDrawing_Gradient)      
        BackColor($00FFFF)
        FrontColor($FF0000)
        BoxedGradient(0, 0, OutputWidth(), OutputHeight())
        Box(0, 0, OutputWidth(), OutputHeight())
        StopDrawing()
      EndIf
    EndIf
  EndIf  
  
  tilesize = w/t
  Puzzle_Create (tilesize, w, h, ImgID)
  Puzzle_Z_Order ()
  move = #PB_Any
  
  
  Repeat
    
    CompilerIf #PB_Compiler_IsMainFile
      Event = WaitWindowEvent(100)
    CompilerElse
      Event = WaitWindowEventEXt(#True)
      
      If UserInterrupt(Event)
        Break
      EndIf
    CompilerEndIf
    
    MouseX = WindowMouseX(WinID)
    MouseY = WindowMouseY(WinID)
    
    If isLMouseButton() Or isRMouseButton() Or rotate = 1
      
      If P_duration <= 0
        Puzzle_Mix(WinID, tilesize)
        Continue
      EndIf
      
      If move = #PB_Any
        n = #PB_Any
        
        ; Find highest machting Sprite
        ForEach Puzzles()
          With Puzzles()
            If SpriteCollision(\id, \cx, \cy, 0, MouseX, MouseY)
              If SpritePixelCollision(\id, \cx, \cy, 0, MouseX, MouseY)
                n = ListIndex(Puzzles())
              EndIf
            EndIf
          EndWith
        Next
        
        If n <> #PB_Any
          P_Moves + 1
          
          SelectElement(Puzzles(), n)
          
          If Puzzles()\Status <> 1
            
            Puzzles()\z = 999
            
            If isRMouseButton() Or rotate = 1
              b = Puzzles()\cr
              c = b + 90
              
              For a = b To c Step 10
                SelectElement(Puzzles(), n)
                Puzzles()\cr = a
                Puzzle_Draw(ImgID)
              Next
              
              SelectElement(Puzzles(), n)
              Puzzles()\cr = c
              
              If Puzzles()\cr > 270
                Puzzles()\cr = 0
              EndIf
              
              If Puzzle_Home()
                Puzzles()\Status = 1
                Puzzles()\z      = 0
                Puzzle_Z_Order()
              EndIf

              
            Else
              move    = Puzzles()\id
              OffsetX = Puzzles()\cx - MouseX
              OffsetY = Puzzles()\cy - MouseY
              
            EndIf
            
            Puzzle_Z_Order()
 
          EndIf
        EndIf
        
      Else
        
        ; Still moving..
        ForEach Puzzles()
          If move = Puzzles()\id  
            Puzzles()\cx = MouseX + OffsetX
            Puzzles()\cy = MouseY + OffsetY
            
            Puzzle_Home()
            
            Break
          EndIf
        Next
      EndIf
      
    ElseIf move <> #PB_Any
      ; Moving finished
      ForEach Puzzles()
        If move = Puzzles()\id
          If Puzzle_Home()
            Puzzles()\Status = 1
            Puzzles()\z      = 0
            
            Puzzle_Z_Order()
            Break
          EndIf
        EndIf
      Next
      
      move = #PB_Any
      OffsetX = 0
      OffsetY = 0
      
      If Puzzle_Solved()
        Pm_duration = Date() - P_duration
        
        x = P_Sym\ArrayX+1
        y = P_Sym\ArrayY+1
        n = x * y
        
        If Pm_duration < n * 10
          Points = ((n * 10) - Pm_duration) * n
        EndIf
        
        If P_Moves < n * 5
          Points + ((n * 5) - P_Moves) * n
        EndIf
        
        Points + (P_Sym\Level * Points)
        
        P_Sym\Status = 2
        Puzzle_Draw (ImgID)
        SetWindowTitle(WinID, "Start new game with Space Key")  
        MessageRequester( "Congratulations!", "Puzzle : " + Str(n) +
                                              " (" + Str(x) + " x " + Str(y) +")" + #CRLF$ +
                                              "Time   : " + Str(Pm_duration) + " sec." + #CRLF$ +
                                              "Moves  : " + Str(P_Moves) + #CRLF$ + #CRLF$ +
                                              "Points : " + Str(Points))
      EndIf
      
    EndIf ; MouseButton(#PB_MouseButton_Left)
    
    Puzzle_Draw(ImgID)
    ;DisplayTransparentSprite(24, MouseX, MouseY, 100)
    
    If rotate
      rotate = 0
    EndIf     
    
    If Event = #WM_KEYDOWN
      
      Select EventwParam() 
          
        Case #VK_ADD
          t + 1
          tilesize = WindowWidth(WinID)/t
          Puzzle_Create (tilesize, WinX, WinY, ImgID)
          Puzzle_Z_Order ()
          
        Case #VK_SUBTRACT
          t - 1
          If t < 3
            t = 3
          EndIf
          
          tilesize = WindowWidth(WinID)/t
          Puzzle_Create (tilesize, WinX, WinY, ImgID)
          Puzzle_Z_Order ()
          
        Case #VK_SPACE
          Puzzle_Mix(WinID, tilesize)
          
        Case #VK_D
          P_Sym\Level + 1
          If P_Sym\Level > 2
            P_Sym\Level = 0
          EndIf
          Puzzle_Create (tilesize, WinX, WinY, ImgID)
          Puzzle_Z_Order ()
          
          
        Case #VK_F1
          P_Sym\Status ! 1
          Puzzle_Draw(ImgID)
          
        Case #VK_S
          file.s = SaveFileRequester( "Puzzel Set speichern", "Puzzle.png", "Bild (*.png)|*.png|Alle Dateien (*.*)|*.*", 0 )
          If file <> ""
            file = GetFilePart(file, #PB_FileSystem_NoExtension)
            Puzzle_TiteSet(tilesize, file, ImgID)
          EndIf
          
        Case #VK_ESCAPE
          Event = #PB_Event_CloseWindow 
      EndSelect
      
    ElseIf Event = #WM_MBUTTONDBLCLK Or Event = 515 
      rotate = 1
    EndIf
    
    
  Until Event = #PB_Event_CloseWindow 

  Puzzle_Create (#PB_Any, #PB_Any, #PB_Any, #PB_Any)
  
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  Puzze_Game(#PB_Any, #PB_Any)
CompilerEndIf
"Papa, mein Wecker funktioniert nicht! Der weckert immer zu früh."
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: Puzzle

Beitrag von ts-soft »

:allright:
Jetzt funktioniert auch das Beenden ordentlich, was aber leider nicht Crossplattform gelöst ist. Man kann eben nicht alles haben :wink:
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
True29
Beiträge: 283
Registriert: 18.08.2012 19:18
Computerausstattung: Windows 8 64bit .Profan x2,Purebasic 5.5
Wohnort: Worms
Kontaktdaten:

Re: Puzzle

Beitrag von True29 »

läuft gut . klappt nun alles so weit was ich testen konnte ;)
was du noch überarbeiten könntest ab einer gewissen anzahl von puzzle teilen wird unten rechts die anzeige überdeckt.
i7,12gb ram , Windows 10 ,Purebasic 5.50
Benutzeravatar
dige
Beiträge: 1182
Registriert: 08.09.2004 08:53

Re: Puzzle

Beitrag von dige »

Danke für die Rückmeldungen. :)

Das mit dem überdecken der Spielzeit ist durchaus gewollt..

Werde jetzt mit Pb2Web daraus ein Online Browser Spiel bauen :D

Ciao Dige
"Papa, mein Wecker funktioniert nicht! Der weckert immer zu früh."
Benutzeravatar
Pelagio
Beiträge: 423
Registriert: 11.11.2004 17:52
Computerausstattung: Intel Core i3-4170 CPU 3,70 GHz
8,00 GB Arbeitsspeicher
WIN 10 Pro 64 Bit Betriebssystem
Wohnort: Bremen

Re: Puzzle

Beitrag von Pelagio »

Hallo dige und alle anderen,

ich war so frei dein Puzzel meinen Bedürfnissen anzugleichen und insbesondere das Beenden des Puzzels zu vereinfachen.
Soweit ich Zeit habe werde ich auch weiterhin versuchen das Puzzel auszubauen.
Hier, dige, Deine abgeänderte Version:

Code: Alles auswählen

; Original by dige 10/2016
;~~~~~~~~~~~~~~~~~~~~~~~~~~

EnableExplicit

InitSprite()
InitMouse()

UsePNGImageDecoder()
UseJPEGImageDecoder()

;-{ Konstanten

Enumeration 
	#winID
	#picID
	#spriteID
	#curID = 24
	#keyESC
	#keySPACE
EndEnumeration

#PuzzleFile = "C:\Temp\Endurotraining-original-135.jpg"

;} Endkonstanten

;-{ Variablen

Structure _PUZZLE
	id.i
	x.i
	y.i
	z.i
	cr.i
	cx.i
	cy.i
	status.i
EndStructure

Global NewList gPuzzles._PUZZLE()
Global gW.i = 800
Global gH.i = 600
Global gTileSize.i = 180

;} EndVariablen

Procedure Puzzle_Z_Order ()
	Protected n.i

	SortStructuredList(gPuzzles(), #PB_Sort_Ascending, OffsetOf(_PUZZLE\z), TypeOf(_PUZZLE\z))
	ForEach gPuzzles()
		If (gPuzzles()\status=#True)
			gPuzzles()\z = #False
		Else
			n + 1
			gPuzzles()\z = n
		EndIf
	Next
EndProcedure 

Procedure Puzzle_Solved()
	Protected n.i, pResult.i

	ForEach gPuzzles()
		If (gPuzzles()\status=#True): n + 1: EndIf
	Next
	If (n=ListSize(gPuzzles()))
		pResult = #True
	EndIf
	ProcedureReturn pResult
EndProcedure

Procedure Puzzle_Home()
	Protected pResult = #False

	If (gPuzzles()\cr=#False)
		If (Abs(gPuzzles()\x-gPuzzles()\cx)<10) And (Abs(gPuzzles()\y - gPuzzles()\cy)<10)
			gPuzzles()\cx = gPuzzles()\x
			gPuzzles()\cy = gPuzzles()\y
		pResult = #True
		EndIf
	EndIf
	ProcedureReturn pResult
EndProcedure

Procedure DrawPuzzle(vBGR = #False)

	FlipBuffers()
	ClearScreen(RGB(42,42,42))
	If StartDrawing(ScreenOutput())
		If vBGR
			DrawAlphaImage(ImageID(#picID), 0, 0, 100)
		Else
			Box(25, 25, 760, 510, 0)
		EndIf
		DrawingMode(#PB_2DDrawing_Transparent)
		DrawText( 300, 560, "Little puzzle game idee by dige", #White )
		StopDrawing()
	EndIf 
	ForEach gPuzzles()
		With gPuzzles()
			RotateSprite(\id, \cr, #PB_Absolute)
			DisplayTransparentSprite(\id, \cx, \cy)
		EndWith
	Next
EndProcedure

Procedure CreatePuzzleTile (vSize.i, vImgID.i, vPattern.i, vSpriteID.i, vX.i, vY.i)
	Protected pImgID = CreateImage(#PB_Any, vSize, vSize, 32, #PB_Image_Transparent)
	Protected pPeak.i = (vSize * 15) / 100
	Protected pGap.i  = (vSize * 25) / 100
	Protected pLength.i = vSize - ( 2 * pPeak)

; Pattern: 1-tongue|2-groove Bits from upper to right to bottom to left
; Edge Tile upper left = 00011000 (groove right, tongue bottom)

	If StartVectorDrawing(ImageVectorOutput(pImgID))
;TranslateCoordinates(peak, peak)
		MovePathCursor(pPeak, pPeak)
; Check upper side (Cursor Upper Left)
		If (vPattern & %11)
			AddPathLine(pPeak + pLength/2-pGap/2, pPeak)
			If (vPattern & %1) ; tongue
				AddPathCurve(0, 0, vSize, 0,  pPeak+pLength/2+pGap/2, pPeak)    ; Tongue
			Else
				AddPathCurve(0, 2*pPeak, vSize, 2*pPeak,  pPeak+pLength/2+pGap/2, pPeak)    ; Groove
			EndIf
		EndIf 
		AddPathLine(vSize-pPeak, pPeak)
; Check right side (Cursor Upper Right)
		If (vPattern & %1100)
			AddPathLine(vSize-pPeak, pPeak+pLength/2-pGap/2)
			If (vPattern & %0100) ; tongue
				AddPathCurve(vSize, 0, vSize, vSize, vSize-pPeak, Ppeak+pLength/2+pGap/2)    ; Tongue
			Else
				AddPathCurve(pLength, 0, pLength, vSize, vSize-pPeak, pPeak+pLength/2+pGap/2)    ; Groove
			EndIf
		EndIf 
		AddPathLine(vSize-pPeak, vSize-pPeak)
; Check bottom side (Cursor bottom Right)
		If (vPattern & %110000)
			AddPathLine(pPeak+pLength/2+pGap/2, vSize-pPeak)
			If (vPattern & %010000) ; tongue
				AddPathCurve(vSize, vSize, 0, vSize, pPeak+pLength/2-pGap/2, vSize-pPeak)    ; Tongue
			Else
				AddPathCurve(vSize, vSize-2*pPeak, 0, vSize-2*pPeak, pPeak+pLength/2-pGap/2, vSize-pPeak)    ; Tongue
			EndIf
		EndIf 
		AddPathLine(pPeak, vSize-pPeak)
; Check left side (Cursor bottom left)
		If (vPattern & %11000000)
			AddPathLine(pPeak, pPeak+pLength/2+pGap/2)
			If (vPattern & %01000000) ; tongue
				AddPathCurve(0, vSize, 0, 0, pPeak, pPeak+pLength/2-pGap/2)
			Else
				AddPathCurve(2*pPeak, vSize, 2*pPeak, 0, pPeak, pPeak+pLength/2-pGap/2)
			EndIf
		EndIf 
		AddPathLine(pPeak, pPeak)
		ClosePath()
		VectorSourceImage(ImageID(vImgID), 255, ImageWidth(vImgID), ImageHeight(vImgID))
 ; Fill the tile shape with the image contents. keep the path
		FillPath(#PB_Path_Preserve)
; Select a solid color and draw the outline of the tile as well
		VectorSourceColor(RGBA(100, 100, 100, 255))   
		StrokePath(2)
		StopVectorDrawing()
	EndIf
	CreateSprite(vSpriteID, vSize, vSize, #PB_Sprite_AlphaBlending|#PB_Sprite_PixelCollision)
	If StartDrawing(SpriteOutput(vSpriteID))
		DrawingMode(#PB_2DDrawing_AlphaChannel)
		Box(0, 0, vSize, vSize, 128)
		DrawingMode(#PB_2DDrawing_AlphaBlend)
		DrawAlphaImage(ImageID(pImgID), 0, 0 )
		DrawText(50, 50, Str(vSpriteID))
		StopDrawing()
	EndIf
	AddElement( gPuzzles())
	With gPuzzles()
		\id = vSpriteID
		\x  = vX
		\y  = vY
		\cx = vX
		\cy = vY
		\cr = #False
	EndWith 
	FreeImage(pImgID)
	ProcedureReturn pLength
EndProcedure

Procedure WindowCreate()
	Protected pX.i, pY.i, pL.i

	If OpenWindow(#winID, 0, 0, gW, gH, "Puzzle Game - Start with SPACE key / End with ESC key", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
		If (LoadImage(#picID, #PuzzleFile)=#False)
			CreateImage(#picID, gW, gH)
			If StartDrawing(ImageOutput(#picID))
				DrawingMode(#PB_2DDrawing_Gradient)
				BackColor($00FFFF)
				FrontColor($FF0000)
				BoxedGradient(0, 0, OutputWidth(), OutputHeight())
				Box(0, 0, OutputWidth(), OutputHeight())
				StopDrawing()
			EndIf
		Else
			ResizeImage(#picID, gW, gH)
		EndIf
		AddKeyboardShortcut(#winID, #PB_Shortcut_Escape, #keyESC)
		AddKeyboardShortcut(#winID, #PB_Shortcut_Space , #keySPACE)
		OpenWindowedScreen(WindowID(#winID), 0, 0, gW, gH)
; First Row
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %00011000, 0, 0, 0)
		pX + pL
		GrabImage(#picID, 3, pX, 0, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %01100100, 1, 1*pL, 0)
		pX + pL

		GrabImage(#picID, 3, pX, 0, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %10011000, 2, 2*pL, 0)
		pX + pL

		GrabImage(#PicID, 3, pX, 0, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %01100100, 3, 3*pL, 0)
		pX + pL
		GrabImage(#PicID, 3, pX, 0, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %10011000, 4, 4*pL, 0)
		pX + pL
		GrabImage(#picID, 3, pX, 0, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %01100000, 5, 5*pL, 0)
; Second Row
		pX = 0
		pY + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %00100110, 6, 0, pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %10011001, 7, 1*pL, pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %01100110, 8, 2*pL, pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %10011001, 9, 3*pL, pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %01100110, 10, 4*pL, pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %10010001, 11, 5*pL, pL)
; Third Row
		pX = 0
		pY + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %00011001, 12, 0, 2*pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %01100110, 13, 1*pL, 2*pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %10011001, 14, 2*pL, 2*pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %01100110, 15, 3*pL, 2*pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %10011001, 16, 4*pL, 2*pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %01100010, 17, 5*pL, 2*pL)
; Last Row
		pX = 0
		pY + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %00000110, 18, 0, 3*pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %10001001, 19, 1*pL, 3*pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %01000110, 20, 2*pL, 3*pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %10001001, 21, 3*pL, 3*pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %01000110, 22, 4*pL, 3*pL)
		pX + pL
		GrabImage(#picID, 3, pX, pY, gTileSize, gTileSize)
		pL = CreatePuzzleTile (gTileSize, 3, %10000001, 23, 5*pL, 3*pL)
		DrawPuzzle(#True)
; Mouse Pointer
		CreateSprite(#curID, 16, 16, #PB_Sprite_PixelCollision|#PB_Sprite_AlphaBlending)
		If StartDrawing(SpriteOutput(#curID))
			DrawingMode(#PB_2DDrawing_AlphaChannel)
			Box(0,0,16,16,128)
			DrawingMode(#PB_2DDrawing_AlphaBlend)
			Circle(8, 8, 7, RGBA(255, 255, 255, 255))
			Circle(8, 8, 6, RGBA(100, 100, 100, 255))
			StopDrawing()
		EndIf
		Puzzle_Z_Order()
	EndIf
EndProcedure

Procedure Main()
	Protected n.i, a.i, b.i, c.i, pEvent.i, pDuration.i
	Protected pOffsetX.i, pOffsetY.i, pMove.i = #PB_Any

	WindowCreate()
	Repeat
		pEvent = WaitWindowEvent(10)
		If ExamineMouse()
			If MouseButton(#PB_MouseButton_Left) Or MouseButton(#PB_MouseButton_Right)
				If (pMove=#PB_Any)
					n = #PB_Any
; Find highest machting Sprite
					ForEach gPuzzles()
						With gPuzzles()
							If SpriteCollision(\id, \cx, \cy, #curID, MouseX(), MouseY())
								If SpritePixelCollision(\id, \cx, \cy, #curID, MouseX(), MouseY())
									n = ListIndex(gPuzzles())
								EndIf
							EndIf
						EndWith
					Next
					If (n<>#PB_Any)
						SelectElement(gPuzzles(), n)
 						If (gPuzzles()\status<>#True)
							gPuzzles()\z = 999
							If MouseButton(#PB_MouseButton_Right)
								b = gPuzzles()\cr
								c = b + 90
								For a=b To c Step 10
									SelectElement(gPuzzles(), n)
									gPuzzles()\cr = a
									DrawPuzzle(#False)
								Next
								gPuzzles()\cr = c
								If (gPuzzles()\cr>270): gPuzzles()\cr = #False: EndIf
							Else
								pMove = gPuzzles()\id
								pOffsetX = gPuzzles()\cx - MouseX()
								pOffsetY = gPuzzles()\cy - MouseY()
							EndIf
							Puzzle_Z_Order()
						EndIf
					EndIf
				Else
; Still moving..
					ForEach gPuzzles()
						If (pMove=gPuzzles()\id)
							gPuzzles()\cx = MouseX() + pOffsetX
							gPuzzles()\cy = MouseY() + pOffsetY
							Puzzle_Home()
							Break
						EndIf
					Next
				EndIf
			ElseIf (pMove<>#PB_Any)
; Moving finished
				ForEach gPuzzles()
					If (pMove=gPuzzles()\id)
						If Puzzle_Home()
							gPuzzles()\status = #True
							gPuzzles()\z      = #False
							Puzzle_Z_Order()
							Break
						EndIf
					EndIf
				Next
				pMove = #PB_Any
				pOffsetX = #False
				pOffsetY = #False
				If Puzzle_Solved()
					SetWindowTitle(0, "Start new game with Space Key") 
					MessageRequester( "Congratulations ! :-)", "Time: " + Str(Date() - pDuration) + " sec.")
				EndIf
			EndIf ; MouseButton(#PB_MouseButton_Left)
			DrawPuzzle(#False)
			DisplayTransparentSprite(#curID, MouseX(), MouseY())
		EndIf 
		If (pEvent=#PB_Event_Menu)
			Select EventMenu()
				Case #keyESC
					pEvent = #PB_Event_CloseWindow
				Case #keySPACE
					ForEach gPuzzles()
						With gPuzzles()
							Select Random(3)
								Case 0 : \cr = 0
								Case 1 : \cr = 90
								Case 2 : \cr = 180
								Case 3 : \cr = 270
							EndSelect
							\cx = Random(gW - gTileSize)
							\cy = Random(gH - gTileSize)
							\status = #False
						EndWith
					Next
					DrawPuzzle(#False)
					pDuration = Date()
					SetWindowTitle(0, "Game is running...")
			EndSelect
		EndIf
	Until (pEvent=#PB_Event_CloseWindow)
EndProcedure

Main()

End
Ich hoffe es bringt andere auch auf creative Ideen. :bounce:
Ohne Zeit kein Fleiß
Auf neustem Stand zu sein ist eine Kunst die nicht jeder perfektioniert [Win10Pro(64); PB6.03 LTS]. :allright:
Antworten