Artifact a469e8ec82640bd93b91791953801acc47e49fae41b6fe1525ba6c47d8d5a2cb:
- File
psl-1983/glisp/vector.old
— 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: 8009) [annotate] [blame] [check-ins using] [more...]
(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