'2048' arrive sur Panoramic !!

DIM x% , y% , n% , case%(16) , mouv% , system$ , joueur$ , score% , best$ , t$ , nbr%
LABEL touche , gauche , droite , haut , bas , fin
LABEL sauve , charge , reset , aide , quitte , tableau ,classement
label autorun : ' PAPYDALL
dim m$,i : ' PAPYDALL
WIDTH 0,360 : HEIGHT 0,400 : CAPTION 0,"2048 - Vers. 14.3.24.05"
n%=1 : system$=DIR_CURRENT$+"\"
FOR y%=1 to 4 : FOR x%=1 to 4
   PICTURE n% : PARENT n%,0 :LEFT n%,x%*80-76 : TOP n%,y%*80-75 : WIDTH n%,79 : HEIGHT n%,79
   ON_KEY_DOWN 0 , touche
   n%=n%+1
NEXT x% : NEXT y%
MAIN_MENU 25
SUB_MENU 26 : PARENT 26,25 : CAPTION 26,"Sauver" : ON_CLICK 26,sauve
SUB_MENU 27 : PARENT 27,25 : CAPTION 27,"Charger" : ON_CLICK 27,charge
SUB_MENU 28 : PARENT 28,25 : CAPTION 28,"Raz" : ON_CLICK 28,reset
SUB_MENU 29 : PARENT 29,25 : CAPTION 29,"Aide" : ON_CLICK 29,aide
SUB_MENU 30 : PARENT 30,25 : CAPTION 30,"Quitter" : ON_CLICK 30,quitte
SUB_MENU 31 : PARENT 31,25 : CAPTION 31,"Score : " : ON_CLICK 31,tableau

SUB_MENU 9999 : PARENT 9999,25 : caption 9999, "Autorun" : on_click 9999, autorun : ' PAPYDALL

CONTAINER 40 : PARENT 40,0 : LEFT 40,5 : TOP 40,5
WIDTH 40,320 : HEIGHT 40,340 : HIDE 40 : CAPTION 40," Les meilleurs scores "
   GRID 45 : PARENT 45,40 : LEFT 45,10 : TOP 45,15 : WIDTH 45,300 : HEIGHT 45,290
   GRID_ROW 45,12 : GRID_ROW_FIXED 45,11 : GRID_ROW_HEIGHT 45,25 : GRID_ONE_ROW_HEIGHT 45,12,1
   GRID_COLUMN 45,3 : GRID_COLUMN_WIDTH 45,80
   GRID_ONE_COLUMN_WIDTH 45,1,132 : GRID_ONE_COLUMN_WIDTH 45,1,132
   GRID_LOAD 45,system$+"scores.248"
   BUTTON 46 : PARENT 46,40 :LEFT 46,10 : TOP 46,305 : WIDTH 46,300 : HEIGHT 46,25
   CAPTION 46,"Femer la fenêtre" : ON_CLICK 46,tableau

   joueur$=message_input$("Nom du joueur", "Indiquez votre nom :" , "toto")
END

touche:
OFF_KEY_DOWN 0
   SELECT KEY_DOWN_CODE
      CASE 81 : TERMINATE
      CASE 37 : GOSUB gauche
      CASE 38 : GOSUB haut
      CASE 39 : GOSUB droite
      CASE 40 : GOSUB bas
   END_SELECT
'   IF score%>VAL(GRID_READ$(45,11,3)) THEN best$=" (TOP10)"
' Papydall : la ligne ci-dessus provoque une erreur; je l'ai donc sautée
   CAPTION 31,"Score : "+str$(score%)+best$
   pause 100
   IF nbr%<>16
      REPEAT
         n%=int(rnd(16))+1
      UNTIL case%(n%)=0
      case%(n%)=2 : nbr%=nbr%+1
   END_IF
   TOP n%,TOP(n%)+48 : LEFT n%,LEFT(n%)+48
   FOR x%=0 to 40 step 8
      TOP n%,TOP(n%)-8 : LEFT n%,LEFT(n%)-8
      WIDTH n%,x%*2 : HEIGHT n%,x%*2
      FILE_LOAD n%,system$+str$(case%(n%))+".jpg"
      WAIT 1
   NEXT x%
   IF nbr%=16 THEN GOSUB fin
ON_KEY_DOWN 0 , touche
RETURN

gauche:
FOR n%=1 TO 4 : FOR y%=1 to 4 : FOR x%=3 to 1 STEP -1
IF case%(x%+y%*4-4)=0
   case%(x%+y%*4-4)=case%(x%+y%*4-3) : case%(x%+y%*4-3)=0
   FILE_LOAD (x%+y%*4-4),system$+str$(case%(x%+y%*4-4))+".jpg"
   FILE_LOAD (x%+y%*4-3),system$+"0.jpg"
ELSE
   IF case%(x%+y%*4-4)=case%(x%+y%*4-3)
      case%(x%+y%*4-4)=case%(x%+y%*4-4)*2
      case%(x%+y%*4-3)=0 : nbr%=nbr%-1
      FOR mouv%=1 TO 80 STEP 4
         LEFT (x%+y%*4-3),LEFT(x%+y%*4-3)-4
         WAIT 1
      NEXT mouv%
      FILE_LOAD (x%+y%*4-4),system$+str$(case%(x%+y%*4-4))+".jpg"
      FILE_LOAD (x%+y%*4-3),system$+"0.jpg" : LEFT (x%+y%*4-3),LEFT(x%+y%*4-3)+80
      score%=score%+case%(x%+y%*4-4)
   END_IF
END_IF
NEXT x% : NEXT y% : NEXT n%
RETURN

haut:
FOR n%=1 TO 4 : FOR x%=1 to 4 : FOR y%=3 to 1 STEP -1
IF case%(x%+y%*4-4)=0
   case%(x%+y%*4-4)=case%(x%+y%*4) : case%(x%+y%*4)=0
   FILE_LOAD (x%+y%*4-4),system$+str$(case%(x%+y%*4-4))+".jpg"
   FILE_LOAD (x%+y%*4),system$+"0.jpg"
ELSE
   IF case%(x%+y%*4-4)=case%(x%+y%*4)
      case%(x%+y%*4-4)=case%(x%+y%*4-4)*2
      case%(x%+y%*4)=0 : nbr%=nbr%-1
      FOR mouv%=1 TO 80 STEP 4
         TOP (x%+y%*4),TOP(x%+y%*4)-4
         WAIT 1
      NEXT mouv%
      FILE_LOAD (x%+y%*4-4),system$+str$(case%(x%+y%*4-4))+".jpg"
      FILE_LOAD (x%+y%*4),system$+"0.jpg" : TOP (x%+y%*4),TOP(x%+y%*4)+80
      score%=score%+case%((x%+y%*4-4))
   END_IF
END_IF
NEXT y% : NEXT x% : NEXT n%
RETURN

droite:
FOR n%=1 TO 4 : FOR y%=1 to 4 : FOR x%=2 to 4
IF case%(x%+y%*4-4)=0
   case%(x%+y%*4-4)=case%(x%+y%*4-5) : case%(x%+y%*4-5)=0
   FILE_LOAD (x%+y%*4-4),system$+str$(case%(x%+y%*4-4))+".jpg"
   FILE_LOAD (x%+y%*4-5),system$+"0.jpg"
ELSE
   IF case%(x%+y%*4-4)=case%(x%+y%*4-5)
      case%(x%+y%*4-4)=case%(x%+y%*4-4)*2
      case%(x%+y%*4-5)=0 : nbr%=nbr%-1
      FOR mouv%=1 TO 80 STEP 4
         LEFT (x%+y%*4-5),LEFT(x%+y%*4-5)+4
         WAIT 1
      NEXT mouv%
      FILE_LOAD (x%+y%*4-4),system$+str$(case%(x%+y%*4-4))+".jpg"
      FILE_LOAD (x%+y%*4-5),system$+"0.jpg" : LEFT (x%+y%*4-5),LEFT(x%+y%*4-5)-80
      score%=score%+case%(x%+y%*4-4)
   END_IF
END_IF
NEXT x% : NEXT y% : NEXT n%
RETURN

bas:
FOR n%=1 TO 4 : FOR x%=1 to 4 : FOR y%=2 to 4
IF case%(x%+y%*4-4)=0
   case%(x%+y%*4-4)=case%(x%+y%*4-8) : case%(x%+y%*4-8)=0
   FILE_LOAD (x%+y%*4-4),system$+str$(case%(x%+y%*4-4))+".jpg"
   FILE_LOAD (x%+y%*4-8),system$+"0.jpg"
ELSE
   IF case%(x%+y%*4-4)=case%(x%+y%*4-8)
      case%(x%+y%*4-4)=case%(x%+y%*4-4)*2
      case%(x%+y%*4-8)=0 : nbr%=nbr%-1
      FOR mouv%=1 TO 80 STEP 4
         TOP (x%+y%*4-8),TOP(x%+y%*4-8)+4
         WAIT 1
      NEXT mouv%
      FILE_LOAD (x%+y%*4-4),system$+str$(case%(x%+y%*4-4))+".jpg"
      FILE_LOAD (x%+y%*4-8),system$+"0.jpg" : TOP (x%+y%*4-8),TOP(x%+y%*4-8)-80
      score%=score%+case%(x%+y%*4-4)
   END_IF
END_IF
NEXT y% : NEXT x% :NEXT n%
RETURN


sauve:
   FILE_OPEN_WRITE 40,system$+"sauvegarde.248"
   FOR y%=1 to 4 : FOR x%=1 to 4
      FILE_WRITELN 40,case%(x%+y%*4-4)
   NEXT x% : NEXT y%
   FILE_WRITELN 40,score%
   FILE_CLOSE 40
   IF best$=" (TOP10)"
      GOSUB classement
      MESSAGE "Partie sauvegardée !"+CHR$(13)+"Score Mis a jour !"
   ELSE
      MESSAGE "Partie sauvegardée !"
   END_IF
RETURN

charge:
   IF FILE_EXISTS(system$+"sauvegarde.248")=1
      nbr%=0
      FILE_OPEN_READ 40,system$+"sauvegarde.248"
      FOR y%=1 to 4 : FOR x%=1 to 4
         FILE_READLN 40,case%(x%+y%*4-4)
         FILE_LOAD (x%+y%*4-4),system$+str$(case%(x%+y%*4-4))+".jpg"
         IF case%(x%+y%*4-4)<>0 THEN nbr%=nbr%+1
      NEXT x% : NEXT y%
      FILE_READLN 40,score%
      CAPTION 31,"Score : "+str$(score%)
      FILE_CLOSE 40
   ELSE
     MESSAGE "Il n'y a pas de sauvegarde éxistante !"
   END_IF
RETURN

fin:
   mouv%=0
   FOR n%=1 TO 4 : FOR y%=1 to 4 : FOR x%=3 to 1 STEP -1
      IF case%(x%+y%*4-4)=case%(x%+y%*4-3) THEN mouv%=mouv%+1
   NEXT x% : NEXT y% : NEXT n%

   FOR n%=1 TO 4 : FOR x%=1 to 4 : FOR y%=3 to 1 STEP -1
      IF case%(x%+y%*4-4)=case%(x%+y%*4) THEN mouv%=mouv%+1
   NEXT y% : NEXT x% : NEXT n%
  
  FOR n%=1 TO 4 : FOR y%=1 to 4 : FOR x%=2 to 4
      IF case%(x%+y%*4-4)=case%(x%+y%*4-5) THEN mouv%=mouv%+1
   NEXT x% : NEXT y% : NEXT n%

   FOR n%=1 TO 4 : FOR x%=1 to 4 : FOR y%=2 to 4
      IF case%(x%+y%*4-4)=case%(x%+y%*4-8) THEN mouv%=mouv%+1
   NEXT y% : NEXT x% :NEXT n%

   IF mouv%=0
   '   GOSUB reset : ' papydall (pour observer votre oeuvre avant le reset !)
   message "!!!  G A M E   O V E R !!!"  : ' papydall
      IF message_confirmation_yes_no("La partie est finie !!!"+CHR$(13)+CHR$(13)+"On recommence ?")<>1 THEN TERMINATE
      gosub reset : ' papydall
   END_IF
RETURN

reset:
   IF best$=" (TOP10)" THEN GOSUB classement
   FOR n%=1 to 16
      case%(n%)=0
      FILE_LOAD n%,system$+"0.jpg"
   NEXT n%
   score%=0 : nbr%=0 : best$=""
   CAPTION 31,"Score : "+str$(score%)
RETURN

classement:
   n%=2
   WHILE val(GRID_READ$(45,n%,3))>score%
      n%=n%+1
   END_WHILE
   FOR x%=10 TO n% STEP -1
      GRID_WRITE 45,x%+1,1,GRID_READ$(45,x%,1) : GRID_WRITE 45,x%+1,2,GRID_READ$(45,x%,2) : GRID_WRITE 45,x%+1,3,GRID_READ$(45,x%,3)
   NEXT x%
   GRID_WRITE 45,n%,1,joueur$ : GRID_WRITE 45,n%,2,DATE$ : GRID_WRITE 45,n%,3,score%
   GRID_SAVE 45,11,3,system$+"scores.248"
RETURN

tableau:
   IF CLICKED(31)=1 THEN SHOW 40 : OFF_KEY_DOWN 0
   IF CLICKED(46)=1 THEN HIDE 40 : ON_KEY_DOWN 0,touche
RETURN

aide:
t$="ATTENTION !"+chr$(13)+chr$(13)
t$=t$+"Ce jeu est issu de l'esprit torturé d'un jeune italien de 19 ans."+chr$(13)+chr$(13)
t$=t$+"Etant donné son pouvoir addictif, ce jeu ne doit etre utiliser que sous le controle"+chr$(13)
t$=t$+" d'un médecin ou d'un psychiatre !"+chr$(13)+chr$(13)
t$=t$+"Toute autre utilisation risque ne nuire gravement à votre santé !"+chr$(13)+chr$(13)
t$=t$+"L'utilisation d'une paire de mouffles est fortement recommandée."+chr$(13)
t$=t$+"(d'après les joueurs, elles éviteraient l'addiction mais celà reste a prouver)."+chr$(13)+chr$(13)
t$=t$+"ETES VOUS TOUJOURS SUR DE VOULOIR JOUER"
IF message_confirmation_yes_no(t$)<>1
   MESSAGE "Pensez quand même a consulter..."
   TERMINATE
ELSE
   t$="LE BUT DU JEU :"+chr$(13)+chr$(13)
   t$=t$+"Rien de plus simple !"+chr$(13)+chr$(13)
   t$=t$+"Il suffit d'empiler les palettes de meme valeur l'une sur l'autre."+chr$(13)
   t$=t$+"Ce qui permet d'augmenter leurs valeurs... "+chr$(13)+chr$(13)
   t$=t$+"Le but est d'arriver à afficher la palette de 2048 !"+chr$(13)+chr$(13)
   t$=t$+"Utilisez les fléches de direction de votre clavier :"+chr$(13)
   t$=t$+"HAUT, BAS, GAUCHE ET DROITE"+chr$(13)+chr$(13)
   t$=t$+"A vous de jouer..."
   MESSAGE t$
END_IF
RETURN

quitte:
   IF best$=" (TOP10)" THEN GOSUB classement
   TERMINATE
  
rem ============================================================================
' Ajouté par PAPYDALL
' Il n'y a aucune IA
' Le programme exécute automatiquement une série de mouvements prédéfinis dans la variables m$.
' Comme il y a toujours une part de hasard dans le choix de la future case à jouer,
' les mouvements prédéfinis peuvent aboutir à des bons résultats ou au contraire à un blocage.
' Cette option est en fait une manière de montrer comment on peut jouer et (pourquoi pas ?) espérer aboutir à un meilleur score !

'
 Autorun:

    m$ = ""
    m$ = m$ + "dhgggbdhhbghbbhbhgbdbhbdghddhghhhhdhhhdhdhbhghhhbbbgh"
    m$ = m$ + "ghhgbgbdhgdhdhhgddgdhgdbddhbddgdgbbdddghhdgdghhddhdhhdhhhhdb"
    m$ = m$ + "ddbbhbghdhddhgghdddgggdggbggghhhgbhbhgggbbgghbbbgbhghgggbbhh"
    m$ = m$ + "gghhgghggdgddbbhghghgbgbghhgghghhbhbgbgbhhhh"
    m$ = m$ + "hgbbhhgbbghggbhbbbgbggghgghhdghhdghh"

    for i = 1 to len(m$)
        select asc(upper$(mid$(m$,i,1)))
            case 66 : gosub bas
            case 68 : gosub droite
            case 71 : gosub gauche
            case 72 : gosub haut
        end_select
        if scancode = 27 then exit_sub
        
        CAPTION 31,"Score : "+str$(score%)+best$
       ' pause 100
        IF nbr%<>16
           REPEAT : n%=int(rnd(16))+1 : UNTIL case%(n%)=0
           case%(n%)=2 : nbr%=nbr%+1
        END_IF
        TOP n%,TOP(n%)+48 : LEFT n%,LEFT(n%)+48
        FOR x%=0 to 40 step 8
            TOP n%,TOP(n%)-8 : LEFT n%,LEFT(n%)-8
            WIDTH n%,x%*2 : HEIGHT n%,x%*2
            FILE_LOAD n%,system$+str$(case%(n%))+".jpg"
            WAIT 1
        NEXT x%
        IF nbr%=16 THEN GOSUB fin
    next i

RETURN
rem ============================================================================