;{- Declares
Declare WindowCallback(WindowID.l, EventID.l, wParam.l, lParam.l)
Declare CancelAll(Param.l)
Declare.s EndField(MaxRekursion.l)
Declare DeCodeEndField(Erg.s)
Declare ConvertString2Field(Field.s)
Declare.s ConvertField2String()
Declare TestField()
Declare GetModus()
Declare RandomField(Max.l)
Declare UpdateField()
Declare TurnIt(Zeile.l, LR.l)
Declare SwitchIt(Modus.l)
Declare GenerateField()
Declare SetBall(Ball.l, RGB.l)
Declare GenerateBalls()
Declare.s ConvertColor2Field(Field.s)
;}

; -----   -----   -----
; | B |   | S |   | O |  0 (Modus)  B = Blau        RGB(0, 0, 255)      0
; ---------------------             Y = Gelb        RGB(255, 255, 0)    1
; | Y | Y | G | R | O |             O = Orange      RGB(255, 127, 0)    2
; ---------------------             S = Schwarz     RGB(100, 100, 100)  3
; | O | O | Y | R | B |             G = Grün        RGB(0, 255, 0)      4
; ---------------------             R = Rot         RGB(255, 0, 0)      5
; | S | S | G | R | B |
; ---------------------
; | G | G | B | R | Y |
; ---------------------
; |   |   |   |   |   |  1 (Modus)
; -----   -----   -----

;{- Constants, Globals & Structures
#BallXL = 30
#BallYL = 30
#BallR = 10
#TrennL = 5
#FieldID = 0

#BallImageOffset = 1
#FieldImageID = 0

Global ImageWidth.l, ImageHeight.l
ImageWidth = #BallXL * 5 + #TrennL * 6
ImageHeight = #BallYL * 6 + #TrennL * 7

Global Cancel.l, Progress.l
Cancel = #False
Progress = #False

Structure Ball
  ImageID.l
  RGB.l
EndStructure
Dim Ball.Ball(6)
Dim Field.b(25)

Structure Loesung
  Field.s
  Erg.s
EndStructure
NewList Loesung.Loesung()
Global LoesungFile.s
LoesungFile = "C:\Programme\PureBasic\Programme\Projekte\Nintendo WonderCylinder\Loesungen.txt"
;}

Field.s
Field = "30000 111132222 444435555 "
;Field = " 000031111 222234444 55553"
;Field = ConvertColor2Field("boyyb sobsogsoy rrrrygggb ")
;Field = ConvertColor2Field("gggos bbgoobbso yyyyrrrsr ")

;{- Lösungen
Procedure ReadLoesung()
  Protected Zeile.s
  ClearList(Loesung())
  If ReadFile(0, LoesungFile)
    While Eof(0) = 0
      Zeile = ReadString()
      AddElement(Loesung())
      Loesung()\Field = Left(Zeile, 26)
      Loesung()\Erg = Mid(Zeile, 27, Len(Zeile) - 26)
    Wend
    CloseFile(0)
  EndIf
EndProcedure

Procedure WriteLoesung()
  ResetList(Loesung())
  If CreateFile(0, LoesungFile)
    While NextElement(Loesung())
      WriteStringN(Loesung()\Field + Loesung()\Erg)
    Wend
    CloseFile(0)
  EndIf
EndProcedure

Procedure AddLoesung(Field.s, Erg.s)
  Protected OK.l
  
  ResetList(Loesung())
  While NextElement(Loesung())
    If Loesung()\Field = Field
      If Len(Loesung()\Erg) > Len(Erg)
        Loesung()\Erg = Erg
        OK = #True
      EndIf
    EndIf
  Wend
  
  If OK = 0
    AddElement(Loesung())
    Loesung()\Field = Field
    Loesung()\Erg = Erg
  EndIf
EndProcedure

Procedure.s SearchLoesung(Field.s)
  ResetList(Loesung())
  While NextElement(Loesung())
    If Loesung()\Field = Field
      ;ProcedureReturn Loesung()\Erg
    EndIf
  Wend
  ProcedureReturn ""
EndProcedure
;}


;{- Init & Converts
Procedure.s ConvertColor2Field(Field.s)
  Protected a.l, Erg.s, z.s
  Field = UCase(Field)
  For a = 1 To Len(Field)
    z = Mid(Field, a, 1)
    Select z
      Case "B" : Erg = Erg + "0"
      Case "S" : Erg = Erg + "3"
      Case "Y" : Erg = Erg + "1"
      Case "G" : Erg = Erg + "4"
      Case "O" : Erg = Erg + "2"
      Case "R" : Erg = Erg + "5"
      Default : Erg = Erg + z
    EndSelect
  Next
  ProcedureReturn Erg
EndProcedure

Procedure GenerateBalls()
  Protected c.l
  For c = 0 To 6
    If CreateImage(Ball(c)\ImageID, #BallXL, #BallYL)
      StartDrawing(ImageOutput())
        Circle(#BallXL / 2, #BallYL / 2, #BallR, Ball(c)\RGB)
      StopDrawing()
    Else
      ProcedureReturn #False
    EndIf
  Next
  ProcedureReturn #True
EndProcedure

Procedure SetBall(Ball.l, RGB.l)
  Ball(Ball)\ImageID = Ball + #BallImageOffset
  Ball(Ball)\RGB = RGB
EndProcedure

Procedure GenerateField()
  Protected a.l, b.l, x.l, y.l, BallX.l, BallY.l, Tmp1.l, Tmp2.l
  Restore FieldPositions
  CreateImage(#FieldImageID, ImageWidth, ImageHeight)
  StartDrawing(ImageOutput())
    Tmp1 = #BallXL + #TrennL
    For a = 0 To 5
      Box(a * Tmp1, 0, #TrennL, ImageHeight, RGB(127, 127, 127))
    Next
    Tmp2 = #BallYL + #TrennL
    For a = 0 To 6
      If a = 0 Or a = 6
        For b = 0 To 2
          Box(b * Tmp1 * 2, a * Tmp2, Tmp1, #TrennL, RGB(127, 127, 127))
        Next
      Else
        Box(0, a * Tmp2, ImageWidth, #TrennL, RGB(127, 127, 127))
      EndIf
    Next
    
    For a = 0 To 25
      Read x
      Read y
      BallX = x * #BallXL + ((x + 1) * #TrennL)
      BallY = y * #BallYL + ((y + 1) * #TrennL)
      DrawImage(UseImage(Ball(Field(a))\ImageID), BallX, BallY)
    Next
  StopDrawing()
  DataSection
    FieldPositions:
     Data.l 0, 0, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5
     Data.l 1, 1, 1, 2, 1, 3, 1, 4
     Data.l 2, 0, 2, 1, 2, 2, 2, 3, 2, 4, 2, 5
     Data.l 3, 1, 3, 2, 3, 3, 3, 4
     Data.l 4, 0, 4, 1, 4, 2, 4, 3, 4, 4, 4, 5
  EndDataSection
EndProcedure

Procedure UpdateField()
  GenerateField()
  SetGadgetState(0, UseImage(#FieldImageID))
  While WindowEvent() : Wend
EndProcedure
;}


;{- Movement & Test
Procedure SwitchIt(Modus.l)
  Protected a.l
  If Modus = 0
    For a = 5 To 0 Step -1
      If a
        Field(a) = Field(a - 1)
        Field(a + 10) = Field(a + 9)
        Field(a + 20) = Field(a + 19)
      Else
        Field(a) = 0
        Field(a + 10) = 0
        Field(a + 20) = 0
      EndIf
    Next
    ProcedureReturn 1
  ElseIf Modus = 1
    For a = 0 To 5
      If a < 5
        Field(a) = Field(a + 1)
        Field(a + 10) = Field(a + 11)
        Field(a + 20) = Field(a + 21)
      Else
        Field(a) = 0
        Field(a + 10) = 0
        Field(a + 20) = 0
      EndIf
    Next
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure TurnIt(Zeile.l, LR.l)
  Protected Offset.l, Tmp.l, a.l
  Offset = Zeile + 1
  
  If LR = -1
    Tmp = Field(Offset)
    For a = 0 To 3
      Field(Offset + a * 5) = Field(Offset + (a + 1) * 5)
    Next
    ;a = 4
    Field(Offset + a * 5) = Tmp
  ElseIf LR = 1
    Tmp = Field(Offset + 4 * 5)
    For a = 3 To 0 Step -1
      Field(Offset + (a + 1) * 5) = Field(Offset + a * 5)
    Next
    Field(Offset) = Tmp
  EndIf
EndProcedure

Procedure RandomField(Max.l)
  Protected a.l, RND.l, RND_Old.l
  Shared Modus
  For a = 1 To Max
    If RND_Old => 4
      RND = Random(3)
    Else
      If RND_Old & 1
        RND_Old - 1
      Else
        RND_Old + 1
      EndIf
      Repeat : RND = Random(6) : Until RND <> RND_Old
    EndIf
    Select RND
      Case 0
        TurnIt(0, -1)
        TurnIt(1, -1)
      Case 1
        TurnIt(0, 1)
        TurnIt(1, 1)
      Case 2
        TurnIt(2, -1)
        TurnIt(3, -1)
      Case 3
        TurnIt(2, 1)
        TurnIt(3, 1)
      Default
        Modus = SwitchIt(Modus)
    EndSelect
    RND_Old = RND
  Next
EndProcedure

Procedure TestField()
  Protected a.l, b.l, Tmp.l, OK.l, Fertig.l
  Fertig = 5
  
  For a = 0 To 4
    OK = #False
    Tmp = Field(a * 5 + 1)
    For b = a * 5 + 2 To a * 5 + 4
      If Field(b) <> Tmp
        OK = #True
      EndIf
    Next
    If OK : Fertig - 1 : EndIf
  Next
  ProcedureReturn Field
EndProcedure
;}


;{- Status & Converts
Procedure GetModus()
  Protected Modus.l
  If Field(5) And Field(15) And Field(25)
    Modus = 1
  ElseIf Field(0) And Field(10) And Field(20)
    Modus = 0
  EndIf
  ProcedureReturn Modus
EndProcedure

Procedure.s ConvertField2String()
  Protected a.l, Field.s
  Field = ""
  For a = 0 To 25
    If Field(a) = 0
      Field = Field + " "
    Else
      Field = Field + Str(Field(a) - 1)
    EndIf
  Next
  ProcedureReturn Field
EndProcedure

Procedure ConvertString2Field(Field.s)
  Protected a.l, z.s
  For a = 1 To 26
    z = Mid(Field, a, 1)
    If z = " "
      Field(a - 1) = 0
    Else
      Field(a - 1) = Val(z) + 1
    EndIf
  Next
EndProcedure

;1 = Turn01_1
;2 = Turn01_-1
;3 = Turn23_1
;4 = Turn23_-1
;5 = Switch
Procedure DeCodeEndField(Erg.s)
  Protected a.l, DeCode.s
  
  DeCode = ""
  For a = 1 To Len(Erg)
    Select Val(Mid(Erg, a, 1))
      Case 1
        DeCode = DeCode + "Oben rechts"
      Case 2
        DeCode = DeCode + "Oben links"
      Case 3
        DeCode = DeCode + "Unten rechts"
      Case 4
        DeCode = DeCode + "Unten links"
      Case 5
        DeCode = DeCode + "Oben <-> Unten"
    EndSelect
    DeCode = DeCode + "," + Chr(13) + Chr(10)
  Next
EndProcedure
;}


;{- Berechnung
Procedure.s EndField(MaxRekursion.l)
  Protected *p.BYTE, MemID.l, TmpField.s, OK.l, TmpB.b, SavedErg.s, Erg.s, a.l, TmpModus.l, TestF.l
  Protected Status.l, time.l, MaxRounds.l, Rounds.l
  
  Shared Modus
  Progress = #True
  
  MemID = GlobalAlloc_(#GPTR, MaxRekursion + 1)
  TmpField = ConvertField2String()
  
  SavedErg = SearchLoesung(TmpField)
  If SavedErg <> ""
    AddGadgetItem(1, -1, "Saved Field...")
    Erg = SavedErg
    Goto EndFieldEnde
  EndIf
  
  #Optimiert = 2
  *p = MemID
  *p\b = 1
  
  Status = 0
  time = GetTickCount_()
  
  Rounds = 0 : MaxRounds = 1

  Repeat

    *p = MemID
    Rounds + 1

    Repeat
      If *p\b > 5
        *p\b = 1
        
        *p + 1
        
        *p\b + 1
        If *p - MemID > Status
          Status = *p - MemID
          time = GetTickCount_() - time
          AddGadgetItem(1, -1, "Status: " + Str(Status) + "/" + Str(MaxRekursion) + " Time: " + Str(time) + " ms")
          time = GetTickCount_()

          MaxRounds = 1 : For a = 1 To Status : MaxRounds * 3 : Next
          ;AddGadgetItem(1, -1, "MaxRounds: " + Str(MaxRounds) + " Rounds: " + Str(Rounds))
          Rounds = 0
        EndIf
      Else
        *p + 1
      EndIf
    Until *p >= MemID + MaxRekursion
    
          SetGadgetState(2, Rounds * 100 / MaxRounds)
          While WindowEvent() : Wend

    CompilerIf #Optimiert
      *p = MemID
      Repeat
        
        ;Optimierung 1
        Select *p\b
          Case 5
            *p + 1
            If *p\b = 5 : *p\b = 6 : EndIf
          Case 1
            *p + 1
            If *p\b = 2
              *p - 1
              *p\b = 2
            Else
              *p - 1
            EndIf
          Case 2
            *p + 1
            If *p\b = 1
              *p - 1
              *p\b = 3
            Else
              *p - 1
            EndIf
          Case 3
            *p + 1
            If *p\b = 4
              *p - 1
              *p\b = 4
            Else
              *p - 1
            EndIf
          Case 4
            *p + 1
            If *p\b = 3
              *p - 1
              *p\b = 5
            Else
              *p - 1
            EndIf
        EndSelect
        
        ;Optimierung 2
        CompilerIf #Optimiert >= 2
          If *p\b And *p\b < 5 And #Optimiert >= 2
            OK = #True
            a = *p
            TmpB = *p\b
            For *p = a + 1 To a + 2
              If TmpB <> *p\b : OK = #False : EndIf
            Next
            
            If OK
              *p = a
              Select TmpB
                Case 1
                  *p\b = 3
                  *p + 1 : *p\b = 2
                  *p + 1 : *p\b = 2
                Case 2
                  *p\b = 0
                  *p + 1 : *p\b = 1
                  *p + 1 : *p\b = 1
                Case 3
                  *p\b = 5
                  *p + 1 : *p\b = 4
                  *p + 1 : *p\b = 4
                Case 4
                  *p\b = 2
                  *p + 1 : *p\b = 3
                  *p + 1 : *p\b = 3
              EndSelect
            EndIf
            *p = a + 1
          Else
            *p + 1
          EndIf
        CompilerElse
          *p + 1
        CompilerEndIf
        
      Until *p >= MemID + MaxRekursion
    CompilerEndIf
    
    While WindowEvent() : Wend
    
    ConvertString2Field(TmpField)
    TmpModus = Modus
    
    *p = MemID
    OK = #False
    
    Repeat
      Select *p\b
        Case 1
          TurnIt(0, 1)
          TurnIt(1, 1)
        Case 2
          TurnIt(0, -1)
          TurnIt(1, -1)
        Case 3
          TurnIt(2, 1)
          TurnIt(3, 1)
        Case 4
          TurnIt(2, -1)
          TurnIt(3, -1)
        Case 5
          TmpModus = SwitchIt(TmpModus)
      EndSelect

      TestF = TestField()
      If TestF = 5
        OK = #True
      ElseIf TestF
        AddGadgetItem(1, -1, "Richtige Spalten: " + Str(TestF))
      Else
        *p + 1
      EndIf
    Until OK Or *p\b = 0
    
    SavedErg = SearchLoesung(ConvertField2String())
    If OK Or SavedErg <> ""
      For *p = MemID To MemID + MaxRekursion - 1
        If *p\b And *p\b < 6
          Erg = Erg + Str(*p\b)
        EndIf
      Next
      Erg = Erg + SavedErg
      
      AddLoesung(TmpField, Erg)
      
      Goto EndFieldEnde
    EndIf
    
    *p = MemID : *p\b + 1
    *p = MemID + MaxRekursion - 1
  Until *p\b = 5 Or Cancel
  Erg = "No Result"
  
  EndFieldEnde:
  Progress = #False
  SetGadgetState(2, 0)
  ConvertString2Field(TmpField)
  Modus = GetModus()
  UpdateField()
  ProcedureReturn Erg
EndProcedure
;}

;{- Controls & Callbacks
Procedure CancelAll(Param.l)
  Cancel = #True
  While Progress : Delay(1) : Wend
  Cancel = #False
EndProcedure

Procedure WindowCallback(WindowID.l, EventID.l, wParam.l, lParam.l)
  Protected Result.l
  Shared Modus, Field
  
  Result = #PB_ProcessPureBasicEvents
  
  Select EventID
    Case #WM_LBUTTONDOWN
      ReleaseCapture_()
      SendMessage_(WindowID, #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
    Case #WM_KEYDOWN
      Select wParam
        Case #VK_ESCAPE
          If Progress
            CreateThread(@CancelAll(), 0)
          Else
            WriteLoesung()
            End
          EndIf
        Case #VK_NUMPAD4  ;oben nach links
          TurnIt(0, -1)
          TurnIt(1, -1)
          UpdateField()
        Case #VK_NUMPAD6  ;oben nach rechts
          TurnIt(0, 1)
          TurnIt(1, 1)
           UpdateField()
        Case #VK_NUMPAD1  ;unten nach links
          TurnIt(2, -1)
          TurnIt(3, -1)
          UpdateField()
        Case #VK_NUMPAD3  ;unten nach rechts
          TurnIt(2, 1)
          TurnIt(3, 1)
          UpdateField()
        Case #VK_NUMPAD5  ;nach oben
          If Modus = 1
            Modus = SwitchIt(Modus)
            UpdateField()
          EndIf
        Case #VK_NUMPAD2  ;nach unten
          If Modus = 0
            Modus = SwitchIt(Modus)
            UpdateField()
          EndIf
        Case #VK_NUMPAD7  ;vermischen
          RandomField(3)
          UpdateField()
        Case #VK_NUMPAD8  ;suchen
          ClearGadgetItemList(1)
          If TestField() = #False
            time.l = GetTickCount_()
            TmpS.s = EndField(100)
            time = GetTickCount_() - time
            AddGadgetItem(1, -1, "Time: " + Str(time) + " ms")
            AddGadgetItem(1, -1, TmpS)
            If CreateFile(0, "f:\Lösung" + RSet(Str(Random(9999)), 4, "0") + ".txt")
              WriteStringN(TmpS)
            EndIf
          EndIf
        Case #VK_NUMPAD9  ;zurücksetzen
          ConvertString2Field(Field)
          Modus = GetModus()
          UpdateField()
      EndSelect
  EndSelect
  ProcedureReturn Result
EndProcedure
;}

;{- Initialize

SetBall(0, RGB( 50,  50,  50))
SetBall(1, RGB(  0,   0, 255))
SetBall(2, RGB(255, 255,   0))
SetBall(3, RGB(255, 127,   0))
SetBall(4, RGB(100, 100, 100))
SetBall(5, RGB(  0, 192,   0))
SetBall(6, RGB(255,   0,   0))
GenerateBalls()

ReadLoesung()

ConvertString2Field(Field)
Modus = GetModus()
;}

#LVWidth = 300
#BsWidth = 100
#PBHeight = 15
If OpenWindow(0, 0, 0, ImageWidth + #LVWidth + #BsWidth, ImageHeight, #PB_Window_ScreenCentered | #PB_Window_BorderLess, "WonderCylinder")
  SetWindowCallback(@WindowCallback())
  
  If CreateGadgetList(WindowID())
    ImageGadget(0, 0, 0, ImageWidth, ImageHeight, 0)
    ListViewGadget(1, ImageWidth, 0, #LVWidth, ImageHeight - #PBHeight)
    ProgressBarGadget(2, ImageWidth, ImageHeight - #PBHeight, #LVWidth, #PBHeight, 0, #LVWidth, #PB_ProgressBar_Smooth)
  EndIf
  UpdateField()
  
  Repeat
;     RandomField(10)
;     UpdateField()
;     EndField(10)
;     
;     WaitTime.l = GetTickCount_() + 1000
;     While GetTickCount_() < WaitTime
;       While WindowEvent() : Wend
;     Wend
;     ClearGadgetItemList(1)
;     WriteLoesung()
    WaitWindowEvent()
  ForEver
EndIf
; jaPBe Version=1.4.1.31
; FoldLines=00000011002100410049007F004A0000005800000062000000760000008200D3
; FoldLines=008300000095000000A3000000A8000000CE000000D6013C00D7000000F60000
; FoldLines=010A0000012C0000013F017C01400000014A00000157000001680000017F024C
; FoldLines=01800000024F0253029B02AA
; Build=1
; FirstLine=25
; CursorPosition=613
; ExecutableFormat=Windows
; Executable=C:\Programme\PureBasic\Programme\Projekte\Nintendo WonderCylinder\WonderCylinder.exe
; SaveDeclare
; EOF