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




;;;; WorldViewer

;;; Changes
;;; 08/09/85 PECANN  Created by Peter E. Cann, refined by/with Michael P. Grandfield
;;; 12/??/85 PECANN  Converted from camera-crane paradigm to hovercam then worldviewer
;;; 04/23/86 PECANN  split off demo to vista:demo;worldviewer-demo
;;; 05/07/86 PECANN  Control menu moved onto vista screen
;;; 06/11/86 PECANN  Adapted to viewport objects.
;;; 06/30/86 PECANN  Adapted to fractional viewports.



(export '(worldviewer-manager *worldviewer* set-vista run));


(defkind WORLDVIEWER-MANAGER vista-manager)

(definstancevars WORLDVIEWER-MANAGER
  (model-transform (make-transform))
  (inverse-camera-transform (make-transform))
  (delta-transform (make-transform))
  (inverse-delta-transform (make-transform))
  view
  selected-control
  (control (oneof 2d-vista
		  'components (list (oneof worldviewer-control
					   'obj-name 'model-roll-lt
					   'shape 'model-roll-lt
					   'x 46
					   'y 84
					   'colorable nil)
				    (oneof worldviewer-control
					   'obj-name 'model-pitch-up
					   'shape 'model-pitch-up
					   'x 139
					   'y 84
					   'colorable nil)
				    (oneof worldviewer-control
					   'obj-name 'model-yaw-lt
					   'shape 'model-yaw-lt
					   'x 232
					   'y 84
					   'colorable nil)
				    (oneof worldviewer-button
					   'obj-name 'reset
					   'shape 'reset
					   'x 325
					   'y 126
					   'colorable nil)
				    (oneof worldviewer-button
					   'obj-name 'exit
					   'shape 'exit
					   'x 325
					   'y 42
					   'colorable nil)
				    (oneof worldviewer-control
					   'obj-name 'zoom-in
					   'shape 'zoom-in
					   'x 418
					   'y 84
					   'colorable nil)
				    (oneof worldviewer-control
					   'obj-name 'mv-up
					   'shape 'mv-up
					   'x 511
					   'y 84
					   'colorable nil)
				    (oneof worldviewer-control
					   'obj-name 'mv-fd
					   'shape 'mv-fd
					   'x 604
					   'y 84
					   'colorable nil)
				    (oneof worldviewer-control
					   'obj-name 'mv-lt
					   'shape 'mv-lt
					   'x 697
					   'y 84
					   'colorable nil)
				    (oneof worldviewer-control
					   'obj-name 'roll-lt
					   'shape 'roll-lt
					   'x 790
					   'y 84
					   'colorable nil)
				    (oneof worldviewer-control
					   'obj-name 'pitch-up
					   'shape 'pitch-up
					   'x 883
					   'y 84
					   'colorable nil)
				    (oneof worldviewer-control
					   'obj-name 'yaw-lt
					   'shape 'yaw-lt
					   'x 976
					   'y 84
					   'colorable nil)
				    )
		  )
	   )
  )

(defobfun (EXIST WORLDVIEWER-MANAGER) (&rest args)
  (apply 'shadowed-exist args)
  (add-component control))

(defobfun (SET-VISTA WORLDVIEWER-MANAGER) (view-vista)
  (delete-component view)
  (add-component (setq view view-vista))
  (ask view (setq view-mode :transform)))


(defkind WORLDVIEWER-BUTTON 2d-visob)

(defobfun (HITP WORLDVIEWER-BUTTON) ()
  (multiple-value-bind (ignore mx my ignore ignore ignore ignore)
      (get-local-last-mouse-click)
    (and (< mx 40)
	 (> mx -40)
	 (< my 40)
	 (> my -40))))

(defobfun (RESET WORLDVIEWER-BUTTON) ()
  (set-color 6)
  (fill-circle 0 0 40)
  (set-color 0)
  (rectangle -20 -20 20 20)
  (move -30 0)
  (line 30 0)
  (move 0 -30)
  (line 0 30))

(defobfun (EXIT WORLDVIEWER-BUTTON) ()
  (set-color 6)
  (fill-circle 0 0 40)
  (set-color 0)
  (move -20 -20)
  (line 20 20)
  (move -20 20)
  (line 20 -20))

(defkind WORLDVIEWER-CONTROL 2d-visob)

(defobfun (HITP WORLDVIEWER-CONTROL) ()
  (multiple-value-bind (ignore mx my ignore ignore ignore ignore)
      (get-local-last-mouse-click)
    (and (< mx 40)
	 (> mx -40)
	 (< my 82)
	 (> my -82))))

(defobfun (VALUE WORLDVIEWER-CONTROL) ()
  (multiple-value-bind (ignore ignore my ignore ignore ignore ignore)
      (ask component-of (get-local-mouse-state))
    (max -1 (min 1 (/ (- my y) 82.0)))))

(defobfun (MODEL-ROLL-LT WORLDVIEWER-CONTROL) ()
  (set-color 6)
  (fill-rectangle -40 -82 40 82)
  (set-color 0)
  (move -35 0)
  (line 35 0)
  (arc 0 40 20 225 135)
  (move -14 54)
  (line -14 61)
  (move -14 54)
  (line -7 54)
  (arc 0 -40 20 225 135)
  (move -14 -54)
  (line -14 -61)
  (move -14 -54)
  (line -7 -54))

(defobfun (MODEL-PITCH-UP WORLDVIEWER-CONTROL) ()
  (set-color 6)
  (fill-rectangle -40 -82 40 82)
  (set-color 0)
  (move -35 0)
  (line 35 0)
  (arc 0 40 20 225 345)
  (arc 0 40 20 15 135)
  (move -14 54)
  (line -14 61)
  (move -14 54)
  (line -7 54)
  (move -30 40)
  (line 30 40)
  (arc 0 -40 20 225 345)
  (arc 0 -40 20 15 135)
  (move -14 -54)
  (line -14 -61)
  (move -14 -54)
  (line -9 -54)
  (move -30 -40)
  (line 30 -40))

(defobfun (MODEL-YAW-LT WORLDVIEWER-CONTROL) ()
  (set-color 6)
  (fill-rectangle -40 -82 40 82)
  (set-color 0)
  (move -35 0)
  (line 35 0)
  (arc 0 40 20 225 75)
  (arc 0 40 20 105 135)
  (move -14 54)
  (line -14 61)
  (move -14 54)
  (line -7 54)
  (move 0 70)
  (line 0 10)
  (arc 0 -40 20 225 75)
  (arc 0 -40 20 105 135)
  (move -14 -54)
  (line -14 -61)
  (move -14 -54)
  (line -9 -54)
  (move 0 -10)
  (line 0 -70))

(defobfun (ZOOM-IN WORLDVIEWER-CONTROL) ()
  (set-color 6)
  (fill-rectangle -40 -82 40 82)
  (set-color 0)
  (move -10 70)
  (line 0 10)
  (line 10 70)
  (move -35 0)
  (line 35 0)
  (move -30 -10)
  (line 0 -70)
  (line 30 -10))

(defobfun (MV-UP WORLDVIEWER-CONTROL) ()
  (set-color 6)
  (fill-rectangle -40 -82 40 82)
  (set-color 0)
  (move 0 -70)
  (line 0 -10)
  (move 0 10)
  (line 0 70)
  (line -5 65)
  (move 0 70)
  (line 5 65)
  (move -5 -65)
  (line 0 -70)
  (line 5 -65)
  (move -35 0)
  (line 35 0))

(defobfun (MV-FD WORLDVIEWER-CONTROL) ()
  (set-color 6)
  (fill-rectangle -40 -82 40 82)
  (set-color 0)
  (move -35 0)
  (line 35 0)
  (move -30 10)
  (line 30 70)
  (line 23 70)
  (move 30 70)
  (line 30 63)
  (move 30 -10)
  (line -30 -70)
  (line -30 -63)
  (move -30 -70)
  (line -23 -70))

(defobfun (MV-LT WORLDVIEWER-CONTROL) ()
  (set-color 6)
  (fill-rectangle -40 -82 40 82)
  (set-color 0)
  (move -35 0)
  (line 35 0)
  (move 30 40)
  (line -30 40)
  (line -25 35)
  (move -30 40)
  (line -25 45)
  (move -30 -40)
  (line 30 -40)
  (line 25 -35)
  (move 30 -40)
  (line 25 -45))

(defobfun (ROLL-LT WORLDVIEWER-CONTROL) ()
  (set-color 6)
  (fill-rectangle -40 -82 40 82)
  (set-color 0)
  (move -35 0)
  (line 35 0)
  (arc 0 40 20 225 135)
  (move -14 54)
  (line -14 61)
  (move -14 54)
  (line -7 54)
  (arc 0 -40 20 225 135)
  (move -14 -54)
  (line -14 -61)
  (move -14 -54)
  (line -7 -54))

(defobfun (PITCH-UP WORLDVIEWER-CONTROL) ()
  (set-color 6)
  (fill-rectangle -40 -82 40 82)
  (set-color 0)
  (move -35 0)
  (line 35 0)
  (arc 0 40 20 225 345)
  (arc 0 40 20 15 135)
  (move -14 54)
  (line -14 61)
  (move -14 54)
  (line -7 54)
  (move -30 40)
  (line 30 40)
  (arc 0 -40 20 225 345)
  (arc 0 -40 20 15 135)
  (move -14 -54)
  (line -14 -61)
  (move -14 -54)
  (line -9 -54)
  (move -30 -40)
  (line 30 -40))

(defobfun (YAW-LT WORLDVIEWER-CONTROL) ()
  (set-color 6)
  (fill-rectangle -40 -82 40 82)
  (set-color 0)
  (move -35 0)
  (line 35 0)
  (arc 0 40 20 225 75)
  (arc 0 40 20 105 135)
  (move -14 54)
  (line -14 61)
  (move -14 54)
  (line -7 54)
  (move 0 70)
  (line 0 10)
  (arc 0 -40 20 225 75)
  (arc 0 -40 20 105 135)
  (move -14 -54)
  (line -14 -61)
  (move -14 -54)
  (line -9 -54)
  (move 0 -10)
  (line 0 -70))


;;; MULTIPLICATION OF POINTS AND TRANSFORMS
;;;
;;;  X---> 00 01 02 03
;;;  Y---> 10 11 12 13
;;;  Z---> 20 21 22 23
;;;  W---> 30 31 32 33
;;;         |  |  |  |
;;;         V  V  V  V
;;;         X' Y' Z' W'


(defobfun (MODEL-YAW-LT WORLDVIEWER-MANAGER) (&aux spd)
  (do ()
      ((zerop (get-mouse-state)) (drawing (draw-self)))
    (let ((spd (* 30 (ask selected-control (value)))))
      (let ((sin (sind spd))
	    (cos (cosd spd)))
	(fill-transform delta-transform
			cos     0.0s0   (- sin) 0.0s0
			0.0s0   1.0s0   0.0s0   0.0s0
			sin     0.0s0   cos     0.0s0
			0.0s0   0.0s0   0.0s0   1.0s0)))
    (multiply-two-transforms model-transform delta-transform model-transform)
    (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
    (finish)					;hang until ready
    (drawing (draw-self))
    )
  )

(defobfun (MODEL-PITCH-UP WORLDVIEWER-MANAGER) (&aux spd)
  (do ()
      ((zerop (get-mouse-state)) (drawing (draw-self)))
    (let ((spd (* 30 (ask selected-control (value)))))
      (let ((sin (sind spd))
	    (cos (cosd spd)))
	(fill-transform delta-transform
			1.0s0   0.0s0   0.0s0   0.0s0
			0.0s0   cos     sin     0.0s0
			0.0s0   (- sin) cos     0.0s0
			0.0s0   0.0s0   0.0s0   1.0s0)))
    (multiply-two-transforms model-transform delta-transform model-transform)
    (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
    (finish)					;hang until ready
    (drawing (draw-self))
    )
  )

(defobfun (MODEL-ROLL-LT WORLDVIEWER-MANAGER) (&aux spd)
  (do ()
      ((zerop (get-mouse-state)) (drawing (draw-self)))
    (let ((spd (* 30 (ask selected-control (value)))))
      (let ((sin (sind spd))
	    (cos (cosd spd)))
	(fill-transform delta-transform
			cos     sin     0.0s0   0.0s0
			(- sin) cos     0.0s0   0.0s0
			0.0s0   0.0s0   1.0s0   0.0s0
			0.0s0   0.0s0   0.0s0   1.0s0)))
    (multiply-two-transforms model-transform delta-transform model-transform)
    (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
    (finish)					;hang until ready
    (drawing (draw-self))
    )
  )

(defobfun (ZOOM-IN WORLDVIEWER-MANAGER) (&aux spd)
  (do ()
      ((zerop (get-mouse-state)) (drawing (draw-self)))
    (let ((spd (* 9 (ask selected-control (value)))))
      (when (and (>= (- (ask view field-of-view) spd) 1)
		 (< (- (ask view field-of-view) spd) 180))
	(ask-funcall view 'set 'field-of-view (ask view (- field-of-view spd)))
	(finish)				;hang until ready
	(drawing (draw-self))
	)
      )
    )
  )

(defobfun (MV-FD WORLDVIEWER-MANAGER) (&aux spd)
  (do ()
      ((zerop (get-mouse-state)) (drawing (draw-self)))
    (let ((spd (* 90 (ask selected-control (value)))))
      (fill-transform delta-transform
		      1.0s0   0.0s0   0.0s0   0.0s0
		      0.0s0   1.0s0   0.0s0   0.0s0
		      0.0s0   0.0s0   1.0s0   0.0s0
		      0.0s0   0.0s0   (- spd) 1.0s0))
    (invert-transform delta-transform inverse-delta-transform)
    (multiply-two-transforms inverse-camera-transform inverse-delta-transform inverse-camera-transform)
    (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
    (finish)					;hang until ready
    (drawing (draw-self))
    )
  )

(defobfun (YAW-LT WORLDVIEWER-MANAGER) (&aux spd)
  (do ()
      ((zerop (get-mouse-state)) (drawing (draw-self)))
    (let ((spd (* 30 (ask selected-control (value)))))
      (let ((sin (sind spd))
	    (cos (cosd spd)))
	(fill-transform delta-transform
			cos     0.0s0   (- sin) 0.0s0
			0.0s0   1.0s0   0.0s0   0.0s0
			sin     0.0s0   cos     0.0s0
			0.0s0   0.0s0   0.0s0   1.0s0)))
    (invert-transform delta-transform inverse-delta-transform)
    (multiply-two-transforms inverse-camera-transform inverse-delta-transform inverse-camera-transform)
    (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
    (finish)					;hang until ready
    (drawing (draw-self))
    )
  )

(defobfun (MV-LT WORLDVIEWER-MANAGER) (&aux spd)
  (do ()
      ((zerop (get-mouse-state)) (drawing (draw-self)))
    (let ((spd (* 90 (ask selected-control (value)))))
      (fill-transform delta-transform
		      1.0s0   0.0s0   0.0s0   0.0s0
		      0.0s0   1.0s0   0.0s0   0.0s0
		      0.0s0   0.0s0   1.0s0   0.0s0
		      (- spd) 0.0s0   0.0s0   1.0s0))
    (invert-transform delta-transform inverse-delta-transform)
    (multiply-two-transforms inverse-camera-transform inverse-delta-transform inverse-camera-transform)
    (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
    (finish)					;hang until ready
    (drawing (draw-self))
    )
  )

(defobfun (PITCH-UP WORLDVIEWER-MANAGER) (&aux spd)
  (do ()
      ((zerop (get-mouse-state)) (drawing (draw-self)))
    (let ((spd (* 30 (ask selected-control (value)))))
      (let ((sin (sind spd))
	    (cos (cosd spd)))
	(fill-transform delta-transform
			1.0s0   0.0s0   0.0s0   0.0s0
			0.0s0   cos     sin     0.0s0
			0.0s0   (- sin) cos     0.0s0
			0.0s0   0.0s0   0.0s0   1.0s0)))
    (invert-transform delta-transform inverse-delta-transform)
    (multiply-two-transforms inverse-camera-transform inverse-delta-transform inverse-camera-transform)
    (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
    (finish)					;hang until ready
    (drawing (draw-self))
    )
  )

(defobfun (MV-UP WORLDVIEWER-MANAGER) (&aux spd)
  (do ()
      ((zerop (get-mouse-state)) (drawing (draw-self)))
    (let ((spd (* 90 (ask selected-control (value)))))
      (fill-transform delta-transform
		      1.0s0   0.0s0   0.0s0   0.0s0
		      0.0s0   1.0s0   0.0s0   0.0s0
		      0.0s0   0.0s0   1.0s0   0.0s0
		      0.0s0   spd     0.0s0   1.0s0))
    (invert-transform delta-transform inverse-delta-transform)
    (multiply-two-transforms inverse-camera-transform inverse-delta-transform inverse-camera-transform)
    (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
    (finish)					;hang until ready
    (drawing (draw-self))
    )
  )

(defobfun (ROLL-LT WORLDVIEWER-MANAGER) (&aux spd)
  (do ()
      ((zerop (get-mouse-state)) (drawing (draw-self)))
    (let ((spd (* 30 (ask selected-control (value)))))
      (let ((sin (sind spd))
	    (cos (cosd spd)))
	(fill-transform delta-transform
			cos     sin     0.0s0   0.0s0
			(- sin) cos     0.0s0   0.0s0
			0.0s0   0.0s0   1.0s0   0.0s0
			0.0s0   0.0s0   0.0s0   1.0s0)))
    (invert-transform delta-transform inverse-delta-transform)
    (multiply-two-transforms inverse-camera-transform inverse-delta-transform inverse-camera-transform)
    (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
    (finish)					;hang until ready
    (drawing (draw-self))
    )
  )

(defobfun (EXIT WORLDVIEWER-MANAGER) ()
  (throw 'done nil))

(defobfun (RESET WORLDVIEWER-MANAGER) ()
  (fill-transform model-transform
		   1 0 0 0
		   0 1 0 0
		   0 0 1 0
		   0 0 0 1)
  (fill-transform inverse-camera-transform
		  1 0 0 0
		  0 1 0 0
		  0 0 1 0
		  0 0 -1000 1)
  (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
  (drawing (draw-self)))

(defobfun (INITIALIZE WORLDVIEWER-MANAGER) ()
  (initialize-device)
  (fill-transform model-transform
		   1 0 0 0
		   0 1 0 0
		   0 0 1 0
		   0 0 0 1)
  (fill-transform inverse-camera-transform
		  1    0     0 0
		  0    1     0 0
		  0    0     1 0
		  0    0 -1000 1)
  (multiply-two-transforms model-transform inverse-camera-transform (ask view viewing-transform))
  (ask view (drawing (compile-self-rigid)))
  (ask control (drawing (compile-self-rigid)))
  )

(defobfun (RUN WORLDVIEWER-MANAGER) (&optional (initp t))
  (if initp (initialize))
  (setq double-buffer-p t)
  (let ((cvp (ask control viewport))
	(vvp (ask view viewport)))
    (setf (viewport-left cvp) 0)
    (setf (viewport-right cvp) 1)
    (setf (viewport-bottom cvp) 0)
    (setf (viewport-top cvp) .21875)
    (setf (viewport-left vvp) 0)
    (setf (viewport-right vvp) 1)
    (setf (viewport-bottom vvp) .21875)
    (setf (viewport-top vvp) 1))
  (ask control (set-ortho 0 1023 0 168))
  (ask view (set-perspective 20 (viewport-aspect-ratio viewport) 1.0s0 100000.0s0))
  (drawing
    (prep-device)
    (draw-self))
  (do () ((not (get-mouse-click))))
  (catch 'done
    (with-vista-mouse
      (do () (nil)
	(get-mouse-click t)
	(dolist (component (ask control components))
	  (when (ask component (hitp))
	    (setq selected-control component)
	    (funcall (ask component shape)); tricky: call the manager's function of same name as shape
	    (return))))))
  )

(defparameter *worldviewer* (oneof worldviewer-manager
				   'obj-name "System WorldViewer"))

(defdemo "WorldViewer" 'demo-worldviewer
  "A model-viewing tool."
  "VISTA:DEMO;WORLDVIEWER")

#+lispm
(defun demo-worldviewer(&aux fm)
  (format t "~&WorldViewer Demo.  Mouse the x to exit.")
  (unwind-protect
      (progn
	(when (typep (get-display-device) 'black&white)
	  (setq fm (b&w-fill-mode (get-display-device)))
	  (setf (b&w-fill-mode (get-display-device)) :solid))
	(drawing (initialize-device)
		 (set-map-color 8 .588 .49 .45))
	(ask *worldviewer*
	  (set-vista (if (typep (get-display-device) 'iris) *floor-monoliths-vista* *monoliths-vista*))
	  (run)))
    (when (typep (get-display-device) 'black&white)
      (setf (b&w-fill-mode (get-display-device)) fm)))
  (format t "~%"))

#-lispm
(defun demo-worldviewer()
  (format t "~&WorldViewer Demo.  Mouse the x to exit.")
  (drawing (initialize-device)
	   (set-map-color 8 .588 .49 .45))
  (ask *worldviewer*
    (set-vista *monoliths-vista*)
    (run))
  (format t "~%"))

;;; this is similar to draw-a-box from basic-drawing-demo
;;; it should go somewhere else???
(defun wire-parallelpiped (x1 y1 z1 x2 y2 z2)
  (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))

(defparameter *MONOLITHS-VISTA* (oneof 3d-vista
				       'components (list
						     (oneof 3d-visob
							    'shape '(wire-parallelpiped 0 0 0 24 54 6)
							    'color 6
							    'x 30
							    'y 1
							    'z 35
							    'obj-name "Small Cyan Monolith")
						     (oneof 3d-visob
							    'shape '(wire-parallelpiped 0 0 0 40 90 10)
							    'color 3
							    'x 1
							    'y 1
							    'z 1
							    'obj-name "Big Yellow Monolith"))
				       'obj-name "Monoliths"))


(defkind FLOOR 3d-visob)

(defclassvars FLOOR
  (tile (make-polygon :3d-absolute
		      0 0 0
		      24 0 0
		      24 0 24
		      0 0 24))
  (half-tile (make-polygon :3d-absolute
			   0 0 0
			   25 0 0
			   25 0 12
			   0 0 12)))

(defobfun (CHECKERBOARD FLOOR) (size)
  (do ((ix (- size) (1+ ix)))
      ((> ix size))
    (do ((iz (- size) (1+ iz)))
	((> iz size))
      (when (evenp (+ ix iz))
	(with-transform
	  (translate (* 25 ix) 0 (* 25 iz))
	  (fill-polygon tile))))
    (with-transform
      (translate (* 25 ix) 0 (- (* -25 size) 12))
      (fill-polygon half-tile))
    (with-transform
      (translate (* 25 ix) 0 (+ (* 25 size) 24))
      (fill-polygon half-tile)))
  (do ((iz (- size) (1+ iz)))
      ((> iz size))
    (with-transform
      (translate (* -25 size) 0 (* 25 iz))
      (rotate -90 :y)
      (fill-polygon half-tile))
    (with-transform
      (translate (+ (* 25 size) 36) 0 (* 25 iz))
      (rotate -90 :y)
      (fill-polygon half-tile)))
  (with-transform
    (translate (* size -25) 0 (- (* size -25) 12))
    (rotate -90 :y)
    (fill-polygon half-tile))
  (with-transform
    (translate (* size -25) 0 (+ (* size 25) 11))
    (rotate -90 :y)
    (fill-polygon half-tile))
  (with-transform
    (translate (+ 36 (* size 25)) 0 (- (* size -25) 12))
    (rotate -90 :y)
    (fill-polygon half-tile))
  (with-transform
    (translate (+ 36 (* size 25)) 0 (+ (* size 25) 11))
    (rotate -90 :y)
    (fill-polygon half-tile)))



(defvar *FLOOR-MONOLITHS-VISTA* (oneof 3d-vista
					 'components (list
						       (oneof 3d-visob
							      'shape '(wire-parallelpiped 0 0 0 24 54 6)
							      'x 30
							      'y 1
							      'z 35
							      'obj-name "Small Cyan Monolith"
							      'color 6)
						       (oneof 3d-visob
							      'shape '(wire-parallelpiped 0 0 0 40 90 10)
							      'x 1
							      'y 1
							      'z 1
							      'obj-name "Big Yellow Monolith"
							      'color 3)
						       (oneof floor
							      'shape '(checkerboard 10)
							      'obj-name "Floor"
							      'color 8))
					 'obj-name "Monoliths on Floor"))