(FILECREATED " 6-Jun-86 12:12:54" {QV}<PEDERSEN>LISP>SCATMATRIX.;7 35186
changes to: (FNS ACTIVATEWINDOWMATRIX BUILDPOINTSLIST DRAWLINEBRUSH GETNEWLINEBRUSH SCATMAT
BUILDWINDOWMATRIX EXTENTOFMATRIX LABELWINDOWMATRIX)
previous date: "19-May-86 12:01:41" {QV}<PEDERSEN>LISP>SCATMATRIX.;6)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SCATMATRIXCOMS)
(RPAQQ SCATMATRIXCOMS ((RECORDS LINEBRUSH SCATMATBRUSH SCATMATPOINT)
(MACROS SCATMATDRAWBRUSH SCATMATINSIDEP SCATMATMODIFYBRUSH SELECTCOORD)
(FNS ACTIVATEWINDOWMATRIX BUILDLINEBRUSH BUILDPOINTSLIST BUILDRECTBRUSH BUILDWINDOWMATRIX
DRAWLINEBRUSH DRAWRECTBRUSH EXTENTOFMATRIX GETNEWLINEBRUSH INSIDELINEBRUSH
INSIDERECTBRUSH LABELWINDOWMATRIX MAKE-IRIS MODIFYLINEBRUSH MODIFYRECTBRUSH NEWRECTBRUSH
SCATFIREPOINTS SCATMAT SCATMATACQUIREBRUSH SCATMATNEWBRUSH SCATMATBUILDPILOTBBT
SCATMATDRAWREGION SCATMATESTABLISHMODE SCATMATPOLLPOINTS SCATMATRELEASEBRUSH
SCATMATRIGHTBUTTONFN SCATMATSIZEWINDOW SHOWHIGHLIGHTED SHOWLOWLIGHTED SHOWPOINT
SCATMATBUTTONEVENTFN SELECTCOORD)
(VARS CIRCLE CROSS IRISCOLLABELLIST IRISLIST IRISROWLABELLIST)
(VARS (BRUSH NIL)
(POINTSLIST NIL))
(CURSORS SCATMATSMALLCURSOR)))
[DECLARE: EVAL@COMPILE
(DATATYPE LINEBRUSH (A B C))
(DATATYPE SCATMATBRUSH (DRAWFN MODIFYFN INSIDEFN NEWFN HORIZCOORD VERTCOORD CURRENTMODE BRUSHDATA))
(DATATYPE SCATMATPOINT (COORDINATES DESTINATIONSCACHE STATUS PERSISTENT? INSIDEP))
]
(/DECLAREDATATYPE (QUOTE LINEBRUSH)
(QUOTE (POINTER POINTER POINTER))
(QUOTE ((LINEBRUSH 0 POINTER)
(LINEBRUSH 2 POINTER)
(LINEBRUSH 4 POINTER)))
(QUOTE 6))
(/DECLAREDATATYPE (QUOTE SCATMATBRUSH)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((SCATMATBRUSH 0 POINTER)
(SCATMATBRUSH 2 POINTER)
(SCATMATBRUSH 4 POINTER)
(SCATMATBRUSH 6 POINTER)
(SCATMATBRUSH 8 POINTER)
(SCATMATBRUSH 10 POINTER)
(SCATMATBRUSH 12 POINTER)
(SCATMATBRUSH 14 POINTER)))
(QUOTE 16))
(/DECLAREDATATYPE (QUOTE SCATMATPOINT)
(QUOTE (POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((SCATMATPOINT 0 POINTER)
(SCATMATPOINT 2 POINTER)
(SCATMATPOINT 4 POINTER)
(SCATMATPOINT 6 POINTER)
(SCATMATPOINT 8 POINTER)))
(QUOTE 10))
(DECLARE: EVAL@COMPILE
(PUTPROPS SCATMATDRAWBRUSH MACRO (OPENLAMBDA (BRUSH WINDOW)
(* jop: "19-May-86 10:04")
(APPLY* (ffetch (SCATMATBRUSH DRAWFN)
of BRUSH)
BRUSH WINDOW)))
(PUTPROPS SCATMATINSIDEP MACRO (OPENLAMBDA (BRUSH X Y)
(* jop: "19-May-86 10:05")
(* *)
(APPLY* (ffetch (SCATMATBRUSH INSIDEFN)
of BRUSH)
BRUSH X Y)))
(PUTPROPS SCATMATMODIFYBRUSH MACRO (OPENLAMBDA (BRUSH X Y)
(* jop: "19-May-86 10:03")
(* *)
(APPLY* (ffetch (SCATMATBRUSH MODIFYFN)
of BRUSH)
BRUSH X Y)))
[PUTPROPS SELECTCOORD DMACRO (OPENLAMBDA (POINT COORDINATE)
(CAR (FNTH (ffetch (SCATMATPOINT COORDINATES)
of POINT)
COORDINATE]
)
(DEFINEQ
(ACTIVATEWINDOWMATRIX
[LAMBDA (WINDOWMATRIX) (* jop: " 6-Jun-86 12:02")
(* * comment)
(bind WINDOW for I from 0 to (SUB1 (ARRAY-DIMENSION WINDOWMATRIX 0))
do (for J from 0 to (SUB1 (ARRAY-DIMENSION WINDOWMATRIX 1))
unless (EQ I J)
do (SETQ WINDOW (AREF WINDOWMATRIX I J))
(WINDOWPROP WINDOW (QUOTE HORIZCOORD)
(ADD1 J))
(WINDOWPROP WINDOW (QUOTE VERTCOORD)
(ADD1 I))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION SCATMATBUTTONEVENTFN))
(WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN)
(FUNCTION SCATMATRIGHTBUTTONFN))
(WINDOWADDPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W)
(DECLARE (GLOBALVARS CURRENTBRUSH OLDBRUSH POINTSLIST))
(SETQ CURRENTBRUSH NIL)
(SETQ OLDBRUSH NIL)
(SETQ POINTSLIST NIL])
(BUILDLINEBRUSH
[LAMBDA (A B C MODE) (* jop: "19-May-86 10:46")
(* * comment)
(create SCATMATBRUSH
BRUSHDATA ← (create LINEBRUSH
A ← A
B ← B
C ← C)
CURRENTMODE ← (OR MODE (QUOTE HIGHLIGHT))
DRAWFN ← (FUNCTION DRAWLINEBRUSH)
MODIFYFN ← (FUNCTION MODIFYLINEBRUSH)
INSIDEFN ← (FUNCTION INSIDELINEBRUSH)
NEWFN ← (FUNCTION GETNEWLINEBRUSH])
(BUILDPOINTSLIST
[LAMBDA (MATRIX SCALEDATA SYMBOL WINDOWMATRIX) (* jop: " 6-Jun-86 12:02")
(* * comment)
(LET* [(ENTRYCURSOR (CURSOR WAITINGCURSOR))
(N (ARRAY-DIMENSION MATRIX 0))
(P (ARRAY-DIMENSION MATRIX 1))
(MARGIN (FIXR (QUOTIENT (IMAX (BITMAPHEIGHT SYMBOL)
(BITMAPWIDTH SYMBOL))
2.0)))
(MAXEXTENT (DIFFERENCE (SCATMATSIZEWINDOW P)
(ITIMES 2 MARGIN)))
(PLST (for I from 0 to (SUB1 N)
collect (create SCATMATPOINT
COORDINATES ←
[for J from 0 to (SUB1 P) as Extent in SCALEDATA
collect (PLUS
MARGIN
(FIX (TIMES MAXEXTENT
(QUOTIENT
(DIFFERENCE (AREF MATRIX
I J)
(CAR Extent))
(DIFFERENCE (CDR Extent)
(CAR Extent]
STATUS ← (QUOTE OFF]
(bind COORDINATES for POINT in PLST
do (* N.B. The row I column J window displays coordinate
J on its horizontal axis and coordinate I on its
vertical axis!)
(SETQ COORDINATES (fetch (SCATMATPOINT COORDINATES) of POINT))
[replace DESTINATIONSCACHE of POINT
with (for I from 0 to (SUB1 P) as ICOORD in COORDINATES
join (for J from 0 to (SUB1 P) as JCOORD in COORDINATES
when (NOT (EQ I J))
collect (SCATMATBUILDPILOTBBT SYMBOL
(AREF WINDOWMATRIX I J)
(IDIFFERENCE JCOORD
MARGIN)
(IPLUS ICOORD MARGIN]
(* N.B. The row I column J window displays coordinate
J on its horizontal axis and coordinate I on its
vertical axis!)
) (* The BACKGROUNDDESTINATION requires that the
destination bitmaps not be moved.
Someday we will provide the necessary recalculation)
(WINDOWPROP (AREF WINDOWMATRIX 0 0)
(QUOTE MOVEFN)
(QUOTE DON'T))
(CURSOR ENTRYCURSOR)
PLST])
(BUILDRECTBRUSH
[LAMBDA (WIDTH HEIGHT MODE) (* jop: "19-May-86 10:26")
(* * comment)
(create SCATMATBRUSH
BRUSHDATA ← (CREATEREGION 0 0 WIDTH HEIGHT)
CURRENTMODE ← (OR MODE (QUOTE HIGHLIGHT))
DRAWFN ← (FUNCTION DRAWRECTBRUSH)
MODIFYFN ← (FUNCTION MODIFYRECTBRUSH)
INSIDEFN ← (FUNCTION INSIDERECTBRUSH)
NEWFN ← (FUNCTION NEWRECTBRUSH])
(BUILDWINDOWMATRIX
[LAMBDA (P) (* jop: "15-May-86 20:51")
(* * comment)
(LET* [(WINDOWSIZE (SCATMATSIZEWINDOW P))
(WINDOWMATRIX (MAKE-ARRAY (LIST P P)))
(WWIDTH (WIDTHIFWINDOW WINDOWSIZE))
(WHEIGHT (HEIGHTIFWINDOW WINDOWSIZE))
(LHC (GETBOXPOSITION (ITIMES P WWIDTH)
(ITIMES P WHEIGHT)))
(WLEFT (fetch (POSITION XCOORD) of LHC))
(WBOTTOM (IPLUS (fetch (POSITION YCOORD) of LHC)
(ITIMES (SUB1 P)
WHEIGHT]
(bind SUPERWINDOW SUBWINDOW for I from 0 to (SUB1 P) as NEWBOTTOM from
WBOTTOM
by (IMINUS WHEIGHT)
do (SETQ SUPERWINDOW (CREATEW (CREATEREGION WLEFT NEWBOTTOM WWIDTH WHEIGHT)))
(ASET SUPERWINDOW WINDOWMATRIX I 0)
(for J from 1 to (SUB1 P) as NEWLEFT from (IPLUS WLEFT WWIDTH)
by WWIDTH
do (SETQ SUBWINDOW (CREATEW (CREATEREGION NEWLEFT NEWBOTTOM WWIDTH
WHEIGHT)))
(ASET SUBWINDOW WINDOWMATRIX I J)
(ATTACHWINDOW SUBWINDOW SUPERWINDOW (QUOTE RIGHT)
(QUOTE TOP))
(SETQ SUPERWINDOW SUBWINDOW)))
(bind (SUPERWINDOW ← (AREF WINDOWMATRIX 0 0))
SUBWINDOW for I from 1 to (SUB1 P)
do (SETQ SUBWINDOW (AREF WINDOWMATRIX I 0))
(ATTACHWINDOW SUBWINDOW SUPERWINDOW (QUOTE BOTTOM)
(QUOTE LEFT))
(SETQ SUPERWINDOW SUBWINDOW))
(WINDOWPROP (AREF WINDOWMATRIX 0 0)
(QUOTE RESHAPEFN)
(QUOTE DON'T))
WINDOWMATRIX])
(DRAWLINEBRUSH
[LAMBDA (LINEBRUSH W) (* jop: " 6-Jun-86 12:03")
(* *)
(LET* ((LINEDATA (fetch (SCATMATBRUSH BRUSHDATA) of LINEBRUSH))
(A (fetch (LINEBRUSH A) of LINEDATA))
(B (fetch (LINEBRUSH B) of LINEDATA))
(C (fetch (LINEBRUSH C) of LINEDATA)))
(if (NOT (EQ B 0))
then (LET [(MAXX (WINDOWPROP W (QUOTE WIDTH]
(DRAWLINE 0 (IQUOTIENT C B)
MAXX
(IQUOTIENT (IDIFFERENCE C (ITIMES A MAXX))
B)
1
(QUOTE INVERT)
W))
else (LET [(MAXY (WINDOWPROP W (QUOTE HEIGHT]
(DRAWLINE (IQUOTIENT C A)
0
(IQUOTIENT (IDIFFERENCE C (ITIMES B MAXY))
A)
MAXY 1 (QUOTE INVERT)
W])
(DRAWRECTBRUSH
[LAMBDA (RECTBRUSH WINDOW) (* jop: "19-May-86 10:14")
(* gets a box position, returning the lower left corner.
During the moving the outline of the box is displayed.
If ORGX is given, the box is originally drawn at that location and the nearest
corner to the cursor is snapped to the cursor position.)
(LET* ((REGION (fetch (SCATMATBRUSH BRUSHDATA) of RECTBRUSH))
(RLEFT (fetch (REGION LEFT) of REGION))
(RBOTTOM (fetch (REGION BOTTOM) of REGION))
(RWIDTH (fetch (REGION WIDTH) of REGION))
(RHEIGHT (fetch (REGION HEIGHT) of REGION))
(SHADE GRAYSHADE))
(BITBLT NIL NIL NIL WINDOW RLEFT RBOTTOM RWIDTH 2 (QUOTE TEXTURE)
(QUOTE INVERT)
SHADE)
(BITBLT NIL NIL NIL WINDOW RLEFT RBOTTOM 2 RHEIGHT (QUOTE TEXTURE)
(QUOTE INVERT)
SHADE)
(BITBLT NIL NIL NIL WINDOW RLEFT (IPLUS RBOTTOM RHEIGHT)
RWIDTH 2 (QUOTE TEXTURE)
(QUOTE INVERT)
SHADE)
(BITBLT NIL NIL NIL WINDOW (IPLUS RLEFT RWIDTH)
RBOTTOM 2 RHEIGHT (QUOTE TEXTURE)
(QUOTE INVERT)
SHADE])
(EXTENTOFMATRIX
[LAMBDA (MATRIX) (* jop: "15-May-86 20:56")
(* * comment)
(for J from 0 to (SUB1 (ARRAY-DIMENSION MATRIX 1))
collect (bind (COLMIN ← (AREF MATRIX 0 J))
(COLMAX ← (AREF MATRIX 0 J)) for I from 1
to (SUB1 (ARRAY-DIMENSION MATRIX 0))
do (SETQ COLMAX (MAX COLMAX (AREF MATRIX I J)))
(SETQ COLMIN (MIN COLMIN (AREF MATRIX I J)))
finally (RETURN (CONS COLMIN COLMAX])
(GETNEWLINEBRUSH
[LAMBDA (LINEBRUSH W) (* jop: " 6-Jun-86 12:03")
(* *)
(DRAWLINEBRUSH LINEBRUSH W)
(PROMPTPRINT "Choose an anchor position")
(LET* ((LINEDATA (fetch (SCATMATBRUSH BRUSHDATA) of LINEBRUSH))
(POSITION (GETPOSITION W))
(X0 (fetch (POSITION XCOORD) of POSITION))
(Y0 (fetch (POSITION YCOORD) of POSITION)))
(bind (OLDX ← MIN.SMALLP)
(OLDY ← MIN.SMALLP)
X Y while (NOT (MOUSESTATE (ONLY RIGHT)))
do (SETQ X (LASTMOUSEX W))
(SETQ Y (LASTMOUSEY W))
(if (NOT (AND (EQ X OLDX)
(EQ Y OLDY)))
then (DRAWLINEBRUSH LINEBRUSH W)
[with LINEBRUSH LINEDATA (SETQ A (IDIFFERENCE Y Y0))
(SETQ B (IDIFFERENCE X0 X))
(SETQ C (IDIFFERENCE (ITIMES X0 Y)
(ITIMES Y0 X]
(DRAWLINEBRUSH LINEBRUSH W))
(SETQ OLDX X)
(SETQ OLDY Y))
(DRAWLINEBRUSH LINEBRUSH W])
(INSIDELINEBRUSH
[LAMBDA (LINEBRUSH X Y) (* jop: "19-May-86 10:23")
(* *)
(LET ((LINEDATA (fetch (SCATMATBRUSH BRUSHDATA) of LINEBRUSH)))
(IGEQ (IPLUS (ITIMES (ffetch (LINEBRUSH A) of LINEDATA)
X)
(ITIMES (ffetch (LINEBRUSH B) of LINEDATA)
Y))
(ffetch (LINEBRUSH C) of LINEDATA])
(INSIDERECTBRUSH
[LAMBDA (RECTBRUSH X Y) (* jop: "19-May-86 10:14")
(* *)
(INSIDEP (ffetch (SCATMATBRUSH BRUSHDATA) of RECTBRUSH)
X Y])
(LABELWINDOWMATRIX
[LAMBDA (WINDOWMATRIX COLLABELS SCALEDATA) (* jop: "15-May-86 21:57")
(* * comment)
(bind WINDOW for I from 0 to (SUB1 (ARRAY-TOTAL-SIZE COLLABELS)) as Extent
in SCALEDATA
do (SETQ WINDOW (AREF WINDOWMATRIX I I))
(PRINTOUT WINDOW .FR 0 (CDR Extent))
(CENTERPRINTINREGION (AREF COLLABELS I)
NIL WINDOW)
(MOVETO 0 0 WINDOW)
(PRINTOUT WINDOW (CAR Extent])
(MAKE-IRIS
[LAMBDA (LST) (* jop: "15-May-86 22:38")
(* *)
(LET [(IRIS (MAKE-ARRAY (QUOTE (150 4))
(QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT]
(for I from 0 to 149 as SUBLST in LST
do (for J from 0 to 3 as NUM in SUBLST do (ASET NUM IRIS I J)))
IRIS])
(MODIFYLINEBRUSH
[LAMBDA (LINEBRUSH X Y) (* jop: "19-May-86 10:20")
(* *)
(LET* ((LINEDATA (fetch (SCATMATBRUSH BRUSHDATA) of LINEBRUSH))
(A (fetch (LINEBRUSH A) of LINEDATA))
(B (fetch (LINEBRUSH B) of LINEDATA)))
(replace (LINEBRUSH C) of LINEDATA with (IPLUS (ITIMES A X)
(ITIMES B Y])
(MODIFYRECTBRUSH
[LAMBDA (RECTBRUSH X Y) (* jop: "19-May-86 10:15")
(* *)
(LET ((BRUSHREGION (fetch (SCATMATBRUSH BRUSHDATA) of RECTBRUSH)))
(replace (REGION LEFT) of BRUSHREGION with X)
(replace (REGION BOTTOM) of BRUSHREGION with Y])
(NEWRECTBRUSH
[LAMBDA (RECTBRUSH WINDOW) (* jop: "19-May-86 10:16")
(LET ((NEWREGION (GETREGION 10 10))
(BRUSHREGION (fetch (SCATMATBRUSH BRUSHDATA) of RECTBRUSH)))
(replace (REGION WIDTH) of BRUSHREGION with (fetch (REGION WIDTH) of NEWREGION))
(replace (REGION HEIGHT) of BRUSHREGION with (fetch (REGION HEIGHT) of NEWREGION])
(SCATFIREPOINTS
[LAMBDA (PLST BRUSH) (* jop: "19-May-86 11:52")
(* * comment)
(bind (BUTTONSTATE ← (if (MOUSESTATE RIGHT)
then (QUOTE RIGHT)
else (QUOTE LEFT)))
(BRUSHMODE ← (fetch (SCATMATBRUSH CURRENTMODE) of BRUSH))
INSIDEP for POINT in PLST
do (SETQ INSIDEP (fetch (SCATMATPOINT INSIDEP) of POINT))
(SELECTQ BRUSHMODE
(HIGHLIGHT (if INSIDEP
then (SCATMATESTABLISHMODE POINT (QUOTE ON))
else (SCATMATESTABLISHMODE POINT (QUOTE OFF))))
(PAINT (if (EQ BUTTONSTATE (QUOTE LEFT))
then (AND INSIDEP (SCATMATESTABLISHMODE POINT (QUOTE ON)
T))
else (AND INSIDEP (SCATMATESTABLISHMODE POINT (QUOTE OFF)
T))))
(SHOULDNT])
(SCATMAT
[LAMBDA (MATRIX COLLABELS SYMBOL) (* jop: " 6-Jun-86 12:04")
(* * comment)
(DECLARE (GLOBALVARS CURRENTBRUSH OLDBRUSH POINTSLIST CIRCLE))
(if (NOT (AND (EQ (ARRAY-ELEMENT-TYPE MATRIX)
(QUOTE SINGLE-FLOAT))
(EQ (ARRAY-RANK MATRIX)
2)))
then (HELP "Illegal MATRIX" MATRIX))
(if (NULL SYMBOL)
then (SETQ SYMBOL CIRCLE))
(LET ((N (ARRAY-DIMENSION MATRIX 0))
(P (ARRAY-DIMENSION MATRIX 1)))
(if (NOT (AND (LEQ N 800)
(GREATERP P 2)
(LESSP P 6)))
then (HELP "MATRIX too large" MATRIX))
(if (NULL COLLABELS)
then (SETQ COLLABELS (MAKE-ARRAY P))
(for I from 0 to (SUB1 P) do (ASET (MKSTRING (ADD1 I))
COLLABELS I))
elseif (LISTP COLLABELS)
then (SETQ COLLABELS (MAKE-ARRAY P (QUOTE :INITIAL-CONTENTS)
COLLABELS))
elseif [NOT (AND (ARRAYP COLLABELS)
(EQ (ARRAY-RANK COLLABELS)
1)
(EQ P (ARRAY-TOTAL-SIZE COLLABELS]
then (HELP "Illegal collabels" COLLABELS))
(LET ((WINDOWMATRIX (BUILDWINDOWMATRIX P))
(SCALEDATA (EXTENTOFMATRIX MATRIX))
(DEFAULTSIZE (QUOTIENT (SCATMATSIZEWINDOW P)
4)))
(SETQ POINTSLIST (BUILDPOINTSLIST MATRIX SCALEDATA SYMBOL WINDOWMATRIX))
(SETQ CURRENTBRUSH (BUILDRECTBRUSH DEFAULTSIZE DEFAULTSIZE))
(SETQ OLDBRUSH (BUILDLINEBRUSH 50 -50 0))
(LABELWINDOWMATRIX WINDOWMATRIX COLLABELS SCALEDATA)
(ACTIVATEWINDOWMATRIX WINDOWMATRIX)
(for POINT in POINTSLIST do (SHOWPOINT POINT))
MATRIX])
(SCATMATACQUIREBRUSH
[LAMBDA (WINDOW) (* jop: "19-May-86 11:08")
(* * comment)
(DECLARE (GLOBALVARS CURRENTBRUSH SCATMATSMALLCURSOR))
(replace (SCATMATBRUSH HORIZCOORD) of CURRENTBRUSH with (WINDOWPROP WINDOW (QUOTE HORIZCOORD)))
(replace (SCATMATBRUSH VERTCOORD) of CURRENTBRUSH with (WINDOWPROP WINDOW (QUOTE VERTCOORD)))
(SCATMATMODIFYBRUSH CURRENTBRUSH (LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))
(SETCURSOR SCATMATSMALLCURSOR)
(SCATMATDRAWBRUSH CURRENTBRUSH WINDOW])
(SCATMATNEWBRUSH
[LAMBDA (CURRENTBRUSH WINDOW) (* jop: "19-May-86 10:07")
(* *)
(APPLY* (ffetch (SCATMATBRUSH NEWFN) of CURRENTBRUSH)
CURRENTBRUSH WINDOW])
(SCATMATBUILDPILOTBBT
[LAMBDA (SOURCEBITMAP WINDOW LEFT TOP) (* jop: "15-May-86 23:25")
(* * comment)
(LET ((BBT (create PILOTBBT
PBTWIDTH ← (BITMAPWIDTH SOURCEBITMAP)
PBTDISJOINT ← T))
(DESTBITMAP (DSPDESTINATION NIL WINDOW)))
(replace (PILOTBBT PBTSOURCE) of BBT with (fetch (BITMAP BITMAPBASE) of SOURCEBITMAP))
(replace (PILOTBBT PBTSOURCEBIT) of BBT with 0)
(replace (PILOTBBT PBTSOURCEBPL) of BBT with (LSH (fetch (BITMAP BITMAPRASTERWIDTH)
of SOURCEBITMAP)
4))
(* Position ourselves at the begining
of a rasterline)
[replace (PILOTBBT PBTDEST) of BBT with (\ADDBASE (fetch (BITMAP BITMAPBASE) of DESTBITMAP)
(ITIMES (fetch (BITMAP BITMAPRASTERWIDTH)
of DESTBITMAP)
(IDIFFERENCE (BITMAPHEIGHT DESTBITMAP)
(IPLUS TOP (DSPYOFFSET NIL
WINDOW]
(replace (PILOTBBT PBTDESTBIT) of BBT with (IPLUS LEFT (DSPXOFFSET NIL WINDOW)))
(replace (PILOTBBT PBTDESTBPL) of BBT with (LSH (fetch (BITMAP BITMAPRASTERWIDTH)
of DESTBITMAP)
4))
(replace (PILOTBBT PBTHEIGHT) of BBT with (BITMAPHEIGHT SOURCEBITMAP))
BBT])
(SCATMATDRAWREGION
[LAMBDA (REGION STREAM) (* jop: "16-May-86 13:16")
(* * comment)
(LET* ((BRUSHLEFT (fetch (REGION LEFT) of REGION))
(BRUSHBOTTOM (fetch (REGION BOTTOM) of REGION))
(BRUSHRIGHT (fetch (REGION RIGHT) of REGION))
(BRUSHTOP (fetch (REGION TOP) of REGION)))
(MOVETO BRUSHLEFT BRUSHBOTTOM STREAM)
(DRAWTO BRUSHRIGHT BRUSHBOTTOM 1 NIL STREAM)
(DRAWTO BRUSHRIGHT BRUSHTOP 1 NIL STREAM)
(DRAWTO BRUSHLEFT BRUSHTOP 1 NIL STREAM)
(DRAWTO BRUSHLEFT BRUSHBOTTOM 1 NIL STREAM)
STREAM])
(SCATMATESTABLISHMODE
[LAMBDA (POINT TARGETMODE PFLG) (* jop: "19-May-86 11:37")
(* * comment)
(LET ((STATUS (fetch (SCATMATPOINT STATUS) of POINT))
(PERSISTENT? (fetch (SCATMATPOINT PERSISTENT?) of POINT)))
(if (NOT PFLG)
then (SELECTQ TARGETMODE
(ON (if (NEQ STATUS (QUOTE ON))
then (SHOWHIGHLIGHTED POINT)
(replace (SCATMATPOINT STATUS) of POINT with TARGETMODE)))
(OFF (if (AND (NEQ STATUS (QUOTE OFF))
(NOT PERSISTENT?))
then (SHOWLOWLIGHTED POINT)
(replace (SCATMATPOINT STATUS) of POINT with TARGETMODE)))
(SHOULDNT))
else (SELECTQ TARGETMODE
(ON (if (NEQ STATUS (QUOTE ON))
then (SHOWHIGHLIGHTED POINT)
(replace (SCATMATPOINT STATUS) of POINT with TARGETMODE)
(replace (SCATMATPOINT PERSISTENT?) of POINT with T)))
(OFF (if (NEQ STATUS (QUOTE OFF))
then (SHOWLOWLIGHTED POINT)
(replace (SCATMATPOINT STATUS) of POINT with TARGETMODE)
(replace (SCATMATPOINT PERSISTENT?) of POINT with NIL)))
(SHOULDNT])
(SCATMATPOLLPOINTS
[LAMBDA (PLST BRUSH) (* jop: "19-May-86 11:49")
(* * comment)
(bind (I ← (fetch (SCATMATBRUSH HORIZCOORD) of BRUSH))
(J ← (fetch (SCATMATBRUSH VERTCOORD) of BRUSH)) for POINT in PLST
do (replace (SCATMATPOINT INSIDEP) of POINT with (SCATMATINSIDEP BRUSH (SELECTCOORD POINT I)
(SELECTCOORD POINT J])
(SCATMATRELEASEBRUSH
[LAMBDA (WINDOW) (* jop: "19-May-86 11:16")
(* * comment)
(DECLARE (GLOBALVARS CURRENTBRUSH DEFAULTCURSOR POINTSLIST))
(for POINT in POINTSLIST do (SCATMATESTABLISHMODE POINT (QUOTE OFF)))
(replace (SCATMATBRUSH HORIZCOORD) of CURRENTBRUSH with NIL)
(replace (SCATMATBRUSH VERTCOORD) of CURRENTBRUSH with NIL)
(SCATMATDRAWBRUSH CURRENTBRUSH WINDOW)
(SETCURSOR DEFAULTCURSOR])
(SCATMATRIGHTBUTTONFN
[LAMBDA (WINDOW) (* jop: "19-May-86 10:58")
(* * comment)
(DECLARE (GLOBALVARS CURRENTBRUSH OLDBRUSH))
(TOTOPW WINDOW)
(LET [(BRUSHMENU (CONSTANT (create MENU
ITEMS ← (QUOTE ((Shapebrush (QUOTE SHAPEBRUSH)
"reshape the current brush")
(Changebrush (QUOTE CHANGEBRUSH)
"Swap brushes")
(Changemode (QUOTE HIGHLIGHT)
"Change brushingmode"
(SUBITEMS (Highlight (QUOTE HIGHLIGHT)
"Highlight mode")
(Paint (QUOTE PAINT)
"Paint mode"]
(SELECTQ (MENU BRUSHMENU)
(SHAPEBRUSH (SCATMATNEWBRUSH CURRENTBRUSH WINDOW))
(CHANGEBRUSH (LET ((TEMP CURRENTBRUSH))
(SETQ CURRENTBRUSH OLDBRUSH)
(SETQ OLDBRUSH TEMP)))
(HIGHLIGHT (replace (SCATMATBRUSH CURRENTMODE) of CURRENTBRUSH with (QUOTE HIGHLIGHT)))
(PAINT (replace (SCATMATBRUSH CURRENTMODE) of CURRENTBRUSH with (QUOTE PAINT)))
NIL])
(SCATMATSIZEWINDOW
[LAMBDA (P) (* SCP "16-Mar-86 19:05")
(* * comment)
(SELECTQ P
(2 200)
(3 200)
(4 128)
(5 128)
(SHOULDNT "Bad Matrix Dimension:" P])
(SHOWHIGHLIGHTED
[LAMBDA (POINT) (* jop: "19-May-86 11:36")
(* *)
(for DESTINATION in (fetch (SCATMATPOINT DESTINATIONSCACHE) of POINT)
do (replace (PILOTBBT PBTSOURCETYPE) of DESTINATION with 1)
(replace (PILOTBBT PBTOPERATION) of DESTINATION with 0)
(\PILOTBITBLT DESTINATION 0])
(SHOWLOWLIGHTED
[LAMBDA (POINT) (* jop: "19-May-86 11:36")
(* *)
(for DESTINATION in (fetch (SCATMATPOINT DESTINATIONSCACHE) of POINT)
do (replace (PILOTBBT PBTSOURCETYPE) of DESTINATION with 0)
(replace (PILOTBBT PBTOPERATION) of DESTINATION with 0)
(\PILOTBITBLT DESTINATION 0])
(SHOWPOINT
[LAMBDA (POINT) (* jop: "16-May-86 18:12")
(* * (for DESTINATION in (fetch DestinationsCache of POINT) do
(BITBLTTODESTINATION (fetch PlottingSymbol of POINT) 0 0 DESTINATION NIL NIL
NIL NIL (QUOTE INPUT) (QUOTE INVERT))))
(for DESTINATION in (fetch (SCATMATPOINT DESTINATIONSCACHE) of POINT)
do (replace (PILOTBBT PBTSOURCETYPE) of DESTINATION with 0)
(replace (PILOTBBT PBTOPERATION) of DESTINATION with 0)
(\PILOTBITBLT DESTINATION 0])
(SCATMATBUTTONEVENTFN
[LAMBDA (WINDOW) (* jop: "19-May-86 11:53")
(* * comment)
(DECLARE (GLOBALVARS CURRENTBRUSH POINTSLIST))
(SCATMATACQUIREBRUSH WINDOW)
(while (NOT (MOUSESTATE UP)) do (SCATMATPOLLPOINTS POINTSLIST CURRENTBRUSH)
(SCATMATDRAWBRUSH CURRENTBRUSH WINDOW)
(SCATMATMODIFYBRUSH CURRENTBRUSH (LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))
(SCATFIREPOINTS POINTSLIST CURRENTBRUSH)
(SCATMATDRAWBRUSH CURRENTBRUSH WINDOW))
(SCATMATRELEASEBRUSH WINDOW])
(SELECTCOORD
[LAMBDA (POINT COORDINATE) (* jop: "15-May-86 22:09")
(* * comment)
(CAR (NTH (fetch (SCATMATPOINT COORDINATES) of POINT)
COORDINATE])
)
(RPAQ CIRCLE (READBITMAP))
(5 5
"G@@@"
"HH@@"
"HH@@"
"HH@@"
"G@@@")
(RPAQ CROSS (READBITMAP))
(5 5
"B@@@"
"B@@@"
"OH@@"
"B@@@"
"B@@@")
(RPAQQ IRISCOLLABELLIST ("Sepal Length" "Sepal Width" "Petal Length" "Petal Width"))
(RPAQQ IRISLIST ((5.1 3.5 1.4 .2)
(4.9 3.0 1.4 .2)
(4.7 3.2 1.3 .2)
(4.6 3.1 1.5 .2)
(5.0 3.6 1.4 .2)
(5.4 3.9 1.7 .4)
(4.6 3.4 1.4 .3)
(5.0 3.4 1.5 .2)
(4.4 2.9 1.4 .2)
(4.9 3.1 1.5 .1)
(5.4 3.7 1.5 .2)
(4.8 3.4 1.6 .2)
(4.8 3.0 1.4 .1)
(4.3 3.0 1.1 .1)
(5.8 4.0 1.2 .2)
(5.7 4.4 1.5 .4)
(5.4 3.9 1.3 .4)
(5.1 3.5 1.4 .3)
(5.7 3.8 1.7 .3)
(5.1 3.8 1.5 .3)
(5.4 3.4 1.7 .2)
(5.1 3.7 1.5 .4)
(4.6 3.6 1.0 .2)
(5.1 3.3 1.7 .5)
(4.8 3.4 1.9 .2)
(5.0 3.0 1.6 .2)
(5.0 3.4 1.6 .4)
(5.2 3.5 1.5 .2)
(5.2 3.4 1.4 .2)
(4.7 3.2 1.6 .2)
(4.8 3.1 1.6 .2)
(5.4 3.4 1.5 .4)
(5.2 4.1 1.5 .1)
(5.5 4.2 1.4 .2)
(4.9 3.1 1.5 .2)
(5.0 3.2 1.2 .2)
(5.5 3.5 1.3 .2)
(4.9 3.6 1.4 .1)
(4.4 3.0 1.3 .2)
(5.1 3.4 1.5 .2)
(5.0 3.5 1.3 .3)
(4.5 2.3 1.3 .3)
(4.4 3.2 1.3 .2)
(5.0 3.5 1.6 .6)
(5.1 3.8 1.9 .4)
(4.8 3.0 1.4 .3)
(5.1 3.8 1.6 .2)
(4.6 3.2 1.4 .2)
(5.3 3.7 1.5 .2)
(5.0 3.3 1.4 .2)
(7.0 3.2 4.7 1.4)
(6.4 3.2 4.5 1.5)
(6.9 3.1 4.9 1.5)
(5.5 2.3 4.0 1.3)
(6.5 2.8 4.6 1.5)
(5.7 2.8 4.5 1.3)
(6.3 3.3 4.7 1.6)
(4.9 2.4 3.3 1.0)
(6.6 2.9 4.6 1.3)
(5.2 2.7 3.9 1.4)
(5.0 2.0 3.5 1.0)
(5.9 3.0 4.2 1.5)
(6.0 2.2 4.0 1.0)
(6.1 2.9 4.7 1.4)
(5.6 2.9 3.6 1.3)
(6.7 3.1 4.4 1.4)
(5.6 3.0 4.5 1.5)
(5.8 2.7 4.1 1.0)
(6.2 2.2 4.5 1.5)
(5.6 2.5 3.9 1.1)
(5.9 3.2 4.8 1.8)
(6.1 2.8 4.0 1.3)
(6.3 2.5 4.9 1.5)
(6.1 2.8 4.7 1.2)
(6.4 2.9 4.3 1.3)
(6.6 3.0 4.4 1.4)
(6.8 2.8 4.8 1.4)
(6.7 3.0 5.0 1.7)
(6.0 2.9 4.5 1.5)
(5.7 2.6 3.5 1.0)
(5.5 2.4 3.8 1.1)
(5.5 2.4 3.7 1.0)
(5.8 2.7 3.9 1.2)
(6.0 2.7 5.1 1.6)
(5.4 3.0 4.5 1.5)
(6.0 3.4 4.5 1.6)
(6.7 3.1 4.7 1.5)
(6.3 2.3 4.4 1.3)
(5.6 3.0 4.1 1.3)
(5.5 2.5 4.0 1.3)
(5.5 2.6 4.4 1.2)
(6.1 3.0 4.6 1.4)
(5.8 2.6 4.0 1.2)
(5.0 2.3 3.3 1.0)
(5.6 2.7 4.2 1.3)
(5.7 3.0 4.2 1.2)
(5.7 2.9 4.2 1.3)
(6.2 2.9 4.3 1.3)
(5.1 2.5 3.0 1.1)
(5.7 2.8 4.1 1.3)
(6.3 3.3 6.0 2.5)
(5.8 2.7 5.1 1.9)
(7.1 3.0 5.9 2.1)
(6.3 2.9 5.6 1.8)
(6.5 3.0 5.8 2.2)
(7.6 3.0 6.6 2.1)
(4.9 2.5 4.5 1.7)
(7.3 2.9 6.3 1.8)
(6.7 2.5 5.8 1.8)
(7.2 3.6 6.1 2.5)
(6.5 3.2 5.1 2.0)
(6.4 2.7 5.3 1.9)
(6.8 3.0 5.5 2.1)
(5.7 2.5 5.0 2.0)
(5.8 2.8 5.1 2.4)
(6.4 3.2 5.3 2.3)
(6.5 3.0 5.5 1.8)
(7.7 3.8 6.7 2.2)
(7.7 2.6 6.9 2.3)
(6.0 2.2 5.0 1.5)
(6.9 3.2 5.7 2.3)
(5.6 2.8 4.9 2.0)
(7.7 2.8 6.7 2.0)
(6.3 2.7 4.9 1.8)
(6.7 3.3 5.7 2.1)
(7.2 3.2 6.0 1.8)
(6.2 2.8 4.8 1.8)
(6.1 3.0 4.9 1.8)
(6.4 2.8 5.6 2.1)
(7.2 3.0 5.8 1.6)
(7.4 2.8 6.1 1.9)
(7.9 3.8 6.4 2.0)
(6.4 2.8 5.6 2.2)
(6.3 2.8 5.1 1.5)
(6.1 2.6 5.6 1.4)
(7.7 3.0 6.1 2.3)
(6.3 3.4 5.6 2.4)
(6.4 3.1 5.5 1.8)
(6.0 3.0 4.8 1.8)
(6.9 3.1 5.4 2.1)
(6.7 3.1 5.6 2.4)
(6.9 3.1 5.1 2.3)
(5.8 2.7 5.1 1.9)
(6.8 3.2 5.9 2.3)
(6.7 3.3 5.7 2.5)
(6.7 3.0 5.2 2.3)
(6.3 2.5 5.0 1.9)
(6.5 3.0 5.2 2.0)
(6.2 3.4 5.4 2.3)
(5.9 3.0 5.1 1.8)))
(RPAQQ IRISROWLABELLIST ("1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16"
"17"
"18" "19" "20" "21" "22" "23" "24" "25" "26" "27" "28" "29" "30" "31"
"32"
"33" "34" "35" "36" "37" "38" "39" "40" "41" "42" "43" "44" "45" "46"
"47"
"48" "49" "50" "51" "52" "53" "54" "55" "56" "57" "58" "59" "60" "61"
"62"
"63" "64" "65" "66" "67" "68" "69" "70" "71" "72" "73" "74" "75" "76"
"77"
"78" "79" "80" "81" "82" "83" "84" "85" "86" "87" "88" "89" "90" "91"
"92"
"93" "94" "95" "96" "97" "98" "99" "100" "101" "102" "103" "104" "105"
"106"
"107" "108" "109" "110" "111" "112" "113" "114" "115" "116" "117"
"118"
"119" "120" "121" "122" "123" "124" "125" "126" "127" "128" "129"
"130"
"131" "132" "133" "134" "135" "136" "137" "138" "139" "140" "141"
"142"
"143" "144" "145" "146" "147" "148" "149" "150"))
(RPAQQ BRUSH NIL)
(RPAQQ POINTSLIST NIL)
(RPAQ SCATMATSMALLCURSOR (CURSORCREATE (READBITMAP) 0 3))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"G@@@"
"E@@@"
"G@@@"
"@@@@")(PUTPROPS SCATMATRIX COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3142 30197 (ACTIVATEWINDOWMATRIX 3152 . 4174) (BUILDLINEBRUSH 4176 . 4757) (
BUILDPOINTSLIST 4759 . 7162) (BUILDRECTBRUSH 7164 . 7643) (BUILDWINDOWMATRIX 7645 . 9386) (
DRAWLINEBRUSH 9388 . 10284) (DRAWRECTBRUSH 10286 . 11663) (EXTENTOFMATRIX 11665 . 12244) (
GETNEWLINEBRUSH 12246 . 13357) (INSIDELINEBRUSH 13359 . 13853) (INSIDERECTBRUSH 13855 . 14088) (
LABELWINDOWMATRIX 14090 . 14613) (MAKE-IRIS 14615 . 15066) (MODIFYLINEBRUSH 15068 . 15560) (
MODIFYRECTBRUSH 15562 . 15926) (NEWRECTBRUSH 15928 . 16382) (SCATFIREPOINTS 16384 . 17502) (SCATMAT
17504 . 19374) (SCATMATACQUIREBRUSH 19376 . 19989) (SCATMATNEWBRUSH 19991 . 20238) (
SCATMATBUILDPILOTBBT 20240 . 22272) (SCATMATDRAWREGION 22274 . 22964) (SCATMATESTABLISHMODE 22966 .
24623) (SCATMATPOLLPOINTS 24625 . 25156) (SCATMATRELEASEBRUSH 25158 . 25704) (SCATMATRIGHTBUTTONFN
25706 . 27375) (SCATMATSIZEWINDOW 27377 . 27659) (SHOWHIGHLIGHTED 27661 . 28100) (SHOWLOWLIGHTED 28102
. 28540) (SHOWPOINT 28542 . 29178) (SCATMATBUTTONEVENTFN 29180 . 29948) (SELECTCOORD 29950 . 30195)))
))
STOP