101 lines
2.9 KiB
Common Lisp
101 lines
2.9 KiB
Common Lisp
(defun mandelbrot (x0 y0 scale)
|
|
(set-rotation 2)
|
|
(fill-screen)
|
|
(dotimes (y 240)
|
|
(let ((b0 (+ (/ (- y 120) 120 scale) y0)))
|
|
(dotimes (x 320)
|
|
(let* ((a0 (+ (/ (- x 160) 120 scale) x0))
|
|
(c 80) (a a0) (b b0) a2)
|
|
(loop
|
|
(setq a2 (+ (- (* a a) (* b b)) a0))
|
|
(setq b (+ (* 2 a b) b0))
|
|
(setq a a2)
|
|
(decf c)
|
|
(when (or (> (+ (* a a) (* b b)) 4) (zerop c)) (return)))
|
|
(draw-pixel x y (if (plusp c) (hsv (* 359 (/ c 80)) 1 1) 0)))))))
|
|
|
|
(defvar fern-cd
|
|
#2A((0 0 0 0.25 0 -0.14 0.02)
|
|
(0.85 0.02 -0.02 0.83 0 1.0 0.84)
|
|
(0.09 -0.28 0.3 0.11 0 0.6 0.07)
|
|
(-0.09 0.28 0.3 0.09 0 0.7 0.07)))
|
|
|
|
(defvar *width* 320)
|
|
(defvar *height* 360)
|
|
(defvar *factor* (/ *height* 7))
|
|
(defvar *x-offset* (/ *width* 2))
|
|
(defvar *y-offset* (/ *height* 24))
|
|
(defvar *dark-green* #b0000001111100000)
|
|
(defvar *fern* fern-cd)
|
|
|
|
(defun fn (n)
|
|
#'(lambda (x y)
|
|
(list (+ (* (aref *fern* n 0) x)
|
|
(* (aref *fern* n 1) y)
|
|
(aref *fern* n 4))
|
|
(+ (* (aref *fern* n 2) x)
|
|
(* (aref *fern* n 3) y)
|
|
(aref *fern* n 5)))))
|
|
|
|
(defun choose-transform ()
|
|
(let ((r (random 1.0)) (p 0))
|
|
(dotimes (i 4)
|
|
(when (<= r (incf p (aref *fern* i 6)))
|
|
(return (fn i))))))
|
|
|
|
(defun plot-pixel (x y)
|
|
(let ((xx (round (+ (* *factor* y) *y-offset*)))
|
|
(yy (round (- *width* (+ (* *factor* x) *x-offset*)))))
|
|
(draw-pixel xx yy *dark-green*)))
|
|
|
|
(defun fern (&optional (iterations 50000))
|
|
(fill-screen #xFFFF)
|
|
(let ((x 0) (y 0))
|
|
(dotimes (i iterations)
|
|
(plot-pixel x y)
|
|
(let ((xy (funcall (choose-transform) x y)))
|
|
(setq x (first xy))
|
|
(setq y (second xy))))))
|
|
|
|
(defun sierpinski (x0 y0 size gen)
|
|
(when (plusp gen)
|
|
(let ((s (ash size -1))
|
|
(n (1- gen)))
|
|
(fill-rect x0 y0 size size (col gen))
|
|
(sierpinski (+ x0 (ash s -1)) y0 s n)
|
|
(sierpinski x0 (+ y0 s) s n)
|
|
(sierpinski (+ x0 s) (+ y0 s) s n))))
|
|
|
|
(defun q (n)
|
|
(if (<= n 2) 1
|
|
(+
|
|
(q (- n (q (- n 1))))
|
|
(q (- n (q (- n 2)))))))
|
|
|
|
(defun speedup (fn)
|
|
(let ((c nil))
|
|
(lambda (x)
|
|
(or (cdr (assoc x c))
|
|
(let ((r (funcall fn x)))
|
|
(setq c (cons (cons x r) c))
|
|
r)))))
|
|
|
|
(setq q (speedup q))
|
|
|
|
(defun qplot (width height)
|
|
(fill-screen)
|
|
(let ((x0 0) (y0 0) x1 y1
|
|
(yellow #b1111111111100000)
|
|
(salmon #b1111110000010000))
|
|
(draw-line 10 (- height 10) (1- width) (- height 10))
|
|
(draw-line 10 (- height 10) 10 10)
|
|
(dotimes (n 6)
|
|
(draw-char 0 (- height (* n (truncate height 6)) 14) (code-char (+ n 48)) yellow))
|
|
(dotimes (n 10)
|
|
(draw-char (+ (* n (truncate width 10)) 12) (- height 7) (code-char (+ n 48)) yellow))
|
|
(dotimes (n width)
|
|
(setq x1 n y1 (q n))
|
|
(draw-line (+ x0 10) (- height y0 10) (+ x1 10) (- height y1 10) salmon)
|
|
(setq x0 x1 y0 y1))))
|
|
|