B2B Code Show

Here is a sudoku solver written in freeBASIC by dodicat. Link is to the forum post is here.

'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