#| -*- Mode:LISP; Base: 10;
       Package:(VISTA-DEMO :use (VISTA OBJ 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 obj vista-library lisp))

(defdemo "Splotch" 'splotch-demo
  "does the splotch demo"
  "vista:demo;new-splotch")

(export '(SPLOTCH-DEMO
         ))

(defvar *all-splotches* nil)

(defkind splotch 3d-visob)

(definstancevars splotch
  (mass 0)
  (x-velocity 0)
  (y-velocity 0)
  (z-velocity 0)
  (time-till-split 0)
  )

(defobfun (exist splotch) (&rest args)
  (apply 'shadowed-exist args)
  (setq time-till-split (- 256 (+ mass (random mass))))
  (setq shape 'foo) 
  (setq color (1+ (random 7)))
  (setq scalablep nil
	colorablep t
	translatablep nil
	x-rotatablep nil
	y-rotatablep nil
	z-rotatablep nil)
  )

(defobfun foo ()
  ;(format t "~%~a ~a" (current-obj) (ask (current-obj) mass))
  (ask (current-obj)
    (fill-circle x y mass)))

(defobfun (tick splotch) ()
  (unless (zerop mass)
    ;(format t "~%~a tick ~a: [~a ~a ~a]" (current-obj) time-till-split x y z)
    (decf time-till-split)
    (when (<= time-till-split 0)
      ;	(remove-self-from-world)
      (setq mass (round (/ mass 2)))
      (let* ((dx (- 5 (random 5)))
	     (dy (- 5 (random 5)))
	     (dz 0) ;(- 5 (random 5)))
	     (new-me (oneof splotch 'mass mass
			            'x x 'y y 'z z
				    'x-velocity (- x-velocity dx)
				    'y-velocity (- y-velocity dy)
				    'z-velocity (- z-velocity dz))))
	;(ask new-me (compile-self-flexible))
	;(format t "~%~a splitting: [~a ~a ~a] ~a" (current-obj) dx dy dz mass)
	;(compile-self-flexible)
	(incf x-velocity dx)
	(incf y-velocity dy)
	(incf z-velocity dz)
	(nconc *all-splotches* (list new-me)))
      (setq time-till-split (- 256 (+ mass (random mass)))))
    (when (and (<= y 0) (< y-velocity 0))
      (setq y-velocity (* .97 (- y-velocity))))
    (when (or (and (<= x 0) (< x-velocity 0))
	      (and (>= x 1000) (> x-velocity 0))) 
      (setq x-velocity (* .97 (- x-velocity))))
    (decf y-velocity 1)
    ;(set-xyz (+ x x-velocity) (+ y y-velocity) (+ z z-velocity))
    (setq x (+ x x-velocity) y (+ y y-velocity) z (+ z z-velocity))
    (draw-self)
    )
  )

(defun splotch-demo ()
  (initialize-device)
  (double-buffer t)
;  (perspective 45 1.0 1.0 100000.0)
;  (view -10000 0 0 0 0 0 0)
  (ortho -100 1000 -100 1000)
  (setq *all-splotches* (list (oneof splotch 'mass 64 'x 10 'y 10 'x-velocity 10 'y-velocity 45)))
  ;(ask (car *all-splotches*) (compile-self-flexible))
  (do ()
	 ((read-char-no-hang))
    (set-color 0)
    (fill-viewport)
    (dolist (s *all-splotches*) 
      (ask s (tick)))
    (swap-buffers)))