#| -*- 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.

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

;;;; The definition of the Vista Library


;;;IMMEDIATE WISH LIST:  differential viewing control - pan, zoom...
;;;RELEASE 2 WISH LIST:  multi-map color mode




(defviceop INITIALIZE-DEVICE ()
  "Call this to initialize or reset a display device.
*** It must be called at least once prior to using the device. ??? ***")

; *** the structure of what this returns should be defined ***
(defviceop DEVICE-INFORMATION ()
  "Returns version information on device hardware, firmware and/or software.")

(defviceop FINISH ()
  "Waits until all pending commands have been executed.")


;---------------- Cursor ----------------

(defviceop SET-CURSOR-VISIBILITY (predicate)
  "Makes the cursor visible (while not inside macro DRAWING) or invisible.
Should not be used inside macro DRAWING, nor inside segments.")

(defviceop GET-CURSOR-VISIBILITY ()
  "Returns a predicate value.")


;-------------------- Color --------------------


(defviceop SET-COLOR (color-map-index)
  "Sets the color. Input is an integer.")

(defviceop GET-COLOR  ()
  "Returns the current color map index.")

(defviceop SET-MAP-COLOR (color-index red green blue)
  "Changes a single color map entry
to the specified RGB value.")

(defviceop GET-MAP-COLOR (color-index)
  "Returns the RED, GREEN, and BLUE components of a color map entry.")

(defviceop COLOR-MAP-SIZE ()
  "Returns two values:

   0) One greater than the highest color number that can be drawn
      on the screen at this time.  (May change when changing
      between single- and double-buffer modes.)

   1) The number of slots in the color map, which is one greater
      than the highest color map index that can be used with
      SET-MAP-COLOR or GET-MAP-COLOR.") 


;----------------- Points ---------------------

(defviceop POINT3 (x y z)
  "Draws a point in 3D.")

(defviceop POINT2 (x y)
  "Draws a point in 2D.")

(defviceop READ-POINT2 (x y)
  "Returns the color-index value at the point.")

(defviceop READ-POINT3 (x y z)
  "Returns the color-index value at the point.")


;------------------ Lines ---------------------

(defviceop LINE3 (x y z)
  "Draws a line from the current graphics
position to the specified 3D point.")

(defviceop LINE2 (x y)
  "Draws a line from the current graphics
position to the specified 2D point.")

(defviceop LINE-RELATIVE3 (dx dy dz)
  "Draws a 3D line from the current graphics
position to the point at the specified distances.")

(defviceop LINE-RELATIVE2 (dx dy)
  "Draws a 2D line from the current graphics
position to the point at the specified distances.")

(defviceop STROKE (x y)
  "brush stroke")

(defviceop MOVE3 (x y z)
  "Move to a specified point.")

(defviceop MOVE2 (x y)
  "Move to a specified 2D point.")

(defviceop MOVE-RELATIVE3 (dx dy dz))

(defviceop MOVE-RELATIVE2 (dx dy))

(defviceop GET-GRAPHICS-POS ()
  "Returns the current graphics position.")

;------------ Rectangles --------------

;;; rectangles can only be drawn in 2d

(defviceop RECTANGLE (x1 y1 x2 y2)
  "Draws a rectangle defined by the
corners X1 Y1 and X2 Y2.")

(defviceop FILL-RECTANGLE (x1 y1 x2 y2)
  "Draws a solid filled rectangle defined by the
corners X1 Y1 and X2 Y2.")

;(defviceop PATTERN-RECTANGLE (x1 y1 x2 y2))

;(defviceop ERASE-RECTANGLE (x1 y1 x2 y2)
;  "Erases the rectangle defined by the
;corners X1 Y1 and X2 Y2.")

;(defviceop INVERT-RECTANGLE (x1 y1 x2 y2)
;  "Inverts the filled rectangle defined by the
;corners X1 Y1 and X2 Y2. (what is the precise definition of this for color?)")



;----------- Arcs and Circles ----------

(defviceop ARC (x y radius start-angle  end-angle)
  "Draws a circular arc.")

(defviceop FILL-ARC (x y radius start-angle end-angle)
  "Draws a filled circular arc.")

(defviceop CIRCLE (x y radius)
  "Outlines a circle.")

(defviceop FILL-CIRCLE (x y radius)
  "Draws a filled circle.")

; *** stroke invert erase pattern ***
; *** ellipses...                 ***


;---------------- Polygons ---------------


(defviceop POLYGON (polygon)
  "Outlines a polygonal area. The argument
can be a 2D or 3D poly and either fixed or relative" )

(defviceop FILL-POLYGON (polygon)
  "Fills a 3D polygonal area.
Polygons should be convex." )

(defviceop SHADE-POLYGON (polygon shade-array)
  "Gouraud-shades a polygon.")

; *** stroke-polygon ***
; *** invert, erase ***
; *** pattern ***


;------------- Segments ------------

;;; segments are device dependant

(defviceop open-segment (keywords &key
				  (translatablep t)
				  (x 0)
				  (y 0)
				  (z 0)
				  (x-rotatablep t)
				  (x-rotation 0)
				  (y-rotatablep t)
				  (y-rotation 0)
				  (z-rotatablep t)
				  (z-rotation 0)
				  (scalablep t)
				  (x-scale 1.0)
				  (y-scale 1.0)
				  (z-scale 1.0)
				  (colorablep t)
				  (color 1))
  "Opens a segment.  All graphics commands until CLOSE-SEGMENT
will be put into the segment.")

(defviceop CLOSE-SEGMENT()
  "Closes the currently open segment. Returns the segment ID")

(defviceop CALL-SEGMENT (segment)
  "Draws an instance of a segment.")

(defviceop DELETE-SEGMENT (segment)
  "Deletes a segment.")

(defviceop SEGMENTP (segment)
  "Returns nil unless the device remembers the segment.")

(defviceop SET-SEGMENT-XYZ (segment x y z))

(defviceop SET-SEGMENT-X-ROTATION (segment x-rotation))

(defviceop SET-SEGMENT-Y-ROTATION (segment y-rotation))

(defviceop SET-SEGMENT-Z-ROTATION (segment z-rotation))

(defviceop SET-SEGMENT-SCALE (segment x-scale y-scale z-scale))

(defviceop SET-SEGMENT-COLOR (segment color))


;------ Modelling Transforms -------

;rename 4transform to transform
;(defmacro with-transform (&body body)
;  (unwind-protect (progn (push-transform) ,@body) (pop-transform)))
			 
(defviceop PUSH-TRANSFORM ()
  "Pushes down the transform stack, duplicating the current 
transform. The top copy can be modified.")

(defviceop POP-TRANSFORM ()
  "Pops the current transformation off the transform stack,
restoring the previous transform.")

(defviceop SET-TRANSFORM (transform)
  "Set the current transform.")

(defviceop GET-TRANSFORM ()
  "Returns (a copy of ????) the current transform.")


;;; Modifications to the current transform
; *** separate for x, y, z ??? ***

(defviceop ROTATE (angle axis)
  "Apply a rotation transformation.
ANGLE is in degrees.
AXIS is one of the keywords :X :Y or :Z")

(defviceop SCALE (x y z)
  "Shrink, expand and mirror objects.
X, Y, and Z specify the scaling of 
each coordinate.")

(defviceop TRANSLATE (x y z)
  "Relocates the model space origin to the
specified model space point.")


(defviceop TRANSFORM (transform)
  "Add an arbitrary transform to the current tranform.
The new transform comes before the previous transform.")


(defviceop TRANSFORM-POINT3 (x y z)
  "Returns the point transformed, with w.")

(defviceop TRANSFORM-POINT2 (x y)
  "Returns the point transformed, with z and w.")

; *** ???? ***
(defviceop TRANSFORM-POINT4 (x y z w)
  "Returns the point transformed.")


(defviceop REVERSE-TRANSFORM-POINT3 (screen-x screen-y)         
  "Maps a point on the screen into 3D world
coordinates. The world space line is returned
as two 3D points.")

(defviceop REVERSE-TRANSFORM-POINT2 (screen-x screen-y)       
  "Maps a point on the screen into 2D world coordinates.")


;--------- Viewing Transforms -------------

(defviceop VIEW (vx vy vz px py pz twist)
  "Defines the viewpoint and the reference point
on the line of sight in world coordinates.")

(defviceop POLAR-VIEW (distance azimuth increment twist)
  "Defines the viewer's position in polar coordinates.
DISTANCE, AZIMUTH, and INCREMENT define a viewpoint.
TWIST rotates the viewpoint.")


;------------- Perspective Transforms ---------------

;;; Note that the perspective transforms
;;; *load* the transformation matrix, not
;;; transform it.

(defviceop ORTHO2 (left right bottom top)
  "Specifies a box-shaped enclosure in the
eye coordinate system that will be mapped
to the viewport.")

(defviceop ORTHO3 (left right bottom top near far)
  "Specifies a box-shaped enclosure in the
eye coordinate system that will be mapped
to the viewport.")

(defviceop PERSPECTIVE (field-of-view-angle aspect-ratio near far) ;DISCUSS
  "Defines a projection transformation.
FIELD-OF-VIEW-ANGLE = Y direction
ASPECT-RATIO = field of view in X direction
NEAR = distance to the near clipping plane
FAR = distance to the far clipping plane")

(defviceop PERSPECTIVE-FRUSTUM (left right bottom top near far)
  "Specifies the position and size of a rectangular
viewing frustum in terms of the distance to the
surface closest to the eye. The image will be
projected with perspective onto the screen.")



;-------------- Viewport -------------

;;; *** A lot of this may need to be rethought/changed
;;; *** if we do windows/environments/...

(defviceop SET-VIEWPORT (viewport)
  "Allocates an area of the screen for an image.")

(defviceop GET-VIEWPORT ()
  "Returns the current viewport.")

(defviceop SCREEN-ASPECT-RATIO ()
  "Returns the aspect ratio of the device screen;
width/height measured in units of physicval linear
measure such as millimeters.")

(defviceop FILL-VIEWPORT ()
  "Sets the screen area within the current viewport to the
current color.")



;--------------- Double Buffering ----------------


(defviceop DOUBLE-BUFFER (&optional (enablep t))
  "Sets or clears double buffer mode.
In double buffer mode drawing always takes place in the back buffer.
The state of the buffers after changing double buffer mode is UNDEFINED.")

(defviceop DOUBLE-BUFFER-P ()
  "Returns T if double-buffering is on.")

(defviceop SWAP-BUFFERS ()
  "Swaps the back buffer into the front buffer in double buffer mode.
The state of the back buffer after a swap-buffers is UNDEFINED.  (Clear it.)")



;---------------- Text ----------------

;;; ***** to be thought out in more detail *****

(defviceop SET-TEXT-POS (x y)
  "Changes the current character position.
Two dimensions.")

(defviceop GET-TEXT-POS ()
  "Returns the current text position.")


(defviceop STRING-OUT (string)
  "Draws a string of text at the current
text position using a raster font.")

(defviceop CHAR-OUT (char)
  "Draws a character at the current
text position")

(defviceop STRING-WIDTH (string)
  "Returns the width of the string.")


(defviceop FONT-HEIGHT ()         ;Need ascent, descent etc...
  "Returns the maximum height of the  
characters in the current raster
font.")


#|||||||||||||||| DISCUSS THIS LATER -- TEXT ||||||||||||||||

(defviceop SET-FONT (font-number)
  "Selects a raster font to display text,
as done by the STRING-OUT or CHAR-OUT command.")

(defviceop GET-FONT ()
  "Returns the index of the currently selected
raster font.")

(defviceop DEFINE-RASTER-FONT (table-index height number-of-characters
		               character-array number-of-bytes raster-array)
  "Defines a raster font by its index, maximum height, number of characters,
an array of individual character descriptors, the number of bytes of
raster information, and an array of raster bit-map information.")


;(defviceop SET-TEXT-POS3 (x y z)
;  "Changes the current character position.")
; *** just do 2d text now ***

||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||#




;----------------- Mouse Handling ---------------

(defviceop MOUSE (predicate)
  "When non-nil, may usurp the mouse and operate it on the current display device
in a separate process.  When nil, returns mouse to normal.
Should not be used by users; use the macro WITH-VISTA-MOUSE.")

(defviceop MOUSEP ()
  "Tells whether the mouse is in vista mode.")

(defviceop GET-MOUSE-STATE ()
  "Returns a fixnum for the mouse buttons followed by 6 values for x, y and z
of the two points defining the line (in the world space defined by the current
transform) on which the mouse lies.  (Only the first 3 values should be used
in 2d; ignore the rest.)")

;; The next three may fall in the "only sometimes supported" category:

(defviceop MOUSE-CLICK-P ()
  "Predicate.  Tells whether there is an unread mouse click in the queue.")

(defviceop GET-MOUSE-CLICK (&optional waitp)
  "Reads a mouse click from the queue.  Returns nil if the queue is empty and
waitp is nil.  Otherwise returns 7 values like MOUSE-STATE which give the button
state and define the mouse position, at the click, in the coordinate system current
at the time called.")

(defviceop GET-LAST-MOUSE-CLICK ()
  "Returns 7 values like MOUSE-STATE which give the button state and define the
mouse position, at the click, in the coordinate system current at the time called.")


;--------------------- ?????? --------------

(defviceop BLANK-VIDEO (&optional (blankp t))
  "Controls whether display is occurring and thereby contending for
screen memory access.  Blank to speed up drawing, blitting, etc.")





#||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

*****************************************************************
			   These are for later
*****************************************************************


;----------- bitblt things --------------

;;; *** also runlength like rastek?


(defviceop WRITE-PIXELS (number-of-pixels color)
  "Paints a row of pixels on the screen.")

(defviceop READ-PIXELS (number-of-pixels)
  "Reads pixel values from the bitplanes. Returns 
the number of pixels read and an array of colors.")

(defviceop RGB-READ-PIXELS (number-of-pixels)
  "Reads pixel values in RGB mode from up to 24 bitplanes. Returns the 
number of pixels read and RGB values in RED, GREEN, and BLUE arrays.")


(defviceop RGB-WRITE-PIXELS (number-of-pixels red green blue)
  "Paints a row of pixels on the screen in RGB mode.")


(defviceop RECTCOPY (left bottom right top new-left new-bottom)
  "Blit between rectangles.")


;----------------- Z-Buffering ------------------

(defviceop SET-DEPTH (near far)
  "Sets the maximum near and far distances
for z-buffering")

(defviceop GET-DEPTH ()
  "Returns the two parameters of the
setdepth command: near and far.")

(defviceop Z-BUFFER-P ()
  "Returns T if z-buffering is on")

(defviceop Z-BUFFER (&optional (enable t))
  "Enables or disables z-buffering.")

(defviceop CLEAR-Z-BUFFER ()
  "Floods the z-buffer with the largest possible positive integer.")



;----------- Hardware Cursor Support ---------------


(defviceop SET-CURSOR-ORIGIN (cursor-table-index x y)
  "Specifies the alignment of a cursor glyph with
the cursor current point.")

(defviceop CURSOR-VISIBILITY (predicate)
  "Users of this library should hide the cursor during
drawing in single-buffer mode.")

(defviceop DEFINE-CURSOR-SHAPE (table-index cursor-bit-map)
  "Defines a cursor shape by its index
and a 16x16 bit map.")

(defviceop GET-CURSOR ()
  "Returns the index of the cursor glyph, color,
writemask, and a boolean indicating whether
the cursor is automatically displayed and 
updated by the system.")

(defviceop SET-CURSOR (glyph color writemask)
  "Sets the cursor characteristics.")




;------------ Patches and Curves, see Youcef --------------


(defviceop SET-PATCH-BASIS (uid vid)
  "Sets the current basis matrices.")

(defviceop SET-PATCH-PRECISION (usegments vsegments)
  "Sets precision at which curves are drawn.")

(defviceop PATCH (geomx geomy geomz)
  "Draws a surface patch.")

(defviceop SET-PATCH-N-CURVES (ucurves vcurves)
  "Sets the number of curves used to represent a patch.")

(defviceop SET-CURVE-BASIS (basis-matrix)
  "Sets the basis matrix used in drawing curves.")

(defviceop SET-CURVE-PRECISION (precision)
  "Sets the number of line segments comprising a curve segment.")

(defviceop CURVE (geom)
  "Draws a curve.")

(defviceop CURVES (number geom)
  "Draws a series of curve segments.")

(defviceop DEFINE-BASIS (id matrix)
  "Defines a basis matrix.")

(defviceop CURVE-ITERATE (iteration-count)
  "Draws a curve by iteration of the forward
differences of the matrix on top of the 
transformation stack.")






;------------- linestlye/texture ------------

; *** These should be superceded by the commands that set
; *** the parameters used by stroke

(defviceop DEFINE-LINESTYLE (table-index pattern)
  "Defines a linestyle by its index and
a 16 bit pattern. By default, index 0 
contains the pattern FFFF, which draws 
solid lines.")

(defviceop GET-LINESTYLE ()
  "Returns the current linestyle as
an index into the linestyle table.")

(defviceop GET-LINESTYLE-REPEAT ()     ;linestyle repeat may not be very universal.
  "Returns the linestyle repeat count.")

(defviceop SET-LINESTYLE-REPEAT (factor) ;linestyle repeat may not be very universal.
  "Sets magnification factor for linestyle.")

(defviceop SET-LINESTYLE (pattern)
  "Selects a linestyle pattern. The default
is SETLINESTYLE 0 (a solid line).")

(defviceop GET-LINEWIDTH ()
  "Returns the current linewidth in pixels.
A line can be one or two pixels wide.")

(defviceop SET-LINE-WIDTH (pixel-width)
  "Specifies whether lines are to be one or two pixels wide.")


(defviceop DEFINE-TEXTURE (texture-table-index bits-square-size array)
  "Defines the texture pattern at a given index in the texture table.")

(defviceop GET-TEXTURE ()
  "Returns the current texture table index.")

(defviceop SET-TEXTURE (texture-table-index)
  "Sets the current texture table index.")



;----------- Write Masks -----------

; *** This could slow down most drawing
; *** on hardware that doesn't support it

(defviceop SET-WRITE-MASK (writemask)
  "Grants write permission to available bitplanes.")

(defviceop GET-WRITE-MASK ()
  "Returns the current writemask as an
integer with up to twelve significant
bits, one for each bitplane.")



;-------------- RGB Mode -------------

;**** how do we handle rgb?

(defviceop SET-RGB-BIT (predicate)
  "Switches the display between color map mode and RGB mode.")

(defviceop SET-RGB-COLOR (red green blue)
  "Sets the current color in RGB mode.
RED, GREEN, and BLUE indicate the 
intensity of each primal color.")

(defviceop GET-RGB-COLOR ()
  "Returns the current RGB color values.")

(defviceop GET-RGB-CURSOR ()                ;DISCUSS
  "Returns the seven parameters of the last
RGBcursor command executed. These are:
INDEX, RED, GREEN, BLUE, REDM, GREENM,
and BLUEM.")

(defviceop GET-RGB-MASK ()
  "Returns the current RGB writemask as three
eight-bit masks, REM, GREENM, and BLUEM.")

(defviceop SET-RGB-CURSOR (index red green blue redm greenm bluem)
  "Picks a cursor, in RGB mode, from the user
defined table. INDEX specifies the cursor.
REDM, GREENM, and BLUEM specify the writemask.")



(defviceop SET-RGB-WRITE-MASK (red green blue)
  "Shields specified bitplanes from ordinary
drawing commands. RED, GREEN, and BLUE are
masks for each of the three sets of eight 
planes.")





||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||#

(defviceop call-with-locked-device (drawing-function)
  "Locks the device so that no other process can use it,
funcalls drawing-function with no arguments inside
that safe environment, and then releases the lock.
May also hide cursor, optionally blank video, etc.
Don't use this; use the macro DRAWING.")

(defviceop blank-video-while-drawing (predicate)
"Tells the device whether it should, if capable, blank the video
within the drawing macro (actually, within call-with-locked-device,
to which DRAWING is just a pretty interface).")