2048

[bonuscad]

Bonjour,

 

Je pense que tout le monde connait 2048

 

Pour le fun, j'ai tenté de le réécrire en lisp.

Par rapport à l'original il présente certainement un comportement un peu différent; j'ai développé mon propre algorithme, mais il est jouable.

Il y a certainement mieux, donc le challenge est lancé, pour ma part j'avais pensé que ce serait assez simple mais je me suis trompé, je suis passé par un phase de test assez fastidieuse pour la mise au point.

 

Vos avis? Vos propositions?!

;; C:GAME2048
;; Un clone en AutoLisp inspiré de https://gabrielecirulli.github.io/2048/
;; par Bruno VALSECCHI Decembre 2017
;;
;; Joindre les nombres de même valeur jusqu'à obtenir la tuile 2048!
;;
;; Utiliser les touches 2 4 6 8 du pavé numérique pour déplacer les tuiles vers le bas, gauche, droite, haut
;;
(defun randomize (v1 v2 / )
 (if (not v_sd)
   (setq v_sd (getvar "DATE"))
 )
 (setq v_sd (rem (+ (* 25173 v_sd) 13849) 65536))
 (+ (* (/ v_sd 65536) (- (max v1 v2) (min v1 v2))) (min v1 v2))
)
(defun vl-position-multi (el l / n l_id l_n)
 (setq
   n 0
   l_id (mapcar '(lambda (x) (equal x el)) l)
 )
 (repeat (length l_id)
   (if (car l_id) (setq l_n (cons n l_n)))
   (setq n (1+ n) l_id (cdr l_id))
 )
 (reverse l_n)
)
(defun draw_map (statut_map / lm_col lt_col tmp lx ly dxf_m dxf_t x y)
 (setq lm_col '((0 . 252) (2 . 255) (4 . 53) (8 . 31) (16 . 30) (32 . 20) (64 . 22) (128 . 42) (256 . 52) (512 . 40) (1024 . 32) (2048 . 2)))
 (setq lt_col '((0 . 252) (2 . 250) (4 . 250) (8 . 255) (16 . 255) (32 . 255) (64 . 255) (128 . 255) (256 . 255) (512 . 255) (1024 . 255) (2048 . 1)))
 (setq tmp map)
 (setq lx (mapcar 'car tmp) ly (mapcar 'cdr tmp))
 (foreach dxf_mask lst_mask
   (setq dxf_m (entget (cdr dxf_mask)))
   (mapcar
     '(lambda (xi yi / x y)
       (setq x xi y yi)
       (entmod
         (subst
           (cons 10 (list (cdr x) (car x) 0))
           (assoc 10 dxf_m)
           dxf_m
         )
       )
       (entmod
         (subst
           (cons 11 (list (1+ (cdr x)) (car x) 0))
           (assoc 11 dxf_m)
           dxf_m
         )
       )
       (entmod
         (subst
           (cons 12 (list (cdr x) (1+ (car x)) 0))
           (assoc 12 dxf_m)
           dxf_m
         )
       )
       (entmod
         (subst
           (cons 13 (list (1+ (cdr x)) (1+ (car x)) 0))
           (assoc 13 dxf_m)
           dxf_m
         )
       )
       (entmod
         (subst
           (cons 62 (cdr (assoc y lm_col)))
           (assoc 62 dxf_m)
           dxf_m
         )
       )
     )
     (list (car lx))
     (list (car ly))
   )
   (setq lx (cdr lx) ly (cdr ly))
 )
 (setq lx (mapcar 'car tmp) ly (mapcar 'cdr tmp))
 (foreach dxf_text lst_text
   (setq dxf_t (entget (cdr dxf_text)))
   (mapcar
     '(lambda (x y / x y)
       (entmod
         (subst
           (cons 11 (list (+ 0.5 (cdr x)) (+ 0.5 (car x)) 0))
           (assoc 11 dxf_t)
           dxf_t
         )
       )
       (entmod
         (subst
           (cons 1 (itoa y))
           (assoc 1 dxf_t)
           (subst
             (cons 62 (cdr (assoc y lt_col)))
             (assoc 62 dxf_t)
             dxf_t
           )
         )
       )
     )
     (list (car lx))
     (list (car ly))
   )
   (setq lx (cdr lx) ly (cdr ly))
 )
 (command "_.TEXTTOFRONT" "_Text")
)
(defun evaluate_push (l count / l)
 (setq l (reverse (vl-remove 0 l)))
 (if (cdr l)
   (cond
     ((and (eq (car l) (cadr l)) (<= (+ (car l) (cadr l)) count))
       (evaluate_push (reverse (cons (+ (car l) (cadr l)) (cddr l))) count)
     )
     (T
       (evaluate_push (reverse (cdr l)) count)
       (setq nwl (cons (car l) nwl))
     )
   )
   (setq nwl (cons (car l) nwl))
 )
 (reverse (if (car nwl) nwl '(0)))
)
(defun push (k / lst tmp nwl)
 (setq map-n map)
 (cond
   ((eq k 50)
     (setq lst '("C-U3" "C-U2" "C-U1" "C-U0"))
   )
   ((eq k 52)
     (setq lst '("R-R0" "R-R1" "R-R2" "R-R3"))
   )
   ((eq k 54)
     (setq lst '("R-L3" "R-L2" "R-L1" "R-L0"))
   )
   ((eq k 56)
     (setq lst '("C-D0" "C-D1" "C-D2" "C-D3"))
   )
 )
 (foreach n lst
   (setq tmp (mapcar 'cdr (mapcar '(lambda (x) (assoc x map)) (eval (read n)))) nwl nil)
   (setq nwl (evaluate_push tmp (* (if (member (apply 'max tmp) (cdr (member (apply 'max tmp) tmp))) 2 1) (apply 'max tmp))))
   (if (not (eq (length (vl-remove 0 nwl)) 4))
     (progn
       (repeat (- (length tmp) (length (setq nwl (vl-remove 0 nwl))))
         (setq nwl (cons 0 nwl))
       )
       nwl
     )
     nwl
   )
   (setq tmp (mapcar '(lambda (x) (assoc x map)) (eval (read n))))
   (foreach n (mapcar '(lambda (x y) (cons x y)) (mapcar 'car (mapcar '(lambda (x) (assoc x map)) (eval (read n)))) nwl)
     (setq map (subst n (assoc (car n) map) map))
   )
 )
)
(defun c:Game2048 ( / v_sd mat_game map lst_mask lst_text nw_pos key before after win loose)
 (foreach n '("R-L0" "R-L1" "R-L2" "R-L3" "R-R0" "R-R1" "R-R2" "R-R3") (set (read n) nil))
 (foreach n '("C-U0" "C-U1" "C-U2" "C-U3" "C-D0" "C-D1" "C-D2" "C-D3") (set (read n) nil))
 (setq mat_game
   '(
     (3 . 0) (3 . 1) (3 . 2) (3 . 3)
     (2 . 0) (2 . 1) (2 . 2) (2 . 3)
     (1 . 0) (1 . 1) (1 . 2) (1 . 3)
     (0 . 0) (0 . 1) (0 . 2) (0 . 3)
   )
 )
 (mapcar
   '(lambda (x y)
     (set
       (read (strcat "R-R" (itoa y)))
       (reverse x)
     )
   )
   (mapcar
     '(lambda (x y)
       (foreach n x
         (set
           (read (strcat "R-L" (itoa y)))
           (cons
             (nth n mat_game)
             (eval (read (strcat "R-L" (itoa y))))
           )
         )
       )
     )
     (mapcar
       '(lambda (x)
         (vl-position-multi x (mapcar 'car mat_game))
       )
       '(0 1 2 3)
     )
     '(0 1 2 3)
   )
   '(0 1 2 3)
 )
 (mapcar
   '(lambda (x y)
     (set
       (read (strcat "C-D" (itoa y)))
       (reverse x)
     )
   )
   (mapcar
     '(lambda (x y)
       (foreach n x
         (set
           (read (strcat "C-U" (itoa y)))
           (cons
             (nth n mat_game)
             (eval (read (strcat "C-U" (itoa y))))
           )
         )
       )
     )
     (mapcar
       '(lambda (x)
         (vl-position-multi x (mapcar 'cdr mat_game))
       )
       '(0 1 2 3)
     )
     '(0 1 2 3)
   )
   '(0 1 2 3)
 )
 (setq map (mapcar '(lambda (n / ) (cons n 0)) mat_game))
 (entmake
   '(
     (0 . "STYLE")
     (100 . "AcDbSymbolTableRecord")
     (100 . "AcDbTextStyleTableRecord")
     (2 . "2048")
     (70 . 0)
     (40 . 0.0)
     (41 . 1.0)
     (50 . 0.0)
     (71 . 0)
     (42 . 0.5)
     (3 . "arial.ttf")
     (4 . "")
   )
 )
 (setvar "TEXTSTYLE" "2048")
 (setvar "CMDECHO" 0)
 (command "_.zoom" "_window" "_none" '(0 0) "_none" '(4 4))
 (foreach n map
   (entmake
     (list
       '(0 . "SOLID")
       '(100 . "AcDbEntity")
       '(67 . 0)
       '(410 . "Model")
       '(8 . "0")
       '(62 . 252)
       '(100 . "AcDbTrace")
       (cons 10 (list (cdar n) (caar n) 0))
       (cons 11 (list (1+ (cdar n)) (caar n) 0))
       (cons 12 (list (cdar n) (1+ (caar n)) 0))
       (cons 13 (list (1+ (cdar n)) (1+ (caar n)) 0))
       '(39 . 0.0)
       '(210 0.0 0.0 1.0)
     )
   )
   (setq lst_mask (cons (assoc -1 (entget (entlast))) lst_mask))
   (entmake
     (list
       '(0 . "TEXT")
       '(100 . "AcDbEntity")
       '(67 . 0)
       '(410 . "Model")
       '(8 . "0")
       '(62 . 252)
       '(100 . "AcDbText")
       (cons 10 (list (+ (cdar n) 0.19423602) (+ (caar n) 0.25) 0))
       '(40 . 0.5)
       '(1 . "0")
       '(50 . 0.0)
       '(41 . 0.65)
       '(51 . 0.0)
       '(7 . "2048")
       '(71 . 0)
       '(72 . 1)
       (cons 11 (list (+ (cdar n) 0.5) (+ (caar n) 0.5) 0))
       '(210 0.0 0.0 1.0)
       '(100 . "AcDbText")
       '(73 . 2)
     )
   )
   (setq lst_text (cons (assoc -1 (entget (entlast))) lst_text))
 )
 (setq nw_pos
   (cons
     (cons
       (read (rtos (randomize 0 3) 2 0))
       (read (rtos (randomize 0 3) 2 0))
     )
     (* 2 (read (rtos (randomize 1 2) 2 0)))
   )
 )
 (if
   (or
     (zerop (cdr (assoc (car nw_pos) map)))
     (eq (cdr (assoc (car nw_pos) map)) (cdr nw_pos))
   )
   (setq map (subst (cons (car nw_pos) (+ (cdr nw_pos) (cdr (assoc (car nw_pos) map)))) (assoc (car nw_pos) map) map))
 )
 (draw_map map)
 (print)
 (while (and (setq key (grread T 4 0)) (not loose))
   (if (member (cadr key) '(50 52 54 56))
     (progn
       (setq before (mapcar 'cdr map))
       (push (cadr key))
       (if (member 2048 (mapcar 'cdr map)) (progn (setq win T) (alert "GAGNE")))
       (setq after (mapcar 'cdr map))
       (cond
         ((not (equal before after))
           (while
             (not
               (zerop
                 (cdr
                   (assoc
                     (car
                       (setq nw_pos
                         (cons
                           (cons
                             (read (rtos (randomize 0 3) 2 0))
                             (read (rtos (randomize 0 3) 2 0))
                           )
                           (* 2 (read (rtos (randomize 1 2) 2 0)))
                         )
                       )
                     )
                     map
                   )
                 )
               )
             )
           )
           (if
             (or
               (zerop (cdr (assoc (car nw_pos) map)))
               (eq (cdr (assoc (car nw_pos) map)) (cdr nw_pos))
             )
             (setq map (subst (cons (car nw_pos) (+ (cdr nw_pos) (cdr (assoc (car nw_pos) map)))) (assoc (car nw_pos) map) map))
           )
           (draw_map map)
         )
         (T (if (not (member 0 (mapcar 'cdr map))) (setq loose T)))
       )
     )
   )
 )
 (if (not win) (alert "PERDU"))
 (command "_.ERASE" "_All" "")
 (setvar "TEXTSTYLE" "Standard")
 (setvar "CMDECHO" 1)
 (foreach n '("R-L0" "R-L1" "R-L2" "R-L3" "R-R0" "R-R1" "R-R2" "R-R3") (set (read n) nil))
 (foreach n '("C-U0" "C-U1" "C-U2" "C-U3" "C-D0" "C-D1" "C-D2" "C-D3") (set (read n) nil))
 (prin1)
)

 

Bien sur, à tester/utiliser dans un dessin vierge (hors session de travail, des bugs bloquants restent possibles)

Modifié le 17 décembre 2017 par bonuscad

[didier]

Coucou

 

J'adore le principe !

 

Par contre dans ce cas précis je bugge, je n'ai pas compris ni la règle, ni ce qu'il fallait faire et encore moins comment le faire ?

J'ai dans mes tiroirs pas mal de choses dans le genre "fun" et je pense que ce sera une future rubrique de mon site quand je serai plus avancé sur les définitions.

Tu peux nous en dire plus sur ce travail ?

 

Amicalement

[bonuscad]

Alors, précision importante que j'ai oublié de dire:

Cela se joue avec le pavé numérique 2 4 8 6 pour simuler le déplacement avec les flèches directionnelles.

Sur un portable (sans pavé) c'est plus fastidieux, mais les touches peuvent être reprogrammées.

 

Le but du jeu: ammener des chiffres identiques bord à bord pour les fusionner et les additionner jusqu'à obtenir le nombre 2048.

 

Attention cela peut être addictif :D

[nosset]

Ça me rappelle mes débuts sous AutoCAD DOS (oui oui windows n'était pas l'environnement unique) et après.

J'avais développé sous AutoCAD : TETRIS, SOLITAIRE, PACMAN, UNE REUSSITE en Lisp et en DCL

Je dois encore avoir les sources quelque part mais je doute que ça marche encore.

[Turtle]

En un mot :

 

Excellent.

 

 

 

 

 

 

 

Bon je retourne, jouer ....

 

 

 

 

 

[bonuscad]

Bonjour à tous

 

J'ai modifié le code original posté plus haut.

L'addition des nombres est plus fidèle à l'original de Gabrielle Cirulli, ce qui n'était pas le cas avant (il brulait des étapes et l'addition des tuiles n'était pas toujours dans le bon ordre.

 

Amusez vous bien et joyeux Noël 2017

[didier]

coucou

 

Indécrottable benêt que je suis !

Je n'ai toujours pas compris la règle !

Je vois bien des chiffres qui bougent quand j'appuie sur les touches 4 8 6 2

Mais je ne sais pas comment les aligner, la règle c'est de faire aligner 2048 sur une ligne ?

 

J'adore le principe du jeu en lisp qui permet à tout le monde d'échanger des programmes sans tenir compte de ses particularités "métier" et donc de devoir donner des explications abstruses.

Encore faut-il comprendre le but à atteindre ...

Dans tous les cas je te remercie du partage car quand je saurai ce qu'il faut faire je décortiquerai le code pour progresser.

Désolé de faire boulet mais je veux bien qu'on m'explique pas à pas quitte à mettre des copies d'écran car même sur le site original je n'ai pas vu d'aide.

 

Amicalement

[nosset]

Tu ne peut additionner que des briques identiques (les 2 avec les 2, les 4 avec les 4 et ainsi de suite)

Pour additionner 2 briques il faut les "jeter" l'une sur l'autre.

Si tu as deux "2" sur la même ligne tu peux soit faire droite soit faire gauche pour les "jeter" l'une sur l'autre, à toi de voir en fonction des autres additions possibles avec ton coup. Si les deux "2" sont sur la même colonne c'est haut et bas.

Lorsque tu fais un déplacement, toutes les briques se 's'empilent du coté du coup que tu as joué créant ainsi de nouvelles additions possibles.

les deux "2" se transforment en un "4" ainsi que toutes les additions possibles avec ton coup.

une nouvelle brique apparaît

Le but est d'avoir "2048" dans une brique.

[bonuscad]

Comme deux explications valent mieux qu'une...

Les touches de déplacement permettent de faire glisser les tuiles dans le sens choisi, soit par colonnes, soit par rangées.

Si lors de ce déplacement, deux tuiles (donc une paire) de même valeur se touchent bord à bord, alors celles-ci fusionnent pour s'additionner et obtenir une seule tuile (tu gagne un nouvel emplacement libre pour les mouvements futur). A chaque mouvement une nouvelle tuile apparait à un emplacement libre aléatoire de valeur 2 ou 4.

 

Donc le but et de glisser les tuiles de façon à les additionner pour le coup à jouer ou le coup suivant. Le but ultime étant d'obtenir la tuile de valeur 2048.

 

Un exemple de glissement en rangée de gauche à droite: (ici sur une seule ligne, dans le jeu c'est sur toutes les lignes)

(2 0 2 16) -> (0 0 4 16)

(4 4 4 8) -> (0 4 8 8): le coup suivant tu obtiendrait (en considérant qu'une nouvelle tuile ne soit pas apparue dans la rangée) -> (0 0 4 16)

(2 16 0 8) -> (0 2 16 8): aucune addition faite, les tuiles ont juste glissées.

 

Pour gagner, il parait qu'il faut coincer la tuile de plus haute valeur dans un coin et éviter de la déplacer (plus facile à dire qu'à faire) et avoir les tuiles de valeur dégressive proche de la plus haute, c'est la tactique que j'emploie, mais cela ne me fait pas gagner à tout les coups (loin de là).

[bseb67]

Au purée :o...

Combien d'heures j'ai du passé sur ce jeu en flash pendant mes pauses de de midi.

 

Merci bonuscad.

 

 

Moi je suis tenté de développer un simulateur de bataille et voir si la partie se finie...

 

Et l'autre idée que je voulais il y a quelques années déjà : un jeu de bataille navale à deux joueurs, sur le même réseau bien-sûr.