===MMSudoku=== {{ :migratedattachments:mmbasic_original:mmsudoku.zip?linkonly}} {{ :migratedattachments:mmbasic_original:sudokuintro.zip?linkonly}} //This module is part of the original MMBasic library. It is reproduced here with kind permission of Hugh Buckle and Geoff Graham. Be aware it may reference functionality which has changed or is deprecated in the latest versions of MMBasic.// Hello all. Here's SUDOKU for Maximite version 1.0 (final?). Features: Requires MMbasic v3.1. Three types of difficulty: Easy, Medium and Hard. In the empty grid you can enter numbers and key lock. If a number is repeated on the same row or column or box failure is reported. Save and load the game. Sorry the comments were mixed English and Italian. Raros. For comments and suggestions: raros on forum 'The Back Shed' Facebook Raffaele Rotondo Skype raros0101 or raros_eepc Italiano: Salve a Tutti. Ecco il SUDOKU per Maximite versione 1.0 (finale?). Caratteristiche: Richiede MMbasic v3.1. Tre tipi di difficoltà: Facile, Medio e Difficile. Nella griglia vuota si possono inserire dei numeri chiave e bloccarli. Se si ripete un numero sulla stessa riga o colonna o riquadro segnala errore. Salva e carica il gioco. **MMSudoku.bas**: 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 ---- **MMSudoku+Intro.bas**: 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