Option base 1
Option explicit
Option default integer
CLS
Dim rowb,colb,row,col
dim s$
Dim a%(3,3,3,3,9) 'rowb, colb, row, col, not eliminated
' a possible value is if not seen in rowb=row, colb=col and not in any row/col
Math set 1,a%() 'set all values as possible
'load sample grid
Dim g%(3,3,3,3)
Dim w=MM.Info(fontwidth)
Dim h=MM.Info(fontheight)
Dim i,j,found,eloop, solved
'replace this with a gui
g%(1,1,1,1)=4
g%(1,1,3,1)=6
g%(1,2,2,2)=7
g%(1,2,3,3)=5
g%(1,3,1,1)=6
g%(1,3,2,2)=2
g%(1,3,3,2)=1
g%(2,1,1,2)=8
g%(2,1,2,1)=9
g%(2,1,3,1)=5
g%(2,2,2,1)=2
g%(2,2,3,3)=6
g%(2,3,1,3)=4
g%(2,3,2,3)=3
g%(2,3,3,2)=7
g%(3,1,1,2)=4
g%(3,1,2,2)=1
g%(3,1,3,3)=7
g%(3,2,1,1)=3
g%(3,2,2,2)=9
g%(3,3,1,3)=2
g%(3,3,3,3)=8
displaygrid
do
loop until inkey$=""
do
s$=inkey$
loop until s$<>""
if s$<>chr$(27) then
 For i=0 To 9
   Line w,i*h*3,w*3*9+w,i*h*3,Choice(i Mod 3=0,2,1)
   Line w*i*3+w,0,w*i*3+w,h*3*9,Choice(i Mod 3=0,2,1)
 Next
 For rowb=1 To 3
   For row=1 To 3
     For colb=1 To 3
       For col=1 To 3
         print @(w*2+((colb-1)*9+(col-1)*3)*w,h+((rowb-1)*9+(row-1)*3)*h)"-";
         do
         i=asc(inkey$)-48
         loop until (i>=1 and i<=9) or i=-16
         if i>0 then
           print @(w*2+((colb-1)*9+(col-1)*3)*w,h+((rowb-1)*9+(row-1)*3)*h)str$(i,1);
         else
           print @(w*2+((colb-1)*9+(col-1)*3)*w,h+((rowb-1)*9+(row-1)*3)*h)" ";
         endif
         g%(rowb,colb,row,col)=choice(i>0,i,0)
       next col
     next colb
   Next row
 next rowb
 displaygrid
 pause 1000
endif
'
' first pass look for cells that are now completely defined
DO
 solved=1
 do
   displaygrid
   setup
   possible
   eloop=1
   For colb=1 To 3
     For col=1 To 3
       For rowb=1 To 3
         For row=1 To 3
           j=0
           for i=1 to 9
             If a%(rowb,colb,row,col,i) Then
               inc j
               found=i
             endif
           next i
           if j=1 then
             g%(rowb,colb,row,col)=found
             eloop=0
           endif
         Next row
       next rowb
     next col
   next colb
 loop until eloop=1
 scancol eloop
 if eloop=0 then solved=0
 scanrow eloop
 if eloop=0 then solved=0
 scanblock eloop
 if eloop=0 then solved=0
loop until solved=1
For colb=1 To 3
 For col=1 To 3
   For rowb=1 To 3
     For row=1 To 3
       if g%(rowb,colb,row,col)=0 then solved=0
     Next row
   next rowb
 next col
next colb
if solved=0 then TEXT 50,400,"FAILED",,,3
'
end
'
sub scancol(eloop)
 eloop=1
 local colb,col,rowb,row,i,j, foundr, foundrb
 For colb=1 To 3
   For col=1 To 3
     for i=1 to 9
       j=0
       for rowb=1 to 3
         for row = 1 to 3
           if a%(rowb,colb,row,col,i) then
             inc j
             foundr=row
             foundrb=rowb
           endif
         next row
       next rowb
       if j=1 then
         g%(foundrb,colb,foundr,col)=i
         eloop=0
       endif
     next i
   next col
 next colb
end sub
'
sub scanrow(eloop)
 eloop=1
 local colb,col,rowb,row,i,j, foundc, foundcb
 For rowb=1 To 3
   For row=1 To 3
     for i=1 to 9
       j=0
       for colb=1 to 3
         for col = 1 to 3
           if a%(rowb,colb,row,col,i) then
             inc j
             foundc=col
             foundcb=colb
           endif
         next col
       next colb
       if j=1 then
         g%(rowb,foundcb,row,foundc)=i
         eloop=0
       endif
     next i
   next row
 next rowb
end sub
'
sub scanblock(eloop)
 eloop=1
 local colb,col,rowb,row,i,j, foundc, foundr
 For rowb=1 To 3
   For colb=1 To 3
     for i=1 to 9
       j=0
       for row=1 to 3
         for col = 1 to 3
           if a%(rowb,colb,row,col,i) then
             inc j
             foundc=col
             foundr=row
           endif
         next col
       next row
       if j=1 then
         g%(rowb,colb,foundr,foundc)=i
         eloop=0
       endif
     next i
   next colb
 next rowb
end sub
'
sub displaygrid
 cls
 local colb,col,rowb,row,i,j
 For i=0 To 9
   Line w,i*h*3,w*3*9+w,i*h*3,Choice(i Mod 3=0,2,1)
 Next
 Print ""
'
 For rowb=1 To 3
   For row=1 To 3
     For colb=1 To 3
       For col=1 To 3
         If g%(rowb,colb,row,col) Then
           Print Str$(g%(rowb,colb,row,col),3);
         Else
           Print "   ";
         EndIf
       Next col
     Next colb
     Print ""
     Print ""
     Print ""
   Next row
 Next rowb
'
 For i=0 To 9
   Line w*i*3+w,0,w*i*3+w,h*3*9,Choice(i Mod 3=0,2,1)
 Next
end sub
'
sub checkcols
 local colb,col,rowb,row,i,j
 For colb=1 To 3
   For col=1 To 3
     For rowb=1 To 3
       For row=1 To 3
         if g%(rowb,colb,row,col) then
           for i=1 to 3
             for j=1 to 3
               if NOT (i=rowb and j=row) then modcell(i,colb,j,col,g%(rowb,colb,row,col))
             next j
           next i
         endif
       Next row
     next rowb
   next col
 next colb
end sub
'
sub checkrows
 local colb,col,rowb,row,i,j
 For rowb=1 To 3
   For row=1 To 3
     For colb=1 To 3
       For col=1 To 3
         if g%(rowb,colb,row,col) then
           for i=1 to 3
             for j=1 to 3
               if NOT (i=colb and j=col) then modcell(rowb,i,row,j,g%(rowb,colb,row,col))
             next j
           next i
         endif
       Next col
     next colb
   next row
 next rowb
end sub
'
sub setup
 local colb,col,rowb,row,i,j
 For rowb=1 To 3
   For row=1 To 3
     For colb=1 To 3
       For col=1 To 3
         if g%(rowb,colb,row,col) then
           for i=1 to 3
             for j=1 to 3
               modcell(rowb,colb,i,j,g%(rowb,colb,row,col))
             next j
           next i
           for i=1 to 9
             If g%(rowb,colb,row,col) <>i Then
               modcell(rowb,colb,row,col,i)
             endif
           next i
         endif
       Next col
     Next colb
   Next row
 next rowb
 checkcols
 checkrows
end sub
'
sub modcell rowb,colb,row,col, veto
 a%(rowb,colb,row,col,veto) =0
end sub
'
sub possible
 local colb,col,rowb,row,i,j,found
 for rowb=1 To 3
   For row=1 To 3
     For colb=1 To 3
       For col=1 To 3
         for i=1 to 9
           if a%(rowb,colb,row,col,i) then
             print @(MM.HRES\2+((colb-1)*12+(col-1)*4+(i-1) mod 3)*w,((rowb-1)*12+(row-1)*4+(i-1)\3)*h+h\2)str$(i,1);
             found=1
           else
             print @(MM.HRES\2+((colb-1)*12+(col-1)*4+(i-1) mod 3)*w,((rowb-1)*12+(row-1)*4+(i-1)\3)*h+h\2)" ";
           endif
         next i
       Next col
     Next colb
   Next row
 Next rowb
 if found then
   For i=0 To 9
     Line MM.HRES\2+w*i*4-w\2,0,MM.HRES\2+w*i*4-w\2,h*3*12,Choice(i Mod 3=0,2,1)
     Line MM.HRES\2-w\2,i*h*4,MM.HRES\2-w\2+w*36,i*h*4,Choice(i Mod 3=0,2,1)
   Next i
 endif
end sub