Sudoku Solver (re-done)

Source-code only - please, don't post questions here.
dodicat
Posts: 4951
Joined: Jan 10, 2006 20:30
Location: Scotland

Sudoku Solver (re-done)

Postby dodicat » Oct 03, 2011 23:36

This is a remake of my previous Sudoku solver.
I Havn't tried it on Linux yet, but I've shelled Gedit to open the optional (save), as well as notepad.
Sudoko solver only here, to include a Sudoku game, the file would be too long.
Edited 9 October.
Shortened the file and altered the colours a bit to suit Linux, and tested on PCLINUXOS.

Code: Select all


'Sodoku solver ~ Linux/Windows
Type d2
    As Integer x,y,w,h,index
    As Uinteger colour
    As String caption
End Type
#macro Typed2(num,_x,_y,_w,_h,_index,_colour,_caption)
num.x=_x:num.y=_y:num.w=_w:num.h=_h:num.index=_index:num.colour=_colour:num.caption=_caption
#endmacro
#define xs exit sub
#define xf exit function
Declare Sub thickline(x1 As Double,_
y1 As Double,_
x2 As Double,_
y2 As Double,_
thickness As Double,_
colour As Uinteger,_
im As Any Pointer=0)
Dim Shared As Integer getout
Declare Sub main
Declare  Sub setboxes
Declare Sub inspect_boxes(mouse As d2)
Declare Sub drawbox(p() As d2,i As Integer,col As Uinteger,th As Single=1,pnt As String="paint",im As Any Pointer=0)
Function inbox(p1() As d2,p As d2,i As Integer) As Integer
    Return (p.x>p1(i).x)*(p.x<(p1(i).x+p1(i).w))*(p.y>p1(i).y)*(p.y<(p1(i).y+p1(i).h))
End Function
#macro incircle(cx,cy,radius,x,y)
(cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
#endmacro
Declare Function roundup (a As Double, b As Integer) As Single
Declare Sub solve3 ()
Declare Sub textend ()
Declare Sub printbox2 (s As String)
Declare Sub timeout ()
Declare Sub setinrow ()
Declare Sub solve2 ()
Declare Sub whatsize (n As String)
Declare Sub phase (number As Integer)
Declare Sub setkeep ()
Declare Sub makekeep (m As Integer)
Declare Function ninebox (m As Integer) As Integer
Declare Sub makehops ()
Declare Sub makeb ()
Declare Sub actions(bo1 As String,bo2 As String,label As String,action As String)
Declare Sub setsquare (y As Integer, x As Integer)
Declare Function boxcheck (in() As Integer, m As Integer, al As Integer, dow As Integer) As Integer
Declare Sub dummy ()
Declare Sub setup ()
Declare Sub build (z As Integer)
Declare Function bigcheck () As Integer
Declare Function weecheck (m As Integer) As Integer
Declare Function cycle (x As Integer) As Integer
Declare Sub solve ()
Declare Function runcheck (n As Integer, x As Integer, y As Integer, m As Integer) As Integer
Declare Function checkerr (m2() As Integer, x As Integer, y As Integer) As Integer
Declare Sub grid ()
Declare Sub box2 (s As String)
Const ok = 1
Const notok = 0
Dim Shared mglobal(9,9) As Integer
Dim Shared square As Integer
Dim Shared bb(1 To 9) As Integer
Dim Shared hopper(1 To 9) As Integer
Dim As Integer a1,b1
Dim Shared inrow(9, 9) As Integer
Dim Shared incol(9, 9) As Integer
Dim Shared keep(9, 9) As Integer
Dim Shared startall As Double
Dim Shared endall As Double
Dim Shared boxes As Integer
Dim Shared As d2 big(9*9),p,nums(9),info(1),help(0)
Dim Shared As Integer xres,yres,dragflag,helpflag,errorflag
Dim Shared As String dragnum
'____________________
Screen 19,32
Screeninfo (xres,yres)
setboxes
main
startall=Timer
Cls
boxes = 1
grid
For a1 = 1 To 9
    For b1 = 1 To 9
        keep(a1, b1) = mglobal(a1, b1)
    Next b1
Next a1 
box2("n")
setup
whatsize("show")
solve
'_____________________
Function bigcheck As Integer
    Dim a As Integer
    Dim b As Integer
    For a = 1 To 9
        For b = 1 To 9
            If inrow(a, b) = 0 Then
                bigcheck = notok
                Exit Function
            End If
            If runcheck(inrow(a, b), a, b, 0) = notok Then
                bigcheck = notok
                Exit Function
            End If
        Next b
    Next a
    bigcheck = ok
End Function

Sub box2 (s As String)
    Dim a1 As Integer
    Dim b1 As Integer
    Color 2, 4
    For a1 = 1 To 9
        For b1 = 1 To 9
            Locate (2 * a1), 25 + 4 * b1
            If mglobal(a1, b1) <> 0 Then Color 1, 4
            If s = "c" Then Print incol(a1, b1)
            If s = "r" Then Print inrow(a1, b1)
            If s = "k" Then Print keep(a1, b1)
            If s = "n" Then Print mglobal(a1,b1)
            Color 2, 4
        Next b1
    Next a1
    Color 15, 4
End Sub
Function boxcheck (in() As Integer, m As Integer, al As Integer, dow As Integer) As Integer
    Dim As Integer along=Any,down=Any,a=Any,d=Any,c,flag
    boxcheck = ok
    If in(al, dow) = 0 Then
        boxcheck = ok
        xf
    End If
    #macro _check()
    flag=1
    If c > 1 Then
        boxcheck = notok
        xf
    End If
    #endmacro
    #macro set(f1,f2,s1,s2)
    boxcheck=ok
    For along=f1
        For down=f2
            c=0
            For a=s1
                For d=s2
                    flag=0
                    If in(along, down) = 0 Then:_check():End If
                    If flag=0 Then
                        If in(along, down) = in(a, d) Then c = c + 1
                        _check()
                    End If
                Next d
            Next a
        Next down
    Next along
    #endmacro
    If m=1 Then :set(1 To 3,1 To 3,1 To 3,1 To 3):End If
    If m=2 Then :set(1 To 3,4 To 6,1 To 3,4 To 6):End If
    If m=3 Then :set(1 To 3,7 To 9,1 To 3,7 To 9):End If
    If m=4 Then :set(4 To 6,1 To 3,4 To 6,1 To 3):End If
    If m=5 Then :set(4 To 6,4 To 6,4 To 6,4 To 6):End If
    If m=6 Then :set(4 To 6,7 To 9,4 To 6,7 To 9):End If
    If m=7 Then :set(7 To 9,1 To 3,7 To 9,1 To 3):End If
    If m=8 Then :set(7 To 9,4 To 6,7 To 9,4 To 6):End If
    If m=9 Then :set(7 To 9,7 To 9,7 To 9,7 To 9):End If
   
End Function
Sub build (z As Integer)
    Dim  As Integer _p=Any,_q=Any
    #macro set(_a1,_a2,_b1,_b2)
    For _p=_a1 To _a2
        For _q=_b1 To _b2
            incol(_q, _p) = inrow(_q, _p)   
        Next _q
    Next _p
    #endmacro 
    If z=1 Then:set(1,3,1,3):xs:End If
    If z=2 Then:set(1,3,4,6):xs:End If
    If z=3 Then:set(1,3,7,9):xs:End If
    If z=4 Then:set(4,6,1,3):xs:End If
    If z=5 Then:set(4,6,4,6):xs:End If
    If z=6 Then:set(4,6,7,9):xs:End If
    If z=7 Then:set(7,9,1,3):xs:End If
    If z=8 Then:set(7,9,4,6):xs:End If
    If z=9 Then:set(7,9,7,9):xs:End If
   
End Sub
Function checkerr (m2() As Integer, x As Integer, y As Integer) As Integer
    Dim count As Integer
    For count = 1 To 9
        If count = y Then Goto endrow
        If m2(x, y) <> 0 Then
            If m2(x, y) = m2(x, count) Then
                checkerr = notok
                Exit Function
            End If
        End If
        checkerr = ok
        endrow:
    Next count
    For count = 1 To 9
        If count = x Then Goto endcol
        If m2(x, y) <> 0 Then
            If m2(x, y) = m2(count, y) Then
                checkerr = notok
                Exit Function
            End If
        End If
        checkerr = ok
        endcol:
    Next count
End Function

Function cycle (x As Integer) As Integer
    If x Mod 9 = 0 Then
        cycle = 9
    Else
        cycle = x Mod 9
    End If
End Function
Sub dummy ()
    If Inkey$ <> "" Then
        Dim what As String 
        doagain:
        Locate 4, 4
        Print "q for quit"
        Print "   c to continue"
        what = Input$(1)
        what = Lcase$(what)
        If Instr("qcqc", what) = 0 Then
            Print "mistake, q/c"
            Goto doagain
        End If
        Locate 4, 4
        Print "           "
        Print "                    "
        If what = "q" Then End
        If what = "c" Then Exit Sub
    End If
End Sub
Sub grid
    Dim As Integer xtemp,ytemp,xpix,ypix,col,col2
    For a2 As Integer=1 To 10
        For b2 As Integer=1 To 10
            If (a2-1) Mod 3 =0 Then
                col=7
            Else
                col=8
            End If
            If (b2-1) Mod 3 =0 Then
                col2=7
            Else
                col2=8
            End If
            xtemp=25+4*b2
            xpix = (640 * (xtemp - 1)) / 79-10
            ytemp = 2 * a2
            ypix = (350 * (ytemp - 1)) / 25 - 8
            If b2<>10 Then Line(xpix,ypix)-(xpix+32,ypix),col
            If a2<>10 Then Line(xpix,ypix)-(xpix,ypix+28),col2
        Next b2
    Next a2
End Sub
Sub makeb
    Dim As Integer x,y,marker
    For x = 1 To 9
        dooagain:
        marker = ok
        bb(x) = Int(((9 - 1) + 1) * Rnd + 1)
        If x > 1 Then
            For y = 1 To x - 1
                If bb(x) = bb(y) Then
                    marker = notok
                    Exit For
                End If
            Next y
        End If
        If marker = notok Then Goto dooagain
    Next x
End Sub
Sub makehops
    Dim As Integer x,y,marker
    For x = 1 To 9
        dooagain2:
        marker = ok
        hopper(x) = Int(((9 - 1) + 1) * Rnd + 1)
        If x > 1 Then
            For y = 1 To x - 1
                If hopper(x) = hopper(y) Then
                    marker = notok
                    Exit For
                End If
            Next y
        End If
        If marker = notok Then Goto dooagain2
    Next x
End Sub
Sub makekeep (m As Integer)
    Dim  As Integer _p=Any,_q=Any
    #macro set(_a1,_a2,_b1,_b2)
    For _p=_a1 To _a2
        For _q=_b1 To _b2
            keep(_p,_q)=incol(_p,_q)
        Next _q
    Next _p
    #endmacro
    If m=1 Then:set(1,3,1,3):xs:End If
    If m=2 Then:set(1,3,4,6):xs:End If
    If m=3 Then:set(1,3,7,9):xs:End If
    If m=4 Then:set(4,6,1,3):xs:End If
    If m=5 Then:set(4,6,4,6):xs:End If
    If m=6 Then:set(4,6,7,9):xs:End If
    If m=7 Then:set(7,9,1,3):xs:End If
    If m=8 Then:set(7,9,4,6):xs:End If
    If m=9 Then:set(7,9,7,9):xs:End If
   
End Sub
Function ninebox (m As Integer) As Integer
    ninebox = notok
    Dim  As Integer _p=Any,_q=Any
    #macro set(_a1,_a2,_b1,_b2)
    For _p=_a1 To _a2
        For _q=_b1 To _b2
            If keep(_p,_q)=0 Then xf
        Next _q
    Next _p
    #endmacro
    If m=1 Then:set(1,3,1,3):End If
    If m=2 Then:set(1,3,4,6):End If
    If m=3 Then:set(1,3,7,9):End If
    If m=4 Then:set(4,6,1,3):End If
    If m=5 Then:set(4,6,4,6):End If
    If m=6 Then:set(4,6,7,9):End If
    If m=7 Then:set(7,9,1,3):End If
    If m=8 Then:set(7,9,4,6):End If
    If m=9 Then:set(7,9,7,9):End If
    ninebox = ok
End Function
Sub phase (number As Integer)
    actions("-1","-1","solving","phase "+Str$(number))
End Sub
Sub printbox2 (s As String)
    Open "results.txt" For Output As #1
    For a1 As Integer = 1 To 9
        For b1 As Integer = 1 To 9
            Print #1, inrow(a1,b1);
        Next b1
        Print #1, " "
    Next a1
    Close #1
    Shell "gedit results.txt"
    Shell "notepad.exe results.txt"
End Sub
Function roundup (a As Double, b As Integer) As Single
    Dim As Single y,i,r
    y = (Abs(a) - Int(Abs(a))) * (10 ^ b)
    i = Int(y)
    y = y - i
    If y >= .5 Then i = i + 1
    i = i / (10 ^ b)
    r = Int(Abs(a)) + i
    If a < 0 Then r = -r
    roundup = r
End Function
Function runcheck (n As Integer, x As Integer, y As Integer, m As Integer) As Integer
    Dim As Integer a=Any,d=Any,count=Any
    For count = 1 To 9
        If count = y Then Goto nextinrow2
        If n = inrow(x, count) Then
            runcheck = notok
            Exit Function
        End If
        runcheck = ok
        nextinrow2:
    Next count
    For count = 1 To 9
        If count = x Then Goto endcol3
        If n = inrow(count, y) Then
            runcheck = notok
            Exit Function
        End If
        runcheck = ok
        endcol3:
    Next count
    #macro set(a1,a2)
    For a=a1
        For d=a2
            If n = inrow(a, d) Then
                runcheck = notok
                xf
            End If
        Next d
    Next a
    #endmacro
    If m=1 Then:set(1 To 3,1 To 3):End If
    If m=2 Then:set(1 To 3,4 To 6):End If
    If m=3 Then:set(1 To 3,7 To 9):End If
    If m=4 Then:set(4 To 6,1 To 3):End If
    If m=5 Then:set(4 To 6,4 To 6):End If
    If m=6 Then:set(4 To 6,7 To 9):End If
    If m=7 Then:set(7 To 9,1 To 3):End If
    If m=8 Then:set(7 To 9,4 To 6):End If
    If m=9 Then:set(7 To 9,7 To 9):End If
   
End Function
Sub setinrow
    Dim along As Integer
    Dim down As Integer
    For along = 1 To 9
        For down = 1 To 9
            inrow(along, down) = keep(along, down)
        Next down
    Next along
End Sub
Sub setkeep
    Dim As Integer a=Any,b=Any
    For a = 1 To 9
        For b = 1 To 9
            keep(a, b) = mglobal(a, b)
        Next b
    Next a
End Sub
Sub setsquare (y As Integer, x As Integer)
    #macro set(a,b,num)
    If  a Then
        If  b Then
            square=num
            xs
        End If
    End If
    #endmacro
    If y <= 3 And x <= 3 Then
        square = 1
    End If
    set(y<= 3,x> 3 And x < 7,2)
    set(y<= 3,x> 6 And x <= 9,3)
    set(y > 3 And y < 7,x <= 3,4)
    set(y > 3 And y < 7,x > 3 And x < 7,5)
    set(y > 3 And y < 7,x > 6 And x <= 9,6)
    set(y > 6 And y <= 9,x <= 3,7)
    set(y > 6 And y <= 9,x > 3 And x < 7,8)
    set(y > 6 And y <= 9,x > 6 And x <= 9,9)
End Sub
Sub setup
    Dim a1 As Integer
    Dim b1 As Integer
    For a1 = 1 To 9
        For b1 = 1 To 9
            inrow(a1, b1) = mglobal(a1, b1)
        Next b1
    Next a1
End Sub
Sub solve
    Dim As Integer along,down,n,hop,hops,skip,b,flag,flag2,first,middle,zz,zzz,zzb
    Dim madeincol As Integer
    Dim hopcount As Integer
    Dim As Single start,finish
    actions("-1","-1","solving","phase 1")
    zzb = 0
    madeincol = notok
    Randomize Timer
    startup:
    Do
        make:
        hopcount = 0
        Locate 23, 52
        Print Chr$(flag2 Mod 4)
        dummy ()
        If flag2 > flag Then flag = flag2
        flag2 = 0
        makehops
        For hops = 1 To 9
            flag2 = flag2 + 1
            hop = hopper(hops)
            If hop = 1 Then skip = 2
            If hop = 2 Then skip = 2
            If hop = 3 Then skip = 2
            If hop = 4 Then skip = 5
            If hop = 5 Then skip = 5
            If hop = 6 Then skip = 5
            If hop = 7 Then skip = 8
            If hop = 8 Then skip = 8
            If hop = 9 Then skip = 8
            If hop <= 3 Then middle = 3 * hop - 1
            If hop >= 4 And hop <= 6 Then
                middle = 3 * hop - 10
            End If
            If hop >= 7 And hop <= 9 Then
                middle = 3 * hop - 19
            End If
            start = Timer
            Do
                hopcount = hopcount + 1
                boxer:
                For along = skip - 1 To skip + 1
                    For down = middle - 1 To middle + 1
                        If mglobal(along, down) = 0 Then
                            makeb
                            For n = 1 To 9
                                If runcheck(bb(n), along, down, hop) = ok Then
                                    inrow(along, down) = bb(n)
                                    Exit For
                                End If
                            Next n
                        End If
                    Next down
                Next along
                finish = Timer
               
                If hopcount > 40 Then
                    setup
                    Goto make
                End If
            Loop Until weecheck(hop) = ok
            If flag2 >= 8 Then     
                For zzz = 1 To 9
                    build(zzz)
                Next zzz
                madeincol = ok
                zzb = zzb + 1
            End If
            If zzb >= boxes And madeincol = ok Then
                setup
                setkeep
                box2 ("c")
                solve3                                     
            End If
        Next hops
        If bigcheck = notok Then
            setup
            Goto make                   
        End If
    Loop Until bigcheck = ok
    endall = Timer
End Sub
Sub solve2
    Dim As Integer along,down,n,hop,hops,skip,b,flag,flag2,first,middle,zz,zzz,zzb
    Dim start2 As Single
    Dim finish2 As Single
    Dim xxx As Integer
    Dim hopcount As Integer
    Dim shiftcount As Integer
    Dim As Single start,finish
    Randomize Timer
    startup2:
    For xxx = 1 To 18
        zz = cycle(xxx)
        makekeep(zz)       
        setinrow           
        If ninebox(zz) = notok Then Goto zznext             
        actions(Str$(zz),"-1","solving","phase 3  ")
        box2 ("n")               
        box2 ("k")
        shiftcount = 0
        make2:
        shiftcount = shiftcount + 1
        hopcount = 0
        If flag2 > flag Then flag = flag2
        flag2 = 0
        makehops
        For hops = 1 To 9
            flag2 = flag2 + 1
            hop = hopper(hops)
            If hop = 1 Then skip = 2
            If hop = 2 Then skip = 2
            If hop = 3 Then skip = 2
            If hop = 4 Then skip = 5
            If hop = 5 Then skip = 5
            If hop = 6 Then skip = 5
            If hop = 7 Then skip = 8
            If hop = 8 Then skip = 8
            If hop = 9 Then skip = 8
            If hop <= 3 Then middle = 3 * hop - 1
            If hop >= 4 And hop <= 6 Then
                middle = 3 * hop - 10
            End If
            If hop >= 7 And hop <= 9 Then
                middle = 3 * hop - 19
            End If
            Do
                hopcount = hopcount + 1
                dummy ()       
                For along = skip - 1 To skip + 1
                    For down = middle - 1 To middle + 1
                        If keep(along, down) = 0 Then       
                            makeb
                            For n = 1 To 9
                                If runcheck(bb(n), along, down, hop) = ok Then
                                    inrow(along, down) = bb(n)
                                    Exit For
                                End If
                            Next n
                        End If
                    Next down
                Next along
                finish = Timer
                If hopcount > 40 Then
                    setinrow           
                    Goto make2
                End If
            Loop Until weecheck(hop) = ok
            missahop:
            If shiftcount > 200 Then
                setkeep
                Goto zznext
            End If
        Next hops
        If bigcheck = ok Then Goto getout
        zznext:
    Next xxx
    setkeep
    Erase incol
    setup
    solve
    getout:
    endall = Timer
    box2 ("r")
    timeout
    actions("-1","-1","            ","                   ")
    actions("-1","-1","solved","Check completed")
    whatsize("")
    Locate 10, 10
    Print "finished"
    textend
    End
End Sub
Sub solve3
    Dim As Integer along,down,n,hop,hops,skip,b,flag,flag2,first,middle,zz,zzz,zzb
    Dim start2 As Single
    Dim finish2 As Single
    Dim xxx As Integer
    Dim yyy As Integer
    Dim hopcount As Integer
    Dim shiftcount As Integer
    Dim As Single start,finish
    Randomize Timer
    startup3:
    setkeep           
    For xxx = 1 To 8
        makekeep(xxx)   
        If ninebox(xxx) = notok Then Goto xxxnext3
        For yyy = xxx + 1 To 9
            makekeep(yyy)   
            If ninebox(yyy) = notok Then Goto yyynext3
            setinrow           
            box2 ("k")
            actions(Str$(xxx),Str$(yyy),"solving","phase 2")
            shiftcount = 0
            make3:
            shiftcount = shiftcount + 1
            hopcount = 0
            If flag2 > flag Then flag = flag2
            flag2 = 0
            makehops
            For hops = 1 To 9
                flag2 = flag2 + 1
                hop = hopper(hops)
                If hop = 1 Then skip = 2
                If hop = 2 Then skip = 2
                If hop = 3 Then skip = 2
                If hop = 4 Then skip = 5
                If hop = 5 Then skip = 5
                If hop = 6 Then skip = 5
                If hop = 7 Then skip = 8
                If hop = 8 Then skip = 8
                If hop = 9 Then skip = 8
                If hop <= 3 Then middle = 3 * hop - 1
                If hop >= 4 And hop <= 6 Then
                    middle = 3 * hop - 10
                End If
                If hop >= 7 And hop <= 9 Then
                    middle = 3 * hop - 19
                End If
                start = Timer
                Do
                    hopcount = hopcount + 1
                    dummy ()       
                    For along = skip - 1 To skip + 1
                        For down = middle - 1 To middle + 1
                            If keep(along, down) = 0 Then   
                                makeb
                                For n = 1 To 9
                                    If runcheck(bb(n), along, down, hop) = ok Then
                                        inrow(along, down) = bb(n)
                                        Exit For
                                    End If
                                Next n
                            End If
                        Next down
                    Next along
                    finish = Timer
                    If hopcount > 40 Then
                        setinrow           
                        Goto make3
                    End If
                Loop Until weecheck(hop) = ok
                missahop3:
                If shiftcount > 200 Then
                    setup
                    setkeep
                    makekeep(xxx)
                    Goto yyynext3
                End If
            Next hops
            If bigcheck = ok Then Goto getout3
            yyynext3:
        Next yyy
        setup
        setkeep
        xxxnext3:
    Next xxx
    setkeep
    setup
    Locate 9, 1
    Print "          "
    solve2
    getout3:
    endall = Timer
    box2 ("r")
    timeout
    actions("-1","-1","            ","                   ")
    actions("-1","-1","","Check completed")
    whatsize("")
    Locate 10, 10
    Print "finished"
    textend
    End
End Sub
Sub textend
    Dim As Integer mx,my,mw,mb
    Do
        Getmouse mx,my,mw,mb
        Screenlock
        Circle(550,50),30,,,,,f
        Circle(550,50),30,9
        Draw String(540,45),"Quit",3
        If incircle(550,50,30,mx,my) And mb<>0 Then
            Screenunlock
            End
        End If
        Circle(550,150),30,,,,,f
        Circle(550,150),30,9
        Draw String(540,145),"Save",3
        If incircle(550,150,30,mx,my) And mb<>0 Then
            Screenunlock
            printbox2("r")
            Exit Sub
        End If
        Screenunlock
        Sleep 1,1
    Loop Until Inkey=Chr(27)
End Sub
Sub timeout
    Dim seconds As Double
    Dim minutes As Double
    seconds = endall - startall
    minutes = seconds / 60
    Locate 13, 2
    If seconds <= 60 Then
        Print "Time = ";
        Print Using "##.#";roundup(Cdbl(seconds), 1);
        Print "s"
    Else
        seconds = roundup(Cdbl((minutes - Int(minutes)) * 60), 1)
        Print "Time = ";Int(minutes);
        Print "m ";
        Print Using "##.#";seconds;
        Print "s"
    End If
End Sub
Function weecheck (m As Integer) As Integer
    Dim As Integer along=Any,down=Any,a=Any,d=Any,c
    #macro set(f1,f2,s1,s2)
    weecheck=ok
    For along=f1
        For down=f2
            c=0
            For a=s1
                For d=s2
                    If inrow(along, down) = 0 Then
                        weecheck = notok
                        Exit Function
                    End If
                    If inrow(along, down) = inrow(a, d) Then c = c + 1
                    If c > 1 Then
                        weecheck = notok
                        Exit Function
                    End If
                Next d
            Next a
        Next down
    Next along
    #endmacro
    If m=1 Then:set(1 To 3,1 To 3,1 To 3,1 To 3):End If
    If m=2 Then:set(1 To 3,4 To 6,1 To 3,4 To 6):End If
    If m=3 Then:set(1 To 3,7 To 9,1 To 3,7 To 9):End If
    If m=4 Then:set(4 To 6,1 To 3,4 To 6,1 To 3):End If
    If m=5 Then:set(4 To 6,4 To 6,4 To 6,4 To 6):End If
    If m=6 Then:set(4 To 6,7 To 9,4 To 6,7 To 9):End If
    If m=7 Then:set(7 To 9,1 To 3,7 To 9,1 To 3):End If
    If m=8 Then:set(7 To 9,4 To 6,7 To 9,4 To 6):End If
    If m=9 Then:set(7 To 9,7 To 9,7 To 9,7 To 9):End If
End Function
Sub whatsize(n As String)
    Locate 22, 4
    If n="show" Then
        Print "Press any key for quit option"
        startall = Timer
    Else
        Print "                                            "
    End If
End Sub
Sub actions(bo1 As String,bo2 As String,label As String,action As String)
    Locate 21,53
    Print label
    Locate 23, 53
    Print action
    Line(400,300)-(600,330),,B
    Locate 21,53
    If label="-1" Then label=""
    Print label
    Locate 23, 52
    Color 15
    If bo1="-1" Then bo1=""
    If bo2="-1" Then bo2=""
    If action="-1" Then action=""
    Print bo1+" ";bo2;"   "+action
End Sub
Sub thickline(x1 As Double,_
    y1 As Double,_
    x2 As Double,_
    y2 As Double,_
    thickness As Double,_
    colour As Uinteger,_
    im As Any Pointer=0)
    Dim p As Uinteger=Rgb(255, 255, 254)
    If thickness<2 Then
        Line(x1,y1)-(x2,y2),colour
    Else               
        Dim As Double h=Sqr((x2-x1)^2+(y2-y1)^2):If h=0 Then h=1e-6
        Dim As Double s= (y1-y2)/h ,c=(x2-x1)/h
        For x As Integer=1 To 2
            Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),p
            Line im,(x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
            Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),p
            Line im,(x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
            Paint im,((x1+x2)/2, (y1+y2)/2), p, p
            p=colour
        Next x
    End If
End Sub
Sub drawbox(p() As d2,i As Integer,col As Uinteger,th As Single=1,pnt As String="paint",im As Any Pointer=0)
    thickline(p(i).x,p(i).y,p(i).x+p(i).w,p(i).y,th,col,im)
    thickline(p(i).x+p(i).w,p(i).y,p(i).x+p(i).w,p(i).y+p(i).h,th,col,im)
    thickline(p(i).x+p(i).w,p(i).y+p(i).h,p(i).x,p(i).y+p(i).h,th,col,im)
    thickline(p(i).x,p(i).y+p(i).h,p(i).x,p(i).y,th,col,im)
    If pnt="paint" Then
        var xc=(p(i).x+p(i).x+p(i).w)/2
        var yc=(p(i).y+p(i).y+p(i).h)/2
        Paint(xc,yc),col,col
        If  i=0 Then p(i).caption=""
        Draw String(xc-5,yc-5),p(i).caption
    End If
End Sub
Sub setboxes
    Dim As Integer count
    For z2 As Integer = 0 To 8
        For z As Integer=0 To 8
            count=count+1
            Select Case count
            Case 1,2,3,10,11,12,19,20,21,7,8,9,16,17,18,25,26,27
                big(count).colour=Rgb(100,0,0)
            Case 55,56,57,64,65,66,73,74,75,61,62,63,70,71,72,79,80,81,31,32,33,40,41,42,49,50,51
                big(count).colour=Rgb(100,0,0)
            Case Else
                big(count).colour=Rgb(0,100,0)
            End Select
            Typed2(big(count),(10+z*33),(10+z2*33),30,30,count,big(count).colour,"")
        Next z
    Next z2
    For z As Integer=0 To 9
        typed2(nums(z),(.8*xres),(z*53),50,50,z,Rgb(100,100,100),Str(z))
    Next z
    typed2(info(1),(.5*xres),0,70,20,1,Rgb(255,0,0),"?")
    typed2(help(0),(.4*xres),21,310,200,0,Rgb(255,255,255),"")
End Sub
Sub inspect_boxes(mouse As d2)
    #macro doublecheck(p1,p2)
    setsquare(p1,p2)
    If checkerr(mglobal(), p1, p2) = notok Or boxcheck(mglobal(), square, p1, p2) = notok Then
        Beep
        big(z).caption=""
        mglobal(p1,p2)=0
        errorflag=1
    Else
        errorflag=0
    End If
    #endmacro
    Dim As Integer vd
    Dim As Uinteger edge,numedge,infoedge=Rgb(0,0,200),helpedge
    For z As Integer=0 To Ubound(big)
        If inbox(big(),mouse,big(z).index) Then
            edge=Rgb(200,200,0)
        Else
            edge=Rgb(00,00,200)
        End If
        'numbers
        If z<=9 Then
            If inbox(nums(),mouse,nums(z).index) Then
                numedge=Rgb(200,200,0)
            Else
                numedge=Rgb(0,0,200)
            End If
        End If
        'numbers
        If z<=9 Then
            drawbox(nums(),nums(z).index,nums(z).colour,1)
            drawbox(nums(),nums(z).index,numedge,2,"")
            If inbox(nums(),mouse,nums(z).index) And mouse.w<>0 Then
                dragflag=1
                dragnum=nums(z).caption
                errorflag=0
            End If
        End If
        drawbox(big(),big(z).index,big(z).colour,1)
        drawbox(big(),big(z).index,edge,2,"")
        If inbox(big(),mouse,big(z).index) And mouse.w<>0 Then
            big(z).caption=dragnum
            vd=z
            Select Case z
            Case 1 To 9
                mglobal(1,vd)=Valint(dragnum)
                doublecheck(1,vd)
            Case 10 To 18
                mglobal(2,vd-9)=Valint(dragnum)
                doublecheck(2,(vd-9))
            Case 19 To 27
                mglobal(3,vd-18)=Valint(dragnum)
                doublecheck(3,(vd-18))
            Case 28 To 36
                mglobal(4,vd-27)=Valint(dragnum)
                doublecheck(4,(vd-27))
            Case 37 To 45
                mglobal(5,vd-36)=Valint(dragnum)
                doublecheck(5,(vd-36))
            Case 46 To 54
                mglobal(6,vd-45)=Valint(dragnum)
                doublecheck(6,(vd-45))
            Case 55 To 63
                mglobal(7,vd-54)=Valint(dragnum)
                doublecheck(7,(vd-54))
            Case 64 To 72
                mglobal(8,vd-63)=Valint(dragnum)
                doublecheck(8,(vd-63))
            Case 73 To 81
                mglobal(9,vd-72)=Valint(dragnum)
                doublecheck(9,(vd-72))
            End Select
            dragflag=0
        End If
        If inbox(big(),mouse,big(z).index) Then
            Draw String(mouse.x,mouse.y-10),dragnum
            If dragnum="" Then Draw String(mouse.x,mouse.y-10),"///"
        End If
    Next z
    If inbox(info(),mouse,1) Then
        If helpflag=0 Then infoedge=Rgb(200,200,0)
    End If
    drawbox(info(),1,info(1).colour,1)
    drawbox(info(),1,infoedge,2,"")
    If inbox(info(),mouse,1) And mouse.w<>0 Then helpflag=1
    If helpflag Then
        drawbox(help(),0,help(0).colour,1)
        drawbox(help(),0,Rgb(200,0,00),2,"")
        Draw String(.41*xres,25),"Click a Grey box to fetch a digit",Rgb(0,0,0)
        Draw String(.41*xres,40),"Carry the digit to the Sudoku",Rgb(0,0,0)
        Draw String(.41*xres,55),"(Just click and carry, not drag)",Rgb(0,0,0)
        Draw String(.41*xres,80),"Click on a Sudoku box to deposit it",Rgb(0,0,0)
        Draw String(.41*xres,100),"Carry the blank to erase a number",Rgb(0,0,0)
        Draw String(.41*xres,120),"Fill all your required boxes and:",Rgb(0,0,0)
        Draw String(.41*xres,140),"Click solve when ready",Rgb(0,0,0)
        Circle(.4*xres+50,180),20,Rgb(0,0,0)
        Draw String(.4*xres+40,175),"OK",Rgb(0,0,0)
        If inbox(help(),mouse,0) And mouse.w<>0 Then
            helpflag=0
        End If
    End If
    Circle(.97*xres,.05*yres),20,Rgb(200,0,0),,,,f
    Circle(.97*xres,.05*yres),20,Rgb(255,255,255)
    Draw String(.965*xres,.04*yres),"X"
    If incircle(.965*xres,.04*yres,20,mouse.x,mouse.y) And  mouse.w<>0 Then
        Screenunlock
        End
    End If
    Circle (.5*xres,.8*yres),30,Rgb(200,200,200),,,,f
    Circle (.5*xres,.8*yres),30,Rgb(0,200,0)
    Draw String(.48*xres,.79*yres),"Solve",Rgb(0,0,0)
    'SOLVE
    If incircle(.5*xres,.8*yres,30,mouse.x,mouse.y) And  mouse.w<>0 Then
        getout=1
        Screenunlock
        Screen 9
        Exit Sub
    End If
End Sub
Sub main
    Dim As Integer mx,my,mw,mb
    Dim As d2 mouse
    Dim As Uinteger edge
    Do
        If getout=1 Then Exit Sub
        Getmouse(mx,my,mw,mb)
        mouse.x=mx:mouse.y=my:mouse.w=mb
        Screenlock
        Cls
        If errorflag Then
            Draw String(.4*xres,yres/2),"ERROR:"
            Draw String(.4*xres,yres/2+30),"Number  " & dragnum &" has been misplaced"
        End If
        inspect_boxes(mouse)
        If dragflag Then
            If dragnum="" Then
                Draw String(mx,my-10),"///"
            Else
                Draw String(mx,my-10),dragnum
            End If
        End If
        Screenunlock
        Sleep 1,1
    Loop Until Inkey=Chr(27)
    End
End Sub

Last edited by dodicat on Oct 09, 2011 20:54, edited 1 time in total.
jdebord
Posts: 508
Joined: May 27, 2005 6:20
Location: Limoges, France
Contact:

Postby jdebord » Oct 04, 2011 8:04

I tried to compile, but got a bunch of errors.

Seems that the program is too long to be posted on the forum.

You may wish to post it on the FBMath mailing list. It has already the previous version.
bfuller
Posts: 326
Joined: Jun 02, 2007 12:35
Location: Sydney, Australia

Postby bfuller » Oct 04, 2011 10:12

@ jdebord
Worked fine for me. Just SELECT the code block, then CTRL C, then CTRL V into FBide, then F5 for quickrun.

@dodicat
did you code all that by hand? its a hell of a lot of typing (even if you did copy and paste the repetitive stuff)!
podvornyak
Posts: 148
Joined: Nov 12, 2007 11:46
Location: Russia

Postby podvornyak » Oct 04, 2011 12:37

Compiling clear, but segmentation fault on run. Ubuntu 10.04 64bit
pestery
Posts: 493
Joined: Jun 16, 2007 2:00
Location: Australia

Postby pestery » Oct 04, 2011 13:12

Compiled and ran fine for me. Win7 64bit.

It beeped at me a lot because I was just clicking random buttons :-)
Looks good.
fxm
Posts: 8053
Joined: Apr 22, 2009 12:46
Location: Paris suburb, FRANCE

Postby fxm » Oct 04, 2011 13:22

podvornyak wrote:Compiling clear, but segmentation fault on run. Ubuntu 10.04 64bit

Try to replace Screenlock/Screenunlock structure by double buffering as following:

Code: Select all

'Sodoku solver
Type d2
    As Integer x,y,w,h,index
    As Uinteger colour
    As String caption
End Type
#macro Typed2(num,_x,_y,_w,_h,_index,_colour,_caption)
num.x=_x:num.y=_y:num.w=_w:num.h=_h:num.index=_index:num.colour=_colour:num.caption=_caption
#endmacro
Declare Sub thickline(x1 As Double,_
y1 As Double,_
x2 As Double,_
y2 As Double,_
thickness As Double,_
colour As Uinteger,_
im As Any Pointer=0)
Dim Shared As Integer getout
Declare Sub main
Declare  Sub setboxes
Declare Sub inspect_boxes(mouse As d2)
Declare Sub drawbox(p() As d2,i As Integer,col As Uinteger,th As Single=1,pnt As String="paint",im As Any Pointer=0)
Function inbox(p1() As d2,p As d2,i As Integer) As Integer
    Return (p.x>p1(i).x)*(p.x<(p1(i).x+p1(i).w))*(p.y>p1(i).y)*(p.y<(p1(i).y+p1(i).h))
End Function
#macro incircle(cx,cy,radius,x,y)
(cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
#endmacro
Declare Function roundup (a As Double, b As Integer) As Single
Declare Sub solve3 ()
Declare Sub norows ()
Declare Sub textend ()
Declare Sub printbox2 (s As String)
Declare Sub introduction ()
Declare Sub timeout ()
Declare Sub setinrow ()
Declare Sub solve2 ()
Declare Sub whatsize (n As String)
Declare Sub phase (number As Integer)
Declare Sub setkeep ()
Declare Sub makekeep (m As Integer)
Declare Function ninebox (m As Integer) As Integer
Declare Sub makehops ()
Declare Sub makeb ()
Declare Sub actions(bo1 As String,bo2 As String,label As String,action As String)
Declare Sub setsquare (y As Integer, x As Integer)
Declare Function boxcheck (in() As Integer, m As Integer, al As Integer, dow As Integer) As Integer
Declare Sub dummy (mm As Integer)
Declare Sub setup ()
Declare Sub build (z As Integer)
Declare Function bigcheck () As Integer
Declare Function wee2 (x As Integer, y As Integer) As Integer
Declare Function weecheck (m As Integer) As Integer
Declare Function cycle (x As Integer) As Integer
Declare Function noblanks () As Integer
Declare Sub solve ()
Declare Function runcheck (n As Integer, x As Integer, y As Integer, m As Integer) As Integer
Declare Function checkerr (m2() As Integer, x As Integer, y As Integer) As Integer
Declare Sub cols ()
Declare Sub grid ()
Declare Sub box2 (s As String)
Const ok = 1
Const notok = 0
Dim m(1 To 9,1 To  9) As Integer
Dim Shared mglobal(9,9) As Integer
Dim Shared square As Integer
Dim Shared bb(1 To 9) As Integer
Dim Shared hopper(1 To 9) As Integer
Dim Shared testflag As Integer
Dim redoflag As Integer
Dim As Integer a,aa1,b,a1,b1,diff,holdb
Dim Shared inrow(9, 9) As Integer
Dim Shared incol(9, 9) As Integer
Dim Shared keep(9, 9) As Integer
Dim Shared startall As Double
Dim Shared endall As Double
Dim Shared boxes As Integer
Dim Shared beginningflag As Integer
Dim Shared As d2 big(9*9),p,nums(9),info(1),help(0)
Dim Shared As Integer xres,yres,dragflag,helpflag,errorflag
Dim Shared As String dragnum
letsgo:
'Screen 19,32
Screen 19,32,2
Screenset 1, 0
Screeninfo (xres,yres)
setboxes
main
redoflag = notok
testflag = notok
helpflag = notok
startall=Timer
Cls
testflag = ok
boxes = 1'500
grid
Goto setmain     
setmain:
For a1 = 1 To 9
    For b1 = 1 To 9
        m(a1, b1)= mglobal(a1, b1)
        keep(a1, b1) = m(a1, b1)
    Next b1
Next a1
Cls
grid   
box2("n")
setup
whatsize("show")
solve
box2 ("r")
timeout
Locate 10, 10
Print "finished"
actions("-1","-1","            ","                   ")
actions("-1","-1","solved","(AND CHECKED)")
textend
If beginningflag = ok Then Goto letsgo
End
Function bigcheck As Integer
    Dim a As Integer
    Dim b As Integer
    For a = 1 To 9
        For b = 1 To 9
            If inrow(a, b) = 0 Then
                bigcheck = notok
                Exit Function
            End If
            If runcheck(inrow(a, b), a, b, 0) = notok Then
                bigcheck = notok
                Exit Function
            End If
        Next b
    Next a
    bigcheck = ok
End Function
#macro hold2()
Sub box (m() As Integer)
    Dim n(9, 9) As String
    Dim a1 As Integer
    Dim b1 As Integer
    Color 2, 4
    For a1 = 1 To 9
        For b1 = 1 To 9
            n(a1, b1) = Ltrim$(Str$(m(a1, b1)))
            Locate (2 * a1), 25 + 4 * b1
            If m(a1, b1) <> 0 Then
                Print Spc(1); n(a1, b1)
            Else
                Print " "
            End If
        Next b1
    Next a1
    Color 15, 4
End Sub
#endmacro
Sub box2 (s As String)
    Dim a1 As Integer
    Dim b1 As Integer
    Color 2, 4
    For a1 = 1 To 9
        For b1 = 1 To 9
            Locate (2 * a1), 25 + 4 * b1
            If mglobal(a1, b1) <> 0 Then Color 1, 4
            If s = "c" Then Print incol(a1, b1)
            If s = "r" Then Print inrow(a1, b1)
            If s = "k" Then Print keep(a1, b1)
            If s = "n" Then Print mglobal(a1,b1)
            Color 2, 4
        Next b1
    Next a1
    Color 15, 4
End Sub
Function boxcheck (in() As Integer, m As Integer, al As Integer, dow As Integer) As Integer
    Dim As Integer along,down,a,d,c
    boxcheck = ok
    If in(al, dow) = 0 Then
        boxcheck = ok
        Exit Function
    End If
    If m = 1 Then
        For along = 1 To 3
            For down = 1 To 3
                c = 0
                For a = 1 To 3
                    For d = 1 To 3
                        If in(along, down) = 0 Then Goto m1
                        If in(along, down) = in(a, d) Then c = c + 1
                        m1:
                        If c > 1 Then
                            boxcheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 2 Then
        boxcheck = ok
        For along = 1 To 3
            For down = 4 To 6
                c = 0
                For a = 1 To 3
                    For d = 4 To 6
                        If in(along, down) = 0 Then Goto m2
                        If in(along, down) = in(a, d) Then c = c + 1
                        m2:
                        If c > 1 Then
                            boxcheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 3 Then
        boxcheck = ok
        For along = 1 To 3
            For down = 7 To 9
                c = 0
                For a = 1 To 3
                    For d = 7 To 9
                        If in(along, down) = 0 Then Goto m3
                        If in(along, down) = in(a, d) Then c = c + 1
                        m3:
                        If c > 1 Then
                            boxcheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 4 Then
        boxcheck = ok
        For along = 4 To 6
            For down = 1 To 3
                c = 0
                For a = 4 To 6
                    For d = 1 To 3
                        If in(along, down) = 0 Then Goto m4
                        If in(along, down) = in(a, d) Then c = c + 1
                        m4:
                        If c > 1 Then
                            boxcheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 5 Then
        boxcheck = ok
        For along = 4 To 6
            For down = 4 To 6
                c = 0
                For a = 4 To 6
                    For d = 4 To 6
                        If in(along, down) = 0 Then Goto m5
                        If in(along, down) = in(a, d) Then c = c + 1
                        m5:
                        If c > 1 Then
                            boxcheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 6 Then
        boxcheck = ok
        For along = 4 To 6
            For down = 7 To 9
                c = 0
                For a = 4 To 6
                    For d = 7 To 9
                        If in(along, down) = 0 Then Goto m6
                        If in(along, down) = in(a, d) Then c = c + 1
                        m6:
                        If c > 1 Then
                            boxcheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 7 Then
        boxcheck = ok
        For along = 7 To 9
            For down = 1 To 3
                c = 0
                For a = 7 To 9
                    For d = 1 To 3
                        If in(along, down) = 0 Then Goto m7
                        If in(along, down) = in(a, d) Then c = c + 1
                        m7:
                        If c > 1 Then
                            boxcheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 8 Then
        boxcheck = ok
        For along = 7 To 9
            For down = 4 To 6
                c = 0
                For a = 7 To 9
                    For d = 4 To 6
                        If in(along, down) = 0 Then Goto m8
                        If in(along, down) = in(a, d) Then c = c + 1
                        m8:
                        If c > 1 Then
                            boxcheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 9 Then
        boxcheck = ok
        For along = 7 To 9
            For down = 7 To 9
                c = 0
                For a = 7 To 9
                    For d = 7 To 9
                        If in(along, down) = 0 Then Goto m9
                        If in(along, down) = in(a, d) Then c = c + 1
                        m9:
                        If c > 1 Then
                            boxcheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
End Function
Sub build (z As Integer)
    Dim x As Integer
    Dim y As Integer
    If z = 1 Then
        For y = 1 To 3
            For x = 1 To 3
                incol(y, x) = inrow(y, x)
            Next x
        Next y
    End If
    If z = 2 Then
        For y = 1 To 3
            For x = 4 To 6
                incol(y, x) = inrow(y, x)
            Next x
        Next y
    End If
    If z = 3 Then
        For y = 1 To 3
            For x = 7 To 9
                incol(y, x) = inrow(y, x)
            Next x
        Next y
    End If
    If z = 4 Then
        For y = 4 To 6
            For x = 1 To 3
                incol(y, x) = inrow(y, x)
            Next x
        Next y
    End If
    If z = 5 Then
        For y = 4 To 6
            For x = 4 To 6
                incol(y, x) = inrow(y, x)
            Next x
        Next y
    End If
    If z = 6 Then
        For y = 4 To 6
            For x = 7 To 9
                incol(y, x) = inrow(y, x)
            Next x
        Next y
    End If
    If z = 7 Then
        For y = 7 To 9
            For x = 1 To 3
                incol(y, x) = inrow(y, x)
            Next x
        Next y
    End If
    If z = 8 Then
        For y = 7 To 9
            For x = 4 To 6
                incol(y, x) = inrow(y, x)
            Next x
        Next y
    End If
    If z = 9 Then
        For y = 7 To 9
            For x = 7 To 9
                incol(y, x) = inrow(y, x)
            Next x
        Next y
    End If
End Sub
Function checkerr (m2() As Integer, x As Integer, y As Integer) As Integer
    Dim count As Integer
    For count = 1 To 9
        If count = y Then Goto endrow
        If m2(x, y) <> 0 Then
            If m2(x, y) = m2(x, count) Then
                checkerr = notok
                Exit Function
            End If
        End If
        checkerr = ok
        endrow:
    Next count
    For count = 1 To 9
        If count = x Then Goto endcol
        If m2(x, y) <> 0 Then
            If m2(x, y) = m2(count, y) Then
                checkerr = notok
                Exit Function
            End If
        End If
        checkerr = ok
        endcol:
    Next count
End Function
Sub cols
    Dim b1 As Integer
    Color 2, 4
    For b1 = 1 To 9
        Locate 20, 25 + 4 * b1
        Print b1
    Next b1
    Color 15, 4
End Sub
Function cycle (x As Integer) As Integer
    If x Mod 9 = 0 Then
        cycle = 9
    Else
        cycle = x Mod 9
    End If
End Function
Sub dummy (mm As Integer)
    If Inkey$ <> "" Then
        Dim what As String
        doagain:
        Locate 4, 4
        Print "q for quit"
        Print "   c to continue"
        what = Input$(1)
        what = Lcase$(what)
        If Instr("qcqc", what) = 0 Then
            Print "mistake, q/c"
            Goto doagain
        End If
        Locate 4, 4
        Print "           "
        Print "                    "
        If what = "q" Then End
        If what = "c" Then
            If mm = 1 Then Exit Sub
            If mm = 2 Then Exit Sub
            If mm = 3 Then Exit Sub
        End If
    End If
End Sub
Sub grid
    Dim As Integer xtemp,ytemp,xpix,ypix,col,col2
    For a2 As Integer=1 To 10
        For b2 As Integer=1 To 10
            If (a2-1) Mod 3 =0 Then
                col=7
            Else
                col=8
            End If
            If (b2-1) Mod 3 =0 Then
                col2=7
            Else
                col2=8
            End If
            xtemp=25+4*b2
            xpix = (640 * (xtemp - 1)) / 79-10
            ytemp = 2 * a2
            ypix = (350 * (ytemp - 1)) / 25 - 8
            If b2<>10 Then Line(xpix,ypix)-(xpix+32,ypix),col
            If a2<>10 Then Line(xpix,ypix)-(xpix,ypix+28),col2
        Next b2
    Next a2
End Sub
Sub makeb
    Dim As Integer x,y,marker
    For x = 1 To 9
        dooagain:
        marker = ok
        bb(x) = Int(((9 - 1) + 1) * Rnd + 1)
        If x > 1 Then
            For y = 1 To x - 1
                If bb(x) = bb(y) Then
                    marker = notok
                    Exit For
                End If
            Next y
        End If
        If marker = notok Then Goto dooagain
    Next x
End Sub
Sub makehops
    Dim As Integer x,y,marker
    For x = 1 To 9
        dooagain2:
        marker = ok
        hopper(x) = Int(((9 - 1) + 1) * Rnd + 1)
        If x > 1 Then
            For y = 1 To x - 1
                If hopper(x) = hopper(y) Then
                    marker = notok
                    Exit For
                End If
            Next y
        End If
        If marker = notok Then Goto dooagain2
    Next x
End Sub
Sub makekeep (m As Integer)
    Dim a As Integer
    Dim b As Integer
    If m = 1 Then
        For a = 1 To 3
            For b = 1 To 3
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 2 Then
        For a = 1 To 3
            For b = 4 To 6
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 3 Then
        For a = 1 To 3
            For b = 7 To 9
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 4 Then
        For a = 4 To 6
            For b = 1 To 3
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 5 Then
        For a = 4 To 6
            For b = 4 To 6
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 6 Then
        For a = 4 To 6
            For b = 7 To 9
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 7 Then
        For a = 7 To 9
            For b = 1 To 3
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 8 Then
        For a = 7 To 9
            For b = 4 To 6
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 9 Then
        For a = 7 To 9
            For b = 7 To 9
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
End Sub
Function ninebox (m As Integer) As Integer
    Dim a As Integer
    Dim b As Integer
    Dim temp As Integer
    ninebox = notok
    If m = 1 Then
        For a = 1 To 3
            For b = 1 To 3
                If keep(a, b) = 0 Then Exit Function
            Next b
        Next a
    End If
    If m = 2 Then
        For a = 1 To 3
            For b = 4 To 6
                If keep(a, b) = 0 Then Exit Function
            Next b
        Next a
    End If
    If m = 3 Then
        For a = 1 To 3
            For b = 7 To 9
                If keep(a, b) = 0 Then Exit Function
            Next b
        Next a
    End If
    If m = 4 Then
        For a = 4 To 6
            For b = 1 To 3
                If keep(a, b) = 0 Then Exit Function
            Next b
        Next a
    End If
    If m = 5 Then
        For a = 4 To 6
            For b = 4 To 6
                If keep(a, b) = 0 Then Exit Function
            Next b
        Next a
    End If
    If m = 6 Then
        For a = 4 To 6
            For b = 7 To 9
                If keep(a, b) = 0 Then Exit Function
            Next b
        Next a
    End If
    If m = 7 Then
        For a = 7 To 9
            For b = 1 To 3
                If keep(a, b) = 0 Then Exit Function
            Next b
        Next a
    End If
    If m = 8 Then
        For a = 7 To 9
            For b = 4 To 6
                If keep(a, b) = 0 Then Exit Function
            Next b
        Next a
    End If
    If m = 9 Then
        For a = 7 To 9
            For b = 7 To 9
                If keep(a, b) = 0 Then Exit Function
            Next b
        Next a
    End If
    ninebox = ok
End Function
Sub phase (number As Integer)
    actions("-1","-1","solving","phase "+Str$(number))
End Sub
Sub printbox2 (s As String)
    Open "results.txt" For Output As #1
    For a1 As Integer = 1 To 9
        For b1 As Integer = 1 To 9
            Print #1, inrow(a1,b1);
        Next b1
        Print #1, " "
    Next a1
    Close #1
    Shell "gedit results.txt"
    Shell "notepad.exe results.txt"
End Sub
Function roundup (a As Double, b As Integer) As Single
    Dim As Single y,i,r
    y = (Abs(a) - Int(Abs(a))) * (10 ^ b)
    i = Int(y)
    y = y - i
    If y >= .5 Then i = i + 1
    i = i / (10 ^ b)
    r = Int(Abs(a)) + i
    If a < 0 Then r = -r
    roundup = r
End Function
Function runcheck (n As Integer, x As Integer, y As Integer, m As Integer) As Integer
    Dim As Integer along,down,a,d,c,count
    For count = 1 To 9
        If count = y Then Goto nextinrow2
        If n = inrow(x, count) Then
            runcheck = notok
            Exit Function
        End If
        runcheck = ok
        nextinrow2:
    Next count
    For count = 1 To 9
        If count = x Then Goto endcol3
        If n = inrow(count, y) Then
            runcheck = notok
            Exit Function
        End If
        runcheck = ok
        endcol3:
    Next count
    If m = 1 Then
        For a = 1 To 3
            For d = 1 To 3
                If n = inrow(a, d) Then
                    runcheck = notok
                    Exit Function
                End If
            Next d
        Next a
    End If
    If m = 2 Then
        For a = 1 To 3
            For d = 4 To 6
                If n = inrow(a, d) Then
                    runcheck = notok
                    Exit Function
                End If
            Next d
        Next a
    End If
    If m = 3 Then
        For a = 1 To 3
            For d = 7 To 9
                If n = inrow(a, d) Then
                    runcheck = notok
                    Exit Function
                End If
            Next d
        Next a
    End If
    If m = 4 Then
        For a = 4 To 6
            For d = 1 To 3
                If n = inrow(a, d) Then
                    runcheck = notok
                    Exit Function
                End If
            Next d
        Next a
    End If
    If m = 5 Then
        For a = 4 To 6
            For d = 4 To 6
                If n = inrow(a, d) Then
                   
                    runcheck = notok
                    Exit Function
                End If
            Next d
        Next a
    End If
    If m = 6 Then
        For a = 4 To 6
            For d = 7 To 9
                If n = inrow(a, d) Then
                    runcheck = notok
                    Exit Function
                End If
            Next d
        Next a
    End If
    If m = 7 Then
        For a = 7 To 9
            For d = 1 To 3
                If n = inrow(a, d) Then
                    runcheck = notok
                    Exit Function
                End If
            Next d
        Next a
    End If
    If m = 8 Then
        For a = 7 To 9
            For d = 4 To 6
                If n = inrow(a, d) Then
                    runcheck = notok
                    Exit Function
                End If
            Next d
        Next a
    End If
    If m = 9 Then
        For a = 7 To 9
            For d = 7 To 9
                If n = inrow(a, d) Then
                    runcheck = notok
                    Exit Function
                End If
            Next d
        Next a
    End If
End Function
Sub setinrow
    Dim along As Integer
    Dim down As Integer
    For along = 1 To 9
        For down = 1 To 9
            inrow(along, down) = keep(along, down)
        Next down
    Next along
End Sub
Sub setkeep
    Dim a As Integer
    Dim b As Integer
    For a = 1 To 9
        For b = 1 To 9
            keep(a, b) = mglobal(a, b)
        Next b
    Next a
End Sub
Sub setsquare (y As Integer, x As Integer)
    If y <= 3 And x <= 3 Then
        square = 1
    End If
    If y <= 3 Then
        If x > 3 And x < 7 Then
            square = 2
        End If
    End If
    If y <= 3 Then
        If x > 6 And x <= 9 Then
            square = 3
        End If
    End If
    If y > 3 And y < 7 Then
        If x <= 3 Then
            square = 4
        End If
    End If
    If y > 3 And y < 7 Then
        If x > 3 And x < 7 Then
            square = 5
        End If
    End If
    If y > 3 And y < 7 Then
        If x > 6 And x <= 9 Then
            square = 6
        End If
    End If
    If y > 6 And y <= 9 Then
        If x <= 3 Then
            square = 7
        End If
    End If
    If y > 6 And y <= 9 Then
        If x > 3 And x < 7 Then
            square = 8
        End If
    End If
    If y > 6 And y <= 9 Then
        If x > 6 And x <= 9 Then
            square = 9
        End If
    End If
End Sub
Sub setup
    Dim a1 As Integer
    Dim b1 As Integer
    For a1 = 1 To 9
        For b1 = 1 To 9
            inrow(a1, b1) = mglobal(a1, b1)
        Next b1
    Next a1
End Sub
Sub solve
    Dim As Integer along,down,n,hop,hops,skip,b,flag,flag2,first,middle,zz,zzz,zzb
    Dim madeincol As Integer
    Dim hopcount As Integer
    Dim As Single start,finish
    actions("-1","-1","solving","phase 1")
    zzb = 0
    madeincol = notok
    Randomize Timer
    startup:
    Do
        make:
        hopcount = 0
        Locate 23, 52
        Print Chr$(flag2 Mod 4)
        dummy (1)
        If flag2 > flag Then flag = flag2
        flag2 = 0
        makehops
        For hops = 1 To 9
            flag2 = flag2 + 1
            hop = hopper(hops)
            If hop = 1 Then skip = 2
            If hop = 2 Then skip = 2
            If hop = 3 Then skip = 2
            If hop = 4 Then skip = 5
            If hop = 5 Then skip = 5
            If hop = 6 Then skip = 5
            If hop = 7 Then skip = 8
            If hop = 8 Then skip = 8
            If hop = 9 Then skip = 8
            If hop <= 3 Then middle = 3 * hop - 1
            If hop >= 4 And hop <= 6 Then
                middle = 3 * hop - 10
            End If
            If hop >= 7 And hop <= 9 Then
                middle = 3 * hop - 19
            End If
            start = Timer
            Do
                hopcount = hopcount + 1
                boxer:
                For along = skip - 1 To skip + 1
                    For down = middle - 1 To middle + 1
                        If mglobal(along, down) = 0 Then
                            makeb
                            For n = 1 To 9
                                If runcheck(bb(n), along, down, hop) = ok Then
                                    inrow(along, down) = bb(n)
                                    Exit For
                                End If
                            Next n
                        End If
                    Next down
                Next along
                finish = Timer
               
                If hopcount > 40 Then
                    setup
                    Goto make
                End If
            Loop Until weecheck(hop) = ok
            If flag2 >= 8 Then     
                For zzz = 1 To 9
                    build(zzz)
                Next zzz
                madeincol = ok
                zzb = zzb + 1
            End If
            If zzb >= boxes And madeincol = ok Then
                setup
                setkeep
                box2 ("c")
                solve3                                     
            End If
        Next hops
        If bigcheck = notok Then
            setup
            Goto make                   
        End If
    Loop Until bigcheck = ok
    endall = Timer
End Sub
Sub solve2
    Dim As Integer along,down,n,hop,hops,skip,b,flag,flag2,first,middle,zz,zzz,zzb
    Dim start2 As Single
    Dim finish2 As Single
    Dim xxx As Integer
    Dim hopcount As Integer
    Dim shiftcount As Integer
    Dim As Single start,finish
    Randomize Timer
    startup2:
    For xxx = 1 To 18
        zz = cycle(xxx)
        makekeep(zz)       
        setinrow           
        If ninebox(zz) = notok Then Goto zznext             
        actions(Str$(zz),"-1","solving","phase 3  ")
        box2 ("n")               
        box2 ("k")
        shiftcount = 0
        make2:
        shiftcount = shiftcount + 1
        hopcount = 0
        If flag2 > flag Then flag = flag2
        flag2 = 0
        makehops
        For hops = 1 To 9
            flag2 = flag2 + 1
            hop = hopper(hops)
            If hop = 1 Then skip = 2
            If hop = 2 Then skip = 2
            If hop = 3 Then skip = 2
            If hop = 4 Then skip = 5
            If hop = 5 Then skip = 5
            If hop = 6 Then skip = 5
            If hop = 7 Then skip = 8
            If hop = 8 Then skip = 8
            If hop = 9 Then skip = 8
            If hop <= 3 Then middle = 3 * hop - 1
            If hop >= 4 And hop <= 6 Then
                middle = 3 * hop - 10
            End If
            If hop >= 7 And hop <= 9 Then
                middle = 3 * hop - 19
            End If
            Do
                hopcount = hopcount + 1
                dummy (2)       
                For along = skip - 1 To skip + 1
                    For down = middle - 1 To middle + 1
                        If keep(along, down) = 0 Then       
                            makeb
                            For n = 1 To 9
                                If runcheck(bb(n), along, down, hop) = ok Then
                                    inrow(along, down) = bb(n)
                                    Exit For
                                End If
                            Next n
                        End If
                    Next down
                Next along
                finish = Timer
                If hopcount > 40 Then
                    setinrow           
                    Goto make2
                End If
            Loop Until weecheck(hop) = ok
            missahop:
            If shiftcount > 200 Then
                setkeep
                Goto zznext
            End If
        Next hops
        If bigcheck = ok Then Goto getout
        zznext:
    Next xxx
    setkeep
    Erase incol
    setup
    solve
    getout:
    endall = Timer
    box2 ("r")
    timeout
    actions("-1","-1","            ","                   ")
    actions("-1","-1","solved","Check completed")
    whatsize("")
    Locate 10, 10
    Print "finished"
    textend
    End
End Sub
Sub solve3
    Dim As Integer along,down,n,hop,hops,skip,b,flag,flag2,first,middle,zz,zzz,zzb
    Dim start2 As Single
    Dim finish2 As Single
    Dim xxx As Integer
    Dim yyy As Integer
    Dim hopcount As Integer
    Dim shiftcount As Integer
    Dim As Single start,finish
    Randomize Timer
    startup3:
    setkeep           
    For xxx = 1 To 8
        makekeep(xxx)   
        If ninebox(xxx) = notok Then Goto xxxnext3
        For yyy = xxx + 1 To 9
            makekeep(yyy)   
            If ninebox(yyy) = notok Then Goto yyynext3
            setinrow           
            box2 ("k")
            actions(Str$(xxx),Str$(yyy),"solving","phase 2")
            shiftcount = 0
            make3:
            shiftcount = shiftcount + 1
            hopcount = 0
            If flag2 > flag Then flag = flag2
            flag2 = 0
            makehops
            For hops = 1 To 9
                flag2 = flag2 + 1
                hop = hopper(hops)
                If hop = 1 Then skip = 2
                If hop = 2 Then skip = 2
                If hop = 3 Then skip = 2
                If hop = 4 Then skip = 5
                If hop = 5 Then skip = 5
                If hop = 6 Then skip = 5
                If hop = 7 Then skip = 8
                If hop = 8 Then skip = 8
                If hop = 9 Then skip = 8
                If hop <= 3 Then middle = 3 * hop - 1
                If hop >= 4 And hop <= 6 Then
                    middle = 3 * hop - 10
                End If
                If hop >= 7 And hop <= 9 Then
                    middle = 3 * hop - 19
                End If
                start = Timer
                Do
                    hopcount = hopcount + 1
                    dummy (3)       
                    For along = skip - 1 To skip + 1
                        For down = middle - 1 To middle + 1
                            If keep(along, down) = 0 Then   
                                makeb
                                For n = 1 To 9
                                    If runcheck(bb(n), along, down, hop) = ok Then
                                        inrow(along, down) = bb(n)
                                        Exit For
                                    End If
                                Next n
                            End If
                        Next down
                    Next along
                    finish = Timer
                    If hopcount > 40 Then
                        setinrow           
                        Goto make3
                    End If
                Loop Until weecheck(hop) = ok
                missahop3:
                If shiftcount > 200 Then
                    setup
                    setkeep
                    makekeep(xxx)
                    Goto yyynext3
                End If
            Next hops
            If bigcheck = ok Then Goto getout3
            yyynext3:
        Next yyy
        setup
        setkeep
        xxxnext3:
    Next xxx
    setkeep
    setup
    Locate 9, 1
    Print "          "
    solve2
    getout3:
    endall = Timer
    box2 ("r")
    timeout
    actions("-1","-1","            ","                   ")
    actions("-1","-1","","Check completed")
    whatsize("")
    Locate 10, 10
    Print "finished"
    textend
    End
End Sub
Sub textend
    Dim As Integer mx,my,mw,mb
    Do
        Getmouse mx,my,mw,mb
'        Screenlock
        Circle(550,50),30,,,,,f
        Circle(550,50),30,9
        Draw String(540,45),"Quit",3
        If incircle(550,50,30,mx,my) And mb<>0 Then End
        Circle(550,150),30,,,,,f
        Circle(550,150),30,9
        Draw String(540,145),"Save",3
        If incircle(550,150,30,mx,my) And mb<>0 Then
            printbox2("r")
            Exit Sub
        End If
'        Screenunlock
Screencopy
        Sleep 1,1
    Loop
End Sub
Sub timeout
    Dim seconds As Double
    Dim minutes As Double
    seconds = endall - startall
    minutes = seconds / 60
    Locate 13, 2
    If seconds <= 60 Then
        Print "Time = ";
        Print Using "##.#";roundup(Cdbl(seconds), 1);
        Print "s"
    Else
        seconds = roundup(Cdbl((minutes - Int(minutes)) * 60), 1)
        Print "Time = ";Int(minutes);
        Print "m ";
        Print Using "##.#";seconds;
        Print "s"
    End If
End Sub
Function weecheck (m As Integer) As Integer
    Dim As Integer along,down,a,d,c
    If m = 1 Then
        weecheck = ok
        For along = 1 To 3
            For down = 1 To 3
                c = 0
                For a = 1 To 3
                    For d = 1 To 3
                        If inrow(along, down) = 0 Then
                            weecheck = notok
                            Exit Function
                        End If
                        If inrow(along, down) = inrow(a, d) Then c = c + 1
                        If c > 1 Then
                            weecheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 2 Then
        weecheck = ok
        For along = 1 To 3
            For down = 4 To 6
                c = 0
                For a = 1 To 3
                    For d = 4 To 6
                        If inrow(along, down) = 0 Then
                            weecheck = notok
                            Exit Function
                        End If
                        If inrow(along, down) = inrow(a, d) Then c = c + 1
                        If c > 1 Then
                            weecheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 3 Then
        weecheck = ok
        For along = 1 To 3
            For down = 7 To 9
                c = 0
                For a = 1 To 3
                    For d = 7 To 9
                        If inrow(along, down) = 0 Then
                            weecheck = notok
                            Exit Function
                        End If
                        If inrow(along, down) = inrow(a, d) Then c = c + 1
                        If c > 1 Then
                            weecheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 4 Then
        weecheck = ok
        For along = 4 To 6
            For down = 1 To 3
                c = 0
                For a = 4 To 6
                    For d = 1 To 3
                        If inrow(along, down) = 0 Then
                            weecheck = notok
                            Exit Function
                        End If
                        If inrow(along, down) = inrow(a, d) Then c = c + 1
                        If c > 1 Then
                            weecheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 5 Then
        weecheck = ok
        For along = 4 To 6
            For down = 4 To 6
                c = 0
                For a = 4 To 6
                    For d = 4 To 6
                        If inrow(along, down) = 0 Then
                            weecheck = notok
                            Exit Function
                        End If
                        If inrow(along, down) = inrow(a, d) Then c = c + 1
                        If c > 1 Then
                            weecheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 6 Then
        weecheck = ok
        For along = 4 To 6
            For down = 7 To 9
                c = 0
                For a = 4 To 6
                    For d = 7 To 9
                        If inrow(along, down) = 0 Then
                            weecheck = notok
                            Exit Function
                        End If
                        If inrow(along, down) = inrow(a, d) Then c = c + 1
                        If c > 1 Then
                            weecheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 7 Then
        weecheck = ok
        For along = 7 To 9
            For down = 1 To 3
                c = 0
                For a = 7 To 9
                    For d = 1 To 3
                        If inrow(along, down) = 0 Then
                            weecheck = notok
                            Exit Function
                        End If
                        If inrow(along, down) = inrow(a, d) Then c = c + 1
                        If c > 1 Then
                            weecheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 8 Then
        weecheck = ok
        For along = 7 To 9
            For down = 4 To 6
                c = 0
                For a = 7 To 9
                    For d = 4 To 6
                        If inrow(along, down) = 0 Then
                            weecheck = notok
                            Exit Function
                        End If
                        If inrow(along, down) = inrow(a, d) Then c = c + 1
                        If c > 1 Then
                            weecheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
    If m = 9 Then
        weecheck = ok
        For along = 7 To 9
            For down = 7 To 9
                c = 0
                For a = 7 To 9
                    For d = 7 To 9
                        If inrow(along, down) = 0 Then
                            weecheck = notok
                            Exit Function
                        End If
                        If inrow(along, down) = inrow(a, d) Then c = c + 1
                        If c > 1 Then
                            weecheck = notok
                            Exit Function
                        End If
                    Next d
                Next a
            Next down
        Next along
    End If
End Function
Sub whatsize(n As String)
    Locate 22, 4
    If n="show" Then
        Print "Press any key for quit option"
        startall = Timer
    Else
        Print "                                            "
    End If
End Sub
Sub actions(bo1 As String,bo2 As String,label As String,action As String)
    Locate 21,53
    Print label
    Locate 23, 53
    Print action
    Line(400,300)-(600,330),,B
    Locate 21,53
    If label="-1" Then label=""
    Print label
    Locate 23, 52
    Color 15
    If bo1="-1" Then bo1=""
    If bo2="-1" Then bo2=""
    If action="-1" Then action=""
    Print bo1+" ";bo2;"   "+action
End Sub
Sub thickline(x1 As Double,_
    y1 As Double,_
    x2 As Double,_
    y2 As Double,_
    thickness As Double,_
    colour As Uinteger,_
    im As Any Pointer=0)
    Dim p As Uinteger=Rgb(255, 255, 254)
    If thickness<2 Then
        Line(x1,y1)-(x2,y2),colour
    Else               
        Dim As Double h=Sqr((x2-x1)^2+(y2-y1)^2):If h=0 Then h=1e-6
        Dim As Double s= (y1-y2)/h ,c=(x2-x1)/h
        For x As Integer=1 To 2
            Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),p
            Line im,(x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
            Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),p
            Line im,(x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
            Paint im,((x1+x2)/2, (y1+y2)/2), p, p
            p=colour
        Next x
    End If
End Sub
Sub drawbox(p() As d2,i As Integer,col As Uinteger,th As Single=1,pnt As String="paint",im As Any Pointer=0)
    thickline(p(i).x,p(i).y,p(i).x+p(i).w,p(i).y,th,col,im)
    thickline(p(i).x+p(i).w,p(i).y,p(i).x+p(i).w,p(i).y+p(i).h,th,col,im)
    thickline(p(i).x+p(i).w,p(i).y+p(i).h,p(i).x,p(i).y+p(i).h,th,col,im)
    thickline(p(i).x,p(i).y+p(i).h,p(i).x,p(i).y,th,col,im)
    If pnt="paint" Then
        var xc=(p(i).x+p(i).x+p(i).w)/2
        var yc=(p(i).y+p(i).y+p(i).h)/2
        Paint(xc,yc),col,col
        If  i=0 Then p(i).caption=""
        Draw String(xc-5,yc-5),p(i).caption
    End If
End Sub
Sub setboxes
    Dim As Integer count
    For z2 As Integer = 0 To 8
        For z As Integer=0 To 8
            count=count+1
            Select Case count
            Case 1,2,3,10,11,12,19,20,21,7,8,9,16,17,18,25,26,27
                big(count).colour=Rgb(200,0,0)
            Case 55,56,57,64,65,66,73,74,75,61,62,63,70,71,72,79,80,81,31,32,33,40,41,42,49,50,51
                big(count).colour=Rgb(200,0,0)
            Case Else
                big(count).colour=Rgb(0,200,0)
            End Select
            Typed2(big(count),(10+z*33),(10+z2*33),30,30,count,big(count).colour,"")
        Next z
    Next z2
    For z As Integer=0 To 9
        typed2(nums(z),(.8*xres),(z*53),50,50,z,Rgb(100,100,100),Str(z))
    Next z
    typed2(info(1),(.5*xres),0,70,20,1,Rgb(255,0,0),"?")
    typed2(help(0),(.4*xres),21,310,200,0,Rgb(255,255,255),"")
End Sub
Sub inspect_boxes(mouse As d2)
    #macro doublecheck(p1,p2)
    setsquare(p1,p2)
    If checkerr(mglobal(), p1, p2) = notok Or boxcheck(mglobal(), square, p1, p2) = notok Then
        Beep
        big(z).caption=""
        mglobal(p1,p2)=0
        errorflag=1
    Else
        errorflag=0
    End If
    #endmacro
    Dim As Integer vd
    Dim As Uinteger edge,numedge
    For z As Integer=0 To Ubound(big)
        If inbox(big(),mouse,big(z).index) Then
            edge=Rgb(200,200,0)
        Else
            edge=Rgb(00,00,200)
        End If
        'numbers _
        If z<=9 Then
            If inbox(nums(),mouse,nums(z).index) Then
                numedge=Rgb(200,200,0)
            Else
                numedge=Rgb(0,0,200)
            End If
        End If
        'numbers
        If z<=9 Then
            drawbox(nums(),nums(z).index,nums(z).colour,1)
            drawbox(nums(),nums(z).index,numedge,2,"")
            If inbox(nums(),mouse,nums(z).index) And mouse.w<>0 Then
                dragflag=1
                dragnum=nums(z).caption
                errorflag=0
            End If
            '__
        End If
        drawbox(big(),big(z).index,big(z).colour,1)
        drawbox(big(),big(z).index,edge,2,"")
        If inbox(big(),mouse,big(z).index) And mouse.w<>0 Then
            big(z).caption=dragnum
            vd=z
            Select Case z
            Case 1 To 9
                mglobal(1,vd)=Valint(dragnum)
                doublecheck(1,vd)
            Case 10 To 18
                mglobal(2,vd-9)=Valint(dragnum)
                doublecheck(2,(vd-9))
            Case 19 To 27
                mglobal(3,vd-18)=Valint(dragnum)
                doublecheck(3,(vd-18))
            Case 28 To 36
                mglobal(4,vd-27)=Valint(dragnum)
                doublecheck(4,(vd-27))
            Case 37 To 45
                mglobal(5,vd-36)=Valint(dragnum)
                doublecheck(5,(vd-36))
            Case 46 To 54
                mglobal(6,vd-45)=Valint(dragnum)
                doublecheck(6,(vd-45))
            Case 55 To 63
                mglobal(7,vd-54)=Valint(dragnum)
                doublecheck(7,(vd-54))
            Case 64 To 72
                mglobal(8,vd-63)=Valint(dragnum)
                doublecheck(8,(vd-63))
            Case 73 To 81
                mglobal(9,vd-72)=Valint(dragnum)
                doublecheck(9,(vd-72))
            End Select
            dragflag=0
        End If
        If inbox(big(),mouse,big(z).index) Then
            Draw String(mouse.x,mouse.y-10),dragnum
            If dragnum="" Then Draw String(mouse.x,mouse.y-10),"///"
        End If
        'if not inbox(big(),mouse,big(z).index) Then errorflag=0
    Next z
    drawbox(info(),1,info(1).colour,1)
    drawbox(info(),1,Rgb(200,200,200),3,"")
    If inbox(info(),mouse,1) And mouse.w<>0 Then
        helpflag=1
    End If
    If helpflag Then
        drawbox(help(),0,help(0).colour,1)
        drawbox(help(),0,Rgb(200,0,200),3,"")
        Draw String(.41*xres,25),"Click a Grey box to fetch a digit",Rgb(0,0,0)
        Draw String(.41*xres,40),"Carry the digit to the Sudoku",Rgb(0,0,0)
        Draw String(.41*xres,55),"Click on a Sudoku box to deposit it",Rgb(0,0,0)
        Draw String(.41*xres,80),"Carry the blank to erase a mistake",Rgb(0,0,0)
        Draw String(.41*xres,100),"Click solve when ready",Rgb(0,0,0)
        If inbox(help(),mouse,0) And mouse.w<>0 Then
            helpflag=0
        End If
    End If
    Circle(.97*xres,.05*yres),20,Rgb(200,0,0),,,,f
    Circle(.97*xres,.05*yres),20,Rgb(255,255,255)
    Draw String(.965*xres,.04*yres),"X"
    If incircle(.965*xres,.04*yres,20,mouse.x,mouse.y) And  mouse.w<>0 Then End
    Circle (.5*xres,.8*yres),30,Rgb(200,200,200),,,,f
    Circle (.5*xres,.8*yres),30,Rgb(0,200,0)
    Draw String(.48*xres,.79*yres),"Solve",Rgb(0,0,0)
    'SOLVE
    If incircle(.5*xres,.8*yres,30,mouse.x,mouse.y) And  mouse.w<>0 Then
        getout=1
'        Screenunlock
'        Screen 9
Screen 9,,2
Screenset 1, 0
        Exit Sub
    End If
End Sub
Sub main
    Dim As Integer mx,my,mw,mb
    Dim As d2 mouse
    Dim As Uinteger edge
    Do
        If getout=1 Then Exit Sub
        Getmouse(mx,my,mw,mb)
        mouse.x=mx:mouse.y=my:mouse.w=mb
'        Screenlock
        Cls
        If errorflag Then
            Draw String(.4*xres,yres/2),"ERROR:"
            Draw String(.4*xres,yres/2+30),"Number  " & dragnum &" has been mis-placed"
        End If
        inspect_boxes(mouse)
        If dragflag Then
            If dragnum="" Then
                Draw String(mx,my-10),"///"
            Else
                Draw String(mx,my-10),dragnum
            End If
        End If
'        Screenunlock
Screencopy
        Sleep 1,1
    Loop Until Inkey=Chr(27)
End Sub
dodicat
Posts: 4951
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Oct 04, 2011 19:37

jdebord wrote:I tried to compile, but got a bunch of errors.

Seems that the program is too long to be posted on the forum.

You may wish to post it on the FBMath mailing list. It has already the previous version.

Hi jdebord
I've posted the file to FBMath, I hope you have better luck there.
FBide registers 1613 lines, the last sub is main.
@ Bfuller.
I didn't write all the code by hand, just the one finger, thanks for trying it out.
@ podvornyak
I'll try it out on Linux later. (PCLINUXOS) is my distro.
@fxm
I'll try the screenset and screenlock methods on Linux.
I normally just use screenlock for easyness, but I know that it has disadvantages sometimes.
@pesetry
I loathe Soduko, I think that it is the most mindless game, I wrote the the solver to batter the life out of it.
I have never yet completed a soduku puzzle, I just get plain fed up half way through.
fxm
Posts: 8053
Joined: Apr 22, 2009 12:46
Location: Paris suburb, FRANCE

Postby fxm » Oct 04, 2011 19:54

dodicat wrote:@fxm
I'll try the screenset and screenlock methods on Linux.
I normally just use screenlock for easyness, but I know that it has disadvantages sometimes.

As you can see in my previous post above, I converted really very easily your program by using the method of double buffering.
dodicat
Posts: 4951
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Oct 04, 2011 23:09

fxm wrote:
dodicat wrote:@fxm
I'll try the screenset and screenlock methods on Linux.
I normally just use screenlock for easyness, but I know that it has disadvantages sometimes.

As you can see in my previous post above, I converted really very easily your program by using the method of double buffering.


The program works on PCLINUXOS ok.
Screenset is much better with linux, Linux seems to hang if END is used within a screenlock/unlock loop.
I think that the screen must be unlocked before quitting the program.
Screenset avoids this issue.
badidea
Posts: 772
Joined: May 24, 2007 22:10
Location: The Netherlands

Postby badidea » Oct 04, 2011 23:13

Can't run the code as well. You do now that you can reduce the number of lines in many cases? E.g. "makekeep" routine:

Code: Select all

Sub makekeep (m As Integer)
    Dim a As Integer
    Dim b As Integer
    If m = 1 Then
        For a = 1 To 3
            For b = 1 To 3
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 2 Then
        For a = 1 To 3
            For b = 4 To 6
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 3 Then
        For a = 1 To 3
            For b = 7 To 9
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 4 Then
        For a = 4 To 6
            For b = 1 To 3
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 5 Then
        For a = 4 To 6
            For b = 4 To 6
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 6 Then
        For a = 4 To 6
            For b = 7 To 9
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 7 Then
        For a = 7 To 9
            For b = 1 To 3
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 8 Then
        For a = 7 To 9
            For b = 4 To 6
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
    If m = 9 Then
        For a = 7 To 9
            For b = 7 To 9
                keep(a, b) = incol(a, b)
            Next b
        Next a
    End If
End Sub

Can be rewritten like this (untested):

Code: Select all

Sub makekeep (m As Integer)
  Dim a, b As Integer
  dim as integer aLow(9) => {1, 1, 1, 4, 4, 4, 7, 7, 7}
  dim as integer bLow(9) => {1, 4, 7, 1, 4, 7, 1, 4, 7}
  for a = aLow(m) to aLow(m) + 2
    for b = bLow(m) to bLow(m) + 2
      keep(a, b) = incol(a, b)
    next
  next
end sub

Maybe a little more complex to read, but less chance of an error caused by a typo.
jdebord
Posts: 508
Joined: May 27, 2005 6:20
Location: Limoges, France
Contact:

Postby jdebord » Oct 05, 2011 7:58

Thanks Dodicat. It works now :)

I have taken this opportunity to reorganize the FBMath archive a bit. Links to individual files are in:

http://tech.groups.yahoo.com/group/fbmathlib/files

You must subscribe to the mailing list to access the files.
dodicat
Posts: 4951
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Oct 05, 2011 9:49

jdebord wrote:Thanks Dodicat. It works now :)

I have taken this opportunity to reorganize the FBMath archive a bit. Links to individual files are in:

http://tech.groups.yahoo.com/group/fbmathlib/files

You must subscribe to the mailing list to access the files.

Thanks jdebord.
Since Yahoo mail is a FREE service, and by definition all members of this forum are thrifty, in as much as they don't like to pay for too much, then perhaps more members could be inspired to use your archive.

Any mention of Pounds, Francs, Pesetas or Rupees , of course, gets them very agitated.
They would scatter in all directions, like rats from a sinking ship.

@badidea
Thanks.
I'll make up macros for repetitions as in your example, and reduce the length of the file.
fxm
Posts: 8053
Joined: Apr 22, 2009 12:46
Location: Paris suburb, FRANCE

Postby fxm » Oct 05, 2011 11:38

badidea wrote:Can be rewritten like this (untested):

Code: Select all

Sub makekeep (m As Integer)
  Dim a, b As Integer
  dim as integer aLow(9) => {1, 1, 1, 4, 4, 4, 7, 7, 7}
  dim as integer bLow(9) => {1, 4, 7, 1, 4, 7, 1, 4, 7}
  for a = aLow(m) to aLow(m) + 2
    for b = bLow(m) to bLow(m) + 2
      keep(a, b) = incol(a, b)
    next
  next
end sub

Maybe a little more complex to read, but less chance of an error caused by a typo.


- Method with tabulated indexes from badidea (lightly corrected):

Code: Select all

Sub makekeep (m As Integer)
  dim as integer a, b
  dim as integer aLow(1 to 9) => {1, 1, 1, 4, 4, 4, 7, 7, 7}
  dim as integer bLow(1 to 9) => {1, 4, 7, 1, 4, 7, 1, 4, 7}
  for a = aLow(m) to aLow(m) + 2
    for b = bLow(m) to bLow(m) + 2
      keep(a, b) = incol(a, b)
    next
  next
end sub


- Method with computed indexes:

Code: Select all

Sub makekeep (m As Integer)
  dim as integer a, b
  dim as integer aLow = 1 + 3 * int((m - 1) / 3)
  dim as integer bLow = 1 + 3 * ((m - 1) mod 3)
  for a = aLow to aLow + 2
    for b = bLow to bLow + 2
      keep(a, b) = incol(a, b)
    next
  next
end sub
podvornyak
Posts: 148
Joined: Nov 12, 2007 11:46
Location: Russia

Postby podvornyak » Oct 05, 2011 12:36

fxm wrote:Try to replace Screenlock/Screenunlock structure by double buffering as following:

Still fault. Suppose, it is my environment trouble.
fxm
Posts: 8053
Joined: Apr 22, 2009 12:46
Location: Paris suburb, FRANCE

Postby fxm » Oct 05, 2011 13:13

podvornyak wrote:
fxm wrote:Try to replace Screenlock/Screenunlock structure by double buffering as following:

Still fault. Suppose, it is my environment trouble.

Have you try to modify the two statements:
Sleep 1,1
by for example:
Sleep 25,1

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest