Draw a sphere: Difference between revisions

=={{header|Emacs Lisp}}==

{{trans|Go}}

<lang lisp>; 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))</lang>