2048

Comme j'ai déjà eu l'occasion d'en parler : jouer ou créer un jeu est particulièrement didactique pour apprendre à programmer.

c'est BonusCAD qui s'y colle encore.

Il a créé un clone du jeu 2048, bien connu paraît-il car j'avoue en ignorer l'existence aussi je suis allé me renseigner et le beauté du code m'a donné envie de le diffuser, avec l'autorisation explicite de l'auteur ne vous en inquiétez pas.

Je ne vais pas vous faire l'affront d'expliquer les règles du jeu et je vous laisse aller sur la toile vous éduquer le cas échéant.
Tout ce qui suit (en italique) est ce que m'a expliqué l'auteur.
Si ce n'est pas suffisant pour jouer utilisez le formulaire de CONTACT et j'irai chercher les informations.

Les seules touches actives sont sur le pavé numérique

• la touche 8 (up) vers le haut,
• la touche 4 (left) à gauche,
• la touche 6 (right) à droite,
• la touche 2 (down) vers le bas.

En appuyant sur l'une de ces touches, toutes les tuiles présentes vont se déplacer dans la direction choisie s'il y a de la place de libre et si elle rencontre une autre tuile de la même valeur, elle va s'additionner.

Imaginons qu'une tuile de valeur 4 apparaisse au même endroit que la précédente.
Si tu appuies sur touche 8 la tuile va se déplacer aussi vers le bord du haut et comme elles ont la même valeur, cela va former une SEULE tuile de valeur 8.
Si ça avait une tuile de valeur 2 elle se serait collée juste en dessous de la tuile de valeur 4.

Si on utilise un portable sans pavé numérique, il faudra utiliser les chiffres du clavier alpha-numérique (moins pratiques) ou reprogrammer les touches dans le code pour en choisir d'autres...

Le jeu est un peu plus difficile que l'original car cet algorithme peut cumuler plusieurs additions en une seule fois, je m'explique:
Tu as par exemple quatre tuiles de valeur 2 dans une même colonne, si tu appuies sur 8 ou 2 cela va donner directement une tuile de valeur 8 en haut ou en bas, alors qu'avec le vrai jeu cela donnerait d'abord deux tuiles de valeur 4 et si tu rappuies sur la même touche, une tuile de valeur 8.
Donc ça peut laisser plus de stratégie dans le déplacement des tuiles.
Je gagne moins souvent avec mon jeu qu'avec le jeu original.

La tactique (au bout d'un moment) est d'arriver à garder une tuile de grande valeur dans un coin sans qu'elle puisse se déplacer et de faire monter sa valeur, donc d'avoir des tuiles de valeurs importante de valeur décroissante autour de celle ci.

Mais bon vous allez expérimenter.

 

;;game2048.lsp
;|
Programmme écrit pas Bruno Valsecchi en décembre 2017
|;
(defun randomize (v1 v2 /)
  (if (not v_sd)
    (setq v_sd (getvar "DATE"))
    ) ;_ Fin de  if
  (setq v_sd (rem (+ (* 25173 v_sd) 13849) 65536))
  (+ (* (/ v_sd 65536) (- (max v1 v2) (min v1 v2)))
     (min v1 v2)
     ) ;_ Fin de  +
  ) ;_ Fin de  defun
(defun vl-position-multi (el l / n l_id l_n)
  (setq n 0
	l_id (mapcar '(lambda (x) (equal x el)) l)
    ) ;_ Fin de  setq
  (repeat (length l_id)
    (if	(car l_id)
      (setq l_n (cons n l_n))
      ) ;_ Fin de  if
    (setq n (1+ n)
	  l_id (cdr l_id)
	  ) ;_ Fin de  setq
    ) ;_ Fin de  repeat
  (reverse l_n)
  ) ;_ Fin de  defun
(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)
		 )
	) ;_ Fin de  setq
  (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)
		 )
	) ;_ Fin de  setq
  (setq tmp map)
  (setq	lx (mapcar 'car tmp)
	ly (mapcar 'cdr tmp)
	) ;_ Fin de  setq
  (foreach dxf_mask lst_mask
    (setq dxf_m (entget (cdr dxf_mask)))
    (mapcar
      '(lambda (xi yi / x y)
	 (setq x xi
	       y yi
	       ) ;_ Fin de  setq
	 (entmod
	   (subst
	     (cons 10 (list (cdr x) (car x) 0))
	     (assoc 10 dxf_m)
	     dxf_m
	     ) ;_ Fin de  subst
	   ) ;_ Fin de  entmod
	 (entmod
	   (subst
	     (cons 11 (list (1+ (cdr x)) (car x) 0))
	     (assoc 11 dxf_m)
	     dxf_m
	     ) ;_ Fin de  subst
	   ) ;_ Fin de  entmod
	 (entmod
	   (subst
	     (cons 12 (list (cdr x) (1+ (car x)) 0))
	     (assoc 12 dxf_m)
	     dxf_m
	     ) ;_ Fin de  subst
	   ) ;_ Fin de  entmod
	 (entmod
	   (subst
	     (cons 13 (list (1+ (cdr x)) (1+ (car x)) 0))
	     (assoc 13 dxf_m)
	     dxf_m
	     ) ;_ Fin de  subst
	   ) ;_ Fin de  entmod
	 (entmod
	   (subst
	     (cons 62 (cdr (assoc y lm_col)))
	     (assoc 62 dxf_m)
	     dxf_m
	     ) ;_ Fin de  subst
	   ) ;_ Fin de  entmod
	 ) ;_ Fin de  lambda
      (list (car lx))
      (list (car ly))
      ) ;_ Fin de  mapcar
    (setq lx (cdr lx)
	  ly (cdr ly)
	  ) ;_ Fin de  setq
    ) ;_ Fin de  foreach
  (setq	lx (mapcar 'car tmp)
	ly (mapcar 'cdr tmp)
	) ;_ Fin de  setq
  (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
	     ) ;_ Fin de  subst
	   ) ;_ Fin de  entmod
	 (entmod
	   (subst
	     (cons 1 (itoa y))
	     (assoc 1 dxf_t)
	     (subst
	       (cons 62 (cdr (assoc y lt_col)))
	       (assoc 62 dxf_t)
	       dxf_t
	       ) ;_ Fin de  subst
	     ) ;_ Fin de  subst
	   ) ;_ Fin de  entmod
	 ) ;_ Fin de  lambda
      (list (car lx))
      (list (car ly))
      ) ;_ Fin de  mapcar
    (command "_.DRAWORDER" (cdr dxf_text) "" "_Front")
    (setq lx (cdr lx)
	  ly (cdr ly)
	  ) ;_ Fin de  setq
    ) ;_ Fin de  foreach
					
  (entmod (subst (cons 1 (itoa counter))
		 (assoc 1 (entget ent_count))
		 (entget ent_count)
		 ) ;_ Fin de  subst
	  ) ;_ Fin de  entmod
  ) ;_ Fin de  defun
(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))
       (setq counter (+ counter (car l) (cadr l)))
       (evaluate_push
	 (reverse (cons (+ (car l) (cadr l)) (cddr l)))
	 count
	 ) ;_ Fin de  evaluate_push
       )
      (T
       (evaluate_push (reverse (cdr l)) count)
       (setq nwl (cons (car l) nwl))
       )
      ) ;_ Fin de  cond
    (setq nwl (cons (car l) nwl))
    ) ;_ Fin de  if
  (reverse (if (car nwl)
	     nwl
	     '(0)
	     ) ;_ Fin de  if
	   ) ;_ Fin de  reverse
  ) ;_ Fin de  defun

;|Fonction qui va pousser les nombres
dans le sens voulu (Haut Bas Droit Gauche)
évaluer éventuellement la somme fonction (evaluate_push)
et mettre à jour la matrice
|;
(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"))
     )
    ) ;_ Fin de  cond
  (foreach n lst
    (setq tmp (mapcar 'cdr
		      (mapcar '(lambda (x) (assoc x map)) (eval (read n)))
		      ) ;_ Fin de  mapcar
	  nwl nil
	  ) ;_ Fin de  setq
    (setq nwl (evaluate_push
		tmp
		(* (if (member (apply 'max tmp)
			       (cdr (member (apply 'max tmp) tmp))
			       ) ;_ Fin de  member
		     2
		     1
		     ) ;_ Fin de  if
		   (apply 'max tmp)
		   ) ;_ Fin de  *
		) ;_ Fin de  evaluate_push
	  ) ;_ Fin de  setq
    (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))
	  ) ;_ Fin de  repeat
	nwl
	) ;_ Fin de  progn
      nwl
      ) ;_ Fin de  if
    (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)))
		   ) ;_ Fin de  mapcar
		 nwl
		 ) ;_ Fin de  mapcar
      (setq map (subst n (assoc (car n) map) map))
      ) ;_ Fin de  foreach
    ) ;_ Fin de  foreach
  ) ;_ Fin de  defun
(defun c:Game2048 (/	    v_sd     mat_game map      lst_mask
		   lst_text nw_pos   key      before   after
		   win	    loose    counter  num_win
		   )
;|
Création des variables: comprendre
R pour Row (Rangée) et C pour Column (Colonne)
L pour Left (Gauche) et R pour Rigth (Droit)
U por Up (Haut) et D pour Down (Bas)
Celle-ci sont mise à vide (nil) pour débuter le jeu ou pour recommencer une nouvelle partie
|;


  (foreach n '("R-L0" "R-L1" "R-L2" "R-L3" "R-R0" "R-R1" "R-R2" "R-R3")
    (set (read n) nil)
    ) ;_ Fin de  foreach
  (foreach n '("C-U0" "C-U1" "C-U2" "C-U3" "C-D0" "C-D1" "C-D2" "C-D3")
    (set (read n) nil)
    ) ;_ Fin de  foreach
;|
;Construction de la matrice du jeu par paire pointée,
mise à zéro du compteur et déclaration du nombre gagnant.
|;
  (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)
	   )
	counter	0
	num_win	2048
	) ;_ Fin de  setq
;Initialisation des variables sur la matrice de jeu
  (mapcar
    '(lambda (x y)
       (set
	 (read (strcat "R-R" (itoa y)))
	 (reverse x)
	 ) ;_ Fin de  set
       ) ;_ Fin de  lambda
    (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))))
	       ) ;_ Fin de  cons
	     ) ;_ Fin de  set
	   ) ;_ Fin de  foreach
	 ) ;_ Fin de  lambda
      (mapcar
	'(lambda (x)
	   (vl-position-multi x (mapcar 'car mat_game))
	   ) ;_ Fin de  lambda
	'(0 1 2 3)
	) ;_ Fin de  mapcar
      '(0 1 2 3)
      ) ;_ Fin de  mapcar
    '(0 1 2 3)
    ) ;_ Fin de  mapcar
  (mapcar
    '(lambda (x y)
       (set
	 (read (strcat "C-D" (itoa y)))
	 (reverse x)
	 ) ;_ Fin de  set
       ) ;_ Fin de  lambda
    (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))))
	       ) ;_ Fin de  cons
	     ) ;_ Fin de  set
	   ) ;_ Fin de  foreach
	 ) ;_ Fin de  lambda
      (mapcar
	'(lambda (x)
	   (vl-position-multi x (mapcar 'cdr mat_game))
	   ) ;_ Fin de  lambda
	'(0 1 2 3)
	) ;_ Fin de  mapcar
      '(0 1 2 3)
      ) ;_ Fin de  mapcar
    '(0 1 2 3)
    ) ;_ Fin de  mapcar
;Mise à zéro du plateau de jeu
  (setq map (mapcar '(lambda (n /) (cons n 0)) mat_game))
;Construction graphique du plateau de jeu à l'écran avec la matrice (map) initialisée
  (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 . "")
      )
    ) ;_ Fin de  entmake
  (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)
	) ;_ Fin de  list
      ) ;_ Fin de  entmake
    (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)
	) ;_ Fin de  list
      ) ;_ Fin de  entmake
    (setq lst_text (cons (assoc -1 (entget (entlast))) lst_text))
    ) ;_ Fin de  foreach
;|création graphique du texte qui représentera
le nombre aléatoire (2 ou 4) qui apparaitra sur le plateau
|;
  (entmake
    (list
      '(0 . "TEXT") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "0")
      '(62 . 256) '(100 . "AcDbText") '(10 -2.0 2.0 0.0) '(40 . 0.5) '(1 . "0")
      '(50 . 0.0) '(41 . 0.65) '(51 . 0.0) '(7 . "2048") '(210 0.0 0.0 1.0)
      '(100 . "AcDbText")) ;_ Fin de  list
    ) ;_ Fin de  entmake
;mémorisation de cette entité 
  (setq ent_count (entlast))
;Premier placement aléatoire sur le plateau du nombre aléatoire 1 ou 2
  (setq	nw_pos
	 (cons
	   (cons
	     (read (rtos (randomize 0 3) 2 0))
	     (read (rtos (randomize 0 3) 2 0))
	     ) ;_ Fin de  cons
	   (* 2 (read (rtos (randomize 1 2) 2 0)))
	   ) ;_ Fin de  cons
	) ;_ Fin de  setq

;Mise à jour de la matrice avec ce nouveau placement
  (if
    (or
      (zerop (cdr (assoc (car nw_pos) map)))
      (eq (cdr (assoc (car nw_pos) map)) (cdr nw_pos))
      ) ;_ Fin de  or
     (setq
       map (subst (cons	(car nw_pos)
			(+ (cdr nw_pos) (cdr (assoc (car nw_pos) map)))
			) ;_ Fin de  cons
		  (assoc (car nw_pos) map)
		  map
		  ) ;_ Fin de  subst
       ) ;_ Fin de  setq
     ) ;_ Fin de  if

;Mise à jour graphique de la matrice
  (draw_map map)
;|
Boucle avec tant que c'est pas perdu
on lit en condition la saisie clavier
faite sur les touches du pavé numérique déclarées.
|;
  
  (while (and (setq key (grread T 4 0)) (not loose))
;|Si ces conditions sont bonnes,
on génère une position aléatoire
et un nombre aléatoire (2 ou 4)
et on met à jour la matrice de jeu.
|;
    (if	(member (cadr key) '(50 52 54 56))
      (progn
	(setq before (mapcar 'cdr map))
;|
Fonction qui va cumuler les nombres identiques
dans une celulle adjacente de la matrice de jeu
et mettre à jour celle-ci
|;
	(push (cadr key))
	(if (member num_win (mapcar 'cdr map))
	  (progn (setq win T) (alert "GAGNE") (setq num_win 4096))
	  ) ;_ Fin de  if
	(setq after (mapcar 'cdr map))
;|On vérifie que la matrice est bien différente du coup précédent,
donc que la matrice n'est pas pleine et que c'est perdu
|;
	(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))
				  ) ;_ Fin de  cons
				(* 2 (read (rtos (randomize 1 2) 2 0)))
				) ;_ Fin de  cons
			     ) ;_ Fin de  setq
		       ) ;_ Fin de  car
		     map
		     ) ;_ Fin de  assoc
		   ) ;_ Fin de  cdr
		 ) ;_ Fin de  zerop
	       ) ;_ Fin de  not
	     ) ;_ Fin de  while
;|On vérifie que la nouvelle position aléatoire
occupée dans la matrice est bien vierge (à Zéro)
pour mettre à jour celle-ci
|;
	   (if
	     (or
	       (zerop (cdr (assoc (car nw_pos) map)))
	       (eq (cdr (assoc (car nw_pos) map)) (cdr nw_pos))
	       ) ;_ Fin de  or
	      (setq
		map (subst
		      (cons
			(car nw_pos)
			(+ (cdr nw_pos) (cdr (assoc (car nw_pos) map)))
			) ;_ Fin de  cons
		      (assoc (car nw_pos) map)
		      map
		      ) ;_ Fin de  subst
		) ;_ Fin de  setq
	      ) ;_ Fin de  if
	   (draw_map map)
	   )
	  (T
	   (if (not (member 0 (mapcar 'cdr map)))
	     (setq loose T)
	     ) ;_ Fin de  if
	   )
	  ) ;_ Fin de  cond
	) ;_ Fin de  progn
      ) ;_ Fin de  if
    ) ;_ Fin de  while
  (if (not win)
    (alert "PERDU")
    ) ;_ Fin de  if
  (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)
    ) ;_ Fin de  foreach
  (foreach n '("C-U0" "C-U1" "C-U2" "C-U3" "C-D0" "C-D1" "C-D2" "C-D3")
    (set (read n) nil)
    ) ;_ Fin de  foreach
  (prin1)
  ) ;_ Fin de  defun