54 lines
1.5 KiB
EmacsLisp
54 lines
1.5 KiB
EmacsLisp
; Draw a sphere
|
|
|
|
(defun normalize (v)
|
|
"Normalize a vector."
|
|
(setq invlen (/ 1.0 (sqrt (dot v v))))
|
|
(mapcar (lambda (x) (* invlen x)) v))
|
|
|
|
(defun dot (v1 v2)
|
|
"Dot product of two vectors."
|
|
(+ (* (car v1) (car v2))
|
|
(* (cadr v1) (cadr v2))
|
|
(* (caddr v1) (caddr v2))))
|
|
|
|
(defun make-array (size)
|
|
"Create an empty array with size*size elements."
|
|
(setq m-array (make-vector size nil))
|
|
(dotimes (i size)
|
|
(setf (aref m-array i) (make-vector size 0)))
|
|
m-array)
|
|
|
|
(defun pic-lines (arr size)
|
|
"Turn array into a string."
|
|
(setq all "")
|
|
(dotimes (y size)
|
|
(setq line "")
|
|
(dotimes (x size)
|
|
(setq line (concat line (format "%i \n" (elt (elt arr y) x)))))
|
|
(setq all (concat all line "\n")))
|
|
all)
|
|
|
|
(defun pic-show (arr size)
|
|
"Convert size*size array to grayscale PBM image and show it."
|
|
(insert-image (create-image (concat (format "P2
|
|
%i %i 255\n" size size) (pic-lines arr size)) 'pbm t)))
|
|
|
|
(defun sphere (size k amb dir)
|
|
"Draw a sphere."
|
|
(let ((arr (make-array size))
|
|
(ndir (normalize dir))
|
|
(r (/ size 2)))
|
|
(dotimes (yp size)
|
|
(dotimes (xp size)
|
|
(setq x (- xp r))
|
|
(setq y (- yp r))
|
|
(setq z (- (* r r) (* x x) (* y y)))
|
|
(if (>= z 0)
|
|
(let* ((vec (normalize (list x y (sqrt z))))
|
|
(s (max 0 (dot vec ndir)))
|
|
(lum (max 0 (min 255 (* 255 (+ amb (expt s k))
|
|
(/ (1+ amb)))))))
|
|
(setf (elt (elt arr yp) xp) lum)))))
|
|
(pic-show arr size)))
|
|
|
|
(sphere 200 1.5 0.2 '(-30 -30 50))
|