Aktuelle Zeit: 15.11.2018 10:24

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 15 Beiträge ]  Gehe zu Seite 1, 2  Nächste
Autor Nachricht
 Betreff des Beitrags: Puzzle
BeitragVerfasst: 13.10.2016 17:23 
Offline
Benutzeravatar

Registriert: 08.09.2004 08:53
Bild

Code:
; 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, ich laufe schneller, dann ist es nicht so weit."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Puzzle
BeitragVerfasst: 13.10.2016 17:35 
Offline
Benutzeravatar

Registriert: 08.09.2004 00:57
Wohnort: Berlin
:allright:
Gut gemacht, lediglich mit dem Beenden hatte ich Probleme, da Maus gefangen.

_________________
PureBasic 5.70 | SpiderBasic 2.10 | Windows 10 Pro (x64) | Linux Mint 19.0 (x64)
"Ich möchte gerne die Welt verändern, doch Gott gibt den Quellcode nicht frei."
Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Puzzle
BeitragVerfasst: 14.10.2016 00:07 
Offline
Moderator
Benutzeravatar

Registriert: 05.10.2006 18:55
Wohnort: Rupture Farms
Sieht gut aus und funktioniert. :allright:

_________________
BildBildBildBildBild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Puzzle
BeitragVerfasst: 14.10.2016 11:16 
Offline
Benutzeravatar

Registriert: 21.08.2006 17:39
moinsen,

Zitat:
... 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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Puzzle
BeitragVerfasst: 20.10.2016 21:14 
Offline

Registriert: 18.08.2012 19:18
Wohnort: Worms
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Puzzle
BeitragVerfasst: 21.10.2016 10:37 
Offline
Benutzeravatar

Registriert: 08.09.2004 08:53
Code:
; 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, ich laufe schneller, dann ist es nicht so weit."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Puzzle
BeitragVerfasst: 21.10.2016 11:49 
Offline
Benutzeravatar

Registriert: 08.09.2004 00:57
Wohnort: Berlin
:allright:
Jetzt funktioniert auch das Beenden ordentlich, was aber leider nicht Crossplattform gelöst ist. Man kann eben nicht alles haben :wink:

_________________
PureBasic 5.70 | SpiderBasic 2.10 | Windows 10 Pro (x64) | Linux Mint 19.0 (x64)
"Ich möchte gerne die Welt verändern, doch Gott gibt den Quellcode nicht frei."
Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Puzzle
BeitragVerfasst: 21.10.2016 11:59 
Offline

Registriert: 18.08.2012 19:18
Wohnort: Worms
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Puzzle
BeitragVerfasst: 21.10.2016 12:35 
Offline
Benutzeravatar

Registriert: 08.09.2004 08:53
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, ich laufe schneller, dann ist es nicht so weit."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Puzzle
BeitragVerfasst: 21.10.2016 15:04 
Offline
Benutzeravatar

Registriert: 11.11.2004 17:52
Wohnort: Bremen
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:
; 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); PB5.62].


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 15 Beiträge ]  Gehe zu Seite 1, 2  Nächste

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye