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

% {DSK}VECTOR.PSL;1  4-MAR-83 16:25:56 





(GLISPOBJECTS


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


(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 ARGTYPES (VECTOR))
	 (- VECTORDIFF OPEN T ARGTYPES (VECTOR))
	 (* VECTORTIMES OPEN T ARGTYPES (NUMBER))
	 (* VECTORDOTPRODUCT OPEN T ARGTYPES (VECTOR))
	 (/ VECTORQUOTIENT OPEN T ARGTYPES (NUMBER))
	 (> VECTORGREATERP OPEN T ARGTYPES (VECTOR))
	 (<= VECTORLEQP OPEN T ARGTYPES (VECTOR))
	 (_+ VECTORMOVE OPEN T ARGTYPES (VECTOR))
	 (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 28-FEB-83 16:03 
(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 28-FEB-83 16:04 
(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 10-FEB-83 13:41 
(DG VECTORPLUS (V1:VECTOR V2:VECTOR)
(A (TYPEOF V1)
   WITH X = V1:X + V2:X Y = V1:Y + V2:Y))


% GSN 10-FEB-83 13:41 
(DG VECTORDIFF (V1:VECTOR V2:VECTOR)
(A (TYPEOF V1)
   WITH X = V1:X - V2:X Y = V1:Y - V2:Y))


% GSN 10-FEB-83 13:42 
(DG VECTORDOTPRODUCT (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 10-FEB-83 13:41 
(DG VECTORTIMES (V:VECTOR N:NUMBER)
(A (TYPEOF V)
   WITH X = X*N Y = Y*N))


% GSN 10-FEB-83 13:42 
(DG VECTORQUOTIENT (V:VECTOR N:NUMBER)
(A (TYPEOF V)
   WITH X = X/N Y = Y/N))


% GSN 10-FEB-83 13:43 
(DG VECTORMOVE (V:VECTOR DELTA:VECTOR)
(V:X _+ DELTA:X)(V:Y _+ DELTA:Y)V)

 (PUT 'RECTANGLE
      'DRAWFN
      'DRAWRECT)