PureBoard

Code: Alles auswählen

; ------------------------------------------------------------------------------------
; Sudoku Solver
; Author: Alexander Aigner
; ------------------------------------------------------------------------------------

EnableExplicit

Structure SudEntry
  Element.i
  Available.b[9]
EndStructure

Global Dim Sudoku.SudEntry(8, 8)
Define Clear, Solve, Event, Main, r, c, w, h, d, bd, x1, y1, x2, y2, ox

Procedure ClearAvailable()
  Protected c, r, a
  For r = 0 To 8
    For c = 0 To 8
      For a = 0 To 8
        Sudoku(c, r)\Available[a] = #False
      Next
    Next
  Next
EndProcedure

Procedure NewSudoku()
  Protected c, r, a
  For r = 0 To 8
    For c = 0 To 8
      SetGadgetText(Sudoku(c, r)\Element, "")
    Next
  Next
EndProcedure

Procedure SolveSudoku()
  Protected s, c, r, a, val, Empty, Change
  Protected b1, b2, b3, b4, bs1, bs2, c2, r2
  Protected nbAvailable, lAvailable
  ClearAvailable() ; Mal alles platt machen
  
  Empty = #True
  Change = #True
  
  ; Solange noch was frei ist oder sich was ändert
  While Change And Empty
    Empty = #False
    Change = #False
    
    ; Reihen & Spalten abklappern
    For r = 0 To 8
      For c = 0 To 8
        Val = Val(GetGadgetText(Sudoku(c, r)\Element))
        If Val
          ; Nicht mehr mögliche streichen
          For s = 0 To 8
            If s<>r
              Sudoku(c, s)\Available[Val-1] = #True
            EndIf
            If s<>c
              Sudoku(s, r)\Available[Val-1] = #True
            EndIf
          Next
        Else
          Empty = #True ; Noch was frei
        EndIf
      Next
    Next
    
    ; Blöcke abklappern
    For b1 = 0 To 2
      For b2 = 0 To 2
        For b3 = 0 To 2
          For b4 = 0 To 2
            r = b1*3 + b3
            c = b2*3 + b4
            Val = Val(GetGadgetText(Sudoku(c, r)\Element))
            If Val
              ; Nicht mehr mögliche streichen
              For bs1 = 0 To 2
                For bs2 = 0 To 2
                  r2 = b1*3 + bs1
                  c2 = b2*3 + bs2
                  If r<>r2 And c<>c2
                    Sudoku(c2, r2)\Available[Val-1] = #True
                  EndIf
                Next
              Next
            Else
              Empty = #True ; Noch was frei
            EndIf
          Next
        Next
      Next
    Next
    
    ; Checken
    For r = 0 To 8
      For c = 0 To 8
        nbAvailable = 9
        For a = 0 To 8
          If Sudoku(c, r)\Available[a]
            nbAvailable-1
          Else
            lAvailable = a + 1
          EndIf
        Next
        If nbAvailable = 1 ; Eindeutige Lösung!
          If Not GetGadgetText(Sudoku(c, r)\Element)
            SetGadgetText(Sudoku(c, r)\Element, Str(lAvailable))
            Change = #True
          EndIf
        ElseIf Not nbAvailable ; FEHLER!
          Change = #True
          Empty = #False
          Break 3
        EndIf
      Next
    Next
  Wend
  
  ; Meldungen
  If (Change = #False) And (Empty = #False)
    MessageRequester("Gelöst", "Sudoku wurde gelöst")
  ElseIf (Change = #False) And (Empty = #True)
    MessageRequester("Nicht eindeutig", "Sudoku nicht eindeutig lösbar, bitte geben sie eine weitere Zahl ein")
  ElseIf (Change = #True) And (Empty = #False)
    MessageRequester("Fehler", "Es ist ein Fehler im Sudoku")
  EndIf
  
EndProcedure





; X - Position
x1 = 5
; Y - Position
y1 = 5
; Breite 1. Eingabe
w = 20
; Höhe 1. Eingabe
h = 20
; Abstand zwischen den Eingaben
d = 5
; Abstand zwischen den Blöcken
bd = 15

ox = x1

Main = OpenWindow(#PB_Any, 0, 0, 250, 310, "Sudoku - Solver", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_Invisible)
Solve = ButtonGadget(#PB_Any, 5, 260, 240, 20, "Lösen")
Clear = ButtonGadget(#PB_Any, 5, 285, 240, 20, "Neues Sudoku")

; SudokuFeld zeichnen
For r = 0 To 8
  If Not r%3 And r
    y1 + (bd-d)
  EndIf
  x1 = ox
  For c = 0 To 8
    If Not c%3 And c
      x1 + (bd-d)
    EndIf
    x2 = x1 + c*(w + d)
    y2 = y1 + r*(h + d)
    Sudoku(c, r)\Element = StringGadget(#PB_Any, x2, y2, w, h, "", #PB_String_Numeric|#PB_Text_Center)
    SendMessage_(GadgetID(Sudoku(c, r)\Element), #EM_LIMITTEXT, 1, 0) ; Zeichenanzahl begrenzen
  Next
Next

HideWindow(Main, #Null)

Repeat
  Event = WaitWindowEvent()
  Select Event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case Clear
          NewSudoku()
        Case Solve
          SolveSudoku()
      EndSelect
  EndSelect
Until Event = #PB_Event_CloseWindow