#| -*- Mode:LISP; Base:10;
       Package: (VISTA-DEMO :use (VISTA-LIBRARY LISP));
       Syntax: Common-lisp; Readtable: CL -*-
|#

;;; Copyright (C) Lisp Machine, Inc. 1984, 1985, 1986
;;;   See filename "Copyright" for
;;; licensing and release information.


(in-package 'vista-demo :use '(vista-library lisp))

(defdemo "Tree" 'tree
  "Draw a Tree"
  "vista:demo;tree")

(export '(TREE					;Draws a tree
         ))


;;;; Tree
;;; Draws a 3 dimensional tree, with options.
;;; This is a less fancy version of Mike Travers' TWEE
;;; that runs in the Vista Library.


;;; Make a segment which is a truncated cone
(defun make-trunc-cone-segment (length bottom-radius top-radius &optional (n-sides 10.))
  (let* ((angle (/ 360. n-sides))
	 (side (make-polygon :3d-absolute
		  bottom-radius 0 0
		  (* bottom-radius (cosd angle)) 0 (* bottom-radius (sind angle))
		  (* top-radius (cosd angle)) length (* top-radius (sind angle))
		  top-radius length 0)))
    (make-segment (:colorablep nil :scalablep nil :translatablep nil
		   :x-rotatablep nil :y-rotatablep nil :z-rotatablep nil)
      (dotimes (i n-sides)
	(fill-polygon side)
	(rotate angle :y)))))



;;; Draw a branch and recursively its sub-branches
(defun climb (levels scale-factor trunc-cone-segment length div-angle nbranch
	      sc sr sg sb  &aux ec er eg eb)
  (when (read-char-no-hang) (throw 'finito nil))
  (setq ec (+ sc 16))
  (set-color sc)
  (call-segment trunc-cone-segment)
  (unless (zerop levels)
    (with-transform
      (translate 0 length 0)
      (scale scale-factor scale-factor scale-factor)
      (rotate div-angle :x)
      (do ((dtheta (/ 360 nbranch))
	   (n 0 (1+ n)))
	  ((= n nbranch))
	(climb (1- levels) scale-factor trunc-cone-segment length div-angle nbranch ec er eg eb)
	(rotate (- div-angle) :x)
	(rotate dtheta :y)
	(rotate div-angle :x)))))



(defun tree (&key (levels 5) (length 120) (thickness 10) (divergence 45) (branch-factor 3) (scale-factor .75) (init t))
  "Draw a Tree, with options:
:LEVELS of branching        :LENGTH of branches
:THICKNESS of branches      :DIVERGENCE angle of branches
:BRANCH-FACTOR number of branches at each branching
:SCALE-FACTOR that sub-branches shrink by"
  (if init (initialize-device))
  (set-color 0) (set-map-color 0 .72 .72 .75) (fill-viewport)
  (shade-colors 1 (random 1.0s0) (random 1.0s0) (random 1.0s0)
		100 (random 1.0s0) (random 1.0s0) (random 1.0s0))
  (perspective 30 .8 0 10000)
  (tree-1 levels length thickness divergence branch-factor scale-factor)
  (frob-colors))


;;; Draw a tree, no setup.
(defun tree-1 (levels length thickness divergence branch-factor scale-factor)
  (clear-input)
  (catch 'finito
    (let ((seg (make-trunc-cone-segment length thickness (* .8 thickness)))) 
      (with-transform
	(polar-view 1000 0 0 0)
	(translate 0 -200 0)			;down a bit
	(rotate 40 :y)				;twisted a bit to break symmetry
	(climb levels scale-factor seg length divergence branch-factor 1 200 200 200 )))))