Klaus
Number of posts : 18
Age : 74
Localisation : France
Registration date : 2013-03-23
 | | Subject: A Sokoban game Mon Mar 25, 2013 11:01 am | |
| Here is my Sokoban game. Written fully in Panoramic, without DLLs, and available in English and French. There are 2 programs: the game itself (sokoban.bas) and the level designer (sokoban_designer.bas). Both programs can be adjusted to either of the 2 languages, by changing the comments in lines 4 and 5. The version presented here is adapted for English. This is the pure Panoramic code. You can download 63 levels from my WebDav (link in the signature): navigate to the Jeux\Sokoban\ folder and download all the *.niv files. Here is sokoban.bas: - Code:
-
' sokoban.bas
dim langage$
' langage$ = "FR"
langage$ = "EN"
' FR: picture : 2=bordure 3=mur 4=cible 5=caisse 6=magasinier
' EN: picture : 2=border 3=wall 4=destination 5=box 6=worker
labels()
constantes()
variables()
form0()
GUI()
initialisations()
active_keys()
end
sub labels()
label charger_bad, gauche, haut, droite, bas, key, charger, focus0
end_sub
sub constantes()
dim dossier$ : dossier$ = ".\"
end_sub
sub variables()
dim nlig%, ncol%, plan%(100,100), ncible%, ncaisse%, perso%(2)
dim w2d%, niveau%, niveau_present%, sz%, nsprite%, sprites%(100,100)
dim cibles%(20,2), caisses%(20,2)
dim s$, l%, c%, i%
end_sub
sub form0()
if langage$="FR" then caption 0,"Pousser les caisses - Version V1.10 du 24 Mars 2013"
if langage$="EN" then caption 0,"Sokoban - Version V1.10 March 24th, 2013"
width 0,1000 : height 0,750 : on_click 0,focus0
w2d% = 800
end_sub
sub GUI()
scene2d 1 : width 1,w2d% : height 1,600
color 1,185,238,240 : sprite_target_is 1 : on_click 1,focus0
picture 2 : hide 2
picture 3 : hide 3
picture 4 : hide 4
picture 5 : hide 5
picture 6 : hide 6
image 7
alpha 10 : top 10,20 : left 10,w2d% + 10
if langage$="FR" then caption 10,"Niveau:"
if langage$="EN" then caption 10,"Level:"
font_size 10,14 : font_bold 10
edit 11 : top 11,20 : left 11,w2d% + 90 : width 11,60
font_size 11,14 : font_bold 11 : font_color 11,0,0,255
button 12 : top 12,50 : left 12,w2d% + 90
if langage$="FR" then caption 12,"Charger"
if langage$="EN" then caption 12,"Load"
on_click 12,charger
button 31 : top 31,300 : left 31,w2d% + 20 : width 31,30 : caption 31,"<"
font_size 31,14 : font_bold 31 : inactive 31 : on_click 31,gauche
button 32 : top 32,275 : left 32,w2d% + 50 : width 32,30 : caption 32,"^"
font_size 32,14 : font_bold 32 : inactive 32 : on_click 32,haut
button 33 : top 33,300 : left 33,w2d% + 80 : width 33,30 : caption 33,">"
font_size 33,14 : font_bold 33 : inactive 33 : on_click 33,droite
button 34 : top 34,325 : left 34,w2d% + 50 : width 34,30 : caption 34,"v"
font_size 34,14 : font_bold 34 : inactive 34 : on_click 34,bas
end_sub
sub initialisations()
nsprite% = 100
niveau% = 1
charger_niveau(niveau%)
if niveau_present%=1 then afficher_niveau()
on_key_down 0,key
on_key_down 1,key
end_sub
sub charger_niveau(n%)
dim_local niv%, s$, i%, c$
niveau_present% = 0
text 11,""
if file_exists(dossier$+"sokoban_"+str$(n%)+".niv")=1
file_open_read 1,dossier$+"sokoban_"+str$(n%)+".niv"
file_readln 1,s$
if s$<>"Sokoban" then goto charger_bad
file_readln 1,s$
if left$(s$,7)<>"Niveau " then goto charger_bad
s$ = mid$(s$,8,len(s$))
if numeric(s$)=0 then goto charger_bad
niv% = val(s$)
if niv%<>n% then goto charger_bad
nlig% = 0
ncible% = 0
ncaisse% = 0
perso%(0) = 0
perso%(1) = 0
perso%(2) = 0
if file_eof(1)=1 then goto charger_bad
repeat
file_readln 1,s$
if nlig%=0 then ncol% = len(s$)
if (nlig%=0) and (left$(s$,2)<>"**") then goto charger_bad
if left$(s$,1)<>"*" then goto charger_bad
if right$(s$,1)<>"*" then goto charger_bad
if len(s$)<>ncol% then goto charger_bad
nlig% = nlig% + 1
for i%=1 to len(s$)
plan%(nlig%,i%) = 0
sprites%(nlig%,i%) = 0
c$ = mid$(s$,i%,1)
if c$="*" then plan%(nlig%,i%) = -1 : ' limite du plateau
if c$="#" then plan%(nlig%,i%) = 1 : ' mur
if c$="X"
plan%(nlig%,i%) = 2 : ' cible
ncible% = ncible% + 1
end_if
if c$="@"
plan%(nlig%,i%) = 3 : ' caisse
ncaisse% = ncaisse% + 1
end_if
if c$="$"
if perso%(0)>0 then goto charger_bad
plan%(nlig%,i%) = 4 : ' magasinier
perso%(0) = 1
perso%(1) = nlig%
perso%(2) = i%
end_if
if c$="%"
plan%(nlig%,i%) = 5 : ' cible + caisse
ncible% = ncible% + 1
ncaisse% = ncaisse% + 1
end_if
if c$="="
plan%(nlig%,i%) = 6 : ' cible + magasinier
ncible% = ncible% + 1
perso%(0) = 1
perso%(1) = nlig%
perso%(2) = i%
end_if
next i%
until file_eof(1)=1
if ncible%=0 then goto charger_bad
if ncaisse%=0 then goto charger_bad
if perso%(0)=0 then goto charger_bad
if ncible%<>ncaisse% then goto charger_bad
file_close 1
niveau_present% = 1
text 11,str$(niveau%)
if nsprite%>100 then sprite_delete_all
nsprite% = 100
sz% = int(600/(max(nlig%+2,ncol%+2)))
width 2,sz% : height 2,sz% : color 2,0,0,0
width 3,sz% : height 3,sz% : color 3,0,0,0
width 4,sz% : height 4,sz% : color 4,0,0,0
width 5,sz% : height 5,sz% : color 5,0,0,0
width 6,sz% : height 6,sz% : color 6,0,0,0
end_if
exit_sub
charger_bad:
file_close 1
if langage$="FR" then message "Erreur: Ligne "+str$(nlig%+1)+" "+s$+" : Le niveau "+str$(n%)+" est invalide"
if langage$="EN" then message "Error: Line "+str$(nlig%+1)+" "+s$+" : The level "+str$(n%)+" is invalid"
end_sub
sub afficher_niveau()
dim_local i%,j%, n_cible%, n_caisse%
' créer les 4 types de sprite
' bordure
n_cible% = 0 : n_caisse% = 0
creer_pictures()
' afficher d'abord les bordures et les murs
for i%=1 to nlig%
for j%=1 to ncol%
select plan%(i%,j%)
case -1
nsprite% = nsprite% + 1
2d_target_is 2
2d_image_copy 7,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,7
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
case 1
nsprite% = nsprite% + 1
2d_target_is 3
2d_image_copy 7,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,7
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
end_select
next j%
next i%
' afficher maintenant les cibles
for i%=1 to nlig%
for j%=1 to ncol%
select plan%(i%,j%)
case 2
nsprite% = nsprite% + 1
2d_target_is 4
2d_image_copy 7,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,7
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
n_cible% = n_cible% + 1
cibles%(n_cible%,1) = i%
cibles%(n_cible%,2) = j%
plan%(i%,j%) = 0
case 5
nsprite% = nsprite% + 1
2d_target_is 4
2d_image_copy 7,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,7
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
n_cible% = n_cible% + 1
cibles%(n_cible%,1) = i%
cibles%(n_cible%,2) = j%
case 6
nsprite% = nsprite% + 1
2d_target_is 4
2d_image_copy 7,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,7
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
n_cible% = n_cible% + 1
cibles%(n_cible%,1) = i%
cibles%(n_cible%,2) = j%
end_select
next j%
next i%
' pour finir, afficher les caisses et le magasinier
for i%=1 to nlig%
for j%=1 to ncol%
select plan%(i%,j%)
case 3
nsprite% = nsprite% + 1
2d_target_is 5
2d_image_copy 7,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,7
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
sprites%(i%,j%) = nsprite%
n_caisse% = n_caisse% + 1
caisses%(n_caisse%,1) = i%
caisses%(n_caisse%,2) = j%
case 4
nsprite% = nsprite% + 1
2d_target_is 6
2d_image_copy 7,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,7
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
perso%(0) = nsprite%
case 5
nsprite% = nsprite% + 1
2d_target_is 5
2d_image_copy 7,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,7
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
sprites%(i%,j%) = nsprite%
n_caisse% = n_caisse% + 1
caisses%(n_caisse%,1) = i%
caisses%(n_caisse%,2) = j%
plan%(i%,j%) = 3
case 6
nsprite% = nsprite% + 1
2d_target_is 6
2d_image_copy 7,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,7
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
perso%(0) = nsprite%
end_select
next j%
next i%
set_focus 0
end_sub
sub creer_pictures()
color 3,9,12,60
2d_image_copy 7,0,0,sz%-1,sz%-1
' mur
color 2,177,8,34
2d_target_is 3
2d_line 0,sz%*0.25,sz%,sz%*0.25
2d_line 0,sz%*0.50,sz%,sz%*0.50
2d_line 0,sz%*0.75,sz%,sz%*0.75
2d_line sz%*0.25,0,sz%*0.25,sz%
2d_line sz%*0.50,0,sz%*0.50,sz%
2d_line sz%*0.75,0,sz%*0.75,sz%
' cible
2d_target_is 4
2d_pen_color 0,0,255
2d_pen_width 3
2d_line 5,5,sz%-5,sz%-5
2d_line 2,sz%-5,sz%-5,5
2d_pen_width 1
' caisse
2d_target_is 5
2d_pen_color 220,220,0
2d_pen_width 3
2d_rectangle 2,2,sz%-3,sz%-3
2d_line 7,7,sz%-7,sz%-7
2d_line 7,sz%-7,sz%-7,7
2d_pen_width 1
' magasinier
2d_target_is 6
2d_pen_color 0,0,255
2d_pen_width 3
2d_fill_color 150,150,255
2d_circle sz%/2,9,8
2d_circle sz%/2,sz%,sz%-16
2d_line 4,sz%-3,sz%-4,sz%-3
end_sub
sub active_keys()
active 31 : active 32 : active 33 : active 34
end_sub
gauche:
set_focus 0
l% = perso%(1)
c% = perso%(2)
if plan%(l%,c%-1)=0
plan%(l%,c%) = 0
plan%(l%,c%-1) = 4
perso%(2) = c% - 1
sprite_position perso%(0),(perso%(2)-1)*sz%,(perso%(1)-1)*sz%
else
if plan%(l%,c%-1)=3
if plan%(l%,c%-2)=0
sprite_position sprites%(l%,c%-1),(c%-3)*sz%,(l%-1)*sz%
sprites%(l%,c%-2) = sprites%(l%,c%-1)
sprites%(l%,c%-1) = 0
plan%(l%,c%-2) = 3
plan%(l%,c%-1) = 4
plan%(l%,c%) = 0
perso%(2) = c% - 1
sprite_position perso%(0),(perso%(2)-1)*sz%,(perso%(1)-1)*sz%
verifier()
end_if
end_if
end_if
return
haut:
set_focus 0
l% = perso%(1)
c% = perso%(2)
if plan%(l%-1,c%)=0
plan%(l%,c%) = 0
plan%(l%-1,c%) = 4
perso%(1) = l% - 1
sprite_position perso%(0),(perso%(2)-1)*sz%,(perso%(1)-1)*sz%
else
if plan%(l%-1,c%)=3
if plan%(l%-2,c%)=0
sprite_position sprites%(l%-1,c%),(c%-1)*sz%,(l%-3)*sz%
sprites%(l%-2,c%) = sprites%(l%-1,c%)
sprites%(l%-1,c%) = 0
plan%(l%-2,c%) = 3
plan%(l%-1,c%) = 4
plan%(l%,c%) = 0
perso%(1) = l% - 1
sprite_position perso%(0),(perso%(2)-1)*sz%,(perso%(1)-1)*sz%
verifier()
end_if
end_if
end_if
return
droite:
set_focus 0
l% = perso%(1)
c% = perso%(2)
if plan%(l%,c%+1)=0
plan%(l%,c%) = 0
plan%(l%,c%+1) = 4
perso%(2) = c% + 1
sprite_position perso%(0),(perso%(2)-1)*sz%,(perso%(1)-1)*sz%
else
if plan%(l%,c%+1)=3
if plan%(l%,c%+2)=0
sprite_position sprites%(l%,c%+1),(c%+1)*sz%,(l%-1)*sz%
sprites%(l%,c%+2) = sprites%(l%,c%+1)
sprites%(l%,c%+1) = 0
plan%(l%,c%+2) = 3
plan%(l%,c%+1) = 4
plan%(l%,c%) = 0
perso%(2) = c% + 1
sprite_position perso%(0),(perso%(2)-1)*sz%,(perso%(1)-1)*sz%
verifier()
end_if
end_if
end_if
return
bas:
set_focus 0
l% = perso%(1)
c% = perso%(2)
if plan%(l%+1,c%)=0
plan%(l%,c%) = 0
plan%(l%+1,c%) = 4
perso%(1) = l% + 1
sprite_position perso%(0),(perso%(2)-1)*sz%,(perso%(1)-1)*sz%
else
if plan%(l%+1,c%)=3
if plan%(l%+2,c%)=0
sprite_position sprites%(l%+1,c%),(c%-1)*sz%,(l%+1)*sz%
sprites%(l%+2,c%) = sprites%(l%+1,c%)
sprites%(l%+1,c%) = 0
plan%(l%+2,c%) = 3
plan%(l%+1,c%) = 4
plan%(l%,c%) = 0
perso%(1) = l% + 1
sprite_position perso%(0),(perso%(2)-1)*sz%,(perso%(1)-1)*sz%
verifier()
end_if
end_if
end_if
return
sub verifier()
dim_local n%,k%, l%, c%, cnt%
cnt% = 0
for n%=1 to ncible%
l% = cibles%(n%,1)
c% = cibles%(n%,2)
if plan%(l%,c%)=3 then cnt% = cnt% + 1
next n%
if cnt%=ncaisse%
if langage$="FR" then message "Félicitations ! Vous avez gagné !"
if langage$="EN" then message "Congratulations ! You win !"
inactive 31 : inactive 32 : inactive 33 : inactive 34
niveau% = niveau% + 1
charger_niveau(niveau%)
if niveau_present%=1
afficher_niveau()
active_keys()
end_if
end_if
end_sub
key:
select scancode
case 37: goto gauche
case 38: goto haut
case 39: goto droite
case 40: goto bas
end_select
return
charger:
set_focus 0
s$ = text$(11)
if numeric(s$)=0
if langage$="FR" then message "Numéro de niveau invalide"
if langage$="EN" then message "Invalid level number"
return
end_if
i% = val(s$)
if i%<1
if langage$="FR" then message "Numéro de niveau invalide"
if langage$="EN" then message "Invalid level number"
return
end_if
niveau% = i%
charger_niveau(niveau%)
if niveau_present%=1 then afficher_niveau()
return
focus0:
set_focus 0
return
And here is sokoban_designer.bas: - Code:
-
' sokoban_designer.bas
dim langage$
' langage$ = "FR"
langage$ = "EN"
' FR: picture : 2=bordure 3=mur 4=cible 5=caisse 6=magasinier 7=cible+caisse
' EN: picture : 2=border 3=wall 4=destination 5=box 6=worker 7=(4)+(6)
labels()
constantes()
variables()
form0()
GUI()
initialisations()
active_keys()
end
sub labels()
label charger_bad, gauche, haut, droite, bas, key, posit
label charger, sauver, creer, sel, appliquer, appl_taille
end_sub
sub constantes()
dim dossier$ : dossier$ = ".\"
dim image% : image% = 9 : ' numéro d'objet de l'image interne pour le dessin
end_sub
sub variables()
dim nlig%, ncol%, plan%(100,100), ncible%, ncaisse%, perso%(2)
dim w2d%, niveau%, niveau_present%, sz%, nsprite%, sprites%(100,100)
dim cibles%(20,2), caisses%(20,2)
dim sel_type%, sel_x%, sel_lig%, sel_col%, n_sel%
dim s$, l%, c%, i%, j%, n%, xp%, yp%
end_sub
sub form0()
if langage$="FR" then caption 0,"Sokoban Designer - Version V1.09 du 15 Février 2013"
if langage$="EN" then caption 0,"Sokoban Designer - Version V1.09 March 24th, 2013"
width 0,1020 : height 0,750
w2d% = 800
end_sub
sub GUI()
scene2d 1 : width 1,w2d% : height 1,600 : ' full_s: pace 1
color 1,185,238,240 : sprite_target_is 1 : on_click 1,posit
picture 2 : hide 2
picture 3 : hide 3
picture 4 : hide 4
picture 5 : hide 5
picture 6 : hide 6
picture 7 : hide 7
picture 8 : hide 8
image image%
alpha 10 : top 10,20 : left 10,w2d% + 10
if langage$="FR" then caption 10,"Niveau:"
if langage$="EN" then caption 10,"Level:"
font_size 10,14 : font_bold 10
edit 11 : top 11,20 : left 11,w2d% + 90 : width 11,60
font_size 11,14 : font_bold 11 : font_color 11,0,0,255
button 12 : top 12,50 : left 12,w2d% + 15
if langage$="FR" then caption 12,"Charger"
if langage$="EN" then caption 12,"Load"
on_click 12,charger
button 13 : top 13,50 : left 13,w2d% + 90
if langage$="FR" then caption 13,"Sauver"
if langage$="EN" then caption 13,"Save"
on_click 13,sauver
button 14 : top 14,75 : left 14,w2d% + 90
if langage$="FR" then caption 14,"Créer"
if langage$="EN" then caption 14,"Create"
on_click 14,creer
picture 21 : top 21,120 : left 21,w2d%+10 : width 21,40 : height 21,40
on_click 21,sel
picture 22 : top 22,120 : left 22,w2d%+55 : width 22,40 : height 22,40
on_click 22,sel
picture 23 : top 23,120 : left 23,w2d%+100 : width 23,40 : height 23,40
on_click 23,sel
picture 24 : top 24,120 : left 24,w2d%+145 : width 24,40 : height 24,40
on_click 24,sel
picture 25 : top 25,180 : left 25,w2d%+10 : width 25,40 : height 25,40
on_click 25,sel
picture 26 : top 26,180 : left 26,w2d%+55 : width 26,40 : height 26,40
on_click 26,sel
picture 27 : top 27,180 : left 27,w2d%+100 : width 27,40 : height 27,40
on_click 27,sel
picture 28 : top 28,180 : left 28,w2d%+145 : width 28,40 : height 28,40
on_click 28,sel
if langage$="FR"
alpha 45 : top 45,165 : left 45,w2d%+15 : caption 45,"Bord"
alpha 46 : top 46,165 : left 46,w2d%+60 : caption 46,"Mur"
alpha 47 : top 47,165 : left 47,w2d%+105 : caption 47,"Cible"
alpha 48 : top 48,165 : left 48,w2d%+150 : caption 48,"Caisse"
alpha 49 : top 49,225 : left 49,w2d%+15 : caption 49,"Ouvrier"
alpha 50 : top 50,225 : left 50,w2d%+60 : caption 50,"Gomme"
alpha 51 : top 51,225 : left 51,w2d%+100 : caption 51,"Cible"
alpha 52 : top 52,225 : left 52,w2d%+150 : caption 52,"Cible"
alpha 53 : top 53,238 : left 53,w2d%+100 : caption 53,"+caisse"
alpha 54 : top 54,238 : left 54,w2d%+150 : caption 54,"+ouvrier"
alpha 61 : top 61,260 : left 61,w2d%+10 : caption 61,"Lignes:"
edit 62 : top 62,260 : left 62,w2d%+50 : width 62,30
alpha 63 : top 63,260 : left 63,w2d%+90 : caption 63,"Colonnes:"
edit 64 : top 64,260 : left 64,w2d%+140 : width 64,30
button 65 : top 65,290 : left 65,w2d% + 20 : width 65,110 : caption 65,"Appliquer"
font_size 65,14 : font_bold 65 : inactive 65 : on_click 65,appl_taille
button 31 : top 31,360 : left 31,w2d% + 20 : width 31,30 : caption 31,"<"
font_size 31,14 : font_bold 31 : inactive 31 : on_click 31,gauche
button 32 : top 32,335 : left 32,w2d% + 50 : width 32,30 : caption 32,"^"
font_size 32,14 : font_bold 32 : inactive 32 : on_click 32,haut
button 33 : top 33,360 : left 33,w2d% + 80 : width 33,30 : caption 33,">"
font_size 33,14 : font_bold 33 : inactive 33 : on_click 33,droite
button 34 : top 34,385 : left 34,w2d% + 50 : width 34,30 : caption 34,"v"
font_size 34,14 : font_bold 34 : inactive 34 : on_click 34,bas
button 35 : top 35,420 : left 35,w2d% + 20 : width 35,110 : caption 35,"Appliquer"
font_size 35,14 : font_bold 35 : inactive 35 : on_click 35,appliquer
end_if
if langage$="EN"
alpha 45 : top 45,165 : left 45,w2d%+15 : caption 45,"Border"
alpha 46 : top 46,165 : left 46,w2d%+60 : caption 46,"Wall"
alpha 47 : top 47,165 : left 47,w2d%+105 : caption 47,"Destination"
alpha 48 : top 48,165 : left 48,w2d%+150 : caption 48,"Box"
alpha 49 : top 49,225 : left 49,w2d%+15 : caption 49,"Worker"
alpha 50 : top 50,225 : left 50,w2d%+60 : caption 50,"Eraser"
alpha 51 : top 51,225 : left 51,w2d%+100 : caption 51,"Destination"
alpha 52 : top 52,225 : left 52,w2d%+150 : caption 52,"Destination"
alpha 53 : top 53,238 : left 53,w2d%+100 : caption 53,"+box"
alpha 54 : top 54,238 : left 54,w2d%+150 : caption 54,"+worker"
alpha 61 : top 61,260 : left 61,w2d%+10 : caption 61,"Lines:"
edit 62 : top 62,260 : left 62,w2d%+50 : width 62,30
alpha 63 : top 63,260 : left 63,w2d%+90 : caption 63,"Columns:"
edit 64 : top 64,260 : left 64,w2d%+140 : width 64,30
button 65 : top 65,290 : left 65,w2d% + 20 : width 65,110 : caption 65,"Apply"
font_size 65,14 : font_bold 65 : inactive 65 : on_click 65,appl_taille
button 31 : top 31,360 : left 31,w2d% + 20 : width 31,30 : caption 31,"<"
font_size 31,14 : font_bold 31 : inactive 31 : on_click 31,gauche
button 32 : top 32,335 : left 32,w2d% + 50 : width 32,30 : caption 32,"^"
font_size 32,14 : font_bold 32 : inactive 32 : on_click 32,haut
button 33 : top 33,360 : left 33,w2d% + 80 : width 33,30 : caption 33,">"
font_size 33,14 : font_bold 33 : inactive 33 : on_click 33,droite
button 34 : top 34,385 : left 34,w2d% + 50 : width 34,30 : caption 34,"v"
font_size 34,14 : font_bold 34 : inactive 34 : on_click 34,bas
button 35 : top 35,420 : left 35,w2d% + 20 : width 35,110 : caption 35,"Apply"
font_size 35,14 : font_bold 35 : inactive 35 : on_click 35,appliquer
end_if
end_sub
sub initialisations()
nsprite% = 100
niveau% = 1
charger_niveau(niveau%)
if niveau_present%=1 then afficher_niveau()
on_key_down 0,key
on_key_down 1,key
end_sub
sub charger_niveau(n%)
dim_local niv%, s$, i%, c$
niveau_present% = 0
text 11,""
if file_exists(dossier$+"sokoban_"+str$(n%)+".niv")=1
file_open_read 1,dossier$+"sokoban_"+str$(n%)+".niv"
file_readln 1,s$
if s$<>"Sokoban" then goto charger_bad
file_readln 1,s$
if left$(s$,7)<>"Niveau " then goto charger_bad
s$ = mid$(s$,8,len(s$))
if numeric(s$)=0 then goto charger_bad
niv% = val(s$)
if niv%<>n% then goto charger_bad
nlig% = 0
ncible% = 0
ncaisse% = 0
perso%(0) = 0
perso%(1) = 0
perso%(2) = 0
if file_eof(1)=1 then goto charger_bad
repeat
file_readln 1,s$
if nlig%=0 then ncol% = len(s$)
if (nlig%=0) and (left$(s$,2)<>"**") then charger_erreur("Erreur de format")
if left$(s$,1)<>"*" then charger_erreur()
if right$(s$,1)<>"*" then charger_erreur()
if len(s$)<>ncol% then charger_erreur()
nlig% = nlig% + 1
for i%=1 to len(s$)
plan%(nlig%,i%) = 0
sprites%(nlig%,i%) = 0
c$ = mid$(s$,i%,1)
if c$="*" then plan%(nlig%,i%) = -1 : ' limite du plateau
if c$="#" then plan%(nlig%,i%) = 1 : ' mur
if c$="X"
plan%(nlig%,i%) = 2 : ' cible
ncible% = ncible% + 1
end_if
if c$="@"
plan%(nlig%,i%) = 3 : ' caisse
ncaisse% = ncaisse% + 1
end_if
if c$="$"
if perso%(0)>0 then charger_erreur("Trop d'ouvriers")
plan%(nlig%,i%) = 4 : ' magasinier
perso%(0) = 1
perso%(1) = nlig%
perso%(2) = i%
end_if
if c$="%"
plan%(nlig%,i%) = 5 : ' cible+caisse
ncible% = ncible% + 1
ncaisse% = ncaisse% + 1
end_if
if c$="="
if perso%(0)>0 then charger_erreur("Trop d'ouvriers")
plan%(nlig%,i%) = 6 : ' cible+ouvrier
ncible% = ncible% + 1
perso%(0) = 1
perso%(1) = nlig%
perso%(2) = i%
end_if
next i%
until file_eof(1)=1
if ncible%=0 then charger_erreur("Pas de cible")
if ncaisse%=0 then charger_erreur("Pas de caisse")
if perso%(0)=0 then charger_erreur("Pas d'ouvrier")
if ncible%<>ncaisse% then charger_erreur("Nombre de caisses <> nombre de cibles")
file_close 1
niveau_present% = 1
text 11,str$(niveau%)
if nsprite%>100 then sprite_delete_all
nsprite% = 100
sz% = int(600/(max(nlig%+2,ncol%+2)))
width 2,sz% : height 2,sz% : color 2,0,0,0
width 3,sz% : height 3,sz% : color 3,0,0,0
width 4,sz% : height 4,sz% : color 4,0,0,0
width 5,sz% : height 5,sz% : color 5,0,0,0
width 6,sz% : height 6,sz% : color 6,0,0,0
text 62,str$(nlig%)
text 64,str$(ncol%)
end_if
exit_sub
charger_bad:
file_close 1
if langage$="FR" then message "Erreur: Ligne "+str$(nlig%+1)+" "+s$+" : Le niveau "+str$(n%)+" est invalide"
if langage$="EN" then message "Error: Line "+str$(nlig%+1)+" "+s$+" : The level "+str$(n%)+" is invalid"
end_sub
sub charger_erreur(txt$)
dim_local m$
if langage$ = "FR" then m$ = "Erreur: Ligne "+str$(nlig%+1)+" "+s$+" : Le niveau "+str$(n%)+" est invalide"
if langage$ = "EN" then m$ = "Error: Line "+str$(nlig%+1)+" "+s$+" : The level "+str$(n%)+" is invalid"
m$ = m$ + chr$(13)+chr$(10)+txt$
message m$
end_sub
sub afficher_niveau()
dim_local i%,j%, n_cible%, n_caisse%
' créer les 4 types de sprite
' bordure
n_cible% = 0 : n_caisse% = 0
if sel_type%>0 then font_bold_off 44+sel_type%
sel_type% = 1 : font_bold 44+sel_type%
creer_pictures()
for i%=1 to nlig%
for j%=1 to ncol%
select plan%(i%,j%)
case -1
nsprite% = nsprite% + 1
2d_target_is 2
2d_image_copy image%,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,image%
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
sprites%(i%,j%) = nsprite%
case 1
nsprite% = nsprite% + 1
2d_target_is 3
2d_image_copy image%,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,image%
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
sprites%(i%,j%) = nsprite%
case 2
nsprite% = nsprite% + 1
2d_target_is 4
2d_image_copy image%,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,image%
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
sprites%(i%,j%) = nsprite%
n_cible% = n_cible% + 1
cibles%(n_cible%,1) = i%
cibles%(n_cible%,2) = j%
case 3
nsprite% = nsprite% + 1
2d_target_is 5
2d_image_copy image%,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,image%
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
sprites%(i%,j%) = nsprite%
n_caisse% = n_caisse% + 1
caisses%(n_caisse%,1) = i%
caisses%(n_caisse%,2) = j%
case 4
nsprite% = nsprite% + 1
2d_target_is 6
2d_image_copy image%,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,image%
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
sprites%(i%,j%) = nsprite%
perso%(0) = nsprite%
case 5
nsprite% = nsprite% + 1
2d_target_is 7
2d_image_copy image%,0,0,sz%-1,sz%-1
sprite nsprite% : sprite_image_load nsprite%,image%
sprite_position nsprite%,(j%-1)*sz%,(i%-1)*sz%
sprites%(i%,j%) = nsprite%
n_cible% = n_cible% + 1
cibles%(n_cible%,1) = i%
cibles%(n_cible%,2) = j%
n_caisse% = n_caisse% + 1
caisses%(n_caisse%,1) = i%
caisses%(n_caisse%,2) = j%
end_select
next j%
next i%
2d_target_is sel_type% + 1
2d_image_copy image%,0,0,sz%-1,sz%-1
n_sel% = 999
sprite n_sel% : sprite_image_load n_sel%,image%
sel_lig% = 1
sel_col% = ncol% + 2
sprite_position n_sel%,(sel_col%-1)*sz%,(sel_lig%-1)*sz%
end_sub
sub creer_pictures()
' gomme
width 2,sz% : height 2,sz%
2d_target_is 2
color 2,255,255,0
display
2d_image_copy image%,0,0,sz%-1,sz%-1
color 26,255,255,255
2d_target_is 26 : 2d_image_paste image%,0,0
display
' bordure
2d_target_is 2
color 2,177,8,34
display
2d_image_copy image%,0,0,sz%-1,sz%-1
color 21,255,255,255
2d_target_is 21 : 2d_image_paste image%,0,0
display
' mur
width 3,sz% : height 3,sz%
color 3,9,12,60
2d_target_is 3
2d_line 0,sz%*0.25,sz%,sz%*0.25
2d_line 0,sz%*0.50,sz%,sz%*0.50
2d_line 0,sz%*0.75,sz%,sz%*0.75
2d_line sz%*0.25,0,sz%*0.25,sz%
2d_line sz%*0.50,0,sz%*0.50,sz%
2d_line sz%*0.75,0,sz%*0.75,sz%
display
2d_image_copy image%,0,0,sz%-1,sz%-1
color 22,255,255,255
2d_target_is 22 : 2d_image_paste image%,0,0
display
' cible
width 4,sz% : height 4,sz%
color 4,0,0,0
2d_target_is 4
2d_pen_color 0,0,255
2d_pen_width 3
2d_line 5,5,sz%-5,sz%-5
2d_line 2,sz%-5,sz%-5,5
2d_pen_width 1
display
2d_image_copy image%,0,0,sz%-1,sz%-1
color 23,255,255,255
2d_target_is 23 : 2d_image_paste image%,0,0
display
' caisse
width 5,sz% : height 5,sz%
color 5,0,0,0
2d_target_is 5
2d_pen_color 220,220,0
2d_pen_width 3
2d_rectangle 2,2,sz%-3,sz%-3
2d_line 7,7,sz%-7,sz%-7
2d_line 7,sz%-7,sz%-7,7
2d_pen_width 1
display
2d_image_copy image%,0,0,sz%-1,sz%-1
color 24,255,255,255
2d_target_is 24 : 2d_image_paste image%,0,0
display
' magasinier
width 6,sz% : height 6,sz%
color 6,0,0,0
2d_target_is 6
2d_pen_color 0,0,255
2d_pen_width 3
2d_fill_color 150,150,255
2d_circle sz%/2,9,8
2d_circle sz%/2,sz%,sz%-16
2d_line 4,sz%-3,sz%-4,sz%-3
display
2d_image_copy image%,0,0,sz%-1,sz%-1
color 25,255,255,255
2d_target_is 25 : 2d_image_paste image%,0,0
display
' cible+caisse
width 7,sz% : height 7,sz%
color 7,0,0,0
2d_target_is 7
2d_pen_color 220,220,0
2d_pen_width 3
2d_rectangle 2,2,sz%-3,sz%-3
2d_line 7,7,sz%-7,sz%-7
2d_line 7,sz%-7,sz%-7,7
2d_pen_color 0,0,255
2d_line 5,5,sz%-5,sz%-5
2d_line 2,sz%-5,sz%-5,5
2d_pen_width 1
display
2d_image_copy image%,0,0,sz%-1,sz%-1
color 27,255,255,255
2d_target_is 27 : 2d_image_paste image%,0,0
display
' cible+ouvrier
width 8,sz% : height 8,sz%
color 8,0,0,0
2d_target_is 8
2d_pen_color 0,0,255
2d_pen_width 3
2d_fill_color 150,150,255
2d_circle sz%/2,9,8
2d_circle sz%/2,sz%,sz%-16
2d_line 4,sz%-3,sz%-4,sz%-3
2d_pen_color 0,0,0
2d_pen_width 3
2d_line 5,5,sz%-5,sz%-5
2d_line 2,sz%-5,sz%-5,5
display
2d_image_copy image%,0,0,sz%-1,sz%-1
color 28,255,255,255
2d_target_is 28 : 2d_image_paste image%,0,0
display
end_sub
sub active_keys()
active 31 : active 32 : active 33 : active 34 : active 35 : active 65
end_sub
gauche:
set_focus 0
if sel_col%>1 then sel_col% = sel_col% - 1
sprite_position n_sel%,(sel_col%-1)*sz%,(sel_lig%-1)*sz%
return
haut:
set_focus 0
if sel_lig%>1 then sel_lig% = sel_lig% - 1
sprite_position n_sel%,(sel_col%-1)*sz%,(sel_lig%-1)*sz%
return
droite:
set_focus 0
if sel_col%<ncol% then sel_col% = sel_col% + 1
sprite_position n_sel%,(sel_col%-1)*sz%,(sel_lig%-1)*sz%
return
bas:
set_focus 0
if sel_lig%<nlig% then sel_lig% = sel_lig% + 1
sprite_position n_sel%,(sel_col%-1)*sz%,(sel_lig%-1)*sz%
return
sub verifier()
dim_local n%,k%, l%, c%, cnt%
cnt% = 0
for n%=1 to ncible%
l% = cibles%(n%,1)
c% = cibles%(n%,2)
if plan%(l%,c%)=3 then cnt% = cnt% + 1
next n%
if cnt%=ncaisse%
if langage$="FR" then message "Félicitations ! Vous avez gagné !"
if langage$="EN" then message "Congratulations ! You win !"
inactive 31 : inactive 32 : inactive 33 : inactive 34 : inactive 35 : inactive 65
niveau% = niveau% + 1
charger_niveau(niveau%)
if niveau_present%=1
afficher_niveau()
active_keys()
end_if
end_if
end_sub
charger:
s$ = text$(11)
if numeric(s$)=0
if langage$="FR" then message "Numéro de niveau invalide"
if langage$="EN" then message "Invalid level number"
return
end_if
i% = val(s$)
if i%<1
if langage$="FR" then message "Numéro de niveau invalide"
if langage$="EN" then message "Invalid level number"
return
end_if
niveau% = i%
charger_niveau(niveau%)
if niveau_present%=1 then afficher_niveau()
return
creer:
s$ = text$(11)
if numeric(s$)=0
if langage$="FR" then message "Numéro de niveau invalide"
if langage$="EN" then message "Invalid level number"
return
end_if
i% = val(s$)
if i%<1
if langage$="FR" then message "Numéro de niveau invalide"
if langage$="EN" then message "Invalid level number"
return
end_if
niveau% = i%
' ici, on continue directement - PAS DE RETURN !
sauver:
s$ = dossier$+"sokoban_"+str$(niveau%)+".niv"
if file_exists(s$)=1
if langage$="FR" then if message_confirmation_yes_no("Ce niveau existe déjà. Remplacer ?")<>1 then return
if langage$="EN" then if message_confirmation_yes_no("This level does already exist. Replace ?")<>1 then return
else
if langage$="FR" then if message_confirmation_yes_no("Ce niveau n'existe pas encore. Créer ?")<>1 then return
if langage$="EN" then if message_confirmation_yes_no("This level doesn't exist. Create ?")<>1 then return
end_if
file_open_write 1,s$
file_writeln 1,"Sokoban"
file_writeln 1,"Niveau "+str$(niveau%)
for l%=1 to nlig%
s$ = ""
for c%=1 to ncol%
select plan%(l%,c%)
case -1: s$ = s$ + "*"
case 0: s$ = s$ + "9"
case 1: s$ = s$ + "#"
case 2: s$ = s$ + "X"
case 3: s$ = s$ + "@"
case 4: s$ = s$ + "$"
case 5: s$ = s$ + "%"
case 6: s$ = s$ + "="
end_select
next c%
file_writeln 1,s$
next l%
file_close 1
if langage$="FR" then message "Terminé."
if langage$="EN" then message "Finished."
return
sel:
set_focus 0
if sel_type%>0 then font_bold_off 44+sel_type%
sel_type% = number_click-20 : font_bold 44+sel_type%
2d_target_is number_click
2d_image_copy image%,0,0,sz%-1,sz%-1
n_sel% = 999
sprite_image_load n_sel%,image%
sel_lig% = 1
sel_col% = ncol% + 2
sprite_position n_sel%,(sel_col%-1)*sz%,(sel_lig%-1)*sz%
return
appliquer:
set_focus 0
if (sel_col%>=ncol%) or (sel_col%<2) then return
if (sel_lig%>=nlig%) or (sel_lig%<2) then return
' types: 1=bordure 2=mur 2=cible 4=caisse 5=magasinier 6=gomme
select sel_type%
case 1
return
case 2
if plan%(sel_lig%,sel_col%)<>0 then return
plan%(sel_lig%,sel_col%) = 1
ajouter_sprite(3)
case 3
if plan%(sel_lig%,sel_col%)<>0 then return
plan%(sel_lig%,sel_col%) = 2
ajouter_sprite(4)
ncible% = ncible% + 1
case 4
if plan%(sel_lig%,sel_col%)<>0 then return
plan%(sel_lig%,sel_col%) = 3
ajouter_sprite(5)
ncaisse% = ncaisse% + 1
case 5
if plan%(sel_lig%,sel_col%)<>0 then return
if perso%(0)>0
sprite_delete perso%(0)
plan%(perso%(1),perso%(2)) = 0
if plan%(perso%(1),perso%(2))=6 then ajouter_cible()
end_if
plan%(sel_lig%,sel_col%) = 4
ajouter_sprite(6)
perso%(0) = nsprite%
perso%(1) = sel_lig%
perso%(2) = sel_col%
case 6
if plan%(sel_lig%,sel_col%)=0 then return
if plan%(sel_lig%,sel_col%)=4
sprite_delete perso%(0)
sprites%(sel_lig%,sel_col%) = 0
perso%(0) = 0
perso%(1) = 0
perso%(2) = 0
else
if plan%(sel_lig%,sel_col%)=6
sprite_delete perso%(0)
sprites%(sel_lig%,sel_col%) = 0
perso%(0) = 0
perso%(1) = 0
perso%(2) = 0
ncible% = ncible% - 1
else
sprite_delete sprites%(sel_lig%,sel_col%)
if plan%(sel_lig%,sel_col%)=2 then ncible% = ncible% - 1
if plan%(sel_lig%,sel_col%)=3 then ncaisse% = ncaisse% - 1
plan%(sel_lig%,sel_col%) = 0
sprites%(sel_lig%,sel_col%) = 0
end_if
end_if
case 7
if plan%(sel_lig%,sel_col%)<>0 then return
plan%(sel_lig%,sel_col%) = 5
ajouter_sprite(7)
ncible% = ncible% + 1
ncaisse% = ncaisse% + 1
case 8
if plan%(sel_lig%,sel_col%)<>0 then return
if perso%(0)>0
sprite_delete perso%(0)
if plan%(perso%(1),perso%(2))=6 then ncible% = ncible% - 1
plan%(perso%(1),perso%(2)) = 0
end_if
plan%(sel_lig%,sel_col%) = 6
ajouter_sprite(8)
ncible% = ncible% + 1
perso%(0) = nsprite%
perso%(1) = sel_lig%
perso%(2) = sel_col%
end_select
sel_lig% = sel_lig% + 1
sel_col% = sel_col% + 1
sprite_position n_sel%,(sel_col%-1)*sz%,(sel_lig%-1)*sz%
return
sub ajouter_sprite(npic%)
2d_target_is npic%
2d_image_copy image%,0,0,sz%-1,sz%-1
nsprite% = nsprite% + 1 : sprite nsprite%
sprites%(sel_lig%,sel_col%) = nsprite%
sprite_image_load nsprite%,image%
sprite_position nsprite%,(sel_col%-1)*sz%,(sel_lig%-1)*sz%
end_sub
sub ajouter_cible()
dim_local lig%, col%
lig% = perso%(1)
col% = perso%(2)
2d_target_is 4
2d_image_copy image%,0,0,sz%-1,sz%-1
nsprite% = nsprite% + 1 : sprite nsprite%
sprites%(lig%,col%) = nsprite%
sprite_image_load nsprite%,image%
sprite_position nsprite%,(col%-1)*sz%,(lig%-1)*sz%
end_sub
appl_taille:
s$ = text$(62)
if numeric(s$)=0
if langage$="FR" then message "Nombre de lignes invalide (5...30)"
if langage$="EN" then message "Invalid line number (5...30)"
return
end_if
l% = val(s$)
if (l%<5) or (l%>30)
if langage$="FR" then message "Nombre de lignes invalide (5...30)"
if langage$="EN" then message "Invalid line number (5...30)"
return
end_if
s$ = text$(64)
if numeric(s$)=0
if langage$="FR" then message "Nombre de colonnes invalide (5...30)"
if langage$="EN" then message "Invalid column number (5...30)"
return
end_if
c% = val(s$)
if (c%<5) or (c%>30)
if langage$="FR" then message "Nombre de colonnes invalide (5...30)"
if langage$="EN" then message "Invalid column number (5...30)"
return
end_if
if sprite_exists(101)=1
if langage$="FR" then s$ = "Ce niveau n'est pas vide."
if langage$="EN" then s$ = "This level is not empty."
if langage$="FR" then s$ = s$ + chr$(13)+chr$(10)+"Cette opération va vider ce niveau."
if langage$="EN" then s$ = s$ + chr$(13)+chr$(10)+"This operation will clear the level."
if langage$="FR" then s$ = s$ + chr$(13)+chr$(10)+"Voulez-vous continuer ?"
if langage$="FR" then s$ = s$ + chr$(13)+chr$(10)+"Do you want to continue ?"
if message_confirmation_yes_no(s$)<>1 then return
sprite_delete_all
nsprite% = 100
ncaisse% = 0
ncible% = 0
perso%(0) = 0
perso%(1) = 0
perso%(2) = 0
for i%=1 to nlig%
for j%=1 to ncol%
plan%(i%,j%) = 0
next j%
next i%
end_if
creer_pictures()
nlig% = l%
ncol% = c%
sz% = int(600/(max(nlig%+2,ncol%+2)))
2d_target_is 2
2d_image_copy image%,0,0,sz%-1,sz%-1
for j%=1 to ncol%
nsprite% = nsprite% + 1 : sprite nsprite%
sprite_image_load nsprite%,image%
sprite_position nsprite%,(j%-1)*sz%,0
nsprite% = nsprite% + 1 : sprite nsprite%
sprite_image_load nsprite%,image%
sprite_position nsprite%,(j%-1)*sz%,(nlig%-1)*sz%
plan%(1,j%) = -1
plan%(nlig%,j%) = -1
next j%
for i%=2 to nlig%-1
nsprite% = nsprite% + 1 : sprite nsprite%
sprite_image_load nsprite%,image%
sprite_position nsprite%,0,(i%-1)*sz%
nsprite% = nsprite% + 1 : sprite nsprite%
sprite_image_load nsprite%,image%
sprite_position nsprite%,(ncol%-1)*sz%,(i%-1)*sz%
plan%(i%,1) = -1
plan%(i%,ncol%) = -1
next i%
niveau_present% = 1
afficher_niveau()
set_focus 0
return
key:
set_focus 0
select scancode
case 37: goto gauche
case 38: goto haut
case 39: goto droite
case 40: goto bas
case 13: goto appliquer
end_select
return
posit:
sel_col% = int((mouse_x_left_down(1)+sz%-1)/sz%)
sel_lig% = int((mouse_y_left_down(1)+sz%-1)/sz%)
sprite_position n_sel%,(sel_col%-1)*sz%,(sel_lig%-1)*sz%
return
Have fun ! | |
|
Nice to have an easy way to change langage (and maybe our german friends will add German version of Sokoban...)