10 ' SUDOKU v1.0 for Maximite-MMbasic v3.1 by Raros/BFTI
20 ' Greetings & Thanks to Geoff Graham for free job and great 
30 ' project of Maximite/MMbasic,
35 ' To all members of forum The Back Shed,
40 ' To Digitalquirk for big idea for VCSUDOKU,
45 ' To Rob Hubbard for music bass of Crazy_Comets.
50 CLS
51 ' *****************
52 Dim mus1(47)
53 musindex=0
54 For t = 0 To 47:Read mus1(t):Next
55 ' *****************
300 SetTick 125,6500: ' Sound Interrupt
3000 ' *************************************************************
3010 ' * Routine SUDOKU v 1.0 16-02-2012
3030 ' *************************************************************
3040 Dim a(8,8,1):Dim b(2,8):Dim r1(2):h=1:v=1:aa=9:bb=10
3050 Cls:Randomize Timer:Font 2,1
3060 Print"    Sudoku":Font 1,1
3070 Print"   from idea by Digitalquirk"
3080 Print"     for Vic20 application"
3090 Print" Reworked by Raros for Maximite":Print:Print
3100 Print" Please select:":Print
3110 Print" ";:Font 1,1,1:Print "f1";:Font 1,1,0:Print" : easy"
3120 Print" ";:Font 1,1,1:Print "f2";:Font 1,1,0:Print" : medium"
3130 Print" ";:Font 1,1,1:Print "f3";:Font 1,1,0:Print" : hard"
3140 Print" ";:Font 1,1,1:Print "f4";:Font 1,1,0:Print" : empty grid"
3145 Print" ";:Font 1,1,1:Print "f5";:Font 1,1,0:Print" : load previous game"
3150 a$=Inkey$: If a$="" Then GoTo 3150
3160 If Asc(a$)=145 Then fu=38:GoTo 3210:'  f1
3170 If Asc(a$)=146 Then fu=48:GoTo 3210:'  f2
3180 If Asc(a$)=147 Then fu=57:GoTo 3210:'  f3
3190 If Asc(a$)=148 Then GoTo 3202:'        f4
3195 If Asc(a$)=149 Then GoTo 3210:'        f5
3200 GoTo 3150
3202 fu=1:For t = 1 To 10
3204 Font 1,1:Print @(36,180) " Use + and - for Un/Lock Key number ":Pause 300
3206 Font 1,1,1:Print @(36,180) " Use + and - for Un/Lock Key number ":Pause 300
3208 Next
3210 ' Grid generator
3215 SetTick 0,0:' Stop Sound
3220 Cls
3230 GRAFLOAD$="sudokul1.mpf":GoSub 5700
3240 ' *** COLUMN ***
3250 lin_or=2:lin_ver=0
3260 For t = 1 To 3
3270 Line (lin_or,0)-(lin_or,215),1
3280 For t1 = 1 To 2
3290 lin_or=lin_or+12
3300 For t2 = 0 To 215 Step 2
3310 Pixel(lin_or,t2)=1
3320 Next t2
3330 Next t1
3340 lin_or=lin_or+12
3350 Next t
3360 ' *** ROW ***
3370 Line (lin_or,0)-(lin_or,215),1
3380 For t = 1 To 3
3390 Line (2,lin_ver)-(110,lin_ver),1
3400 For t1 = 1 To 2
3410 lin_ver=lin_ver+24
3420 For t2 = 2 To 110 Step 2
3430 Pixel(t2,lin_ver)=1
3440 Next t2:Next t1
3450 lin_ver=lin_ver+24
3460 Next t
3470 Line (2,215)-(110,215),1
3480 ' End Grid generator
3490 If Asc(a$)=148 Then GoTo 3760:'              Empty grid
3495 If Asc(a$)=149 Then GoSub 4700:GoTo 3760:'   LOAD Previous Game
3500 For sr=0 To 8:For sl=0 To 8:Read a(sr,sl,0):Next sl:Next sr
3510 sc=0
3520 For rp=0 To 2
3530 GoSub 3970
3540 For sr=0 To 2:For sl=0 To 8:b(sr,sl)=a(sr+sc,sl,0):Next sl:Next sr
3550 For sr=0 To 2:For sl=0 To 8:a(sr+sc,sl,0)=b(r1(sr),sl):Next sl:Next sr
3560 sc=sc+3:Next rp
3570 sc=0
3580 For rp=0 To 2
3590 GoSub 3970
3600 For sl=0 To 2:For sr=0 To 8:b(r1(sl),sr)=a(sr,sl+sc,0):Next sr:Next sl
3610 For sl=0 To 2:For sr=0 To 8:a(sr,sl+sc,0)=b(sl,sr):Next sr:Next sl
3620 sc=sc+3
3630 Next rp
3640 For sr=1 To fu
3650 v=Int(Rnd(1)*9):h=Int(Rnd(1)*9)
3660 If a(v,h,0)=0 Then GoTo 3650
3670 a(v,h,0)=0:Next sr
3680 '  Write number on grid
3690 lin_or=6:lin_ver=7
3700 For sr=0 To 8:For sl=0 To 8
3710 If a(sr,sl,0)>0 Then Print @(lin_or,lin_ver)Str$(a(sr,sl,0)):a(sr,sl,1)=1:GoSub 4390
3720 lin_or=lin_or+12:Next sl
3730 lin_or=6
3740 lin_ver=lin_ver+24:Next sr
3750 ' END Write number on grid
3760 ' **** First box in Reverse
3770 lin_or=6:lin_ver=7:h=1:v=1
3780 rev=1:GoSub 4410
3790 Timer=tempo
3800 Print @(280,37)"v1.0"
3810 Print @(170,58)"FOR MAXIMITE"
3820 Print @(140,100)"1-9 Value and 0 for Erase"
3830 Print @(140,120)"CursorKey for move"
3835 Print @(140,140)"S for Save game"
3840 Print @(140,160)"X for Exit"
3845 Print @(230,204)"TIME:"
3850 Print @(264,204)Int(Timer/1000)
3860 a$=Inkey$: If a$="" Then GoTo 3850
3870 If Asc(a$)=131 And h<9 Then GoSub 4060:' MOVIMENTO a DESTRA
3880 If Asc(a$)=130 And h>1 Then GoSub 4070:' MOVIMENTO a SINISTRA
3890 If Asc(a$)=129 And v<9 Then GoSub 4080:' MOVIMENTO in GIU'
3900 If Asc(a$)=128 And v>1 Then GoSub 4090:' MOVIMENTO in SU'
3910 If a$="0" Then GoSub 4100:'  CANCELLA
3920 If Val(a$)>0 And Val(a$)<10 Then GoSub 4120
3930 If a$="x" Or a$="X" Then GoTo 3960: ' EXIT
3935 If a$="s" Or a$="S" Then GoSub 4600: ' Save games
3937 If a$="+" And fu=1 Then If a(v-1,h-1,0)>0 Then a(v-1,h-1,1)=1:GoSub 4390:' is Number Key: LOCK and underscore
3939 If a$="-" And fu=1 Then a(v-1,h-1,1)=0:GoSub 4405:' is no Number Key: UNLOCK and remove underscore
3945 GoTo 3850
3950 '************  END  **************************
3960 Cls:Print:Print "Bye Bye from Raros":Print:End
3961 ' Raffaele Rotondo - 82100 Benevento - ITALY
3962 ' on Facebbok and Skype: raros0101 (also Rotondo Lello - raros_eepc)
3965 '************  END  **************************
3970 r1(0)=9:r1(1)=9:r1(2)=9
3980 For sr=0 To 2
3990 rn=Int(Rnd(1)*3)
4000 For sl=0 To 2
4010 If rn=r1(sl) Then GoTo 3990
4020 Next sl
4030 r1(sr)=rn:Next sr:Return
4040 Stop
4050 ' ***********  SUBROUTINE  Cursore ***********
4060 rev=0:GoSub 4410:lin_or=lin_or+12:h=h+1:rev=1:GoSub 4410:Return:' MOVIMENTO a DESTRA
4070 rev=0:GoSub 4410:lin_or=lin_or-12:h=h-1:rev=1:GoSub 4410:Return:' MOVIMENTO a SINISTRA
4080 rev=0:GoSub 4410:lin_ver=lin_ver+24:v=v+1:rev=1:GoSub 4410:Return:' MOVIMENTO in GIU'
4090 rev=0:GoSub 4410:lin_ver=lin_ver-24:v=v-1:rev=1:GoSub 4410:Return:' MOVIMENTO in SU'
4100 If a(v-1,h-1,1)=1 Then Return:' NO  una casella con numero chiave
4110 a(v-1,h-1,0)=0:rev=1:GoSub 4410:Return:'  OK CANCELLA
4120 If a(v-1,h-1,1)=1 Then Return:' NO  una casella con numero chiave
4130 '
4140 For sl=0 To 8
4150 If Val(a$)=a(v-1,sl,0) Then GoSub 4360:Return:' ERRORE vert
4160 Next sl
4170 For sl=0 To 8
4180 If Val(a$)=a(sl,h-1,0) Then GoSub 4360:Return:' ERRORE orizz
4190 Next sl
4200 If v<4 Then aa=0
4210 If v>3 Then aa=3
4220 If v>6 Then aa=6
4230 If h<4 Then bb=0
4240 If h>3 Then bb=3
4250 If h>6 Then bb=6
4260 For sr=0 To 2:For sl=0 To 2
4270 If Val(a$)=a(aa+sr,bb+sl,0) Then GoSub 4360:Return:' ERRORE QUADR
4280 Next sl:Next sr
4290 a(v-1,h-1,0)=Val(a$):rev=1:GoSub 4410
4300 For sr=0 To 8:For sl=0 To 8
4310 If a(sr,sl,0)=0 Then Return
4320 Next sl:Next sr
4330 Print @(150,180)" YOU WIN!!!!"
4335 musindex=17:SetTick 125,6630
4340 Do While (Inkey$ = ""):Loop
4350 GoTo 3960: ' >>>>>>>>>>> EXIT <<<<<<<<<<<<<<<<<
4360 ' ********************************************************
4370 Print @(lin_or,lin_ver)"E":Sound 100,300:Pause 1000
4380 a(v-1,h-1,0)=Val(a$):rev=1:GoSub 4410:Return
4390 ' sottolinea i numeri immessi/generati: UNDERSCORE
4400 Line (lin_or,lin_ver+13)-(lin_or+5,lin_ver+13):Return
4405 ' Toglie la sottolinea dei numeri immessi/generati: REMOVE UNDERSCORE
4406 Line (lin_or,lin_ver+13)-(lin_or+5,lin_ver+13),0:Return
4410 ' Toggle casella in reverse conservando il contenuto
4420 Font 1,1,rev
4430 If a(v-1,h-1,0)=0 Then
4440 Print @(lin_or,lin_ver)" "
4450 Else
4460 Print @(lin_or,lin_ver)Str$(a(v-1,h-1,0))
4470 EndIf
4480 Font 1,1:Return
4490 ' END Toggle casella in reverse
4500 '***********************************************
4600 ' Save Game (163 variables: a(8,8,1)+Timer/tempo)
4610 tempo = Timer
4620 Open "sudoku.sav" For output As 1
4630 For t = 0 To 1
4640 For t1 =0 To 8
4650 For t2=0 To 8
4660 Print #1,a(t2,t1,t)
4670 Next t2:Next t1:Next t
4680 Print #1,Tempo
4690 Close 1:Return
4695 '********* END Save Game ****************
4700 ' Load previous Game (163 variables: a(8,8,1)+Timer/tempo)
4710 Open "sudoku.sav" For input As 1
4730 For t = 0 To 1
4740 For t1 =0 To 8
4750 For t2=0 To 8
4760 Input #1,a(t2,t1,t)
4770 Next t2:Next t1:Next t
4780 Input #1,Tempo
4790 Close 1
4800 '      Write number on grid
4810 lin_or=6:lin_ver=7
4820 For sr=0 To 8:For sl=0 To 8
4830 If a(sr,sl,0)>0 Then Print @(lin_or,lin_ver)Str$(a(sr,sl,0))
4840 If a(sr,sl,1)>0 Then GoSub 4390
4850 lin_or=lin_or+12:Next sl
4860 lin_or=6
4870 lin_ver=lin_ver+24:Next sr
4878 '     END Write number on grid
4880 Return
4890 '********* END Load previous Game **********************
4900 '*******************************************************
5700 ' *********  MPFVIEW by crackerjack 10/2011
5710 Open GRAFLOAD$ For INPUT As #1
5720 Line Input #1,ID$:If ID$<>"MPF1" Then GoTo 5910
5730 Line Input #1,WIDTH$
5740 Line Input #1,HEIGHT$
5750 Y=Val(HEIGHT$)
5760 WIDTH=Val(WIDTH$)-1
5770 X1=0
5780 X2=Asc(Input$(1,#1))-1
5790 PXL=Val(Input$(1,#1))
5800 Line(X1,Y)-(X2,Y),PXL
5810 Do
5820   If X2>=WIDTH Then
5830     X1=0:Y=Y-1
5840   Else
5850     X1=X2+1
5860   EndIf
5870   X2=X1+Asc(Input$(1,#1))-1
5880   PXL=Val(Input$(1,#1))
5890   Line(X1,Y)-(X2,Y),PXL
5900 Loop Until Eof(#1)
5910 Close #1
5920 Return
5930 '***********************************************
6500 ' ***** INTERRUPT 1 *****
6520 'Sound 0,0
6530 Sound mus1(musindex),90:' 110
6535 musindex=musindex+1
6540 If musindex > 16 Then SetTick 125,6600
6550 IReturn
6600 ' ***** INTERRUPT 2 *****
6620 'Sound 0,0
6630 Sound mus1(musindex),120,3:' 110,5
6635 musindex=musindex+1
6640 If musindex > 47 Then musindex=16
6650 IReturn
6660 '***********************************************
7000 ' ************ Dati per la musica **************
7010 ' frequenze musica prima parte (16 note:0-15)
7011 Data 131,131,131,131,131,0,131,131
7012 Data 87.3,87.3,87.3,87.3,0,87.3,87.3,87.3
7013 ' frequenze musica seconda parte (32 note:16-47)
7014 Data 98,0,0,196,0,87.3,92.5,0
7016 Data 98,0,0,196,0,196,87.3,92.5
7018 Data 98,0,0,196,0,0,110,0
7020 Data 117,117,233,117,131,131,262,131
7030 ' ********** End Music **************
7040 ' *********************************************
7500 ' valori preelaborati x Sudoku by 'Digitalquirk'
7505 Data 2,1,8,6,3,9,4,7,5,5,9,6,8,7,4,1,2,3
7510 Data 7,4,3,1,5,2,6,8,9,1,5,9,7,6,8,3,4,2
7520 Data 6,3,4,2,9,5,7,1,8,8,2,7,3,4,1,9,5,6
7530 Data 9,6,1,5,2,7,8,3,4,4,7,2,9,8,3,5,6,1
7540 Data 3,8,5,4,1,6,2,9,7


