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-16-2018, 06:41 PM (This post was last modified: 01-16-2018 08:20 PM by bplus.)
Post: #1
 (Print Post)
All mouse (except level of play input) for Sudoku Game:
Code Snippet: [Select]
_TITLE "Sudoku Game by bplus 2018-01-16"
'EDIT: QB64 version 20171106/82

'translated from
' Sudoku Game mod 3 nice hide.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-14
'from: sudoku mod bplus.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-06
' change a few things from Chris version of
' 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

CONST xmax = 440
CONST ymax = 570
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 20

DEFINT A-Z
RANDOMIZE TIMER
CONST TextSize = 8
CONST CellSize = TextSize * 5

CONST xMinBoard = CellSize
CONST yMinBoard = CellSize
CONST xMaxBoard = xMinBoard + 9 * CellSize
CONST yMaxBoard = yMinBoard + 9 * CellSize

CONST xMidBoard = xMinBoard + xMaxBoard / 2 - xMinBoard / 2
CONST yMidBoard = yMinBoard + yMaxBoard / 2 - yMinBoard / 2

CONST xMinKeyPad = xMinBoard - .5 * CellSize
CONST xMaxKeyPad = xMinKeyPad + CellSize * 10
CONST yMinKeyPad = yMaxBoard + 10
CONST yMaxKeyPad = yMinKeyPad + CellSize

COMMON SHARED bx, by, mkey, update, level
DIM SHARED grid(8, 8), temp(8, 8)

'main loop sets up game puzzle,
'when solved it flashes that fact and then sets up another puzzle
WHILE 1
   COLOR _RGB32(55, 55, 0), _RGB32(230, 170, 120)
   CLS
   'get desired level of difficulty set
   LOCATE 5, 5: PRINT "Welcome to QB 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 8 any else quits "; level
   IF level < 0 OR level > 9 THEN 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
   mkey = 1 'current key highlighted on keyPad, key = 0 clears cell
   update = 1 'when to show game board
   ERASE grid '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
       'get next mouse click, check if in board and if so update x, y
       m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
       IF mb THEN 'get last place mouse button was down
           mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
           WHILE mb 'left button down, wait for mouse button release
               m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
           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 mkey = 0 THEN grid(bx, by) = 0 ELSE grid(bx, by) = -mkey
               END IF
               update = 1
           END IF

           'clicked inside keyPad
           IF xMinKeyPad <= mx AND mx <= xMaxKeyPad AND yMinKeyPad <= my AND my <= yMaxKeyPad THEN
               mkey = INT((mx - xMinKeyPad) / CellSize)
               update = 1
           END IF

           IF xMidBoard - 3 * CellSize <= mx AND mx <= xMidBoard + 3 * CellSize THEN
               IF yMaxKeyPad + CellSize <= my AND my <= yMaxKeyPad + 2 * CellSize THEN xit = 1: EXIT WHILE
           END IF
       END IF
       _DISPLAY
       _LIMIT 1000 '? save fan?
   WEND
   IF xit THEN
       xit = 0
   ELSE
       BEEP
       t# = TIMER
       WHILE (TIMER - t# < 6) 'where's the mouse?
           showGrid
           _DISPLAY
           _DELAY .9
           COLOR 15, 0
           CLS
           _PRINTSTRING (xMidBoard - 7 * TextSize, yMidBoard - .5 * TextSize), "Puzzle solved!"
           _DISPLAY
           _DELAY .1
       WEND
   END IF
WEND

FUNCTION solved%
   solved% = 0 'n must be found in every column, row and 3x3 cell
   FOR n = 1 TO 9
       'check coloumns 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 FUNCTION
       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 FUNCTION
       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 FUNCTION
       NEXT
   NEXT
   solved% = -1
END FUNCTION

' displays the game grid
SUB showGrid ()
   update = 0 'global calls for this display
   'local x, y, i, j, b
   b& = _RGB32(0, 0, 40)
   COLOR _RGB(255, 255, 255), b&: CLS
   LOCATE 2, 22: PRINT "Sudoku Level "; RIGHT$(STR$(level), 1)
   LINE (xMidBoard - 3 * CellSize, yMaxKeyPad + CellSize)-(xMidBoard + 3 * CellSize, yMaxKeyPad + 2 * CellSize), _RGB32(255, 0, 0), BF
   COLOR _RGB32(190, 190, 190), _RGB32(255, 0, 0)
   _PRINTSTRING (xMidBoard - 2 * TextSize, yMaxKeyPad + CellSize + TextSize + 4), "EXIT"
   'draw line segments
   i = xMinBoard
   FOR x = 0 TO 9
       LINE (i, yMinBoard)-(i, yMaxBoard), _RGB32(255, 0, 255)
       i = i + CellSize
   NEXT x
   j = yMinBoard
   FOR y = 0 TO 9
       LINE (xMinBoard, j)-(xMaxBoard, j), _RGB32(255, 0, 255)
       j = j + CellSize
   NEXT y
   'draw heavy 3x3 cell borders
   LINE (xMinBoard + 1, yMinBoard + 1)-(xMaxBoard + 1, yMaxBoard + 1), _RGB(255, 255, 255), B
   i = xMinBoard + (CellSize * 3) + 1
   LINE (i, yMinBoard)-(i, yMaxBoard), _RGB(255, 255, 255)
   i = xMinBoard + (CellSize * 6) + 1
   LINE (i, yMinBoard)-(i, yMaxBoard), _RGB(255, 255, 255)
   j = yMinBoard + (CellSize * 3) + 1
   LINE (xMinBoard, j)-(xMaxBoard, j), _RGB(255, 255, 255)
   j = yMinBoard + (CellSize * 6) + 1
   LINE (xMinBoard, j)-(xMaxBoard, j), _RGB(255, 255, 255)
   FOR y = 0 TO 8
       FOR x = 0 TO 8
           'highlite?
           IF x = bx AND y = by THEN
               COLOR b&, _RGB32(0, 255, 0)
               LINE (xMinBoard + x * CellSize + 3, yMinBoard + y * CellSize + 3)-STEP(CellSize - 5, CellSize - 5), _RGB32(0, 255, 0), BF
           ELSE
               IF grid(x, y) > 0 THEN COLOR _RGB32(0, 0, 255), b& ELSE COLOR _RGB32(190, 190, 190), b&
           END IF
           IF grid(x, y) <> 0 THEN
               _PRINTSTRING (xMinBoard + (x * CellSize) + (TextSize * 2), yMinBoard + (y * CellSize) + TextSize + 4), RIGHT$(STR$(ABS(grid(x, y))), 1)
           END IF
       NEXT
   NEXT
   'show a keypad key with highlite
   i = xMinKeyPad
   FOR x = 0 TO 9
       IF x = mkey THEN
           LINE (i + 3, yMinKeyPad + 3)-STEP(CellSize - 5, CellSize - 5), _RGB32(0, 255, 0), BF
           COLOR b&, _RGB32(0, 255, 0)
       ELSE
           COLOR _RGB32(0, 255, 255), b&
       END IF
       LINE (i, yMinKeyPad)-(i, yMaxKeyPad), _RGB32(190, 190, 190)
       _PRINTSTRING (i + (TextSize * 2), yMinKeyPad + TextSize + 4), RIGHT$(STR$(x), 1)
       i = i + CellSize
   NEXT
   LINE (xMinKeyPad, yMinKeyPad)-(xMaxKeyPad, yMaxKeyPad), _RGB32(190, 190, 190), B
END SUB

FUNCTION loadCell (n, cellBlock)
   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 clist(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
                   END IF
               NEXT
               IF bad = 0 THEN
                   FOR xx = 0 TO xstop
                       IF grid(xx, yoff + y) = n THEN
                           bad = 1
                           EXIT FOR
                       END IF
                   NEXT
               END IF
               IF bad = 0 THEN available = available + 1: clist(3 * y + x) = 1
           END IF
       NEXT
   NEXT
   IF available = 0 THEN
       '? "error: no cells available for: "; n;" in cellBlock ";cellBlock : delay 1500
       loadCell = 0
       EXIT FUNCTION
   END IF
   DIM cell(1 TO available): pointer = 1
   FOR i = 0 TO 8
       IF clist(i) THEN cell(pointer) = i: pointer = pointer + 1
   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
   END IF
   'load the first one listed
   grid(xoff + (cell(1) MOD 3), yoff + INT(cell(1) / 3)) = n
   loadCell = 1
END FUNCTION

SUB makeGrid 'this version requires the assistance of loadCell sub routine
   DO
       ERASE grid, temp
       startOver = 0
       FOR n = 1 TO 9
           FOR r = 0 TO 8
               FOR c = 0 TO 8
                   temp(c, r) = grid(c, r)
               NEXT
           NEXT
           cnt = 0
           DO
               FOR cellBlock = 0 TO 8
                   success = loadCell(n, cellBlock)
                   IF success = 0 THEN
                       cnt = cnt + 1
                       tCount = tCount + 1 'don't need
                       grid = temp
                       IF cnt >= 20 THEN startOver = 1: tStartOver = tStartOver + 1: EXIT FOR 'don't need tStartOver
                       FOR r = 0 TO 8
                           FOR c = 0 TO 8
                               grid(c, r) = temp(c, r)
                           NEXT
                       NEXT

                       EXIT FOR
                   END IF
               NEXT
               IF startOver THEN EXIT DO
           LOOP UNTIL success
           IF startOver THEN EXIT FOR
       NEXT
   LOOP UNTIL startOver = 0
END SUB

SUB hideCells
   FOR r = 0 TO 8
       FOR c = 0 TO 8
           temp(c, r) = grid(c, r)
       NEXT
   NEXT
   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
       REDIM 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
               FOR r = 0 TO 8
                   FOR c = 0 TO 8
                       grid(c, r) = temp(c, r)
                   NEXT
               NEXT

           END IF
       END IF
   WEND
END SUB


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:51 PM
Post: #2
 (Print Post)
hello bplus
may I suggest that you specify in comments at top of code what version of Basic you are using?
it looks like QB64 but it's nice to see such details right at the top.
Find all posts by this user
Like Post
01-16-2018, 08:18 PM
Post: #3
 (Print Post)
Yes I only post QB64 in this section of forum but version number should be included too!

QB64 version 20171106/82 the day before QB64 went to 1.2

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-17-2018, 01:53 PM
Post: #4
 (Print Post)
A bunch of edits, mostly cosmetic but the display was not flashing "Puzzle Solved" correctly:
Code Snippet: [Select]
_TITLE "QB1 Sudoku Game by bplus"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
'2018-01-17 edits of 2018-01-16 post
' loadCell reduce 13 lines to 3, remove more debug code
' makeGrid remove counters and grid = temp  or vice versa should have been comment
' display when solved after inner wend of inner main loop was not displaying message
' better check for quit when getting play level

'translated from
' Sudoku Game mod 3 nice hide.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-14
' from: sudoku mod bplus.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-06
' change a few things mainly board setup from Chris version of
' 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

CONST xmax = 440
CONST ymax = 570
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 20

DEFINT A-Z
RANDOMIZE TIMER
CONST TextSize = 8
CONST CellSize = TextSize * 5

CONST xMinBoard = CellSize
CONST yMinBoard = CellSize
CONST xMaxBoard = xMinBoard + 9 * CellSize
CONST yMaxBoard = yMinBoard + 9 * CellSize

CONST xMidBoard = xMinBoard + xMaxBoard / 2 - xMinBoard / 2
CONST yMidBoard = yMinBoard + yMaxBoard / 2 - yMinBoard / 2

CONST xMinKeyPad = xMinBoard - .5 * CellSize
CONST xMaxKeyPad = xMinKeyPad + CellSize * 10
CONST yMinKeyPad = yMaxBoard + 10
CONST yMaxKeyPad = yMinKeyPad + CellSize

COMMON SHARED bx, by, mkey, update, level
DIM SHARED grid(8, 8), temp(8, 8)

'Main: asks for level with quit option, sets up game puzzle,
' then inner loop loops until player solves
' when solved it flashes that fact and then prompts another puzzle
WHILE 1
    COLOR _RGB32(200, 200, 200), _RGB32(0, 0, 128)
    CLS
    'get desired level of difficulty set
    LOCATE 5, 5: PRINT "Welcome to QB 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 "; lvl$
    IF INSTR("0123456789", lvl$) THEN level = VAL(lvl$) ELSE CLS: END

    'globals
    bx = 0: by = 0 '      current highlighted location on board
    mkey = 1 '            current key highlighted on keyPad, key = 0 clears cell
    update = 1 '          when to show game board
    ERASE grid '          9x9 board positive values are puzzle clues
    '                     0 value in grid is blank cell to fill out
    '                     neg values in grid are players guesses to solve 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
        'get next mouse click, check if in board and if so update x, y
        m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
        IF mb THEN 'get last place mouse button was down
            mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
            WHILE mb 'left button down, wait for mouse button release
                m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
            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 mkey = 0 THEN grid(bx, by) = 0 ELSE grid(bx, by) = -mkey
                END IF
                update = 1
            END IF
            'clicked inside keyPad?
            IF xMinKeyPad <= mx AND mx <= xMaxKeyPad AND yMinKeyPad <= my AND my <= yMaxKeyPad THEN
                mkey = INT((mx - xMinKeyPad) / CellSize)
                update = 1
            END IF
            'clicked exit?
            IF xMidBoard - 3 * CellSize <= mx AND mx <= xMidBoard + 3 * CellSize THEN
                IF yMaxKeyPad + CellSize <= my AND my <= yMaxKeyPad + 2 * CellSize THEN xit = 1: EXIT WHILE
            END IF
        END IF
        _DISPLAY
        _LIMIT 1000 '? save fan?
    WEND
    IF xit THEN
        xit = 0
    ELSE
        BEEP
        t# = TIMER
        WHILE (TIMER - t# < 6)
            showGrid
            _DISPLAY
            _DELAY 1
            COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0) 'EDIT fix for QB64
            CLS
            _PRINTSTRING (xMidBoard - 7 * TextSize, yMidBoard - .5 * TextSize), "Puzzle solved!"
            _DISPLAY
            _DELAY .5 'changed with EDIT
        WEND
    END IF
WEND

FUNCTION solved%
    solved% = 0 'n must be found in every column, row and 3x3 cell
    FOR n = 1 TO 9
        'check coloumns 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 FUNCTION
        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 FUNCTION
        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 FUNCTION
        NEXT
    NEXT
    solved% = -1
END FUNCTION

' displays the game grid
SUB showGrid ()
    update = 0 'global calls for this display
    'local x, y, i, j, b
    b& = _RGB32(0, 0, 40)
    COLOR _RGB(255, 255, 255), b&: CLS
    LOCATE 2, 22: PRINT "Sudoku Level "; RIGHT$(STR$(level), 1)
    LINE (xMidBoard - 3 * CellSize, yMaxKeyPad + CellSize)-(xMidBoard + 3 * CellSize, yMaxKeyPad + 2 * CellSize), _RGB32(255, 0, 0), BF
    COLOR _RGB32(190, 190, 190), _RGB32(255, 0, 0)
    _PRINTSTRING (xMidBoard - 2 * TextSize, yMaxKeyPad + CellSize + TextSize + 4), "EXIT"
    'draw line segments
    i = xMinBoard
    FOR x = 0 TO 9
        LINE (i, yMinBoard)-(i, yMaxBoard), _RGB32(255, 0, 255)
        i = i + CellSize
    NEXT x
    j = yMinBoard
    FOR y = 0 TO 9
        LINE (xMinBoard, j)-(xMaxBoard, j), _RGB32(255, 0, 255)
        j = j + CellSize
    NEXT y
    'draw heavy 3x3 cell borders
    LINE (xMinBoard + 1, yMinBoard + 1)-(xMaxBoard + 1, yMaxBoard + 1), _RGB(255, 255, 255), B
    i = xMinBoard + (CellSize * 3) + 1
    LINE (i, yMinBoard)-(i, yMaxBoard), _RGB(255, 255, 255)
    i = xMinBoard + (CellSize * 6) + 1
    LINE (i, yMinBoard)-(i, yMaxBoard), _RGB(255, 255, 255)
    j = yMinBoard + (CellSize * 3) + 1
    LINE (xMinBoard, j)-(xMaxBoard, j), _RGB(255, 255, 255)
    j = yMinBoard + (CellSize * 6) + 1
    LINE (xMinBoard, j)-(xMaxBoard, j), _RGB(255, 255, 255)
    FOR y = 0 TO 8
        FOR x = 0 TO 8
            'highlite?
            IF x = bx AND y = by THEN
                COLOR b&, _RGB32(0, 255, 0)
                LINE (xMinBoard + x * CellSize + 3, yMinBoard + y * CellSize + 3)-STEP(CellSize - 5, CellSize - 5), _RGB32(0, 255, 0), BF
            ELSE
                IF grid(x, y) > 0 THEN COLOR _RGB32(0, 0, 255), b& ELSE COLOR _RGB32(190, 190, 190), b&
            END IF
            IF grid(x, y) <> 0 THEN
                _PRINTSTRING (xMinBoard + (x * CellSize) + (TextSize * 2), yMinBoard + (y * CellSize) + TextSize + 4), RIGHT$(STR$(ABS(grid(x, y))), 1)
            END IF
        NEXT
    NEXT
    'show a keypad key with highlite
    i = xMinKeyPad
    FOR x = 0 TO 9
        IF x = mkey THEN
            LINE (i + 3, yMinKeyPad + 3)-STEP(CellSize - 5, CellSize - 5), _RGB32(0, 255, 0), BF
            COLOR b&, _RGB32(0, 255, 0)
        ELSE
            COLOR _RGB32(0, 255, 255), b&
        END IF
        LINE (i, yMinKeyPad)-(i, yMaxKeyPad), _RGB32(190, 190, 190)
        _PRINTSTRING (i + (TextSize * 2), yMinKeyPad + TextSize + 4), RIGHT$(STR$(x), 1)
        i = i + CellSize
    NEXT
    LINE (xMinKeyPad, yMinKeyPad)-(xMaxKeyPad, yMaxKeyPad), _RGB32(190, 190, 190), B
END SUB

FUNCTION loadCell (n, cellBlock)
    'EDIT next 3 lines instead of 13 lines of select case
    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 clist(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
                    END IF
                NEXT
                IF bad = 0 THEN
                    FOR xx = 0 TO xstop
                        IF grid(xx, yoff + y) = n THEN
                            bad = 1
                            EXIT FOR
                        END IF
                    NEXT
                END IF
                IF bad = 0 THEN available = available + 1: clist(3 * y + x) = 1
            END IF
        NEXT
    NEXT
    IF available = 0 THEN loadCell = 0: EXIT FUNCTION
    DIM cell(1 TO available): pointer = 1
    FOR i = 0 TO 8
        IF clist(i) THEN cell(pointer) = i: pointer = pointer + 1
    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
    END IF
    'load the first one listed
    grid(xoff + (cell(1) MOD 3), yoff + INT(cell(1) / 3)) = n
    loadCell = 1
END FUNCTION

SUB makeGrid 'this version requires the assistance of loadCell sub routine
    DO
        ERASE grid, temp
        startOver = 0
        FOR n = 1 TO 9
            FOR r = 0 TO 8
                FOR c = 0 TO 8
                    temp(c, r) = grid(c, r)
                NEXT
            NEXT
            cnt = 0
            DO
                FOR cellBlock = 0 TO 8
                    success = loadCell(n, cellBlock)
                    IF success = 0 THEN
                        cnt = cnt + 1 'EDIT remove the counters used to test code tCnt and tStartOver
                        IF cnt >= 20 THEN startOver = 1: EXIT FOR
                        'EDIT supposed to be comment grid = temp
                        FOR r = 0 TO 8
                            FOR c = 0 TO 8
                                grid(c, r) = temp(c, r)
                            NEXT
                        NEXT

                        EXIT FOR
                    END IF
                NEXT
                IF startOver THEN EXIT DO
            LOOP UNTIL success
            IF startOver THEN EXIT FOR
        NEXT
    LOOP UNTIL startOver = 0
END SUB

SUB hideCells
    FOR r = 0 TO 8
        FOR c = 0 TO 8
            temp(c, r) = grid(c, r)
        NEXT
    NEXT
    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
        REDIM 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
                FOR r = 0 TO 8
                    FOR c = 0 TO 8
                        grid(c, r) = temp(c, r)
                    NEXT
                NEXT
            END IF
        END IF
    WEND
END SUB

BTW a beep when starting level 0 means puzzle is already solved.

A beep likely on level 7 and very likely on level 8 and surely on level 9 means that the whole set of numbers 1 to 9 is not showing in clues.

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:49 PM (This post was last modified: 01-21-2018 02:23 AM by bplus.)
Post: #5
 (Print Post)
opps wrong board. 

Delete still wont work for me.


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, 01:04 PM
Post: #6
 (Print Post)
@Bplus,

You can not delete the first post of a thread, or a thread itself. That is why there are no "X" at the bottom right of all first posts in a thread. I will not allow deleting a thread because that would delete posts of others, which could possibly cause havoc.

I have created a new account to test this forum to make sure things are working probably, and so far everything seems to be working as they are suppose to.

Dedicated to working with computer programming hobbyists, tinkerers, amateurs, and enthusiasts.
Find all posts by this user
Like Post
01-21-2018, 01:51 PM (This post was last modified: 01-21-2018 01:53 PM by bplus.)
Post: #7
 (Print Post)
The post I am trying to delete IS NOT THE FIRST POST.

The post I was trying to delete was the post where I am showing you all the the delete screen shots of attempts to delete, post #5, NOT the first.

I did see the red x before when this was discussed on another board, may have been in on another machine but with same browser. That is why I suspect it is the board I am trying to delete from...

If we cant delete posts from the editor when in Full Editor mode, why show the option? It's just teasing us with a big friendly obvious option which is easier to find than red x.

Another possible, do I have to watch commercials to see the red x delete button? because my browser has the blocker going.


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, 02:09 PM (This post was last modified: 01-21-2018 02:14 PM by bplus.)
Post: #8
 (Print Post)
Nope! I am sure it is not the ad blocker because the red x button does show up on another board where we are talking about deleting posts.

Sudoku says, "It must be this board!" there is no other logical option.

Wait... maybe it was Spock who will say it sometime in the future...

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-23-2018, 10:21 PM (This post was last modified: 01-24-2018 05:11 PM by bplus.)
Post: #9
 (Print Post)
OK fully featured Sudoku App, I will let screen shots tell story of Recursive Solver, most excellent Help toggle, Save and Load file..

Oh yeah the temp files are editable with Notepad.


Attached File(s) Image(s)
                       

.zip  QB3_1 Sudoku App.zip (Size: 6.26 KB / Downloads: 2)

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-24-2018, 05:13 PM
Post: #10
 (Print Post)
Oops, number key presses were not being entered into the grid as negative thus making the entries look and act like clues.

Fixed in QB3_1 Sudoku App.zip attached in the above post.

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