;;; avant de compiler chager la bibliotheque "imago" ;;; CL-USER> (ql:quickload "imago") ;;; pour simplifier travailler dans le package :zones ;;; CL-USER> (in-package :zones) (ou raccourci C-c M-p + nom package) ;;; ZONES> ;; pour sauver une zone dans un fichier ;; ZONES> (zone-to-png (zone-difference (make-disk 30) (make-disk 20)) 50 "anneau.png") ;;; le fichier sauve se trouve dans le repertoire courant reperable ;;; grace a la variable *default-pathname-defaults* ;;; ZONES> *default-pathname-defaults* ;;; #P"/nfs4/home4/idurand/Enseignement/PFS/TD-PFS/Zones/" ;;; visualiser l'image avec le viewer de votre choix (defpackage #:zones (:use #:common-lisp #:imago)) (in-package :zones) ;;; A zone is represented as a function that takes a point in 2-dimensional ;;; space as a parameter (represented as a complex number), and returns T ;;; if and only if the point is in the zone, and NIL otherwise. ;;; To determine whether a point is in a zone, just call this function (defun point-in-zone-p (point zone) (funcall zone point)) ;;; A zone that contains no points. A point is never in this zone. (defparameter +nowhere+ (lambda (p) (declare (ignore p)) nil)) ;;; Create a circular zone with center in (0,0) with the indicated radius. (defun make-disk (radius) (lambda (p) (<= (abs p) radius))) ;;; Given two zones, create a zone that behaves as the intersection of the two. (defun zone-intersection (zone1 zone2) (lambda (p) (and (point-in-zone-p p zone1) (point-in-zone-p p zone2)))) ;;; Given a zone, move it by a vector indicated as a complex number ;;; passed as the argument. (defun move-zone (zone vector) (lambda (p) (point-in-zone-p (- p vector) zone))) ;;; Given two zones, create a zone that behaves as the difference of the two. (defun zone-difference (zone1 zone2) (lambda (p) (and (point-in-zone-p p zone1) (not (point-in-zone-p p zone2))))) ;;; visualisation (defvar *nb-pixels-per-unit* 10) (defun int-to-nb-pixels (n) (* *nb-pixels-per-unit* n)) (defun pixel-to-float (x) (/ x *nb-pixels-per-unit*)) (defun pixel-to-point (px py) (complex (pixel-to-float px) (pixel-to-float py))) (defun zone-to-pixels (zone n) (loop with nb-pixels = (int-to-nb-pixels n) with pixels = (make-array (list nb-pixels nb-pixels) :element-type 'rgb-pixel :initial-element +black+) for x from 0 below nb-pixels do (loop for y from 0 below nb-pixels do (setf (aref pixels x y) (if (point-in-zone-p (pixel-to-point x y) zone) +red+ +white+))) finally (return (coerce pixels '(simple-array rgb-pixel (* *)))))) (defun pixels-to-png (pixels filename) (write-png (make-instance 'rgb-image :pixels pixels) filename)) (defun zone-to-png (zone n filename) (pixels-to-png (zone-to-pixels zone n) filename)) (defun random-point (z) (complex (random z) (random z))) (defun gruyere (n) (loop with zone = (make-disk 40) with disk = (make-disk 5) repeat n do (setq zone (zone-difference zone (move-zone disk (random-point 40)))) finally (return zone))) ;; (zone-to-png (gruyere 5) 50 "gruyere.png")