Журнал о программированнии на языках Blitz3D, BlitzPlus, BlitzMax

BlitzMax-код:SudokuSolver.bmx

Материал из Blitz Et Cetera

Перейти к: навигация, поиск
Framework brl.d3d7max2d

Import brl.freetypefont

SuperStrict

Type LTFinished
        Field N:Int, M:Int
End Type

Type LTBackup
        Field N:Int, M:Int
        Field Guess:Int
End Type

Type LTBackupChoice
        Field N:Int, M:Int
        Field Guesses:Int[]
        Field Choice:Int
End Type

Global GameField:Int[,] = New Int[ 9, 9 ]
Global Guess:Int[,,] = New Int[ 9, 9, 9 ]
Global FinishedQuantity:Int = 0
Global Faults:Int = 0

Global Font:TImageFont[] = New TImageFont[ 2 ]
Font[ 0 ] = LoadImageFont( ".\arial.ttf", 51 )
Font[ 1 ] = LoadImageFont( ".\arial.ttf", 17 )

Graphics 800, 600

Global FinishedStack:TList = New TList
Global UndoStack:TList

SetImageFont( Font[ 1 ] )
DrawText( "Do you want to use stored puzzle (y/n)?", 0, 0 )
Flip
Local UseStored:Int = 0

Repeat
        If KeyHit( KEY_N ) Then Exit
        If KeyHit( KEY_Y ) Then
                UseStored = 1
                Exit
        End If
Forever

For Local M:Int = 0 Until 9
        For Local N:Int = 0 Until 9
                Local V:Int = 0
                If UseStored Then ReadData V
               
                If V Then
                        Guess[ N, M, V - 1 ] = 1
                        GameField[ N, M ] = -1
                        AddFinished( N, M )
                Else
                        GameField[ N, M ] = -9
                        For Local K:Int = 0 Until 9
                                Guess[ N, M, K ] = 1
                        Next
                End If
        Next
Next

DefData  0, 0, 0,   0, 8, 0,   0, 0, 0
DefData  9, 0, 0,   0, 6, 0,   0, 3, 1
DefData  0, 0, 0,   2, 0, 1,   0, 0, 7

DefData  0, 6, 0,   0, 0, 0,   0, 2, 0
DefData  7, 3, 0,   5, 0, 0,   9, 8, 0
DefData  1, 0, 0,   0, 0, 2,   0, 0, 0

DefData  0, 0, 8,   0, 0, 0,   0, 0, 0
DefData  0, 0, 0,   7, 2, 5,   0, 0, 0
DefData  0, 0, 0,   0, 0, 8,   3, 1, 0

Repeat
        Draw()

        Local Finished:LTFinished = LTFinished( FinishedStack.First() )
        If Finished Then
                If GameField[ Finished.N, Finished.M ] <> -1 Then
                        Faults :+ 1
                        RollBackup()
                        Continue
                End If

                Local N:Int = Finished.N
                Local M:Int = Finished.M
               
                Local Variant:Int = -1
                For Local K:Int = 0 Until 9
                        If Guess[ N, M, K ] Then
                                Variant = K
                                Exit
                        End If
                Next
               
                Local QuadrantN:Int = Floor( N / 3 ) * 3
                Local QuadrantM:Int = Floor( M / 3 ) * 3
                For Local K:Int = 0 Until 9
                        RemoveVariant( K, M, Variant )
                        RemoveVariant( N, K, Variant )
                        RemoveVariant( QuadrantN + ( K Mod 3 ), QuadrantM + Floor( K / 3 ), Variant )
                Next
                GameField[ N, M ] = Variant + 1
                'Waitkey
                FinishedQuantity :+ 1
               
                If FinishedQuantity = 81 Then
                        Draw()
                        WaitKey
                        End
                End If
               
                FinishedStack.RemoveFirst()
        Else
                Local MinN:Int = 0
                Local MinM:Int = 0
                Local MinQ:Int = 9

                For Local N:Int = 0 Until 9
                        For Local M:Int = 0 Until 9
                                If GameField[ N, M ] < 0 Then
                                        Local Quantity:Int = 0
                                        For Local K:Int = 0 Until 9
                                                If Guess[ N, M, K ] Then Quantity :+ 1
                                        Next
                                        If Quantity < MinQ Then
                                                MinQ = Quantity
                                                MinN = N
                                                MinM = M
                                        End If
                                End If
                        Next
                Next
               
                If Not UndoStack Then UndoStack = New TList
                Local BackupChoice:LTBackupChoice = New LTBackupChoice
                BackupChoice.N = MinN
                BackupChoice.M = MinM
                BackupChoice.Guesses = New Int[ 9 ]
                UndoStack.AddFirst( BackupChoice )
               
                Local Variant:Int =  -1
                For Local K:Int = 0 Until 9
                        BackupChoice.Guesses[ K ] = Guess[ MinN, MinM, K ]
                        If Guess[ MinN, MinM, K ] And Variant = -1 Then
                                Variant = K
                        Else
                                Guess[ MinN, MinM, K ] = 0
                        End If
                Next
               
                AddFinished( MinN, MinM )
                GameField[ MinN, MinM ] = -1
                BackupChoice.Choice = Variant
               
                Draw()
        End If
       
        Flip
       
Until KeyHit( KEY_ESCAPE )



Function CenterText( Text:String, X:Int, Y:Int, Font:TImageFont )
        SetImageFont( Font )
        DrawText( Text, X - TextWidth( Text ) / 2, Y - TextHeight( Text ) / 2 )
End Function



Function RemoveVariant( N:Int, M:Int, Variant:Int )
        If Guess[ N, M, Variant ] Then
                GameField[ N, M ] :+ 1
                Guess[ N, M, Variant ] = 0
                If GameField[ N, M ] = -1 Then AddFinished( N, M )
               
                If UndoStack Then
                        Local Backup:LTBackup = New LTBackup
                        Backup.N = N
                        Backup.M = M
                        Backup.Guess = Variant
                        UndoStack.AddFirst( Backup )
                End If
        End If
End Function



Function RollBackup()
        If Not UndoStack Then RuntimeError( "This board has no solution!" )
        If UndoStack.Count() = 0 Then RuntimeError( "This board has no solution!" )
        Repeat
                Local Backup:LTBackup = LTBackup( UndoStack.First() )
                If Backup Then
                        If GameField[ Backup.N, Backup.M ] > 0 Then
                                FinishedQuantity :- 1
                                GameField[ Backup.N, Backup.M ] = 0
                        End If
                        GameField[ Backup.N, Backup.M ] :- 1
                        Guess[ Backup.N, Backup.M, Backup.Guess ] = 1
                        UndoStack.RemoveFirst()
                        Draw()
                Else
                        Local BackupChoice:LTBackupChoice = LTBackupChoice( UndoStack.First() )

                        Local N:Int = BackupChoice.N
                        Local M:Int = BackupChoice.M
                        Guess[ N, M, BackupChoice.Choice ] = 0
                       
                        For Local K:Int = BackupChoice.Choice + 1 Until 9
                                If BackupChoice.Guesses[ K ] Then
                                        GameField[ N, M ] = -1
                                        Guess[ N, M, K ] = 1
                                        BackupChoice.Choice = K
                                        FinishedStack.Clear()
                                        AddFinished( N, M )
                                        draw()
                                        Return
                                End If
                        Next
                       
                        For Local K:Int = 0 Until 9
                                Guess[ BackupChoice.N, BackupChoice.M, K ] = BackupChoice.Guesses[ K ]
                        Next
               
                        UndoStack.RemoveFirst()
                        RollBackup()
                End If
        Forever
End Function



Function AddFinished( N:Int, M:Int )
        Local Finished:LTFinished = New LTFinished
        Finished.N = N
        Finished.M = M
        FinishedStack.AddLast( Finished )
End Function



Function Draw()
        Cls
       
        For Local N:Int = 0 To 9
                Local V:Int = 0
                If ( N Mod 3 ) = 0 Then V = 1
                DrawRect 32 + N * 60 - V * 2, 30, 1 + V * 4, 544
                DrawRect 30, 32 + N * 60 - V * 2, 544, 1 + V * 4
        Next
       
        For Local N:Int = 0 Until 9
                For Local M:Int = 0 Until 9
                        If GameField[ M, N ] > 0 Then
                                CenterText( GameField[ M, N ], 62 + M * 60, 62 + N * 60, Font[ 0 ] )
                        Else
                                For Local K:Int = 0 Until 9
                                        If Guess[ M, N, K ] Then CenterText( K + 1, 42 + M * 60 + ( K Mod 3 ) * 20, 42 + N * 60 + Floor( K / 3 ) * 20, Font[ 1 ] )
                                Next
                        End If
                Next
        Next
       
        SetImageFont( Font[ 0 ] )
        DrawText( FinishedQuantity, 800 - TextWidth( FinishedQuantity ), 0 )
        SetColor 255, 0, 0
        If Faults Then DrawText( Faults, 800 - TextWidth( Faults ), 50 )
        SetColor 255, 255, 255
       
        Flip

End Function

Другие

Друзья