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
10 ' INTRO & 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 ' ***************** 60 T1$= " Greetings to all membe" 62 T2$= "rs forum of The Back She" 63 T3$= "d from Raros of BLACKFIR" 64 T4$= "E TEAM ITALY Greetings to all membe" 68 scroll$ = T1$+T2$+T3$+T4$ 90 ' ********* Load and view BFT3.MPF 92 GRAFLOAD$="BFT3.MPF":Gosub 5700 279 ' *********************** 300 SetTick 125,6500: ' Provasound4 310 ' *********************** 350 Font 2:totchr=83+22 351 T5$=Space$(22) 355 for t = 1 to totchr:' 83+22 char la prima volta. Poi 83 360 for tt = 13 to 1 step -1:' 13 pixel x char 365 Print @(tt-13,198) Mid$(T5$+scroll$,t,25) 367 Print @(305,198)" ":' per nascondere il primo char su VGA 368 Pause 10:Next 370 key$=Inkey$:If key$ <> "" Then Exit For 372 Next 375 totchr=83:T5$="" 380 If key$ = "" Then GoTo 355 400 SetTick 0,0:scroll$="" 410 '************************ 1000 ' ********* SCROLL ***************** 1100 Cls 1110 ' 1119 ' ******* Vertical Scroll ************** 1120 Font 1,2 1130 For t = 0 To 90 1150 Print @(108,t)"PRESENTS" 1170 Pause 30 1200 Next 1210 Pause 800 1240 ' ******* Horizzontal Zoom ************** 1250 hosu2 = 116:' Position start HOrizzontal SUdoku 1251 hosu = hosu2-13:' " " " 1252 vesu = 120:' Position VErtical SUdoku 1253 offsch = 13:' Numero pixel tra i caratteri 1254 pausscrolz = 100 1255 sudoku$="SUDOKU" 1399 ' *************** 1400 for tt = 1 to 6:' Numero caratteri dello zoom 1405 hosu=hosu+offsch 1410 For t = 7 To 0 Step -1:' Zoom decrement 1420 Font 2,t+1 1430 Print @(hosu-(t*30),vesu,1) Mid$(sudoku$,tt,1) 1440 Pause pausscrolz 1450 Print @(hosu-(t*30),vesu) " " 1455 Font 2,1:If tt >1 Then Print @(hosu2,vesu,1)Mid$(sudoku$,1,tt-1) 1460 Next 1490 Font 2,1:Print @(hosu2,vesu,1)Mid$(sudoku$,1,tt) 1500 Next:Pause 300 1510 Font 1,1:Print:Print Tab(21) "For Maximite" 1600 ' ********* END SCROLL ******** 1601 ' Do While (Inkey$ = ""):Loop 1610 Pause 3000 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 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