File psl-1983/glisp/vector.old artifact a469e8ec82 part of check-in ed4c581dbb


(FILECREATED "23-JAN-83 16:33:50" {DSK}VECTOR.LSP;9 7836   

      changes to:  (FNS VECTORMOVE)

      previous date: "14-JAN-83 12:45:52" {DSK}VECTOR.LSP;8)


(PRETTYCOMPRINT VECTORCOMS)

(RPAQQ VECTORCOMS ((GLISPOBJECTS DEGREES DOLPHINREGION GRAPHICSOBJECT RADIANS REGION RVECTOR SYMMETRY 
				 VECTOR)
	(FNS DRAWRECT GRAPHICSOBJECTMOVE NEWSTART NEWPOINT REGION-CONTAINS REGION-INTERSECT 
	     REGION-SETPOSITION REGION-UNION VECTORPLUS VECTORDIFF VECTORGREATERP VECTORLEQP 
	     VECTORTIMES VECTORQUOTIENT VECTORMOVE)
	(PROP DRAWFN RECTANGLE)))


[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 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
			  (QUOTE PAINT]
	   [ERASE ((APPLY* (GETPROP SHAPE 'DRAWFN)
			   self
			   (QUOTE 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))  )

(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)))
	   (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]  )
]

(DEFINEQ

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

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

(NEWSTART
  [GLAMBDA (START:VECTOR SIZE:VECTOR SYM:SYMMETRY)           (* edited: " 1-JAN-83 15:13")
                                                             (* Transform the starting point of an object as 
							     appropriate for the specified symmetry transform.)
	   (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 VECTOR WITH X = START:X+W Y = START:Y+H])

(NEWPOINT
  [GLAMBDA (START:VECTOR POINT:VECTOR SYM:SYMMETRY)          (* edited: " 1-JAN-83 15:12")
                                                             (* Transform a given relative POINT for specified 
							     symmetry transform.)
	   (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 VECTOR WITH X = START:X+W Y = START:Y+H])

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

(REGION-INTERSECT
  (GLAMBDA (P,Q:AREA)                                        (* edited: "23-SEP-82 10:44")
	   (RESULT AREA)                                     (* 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 _(AN AREA))
	         (IF XSIZE>0 AND YSIZE>0
		     THEN NEWAREA:LEFT_NEWLEFT
			  NEWAREA:BOTTOM_NEWBOTTOM
			  NEWAREA:WIDTH_XSIZE
			  NEWAREA:HEIGHT_YSIZE)
	         (RETURN NEWAREA))))

(REGION-SETPOSITION
  (GLAMBDA (AREA APOS:VECTOR NEWPOS:VECTOR)                  (* 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.)
	   (AREA:START _+
		       NEWPOS - APOS)))

(REGION-UNION
  (GLAMBDA (P,Q:AREA)                                        (* edited: "23-SEP-82 11:15")
	   (RESULT AREA)                                     (* 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 _(AN AREA))
	         (NEWAREA:LEFT_NEWLEFT)
	         (NEWAREA:BOTTOM_NEWBOTTOM)
	         (NEWAREA:WIDTH_XSIZE)
	         (NEWAREA:HEIGHT_YSIZE)
	         (RETURN NEWAREA))))

(VECTORPLUS
  (GLAMBDA (V1,V2:VECTOR)
	   (A VECTOR WITH X = V1:X + V2:X , Y = V1:Y + V2:Y)))

(VECTORDIFF
  (GLAMBDA (V1,V2:VECTOR)
	   (A VECTOR WITH X = V1:X - V2:X , Y = V1:Y - V2:Y)))

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

(VECTORLEQP
  (GLAMBDA (U:VECTOR V:VECTOR)                               (* GSN "14-JAN-83 12:31")
	   (U:X<=V:X AND U:Y<=V:Y)))

(VECTORTIMES
  (GLAMBDA (V:VECTOR N:NUMBER)
	   (A VECTOR WITH X = X*N , Y = Y*N)))

(VECTORQUOTIENT
  (GLAMBDA (V:VECTOR N:NUMBER)
	   (A VECTOR WITH X = X/N , Y = Y/N)))

(VECTORMOVE
  (GLAMBDA (V,DELTA:VECTOR)                                  (* GSN "23-JAN-83 16:28")
	   (V:X _+
		DELTA:X)
	   (V:Y _+
		DELTA:Y)
	   V))
)

(PUTPROPS RECTANGLE DRAWFN DRAWRECT)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2907 7772 (DRAWRECT 2917 . 3338) (GRAPHICSOBJECTMOVE 3340 . 3522) (NEWSTART 3524 . 4114
) (NEWPOINT 4116 . 4688) (REGION-CONTAINS 4690 . 5005) (REGION-INTERSECT 5007 . 5734) (
REGION-SETPOSITION 5736 . 6107) (REGION-UNION 6109 . 6799) (VECTORPLUS 6801 . 6898) (VECTORDIFF 6900
 . 6997) (VECTORGREATERP 6999 . 7289) (VECTORLEQP 7291 . 7427) (VECTORTIMES 7429 . 7516) (
VECTORQUOTIENT 7518 . 7608) (VECTORMOVE 7610 . 7770)))))
STOP


REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]