SUSOLVER.BAS
0 rem poke808,234:rem deactivat runstop key
1 c1= 1:c2= 1:rem 7
2 bo=0:max=3
5 rem 80 - draw frame
6 rem 200 - input from joy and keys
7 rem 300 - display array
8 rem 360 - draw grid
9 rem 400 - read data into array
10 rem 500 - solve sudoku
11 rem 700 - help screen
12 rem 850 - clear board
15 poke53280,0:poke53281,0
20 printchr$(5):rem textcolor:rem poke646,1
30 printchr$(147);:rem clear screen
40 rem print"{swlc}";:rem upper&lowercase
52 printtab(8)"{gry1}{CBM-V}{lgrn}{CBM-B}{grn}{CBM-D}{lgrn}{CBM-B}{CBM-F}{wht}{CBM-B}{lgrn}{CBM-F}{CBM-B}{CBM-C}{grn}{CBM-B}{CBM-D}{gry1}{CBM-F}{grn}{CBM-C}{lgrn}{CBM-B}{wht}{CBM-D}{lgrn}{CBM-B}{grn}{CBM-F}{CBM-B}{gry1}{CBM-C}{grn}{CBM-B}{lgrn}{CBM-D}{gry1}{CBM-C}"
56 printtab(8)"{grn}{CBM-D} {CBM-C}"
60 printtab(8)"{lgrn}{CBM-V} {wht}easy sudoku solver {grn}{CBM-B}"
62 rem printtab(8)"{lgrn}{CBM-V} {wht}EasY sUdOkU sOLvER {grn}{CBM-B}"
65 printtab(8)"{lgrn}{CBM-B} {gry1}{CBM-D}"
66 printtab(8)"{gry1}{CBM-F}{grn}{CBM-B}{lgrn}{CBM-C}{wht}{CBM-D}{lgrn}{CBM-V}{grn}{CBM-B}{gry1}{CBM-D}{grn}{CBM-C}{lgrn}{CBM-V}{CBM-C}{wht}{CBM-F}{lgrn}{CBM-F}{grn}{CBM-C}{CBM-B}{lgrn}{CBM-D}{grn}{CBM-B}{lgrn}{CBM-B}{wht}{CBM-V}{lgrn}{CBM-B}{CBM-F}{CBM-B}{grn}{CBM-D}"
67 print:printtab(8)"{gry2}initializing..."
68 dimb(8,8):dimt(8,8):dime(8)
69 e(0)=0:e(1)=1:e(2)=2:e(3)=4:e(4)=5:e(5)=6:e(6)=8:e(7)=9:e(8)=10
70 printtab(8)"{up} "
71 poke781,23:poke782,0:sys65520
72 print" {rvon}{yel}f1{lblu} help {yel}f2{lblu} example {yel}f4{lblu} clear {yel}f5{lblu} solve "
77 gosub80:gosub360
78 gosub200: gosub500
79 goto78
80 rem *** draw frame ***
90 poke781,6:poke782,0:sys65520:rem cursor position
95 remprint"{up}{up}"
100 printtab(13)"{wht}{CBM-D}{gry3}{CBM-I}{lred}{CBM-I}{gry2}{CBM-I}{orng}{CBM-I}{gry1}{CBM-I}{brn}{CBM-I}{gry1}{CBM-I}{orng}{CBM-I}{gry2}{CBM-I}{lred}{CBM-I}{gry3}{CBM-I}{wht}{CBM-F}"
101 printtab(13)"{gry3}{rvon}{CBM-K}{rvof}{wht} {gry3} {wht} {gry3} {wht} {gry3}{CBM-K}"
102 printtab(13)"{lred}{rvon}{CBM-K}{rvof}{wht} {lred} {wht} {lred} {wht} {lred}{CBM-K}"
103 printtab(13)"{gry2}{rvon}{CBM-K}{rvof}{wht} {gry2} {wht} {gry2} {wht} {gry2}{CBM-K}"
104 printtab(13)"{orng}{rvon}{CBM-K}{rvof} {orng}{CBM-K}"
105 printtab(13)"{gry1}{rvon}{CBM-K}{rvof}{wht} {gry1} {wht} {gry1} {wht} {gry1}{CBM-K}"
106 printtab(13)"{brn}{rvon}{CBM-K}{rvof}{wht} {brn} {wht} {brn} {wht} {brn}{CBM-K}"
107 printtab(13)"{gry1}{rvon}{CBM-K}{rvof}{wht} {gry1} {wht} {gry1} {wht} {gry1}{CBM-K}"
108 printtab(13)"{orng}{rvon}{CBM-K}{rvof} {orng}{CBM-K}"
109 printtab(13)"{gry2}{rvon}{CBM-K}{rvof}{wht} {gry2} {wht} {gry2} {wht} {gry2}{CBM-K}"
110 printtab(13)"{lred}{rvon}{CBM-K}{rvof}{wht} {lred} {wht} {lred} {wht} {lred}{CBM-K}"
111 printtab(13)"{gry3}{rvon}{CBM-K}{rvof}{wht} {gry3} {wht} {gry3} {wht} {gry3}{CBM-K}"
120 printtab(13)"{wht}{CBM-C}{rvon}{gry3}{CBM-I}{lred}{CBM-I}{gry2}{CBM-I}{orng}{CBM-I}{gry1}{CBM-I}{brn}{CBM-I}{gry1}{CBM-I}{orng}{CBM-I}{gry2}{CBM-I}{lred}{CBM-I}{gry3}{CBM-I}{rvof}{wht}{CBM-V}"
125 print"{wht}"
130 return
200 rem *** input from joy and keys ***
205 x=0:y=0:k=0:k$=""
212 poke1318+a,peek(1318+a)or128:getk$:j=peek(56320):f=jand16:j=15-(jand15)
213 ifk$=""andj<>4andj<>8andj<>1andj<>2then212
214 ifk$=chr$(135)thenreturn
215 ifk$=chr$(32)thenb(x,y)=0:poke1318+a,32
216 ifk$=chr$(133)thengosub700
218 ifk$=chr$(137)thengosub400:gosub500
219 ifk$=chr$(138)thengosub850
220 v=asc(k$)
227 ifj=8orv=29thenx=x+1
228 ifj=4orv=157thenx=x-1
229 ifj=2orv=17theny=y+1
230 ifj=1orv=145theny=y-1
231 ifx>8thenx=8
232 ifx<0thenx=0
233 ify>8theny=8
234 ify<0theny=0
235 poke1318+a,peek(1318+a)and127
240 k=0:ifk$<>""thenk=asc(k$)
245 a=e(x)+e(y)*40:ifk>48andk<58thenpoke1318+a,k:b(x,y)=k-48
250 goto212
255 rem input
260 return
300 rem *** display array ***
310 j=0:fory=0to8:i=0:forx=0to8
322 ch=b(x,y):col=c1
324 ifch=0thench=48:col=c2
326 addr=i+14+(j+7)*40
328 poke55296+addr,col
330 poke1024+addr,48+ch
340 i=i+1:ifi=3ori=7theni=i+1
345 next
355 j=j+1:ifj=3orj=7thenj=j+1
357 next
359 return
360 rem *** draw grid ***
365 rempoke781,7:poke782,4:sys65520:rem cursor position
370 fori=0to10:poke1321+i*40,66:poke1325+i*40,66:poke1438+i,67:poke1598+i,67:next
375 poke1441,91:poke1445,91:poke1601,91:poke1605,91:poke55710,15:poke55711,10:poke55712,12
380 poke55714,11:poke55715,9:poke55716,11:poke55718,12:poke55719,10:poke55720,15:poke55870,15
390 poke55871,10:poke55872,12:poke55874,11:poke55875,9:poke55876,11:poke55878,12:poke55879,10
395 poke55880,15:return
400 rem *** read data into array ***
401 restore:readh:l=peek(65)-3:h=peek(66):restore:rem size=180
402 s=l+h*256:p=s+186*bo:poke65,pand255:poke66,int(p/256):rem dataline
404 fory=0to8:forx=0to8:readb(x,y)
405 next:next
406 bo=bo+1:m=bo-(int(bo/max)*max):bo=m
407 gosub300:rem display array
408 return
410 printl;" "h;" ("l;")"
415 printpeek(65);" ";peek(66)
420 end
500 rem *** solve sudoku ***
501 rem z=323
502 z=0:ti$="000000"
504 poke781,20:poke782,0:sys65520
505 printtab(9)" "
506 poke781,20:poke782,0:sys65520
507 printtab(9)"solving sudoku..."
510 fora=0to4:forn=1to9:t(0,0)=b(0,0):t(0,1)=b(0,1):t(0,2)=b(0,2):t(0,3)=b(0,3)
511 t(0,4)=b(0,4):t(0,5)=b(0,5):t(0,6)=b(0,6):t(0,7)=b(0,7):t(0,8)=b(0,8)
512 t(1,0)=b(1,0):t(1,1)=b(1,1):t(1,2)=b(1,2):t(1,3)=b(1,3):t(1,4)=b(1,4)
513 t(1,5)=b(1,5):t(1,6)=b(1,6):t(1,7)=b(1,7):t(1,8)=b(1,8):t(2,0)=b(2,0)
514 t(2,1)=b(2,1):t(2,2)=b(2,2):t(2,3)=b(2,3):t(2,4)=b(2,4):t(2,5)=b(2,5)
515 t(2,6)=b(2,6):t(2,7)=b(2,7):t(2,8)=b(2,8):t(3,0)=b(3,0):t(3,1)=b(3,1)
516 t(3,2)=b(3,2):t(3,3)=b(3,3):t(3,4)=b(3,4):t(3,5)=b(3,5):t(3,6)=b(3,6)
517 t(3,7)=b(3,7):t(3,8)=b(3,8):t(4,0)=b(4,0):t(4,1)=b(4,1):t(4,2)=b(4,2)
518 t(4,3)=b(4,3):t(4,4)=b(4,4):t(4,5)=b(4,5):t(4,6)=b(4,6):t(4,7)=b(4,7)
519 t(4,8)=b(4,8):t(5,0)=b(5,0):t(5,1)=b(5,1):t(5,2)=b(5,2):t(5,3)=b(5,3)
520 t(5,4)=b(5,4):t(5,5)=b(5,5):t(5,6)=b(5,6):t(5,7)=b(5,7):t(5,8)=b(5,8)
521 t(6,0)=b(6,0):t(6,1)=b(6,1):t(6,2)=b(6,2):t(6,3)=b(6,3):t(6,4)=b(6,4)
522 t(6,5)=b(6,5):t(6,6)=b(6,6):t(6,7)=b(6,7):t(6,8)=b(6,8):t(7,0)=b(7,0)
523 t(7,1)=b(7,1):t(7,2)=b(7,2):t(7,3)=b(7,3):t(7,4)=b(7,4):t(7,5)=b(7,5)
524 t(7,6)=b(7,6):t(7,7)=b(7,7):t(7,8)=b(7,8):t(8,0)=b(8,0):t(8,1)=b(8,1)
525 t(8,2)=b(8,2):t(8,3)=b(8,3):t(8,4)=b(8,4):t(8,5)=b(8,5):t(8,6)=b(8,6)
526 t(8,7)=b(8,7):t(8,8)=b(8,8)
528 fory=0to8:forx=0to8:ifb(x,y)<>nthen540
530 t(x,0)=n:t(0,y)=n:t(x,1)=n:t(1,y)=n:t(x,2)=n:t(2,y)=n:t(x,3)=n:t(3,y)=n
535 t(x,4)=n:t(4,y)=n:t(x,5)=n:t(5,y)=n:t(x,6)=n:t(6,y)=n:t(x,7)=n:t(7,y)=n
538 t(x,8)=n:t(8,y)=n
540 next:next
542 o=0:forx=0to8:fory=0to8:if(b(x,y)<>0)theno=o+1
544 nexty:nextx
550 forq=0to2:s=3*q:forp=0to2:r=3*p:fory=0to2:forx=0to2:ifb(r+x,s+y)<>nthen570
560 t(r,s)=n:t(r+1,s)=n:t(r+2,s)=n:t(r,s+1)=n:t(r+1,s+1)=n:t(r+2,s+1)=n
562 t(r,s+2)=n:t(r+1,s+2)=n:t(r+2,s+2)=n
565 goto580
570 next:next
580 next:next
590 fori=0to8:u=0:v=0:forj=0to8:ift(j,i)=0thenu=u+1:w=j
595 ift(i,j)=0thenv=v+1:d=j
596 next:ifu=1thenb(w,i)=n
597 ifv=1thenb(i,d)=n:rem323:125%:int(z*100/400)
598 printtab(26)"{up}";int(o/81*100);"{left} %":z=z+1:ifo>80thengoto610
599 next:nextn:next
600 printtab(10)"{up}{left} "
610 gosub300:rem display array
615 return
620 printti;" "ti$
640 end
700 rem *** help screen ***
710 poke781,6:poke782,0:sys65520
712 print"sudoku is a game of logic. the task is"
713 print"to fill in the blanks with numbers from"
714 print"1 to 9 and a square in a row has to be"
715 print"an unique number, same with columns.":print
716 print"use the arrow keys or joystick in port"
717 print"2 to move the cursor around the board."
718 print"press any numerical key 1-9 to insert"
719 print"it at the specified cursor location."
720 print
722 print"this program is not a game of sudoku"
724 print"but a sudoku solver. it solves easy"
726 print"and some medium level boards. press f5"
728 print"to start analyzing and solving."
730 print:print"this was coded by rudi in nov/des 2019."
750 getk$:ifk$=""then750
783 poke781,5:poke782,0:sys65520
785 fori=0to16:print" ":nexti
788 poke781,6:poke782,0:sys65520
790 gosub80: gosub360
799 return
800 print chr$(147)
810 getks$:ifks$=""goto810
820 print"ascii code{$a0}is "asc(ks$)
830 goto 810
850 rem *** clear board ***
855 fory=0to8:forx=0to8:b(x,y)=0:next:next:gosub300
860 return
900 print chr$(147)
910 getk$:ifk$=""goto910
912 ifasc(k$)<49 or asc(k$)>57 goto 910
920 k%=val(k$):printk%
930 goto910
1000 data 0,8,0,9,3,6,0,0,0, 7,2,5,0,0,0,0,6,0, 0,0,6,0,0,0,4,1,8
1001 data 0,0,0,6,0,7,1,8,0, 2,6,0,3,0,0,0,4,5, 8,3,0,4,0,9,0,0,0
1002 data 0,5,3,0,9,1,0,0,6, 9,0,8,0,0,5,7,0,4, 0,0,0,0,4,0,5,0,1
1004 data 0,0,8,6,0,1,0,0,0, 3,0,0,0,0,2,0,0,0, 1,0,9,0,0,0,4,6,0
1005 data 7,4,0,8,5,0,3,0,0, 0,0,3,0,0,0,5,0,0, 0,0,2,0,6,3,0,1,8
1006 data 0,9,6,0,0,0,1,0,3, 0,0,0,3,0,0,0,0,5, 0,0,0,9,0,4,6,0,0
1008 data 0,0,0,8,0,3,0,0,1, 0,8,3,2,0,4,0,0,7, 0,7,0,0,9,0,0,0,0
1009 data 0,0,1,0,0,2,0,6,8, 0,6,2,0,4,0,1,7,0, 7,3,0,6,0,0,4,0,0
1010 data 0,0,0,0,6,0,0,1,0, 9,0,0,3,0,1,5,2,0, 3,0,0,4,0,5,0,0,0
2000 rem *** joystick test ***
2010 printchr$(147)
2020 jv=peek(56320)
2030 fr=jvand16
2040 jv=15-(jvand15)
2050 print" ";jv
2060 goto2020
2900 end
8000 rem ******************************
8002 rem * programmed by rudi *
8004 rem * nov/des. 2019 *
8006 rem ****************************** |
