FotS

MMSudoku

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