Sudoku Solver (re-done)

dodicat
Posts: 6234
Joined: Jan 10, 2006 20:30
Location: Scotland

Sudoku Solver (re-done)

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/WindowsType d2    As Integer x,y,w,h,index    As Uinteger colour    As String captionEnd 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 functionDeclare 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 getoutDeclare Sub main Declare  Sub setboxesDeclare 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#endmacroDeclare Function roundup (a As Double, b As Integer) As SingleDeclare 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 IntegerDeclare 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 IntegerDeclare Sub dummy ()Declare Sub setup ()Declare Sub build (z As Integer)Declare Function bigcheck () As IntegerDeclare Function weecheck (m As Integer) As IntegerDeclare Function cycle (x As Integer) As IntegerDeclare Sub solve ()Declare Function runcheck (n As Integer, x As Integer, y As Integer, m As Integer) As IntegerDeclare Function checkerr (m2() As Integer, x As Integer, y As Integer) As IntegerDeclare Sub grid ()Declare Sub box2 (s As String)Const ok = 1Const notok = 0Dim Shared mglobal(9,9) As IntegerDim Shared square As IntegerDim Shared bb(1 To 9) As IntegerDim Shared hopper(1 To 9) As IntegerDim As Integer a1,b1Dim Shared inrow(9, 9) As IntegerDim Shared incol(9, 9) As IntegerDim Shared keep(9, 9) As IntegerDim Shared startall As DoubleDim Shared endall As DoubleDim Shared boxes As IntegerDim Shared As d2 big(9*9),p,nums(9),info(1),help(0)Dim Shared As Integer xres,yres,dragflag,helpflag,errorflagDim Shared As String dragnum'____________________Screen 19,32Screeninfo (xres,yres)setboxesmainstartall=TimerClsboxes = 1gridFor a1 = 1 To 9    For b1 = 1 To 9        keep(a1, b1) = mglobal(a1, b1)    Next b1Next a1  box2("n")setupwhatsize("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 = okEnd FunctionSub 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, 4End SubFunction 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 FunctionSub 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 SubFunction 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 countEnd FunctionFunction cycle (x As Integer) As Integer    If x Mod 9 = 0 Then        cycle = 9    Else         cycle = x Mod 9    End IfEnd FunctionSub 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 IfEnd SubSub 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 a2End SubSub 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 xEnd SubSub 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 xEnd SubSub 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 SubFunction 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 = okEnd FunctionSub phase (number As Integer)    actions("-1","-1","solving","phase "+Str\$(number))End SubSub 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 SubFunction 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 = rEnd FunctionFunction 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 FunctionSub 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 alongEnd SubSub 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 aEnd SubSub 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 SubSub 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 a1End SubSub 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 = TimerEnd SubSub 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    EndEnd SubSub 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    EndEnd SubSub 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 SubSub 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 IfEnd SubFunction 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 IfEnd FunctionSub whatsize(n As String)    Locate 22, 4    If n="show" Then        Print "Press any key for quit option"        startall = Timer    Else        Print "                                            "    End IfEnd SubSub 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;"   "+actionEnd SubSub 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 IfEnd SubSub 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 IfEnd SubSub 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 SubSub 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 IfEnd SubSub 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)    EndEnd Sub`
Last edited by dodicat on Oct 09, 2011 20:54, edited 1 time in total.
jdebord
Posts: 525
Joined: May 27, 2005 6:20
Location: Limoges, France
Contact:
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: 333
Joined: Jun 02, 2007 12:35
Location: Sydney, Australia
@ 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
Compiling clear, but segmentation fault on run. Ubuntu 10.04 64bit
pestery
Posts: 493
Joined: Jun 16, 2007 2:00
Location: Australia
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: 9529
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE
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 solverType d2    As Integer x,y,w,h,index    As Uinteger colour    As String captionEnd 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#endmacroDeclare 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 getoutDeclare Sub mainDeclare  Sub setboxesDeclare 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#endmacroDeclare Function roundup (a As Double, b As Integer) As SingleDeclare 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 IntegerDeclare 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 IntegerDeclare Sub dummy (mm As Integer)Declare Sub setup ()Declare Sub build (z As Integer)Declare Function bigcheck () As IntegerDeclare Function wee2 (x As Integer, y As Integer) As IntegerDeclare Function weecheck (m As Integer) As IntegerDeclare Function cycle (x As Integer) As IntegerDeclare Function noblanks () As IntegerDeclare Sub solve ()Declare Function runcheck (n As Integer, x As Integer, y As Integer, m As Integer) As IntegerDeclare Function checkerr (m2() As Integer, x As Integer, y As Integer) As IntegerDeclare Sub cols ()Declare Sub grid ()Declare Sub box2 (s As String)Const ok = 1Const notok = 0Dim m(1 To 9,1 To  9) As IntegerDim Shared mglobal(9,9) As IntegerDim Shared square As IntegerDim Shared bb(1 To 9) As IntegerDim Shared hopper(1 To 9) As IntegerDim Shared testflag As IntegerDim redoflag As IntegerDim As Integer a,aa1,b,a1,b1,diff,holdbDim Shared inrow(9, 9) As IntegerDim Shared incol(9, 9) As IntegerDim Shared keep(9, 9) As IntegerDim Shared startall As DoubleDim Shared endall As DoubleDim Shared boxes As IntegerDim Shared beginningflag As IntegerDim Shared As d2 big(9*9),p,nums(9),info(1),help(0)Dim Shared As Integer xres,yres,dragflag,helpflag,errorflagDim Shared As String dragnumletsgo:'Screen 19,32Screen 19,32,2Screenset 1, 0Screeninfo (xres,yres)setboxesmainredoflag = notoktestflag = notokhelpflag = notokstartall=TimerClstestflag = okboxes = 1'500gridGoto 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 b1Next a1Clsgrid   box2("n")setupwhatsize("show")solvebox2 ("r")timeoutLocate 10, 10Print "finished"actions("-1","-1","            ","                   ")actions("-1","-1","solved","(AND CHECKED)")textendIf beginningflag = ok Then Goto letsgoEndFunction 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 = okEnd 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, 4End Sub#endmacroSub 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, 4End SubFunction 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 IfEnd FunctionSub 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 IfEnd SubFunction 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 countEnd FunctionSub cols    Dim b1 As Integer    Color 2, 4    For b1 = 1 To 9        Locate 20, 25 + 4 * b1        Print b1    Next b1    Color 15, 4End SubFunction cycle (x As Integer) As Integer    If x Mod 9 = 0 Then        cycle = 9    Else        cycle = x Mod 9    End IfEnd FunctionSub 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 IfEnd SubSub 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 a2End SubSub 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 xEnd SubSub 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 xEnd SubSub 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 IfEnd SubFunction 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 = okEnd FunctionSub phase (number As Integer)    actions("-1","-1","solving","phase "+Str\$(number))End SubSub 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 SubFunction 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 = rEnd FunctionFunction 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 IfEnd FunctionSub 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 alongEnd SubSub 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 aEnd SubSub 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 IfEnd SubSub 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 a1End SubSub 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 = TimerEnd SubSub 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    EndEnd SubSub 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    EndEnd SubSub 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'        ScreenunlockScreencopy        Sleep 1,1    LoopEnd SubSub 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 IfEnd SubFunction 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 IfEnd FunctionSub whatsize(n As String)    Locate 22, 4    If n="show" Then        Print "Press any key for quit option"        startall = Timer    Else        Print "                                            "    End IfEnd SubSub 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;"   "+actionEnd SubSub 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 IfEnd SubSub 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 IfEnd SubSub 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 SubSub 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 9Screen 9,,2Screenset 1, 0        Exit Sub    End IfEnd SubSub 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'        ScreenunlockScreencopy        Sleep 1,1    Loop Until Inkey=Chr(27) End Sub`
dodicat
Posts: 6234
Joined: Jan 10, 2006 20:30
Location: Scotland
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: 9529
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE
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: 6234
Joined: Jan 10, 2006 20:30
Location: Scotland
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.
Posts: 1897
Joined: May 24, 2007 22:10
Location: The Netherlands
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 IfEnd 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  nextend sub`

Maybe a little more complex to read, but less chance of an error caused by a typo.
jdebord
Posts: 525
Joined: May 27, 2005 6:20
Location: Limoges, France
Contact:
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: 6234
Joined: Jan 10, 2006 20:30
Location: Scotland
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.

Thanks.
I'll make up macros for repetitions as in your example, and reduce the length of the file.
fxm
Posts: 9529
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE
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  nextend 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  nextend 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  nextend sub`
podvornyak
Posts: 148
Joined: Nov 12, 2007 11:46
Location: Russia
fxm wrote:Try to replace Screenlock/Screenunlock structure by double buffering as following:

Still fault. Suppose, it is my environment trouble.
fxm
Posts: 9529
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE
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