Artifact c908cd681b97e9231e193b953bd7b113e955b181e50123eab611bd80e111aac5:

• File psl-1983/3-1/glisp/vector.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 6171) [annotate] [blame] [check-ins using] [more...]

% {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)