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

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


;;; really should be in vl-demo or some such

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


(defdemo "Basic Drawing Demo" 'basic-drawing-demo
  "A menu of simple 3d drawing demos")

(export '(BASIC-DRAWING-DEMO 100-RANDOM-CUBES SQUARE-SPIRAL))

(defconstant *DRAWING-DEMO-ALIST*
	  '(("ERASE"
	     :value (erase)
	     :font fonts:metsi)
	    ("Random Cubes"
	     :value (100-random-cubes)
	     :font fonts:mets)
	    ("Square Spiral"
	     :value (square-spiral)
	     :font fonts:mets)
	    ))


(defun BASIC-DRAWING-DEMO ()
  "Select a drawing demo from the menu"
  (3dbb-menu *drawing-demo-alist*
	     "  Select a demo, or exit to LISP and try functions  "))

(defun 3DBB-MENU (alist title-string)
  (setq alist (zl:sortcar (zl:copylist alist) #'string-lessp))
  (loop as choice = (tv:menu-choose alist title-string)
	 until (or (null choice)
		    (and (stringp (car choice))
			   (string-equal (car choice) "Quit")))
	 do
	 (if (eq (car choice) 'menu)
	     (vista-demo (cddr choice) (cadr choice))
	   (zl:catch-error-restart ((sys:abort error) "Terminate this demo.")
	     (eval choice)))))


(defun ERASE ()
  "Erases the 3dbb"
  (initialize-device)
  (set-color 0)
  (fill-viewport))

(defun draw-a-box (color x1 y1 z1 x2 y2 z2)
  (set-color color)
  (move x1 y1 z1)
  (line x1 y1 z2)
  (line x1 y2 z2)
  (line x1 y2 z1)
  (line x1 y1 z1)

  (move x2 y1 z1)
  (line x2 y1 z2)
  (line x2 y2 z2)
  (line x2 y2 z1)
  (line x2 y1 z1)

  (line x1 y1 z1)

  (move x1 y2 z1)
  (line x2 y2 z1)

  (move x1 y2 z2)
  (line x2 y2 z2)

  (move x1 y1 z2)
  (line x2 y1 z2))


(defun 100-RANDOM-CUBES
       (&optional (max-x 1000)			; (fixr (* (center-x) 2)))
	(max-y 500)				; (fixr (* (center-y) 2)))
	(max-z 1200))
  "Draw 100 randomly located and colored cubes in a cube 200? x 200? x 200?
placed 120? units from the viewer after erasing the screen."
  (initialize-device)
  (perspective 120 1.0 1.0 -10000.0)
  (do ((i 0 (1+ i))
       (x 0 (+ (random max-x) (- (/ max-x 2))))
       (y 0 (+ (random max-y) (- (/ max-y 2))))
       (z -750 (+ (random max-z) -1500.)))
      ((= i 100))
    (draw-a-box (1+ (random 7.)) x y z
		 (+ x 40.)
		 (+ y 40.)
		 (+ z 40.))))

  
(defun SQUARE-SPIRAL (&optional (x 0) (y -200) (z -2000))
  (initialize-device)
  (move x y z)					;move to starting point
  (do ((j 1 (+ 7 j))
       (z z (+ z 11)))
      ((> j 1024))
    (setq x (if (evenp j) (- x j) (+ x j)))
    (set-color 4)
    (line x y z)	
    (setq y (if (evenp j) (- y j) (+ y j)))
    (set-color 6)
    (line x y z)))