reduce-historical/psl-1983/glisp/vector.sl

% VECTOR.SL.3       28 Feb 83
% {DSK}VECTOR.PSL;1  5-FEB-83 15:48:43 





(GLISPOBJECTS


(DEGREES REAL
PROP    ((RADIANS (self* (3.1415926/180.0))
		  RESULT RADIANS)
	 (DISPLAYPROPS (T))))


(DOLPHINREGION (LIST (LEFT INTEGER)
		     (BOTTOM INTEGER)
		     (WIDTH INTEGER)
		     (HEIGHT INTEGER))
PROP    ((START (self)
		RESULT VECTOR)
	 (SIZE ((CDDR self))
	       RESULT VECTOR))
SUPERS  (REGION))


(GRAPHICSOBJECT (LIST (SHAPE ATOM)
		      (START VECTOR)
		      (SIZE VECTOR))
PROP    ((LEFT (START:X))
	 (BOTTOM (START:Y))
	 (RIGHT (LEFT+WIDTH))
	 (TOP (BOTTOM+HEIGHT))
	 (WIDTH (SIZE:X))
	 (HEIGHT (SIZE:Y))
	 (CENTER (START+SIZE/2))
	 (AREA (WIDTH*HEIGHT)))
MSG     ((DRAW ((APPLY* (GETPROP SHAPE 'DRAWFN)
			self
			'PAINT)))
	 (ERASE ((APPLY* (GETPROP SHAPE 'DRAWFN)
			 self
			 'ERASE)))
	 (MOVE GRAPHICSOBJECTMOVE OPEN T)))


(RADIANS REAL
PROP    ((DEGREES (self* (180.0/3.1415926))
		  RESULT DEGREES)
	 (DISPLAYPROPS (T))))


(REGION (LIST (START VECTOR)
	      (SIZE VECTOR))
PROP    ((LEFT (START:X))
	 (BOTTOM (START:Y))
	 (RIGHT (LEFT+WIDTH))
	 (TOP (BOTTOM+HEIGHT))
	 (WIDTH (SIZE:X))
	 (HEIGHT (SIZE:Y))
	 (CENTER (START+SIZE/2))
	 (TOPCENTER ((A VECTOR WITH X = LEFT+WIDTH/2 Y = TOP)))
	 (BOTTOMCENTER ((A VECTOR WITH X = LEFT+WIDTH/2 Y = BOTTOM)))
	 (AREA (WIDTH*HEIGHT)))
ADJ     ((EMPTY (WIDTH IS ZERO OR HEIGHT IS ZERO))
	 (ZERO (self IS EMPTY)))
MSG     ((CONTAINS? REGION-CONTAINS OPEN T)
	 (SETPOSITION REGION-SETPOSITION OPEN T)
	 (CENTEROFFSET REGION-CENTEROFFSET OPEN T)))


(RVECTOR (LIST (X REAL)
	       (Y REAL))
SUPERS  (VECTOR))


(SYMMETRY INTEGER
PROP    ((SWAPXY ((LOGAND self 4)
		  <>0))
	 (INVERTY ((LOGAND self 2)
		   <>0))
	 (INVERTX ((LOGAND self 1)
		   <>0))))


(VECTOR (LIST (X INTEGER)
	      (Y INTEGER))
PROP    ((MAGNITUDE ((SQRT X^2 + Y^2)))
	 (IMAGNITUDE ((FIX MAGNITUDE + .9999)))
	 (ANGLE ((ARCTAN2 Y X T))
		RESULT RADIANS)
	 (UNITVECTOR ((A RVECTOR WITH X = X/MAGNITUDE Y= Y/MAGNITUDE))))
ADJ     ((ZERO (X IS ZERO AND Y IS ZERO))
	 (NORMALIZED (MAGNITUDE = 1.0)))
MSG     ((+ VECTORPLUS OPEN T)
	 (- VECTORDIFF OPEN T)
	 (* VECTORTIMES OPEN T)
	 (/ VECTORQUOTIENT OPEN T)
	 (> VECTORGREATERP OPEN T)
	 (<= VECTORLEQP OPEN T)
	 (_+ VECTORMOVE OPEN T)
	 (PRIN1 ((PRIN1 "(")
		 (PRIN1 X)
		 (PRIN1 ",")
		 (PRIN1 Y)
		 (PRIN1 ")")))
	 (PRINT ((_ self PRIN1)
		 (TERPRI)))))

)



% edited: 11-JAN-82 12:40 
(DG DRAWRECT ((A GRAPHICSOBJECT)
 DSPOP:ATOM)
(PROG (OLDDS)
      (OLDDS _ (CURRENTDISPLAYSTREAM DSPS))
      (DSPOPERATION DSPOP)
      (MOVETO LEFT BOTTOM)
      (DRAWTO LEFT TOP)
      (DRAWTO RIGHT TOP)
      (DRAWTO RIGHT BOTTOM)
      (DRAWTO LEFT BOTTOM)
      (CURRENTDISPLAYSTREAM OLDDS)))


% edited: 11-JAN-82 16:07 
(DG GRAPHICSOBJECTMOVE (self:GRAPHICSOBJECT DELTA:VECTOR)
(_ self ERASE)(START _+ DELTA)(_ self DRAW))


% GSN 30-JAN-83 15:44 
% Transform the starting point of an object as appropriate for the 
%   specified symmetry transform. 
(DG NEWSTART (START:VECTOR SIZE:VECTOR SYM:SYMMETRY)
(PROG (W H TMP)
      (W_SIZE:X)
      (H_SIZE:Y)
      (IF SYM:SWAPXY THEN TMP_W W_H H_TMP)
      (IF ~SYM:INVERTY THEN H_0)
      (IF ~SYM:INVERTX THEN W_0)
      (RETURN (A (TYPEOF START)
		 WITH X = START:X+W Y = START:Y+H))))


% GSN 30-JAN-83 15:44 
% Transform a given relative POINT for specified symmetry transform. 
(DG NEWPOINT (START:VECTOR POINT:VECTOR SYM:SYMMETRY)
(PROG (W H TMP)
      (W_POINT:X)
      (H_POINT:Y)
      (IF SYM:SWAPXY THEN TMP_W W_H H_TMP)
      (IF ~SYM:INVERTY THEN H _ - H)
      (IF ~SYM:INVERTX THEN W _ - W)
      (RETURN (A (TYPEOF POINT)
		 WITH X = START:X+W Y = START:Y+H))))


% GSN  2-FEB-83 14:00 
(DG REGION-CENTEROFFSET (R:REGION V:VECTOR)
(A (TYPEOF V)
   WITH X = (R:WIDTH - V:X)
   /2 Y = (R:HEIGHT - V:Y)
   /2))


% edited: 26-OCT-82 11:45 
% Test whether an area contains a point P. 
(DG REGION-CONTAINS (AREA P)
(P:X>=AREA:LEFT AND P:X<=AREA:RIGHT AND P:Y>=AREA:BOTTOM AND P:Y<=AREA:TOP))


% GSN 30-JAN-83 15:45 
(DG REGION-INTERSECT (P:AREA Q:AREA)
(RESULT (TYPEOF P))
% Produce an AREA which is the intersection of two given AREAs. 
(PROG (NEWBOTTOM NEWLEFT NEWAREA XSIZE YSIZE)
      (NEWBOTTOM _ (IMAX P:BOTTOM Q:BOTTOM))
      (YSIZE _ (IMIN P:TOP Q:TOP)
	     - NEWBOTTOM)
      (NEWLEFT _ (IMAX P:LEFT Q:LEFT))
      (XSIZE _ (IMIN P:RIGHT Q:RIGHT)
	     - NEWLEFT)
      (NEWAREA _ (A (TYPEOF P)))
      (IF XSIZE>0 AND YSIZE>0 THEN NEWAREA:LEFT_NEWLEFT 
	  NEWAREA:BOTTOM_NEWBOTTOM NEWAREA:WIDTH_XSIZE NEWAREA:HEIGHT_YSIZE)
      (RETURN NEWAREA)))


% GSN 14-JAN-83 11:52 
% Change the START point of AREA so that the position APOS relative to 
%   the area will have the position NEWPOS. 
(DG REGION-SETPOSITION (AREA APOS:VECTOR NEWPOS:VECTOR)
(AREA:START _+ NEWPOS - APOS))


% GSN 30-JAN-83 15:46 
(DG REGION-UNION (P:AREA Q:AREA)
(RESULT (TYPEOF P))% Produce an AREA which is the union of two given AREAs. 
(PROG (NEWBOTTOM NEWLEFT XSIZE YSIZE NEWAREA)
      (NEWBOTTOM _ (IMIN P:BOTTOM Q:BOTTOM))
      (YSIZE _ (IMAX P:TOP Q:TOP)
	     - NEWBOTTOM)
      (NEWLEFT _ (IMIN P:LEFT Q:LEFT))
      (XSIZE _ (IMAX P:RIGHT Q:RIGHT)
	     - NEWLEFT)
      (NEWAREA _ (A (TYPEOF P)))
      (NEWAREA:LEFT_NEWLEFT)
      (NEWAREA:BOTTOM_NEWBOTTOM)
      (NEWAREA:WIDTH_XSIZE)
      (NEWAREA:HEIGHT_YSIZE)
      (RETURN NEWAREA)))


% GSN 30-JAN-83 15:36 
(DG VECTORPLUS (V1:VECTOR V2:VECTOR)
(A (TYPEOF V1)
   WITH X = V1:X + V2:X Y = V1:Y + V2:Y))


% GSN 30-JAN-83 15:47 
(DG VECTORDIFF (V1:VECTOR V2:VECTOR)
(A (TYPEOF V1)
   WITH X = V1:X - V2:X Y = V1:Y - V2:Y))


% GSN 14-JAN-83 12:33 
% This version of > tests whether one box will fit inside the other. 
(DG VECTORGREATERP (U:VECTOR V:VECTOR)
(U:X>V:X OR U:Y>V:Y))


% GSN 14-JAN-83 12:31 
(DG VECTORLEQP (U:VECTOR V:VECTOR)
(U:X<=V:X AND U:Y<=V:Y))


% GSN 30-JAN-83 15:47 
(DG VECTORTIMES (V:VECTOR N:NUMBER)
(A (TYPEOF V)
   WITH X = X*N Y = Y*N))


% GSN 30-JAN-83 15:47 
(DG VECTORQUOTIENT (V:VECTOR N:NUMBER)
(A (TYPEOF V)
   WITH X = X/N Y = Y/N))


% GSN 23-JAN-83 16:28 
(DG VECTORMOVE (V:VECTOR DELTA:VECTOR)
(V:X _+ DELTA:X)(V:Y _+ DELTA:Y)V)

 (PUT 'RECTANGLE
      'DRAWFN
      'DRAWRECT)