YOUR JOYFUL MEMBERSHIP CREDENTIALS HAVE NOT BEEN IDENTIFIED. PLEASE ENTER YOUR CREDENTIALS OR JOIN OUR JOYFUL COMMUNITY.
ENTER YOUR JOYFUL MEMBER CREDENTIALS REQUEST ACCESS TO OUR JOYFUL COMMUNITY


Sudoku
01-11-2018, 11:00 AM
Post: #1
 (Print Post)
Hi,

I want to talk about Sudoku both the Game and a Solver. Since qbguy posted his version at QB.net, I have been determined to create the best Game possible. Turns out the boards qbguy's code produced followed a very simple pattern making the solving of them almost trivial AFTER you figured out the pattern. We won't say how long it took me to realize the pattern. Tongue

So here is a guaranteed board maker for Sudoku in SmallBASIC BUT! it makes the same simple pattern as qbguy's puzzles. Can you see the problem?

Code Snippet: [Select]
' Make Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-07

'I don't know if this offers real variety??

dim grid(8, 8) 'global access

'test grids have solutions for Sudoku Game
while 1
 makeGrid
 showGrid
 ? : ? "Grid solve-able ? answer: ";solved()
 input "Press enter for another, any else quits ";more
 if len(more) then end
wend

sub makeGrid
 ' create a playable Sudoku grid and then swap rows, columns or cell blocks
 ' any of 1 to 9 digits could end up in any grid(x, y) position
 
 local rIncrement, col, row, starter, slider
 local i, j, swapMode, cellSet, rc1, rc2
 local ta 'temp array
 
 'to understand the following need diagram
 '147:258:369
 '258:369:471
 '369:471:582
 '471:582:693
 '582:693:714
 '693:714:825
 '714:825:936
 '825:936:147
 '936:147:258
 'then I accidently discovered increment 1 (above) 2, 4, 5, 7, 8 all work for same starter!
 
 repeat 'choose from 6 setup boards
   rIncrement = Int(rnd * 8) + 1
 until rIncrement <> 3 and rIncrement <> 6
 
 for col = 0 to 8
   if starter = 0
     starter = 1
   elif starter = 7
     starter = 2
   elif starter = 8
     starter = 3
   else
     starter = starter + 3
   fi
   slider = starter
   for row = 0 to 8
     grid(col, row) = slider
     slider = slider + rIncrement
     if slider > 9 then slider = slider mod 9
   next
 next
 
 'potentialy shuffling 9 rows, 9 cols, 3 vertical cell blocks or 3 horizontals
 for i = 0 to 23
   swapMode = int(rnd * 24)
   cellSet = int(rnd * 3)           ' first, second, third
   rc1 = int(rnd * 3)               ' 0, 1, 2
   repeat
     rc2 = int(rnd * 3)             ' to swap with rc1 0, 1, 2 Not = rc1
   until rc2 <> rc1
   for slider = 0 to 8              ' reusing a variable
     if swapMode < 9 then           ' swap rows
       swap grid(slider, cellSet * 3 + rc1), grid(slider, cellSet * 3 + rc2)
     elif swapMode < 18              ' swap columns
       swap grid(cellSet * 3 + rc1, slider), grid(cellSet * 3 + rc2, slider)
     elif swapMode < 21              ' swap cell block rows
       for j = 0 to 2
         swap grid(slider, rc1*3 + j), grid(slider, rc2*3 + j)
       next
     elif swapMode < 24            ' swap cell block columns
       for j = 0 to 2
         swap grid(rc1*3 + j, slider), grid(rc2*3 + j, slider)
       next
     fi
   next
 next
 
 'for 9! permutations of number substitutes or codes
 'OK code the numbers st 1 is made another number 1-9, 2...
 dim ta(1 to 9)
 for i = 1 to 9 : ta(i) = i : next
 for i = 9 to 2 step -1 'shuffle
   swap ta(i), ta(int(rnd*i) + 1)
 next
 for col = 0 to 8
   for row = 0 to 8
     grid(col, row) = ta( grid(col, row))
   next
 next
end

sub showGrid
 local r, c
 cls
 for r = 0 to 8
   for c = 0 to 8
     locate int(r/3) + r + 2 , int(c/3) * 2 + (c + 2) * 3,  : ? grid(c, r)
   next
 next
 ?
end

' add solved function
func solved()
 local n, col, row, cell, cellrow, cellcol, found
 solved = 0 'n must be found in every column, row and 3x3 cell
 FOR n = 1 TO 9
   'check columns for n
   FOR col = 0 TO 8
     found = 0
     FOR row = 0 TO 8
       IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR
     NEXT
     IF found = 0 THEN EXIT FUNC
   NEXT
   'check rows for n
   FOR row = 0 TO 8
     found = 0
     FOR col = 0 TO 8
       IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR
     NEXT
     IF found = 0 THEN EXIT FUNC
   NEXT
   'check 3x3 cells for n
   FOR cell = 0 TO 8
     cellcol = cell MOD 3
     cellrow = INT(cell / 3)
     found = 0
     FOR col = 0 TO 2
       FOR row = 0 TO 2
         IF abs(grid(cellcol * 3 + col, cellrow * 3 + row)) = n THEN found = 1: EXIT FOR
       NEXT
       IF found = 1 THEN EXIT FOR
     NEXT
     IF found = 0 THEN EXIT FUNC
   NEXT
 NEXT
 solved = 1
end


Attached File(s) Image(s)
   

For a bad joke 
http://www.laughfactory.com/jokes/joke-of-the-day 
worse than Pete's Big Grin
Find all posts by this user
Like Post
01-11-2018, 11:50 PM (This post was last modified: 01-11-2018 11:53 PM by bplus.)
Post: #2
 (Print Post)
OK here is a much better Sudoku Board builder code:
Code Snippet: [Select]
' Make #2 Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-09

'attempt a very different way to load a grid that might offer more variety than first successful attempt

randomize
dim grid(8, 8) 'global access

'test grids have solutions for Sudoku Game
while 1
 tCount = 0 : tStartOver = 0
 makeGrid
 showGrid
 ? : ? "Grid solve-able ? answer: ";solved()
 ? "Total cellBlock redo's ";tCount
 ? "      Total StartOvers ";tStartOver
 input "Press enter for another, any else quits ";more
 if len(more) then end
wend

'this will either put the number in the grid's sellBlock or return 0 for failure
func loadCell(n, cellBlock)
 local xoff, yoff, xstop, ystop, list, x, y
 local xx, yy, available, i, pointer, cell, r
 local wait

 'grid
 ' 0 1 2  3 4 5  6 7 8
 '
 'cell block numbers
 ' 0 1 2
 ' 3 4 5
 ' 6 7 8

 select case cellBlock
   case 0 : xoff = 0 : yoff = 0 : xstop = 0 : ystop = 0
   case 1 : xoff = 3 : yoff = 0 : xstop = 2 : ystop = 0
   case 2 : xoff = 6 : yoff = 0 : xstop = 5 : ystop = 0

   case 3 : xoff = 0 : yoff = 3 : xstop = 0 : ystop = 2
   case 4 : xoff = 3 : yoff = 3 : xstop = 2 : ystop = 2
   case 5 : xoff = 6 : yoff = 3 : xstop = 5 : ystop = 2

   case 6 : xoff = 0 : yoff = 6 : xstop = 0 : ystop = 5
   case 7 : xoff = 3 : yoff = 6 : xstop = 2 : ystop = 5
   case 8 : xoff = 6 : yoff = 6 : xstop = 5 : ystop = 5
 end select
 'filling the cells in order so all the ones before n are done
 'make a list of free cells in cellblock
 dim list(8)
 for y = 0 to 2  'make list of cells available
   for x = 0 to 2 'find open cell in cellBlock first
     if grid(xoff + x, yoff + y) = 0 then 'open

       bad = 0
       'check rows and columns before this cell block
       for yy = 0 to ystop 'rows
         if grid(xoff + x,  yy) = n  then
           bad = 1
           exit for
         fi
       next
       if bad = 0 then
         for xx = 0 to xstop
           if grid(xx, yoff + y) = n then
             bad = 1
             exit for
           fi
         next
       fi
       if bad = 0 then available++ : list(3*y + x) = 1
     end if

   next
 next

 '? : ? "Number of Cells available ";available
 'for i = 0 to 8 : ? list(i); : next : ?
 'input "OK, press enter... ";wait
 'delay 20

 if available = 0 then
   '? "error: no cells available for: "; n;" in cellBlock ";cellBlock : delay 1500
   loadCell = 0
   exit func
 fi
 dim cell(1 to available) : pointer = 1
 for i = 0 to 8
   if list(i) then cell(pointer) = i : pointer ++
 next

 'OK our list has cells available to load, pick one randomly
 if available > 1 then 'shuffle cells
   for i = available to 2 step -1
     r = int(rnd * i) + 1
     swap cell(i), cell(r)
   next
 fi
 'load the first one listed
 grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n
 loadCell = 1
end

'the master sub for which loadCell function was designed
sub makeGrid
 local n, cellBlock, i, cnt, startOver, temp, wait
 'this version requires the assistance of loadCell sub routine
 ' debug by stepping through process with showGrid sub

 repeat
   dim grid(8, 8) : startOver = 0
   for n = 1 to 9
     temp = grid : cnt = 0
     repeat
       for i = 1 to 9
         cellBlock = val(mid("013246578", i , 1))
         success = loadCell(n, cellBlock)
         if success = 0 then
           cnt = cnt + 1
           tCount++
           if cnt >= 20 then startOver = 1 : tStartOver++ : exit for
           grid = temp
           exit for
         fi
         'showGrid
         'input  " OK, press enter..."; wait
         'delay 200
       next
       if startOver then exit loop
     until success
     if startOver then exit for
   next
 until startOver = 0
end

sub showGrid
 local r, c
 cls
 for r = 0 to 8
   for c = 0 to 8
     locate int(r/3) + r + 2 , int(c/3) * 2 + (c + 2) * 3,  : ? grid(c, r)
   next
 next
 ?
end

' add solved function
func solved()
 local n, col, row, cell, cellrow, cellcol, found
 solved = 0 'n must be found in every column, row and 3x3 cell
 FOR n = 1 TO 9
   'check columns for n
   FOR col = 0 TO 8
     found = 0
     FOR row = 0 TO 8
       IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR
     NEXT
     IF found = 0 THEN EXIT FUNC
   NEXT
   'check rows for n
   FOR row = 0 TO 8
     found = 0
     FOR col = 0 TO 8
       IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR
     NEXT
     IF found = 0 THEN EXIT FUNC
   NEXT
   'check 3x3 cells for n
   FOR cell = 0 TO 8
     cellcol = cell MOD 3
     cellrow = INT(cell / 3)
     found = 0
     FOR col = 0 TO 2
       FOR row = 0 TO 2
         IF abs(grid(cellcol * 3 + col, cellrow * 3 + row)) = n THEN found = 1: EXIT FOR
       NEXT
       IF found = 1 THEN EXIT FOR
     NEXT
     IF found = 0 THEN EXIT FUNC
   NEXT
 NEXT
 solved = 1
end

If you didn't see the patterns of 3 digit sets in first screen shot repeated over and over, compare to this screen where they are not repeated over and over...


Attached File(s) Image(s)
   

For a bad joke 
http://www.laughfactory.com/jokes/joke-of-the-day 
worse than Pete's Big Grin
Find all posts by this user
Like Post
01-14-2018, 11:31 AM
Post: #3
 (Print Post)
Game design decision:

Levels: (a "box" is one of 9 3x3 cells in the grid, in each of which a whole set of numbers 1 to 9 must fit).
I have designated levels to how many cells to remove from each box. So level 1 is 1 cell from each box and this level is good for "flash card" training, to see and type or click the missing number faster than the mind can think. The same goes for level 2 and 3, trainers for automatic processing without brain slowing you down. Levels 4, 5, 6 are the more familiar equivalent to easy, intermediate and hard: leaving 56% (really easy!), 44% (easy-intermediate) and 33% (easy-hard level) number cells in boxes and grid both.

I am pleased to announce I finally found a formula or recipe for hiding cells that guarantees a cell in every row and column of a box thus guarantees 3 cells in every row and column of the whole grid on the hardest level that is still random. The hardest level removes 6 of 9 cells in every box leaving 33% of cells. 

My conjecture is that such a homogeneous distribution of hidden cells will be least likely to generate multiple solutions deviating from the original puzzle devised from the start. This conjecture will be explored when I start playing around with Solvers.

I think I can further target numbered cells for a homogeneous distribution of them when hiding cells. Again this is an effort to reduce the likelihood of multiple solutions from the original puzzle devised.

My goal is to make puzzles where only one number works for each cell that leads to solution that is the same as original puzzle setup.

For a bad joke 
http://www.laughfactory.com/jokes/joke-of-the-day 
worse than Pete's Big Grin
Find all posts by this user
Like Post
01-14-2018, 01:23 PM (This post was last modified: 01-14-2018 01:26 PM by bplus.)
Post: #4
 (Print Post)
Code Snippet: [Select]
' Make #3 Board Test Hiding.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-14

'from make #2 Board Maker, now test hiding cells
'aha! I have defined levels well for myself at least!

randomize
dim grid(8, 8) 'global access to use between calls to functions using them

while 1
  cls
  'get desired level of difficulty set
  locate 6, 27 : ? "Welcome to the game called Sudoku!"
  locate 7, 20 : ? "To begin, please enter a level of difficulty."
  locate 9, 10 : ? "A level of 1 will hide 1 cell in every box, 4 will hide 4 in every box."
  locate 11, 10 : ? "Levels 1 to 3 are good for developing 'flash card' automatic skills."
  locate 12, 10 : ? "Levels 4, 5 and 6 are your standard but on easy side for:"
  locate 13, 10 : ? "beginner, intermediate, and difficult puzzles."
  locate 15, 10  : input "Enter 1 for very easy up to 6 for very hard! any else quits ";level
  if level < 0 or level > 10 then end
  'test robustness of algo for hiding should work to hiding 9 cells in box! YES!!!

    'test grids have solutions for Sudoku Game
  'while 1
  tCount = 0 : tStartOver = 0
  makeGrid
  showGrid
  ? : ? "Grid solve-able ? answer: ";solved()
  ? "Total cellBlock redo's ";tCount
  ? "      Total StartOvers ";tStartOver
  input "OK press enter to see the Hide...";more
  hideCells
  showGrid
  print "That was level ";level
  input "Press enter for another set, any else quits ";more
  if len(more) then end
wend

sub hideCells
  'global level
  local box, cBase, rBase, m, bx, by, dx, dy, dm
  for box = 0 to 8
    cBase = (box mod 3) * 3
    rBase = int(box / 3) * 3
    bx = int(rnd*3) : by = int(rnd*3)
    dx = int(rnd*2) + 1 : dy = int(rnd*2) + 1
    if rnd <.5 then dm = -1 else dm = 1
    for m = 0 to level-1
      grid(cBase + ((bx + m * dx) mod 3) , rBase + (by + m * dy + int(m/3) * dm) mod 3) = 0
    next
  next
end

'this will either put the number in the grid's cellBlock or return 0 for failure
func loadCell(n, cellBlock)
  local xoff, yoff, xstop, ystop, list, x, y
  local xx, yy, available, i, pointer, cell, r
  local wait

  'grid
  ' 0 1 2  3 4 5  6 7 8
  '
  'cell block numbers
  ' 0 1 2
  ' 3 4 5
  ' 6 7 8

  select case cellBlock
    case 0 : xoff = 0 : yoff = 0 : xstop = 0 : ystop = 0
    case 1 : xoff = 3 : yoff = 0 : xstop = 2 : ystop = 0
    case 2 : xoff = 6 : yoff = 0 : xstop = 5 : ystop = 0

    case 3 : xoff = 0 : yoff = 3 : xstop = 0 : ystop = 2
    case 4 : xoff = 3 : yoff = 3 : xstop = 2 : ystop = 2
    case 5 : xoff = 6 : yoff = 3 : xstop = 5 : ystop = 2

    case 6 : xoff = 0 : yoff = 6 : xstop = 0 : ystop = 5
    case 7 : xoff = 3 : yoff = 6 : xstop = 2 : ystop = 5
    case 8 : xoff = 6 : yoff = 6 : xstop = 5 : ystop = 5
  end select
  'filling the cells in order so all the ones before n are done
  'make a list of free cells in cellblock
  dim list(8)
  for y = 0 to 2  'make list of cells available
    for x = 0 to 2 'find open cell in cellBlock first
      if grid(xoff + x, yoff + y) = 0 then 'open

        bad = 0
        'check rows and columns before this cell block
        for yy = 0 to ystop 'rows
          if grid(xoff + x,  yy) = n  then
            bad = 1
            exit for
          fi
        next
        if bad = 0 then
          for xx = 0 to xstop
            if grid(xx, yoff + y) = n then
              bad = 1
              exit for
            fi
          next
        fi
        if bad = 0 then available++ : list(3*y + x) = 1
      end if

    next
  next

  '? : ? "Number of Cells available ";available
  'for i = 0 to 8 : ? list(i); : next : ?
  'input "OK, press enter... ";wait
  'delay 20

  if available = 0 then
    '? "error: no cells available for: "; n;" in cellBlock ";cellBlock : delay 1500
    loadCell = 0
    exit func
  fi
  dim cell(1 to available) : pointer = 1
  for i = 0 to 8
    if list(i) then cell(pointer) = i : pointer ++
  next

  'OK our list has cells available to load, pick one randomly
  if available > 1 then 'shuffle cells
    for i = available to 2 step -1
      r = int(rnd * i) + 1
      swap cell(i), cell(r)
    next
  fi
  'load the first one listed
  grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n
  loadCell = 1
end

'the master sub for which loadCell function was designed
sub makeGrid
  local n, cellBlock, i, cnt, startOver, temp, wait
  'this version requires the assistance of loadCell sub routine
  ' debug by stepping through process with showGrid sub

  repeat
    dim grid(8, 8) : startOver = 0
    for n = 1 to 9
      temp = grid : cnt = 0
      repeat
        for cellBlock  = 0 to 8
          success = loadCell(n, cellBlock)
          if success = 0 then
            cnt = cnt + 1
            tCount++
            if cnt >= 20 then startOver = 1 : tStartOver++ : exit for
            grid = temp
            exit for
          fi
          'showGrid
          'input  " OK, press enter..."; wait
          'delay 200
        next
        if startOver then exit loop
      until success
      if startOver then exit for
    next
  until startOver = 0
end

sub showGrid
  local r, c
  cls
  for r = 0 to 8
    for c = 0 to 8
      locate int(r/3) + r + 2 , int(c/3) * 2 + (c + 2) * 3,  : ? grid(c, r)
    next
  next
  ?
end

' add solved function
func solved()
  local n, col, row, cell, cellrow, cellcol, found
  solved = 0 'n must be found in every column, row and 3x3 cell
  FOR n = 1 TO 9
    'check columns for n
    FOR col = 0 TO 8
      found = 0
      FOR row = 0 TO 8
        IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR
      NEXT
      IF found = 0 THEN EXIT FUNC
    NEXT
    'check rows for n
    FOR row = 0 TO 8
      found = 0
      FOR col = 0 TO 8
        IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR
      NEXT
      IF found = 0 THEN EXIT FUNC
    NEXT
    'check 3x3 cells for n
    FOR cell = 0 TO 8
      cellcol = cell MOD 3
      cellrow = INT(cell / 3)
      found = 0
      FOR col = 0 TO 2
        FOR row = 0 TO 2
          IF abs(grid(cellcol * 3 + col, cellrow * 3 + row)) = n THEN found = 1: EXIT FOR
        NEXT
        IF found = 1 THEN EXIT FOR
      NEXT
      IF found = 0 THEN EXIT FUNC
    NEXT
  NEXT
  solved = 1
end

Algo for hiding cells that matches players choice of playing level. 

This algo leaves a clue in every cell and row of a box at most difficult level of 6.

Such a distribution is also pleasing to the eye and invites me to play even at this hardest level of 6 leaving only 33% of cells as clues.

I am hoping I can modify this to target numbers in cells to show at least 1 or 2 of all the numbers 1 to 9 on the board.

Level 6 screen shot:


Attached File(s) Image(s)
   

For a bad joke 
http://www.laughfactory.com/jokes/joke-of-the-day 
worse than Pete's Big Grin
Find all posts by this user
Like Post
01-16-2018, 06:38 PM (This post was last modified: 01-17-2018 03:45 PM by bplus.)
Post: #5
 (Print Post)
Well here is current update of SmallBasic Sudoku Game.

Code Snippet: [Select]
' SB1 Sudoku Game.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-17
' some edits of game posted 2018-01-17, better quit code with level
' more debug code removed

'from: sudoku mod bplus.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-06
' add whole new makeGrid (maybe faster) and hideCells code (not so random)

'Sudoku Game from SB.bas SmallBASIC 0.12.9 (B+=MGA) 2018-01-04
' fix color at start so can see the grid!
' add solved function!!! and loop around when solved
' removed cell notes, to store in corners

randomize
const TextSize = textwidth("9")
const CellSize = TextSize * 5
const xMinBoard = CellSize
const yMinBoard = CellSize
const xMaxBoard = xMinBoard + 9 * CellSize
const yMaxBoard = yMinBoard + 9 * CellSize
const xMidBoard = xMinBoard + (xMaxBoard - xMinBoard)/2
const yMidBoard = yMinBoard + (yMaxBoard - yMinBoard)/2
const xMinKeyPad = xMinBoard - .5 * CellSize
const xMaxKeyPad = xMinKeyPad + CellSize * 10
const yMinKeyPad = yMaxBoard + 10
const yMaxKeyPad = yMinKeyPad + CellSize

'main loop sets up game puzzle,
'when solved it flashes that fact and then sets up another puzzle
while 1
  'get desired level of difficulty set
  cls
  LOCATE 5, 5: PRINT "Welcome to SB version of Sudoku Game by bplus"
  LOCATE 9, 5: PRINT "To begin, please enter a level of difficulty."
  LOCATE 10, 8: PRINT "A level of 1 will hide 1 cell in every box,"
  LOCATE 12, 14: PRINT "4 will hide 4 in every box."
  LOCATE 14, 9: PRINT "Levels 1 to 3 are good for developing"
  LOCATE 15, 12: PRINT "'flash card' automatic skills."
  LOCATE 17, 9: PRINT "Levels 4, 5 and 6 are easy standard for:"
  LOCATE 18, 5: PRINT "beginner, intermediate, and difficult puzzles."
  LOCATE 22, 12: INPUT "Enter 0 to 9 any else quits "; level
  IF instr("0123456789", level) then level = val(level) else CLS: END
  'test robustness of algo for hiding should work to hiding 9 cells in box! YES!!!
  'globals
  bx = 0 : by = 0  'current highlighted location on board
  key = 1          'current key highlighted on keyPad, key = 0 clears cell
  update = 1       'when to show game board
  dim grid(8,8)    '9x9 board positive values come from puzzle creation
  '0 and negative values are cells blanked out to make puzzle

  makeGrid
  hideCells
  'game loop will continue to respond to mouse clicks until puzzle is solved
  while solved() = 0
    'cls screen display puzzle catch mouse and handle it
    if update then showGrid
    if pen(3) then
      mx = pen(4) : my = pen(5)
      while pen(3)
        mx = pen(4) : my = pen(5)
      wend
      'clicked inside Board
      if xMinBoard <= mx and mx <= xMaxBoard and yMinBoard <= my and my <= yMaxBoard then
        bx = int((mx - xMinBoard)/CellSize) : by = int((my-yMinBoard)/CellSize)
        if grid(bx, by) < 1 then
          if key = 0 then grid(bx, by) = 0 else grid(bx, by) = -key
        fi
        update = 1
      fi
      'clicked inside KeyPad
      if xMinKeyPad <= mx and mx <= xMaxKeyPad and yMinKeyPad <= my and my <= yMaxKeyPad then
        key = int((mx - xMinKeyPad) / CellSize)
        update = 1
      fi
      if xMidBoard - 3 * CellSize <= mx and mx <= xMidBoard + 3 * CellSize then
        if yMaxKeyPad + CellSize <= my and my <= yMaxKeyPad + 2 * CellSize then xit = 1 : exit loop
      fi
    fi
    delay 50  'save fan from running
  wend
  IF xit THEN
    xit = 0
  ELSE
    BEEP
    t = TIMER
    WHILE (TIMER - t < 6)
      showGrid
      DELAY 900
      COLOR 15, 0
      CLS
      at xMidBoard - 7 * TextSize, yMidBoard - .5 * TextSize : ? "Puzzle solved!"
      DELAY 300
    WEND
  END IF
wend

' add solved function
func solved()
  local n, col, row, cell, cellrow, cellcol, found
  solved = 0 'n must be found in every column, row and 3x3 cell
  FOR n = 1 TO 9
    'check columns for n
    FOR col = 0 TO 8
      found = 0
      FOR row = 0 TO 8
        IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR
      NEXT
      IF found = 0 THEN EXIT FUNC
    NEXT
    'check rows for n
    FOR row = 0 TO 8
      found = 0
      FOR col = 0 TO 8
        IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR
      NEXT
      IF found = 0 THEN EXIT FUNC
    NEXT
    'check 3x3 cells for n
    FOR cell = 0 TO 8
      cellcol = cell MOD 3
      cellrow = INT(cell / 3)
      found = 0
      FOR col = 0 TO 2
        FOR row = 0 TO 2
          IF abs(grid(cellcol * 3 + col, cellrow * 3 + row)) = n THEN found = 1: EXIT FOR
        NEXT
        IF found = 1 THEN EXIT FOR
      NEXT
      IF found = 0 THEN EXIT FUNC
    NEXT
  NEXT
  solved = 1
end

' displays the game grid, mainly as Chris with more constants
sub showGrid()
  update = 0 'global calls for this display
  local x, y, i, j, b
  b = rgb(0, 0, 40)
  color 15, b : cls
  locate 1, 21 : ? "Sudoku Level ";level
  rect xMidBoard - 3 * CellSize, yMaxKeyPad + CellSize, xMidBoard + 3 * CellSize, yMaxKeyPad + 2 * CellSize, 12 filled
  at xMidBoard - 2 * TextSize, yMaxKeyPad + CellSize + TextSize + 4
  color 7, 12
  ? "EXIT"
  'draw line segments
  i = xMinBoard
  for x = 0 to 9
    line i,yMinBoard,i,yMaxBoard,13
    i += CellSize
  next x
  j = yMinBoard
  for y = 0 to 9
    line xMinBoard,j,xMaxBoard,j,13
    j += CellSize
  next y
  'draw heavy 3x3 cell borders
  rect xMinBoard+1,yMinBoard+1,xMaxBoard+1,yMaxBoard+1,15
  i = xMinBoard+(CellSize*3)+1
  line i,yMinBoard,i,yMaxBoard,15
  i = xMinBoard+(CellSize*6)+1
  line i,yMinBoard,i,yMaxBoard,15
  j = yMinBoard+(CellSize*3)+1
  line xMinBoard,j,xMaxBoard,j,15
  j = yMinBoard+(CellSize*6)+1
  line xMinBoard,j,xMaxBoard,j,15
  for y = 0 to 8
    for x = 0 to 8
      'highlite?
      if x = bx and y = by then
        color b, 10
        rect xMinBoard+x*CellSize+3, yMinBoard+y*CellSize+3 step CellSize-5, CellSize-5, 10 filled
      else
        if grid(x, y) > 0 then color 9, b else color 7, b
      end if
      if grid(x,y) <> 0 then
        at xMinBoard+(x*CellSize)+(TextSize*2), yMinBoard+(y*CellSize)+TextSize+4
        ? abs(grid(x,y))
      fi
    next
  next
  'show a keypad key with highlite
  i = xMinKeyPad
  for x = 0 to 9
    if x = key then
      rect i+3,yMinKeyPad+3 step CellSize-5, CellSize-5, 10 filled
      color b, 10
    else
      color 11, b
    fi
    line i,yMinKeyPad,i,yMaxKeyPad,7
    at i+(TextSize*2),yMinKeyPad+TextSize+4
    ? x
    i += CellSize
  next
  rect xMinKeyPad, yMinKeyPad, xMaxKeyPad, yMaxKeyPad, 7
end

func loadCell(n, cellBlock)
  local xoff, yoff, xstop, ystop, list, x, y
  local xx, yy, available, i, pointer, cell, r
  
  xoff = 3 * (cellBlock MOD 3): yoff = 3 * INT(cellBlock / 3)
  IF xoff > 0 THEN xstop = xoff - 1 ELSE xstop = 0
  IF yoff > 0 THEN ystop = yoff - 1 ELSE ystop = 0
  'filling the cells in order so all the ones before n are done
  'make a list of free cells in cellblock
  dim list(8)
  for y = 0 to 2  'make list of cells available
    for x = 0 to 2 'find open cell in cellBlock first
      if grid(xoff + x, yoff + y) = 0 then 'open
        bad = 0
        'check rows and columns before this cell block
        for yy = 0 to ystop 'rows
          if grid(xoff + x,  yy) = n  then
            bad = 1
            exit for
          fi
        next
        if bad = 0 then
          for xx = 0 to xstop
            if grid(xx, yoff + y) = n then
              bad = 1
              exit for
            fi
          next
        fi
        if bad = 0 then available++ : list(3*y + x) = 1
      end if
    next
  next
  if available = 0 then
    loadCell = 0
    exit func
  fi
  dim cell(1 to available) : pointer = 1
  for i = 0 to 8
    if list(i) then cell(pointer) = i : pointer ++
  next
  'OK our list has cells available to load, pick one randomly
  if available > 1 then 'shuffle cells
    for i = available to 2 step -1
      r = int(rnd * i) + 1
      swap cell(i), cell(r)
    next
  fi
  'load the first one listed
  grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n
  loadCell = 1
end

sub makeGrid
  local n, cellBlock, i, cnt, startOver, temp, wait
  'this version requires the assistance of loadCell sub routine
  ' debug by stepping through process with showGrid sub
  repeat
    dim grid(8, 8) : startOver = 0
    for n = 1 to 9
      temp = grid : cnt = 0
      repeat
        for i = 1 to 9
          cellBlock = val(mid("013246578", i , 1))
          success = loadCell(n, cellBlock)
          if success = 0 then
            cnt = cnt + 1
            if cnt >= 20 then startOver = 1 : exit for
            grid = temp
            exit for
          fi
        next
        if startOver then exit loop
      until success
      if startOver then exit for
    next
  until startOver = 0
end

sub hideCells
  local copyGrid, success, box, cBase, rBase, m, bx, by, dx, dy, dm, test, r, c, i, cnt
  copyGrid = grid
  while success = 0
    for box = 0 to 8
      cBase = (box mod 3) * 3
      rBase = int(box / 3) * 3
      dx = int(rnd*2) + 1 : dy = int(rnd*2) + 1
      if rnd <.5 then dm = -1 else dm = 1
      bx = int(rnd*3) : by = int(rnd*3)
      for m = 0 to level-1
        grid(cBase + ((bx + m * dx) mod 3) , rBase + (by + m * dy + int(m/3) * dm) mod 3) = 0
      next
    next
    showGrid
    dim test(9)
    for box = 0 to 8
      cBase = (box mod 3) * 3
      rBase = int(box / 3) * 3
      for r = 0 to 2
        for c = 0 to 2
          test(grid(cBase + c, rBase + r)) = 1
        next
      next
    next
    success = 1
    for i = 1 to 9
      if test(i) = 0 then success = 0
    next
    if success = 0 then
      cnt = cnt + 1
      if cnt > 20 then
        success = 1 : beep 'when all numbers aren't there
      else
        grid = copyGrid
      fi
    fi
  wend
end

EDIT: small change since post (1 hour later) change delay .1 to delay 300 as marked in code.

EDIT: 2018-01-17 some more edits to keep abreast of QB64 version.


Attached File(s) Image(s)
   

For a bad joke 
http://www.laughfactory.com/jokes/joke-of-the-day 
worse than Pete's Big Grin
Find all posts by this user
Like Post
01-20-2018, 08:58 PM (This post was last modified: 01-20-2018 09:04 PM by bplus.)
Post: #6
 (Print Post)
Now a full featured Sudoku App, Game, Solver and Editor:
Code Snippet: [Select]
' SB2 Sudoku Game Solver Editor.bas for SmallBASIC 0.12.11 (B+=MGA) 2018-01-20
' + A Solver that can do allot of logic to solve, but not all (yet!).
' + Puzzle and Make modes, Save and Load temp files, all editable: Temp Saved Puzzle.txt
' + Automatic save of solved puzzles: Temp Solved Puzzle.txt
' + Temp files created can be read and edited with Notepad
' Use OS file manager to save files long term under new names (and/or folders).
' + Anything you can do with mouse you can do with keyboard and vice versa.
' + ie 6 function Menu

'from: SB1 Sudoku Game.bas for SmallBASIC 0.12.11 (B+=MGA) 2018-01-17
' + more definitive levels of difficulty and design around them.
' + some edits of game posted 2018-01-17, better quit code with level
' + more debug code removed, whole sections rewritten.

'from: sudoku mod bplus.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-06
' add whole new makeGrid (maybe faster) and hideCells code (not so random)

'Sudoku Game from SB.bas SmallBASIC 0.12.9 (B+=MGA) 2018-01-04
' fix color at start so can see the grid!
' add solved function!!! and loop around when solved
' removed cell notes, to store in corners option

randomize
const TextSize   = textwidth("9")
const CellSize   = TextSize * 5
const xMinBoard  = CellSize
const yMinBoard  = CellSize
const xMaxBoard  = xMinBoard + 9 * CellSize
const yMaxBoard  = yMinBoard + 9 * CellSize
const xMidBoard  = xMinBoard + (xMaxBoard - xMinBoard)/2
const yMidBoard  = yMinBoard + (yMaxBoard - yMinBoard)/2
const xMinKeyPad = xMinBoard - .5 * CellSize
const xMaxKeyPad = xMinKeyPad + CellSize * 10
const yMinKeyPad = yMaxBoard + 10
const yMaxKeyPad = yMinKeyPad + CellSize
const screenWide = 11 * CellSize
const funcWide   = screenWide / 6
const yMinFunc   = yMaxKeyPad + CellSize
const yMaxFunc   = yMinFunc + CellSize

'main loop sets up game puzzle,
'when solved it flashes that fact and then sets up another puzzle
while 1
 'globals
 bx = 0 : by = 0  'current highlighted location on board
 key = 1          'current key highlighted on keyPad, key = 0 clears cell
 update = 1       'when to show game board
 mode = "p"       'mode p for play, mode m for make puzzle
 dim grid(8,8)    '9 x 9 board
                  '0 value = cell blank, > 0 clues of puzzle, < 0 are guesses
 getLevel         'level determines the number of cells removed from each box
 makeGrid
 hideCells

 'game loop will continue to respond to mouse clicks until puzzle is solved
 while solved() = 0

   'cls screen display puzzle catch mouse and handle it
   if update then showGrid

   'handlekeypresses should have equivalent mouse actions!
   k = inkey
   if len(k) = 1 then
     update = 1
     if k = "h" then
       hardSolve
     elif k = "m" or k = "p"
       mode = k
     elif k = "m" then 'convert grid to all positive values
       for rrow = 0 to 8
         for ccol = 0 to 8
           grid(ccol, rrow) = abs(grid(ccol, rrow))
         next
       next
    elif k = "s"
      savePZ(0)
    elif k = "l"
      loadPZ
    elif instr("0123456789", k) then
      handleNumber k
    elif asc(k) = 27
      cls : end
    else
      update = 0
    end if
   elseif len(k) = 2
     update = 1
     select case asc(right(k, 1))
     case 9  : if by > 0 then by = by - 1 'up arrow
     case 10 : if by < 8 then by = by + 1 'down arrow
     case 4  : if bx > 0 then bx = bx - 1 'left arrow
     case 5  : if bx < 8 then bx = bx + 1 'right arrow
     case else : update = 0
     end select
   end if ' k was something

   if pen(3) then  ' caught a mouse down
     mx = pen(4) : my = pen(5)
     while pen(3)  ' update position until release
       mx = pen(4) : my = pen(5)
     wend

     'clicked inside Board
     if xMinBoard <= mx and mx <= xMaxBoard and yMinBoard <= my and my <= yMaxBoard then
       bx = int((mx - xMinBoard)/CellSize) : by = int((my-yMinBoard)/CellSize)
       handleNumber key
     fi

     'clicked inside KeyPad
     if xMinKeyPad <= mx and mx <= xMaxKeyPad and yMinKeyPad <= my and my <= yMaxKeyPad then
       key = int((mx - xMinKeyPad) / CellSize)
       update = 1
     fi

     'clicked inside Func menu: help solve, play mode, make mode, save file, load file, quit screen
     if 0 <= mx and mx <= screenWide then
       if yMinFunc < my and my < yMaxFunc then
         update = 1
         xf = mx / funcWide
         if xf <= 1 then 'help solve
           hardSolve
         elif xf <= 2 'play mode
           mode = "p"
         elif xf <= 3 'make mode
           mode = "m"
           for rrow = 0 to 8
             for ccol = 0 to 8
               grid(ccol, rrow) = abs(grid(ccol, rrow))
             next
           next
         elif xf <= 4 'save file
           savePZ(0)
         elif xf <= 5 'load file
           loadPZ
         elif xf <= 6 'exit
           xit = 1 : exit loop
         fi
       fi
     fi

   fi 'if mouse clicked
   delay 50  'save fan from running
 wend

 'did we exit inner game loop because puzzle solved, or quit or get another board?
 IF xit THEN xit = 0 ELSE BEEP : savePZ(1) 'signals puzzle solved
wend

sub handleNumber(ky)
 if grid(bx, by) < 1 or mode = "m"  then 'don't change clues in puzzle mode
   if ky = 0 then
     grid(bx, by) = 0
   else
     if aok(ky, bx, by) then 'is this a bad idea = bad key?
       if mode = "p" then grid(bx, by) = -ky else grid(bx, by) = ky
     else
       beep ' bad idea for puzzle mode and make mode
     fi
   fi
 else
   beep ' don't change clues!
 fi
 update = 1
end

func solved() 'has the puzzle been solved? assume solved = 0, exit func once proved
 local n, found, col, row, box, cbox, rbox
 for n = 1 to 9
   'check columns for n
   for col = 0 to 8
     found = 0
     for row = 0 to 8
       if abs(grid(col, row)) = n then found = 1 : exit for
     next
     if found = 0 then exit func
   next
   'check rows for n
   for row = 0 to 8
     found = 0
     for col = 0 to 8
       if abs(grid(col, row)) = n then found = 1: exit for
     next
     if found = 0 then exit func
   next
   'check boxes for n
   for cell = 0 to 8
     cbox = 3 * cell mod 3
     rbox = 3 * int(cell / 3)
     found = 0
     for col = 0 to 2
       for row = 0 to 2
         if abs(grid(cbox+ col, rbox + row)) = n then found = 1: exit for
       next
       if found = 1 then exit for
     next
     if found = 0 then exit func
   next
 next
 solved = 1 'good one!
end

' displays the game grid, mainly as Chris with more constants
sub showGrid()
 local x, y, i, j, b, s
 
 update = 0 'before we forget, turn off update global calls for this display

 b = rgb(0, 0, 40) 'background color
 color 15, b : cls
 
 'title, level mode
 if mode = "p" then s = "     Puzzle Mode" else s = "    Make Mode"
 ? : cp 1, "Sudoku Level " + level + s
 
 'draw board line segments
 i = xMinBoard
 for x = 0 to 9
   line i, yMinBoard, i, yMaxBoard, 13
   i += CellSize
 next x
 j = yMinBoard
 for y = 0 to 9
   line xMinBoard, j, xMaxBoard, j, 13
   j += CellSize
 next y
 'draw heavy 3x3 cell borders
 rect xMinBoard + 1, yMinBoard + 1, xMaxBoard + 1, yMaxBoard + 1, 15
 i = xMinBoard + CellSize * 3 + 1
 line i, yMinBoard, i, yMaxBoard, 15
 i = xMinBoard + CellSize * 6 + 1
 line i, yMinBoard, i, yMaxBoard, 15
 j = yMinBoard + CellSize * 3 + 1
 line xMinBoard, j, xMaxBoard, j, 15
 j = yMinBoard + CellSize * 6 + 1
 line xMinBoard, j, xMaxBoard, j, 15
 for y = 0 to 8
   for x = 0 to 8
     'highlite?
     if x = bx and y = by then
       color b, 10
       rect xMinBoard + x*CellSize + 3, yMinBoard + y*CellSize + 3 step CellSize-5, CellSize-5, 10 filled
     else
       if grid(x, y) > 0 then color 9, b else color 7, b
     end if
     if grid(x,y) <> 0 then
       at xMinBoard + x*CellSize + TextSize*2, yMinBoard + y*CellSize + TextSize + 4
       ? abs(grid(x, y))
     fi
   next
 next
 
 'show a keypad key with highlite
 i = xMinKeyPad
 for x = 0 to 9
   if x = key then
     rect i+3,yMinKeyPad+3 step CellSize-5, CellSize-5, 10 filled
     color b, 10
   else
     color 11, b
   fi
   line i,yMinKeyPad,i,yMaxKeyPad,7
   at i+(TextSize*2),yMinKeyPad+TextSize+4
   ? x
   i += CellSize
 next
 rect xMinKeyPad, yMinKeyPad, xMaxKeyPad, yMaxKeyPad, 7
 
 'function pad
 'here's where mouse is looking
 '    if 0 <= mx and mx <= screenWide then
 '      if yMinFunc < my and my < yMaxFunc then
 '        xf = my / funcWide
 color 11, 12
 for i = 1 to 6
   rect (i -1)*funcWide + 5, yMinFunc + 5, i * funcWide - 5, yMaxFunc - 5, 12 filled
   at  (i -1)*funcWide + 25, yMinFunc + 15
   select case i
   case 1 : ? "Help"
   case 2 : ? "Play"
   case 3 : ? "Make"
   case 4 : ? "Save"
   case 5 : ? "Load"
   case 6 : ? "Exit""
   end select
 next  
end

sub makeGrid
 local n, cellBlock, i, cnt, startOver, temp, wait
 'this version requires the assistance of loadCell sub routine
 ' debug by stepping through process with showGrid sub
 repeat
   dim grid(8, 8) : startOver = 0
   for n = 1 to 9
     temp = grid : cnt = 0
     repeat
       for box= 0 to 8
         success = loadBox(n, box)
         if success = 0 then
           cnt = cnt + 1
           if cnt >= 20 then startOver = 1 : exit for
           grid = temp
           exit for
         fi
       next
       if startOver then exit loop
     until success
     if startOver then exit for
   next
 until startOver = 0
end

sub hideCells
 local box, cBase, rBase, m, bx, by, dx, dy, dm
   for box = 0 to 8
     cBase = (box mod 3) * 3
     rBase = int(box / 3) * 3
     dx = int(rnd * 2) + 1 : dy = int(rnd * 2) + 1
     if rnd < .5 then dm = -1 else dm = 1
     bx = int(rnd * 3) : by = int(rnd * 3)
     for m = 0 to level - 1
       grid(cBase + ((bx + m * dx) mod 3) , rBase + (by + m * dy + int(m/3) * dm) mod 3) = 0
     next
   next
end

func aok(a, c, r) 'check to see if a is OK to place at (c, r)
 local i, rr, cc, cbase, rbase
 aok = 0
 if grid(c, r) = 0 then 'check cell empty
    for i = 0 to 8 'check row and column
      if abs(grid(i, r)) = a or abs(grid(c, i)) = a then exit func
    next
    'cbase = int(c / 3) * 3 : rbase = int(r / 3) * 3
    cbase = c - c mod 3 : rbase = r - r mod 3
    for rr = 0 to 2
       for cc = 0 to 2
          if abs(grid(cbase + cc, rbase + rr)) = a then exit func
       next
    next
    aok = 1
 fi
end

func loadBox(n, box) 'this one uses aok function to help load boxes
 local xoff, yoff, list, x, y, available, i, pointer, cell, r
 
 xoff = 3 * (box mod 3) : yoff = 3 * int(box / 3)
 'make a list of free cells in cellblock
 dim list(8)
 for y = 0 to 2  'make list of cells available
   for x = 0 to 2 'find open cell in cellBlock first
       if aok(n, xoff + x, yoff + y) then available++ : list(3 * y + x) = 1
   next
 next
 if available = 0 then
   exit func
 fi
 dim cell(1 to available) : pointer = 1
 for i = 0 to 8
   if list(i) then cell(pointer) = i : pointer ++
 next
 'OK our list has cells available to load, pick one randomly
 if available > 1 then 'shuffle cells
   for i = available to 2 step -1
     r = int(rnd * i) + 1
     swap cell(i), cell(r)
   next
 fi
 'load the first one listed
 grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n
 loadBox = 1
end

func sweepChange()
 'global grid, update
 local n, c, r, only, nn, b1, b2, b3, b4, cbase, rbase, rr, cc
 
 for n = 1 to 9
   for r = 0 to 8
     for c = 0 to 8
       if aok(n, c, r) then
         cbase = 3 * int(c / 3) : rbase = 3 * int(r /3) 'used in a couple of tests
         'only n is good at c, r ?
         only = 1
         for nn = 1 to 9
           if nn <> n then
             if aok(nn, c, r) then only = 0 : exit for
             'no other n works at
           fi
         next
         if only then
           grid(c, r) = -n : sweepChange = 1 : update = 1 : exit for
         fi
       fi 'if aok(n, c, r)
     next c
   next r
 next n
end

sub hardSolve()
 local continue
 
 continue = boxCheck
 while continue
   showGrid
   delay 1000
   continue = boxCheck
   if continue = 0 then continue = sweepChange() 'a 2nd solver method
 wend
 beep
end

sub savePZ(saveSolved)
 local fName, r, s, c
 showGrid
 if saveSolved then fName = "Temp Solved Puzzle.txt" else fName = "Temp Saved Puzzle.txt"
 open fName for output as #1
 for r = 0 to 8
   s = ""
   for c = 0 to 8
     s = s + right("   " + str(grid(c, r)), 3)
   next
   print #1, s;Chr(13) 'not 13 and 10 and not 10 so 13! yes!
 next
 close #1
 color 9, 11
 locate 26, 3 : ? " *** Puzzle saved to: " + fName + " *** "
 delay 5500
end

sub loadPZ()
 local fl, row, i, n
 
 open "Temp Saved Puzzle.txt" for input as #1
 for row = 0 to 8
   input #1, fl
   for i = 0 to 8
     n = val(mid(fl, 3 * i + 1, 3))
     grid(i, row) = n
   next
 next
 close #1
end

func boxCheck() 'return 0 if no changes made, else return 1
 local n, box, xoff, yoff, list, x, y, available, theCell
 for n = 1 to 9
   for box = 0 to 8
     available = 0
     xoff = 3 * (box MOD 3): yoff = 3 * INT(box / 3)
     'save last free cells in box, if only one the
     for y = 0 to 2  'make list of cells available
       for x = 0 to 2 'find open cell in cellBlock first
         if aok(n, xoff + x, yoff + y) then 'count available
           available++ : theCell = 3 * y + x
         end if
       next
     next
     'if there is only one place n works in box put it there!
     if available = 1 then
       boxCheck = 1 'flag a change
       grid(xoff + (theCell mod 3), yoff + int(theCell / 3)) = -n
     fi
   next
 next
end

sub getLevel  'isolated to work on independently
 'get desired level of difficulty set
 color 15, 0: cls
 rect 0, 0, screenwide, yMaxFunc, 8

 cp 2,  "Sudoku Game, Solver and Editor by bplus"
 cp 4, "While running a puzzle try pressing h key for help."
 cp 5, "It will logically solve puzzle as far as it can,"
 cp 6, "then beep to let you know it's finished."
 cp 7, "(A double beep would mean it's finished and solved.)"

 cp 9, "To begin, please enter a level of difficulty."
 cp 10, "A level of 1 will hide 1 cell in every box,"
 cp 11, "4 will hide 4 in every box."
 cp 12, "Levels 1 to 3 are good for developing"
 cp 13, "'flash card' automatic skills."
 cp 14, "Levels 4, 5 and 6 are easy standard for:"
 cp 15, "beginner, intermediate, and difficult puzzles."

 cp 17, "Use level 9 to blank a puzzle and input your own."
 lp 2, "press m for Make mode (enters pos values in grid)."
 lp 2, "press p for Puzzle mode (enters neg values in grid)."
 lp 2, "Press s for save, files to Temp Saved Puzzle.txt"
 lp 2, "press l to load that puzzle up again."
 cp 22, "When a puzzle is Solved it is automatically saved"
 cp 23, "to Temp Solved Puzzle.txt"
 cp 24, "Use your OS to manage these files."
 color 14, 0
 LOCATE 27, 1: INPUT "Now about the level? Enter 0 to 9 any else quits "; level
 IF instr("0123456789", level) then level = val(level) else CLS: stop
 'test robustness of algo for hiding should work to hiding 9 cells in box! YES!!!
end

sub cp(cpRow, text)
 at (screenWide - txtw(text))/2, cpRow * txth(text)
 ? text  
end

sub lp(spacer, text)
 ? space(spacer);text
end

Funny, when testing code, I discovered the scroll wheel works allowing the highlighted cell to move up and down the column. Funny because I did not program that! Huh

The Help button is for helping solve the puzzle, it will go as far as it can logically figuring the puzzle without guessing at the numbers and seeing what works or not.

Instructions are on same screen as getting the level to play. Basically the keys do the same thing as first letter of menu item.


Attached File(s) Image(s)
   

For a bad joke 
http://www.laughfactory.com/jokes/joke-of-the-day 
worse than Pete's Big Grin
Find all posts by this user
Like Post
01-21-2018, 04:28 AM (This post was last modified: 01-21-2018 04:31 AM by bplus.)
Post: #7
 (Print Post)
Oh hey! 

Add this:
Code Snippet: [Select]
sub ps(x, y, size, s) ' a sub to make translating to SmallBASIC from SdlBasic easier
 'when this sub is used text size is altered for the rest of the run
 local l
 l.w = window() : l.w.setfont(size, "pt", 0, 0)
 at x, y : ? s
 l.w.setfont(18, "pt", 0, 0)
end

To remake this:
Code Snippet: [Select]
' displays the game grid, mainly as Chris with more constants
sub showGrid()
 local x, y, i, j, b, s, cell, n, cs
 
 update = 0 'before we forget, turn off update global calls for this display
 
 b = rgb(0, 0, 40) 'background color
 color 15, b : cls
 
 'title, level mode
 if mode = "p" then s = "     Puzzle Mode" else s = "    Make Mode"
 ? : cp 1, "Sudoku Level " + level + s
 
 'draw board line segments
 i = xMinBoard
 for x = 0 to 9
   line i, yMinBoard, i, yMaxBoard, 13
   i += CellSize
 next x
 j = yMinBoard
 for y = 0 to 9
   line xMinBoard, j, xMaxBoard, j, 13
   j += CellSize
 next y
 'draw heavy 3x3 cell borders
 rect xMinBoard + 1, yMinBoard + 1, xMaxBoard + 1, yMaxBoard + 1, 15
 i = xMinBoard + CellSize * 3 + 1
 line i, yMinBoard, i, yMaxBoard, 15
 i = xMinBoard + CellSize * 6 + 1
 line i, yMinBoard, i, yMaxBoard, 15
 j = yMinBoard + CellSize * 3 + 1
 line xMinBoard, j, xMaxBoard, j, 15
 j = yMinBoard + CellSize * 6 + 1
 line xMinBoard, j, xMaxBoard, j, 15
 for y = 0 to 8
   for x = 0 to 8
     'make a string of available candidates for cell
     cs = ""
     for n = 1 to 9
       if aok(n, x, y) then cs = cs + str(n)
     next
     
     'highlite?
     if x = bx and y = by then
       color b, 10
       rect xMinBoard + x*CellSize + 3, yMinBoard + y*CellSize + 3 step CellSize-5, CellSize-5, 10 filled
     else
       if grid(x, y) > 0 then color 9, b else color 7, b
     end if
     if grid(x,y) <> 0 then
       ps xMinBoard + x*CellSize + TextSize*2, yMinBoard + y*CellSize + TextSize + 4, 26, abs(grid(x, y))
     else
       ps xMinBoard + x*CellSize + 3, yMinBoard + y*CellSize + 3, 12, cs
     fi
   next
 next
 
 'show a keypad key with highlite
 i = xMinKeyPad
 for x = 0 to 9
   if x = key then
     rect i+3,yMinKeyPad+3 step CellSize-5, CellSize-5, 10 filled
     color b, 10
   else
     color 11, b
   fi
   line i,yMinKeyPad,i,yMaxKeyPad,7
   at i+(TextSize*2),yMinKeyPad+TextSize+4
   ? x
   i += CellSize
 next
 rect xMinKeyPad, yMinKeyPad, xMaxKeyPad, yMaxKeyPad, 7
 
 'function pad
 'here's where mouse is looking
 '    if 0 <= mx and mx <= screenWide then
 '      if yMinFunc < my and my < yMaxFunc then
 '        xf = my / funcWide
 color 11, 12
 for i = 1 to 6
   rect (i -1)*funcWide + 5, yMinFunc + 5, i * funcWide - 5, yMaxFunc - 5, 12 filled
   at  (i -1)*funcWide + 25, yMinFunc + 15
   select case i
   case 1 : ? "Help"
   case 2 : ? "Play"
   case 3 : ? "Make"
   case 4 : ? "Save"
   case 5 : ? "Load"
   case 6 : ? "Exit""
   end select
 next  
end

And now you can see this!
(note: the puzzle in screen shot is Not Level 6 but a puzzle I copied from newspaper and saved and loaded after selecting a level 6 puzzle.)


Attached File(s) Image(s)
   

For a bad joke 
http://www.laughfactory.com/jokes/joke-of-the-day 
worse than Pete's Big Grin
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - Full Color LED Sign
QB64 Member Project - Swirl
QB64 Member Project - Score 4
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Pivot version two
QB64 Member Project - Line Thickness
QB64 Member Project - Touche
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Pivet version one
QB64 Member Project - Othello
QB64 Member Project - Overboard
QB64 Member Project - Martin Fractals version three
QB64 Member Project - Bowditch curve
QB64 Member Project - Quarto
QB64 Member Project - OpenGL Triangles
QB64 Member Project - Spiro Roses
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Inside Moves
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Domain
QB64 Member Project - Isolation
QB64 Member Project - Input
QB64 Member Project - Basic Dithering
QB64 Member Project - Sabotage
QB64 Member Project - Dakapo
QB64 Member Project - Foursight
QB64 Member Project - Martin Fractals version one
QB64 Member Project - Color Rotating Text
QB64 Member Project - Point Blank
QB64 Member Project - Color Triangles
QB64 Member Project - Dreamy Clock
QB64 Member Project - Rotating Background
QB64 Member Project - Exit
QB64 Member Project - Qubic
QB64 Member Project - MAPTRIANGLE
QB64 Member Project - Amazon
QB64 Member Project - Rubix's Magic
QB64 Member Project - Algeria Weather
QB64 Member Project - Kings Court
QB64 Member Project - Splatter
QB64 Member Project - Blokus
QB64 Member Project - Connect Four
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - ARB Checkers
QB64 Member Project - 9 Board