www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs

couples-entiers.lisp (4155B)

      1 #|
      2 Auteur : John CHARRON
      3 email : charron.john@gmail.com
      4 |#
      5                                                                                 
      6 ;; définition des variables globales (toujours entre astérisques)
      7 (defvar *current* (list 0 0 0)) ;; liste courante (clé x y)
      8 (setf *current* (list 0 0 0)) 
      9 (defvar *db* nil) ;; base de données qui stocke tous les "(clé x y)"
     10 (setf *db* nil)
     11 (push *current* *db*)
     12 
     13 (defvar *max-x* 0) ;; valeur maximale de x jusque atteinte
     14 (setf *max-x* 0)
     15 (defvar *max-y* 0) ;; valeur maximale de y jusque atteinte
     16 (setf *max-y* 0)
     17 (defvar *min-x* 0) ;; valeur minimale de x atteinte
     18 (setf *min-x* 0) 
     19 (defvar *min-y* 0) ;; valeur minimale de y atteinte
     20 (setf *min-y* 0) 
     21 
     22 #| pour remettre toutes les variables globales à leur valeurs par défaut 
     23 afin de tester, de refaire un 'zig-zag', etc.
     24 |#
     25 (defun reset ()
     26   (progn
     27     (defvar *current* (list 0 0 0)) ;; liste courante (clé x y)
     28     (setf *current* (list 0 0 0))  
     29     (defvar *db* nil) ;; base de données qui stocke tous les "(clé x y)"
     30     (setf *db* nil)
     31     (push *current* *db*)
     32     (defvar *max-x* 0) ;; valeur maximal de x jusque "là"
     33     (setf *max-x* 0)
     34     (defvar *max-y* 0) ;; valeur maximal de y jusque "là"
     35     (setf *max-y* 0)
     36     (defvar *min-x* 0) ;; valeur minimale de x atteinte
     37     (setf *min-x* 0)
     38     (defvar *min-y* 0) ;; valeur minimale de y atteinte
     39     (setf *min-y* 0)
     40     *current*))
     41   
     42 #| Les fonctions "right" "down", "down", "up" imitent le movement des 
     43 coordonnées sur un graphe mais au les coordonnées "y" positifs sont en DESSOUS du graphe
     44 |#
     45 
     46 (defun right (L)
     47   (progn
     48     (push
     49       (setf *current*
     50         (cons (+ 1 (first L)) (cons (+ 1 (second L)) (last L)))) *db*)
     51     *current*))
     52   
     53 (defun left (L)
     54   (progn
     55     (push
     56       (setf *current*
     57         (cons (+ 1 (first L)) (cons (- (second L) 1) (last L)))) *db*)
     58     *current*))
     59 
     60 (defun up (L)
     61   (progn
     62     (push
     63       (setf *current*
     64         (cons (+ 1 (first L)) (cons (second L) (cons (+ (third L) 1) ())))) *db*)
     65     *current*))
     66     
     67 (defun down (L)
     68   (progn
     69 	(push
     70 	  (setf *current*
     71 	    (cons (+ 1 (first L)) (cons (second L) (cons (- (third L) 1) ())))) *db*)
     72     *current*))
     73 
     74 (defun update-max-x (L)
     75   (if (> (second L) *max-x*)
     76     (setf *max-x* (second L))
     77     nil))
     78 
     79 (defun update-max-y (L)
     80   (if (> (third L) *max-y*)
     81     (setf *max-y* (third L))
     82     nil))
     83 
     84 (defun update-min-x (L)
     85   (if (< (second L) *min-x*)
     86     (setf *min-x* (second L))
     87     nil))
     88 
     89 (defun update-min-y (L)
     90   (if (> (third L) *max-y*)
     91     (setf *min-y* (third L))
     92     nil))
     93 
     94 (defun print-all ()
     95   (print "*current*")
     96   (print *current*)
     97   (print "*max-x*: ~S")
     98   (print *max-x*))
     99 
    100 (defun update-all (L)
    101   (cond
    102    ((> (second L) *max-x*)
    103      (setf *max-x* (second L)))
    104     ((> (third L) *max-y*)
    105       (setf *max-y* (third L)))
    106     ((< (second L) *min-x*)
    107       (setf *min-x* (second L)))
    108     ((< (third L) *min-y*)
    109       (setf *min-y* (third L)))  
    110     (t ())))
    111 
    112 ;; "move" s'occupe de choisir "right", "down-left" etc. selon les valeurs dans *current*
    113 (defun move (L)
    114   (cond
    115     ((and (zerop (second L)) (zerop (third L))) ; if x== 0 && y==0 then go right TO BEGIN
    116       (print "in RIGHT")
    117        (right L))
    118     ((and (= *min-y* (- *max-y*)) (< (second L) (+ (- *min-x*) 1)))
    119       (print "in RIGHT")
    120       (right L))
    121     ((and (= *max-x* (+ (- *min-x*) 1)) (< (third L) (+ (- *min-y*) 1)))
    122       (print "in UP")
    123       (up L))
    124     ((and (= *max-y* (+ (- *min-y*) 1)) (> (second L) (- *max-x*)))
    125       (print "in LEFT")
    126       (left L))
    127     ((and (= *min-x* (- *max-x*)) (> (third L) (- *max-y*)))
    128       (print "in DOWN")
    129       (down L))
    130     (t *current*)
    131     ))
    132 
    133 
    134 #|
    135 On fait un "move" et puis un "update-max-x-y"
    136 Attention : il faut bien faire un setf L, sinon, le paramètre L de "update-max-x-y utilise la valeur
    137 de L inchangé !
    138 |#
    139 (defun move-and-update (L)
    140   (progn
    141     (setf L (move L))
    142     (update-all L)
    143     *db*))
    144 
    145 ;; "zig-zag" fait n "move-and-update" en un seul coup et affiche le contenu de *db* (toutes les couples) 
    146 (defun zig-zag (L n)
    147     (if (zerop n) 
    148       (move-and-update *current*)
    149       (progn
    150         (move-and-update *current*)
    151         (zig-zag L (- n 1)))))