ReneMiner
25-02-2016, 02:42
You like to solve sudoku-puzzles?
24 kB of thinBasic-code to get busy:
' #Filename "Sudoku.tBasic"
#MINVERSION 1.9.16.16
Uses "TBGL"
'[] Const
Begin Const
' window-size:
%Width = 640
%Height = 640
' window-handle:
%hWnd = TBGL_CreateWindowEx( _
"thinBasic-Sudoku [esc to exit]", _
%Width, %Height, 32, _
%TBGL_WS_WINDOWED | %TBGL_WS_CLOSEBOX | %TBGL_WS_DONTSIZE )
' font-ids
%Font_Text = TBGL_BuildFont(TBGL_FontHandle("Courier New", 16, %TBGL_BOLD), 1)
%Font_Large = TBGL_BuildFont(TBGL_FontHandle("Courier New", 36, %TBGL_BOLD), 2)
%Font_Small = TBGL_BuildFont(TBGL_FontHandle("Courier New", 11), 3)
%Font_Digits = TBGL_BuildFont(TBGL_FontHandle("Wingdings", 24), 4)
' button-ids
%btnEasy = 1
%btnMedium
%btnHard
%btnHelp
%btnRestart
%btnNew
End Const
' dimensioning of globals follows type-definitions!
' find them at the end of the script
' --------------------------------------------------------------------------------------------------
Function TBMain()
' --------------------------------------------------------------------------------------------------
Local lMB As Long ' check left mouse-button
' -1 : up, release
' 0 : not
' 1 : down, push
' 2 : hold
Local lBtn As Long ' UI-button-index-counter
' --- clear keyboard-buffer
TBGL_ResetKeyState()
' --- display the window
TBGL_ShowWindow
' --- TBGL setup:
TBGL_ShowCursor(TRUE)
TBGL_UseLighting FALSE
TBGL_UseDepth FALSE
TBGL_DepthFunc(%TBGL_ALWAYS)
TBGL_UseTexturing(FALSE)
TBGL_RenderMatrix2D(0, %Height, %Width, 0)
TBGL_BackColor( 0, 60, 220 )
' --- setup global btn-buttons:
btn(%btnEasy).sText = "Easy"
btn(%btnEasy).X1 = 60 : btn(%btnEasy).Y1 = 568
btn(%btnEasy).X2 = 220 : btn(%btnEasy).Y2 = 596
btn(%btnMedium).sText = "Medium"
btn(%btnMedium).X1 = 240 : btn(%btnMedium).Y1 = btn(%btnEasy).Y1
btn(%btnMedium).X2 = 400 : btn(%btnMedium).Y2 = btn(%btnEasy).Y2
btn(%btnMedium).Is = TRUE
btn(%btnHard).sText = "Hard"
btn(%btnHard).X1 = 420 : btn(%btnHard).Y1 = btn(%btnEasy).Y1
btn(%btnHard).X2 = 580 : btn(%btnHard).Y2 = btn(%btnEasy).Y2
btn(%btnHelp).sText = "Help"
btn(%btnHelp).X1 = 60 : btn(%btnHelp).Y1 = 600
btn(%btnHelp).X2 = 220 : btn(%btnHelp).Y2 = 628
btn(%btnRestart).sText = "Restart"
btn(%btnRestart).X1 = 240 : btn(%btnRestart).Y1 = btn(%btnHelp).Y1
btn(%btnRestart).X2 = 400 : btn(%btnRestart).Y2 = btn(%btnHelp).Y2
btn(%btnNew).sText = "New"
btn(%btnNew).X1 = 420 : btn(%btnNew).Y1 = btn(%btnHelp).Y1
btn(%btnNew).X2 = 580 : btn(%btnNew).Y2 = btn(%btnHelp).Y2
' --- Main-Loop
While TBGL_IsWindow(%hWnd)
TBGL_ClearFrame
' --- draw the buttons:
For lBtn = %BtnEasy To %BtnNew
btn(lBtn).Render
Next
' --- draw the game-board:
Sudoku.Render()
TBGL_DrawFrame
' --- check input:
If TBGL_GetWindowKeyState(%hWnd, %VK_ESCAPE) Then Exit While
lMB = IIf(TBGL_GetWindowKeyState(%hWnd, %VK_LBUTTON), IIf(lMB < 1, 1, 2), IIf(lMB > 0, -1, 0))
If lMB = 1 Then
' = when left button went down
If Not sudoku.Input Then
' = no input on the board
Sudoku.ShowDigits = FALSE
' --- check if a button was clicked
For lBtn = 1 To %BtnNew
If Between(TBGL_MouseGetPosX, btn(lBtn).X1, btn(lBtn).X2 ) Then
If Between(TBGL_MouseGetPosY, btn(lBtn).Y1, btn(lBtn).Y2 ) Then
' = mouse points this button
Call "Click_" & btn(lBtn).sText
EndIf
EndIf
Next
EndIf
EndIf
Wend
End Function
' --------------------------------------------------------------------------------------------------
Sub Click_Easy()
' --------------------------------------------------------------------------------------------------
' set Sudoku.Mode to Easy
If Sudoku.Mode <> 1 Then
btn(%BtnEasy).Is = TRUE
btn(%BtnMedium).Is = FALSE
btn(%BtnHard).Is = FALSE
Sudoku.Mode = 1
Sudoku.NewBoard
EndIf
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_Medium()
' --------------------------------------------------------------------------------------------------
' set Sudoku.Mode to Medium
If Sudoku.Mode <> 2 Then
btn(%BtnEasy).Is = FALSE
btn(%BtnMedium).Is = TRUE
btn(%BtnHard).Is = FALSE
Sudoku.Mode = 2
Sudoku.NewBoard
EndIf
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_Hard()
' --------------------------------------------------------------------------------------------------
' set Sudoku.Mode to Hard
If Sudoku.Mode <> 3 Then
btn(%BtnEasy).Is = FALSE
btn(%BtnMedium).Is = FALSE
btn(%BtnHard).Is = TRUE
Sudoku.Mode = 3
Sudoku.NewBoard
EndIf
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_New()
' --------------------------------------------------------------------------------------------------
' call to start a new game
Sudoku.NewBoard()
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_Help()
' --------------------------------------------------------------------------------------------------
' toggle visibility of possible numbers
Btn(%BtnHelp).Is = Btn(%BtnHelp).Is XOR TRUE
Sudoku.Help = Btn(%BtnHelp).Is
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_Restart()
' --------------------------------------------------------------------------------------------------
' restart the current game
Local x, y As Long
Memory_Set(VarPtr(Sudoku.Visible(1,1)), Repeat$(81, MKL$(0)))
For x = 1 To 9
For y = 1 To 9
If Sudoku.Fixed(x,y) Then
sudoku.Visible(x,y) = sudoku.content(x,y)
EndIf
Next
Next
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_Sudoku()
' --------------------------------------------------------------------------------------------------
' if a digit was clicked to place into selected field
If Sudoku.SelX = 0 Or Sudoku.SelY = 0 Then Exit Sub
Select Case Sudoku.SelDigit
Case 10
Sudoku.Visible(Sudoku.SelX, Sudoku.SelY) = 0
Case Else
Sudoku.Visible(Sudoku.SelX, Sudoku.SelY) = Sudoku.SelDigit
End Select
End Sub
' ##################################################################################################
Type tButton
' ##################################################################################################
sText As String
FontID As Long
X1 As Long
Y1 As Long
X2 As Long
Y2 As Long
Is As Boolean ' state-switch
' --------------------------------------------------------------------------------------------------
Function Render()
' --------------------------------------------------------------------------------------------------
If Not Between(Me.FontID, 1, 4) Then
' ensure valid font:
Me.FontID = %Font_Text
EndIf
TBGL_SetActiveFont Me.FontID
If Between(TBGL_MouseGetPosX, Me.X1, Me.X2) Then
If Between(TBGL_MouseGetPosY, Me.Y1, Me.Y2) Then
' mouse points on Me:
TBGL_Color 255, 0, 255
TBGL_Rect Me.X1 - 2, Me.Y1 - 2, Me.X2 + 2, Me.Y2 + 2
EndIf
EndIf
If Me.Is Then
' "checked"
TBGL_Color 80, 200, 40
Else
' "not checked"
TBGL_Color 40, 80, 200
EndIf
' draw the button:
TBGL_Rect Me.X1, Me.Y1, Me.X2, Me.Y2
' draw the caption:
TBGL_Color 255, 255, 255
TBGL_PrintFont2D Me.sText, 0.5 * (Me.X2 - Me.X1) + Me.X1, Me.Y2 - IIf(Me.FontID = %font_Digits, 1, 8), %TBGL_ALIGN_NONE, %TBGL_ALIGN_CENTER_DOWN
End Function
' ..................................................................................................
End Type
' ..................................................................................................
' ##################################################################################################
Type tSudoku
' ##################################################################################################
Content(9,9) As Long ' real number that belongs here
Visible(9,9) As Long ' displayed number
Fixed(9,9) As Boolean ' are these fields given visible by tSudoku.NewBoard()
Group(9,9) As Long ' block-group of the tile(x,y)
' positions of the fields
X1(9,9) As Long
Y1(9,9) As Long
X2(9,9) As Long
Y2(9,9) As Long
Help As Boolean ' display possible numbers
Mode As Long ' 1 easy, 2 medium, 3 hard
Digit(10) As tButton
ShowDigits As Boolean ' show digit-buttons to input numbers
SelX As Long ' selected field
SelY As Long
PointX As Long ' pointed field
PointY As Long
SelDigit As Long ' clicked digit-button
missing As Long ' = empty fields
' --------------------------------------------------------------------------------------------------
Function _Create()
' --------------------------------------------------------------------------------------------------
' assign initial variables:
Local x, y As Long
Local x1, y1 As Long ' positions
x1 = 64
For x = 1 To 9
y1 = 36
For y = 1 To 9
' assign group-numbers:
Me.Group(x, y) = (X-1)\3 + 1 + (Y-1)\3 * 3
' positions:
Me.X1(x,y) = x1
Me.Y1(x,y) = y1
Me.X2(x,y) = x1 + 48
Me.Y2(x,y) = y1 + 48
y1 += 56
If Mod(y, 3) = 0 Then
y1 += 8
EndIf
Next
x1 += 56
If Mod(x, 3) = 0 Then
x1 += 8
EndIf
Next
' setup digit-input-buttons caption:
For x = 1 To 9
Me.Digit(x).sText = Chr$(x + 139)
Me.Digit(x).FontID = %Font_Digits
Next
Me.Digit(10).sText = Chr$(161)
Me.Digit(10).FontID = %Font_Digits
Me.Mode = 2 ' medium difficulty at start
End Function
' --------------------------------------------------------------------------------------------------
Function Render()
' --------------------------------------------------------------------------------------------------
' draw sudoku-fields including digit-buttons
Static x, y, i, lTop As Long
Static sRow As String ' possible numbers
Static Sinus, Cosinus, lRot As Long ' to move "Solved !!!"-text
Me.PointX = 0
Me.PointY = 0
For x = 1 To 9
If Between(TBGL_MouseGetPosX, Me.X1(x, 1), Me.X2(x, 1)) Then
For y = 1 To 9
If Between(TBGL_MouseGetPosY, Me.Y1(x, y), Me.Y2(x, y)) Then
Me.PointX = X
Me.PointY = Y
Exit Exit For
EndIf
Next
EndIf
Next
' count down filled fields:
Me.Missing = 81
' draw 9 * 9 fields:
For x = 1 To 9
For y = 1 To 9
If All( X = Me.SelX, _
Y = Me.SelY, _
Me.Fixed(x, y) = FALSE _
) Then
TBGL_Color 255, 0, 255
TBGL_Rect Me.X1(x,y)-4, Me.Y1(x,y)-4, Me.X2(x,y)+4, Me.Y2(x,y)+4
EndIf
TBGL_Color 220, 220, 240
TBGL_Rect Me.X1(x,y), Me.Y1(x,y), Me.X2(x,y), Me.Y2(x,y)
If Me.Visible(x,y) Then
If Me.Fixed(x,y) Then
TBGL_Color 0, 0, 0
Me.Missing -= 1
Else
If Me.IsCorrect( x, y) Then
TBGL_Color 0, 40, 190
Me.Missing -= 1
Else
TBGL_Color 240, 40, 0
EndIf
EndIf
TBGL_SetActiveFont %Font_Large
TBGL_PrintFont2D TStr$(Me.Visible(x,y)), Me.X1(x,y) + 8, Me.Y2(x,y) - 8
ElseIf Me.Help Then
TBGL_SetActiveFont %Font_Small
TBGL_Color 220, 100, 60
sRow = ""
lTop = Me.Y1(x,y) + 13
For i = 1 To 9
sRow &= IIf$(Me.IsPossible(i, x, y), TStr$(i) & " ", " ")
If Mod(i, 3) = 0 Then
TBGL_PrintFont2D sRow, Me.X1(x,y) + 4, lTop
lTop += 15
sRow = ""
EndIf
Next
EndIf
Next
Next
If Me.Missing = 0 Then
' = all fields filled in
lRot += 1
If lRot > 360 Then lRot -= 360
Sinus = %width/2 + Sin(lRot * M_PI/180) * 140
Cosinus = %height/2 + Cos(lRot * M_PI/180) * 140
TBGL_SetActiveFont %Font_Large
TBGL_Color 0, 0, 0
TBGL_PrintFont2D "Solved !!!", Sinus + 2, Cosinus + 2, %TBGL_ALIGN_NONE, %TBGL_ALIGN_CENTER_CENTER
TBGL_Color 230, 50, 0
TBGL_PrintFont2D "Solved !!!", Sinus, Cosinus, %TBGL_ALIGN_NONE, %TBGL_ALIGN_CENTER_CENTER
Me.ShowDigits = FALSE
Me.SelX = 0
Me.SelY = 0
EndIf
If Me.ShowDigits Then
' = await possible click onto a number to fill in on selected field
' draw the digit-buttons:
For i = 1 To 10
Me.Digit(i).Render()
Next
EndIf
End Function
' --------------------------------------------------------------------------------------------------
Function Input() As Boolean
' --------------------------------------------------------------------------------------------------
Static x, y As Long
If Me.ShowDigits Then
' checck for click onto digit-buttons:
For x = 1 To 10
If Between(TBGL_MouseGetPosX, Me.Digit(x).X1, Me.Digit(x).X2) Then
If Between(TBGL_MouseGetPosY, Me.Digit(x).Y1, Me.Digit(x).Y2) Then
Me.SelDigit = x
Me.ShowDigits = FALSE
click_Sudoku()
' --- click done
Return TRUE
EndIf
EndIf
Next
Else
Me.SelX = 0
Me.SelY = 0
EndIf
If All(Me.PointX, Me.PointY) Then
If Not Me.Fixed(Me.PointX, Me.PointY) Then
' remember pointed field
Me.SelX = Me.PointX
Me.SelY = Me.PointY
' position digit-buttons around selected field
Me.Digit(1).X1 = Me.X1(Me.PointX, Me.PointY) - 16
Me.Digit(1).Y1 = Me.Y1(Me.PointX, Me.PointY) - 26
Me.Digit(1).X2 = Me.Digit(1).X1 + 25
Me.Digit(1).Y2 = Me.Digit(1).Y1 + 25
Me.Digit(2).X1 = Me.Digit(1).X1 - 16
Me.Digit(2).Y1 = Me.Digit(1).Y2
Me.Digit(2).X2 = Me.Digit(2).X1 + 25
Me.Digit(2).Y2 = Me.Digit(2).Y1 + 25
Me.Digit(3).X1 = Me.Digit(2).X1
Me.Digit(3).Y1 = Me.Digit(2).Y2 + 2
Me.Digit(3).X2 = Me.Digit(3).X1 + 25
Me.Digit(3).Y2 = Me.Digit(3).Y1 + 25
Me.Digit(4).X1 = Me.Digit(1).X1
Me.Digit(4).Y1 = Me.Digit(3).Y2
Me.Digit(4).X2 = Me.Digit(1).X2
Me.Digit(4).Y2 = Me.Digit(4).Y1 + 25
Me.Digit(5).X1 = Me.X1(Me.PointX, Me.PointY) + 12
Me.Digit(5).Y1 = Me.Y2(Me.PointX, Me.PointY) + 8
Me.Digit(5).X2 = Me.Digit(5).X1 + 25
Me.Digit(5).Y2 = Me.Digit(5).Y1 + 25
Me.Digit(6).X1 = Me.X2(Me.PointX, Me.PointY) - 8
Me.Digit(6).Y1 = Me.Digit(4).Y1
Me.Digit(6).X2 = Me.Digit(6).X1 + 25
Me.Digit(6).Y2 = Me.Digit(4).Y2
Me.Digit(7).X1 = Me.Digit(6).X1 + 16
Me.Digit(7).Y1 = Me.Digit(3).Y1
Me.Digit(7).X2 = Me.Digit(7).X1 + 25
Me.Digit(7).Y2 = Me.Digit(3).Y2
Me.Digit(8).X1 = Me.Digit(7).X1
Me.Digit(8).Y1 = Me.Digit(2).Y1
Me.Digit(8).X2 = Me.Digit(7).X2
Me.Digit(8).Y2 = Me.Digit(2).Y2
Me.Digit(9).X1 = Me.Digit(6).X1
Me.Digit(9).Y1 = Me.Digit(1).Y1
Me.Digit(9).X2 = Me.Digit(6).X2
Me.Digit(9).Y2 = Me.Digit(1).Y2
Me.Digit(10).X1 = Me.Digit(5).X1
Me.Digit(10).Y1 = Me.Y1(Me.PointX, Me.PointY) - 32
Me.Digit(10).X2 = Me.Digit(5).X2
Me.Digit(10).Y2 = Me.Digit(10).Y1 + 25
Me.ShowDigits = TRUE
EndIf
' yes we had a click:
Function = TRUE
EndIf
End Function
' --------------------------------------------------------------------------------------------------
Function GetPossible(ByRef n() As Long, _
ByVal X As Long, _
ByVal Y As Long _
) As Long
' --------------------------------------------------------------------------------------------------
' n() will receive all possible numbers for x,y
' returns count of possibilities
Local i, lResult As Long
For i = 1 To 9
If Not Me.IsInGroup( i, Me.Group(x,y) ) Then
If Not Me.IsInX(i, x) Then
If Not Me.IsInY(i, y) Then
lResult += 1
n(lResult) = i
EndIf
EndIf
EndIf
Next
Function = lResult
End Function
' --------------------------------------------------------------------------------------------------
Function IsPossible(ByVal n As Long, _
ByVal X As Long, _
ByVal Y As Long _
) As Boolean
' --------------------------------------------------------------------------------------------------
' returns if number n were possible at x,y
If Not Me.IsInGroup( n, Me.Group(x,y) ) Then
If Not Me.IsInX(n, x) Then
If Not Me.IsInY(n, y) Then
Function = TRUE
EndIf
EndIf
EndIf
End Function
' --------------------------------------------------------------------------------------------------
Function IsInX(ByVal n As Long, _
ByVal x As Long _
) As Boolean
' --------------------------------------------------------------------------------------------------
' check if number n is already in column x
Local y As Long
For y = 1 To 9
If Me.Visible(x, y) = n Then
Return TRUE
EndIf
Next
End Function
' --------------------------------------------------------------------------------------------------
Function IsInY(ByVal n As Long, _
ByVal y As Long _
) As Boolean
' --------------------------------------------------------------------------------------------------
' check if number n is already in row y
Local x As Long
For x = 1 To 9
If Me.Visible(x, y) = n Then
Return TRUE
EndIf
Next
End Function
' --------------------------------------------------------------------------------------------------
Function IsInGroup(ByVal n As Long,
ByVal group As Long _
) As Boolean
' --------------------------------------------------------------------------------------------------
' check if number n is already in the given group
Local x, y As Long
For x = 1 To 9
For y = 1 To 9
If Me.Group(x,y) = group Then
If Me.Visible(x, y) = n Then
Return TRUE
EndIf
EndIf
Next
Next
End Function
' --------------------------------------------------------------------------------------------------
Function IsCorrect(ByVal X As Long, _
ByVal Y As Long _
) As Boolean
' --------------------------------------------------------------------------------------------------
' returns if placed number is correct at x, y
Static lX, lY As Long
For lX = 1 To 9
If lX <> x Then
If Me.Visible(lX, y) = Me.Visible(x,y) Then Return FALSE
EndIf
Next
For lY = 1 To 9
If lY <> y Then
If Me.Visible(x, lY) = Me.Visible(x,y) Then Return FALSE
EndIf
Next
For lX = 1 To 9
For lY = 1 To 9
If All( lX <> x, _
lY <> y, _
Me.Group(x,y) = Me.Group(lX,lY) _
) Then
If Me.Visible(lX, lY) = Me.Visible(x,y) Then Return FALSE
EndIf
Next
Next
Function = TRUE
End Function
' --------------------------------------------------------------------------------------------------
Function NewBoard()
' --------------------------------------------------------------------------------------------------
' starts a new game
Local i, x, y, num(9) As Long
Local finish As Boolean
If TBGL_IsWindow(%hWnd) Then
TBGL_ClearFrame
TBGL_SetActiveFont %Font_Large
TBGL_Color 0, 20, 60
TBGL_PrintFont2D "Please wait", 161, 381
TBGL_Color 200, 240, 200
TBGL_PrintFont2D "Please wait", 160, 380
TBGL_DrawFrame
EndIf
Randomize
While Not finish
' clear visible numbers:
Memory_Set(VarPtr(Me.Visible(1,1)), Repeat$(81, MKL$(0)))
For y = 1 To 9
For x = 1 To 9
i = Me.GetPossible(num, x, y)
If Not i Then Exit Exit For
' pick random a number of what's possible
Me.Visible(x, y) = num(Rnd(1, i))
finish = All( x = 9, y = 9)
Next
Next
Wend
' all numbers placed now
' set calculated content, hide visible, erase fixed
Memory_Set(VarPtr(Me.Content(1,1)), Memory_Get(VarPtr(Me.Visible(1,1)), 324))
Memory_Set(VarPtr(Me.Visible(1,1)), Repeat$(81, MKL$(0)))
Memory_Set(VarPtr(Me.Fixed(1,1)), Repeat$(81, MKI$(0)))
' total count of visible fields depending on mode:
i = 29 + (3 - Me.Mode) * 5 + Rnd(1, 4 - Me.Mode)
x = 0
y = 0
While i > 0
x += Rnd(1, 2)
If x > 4 Then x = 0
y += Rnd(1, 2)
If y > 4 Then y = 0
If x Or y Then
If Rnd(1, 2) = 1 Then
If Not Me.Fixed(5+x, 5+y) Then
Me.Fixed(5+x,5+y) = TRUE
Me.Visible(5+x,5+y) = Me.Content(5+x,5+y)
i -= 1
EndIf
If Not Me.Fixed(5-x, 5-y) Then
Me.Fixed(5-x,5-y) = TRUE
Me.Visible(5-x,5-y) = Me.Content(5-x,5-y)
i -= 1
EndIf
EndIf
If i < 1 Then Exit While
If Rnd(1, 2) = 1 Then
If Not Me.Fixed(5+x, 5-y) Then
Me.Fixed(5+x,5-y) = TRUE
Me.Visible(5+x,5-y) = Me.Content(5+x,5-y)
i -= 1
EndIf
If Not Me.Fixed(5-x, 5+y) Then
Me.Fixed(5-x,5+y) = TRUE
Me.Visible(5-x,5+y) = Me.Content(5-x,5+y)
i -= 1
EndIf
EndIf
EndIf
Wend
Me.SelX = 0
Me.SelY = 0
End Function
' ..................................................................................................
End Type
' ..................................................................................................
'[] Global
Global Sudoku As tSudoku
Global Btn(%BtnNew) As tButton
' :::::::::::::::::::::::::::::::::::::>> The End <<::::::::::::::::::::::::::::::::::::::::::::::::
It took me almost 6 hours to write this :D
24 kB of thinBasic-code to get busy:
' #Filename "Sudoku.tBasic"
#MINVERSION 1.9.16.16
Uses "TBGL"
'[] Const
Begin Const
' window-size:
%Width = 640
%Height = 640
' window-handle:
%hWnd = TBGL_CreateWindowEx( _
"thinBasic-Sudoku [esc to exit]", _
%Width, %Height, 32, _
%TBGL_WS_WINDOWED | %TBGL_WS_CLOSEBOX | %TBGL_WS_DONTSIZE )
' font-ids
%Font_Text = TBGL_BuildFont(TBGL_FontHandle("Courier New", 16, %TBGL_BOLD), 1)
%Font_Large = TBGL_BuildFont(TBGL_FontHandle("Courier New", 36, %TBGL_BOLD), 2)
%Font_Small = TBGL_BuildFont(TBGL_FontHandle("Courier New", 11), 3)
%Font_Digits = TBGL_BuildFont(TBGL_FontHandle("Wingdings", 24), 4)
' button-ids
%btnEasy = 1
%btnMedium
%btnHard
%btnHelp
%btnRestart
%btnNew
End Const
' dimensioning of globals follows type-definitions!
' find them at the end of the script
' --------------------------------------------------------------------------------------------------
Function TBMain()
' --------------------------------------------------------------------------------------------------
Local lMB As Long ' check left mouse-button
' -1 : up, release
' 0 : not
' 1 : down, push
' 2 : hold
Local lBtn As Long ' UI-button-index-counter
' --- clear keyboard-buffer
TBGL_ResetKeyState()
' --- display the window
TBGL_ShowWindow
' --- TBGL setup:
TBGL_ShowCursor(TRUE)
TBGL_UseLighting FALSE
TBGL_UseDepth FALSE
TBGL_DepthFunc(%TBGL_ALWAYS)
TBGL_UseTexturing(FALSE)
TBGL_RenderMatrix2D(0, %Height, %Width, 0)
TBGL_BackColor( 0, 60, 220 )
' --- setup global btn-buttons:
btn(%btnEasy).sText = "Easy"
btn(%btnEasy).X1 = 60 : btn(%btnEasy).Y1 = 568
btn(%btnEasy).X2 = 220 : btn(%btnEasy).Y2 = 596
btn(%btnMedium).sText = "Medium"
btn(%btnMedium).X1 = 240 : btn(%btnMedium).Y1 = btn(%btnEasy).Y1
btn(%btnMedium).X2 = 400 : btn(%btnMedium).Y2 = btn(%btnEasy).Y2
btn(%btnMedium).Is = TRUE
btn(%btnHard).sText = "Hard"
btn(%btnHard).X1 = 420 : btn(%btnHard).Y1 = btn(%btnEasy).Y1
btn(%btnHard).X2 = 580 : btn(%btnHard).Y2 = btn(%btnEasy).Y2
btn(%btnHelp).sText = "Help"
btn(%btnHelp).X1 = 60 : btn(%btnHelp).Y1 = 600
btn(%btnHelp).X2 = 220 : btn(%btnHelp).Y2 = 628
btn(%btnRestart).sText = "Restart"
btn(%btnRestart).X1 = 240 : btn(%btnRestart).Y1 = btn(%btnHelp).Y1
btn(%btnRestart).X2 = 400 : btn(%btnRestart).Y2 = btn(%btnHelp).Y2
btn(%btnNew).sText = "New"
btn(%btnNew).X1 = 420 : btn(%btnNew).Y1 = btn(%btnHelp).Y1
btn(%btnNew).X2 = 580 : btn(%btnNew).Y2 = btn(%btnHelp).Y2
' --- Main-Loop
While TBGL_IsWindow(%hWnd)
TBGL_ClearFrame
' --- draw the buttons:
For lBtn = %BtnEasy To %BtnNew
btn(lBtn).Render
Next
' --- draw the game-board:
Sudoku.Render()
TBGL_DrawFrame
' --- check input:
If TBGL_GetWindowKeyState(%hWnd, %VK_ESCAPE) Then Exit While
lMB = IIf(TBGL_GetWindowKeyState(%hWnd, %VK_LBUTTON), IIf(lMB < 1, 1, 2), IIf(lMB > 0, -1, 0))
If lMB = 1 Then
' = when left button went down
If Not sudoku.Input Then
' = no input on the board
Sudoku.ShowDigits = FALSE
' --- check if a button was clicked
For lBtn = 1 To %BtnNew
If Between(TBGL_MouseGetPosX, btn(lBtn).X1, btn(lBtn).X2 ) Then
If Between(TBGL_MouseGetPosY, btn(lBtn).Y1, btn(lBtn).Y2 ) Then
' = mouse points this button
Call "Click_" & btn(lBtn).sText
EndIf
EndIf
Next
EndIf
EndIf
Wend
End Function
' --------------------------------------------------------------------------------------------------
Sub Click_Easy()
' --------------------------------------------------------------------------------------------------
' set Sudoku.Mode to Easy
If Sudoku.Mode <> 1 Then
btn(%BtnEasy).Is = TRUE
btn(%BtnMedium).Is = FALSE
btn(%BtnHard).Is = FALSE
Sudoku.Mode = 1
Sudoku.NewBoard
EndIf
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_Medium()
' --------------------------------------------------------------------------------------------------
' set Sudoku.Mode to Medium
If Sudoku.Mode <> 2 Then
btn(%BtnEasy).Is = FALSE
btn(%BtnMedium).Is = TRUE
btn(%BtnHard).Is = FALSE
Sudoku.Mode = 2
Sudoku.NewBoard
EndIf
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_Hard()
' --------------------------------------------------------------------------------------------------
' set Sudoku.Mode to Hard
If Sudoku.Mode <> 3 Then
btn(%BtnEasy).Is = FALSE
btn(%BtnMedium).Is = FALSE
btn(%BtnHard).Is = TRUE
Sudoku.Mode = 3
Sudoku.NewBoard
EndIf
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_New()
' --------------------------------------------------------------------------------------------------
' call to start a new game
Sudoku.NewBoard()
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_Help()
' --------------------------------------------------------------------------------------------------
' toggle visibility of possible numbers
Btn(%BtnHelp).Is = Btn(%BtnHelp).Is XOR TRUE
Sudoku.Help = Btn(%BtnHelp).Is
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_Restart()
' --------------------------------------------------------------------------------------------------
' restart the current game
Local x, y As Long
Memory_Set(VarPtr(Sudoku.Visible(1,1)), Repeat$(81, MKL$(0)))
For x = 1 To 9
For y = 1 To 9
If Sudoku.Fixed(x,y) Then
sudoku.Visible(x,y) = sudoku.content(x,y)
EndIf
Next
Next
End Sub
' --------------------------------------------------------------------------------------------------
Sub Click_Sudoku()
' --------------------------------------------------------------------------------------------------
' if a digit was clicked to place into selected field
If Sudoku.SelX = 0 Or Sudoku.SelY = 0 Then Exit Sub
Select Case Sudoku.SelDigit
Case 10
Sudoku.Visible(Sudoku.SelX, Sudoku.SelY) = 0
Case Else
Sudoku.Visible(Sudoku.SelX, Sudoku.SelY) = Sudoku.SelDigit
End Select
End Sub
' ##################################################################################################
Type tButton
' ##################################################################################################
sText As String
FontID As Long
X1 As Long
Y1 As Long
X2 As Long
Y2 As Long
Is As Boolean ' state-switch
' --------------------------------------------------------------------------------------------------
Function Render()
' --------------------------------------------------------------------------------------------------
If Not Between(Me.FontID, 1, 4) Then
' ensure valid font:
Me.FontID = %Font_Text
EndIf
TBGL_SetActiveFont Me.FontID
If Between(TBGL_MouseGetPosX, Me.X1, Me.X2) Then
If Between(TBGL_MouseGetPosY, Me.Y1, Me.Y2) Then
' mouse points on Me:
TBGL_Color 255, 0, 255
TBGL_Rect Me.X1 - 2, Me.Y1 - 2, Me.X2 + 2, Me.Y2 + 2
EndIf
EndIf
If Me.Is Then
' "checked"
TBGL_Color 80, 200, 40
Else
' "not checked"
TBGL_Color 40, 80, 200
EndIf
' draw the button:
TBGL_Rect Me.X1, Me.Y1, Me.X2, Me.Y2
' draw the caption:
TBGL_Color 255, 255, 255
TBGL_PrintFont2D Me.sText, 0.5 * (Me.X2 - Me.X1) + Me.X1, Me.Y2 - IIf(Me.FontID = %font_Digits, 1, 8), %TBGL_ALIGN_NONE, %TBGL_ALIGN_CENTER_DOWN
End Function
' ..................................................................................................
End Type
' ..................................................................................................
' ##################################################################################################
Type tSudoku
' ##################################################################################################
Content(9,9) As Long ' real number that belongs here
Visible(9,9) As Long ' displayed number
Fixed(9,9) As Boolean ' are these fields given visible by tSudoku.NewBoard()
Group(9,9) As Long ' block-group of the tile(x,y)
' positions of the fields
X1(9,9) As Long
Y1(9,9) As Long
X2(9,9) As Long
Y2(9,9) As Long
Help As Boolean ' display possible numbers
Mode As Long ' 1 easy, 2 medium, 3 hard
Digit(10) As tButton
ShowDigits As Boolean ' show digit-buttons to input numbers
SelX As Long ' selected field
SelY As Long
PointX As Long ' pointed field
PointY As Long
SelDigit As Long ' clicked digit-button
missing As Long ' = empty fields
' --------------------------------------------------------------------------------------------------
Function _Create()
' --------------------------------------------------------------------------------------------------
' assign initial variables:
Local x, y As Long
Local x1, y1 As Long ' positions
x1 = 64
For x = 1 To 9
y1 = 36
For y = 1 To 9
' assign group-numbers:
Me.Group(x, y) = (X-1)\3 + 1 + (Y-1)\3 * 3
' positions:
Me.X1(x,y) = x1
Me.Y1(x,y) = y1
Me.X2(x,y) = x1 + 48
Me.Y2(x,y) = y1 + 48
y1 += 56
If Mod(y, 3) = 0 Then
y1 += 8
EndIf
Next
x1 += 56
If Mod(x, 3) = 0 Then
x1 += 8
EndIf
Next
' setup digit-input-buttons caption:
For x = 1 To 9
Me.Digit(x).sText = Chr$(x + 139)
Me.Digit(x).FontID = %Font_Digits
Next
Me.Digit(10).sText = Chr$(161)
Me.Digit(10).FontID = %Font_Digits
Me.Mode = 2 ' medium difficulty at start
End Function
' --------------------------------------------------------------------------------------------------
Function Render()
' --------------------------------------------------------------------------------------------------
' draw sudoku-fields including digit-buttons
Static x, y, i, lTop As Long
Static sRow As String ' possible numbers
Static Sinus, Cosinus, lRot As Long ' to move "Solved !!!"-text
Me.PointX = 0
Me.PointY = 0
For x = 1 To 9
If Between(TBGL_MouseGetPosX, Me.X1(x, 1), Me.X2(x, 1)) Then
For y = 1 To 9
If Between(TBGL_MouseGetPosY, Me.Y1(x, y), Me.Y2(x, y)) Then
Me.PointX = X
Me.PointY = Y
Exit Exit For
EndIf
Next
EndIf
Next
' count down filled fields:
Me.Missing = 81
' draw 9 * 9 fields:
For x = 1 To 9
For y = 1 To 9
If All( X = Me.SelX, _
Y = Me.SelY, _
Me.Fixed(x, y) = FALSE _
) Then
TBGL_Color 255, 0, 255
TBGL_Rect Me.X1(x,y)-4, Me.Y1(x,y)-4, Me.X2(x,y)+4, Me.Y2(x,y)+4
EndIf
TBGL_Color 220, 220, 240
TBGL_Rect Me.X1(x,y), Me.Y1(x,y), Me.X2(x,y), Me.Y2(x,y)
If Me.Visible(x,y) Then
If Me.Fixed(x,y) Then
TBGL_Color 0, 0, 0
Me.Missing -= 1
Else
If Me.IsCorrect( x, y) Then
TBGL_Color 0, 40, 190
Me.Missing -= 1
Else
TBGL_Color 240, 40, 0
EndIf
EndIf
TBGL_SetActiveFont %Font_Large
TBGL_PrintFont2D TStr$(Me.Visible(x,y)), Me.X1(x,y) + 8, Me.Y2(x,y) - 8
ElseIf Me.Help Then
TBGL_SetActiveFont %Font_Small
TBGL_Color 220, 100, 60
sRow = ""
lTop = Me.Y1(x,y) + 13
For i = 1 To 9
sRow &= IIf$(Me.IsPossible(i, x, y), TStr$(i) & " ", " ")
If Mod(i, 3) = 0 Then
TBGL_PrintFont2D sRow, Me.X1(x,y) + 4, lTop
lTop += 15
sRow = ""
EndIf
Next
EndIf
Next
Next
If Me.Missing = 0 Then
' = all fields filled in
lRot += 1
If lRot > 360 Then lRot -= 360
Sinus = %width/2 + Sin(lRot * M_PI/180) * 140
Cosinus = %height/2 + Cos(lRot * M_PI/180) * 140
TBGL_SetActiveFont %Font_Large
TBGL_Color 0, 0, 0
TBGL_PrintFont2D "Solved !!!", Sinus + 2, Cosinus + 2, %TBGL_ALIGN_NONE, %TBGL_ALIGN_CENTER_CENTER
TBGL_Color 230, 50, 0
TBGL_PrintFont2D "Solved !!!", Sinus, Cosinus, %TBGL_ALIGN_NONE, %TBGL_ALIGN_CENTER_CENTER
Me.ShowDigits = FALSE
Me.SelX = 0
Me.SelY = 0
EndIf
If Me.ShowDigits Then
' = await possible click onto a number to fill in on selected field
' draw the digit-buttons:
For i = 1 To 10
Me.Digit(i).Render()
Next
EndIf
End Function
' --------------------------------------------------------------------------------------------------
Function Input() As Boolean
' --------------------------------------------------------------------------------------------------
Static x, y As Long
If Me.ShowDigits Then
' checck for click onto digit-buttons:
For x = 1 To 10
If Between(TBGL_MouseGetPosX, Me.Digit(x).X1, Me.Digit(x).X2) Then
If Between(TBGL_MouseGetPosY, Me.Digit(x).Y1, Me.Digit(x).Y2) Then
Me.SelDigit = x
Me.ShowDigits = FALSE
click_Sudoku()
' --- click done
Return TRUE
EndIf
EndIf
Next
Else
Me.SelX = 0
Me.SelY = 0
EndIf
If All(Me.PointX, Me.PointY) Then
If Not Me.Fixed(Me.PointX, Me.PointY) Then
' remember pointed field
Me.SelX = Me.PointX
Me.SelY = Me.PointY
' position digit-buttons around selected field
Me.Digit(1).X1 = Me.X1(Me.PointX, Me.PointY) - 16
Me.Digit(1).Y1 = Me.Y1(Me.PointX, Me.PointY) - 26
Me.Digit(1).X2 = Me.Digit(1).X1 + 25
Me.Digit(1).Y2 = Me.Digit(1).Y1 + 25
Me.Digit(2).X1 = Me.Digit(1).X1 - 16
Me.Digit(2).Y1 = Me.Digit(1).Y2
Me.Digit(2).X2 = Me.Digit(2).X1 + 25
Me.Digit(2).Y2 = Me.Digit(2).Y1 + 25
Me.Digit(3).X1 = Me.Digit(2).X1
Me.Digit(3).Y1 = Me.Digit(2).Y2 + 2
Me.Digit(3).X2 = Me.Digit(3).X1 + 25
Me.Digit(3).Y2 = Me.Digit(3).Y1 + 25
Me.Digit(4).X1 = Me.Digit(1).X1
Me.Digit(4).Y1 = Me.Digit(3).Y2
Me.Digit(4).X2 = Me.Digit(1).X2
Me.Digit(4).Y2 = Me.Digit(4).Y1 + 25
Me.Digit(5).X1 = Me.X1(Me.PointX, Me.PointY) + 12
Me.Digit(5).Y1 = Me.Y2(Me.PointX, Me.PointY) + 8
Me.Digit(5).X2 = Me.Digit(5).X1 + 25
Me.Digit(5).Y2 = Me.Digit(5).Y1 + 25
Me.Digit(6).X1 = Me.X2(Me.PointX, Me.PointY) - 8
Me.Digit(6).Y1 = Me.Digit(4).Y1
Me.Digit(6).X2 = Me.Digit(6).X1 + 25
Me.Digit(6).Y2 = Me.Digit(4).Y2
Me.Digit(7).X1 = Me.Digit(6).X1 + 16
Me.Digit(7).Y1 = Me.Digit(3).Y1
Me.Digit(7).X2 = Me.Digit(7).X1 + 25
Me.Digit(7).Y2 = Me.Digit(3).Y2
Me.Digit(8).X1 = Me.Digit(7).X1
Me.Digit(8).Y1 = Me.Digit(2).Y1
Me.Digit(8).X2 = Me.Digit(7).X2
Me.Digit(8).Y2 = Me.Digit(2).Y2
Me.Digit(9).X1 = Me.Digit(6).X1
Me.Digit(9).Y1 = Me.Digit(1).Y1
Me.Digit(9).X2 = Me.Digit(6).X2
Me.Digit(9).Y2 = Me.Digit(1).Y2
Me.Digit(10).X1 = Me.Digit(5).X1
Me.Digit(10).Y1 = Me.Y1(Me.PointX, Me.PointY) - 32
Me.Digit(10).X2 = Me.Digit(5).X2
Me.Digit(10).Y2 = Me.Digit(10).Y1 + 25
Me.ShowDigits = TRUE
EndIf
' yes we had a click:
Function = TRUE
EndIf
End Function
' --------------------------------------------------------------------------------------------------
Function GetPossible(ByRef n() As Long, _
ByVal X As Long, _
ByVal Y As Long _
) As Long
' --------------------------------------------------------------------------------------------------
' n() will receive all possible numbers for x,y
' returns count of possibilities
Local i, lResult As Long
For i = 1 To 9
If Not Me.IsInGroup( i, Me.Group(x,y) ) Then
If Not Me.IsInX(i, x) Then
If Not Me.IsInY(i, y) Then
lResult += 1
n(lResult) = i
EndIf
EndIf
EndIf
Next
Function = lResult
End Function
' --------------------------------------------------------------------------------------------------
Function IsPossible(ByVal n As Long, _
ByVal X As Long, _
ByVal Y As Long _
) As Boolean
' --------------------------------------------------------------------------------------------------
' returns if number n were possible at x,y
If Not Me.IsInGroup( n, Me.Group(x,y) ) Then
If Not Me.IsInX(n, x) Then
If Not Me.IsInY(n, y) Then
Function = TRUE
EndIf
EndIf
EndIf
End Function
' --------------------------------------------------------------------------------------------------
Function IsInX(ByVal n As Long, _
ByVal x As Long _
) As Boolean
' --------------------------------------------------------------------------------------------------
' check if number n is already in column x
Local y As Long
For y = 1 To 9
If Me.Visible(x, y) = n Then
Return TRUE
EndIf
Next
End Function
' --------------------------------------------------------------------------------------------------
Function IsInY(ByVal n As Long, _
ByVal y As Long _
) As Boolean
' --------------------------------------------------------------------------------------------------
' check if number n is already in row y
Local x As Long
For x = 1 To 9
If Me.Visible(x, y) = n Then
Return TRUE
EndIf
Next
End Function
' --------------------------------------------------------------------------------------------------
Function IsInGroup(ByVal n As Long,
ByVal group As Long _
) As Boolean
' --------------------------------------------------------------------------------------------------
' check if number n is already in the given group
Local x, y As Long
For x = 1 To 9
For y = 1 To 9
If Me.Group(x,y) = group Then
If Me.Visible(x, y) = n Then
Return TRUE
EndIf
EndIf
Next
Next
End Function
' --------------------------------------------------------------------------------------------------
Function IsCorrect(ByVal X As Long, _
ByVal Y As Long _
) As Boolean
' --------------------------------------------------------------------------------------------------
' returns if placed number is correct at x, y
Static lX, lY As Long
For lX = 1 To 9
If lX <> x Then
If Me.Visible(lX, y) = Me.Visible(x,y) Then Return FALSE
EndIf
Next
For lY = 1 To 9
If lY <> y Then
If Me.Visible(x, lY) = Me.Visible(x,y) Then Return FALSE
EndIf
Next
For lX = 1 To 9
For lY = 1 To 9
If All( lX <> x, _
lY <> y, _
Me.Group(x,y) = Me.Group(lX,lY) _
) Then
If Me.Visible(lX, lY) = Me.Visible(x,y) Then Return FALSE
EndIf
Next
Next
Function = TRUE
End Function
' --------------------------------------------------------------------------------------------------
Function NewBoard()
' --------------------------------------------------------------------------------------------------
' starts a new game
Local i, x, y, num(9) As Long
Local finish As Boolean
If TBGL_IsWindow(%hWnd) Then
TBGL_ClearFrame
TBGL_SetActiveFont %Font_Large
TBGL_Color 0, 20, 60
TBGL_PrintFont2D "Please wait", 161, 381
TBGL_Color 200, 240, 200
TBGL_PrintFont2D "Please wait", 160, 380
TBGL_DrawFrame
EndIf
Randomize
While Not finish
' clear visible numbers:
Memory_Set(VarPtr(Me.Visible(1,1)), Repeat$(81, MKL$(0)))
For y = 1 To 9
For x = 1 To 9
i = Me.GetPossible(num, x, y)
If Not i Then Exit Exit For
' pick random a number of what's possible
Me.Visible(x, y) = num(Rnd(1, i))
finish = All( x = 9, y = 9)
Next
Next
Wend
' all numbers placed now
' set calculated content, hide visible, erase fixed
Memory_Set(VarPtr(Me.Content(1,1)), Memory_Get(VarPtr(Me.Visible(1,1)), 324))
Memory_Set(VarPtr(Me.Visible(1,1)), Repeat$(81, MKL$(0)))
Memory_Set(VarPtr(Me.Fixed(1,1)), Repeat$(81, MKI$(0)))
' total count of visible fields depending on mode:
i = 29 + (3 - Me.Mode) * 5 + Rnd(1, 4 - Me.Mode)
x = 0
y = 0
While i > 0
x += Rnd(1, 2)
If x > 4 Then x = 0
y += Rnd(1, 2)
If y > 4 Then y = 0
If x Or y Then
If Rnd(1, 2) = 1 Then
If Not Me.Fixed(5+x, 5+y) Then
Me.Fixed(5+x,5+y) = TRUE
Me.Visible(5+x,5+y) = Me.Content(5+x,5+y)
i -= 1
EndIf
If Not Me.Fixed(5-x, 5-y) Then
Me.Fixed(5-x,5-y) = TRUE
Me.Visible(5-x,5-y) = Me.Content(5-x,5-y)
i -= 1
EndIf
EndIf
If i < 1 Then Exit While
If Rnd(1, 2) = 1 Then
If Not Me.Fixed(5+x, 5-y) Then
Me.Fixed(5+x,5-y) = TRUE
Me.Visible(5+x,5-y) = Me.Content(5+x,5-y)
i -= 1
EndIf
If Not Me.Fixed(5-x, 5+y) Then
Me.Fixed(5-x,5+y) = TRUE
Me.Visible(5-x,5+y) = Me.Content(5-x,5+y)
i -= 1
EndIf
EndIf
EndIf
Wend
Me.SelX = 0
Me.SelY = 0
End Function
' ..................................................................................................
End Type
' ..................................................................................................
'[] Global
Global Sudoku As tSudoku
Global Btn(%BtnNew) As tButton
' :::::::::::::::::::::::::::::::::::::>> The End <<::::::::::::::::::::::::::::::::::::::::::::::::
It took me almost 6 hours to write this :D