RB+Sudoku

Originally coded for Liberty BASIC v4.3, this Sudoku version has been modified for Run BASIC. It's only been tested in IE 7 and Firefox 2.0.0.9. code format="vbnet" ' RB Sudoku ' Janet Terra ' February, 2008

' Initial set up ' Assign the Containers (cssID) Cls Call Containers For n = 1 to 9 Call SetClassNumberPad n   Next n ' Dim the arrays Dim sudoku(9, 9) Dim sudoku$(9, 9) Dim key(9, 9)

' Assign the cells (cssClass) For row = 1 to 9 For col = 1 to 9 Call SetClassBox col, row, 0 Next col Next row ' End initial set up

[NewPuzzle] Cls Print: Print Print "Generating New Puzzle" Redim sudoku(9, 9) For row = 1 to 9 For col = 1 to 9 If col > 3 and row > 3 Then null = null Else RandomNumber = RandomNumber(col, row) sudoku(col, row) = RandomNumber If RandomNumber = 0 Then col = 9 row = 9 End If           End If        Next col Next row If RandomNumber = 0 Then [NewPuzzle]

Redim soduko$(9, 9) For attempt = 1 to 36 For row = 4 to 9 For col = 4 to 9 soduko$(col, row) = RandomNumber$(col, row) Next col Next row LeastRandom$ = LeastRandom$ If Val(Word$(LeastRandom$, 3)) = 0 Then attempt = 36 End If       col = Val(Word$(LeastRandom$, 1)) row = Val(Word$(LeastRandom$, 2)) RandomNumber = RandomNumber(col, row) sudoku(col, row) = RandomNumber Next attempt If PuzzleComplete = 0 Then [NewPuzzle]

Call SetToNegative

[ShowClue] box = box + 1 If box = 10 Then box = 1 End If   BoxColRow$ = BoxColRow$(box) col = Val(Word$(BoxColRow$, 1)) row = Val(Word$(BoxColRow$, 2)) sudoku(col, row) = Abs(sudoku(col, row)) key(col, row) = sudoku(col, row)

[SolvingLoop] foundNumber = 0 For row = 1 to 9 For col = 1 to 9 If sudoku(col, row) < 0 Then If TrueFit(col, row) > 0 Then foundNumber = foundNumber + 1 End If           End If        Next col Next row If foundNumber > 0 Then [SolvingLoop] If PuzzleComplete = 0 Then [ShowClue]

[SamePuzzle] Call ResetSudoku For row = 1 to 9 For col = 1 to 9 Call SetClassHover col, row, 0 Next col Next row EventKey$ = "#box00"

[SelectCell] col = Val(Mid$(EventKey$, 5, 1)) row = Val(Mid$(EventKey$, 6, 1)) If key(col, row) <= 0 Then Call SetClassBox key(0, 1), key(0, 2), 0 Call SetClassHover key(0, 1), key(0, 2), 0 key(0, 1) = col key(0, 2) = row Call SetClassBox key(0, 1), key(0, 2), 1 Call SetClassHover key(0, 1), key(0, 2), 1 Gosub [Display] End If Wait

[SelectNumber] col = key(0, 1) row = key(0, 2) n = Val(Mid$(EventKey$, 3, 1)) sudoku(col, row) = n   Call SetClassBox col, row, 0 key(0, 1) = 0 key(0, 2) = 0 WinPuzzle = PuzzleSolved Gosub [Display] Wait

[SolvePuzzle] For row = 1 to 9 For col = 1 to 9 sudoku(col, row) = Abs(key(col, row)) Next col Next row key(0, 1) = 0 key(0, 2) = 0 Gosub [Display] Wait

Sub QuitApp key$ Cls End End Sub

[Display] Cls Div MainContainer Div Title Print Print "RB Sudoku" Print End Div Div SudokuGrid For row = 1 to 9 For col = 1 to 9 lnk$ = "#box";col;row If sudoku(col, row) > 0 Then n$ = Str$(sudoku(col, row)) Else n$ = "" End If                   Link #lnk$, n$, [SelectCell] #lnk$ cssClass(Mid$(lnk$, 2)) Next col Next row End Div Div LowerBuffer End Div Div Controls Div LeftCol Print: Print Link #n, "New", [NewPuzzle] Print: Print Link #r, "Reset", [SamePuzzle] End Div If key(0, 1) + key(0, 2) > 0 Then Div NumberCol For n = 1 to 9 lnk$ = "#n";n Link #lnk$, Str$(n), [SelectNumber] #lnk$ cssClass(Mid$(lnk$, 2)) Next n               End Div Else Div MiddleCol If WinPuzzle = 1 Then Print "YOU" Print "WIN" WinPuzzle = 0 End If               End Div End If           Div RightCol Print: Print Link #s, "Solve", [SolvePuzzle] Print: Print Link #q, "Quit", QuitApp End Div End Div End Div Return

Sub SetClassBox col, row, bg   lnk$ = "a.box";col;row If bg = 0 Then bg$ = "#FFFFCC" Else bg$ = "#FFFFFF" End If   cssClass lnk$, "{        Text-Decoration: None;        Font-Family: Verdana;        Font-Weight: Bold;        Font-Size: 20pt;        Text-Align: Center;        Background: ";bg$;";        Width: 30px;        Height: 34px;        Display: Block;        Border: 1px Dotted Blue;        Float: Left;        }" Select Case col Case 1, 4, 7 cssClass lnk$, "{Border-Left: 2px Solid Black}" Select Case row Case 1, 4, 7 cssClass lnk$, "{Border-Top: 2px Solid Black}" Case 9 cssClass lnk$, "{Border-Bottom: 2px Solid Black}" End Select Case 2, 5, 8 Select Case row Case 1, 4, 7 cssClass lnk$, "{Border-Top: 2px Solid Black}" Case 9 cssClass lnk$, "{Border-Bottom: 2px Solid Black}" End Select Case 3, 6, 9 cssClass lnk$, "{Border-Right: 2px Solid Black}" Select Case row Case 1, 4, 7 cssClass lnk$, "{Border-Top: 2px Solid Black}" Case 9 cssClass lnk$, "{Border-Bottom: 2px Solid Black}" End Select End Select End Sub

Sub SetClassHover col, row, bg   If bg = 0 Then bg$ = "#FFFFCC" Else bg$ = "#FFFFFF" End If   lnk$ = "a.box";col;row If key(col, row) > 0 Then cssClass lnk$, "{Color: Black}" Else cssClass lnk$, "{Color: Blue}" End If   lnk$ = lnk$;":Hover" If key(col, row) > 0 Then cssClass lnk$, "{           Background-Color: ";bg$;";            Cursor: Not-Allowed;            }" Else cssClass lnk$, "{           Background-Color: ";bg$;";            Cursor: Pointer;            }" End If End Sub

Sub SetClassNumberPad n   lnk$ = "a.n";n cssClass lnk$, "{       Text-Decoration: None;        Font-Family: Verdana;        Font-Weight: Bold;        Font-Size: 20pt;        Text-Align: Center;        Background-Color: Silver;        Color: White;        Width: 29px;        Height: 34px;        Display: Block;        Border: 2px Solid Black;        Float: Left;        }" End Sub

Sub Containers CSSID #MainContainer, "{       Width: 300px;        Height: 575px;        Background-Color: #CCFFCC;        Font-Family: Verdana;        Font-Weight: Bold;        Text-Align: Center;        Margin: 0px Auto;        }" cssID #Title, "{       Background-Color: #CCCCFF;        Font-Size: 24px;        Font-Style: Italic;        Color: #000099;        }" cssID #SudokuGrid, "{       Background-Color: #FFFFFF;        Width: 294px;        Height: 328px;        Border: 1px Solid Black;        }" cssID #LowerBuffer, "{       Background-Color: #CCFFCC;        Width: 294px;        Height: 20px;        Border: None;        }" cssID #Controls, "{       Background-Color: #CCFFCC;        }" cssID #LeftCol, "{       Background-Color: #CCFFCC;        Width: 99px;        Height: 114px;        Float: Left;        }" cssID #MiddleCol, "{       Background-Color: #CCFFCC;        Width: 99px;        Height: 114px;        Font-Family: Verdana;        Font-Style: Italic;        Font-Size: 26pt;        Color: Red;        Float: Left;        }" cssID #NumberCol, "{       Background-Color: #CCFFCC;        Width: 99px;        Height: 114px;        Border: 1px Solid Black;        Float: Left;        }" cssID #RightCol, "{       Background-Color: #CCFFCC;        Width: 98px;        Height: 114px;        Float: Left;        }" End Sub

Function RandomNumber(col, row) RandomNumber$ = RandomNumber$(col, row) nRnd = Len(RandomNumber$) If nRnd > 0 Then RandomNumber = Val(Mid$(RandomNumber$, Int(Rnd(1) * nRnd) + 1, 1)) Else RandomNumber = 0 End If End Function

Function RandomNumber$(col, row) ColStrand$ = ColStrand$(col) RowStrand$ = RowStrand$(row) BoxStrand$ = BoxStrand$(col, row) RandomNumber$ = "" For i = 1 to 9 If Instr(ColStrand$, Str$(i)) = 0 Then If Instr(RowStrand$, Str$(i)) = 0 Then If Instr(BoxStrand$, Str$(i)) = 0 Then RandomNumber$ = RandomNumber$;Str$(i) End If           End If        End If    Next i End Function

Function ColStrand$(col) ColStrand$ = "" For row = 1 to 9 If sudoku(col, row) > 0 Then ColStrand$ = ColStrand$;Str$(sudoku(col, row)) End If   Next row End Function

Function RowStrand$(row) RowStrand$ = "" For col = 1 to 9 If sudoku(col, row) > 0 Then RowStrand$ = RowStrand$;Str$(sudoku(col, row)) End If   Next col End Function

Function BoxStrand$(col, row) BoxStrand$ = "" c = Int((col - 1) /3) * 3 + 1 r = Int((row - 1) /3) * 3 + 1 For rw = r to r + 2 For cl = c to c + 2 If sudoku(cl, rw) > 0 Then BoxStrand$ = BoxStrand$;Str$(sudoku(cl, rw)) End If       Next cl    Next rw End Function

Function LeastRandom$ LeastRandom = 9 For row = 4 to 9 For col = 4 to 9 If sudoku(col, row) = 0 Then sudoku$(col, row) = RandomNumber$(col, row) least = Len(sudoku$(col, row)) If least < LeastRandom Then LeastRandom = least LeastRandom$ = col;" ";row;" ";LeastRandom End If           End If        Next col Next row End Function

Function PuzzleComplete PuzzleComplete = 1 For row = 1 to 9 For col = 1 to 9 If sudoku(col, row) < 1 Then PuzzleComplete = 0 End If       Next col Next row End Function

Sub SetToNegative For row = 1 to 9 For col = 1 to 9 sudoku(col, row) = sudoku(col, row) * -1 key(col, row) = sudoku(col, row) Next col Next row End Sub

Function BoxColRow$(box) Select Case box Case 1 c = 1 r = 1 Case 2 c = 4 r = 1 Case 3 c = 7 r = 1 Case 4 c = 1 r = 4 Case 5 c = 4 r = 4 Case 6 c = 7 r = 4 Case 7 c = 1 r = 7 Case 8 c = 4 r = 7 Case 9 c = 7 r = 7 End Select col = Int(Rnd(1) * 3) + c   row = Int(Rnd(1) * 3) + r    BoxColRow$ = col;" ";row End Function

Function TrueFit(col, row) TrueFit$ = "" TrueFit = 0 ColStrand$ = ColStrand$(col) RowStrand$ = RowStrand$(row) BoxStrand$ = BoxStrand$(col, row) For i = 1 to 9 If Instr(ColStrand$, Str$(i)) = 0 Then If Instr(RowStrand$, Str$(i)) = 0 Then If Instr(BoxStrand$, Str$(i)) = 0 Then TrueFit$ = TrueFit$;i End If           End If        End If    Next i    If Len(TrueFit$) = 1 Then TrueFit = Val(TrueFit$) sudoku(col, row) = TrueFit End If End Function

Function PuzzleSolved PuzzleSolved = 1 For row = 1 to 9 For col = 1 to 9 If sudoku(col, row) <> Abs(key(col, row)) Then PuzzleSolved = 0 End If       Next col Next row End Function

Sub ResetSudoku For row = 1 to 9 For col = 1 to 9 If key(col, row) > 0 Then sudoku(col, row) = key(col, row) Else sudoku(col, row) = 0 End If       Next col Next row End Sub code