(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))))