(FILECREATED " 8-Aug-85 01:03:48" {PHYLUM}<PEDERSEN>LISP>INSPECTARRAY.;2 75157
changes to: (VARS INSPECTARRAYCOMS)
(FNS ICMLARRAY.GETSTATUSWINDOWGROUP MENUW.MAKEREGIONS MENUW.REPAINTFN
ONED.DOWINDOWCOMFN TWOD.DOWINDOWCOMFN CMLARRAYP)
previous date: "28-Jul-85 17:38:39" {PHYLUM}<PEDERSEN>LISP>INSPECTARRAY.;1)
(PRETTYCOMPRINT INSPECTARRAYCOMS)
(RPAQQ INSPECTARRAYCOMS [(FNS CMLARRAYP COMPUTEONEDFIELDWIDTH COMPUTETWODCOLUMNWIDTH
COMPUTETWODTOTALWIDTH CREATE.ARRAYSLICE DISPLAY.ONEDSLICE
DISPLAY.TWODSLICE DISPLAYSLICE ICMLARRAY ICMLARRAY.GETONEDWINDOWGROUP
ICMLARRAY.GETREGIONFN ICMLARRAY.GETSTATUSWINDOWGROUP
ICMLARRAY.GETTWODWINDOWGROUP INVERTREGION LISTNCHARS LISTSTRREGION
LISTSTRWIDTH MENU.GETLEVEL MENUW.APPLY MENUW.BUTTONEVENTFN
MENUW.CURSORMOVEDFN MENUW.CURSOROUTFN MENUW.MAKEREGIONS MENUW.REPAINTFN
MENUW.RESHAPEFN MENUW.SHOW ONED.BUTTONEVENTFN ONED.DOWINDOWCOMFN
ONED.INDICES ONED.MAKEREGIONS ONED.MENUFN ONED.PRTELEMENT
ONED.REPAINTFN ONED.RESHAPEFN ONED.SCROLLFN ONED.SETVALUE
ONEDRIGHTW.REPAINTFN ONEDRIGHTW.RESHAPEFN OUTLINEREGION PLNCHARS
PLSTRINGREGION PLSTRINGWIDTH RIGHTW.REPAINTFN RIGHTW.RESHAPEFN
SLICEDIMENSION SLICERANK SLICEREF SLICESET STATUSW.BUTTONEVENTFN
STATUSW.REPAINTFN TOPW.REPAINTFN TOPW.RESHAPEFN TWOD.BUTTONEVENTFN
TWOD.DOWINDOWCOMFN TWOD.INDICES TWOD.MAKEREGIONS TWOD.MENUFN
TWOD.PRTELEMENT TWOD.REPAINTFN TWOD.RESHAPEFN TWOD.SCROLLFN
TWOD.SETVALUE ZEROD.SETVALUE)
(RECORDS ICMLARRAY.ACTIVEREGION ICMLARRAY.ARRAYSLICE)
(ADDVARS (INSPECTMACROS ((FUNCTION CMLARRAYP) . ICMLARRAY])
(DEFINEQ
(CMLARRAYP
[LAMBDA (DATUM)
(OR (type? ARRAY DATUM)
(type? VECTOR DATUM])
(COMPUTEONEDFIELDWIDTH
[LAMBDA (SLICE FONT) (* jop: "23-Jul-85 16:15")
(RESETLST [RESETSAVE (PRINTLEVEL (QUOTE (2 . 5]
(bind (MAX ← 0)
SIZE for I from 0 to (SUB1 (SLICEDIMENSION SLICE 0))
do (SETQ SIZE (PLSTRINGWIDTH (SLICEREF SLICE I)
FONT))
(if (GREATERP SIZE MAX)
then (SETQ MAX SIZE))
finally (RETURN MAX])
(COMPUTETWODCOLUMNWIDTH
[LAMBDA (SLICE J FONT) (* jop: "23-Jul-85 17:20")
(* * Computes the MIN fieldwidth for the jth column of SLICE)
(RESETFORM (PRINTLEVEL (QUOTE (2 . 5)))
(PLUS (PLSTRINGWIDTH " " FONT)
(bind (MAX ← 0)
SIZE for I from 0 to (SUB1 (SLICEDIMENSION SLICE 0))
do (SETQ SIZE (PLSTRINGWIDTH (SLICEREF SLICE I J)
FONT))
(if (GREATERP SIZE MAX)
then (SETQ MAX SIZE))
finally (RETURN MAX])
(COMPUTETWODTOTALWIDTH
[LAMBDA (SLICE FONT) (* jop: "23-Jul-85 17:41")
(for J from 0 to (SUB1 (SLICEDIMENSION SLICE 1)) sum (COMPUTETWODCOLUMNWIDTH SLICE J FONT])
(CREATE.ARRAYSLICE
[LAMBDA (ARRAY KEEPS) (* jop: "28-Jul-85 17:34")
(* * An ARRAYSLICE is a one or two dimensional slice of a CMLARRAY, which may be REF'ed SET, etc., as if it were an
array. Functions SLICE* perform the analogous actions. KEEPS is in ASSOC list format (.. (DIM LEVEL) ...))
(PROG ((RANK (ARRAY-RANK ARRAY))
(DIMS (ARRAY-DIMENSIONS ARRAY))
(LKEEPS (LENGTH KEEPS))
EXCESS SETLIST REFLIST INDEXLIST FIRSTINDEX SECONDINDEX REALINDICES)
(SETQ EXCESS (DIFFERENCE RANK LKEEPS))
(if (LESSP EXCESS 1)
then (HELP "TOO MANY DIMS KEPT" KEEPS)
elseif (GREATERP EXCESS 2)
then (HELP "TOO FEW DIMS KEPT" KEEPS))
[SETQ SETLIST (APPEND (LIST NIL ARRAY)
(bind PAIR VALUE for I from 0 to (SUB1 RANK)
collect (if (SETQ PAIR (ASSOC I KEEPS))
then (if (LESSP (SETQ VALUE (CADR PAIR))
(ARRAY-DIMENSION ARRAY I))
then VALUE
else (HELP "KEPT LEVEL OUT OF RANGE" PAIR]
(SETQ REFLIST (CDR SETLIST))
(SETQ INDEXLIST (CDR REFLIST))
(SETQ REALINDICES (for I from 0 to (SUB1 RANK) when (NOT (ASSOC I KEEPS))
collect [if FIRSTINDEX
then (SETQ SECONDINDEX (NTH INDEXLIST (ADD1 I)))
else (SETQ FIRSTINDEX (NTH INDEXLIST (ADD1 I]
I))
(RETURN (create ICMLARRAY.ARRAYSLICE
ARRAY ← ARRAY
SETLIST ← SETLIST
REFLIST ← REFLIST
INDEXLIST ← INDEXLIST
FIRSTINDEX ← FIRSTINDEX
SECONDINDEX ← SECONDINDEX
TWOD? ←(EQP EXCESS 2)
REALINDICES ← REALINDICES])
(DISPLAY.ONEDSLICE
[LAMBDA (MAINWINDOW SLICE) (* jop: "25-Jul-85 16:29")
(PROG [(ONEDWINDOW (WINDOWPROP MAINWINDOW (QUOTE ONEDWINDOW]
[if (NULL ONEDWINDOW)
then [SETQ ONEDWINDOW (ICMLARRAY.GETONEDWINDOWGROUP MAINWINDOW SLICE
(QUOTE (GACHA 10]
(WINDOWPROP MAINWINDOW (QUOTE ONEDWINDOW)
ONEDWINDOW)
else (WINDOWPROP ONEDWINDOW (QUOTE SLICE)
SLICE)
(ONED.RESHAPEFN ONEDWINDOW)
(ONEDRIGHTW.RESHAPEFN (WINDOWPROP ONEDWINDOW (QUOTE RIGHTWINDOW]
(if (EQ ONEDWINDOW (MAINWINDOW ONEDWINDOW))
then (ATTACHWINDOW ONEDWINDOW MAINWINDOW (QUOTE LEFT)
(QUOTE TOP)) (* Note the order is important here)
(WINDOWPROP ONEDWINDOW (QUOTE DOWINDOWCOMFN)
(FUNCTION ONED.DOWINDOWCOMFN])
(DISPLAY.TWODSLICE
[LAMBDA (MAINWINDOW SLICE) (* jop: "25-Jul-85 16:30")
(PROG [(TWODWINDOW (WINDOWPROP MAINWINDOW (QUOTE TWODWINDOW]
[if (NULL TWODWINDOW)
then [SETQ TWODWINDOW (ICMLARRAY.GETTWODWINDOWGROUP MAINWINDOW SLICE
(QUOTE (GACHA 10]
(WINDOWPROP MAINWINDOW (QUOTE TWODWINDOW)
TWODWINDOW)
else (WINDOWPROP TWODWINDOW (QUOTE SLICE)
SLICE) (* The following resets and redisplayed the windows)
(TWOD.RESHAPEFN TWODWINDOW)
(RIGHTW.RESHAPEFN (WINDOWPROP TWODWINDOW (QUOTE RIGHTWINDOW)))
(TOPW.RESHAPEFN (WINDOWPROP TWODWINDOW (QUOTE TOPWINDOW]
(if (EQ TWODWINDOW (MAINWINDOW TWODWINDOW))
then (ATTACHWINDOW TWODWINDOW MAINWINDOW (QUOTE LEFT)
(QUOTE TOP)) (* order important here)
(WINDOWPROP TWODWINDOW (QUOTE DOWINDOWCOMFN)
(FUNCTION TWOD.DOWINDOWCOMFN])
(DISPLAYSLICE
[LAMBDA (MAINWINDOW LEVELS) (* jop: "18-Jul-85 21:02")
(PROG ((CMLARRAY (WINDOWPROP MAINWINDOW (QUOTE CMLARRAY)))
(CURRENTSLICE (WINDOWPROP MAINWINDOW (QUOTE CURRENTSLICE)))
SLICE) (* Set up the array slice)
[SETQ SLICE (CREATE.ARRAYSLICE CMLARRAY (for LEVEL in LEVELS as DIM from 0
unless (EQ LEVEL (QUOTE ALL))
collect (LIST DIM LEVEL]
(* Clean up previous display)
[if CURRENTSLICE
then (if (EQP 1 (SLICERANK CURRENTSLICE))
then (DETACHWINDOW (WINDOWPROP MAINWINDOW (QUOTE ONEDWINDOW)))
(CLOSEW (WINDOWPROP MAINWINDOW (QUOTE ONEDWINDOW)))
else (DETACHWINDOW (WINDOWPROP MAINWINDOW (QUOTE TWODWINDOW)))
(CLOSEW (WINDOWPROP MAINWINDOW (QUOTE TWODWINDOW]
(WINDOWPROP MAINWINDOW (QUOTE CURRENTSLICE)
SLICE)
(if (EQP 1 (SLICERANK SLICE))
then (DISPLAY.ONEDSLICE MAINWINDOW SLICE)
else (DISPLAY.TWODSLICE MAINWINDOW SLICE])
(ICMLARRAY
[LAMBDA (CMLARRAY ASTYPE WHERE) (* jop: "28-Jul-85 17:31")
(* * Top level entry point into the CMLARRAY inspector)
[if (WINDOWP WHERE)
then (PROMPTPRINT "CMLARRAY INSPECTOR OF FIXED SIZE")
(SETQ WHERE NIL)
elseif (REGIONP WHERE)
then (PROMPTPRINT "USING LOWER LEFT CORNER")
(SETQ WHERE (create POSITION
XCOORD ←(fetch LEFT of WHERE)
YCOORD ←(fetch BOTTOM of WHERE]
(PROG ((RANK (ARRAY-RANK CMLARRAY))
(FONT (QUOTE (GACHA 10)))
DISPLAYEDLEVELS MAINWINDOW STATUSWIDTH)
(SETQ DISPLAYEDLEVELS (for I from 0 to (SUB1 RANK)
collect (if (LESSP (DIFFERENCE (SUB1 (ARRAY-RANK CMLARRAY))
I)
2)
then (QUOTE ALL)
else 0)))
[SETQ STATUSWIDTH (IMAX 250 (WIDTHIFWINDOW (TIMES (STRINGWIDTH "A" FONT)
(PLUS 10 (TIMES 5 RANK]
(SETQ MAINWINDOW (ICMLARRAY.GETSTATUSWINDOWGROUP CMLARRAY STATUSWIDTH FONT DISPLAYEDLEVELS
WHERE))
(if (GREATERP RANK 0)
then (DISPLAYSLICE MAINWINDOW DISPLAYEDLEVELS))
(RETURN MAINWINDOW])
(ICMLARRAY.GETONEDWINDOWGROUP
[LAMBDA (MAINWINDOW SLICE FONT) (* jop: "25-Jul-85 16:32")
(PROG ([DWHEIGHT (IMIN 500 (HEIGHTIFWINDOW (TIMES (FONTPROP FONT (QUOTE HEIGHT))
(SLICEDIMENSION SLICE 0]
[DWWIDTH (IMIN 250 (WIDTHIFWINDOW (COMPUTEONEDFIELDWIDTH SLICE FONT]
[RWWIDTH (WIDTHIFWINDOW (TIMES 2 (STRINGWIDTH (QUOTE A)
FONT]
DWLEFT DWBOTTOM DISPLAYWINDOW RIGHTWINDOW)
(SETQ DWLEFT (DIFFERENCE (fetch LEFT of (WINDOWPROP MAINWINDOW (QUOTE REGION)))
(PLUS DWWIDTH RWWIDTH)))
(if (LESSP DWLEFT 0)
then (SETQ DWLEFT 0)
(SETQ DWWIDTH (DIFFERENCE (fetch LEFT of (WINDOWPROP MAINWINDOW (QUOTE REGION)))
RWWIDTH)))
(SETQ DWBOTTOM (DIFFERENCE (fetch TOP of (WINDOWPROP MAINWINDOW (QUOTE REGION)))
DWHEIGHT))
[if (LESSP DWBOTTOM 0)
then (SETQ DWBOTTOM 0)
(SETQ DWHEIGHT (fetch TOP of (WINDOWPROP MAINWINDOW (QUOTE REGION]
(* DISPLAYWINDOW is the central and main window of the
group)
(* DISPLAYWINDOW has at least five special properties;
SLICE TOPWINDOW RIGHTWINDOW VERTMARKS and HORZMARKS)
(SETQ DISPLAYWINDOW (CREATEW (CREATEREGION 0 0 DWWIDTH DWHEIGHT)
NIL NIL T))
(WINDOWPROP DISPLAYWINDOW (QUOTE REPAINTFN)
(FUNCTION ONED.REPAINTFN))
(WINDOWPROP DISPLAYWINDOW (QUOTE RESHAPEFN)
(FUNCTION ONED.RESHAPEFN))
(WINDOWPROP DISPLAYWINDOW (QUOTE SCROLLFN)
(FUNCTION ONED.SCROLLFN))
(WINDOWPROP DISPLAYWINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION ONED.BUTTONEVENTFN))
(DSPRIGHTMARGIN MAX.SMALLP DISPLAYWINDOW)
(WINDOWPROP DISPLAYWINDOW (QUOTE SLICE)
SLICE)
(DSPFONT FONT DISPLAYWINDOW) (* RIGHTWINDOW records the indices of the 0th virtual
dimension)
(SETQ RIGHTWINDOW (CREATEW (CREATEREGION 0 0 RWWIDTH DWHEIGHT)
NIL NIL T))
(WINDOWPROP RIGHTWINDOW (QUOTE REPAINTFN)
(FUNCTION ONEDRIGHTW.REPAINTFN))
(WINDOWPROP RIGHTWINDOW (QUOTE RESHAPEFN)
(FUNCTION ONEDRIGHTW.RESHAPEFN))
(WINDOWPROP RIGHTWINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(WINDOWPROP RIGHTWINDOW (QUOTE MINSIZE)
(CONS RWWIDTH 0))
(WINDOWPROP RIGHTWINDOW (QUOTE MAXSIZE)
(CONS RWWIDTH MAX.SMALLP))
(WINDOWPROP RIGHTWINDOW (QUOTE NOSCROLLBARS)
T)
(DSPFONT FONT RIGHTWINDOW)
(WINDOWPROP DISPLAYWINDOW (QUOTE RIGHTWINDOW)
RIGHTWINDOW) (* Put up the window group)
(MOVEW DISPLAYWINDOW DWLEFT DWBOTTOM) (* This has many side effects, including the creation
of activeregions and the filling of the window)
(ONED.RESHAPEFN DISPLAYWINDOW)
(ATTACHWINDOW RIGHTWINDOW DISPLAYWINDOW (QUOTE RIGHT))
(RETURN DISPLAYWINDOW])
(ICMLARRAY.GETREGIONFN
[LAMBDA (FIXEDPOINT MOVINGPOINT INFO) (* jop: "25-Jul-85 16:33")
(* * Controled reshape of a CMLARRAY inspector display window. For use with GETREGION Assumes that info is CONS pair
(WINDOW . STATE) The initial state is CLOSED. Assumes no init region or minsize)
(PROG ((WINDOW (CAR INFO))
(STATE (CDR INFO))
WINDOWREGION) (* Assumes Window is an attached window)
(SETQ WINDOWREGION (WINDOWREGION WINDOW))
(if (NULL MOVINGPOINT)
then [RETURN (create POSITION
XCOORD ←(ADD1 (fetch RIGHT of WINDOWREGION))
YCOORD ←(ADD1 (fetch TOP of WINDOWREGION]
else (if (EQ STATE (QUOTE CLOSED))
then (RPLACD INFO (QUOTE OPEN))
[RETURN (create POSITION
XCOORD ←(SUB1 (fetch LEFT of WINDOWREGION))
YCOORD ←(SUB1 (fetch BOTTOM of WINDOWREGION]
else (if (GREATERP (fetch XCOORD of MOVINGPOINT)
(fetch RIGHT of WINDOWREGION))
then (replace XCOORD of MOVINGPOINT with (fetch RIGHT of WINDOWREGION)))
(if (GREATERP (fetch YCOORD of MOVINGPOINT)
(fetch TOP of WINDOWREGION))
then (replace YCOORD of MOVINGPOINT with (fetch TOP of WINDOWREGION)))
(RETURN MOVINGPOINT])
(ICMLARRAY.GETSTATUSWINDOWGROUP
[LAMBDA (CMLARRAY WIDTH FONT DISPLAYEDLEVELS WHERE) (* jop: "28-Jul-85 17:31")
(* * CONSTRUCTS THE THREE WINDOWS OF THE STATUS GROUP AND PUTS THEM UP ON THE SCREEN. THE ONLY FREE PARAMETER IS THE
GROUP WIDTH, SINCE THE HEIGHTS ARE SET BY THE WINDOW CONTENTS. RETURNS THE MAINWINDOW OF THE GROUP.)
(PROG ((RANK (ARRAY-RANK CMLARRAY))
(SHEIGHT (HEIGHTIFWINDOW (TIMES 4 (FONTPROP FONT (QUOTE HEIGHT)))
T))
[PHEIGHT (HEIGHTIFWINDOW (FONTPROP FONT (QUOTE HEIGHT]
(MHEIGHT (HEIGHTIFWINDOW (TIMES 4 (FONTPROP FONT (QUOTE HEIGHT)))
T))
SWINDOW PWINDOW MWINDOW) (* SWINDOW is the status window)
(* SWINDOW has at least six special window props;
CMLARRAY DISPLAYEDLEVELS PRTWINDOW CURRENTSLICE
ONEDWINDOW and TWODWINDOW)
(RESETVAR *PRINT-ARRAY* NIL (SETQ SWINDOW (CREATEW (CREATEREGION 0 0 WIDTH SHEIGHT)
(CONCAT "Inspector of " CMLARRAY)
NIL T)))
(WINDOWPROP SWINDOW (QUOTE REPAINTFN)
(FUNCTION STATUSW.REPAINTFN)) (* Makes no sense to reshape the status window group)
(WINDOWPROP SWINDOW (QUOTE RESHAPEFN)
(QUOTE DON'T)) (* Cache the datum)
(WINDOWPROP SWINDOW (QUOTE CMLARRAY)
CMLARRAY) (* add BUTTONEVENTFN if we are displaying a value)
(if (EQP RANK 0)
then (WINDOWPROP SWINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION STATUSW.BUTTONEVENTFN)))
(* DISPLAYEDLEVELS is a description of the array slice
to be displayed)
(WINDOWPROP SWINDOW (QUOTE DISPLAYEDLEVELS)
DISPLAYEDLEVELS) (* PWINDOW is the prompt window)
(SETQ PWINDOW (CREATEW (CREATEREGION 0 0 WIDTH PHEIGHT)
NIL NIL T))
(WINDOWPROP PWINDOW (QUOTE PAGEFULLFN)
(FUNCTION NILL))
(DSPSCROLL (QUOTE ON)
PWINDOW)
(WINDOWPROP SWINDOW (QUOTE PRTWINDOW)
PWINDOW) (* MWINDOW is the menu window)
(if (GREATERP RANK 1)
then (SETQ MWINDOW (CREATEW (CREATEREGION 0 0 WIDTH MHEIGHT)
"Current Slice" NIL T))
(WINDOWPROP MWINDOW (QUOTE REPAINTFN)
(FUNCTION MENUW.REPAINTFN))
(WINDOWPROP MWINDOW (QUOTE RESHAPEFN)
(FUNCTION MENUW.RESHAPEFN))
(WINDOWPROP MWINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION MENUW.BUTTONEVENTFN))
(WINDOWPROP MWINDOW (QUOTE CURSORMOVEDFN)
(FUNCTION MENUW.CURSORMOVEDFN))
(WINDOWPROP MWINDOW (QUOTE CURSOROUTFN)
(FUNCTION MENUW.CURSOROUTFN)))
(* POSITION AND OPEN THE WINDOWGROUP)
[MOVEW SWINDOW (if WHERE
then (create POSITION
XCOORD ←(fetch XCOORD of WHERE)
YCOORD ←(PLUS (fetch YCOORD of WHERE)
PHEIGHT
(if (GREATERP RANK 1)
then MHEIGHT
else 0)))
else (GETBOXPOSITION (fetch WIDTH of (WINDOWPROP SWINDOW (QUOTE REGION)))
(fetch HEIGHT of (WINDOWPROP SWINDOW (QUOTE REGION]
(STATUSW.REPAINTFN SWINDOW)
(ATTACHWINDOW PWINDOW SWINDOW (QUOTE BOTTOM))
(if (GREATERP RANK 1)
then (ATTACHWINDOW MWINDOW SWINDOW (QUOTE BOTTOM)))
(RETURN SWINDOW])
(ICMLARRAY.GETTWODWINDOWGROUP
[LAMBDA (MAINWINDOW SLICE FONT) (* jop: "23-Jul-85 17:43")
(PROG ([DWHEIGHT (IMIN 500 (HEIGHTIFWINDOW (TIMES (FONTPROP FONT (QUOTE HEIGHT))
(SLICEDIMENSION SLICE 0]
[DWWIDTH (IMIN 400 (WIDTHIFWINDOW (COMPUTETWODTOTALWIDTH SLICE FONT]
[TWHEIGHT (HEIGHTIFWINDOW (FONTPROP FONT (QUOTE HEIGHT]
[RWWIDTH (WIDTHIFWINDOW (TIMES 2 (STRINGWIDTH (QUOTE A)
FONT]
[CWWIDTH (WIDTHIFWINDOW (TIMES 2 (STRINGWIDTH (QUOTE A)
FONT]
[CWHEIGHT (HEIGHTIFWINDOW (FONTPROP FONT (QUOTE HEIGHT]
DWLEFT DWBOTTOM DISPLAYWINDOW TOPWINDOW RIGHTWINDOW CORNERWINDOW)
(SETQ DWLEFT (DIFFERENCE (fetch LEFT of (WINDOWPROP MAINWINDOW (QUOTE REGION)))
(PLUS DWWIDTH RWWIDTH)))
(if (LESSP DWLEFT 0)
then (SETQ DWLEFT 0)
(SETQ DWWIDTH (DIFFERENCE (fetch LEFT of (WINDOWPROP MAINWINDOW (QUOTE REGION)))
RWWIDTH)))
(SETQ DWBOTTOM (DIFFERENCE (fetch TOP of (WINDOWPROP MAINWINDOW (QUOTE REGION)))
(PLUS DWHEIGHT TWHEIGHT)))
(if (LESSP DWBOTTOM 0)
then (SETQ DWBOTTOM 0)
(SETQ DWHEIGHT (DIFFERENCE (fetch TOP of (WINDOWPROP MAINWINDOW (QUOTE REGION)))
TWHEIGHT))) (* DISPLAYWINDOW is the central and main window of the
group)
(* DISPLAYWINDOW has five special properties;
SLICE TOPWINDOW RIGHTWINDOW VERTMARKS and HORZMARKS)
(SETQ DISPLAYWINDOW (CREATEW (CREATEREGION 0 0 DWWIDTH DWHEIGHT)
NIL NIL T))
(WINDOWPROP DISPLAYWINDOW (QUOTE REPAINTFN)
(FUNCTION TWOD.REPAINTFN))
(WINDOWPROP DISPLAYWINDOW (QUOTE RESHAPEFN)
(FUNCTION TWOD.RESHAPEFN))
(WINDOWPROP DISPLAYWINDOW (QUOTE SCROLLFN)
(FUNCTION TWOD.SCROLLFN))
(WINDOWPROP DISPLAYWINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION TWOD.BUTTONEVENTFN))
(DSPRIGHTMARGIN MAX.SMALLP DISPLAYWINDOW)
(WINDOWPROP DISPLAYWINDOW (QUOTE SLICE)
SLICE)
(DSPFONT FONT DISPLAYWINDOW) (* TOPWINDOW simply records the indices of the 1st
virtual dimension)
(SETQ TOPWINDOW (CREATEW (CREATEREGION 0 0 DWWIDTH TWHEIGHT)
NIL NIL T))
(WINDOWPROP TOPWINDOW (QUOTE REPAINTFN)
(FUNCTION TOPW.REPAINTFN))
(WINDOWPROP TOPWINDOW (QUOTE RESHAPEFN)
(FUNCTION TOPW.RESHAPEFN))
(WINDOWPROP TOPWINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(WINDOWPROP TOPWINDOW (QUOTE MINSIZE)
(CONS 0 TWHEIGHT))
(WINDOWPROP TOPWINDOW (QUOTE MAXSIZE)
(CONS MAX.SMALLP TWHEIGHT))
(DSPRIGHTMARGIN MAX.SMALLP TOPWINDOW) (* TOPWINDOW will scroll under program control)
(WINDOWPROP TOPWINDOW (QUOTE NOSCROLLBARS)
T)
(DSPFONT FONT TOPWINDOW)
(WINDOWPROP DISPLAYWINDOW (QUOTE TOPWINDOW)
TOPWINDOW) (* RIGHTWINDOW records the indices of the 0th virtual
dimension)
(SETQ RIGHTWINDOW (CREATEW (CREATEREGION 0 0 RWWIDTH DWHEIGHT)
NIL NIL T))
(WINDOWPROP RIGHTWINDOW (QUOTE REPAINTFN)
(FUNCTION RIGHTW.REPAINTFN))
(WINDOWPROP RIGHTWINDOW (QUOTE RESHAPEFN)
(FUNCTION RIGHTW.RESHAPEFN))
(WINDOWPROP RIGHTWINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(WINDOWPROP RIGHTWINDOW (QUOTE MINSIZE)
(CONS RWWIDTH 0))
(WINDOWPROP RIGHTWINDOW (QUOTE MAXSIZE)
(CONS RWWIDTH MAX.SMALLP))
(WINDOWPROP RIGHTWINDOW (QUOTE NOSCROLLBARS)
T)
(DSPFONT FONT RIGHTWINDOW)
(WINDOWPROP DISPLAYWINDOW (QUOTE RIGHTWINDOW)
RIGHTWINDOW) (* CORNERWINDOW is just a place holder)
(SETQ CORNERWINDOW (CREATEW (CREATEREGION 0 0 CWWIDTH CWHEIGHT)
NIL NIL T))
(WINDOWPROP CORNERWINDOW (QUOTE MINSIZE)
(CONS CWWIDTH CWHEIGHT))
(WINDOWPROP CORNERWINDOW (QUOTE MAXSIZE)
(CONS CWWIDTH CWHEIGHT)) (* Put up the window group)
(MOVEW DISPLAYWINDOW DWLEFT DWBOTTOM) (* This has many side effects, including the creation
of activeregions and the filling of the window)
(TWOD.RESHAPEFN DISPLAYWINDOW)
(ATTACHWINDOW TOPWINDOW DISPLAYWINDOW (QUOTE TOP))
(ATTACHWINDOW CORNERWINDOW RIGHTWINDOW (QUOTE TOP))
(ATTACHWINDOW RIGHTWINDOW DISPLAYWINDOW (QUOTE RIGHT))
(RETURN DISPLAYWINDOW])
(INVERTREGION
[LAMBDA (WINDOW AREGION) (* jop: " 5-Jun-85 16:00")
(PROG ((REGION (fetch REGION of AREGION)))
(BITBLT NIL NIL NIL WINDOW (fetch LEFT of REGION)
(fetch BOTTOM of REGION)
(fetch WIDTH of REGION)
(fetch HEIGHT of REGION)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(LISTNCHARS
[LAMBDA (LST DEPTH FONT FLG RDTBL) (* jop: "19-Jul-85 16:30")
(* CDRVAL must be non-negative to get here)
(if (EQP (CAR (PRINTLEVEL))
DEPTH)
then 1
else (PROG ((TCDRLEVEL (DIFFERENCE (CDR (PRINTLEVEL))
DEPTH))
TOTALCHARS)
[SETQ TOTALCHARS (PLUS 1 (for ITEM in LST as I from 0 while (GREATERP TCDRLEVEL I)
sum (PLUS (if (LISTP ITEM)
then (LISTNCHARS ITEM (ADD1 DEPTH)
FLG RDTBL)
else (NCHARS ITEM FLG RDTBL))
1]
(SETQ TOTALCHARS (PLUS TOTALCHARS (if (GREATERP (LENGTH LST)
TCDRLEVEL)
then 2
else -1)
1))
(RETURN TOTALCHARS])
(LISTSTRREGION
[LAMBDA (LST DEPTH STREAM FLG RDTBL) (* jop: "19-Jul-85 16:54")
(* CDRVAL must be non-negative to get here)
(CREATEREGION (DSPXPOSITION NIL STREAM)
(DIFFERENCE (DSPYPOSITION NIL STREAM)
(FONTPROP STREAM (QUOTE DESCENT)))
(PLSTRINGWIDTH LST STREAM FLG RDTBL)
(FONTPROP STREAM (QUOTE HEIGHT])
(LISTSTRWIDTH
[LAMBDA (LST DEPTH FONT FLG RDTBL) (* jop: "21-Jul-85 13:19")
(* CDRVAL must be non-negative to get here)
(if (EQP (CAR (PRINTLEVEL))
DEPTH)
then (STRINGWIDTH (QUOTE &)
FONT FLG RDTBL)
else (PROG ((TCDRLEVEL (DIFFERENCE (CDR (PRINTLEVEL))
DEPTH))
(WIDTHOFSPACE (STRINGWIDTH (QUOTE % )
FONT FLG RDTBL))
TOTALWIDTH)
[SETQ TOTALWIDTH (PLUS (STRINGWIDTH (QUOTE %()
FONT FLG RDTBL)
(for ITEM in LST as I from 0 while (GREATERP TCDRLEVEL I)
sum (PLUS (if (LISTP ITEM)
then (LISTSTRWIDTH ITEM (ADD1 DEPTH)
FONT FLG RDTBL)
else (STRINGWIDTH ITEM FONT FLG RDTBL))
WIDTHOFSPACE]
(SETQ TOTALWIDTH (PLUS TOTALWIDTH (if (GREATERP (LENGTH LST)
TCDRLEVEL)
then (STRINGWIDTH (QUOTE --)
FONT FLG RDTBL)
else (IMINUS WIDTHOFSPACE))
(STRINGWIDTH (QUOTE %))
FONT FLG RDTBL)))
(RETURN TOTALWIDTH])
(MENU.GETLEVEL
[LAMBDA (WINDOW DIM) (* jop: "28-Jul-85 17:33")
(* * Get a new LEVEL for dim DIM and redisplay the MENU window)
(PROG ((MAINW (MAINWINDOW WINDOW))
(LEVELS (WINDOWPROP WINDOW (QUOTE LEVELS)))
CMLARRAY PRTWINDOW LEVEL NEWVALUE)
(SETQ CMLARRAY (WINDOWPROP MAINW (QUOTE CMLARRAY)))
(SETQ PRTWINDOW (WINDOWPROP MAINW (QUOTE PRTWINDOW)))
[SETQ LEVEL (CAR (NTH LEVELS (ADD1 DIM]
(printout PRTWINDOW T)
(SETQ NEWVALUE (PROMPTFORWORD (CONCAT "NEW LEVEL FOR DIM " DIM " :")
LEVEL "TYPE A LEVEL VALUE OR ALL" PRTWINDOW))
[if (STRINGP NEWVALUE)
then (if (STREQUAL NEWVALUE "ALL")
then (SETQ LEVEL (QUOTE ALL))
else (SETQ NEWVALUE (READ (OPENSTRINGSTREAM NEWVALUE)))
(if (AND (FIXP NEWVALUE)
(GEQ NEWVALUE 0)
(LESSP NEWVALUE (ARRAY-DIMENSION CMLARRAY DIM)))
then (SETQ LEVEL NEWVALUE)
else (printout (WINDOWPROP MAINW (QUOTE PRTWINDOW))
T
(CONCAT "ILLEGAL VALUE " NEWVALUE]
(RPLACA (NTH LEVELS (ADD1 DIM))
LEVEL)
(MENUW.REPAINTFN WINDOW])
(MENUW.APPLY
[LAMBDA (WINDOW) (* jop: "25-Jul-85 16:37")
(* * Display the slice descibed by the windowprop LEVELS)
(PROG ((MAINW (MAINWINDOW WINDOW))
(LEVELS (WINDOWPROP WINDOW (QUOTE LEVELS)))
SLICEDIM)
[SETQ SLICEDIM (for LEVEL in LEVELS count (EQ LEVEL (QUOTE ALL]
(if (OR (LESSP SLICEDIM 1)
(GREATERP SLICEDIM 2))
then (printout (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE PRTWINDOW))
T "NOT A VALID SLICE")
else [WINDOWPROP MAINW (QUOTE DISPLAYEDLEVELS)
(COPY (WINDOWPROP WINDOW (QUOTE LEVELS]
(DISPLAYSLICE MAINW (WINDOWPROP MAINW (QUOTE DISPLAYEDLEVELS])
(MENUW.BUTTONEVENTFN
[LAMBDA (WINDOW) (* jop: "22-Jul-85 12:38")
(PROG [(ACTIVEREGIONS (WINDOWPROP WINDOW (QUOTE ACTIVEREGIONS)))
(SELECTEDREGION (WINDOWPROP WINDOW (QUOTE SELECTEDREGION]
(TOTOPW WINDOW)
(if SELECTEDREGION
then (OUTLINEREGION WINDOW SELECTEDREGION)
(INVERTREGION WINDOW SELECTEDREGION)
(until (MOUSESTATE UP) do (BLOCK))
(INVERTREGION WINDOW SELECTEDREGION)
(WINDOWPROP WINDOW (QUOTE SELECTEDREGION)
NIL)
(if (NULL (WINDOWPROP WINDOW (QUOTE ASKING)))
then (APPLY* (fetch (ICMLARRAY.ACTIVEREGION FUNCTION) of SELECTEDREGION)
WINDOW
(fetch (ICMLARRAY.ACTIVEREGION DATA) of SELECTEDREGION])
(MENUW.CURSORMOVEDFN
[LAMBDA (WINDOW) (* jop: "22-Jul-85 12:34")
(PROG [(ACTIVEREGIONS (WINDOWPROP WINDOW (QUOTE ACTIVEREGIONS)))
(SELECTEDREGION (WINDOWPROP WINDOW (QUOTE SELECTEDREGION]
(bind (CURSOR ←(CURSORPOSITION NIL WINDOW))
FOUNDIT for AREGION in ACTIVEREGIONS until FOUNDIT
do (if (INSIDEP (fetch (ICMLARRAY.ACTIVEREGION REGION) of AREGION)
CURSOR)
then (SETQ FOUNDIT AREGION))
finally (if (AND FOUNDIT (NOT (EQ SELECTEDREGION FOUNDIT)))
then (* Lowlight previous region)
(if SELECTEDREGION
then (OUTLINEREGION WINDOW SELECTEDREGION))
(* highlight new region)
(OUTLINEREGION WINDOW FOUNDIT)
(WINDOWPROP WINDOW (QUOTE SELECTEDREGION)
FOUNDIT)
elseif (AND (NULL FOUNDIT)
SELECTEDREGION)
then (* Cursor between regions)
(OUTLINEREGION WINDOW SELECTEDREGION)
(WINDOWPROP WINDOW (QUOTE SELECTEDREGION)
NIL])
(MENUW.CURSOROUTFN
[LAMBDA (WINDOW) (* jop: "25-Jul-85 12:16")
(PROG [(SELECTEDREGION (WINDOWPROP WINDOW (QUOTE SELECTEDREGION]
(if SELECTEDREGION
then (OUTLINEREGION WINDOW SELECTEDREGION)
(WINDOWPROP WINDOW (QUOTE SELECTEDREGION)
NIL])
(MENUW.MAKEREGIONS
[LAMBDA (WINDOW) (* jop: "25-Jul-85 16:39")
(* * Sets up activeregion)
(PROG ((LEVELS (WINDOWPROP WINDOW (QUOTE LEVELS)))
(HORZINC (STRINGWIDTH (QUOTE A)
(DSPFONT NIL WINDOW)))
(LF (DSPLINEFEED NIL WINDOW))
ACTIVEREGIONS)
(if (NULL LEVELS)
then [SETQ LEVELS (COPY (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE DISPLAYEDLEVELS]
(WINDOWPROP WINDOW (QUOTE LEVELS)
LEVELS))
(MOVETOUPPERLEFT WINDOW)
[SETQ ACTIVEREGIONS (LIST (create ICMLARRAY.ACTIVEREGION
REGION ←(STRINGREGION "SHOW" WINDOW)
FUNCTION ←(FUNCTION MENUW.SHOW]
(RELMOVETO (TIMES HORZINC (DIFFERENCE (SUB1 (LINELENGTH NIL WINDOW))
(NCHARS "SHOW")))
0 WINDOW)
(push ACTIVEREGIONS (create ICMLARRAY.ACTIVEREGION
REGION ←(STRINGREGION "APPLY" WINDOW)
FUNCTION ←(FUNCTION MENUW.APPLY)))
(MOVETO 0 (PLUS (WINDOWPROP WINDOW (QUOTE HEIGHT))
(TIMES 4 LF))
WINDOW)
(bind (VMARK ←(DSPYPOSITION NIL WINDOW))
(FIELDWIDTH ←(TIMES 4 HORZINC))
(FIELDHEIGHT ←(FONTPROP WINDOW (QUOTE HEIGHT))) for DIM from 0
to (SUB1 (LENGTH LEVELS)) as HMARK from (TIMES HORZINC 11) by (TIMES HORZINC 5)
do (push ACTIVEREGIONS (create ICMLARRAY.ACTIVEREGION
REGION ←(CREATEREGION HMARK VMARK FIELDWIDTH FIELDHEIGHT)
FUNCTION ←(FUNCTION MENU.GETLEVEL)
DATA ← DIM)))
(WINDOWPROP WINDOW (QUOTE ACTIVEREGIONS)
ACTIVEREGIONS])
(MENUW.REPAINTFN
[LAMBDA (WINDOW) (* jop: "28-Jul-85 17:31")
(PROG [(CMLARRAY (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE CMLARRAY)))
(LEVELS (WINDOWPROP WINDOW (QUOTE LEVELS)))
(SELECTEDREGION (WINDOWPROP WINDOW (QUOTE SELECTEDREGION]
[if (NULL LEVELS)
then (MENUW.MAKEREGIONS WINDOW)
(SETQ LEVELS (WINDOWPROP WINDOW (QUOTE LEVELS]
(DSPRESET WINDOW)
(printout WINDOW "SHOW " .FR (LINELENGTH NIL WINDOW)
"APPLY" T T)
(first (printout WINDOW "Dimension:") for I from 0 to (SUB1 (ARRAY-RANK CMLARRAY))
do (printout WINDOW .I5 I) finally (printout WINDOW T))
(first (printout WINDOW "Level: ") for LEVEL in LEVELS as HMARK from 15 by 5
do (printout WINDOW .FR HMARK LEVEL))
(if SELECTEDREGION
then (OUTLINEREGION WINDOW SELECTEDREGION])
(MENUW.RESHAPEFN
[LAMBDA (WINDOW) (* jop: " 9-Jun-85 16:57")
(MENUW.MAKEREGIONS WINDOW)
(MENUW.REPAINTFN WINDOW])
(MENUW.SHOW
[LAMBDA (WINDOW) (* jop: "25-Jul-85 16:40")
(WINDOWPROP WINDOW (QUOTE LEVELS)
NIL) (* This has the side effect of forcing MENUW.REPAINTFN
to take the value of DISPLAYEDLEVELS as the value of
LEVELS)
(MENUW.REPAINTFN WINDOW])
(ONED.BUTTONEVENTFN
[LAMBDA (WINDOW) (* jop: "28-Jul-85 16:03")
(PROG [(ACTIVEREGIONS (WINDOWPROP WINDOW (QUOTE ACTIVEREGIONS)))
(SELECTEDREGION (WINDOWPROP WINDOW (QUOTE SELECTEDREGION]
(TOTOPW WINDOW)
[while (MOUSESTATE LEFT) do (bind (CURSOR ←(CURSORPOSITION NIL WINDOW))
FOUNDIT for AREGION in ACTIVEREGIONS until FOUNDIT
do (if (INSIDEP (fetch REGION of AREGION)
CURSOR)
then (SETQ FOUNDIT AREGION))
finally (if (AND FOUNDIT (NOT (EQ SELECTEDREGION FOUNDIT)))
then (if SELECTEDREGION
then (INVERTREGION WINDOW
SELECTEDREGION))
(INVERTREGION WINDOW FOUNDIT)
(WINDOWPROP WINDOW (QUOTE SELECTEDREGION)
FOUNDIT)
(SETQ SELECTEDREGION FOUNDIT]
(if (MOUSESTATE MIDDLE)
then (if SELECTEDREGION
then (APPLY* (fetch (ICMLARRAY.ACTIVEREGION FUNCTION) of SELECTEDREGION)
WINDOW SELECTEDREGION])
(ONED.DOWINDOWCOMFN
[LAMBDA (ONEDWINDOW) (* jop: "25-Jul-85 16:41")
(* * Pass on the usual comms, except for SHAPEW)
(PROG (COM)
(SETQ COM (MENU WindowMenu))
(SELECTQ COM
(NIL NIL)
[SHAPEW (SHAPEW ONEDWINDOW (GETREGION NIL NIL NIL (FUNCTION ICMLARRAY.GETREGIONFN)
(CONS ONEDWINDOW (QUOTE CLOSED]
((MOVEW CLOSEW SHRINKW BURYW)
(APPLY* COM (MAINWINDOW ONEDWINDOW)))
(APPLY* COM ONEDWINDOW])
(ONED.INDICES
[LAMBDA (SLICE SELECTEDREGION WINDOW) (* jop: "28-Jul-85 17:31")
(* * Display the indices of the selected item in the group promptwindow)
(PROG ((DISPLAYEDLEVELS (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE DISPLAYEDLEVELS)))
(PRTWINDOW (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE PRTWINDOW)))
(DATA (fetch (ICMLARRAY.ACTIVEREGION DATA) of SELECTEDREGION)))
(printout PRTWINDOW T "INDICES: ")
(for LEVEL in DISPLAYEDLEVELS as I from 0 to (SUB1 (ARRAY-RANK (fetch (ICMLARRAY.ARRAYSLICE
ARRAY)
of SLICE)))
do (if (EQ LEVEL (QUOTE ALL))
then (printout PRTWINDOW .I5 DATA)
else (printout PRTWINDOW .I5 LEVEL])
(ONED.MAKEREGIONS
[LAMBDA (WINDOW) (* jop: "25-Jul-85 16:42")
(* * Sets up some windowprops and activeregions)
(RESETFORM (PRINTLEVEL (QUOTE (2 . 5)))
(PROG ((SLICE (WINDOWPROP WINDOW (QUOTE SLICE)))
(WINDOWHEIGHT (WINDOWPROP WINDOW (QUOTE HEIGHT)))
(LF (DSPLINEFEED NIL WINDOW))
FIELDWIDTH ACTIVEREGIONS VERTMARKS DIM0)
(if (NULL SLICE)
then (RETURN))
(SETQ DIM0 (SLICEDIMENSION SLICE 0))
(WINDOWPROP WINDOW (QUOTE FIELDWIDTH)
(SETQ FIELDWIDTH (COMPUTEONEDFIELDWIDTH SLICE WINDOW)))
(SETQ VERTMARKS (for I from 1 to DIM0 as MARK from (PLUS WINDOWHEIGHT LF)
by LF collect MARK))
(bind (FHEIGHT ←(FONTPROP WINDOW (QUOTE HEIGHT))) for I from 0
to (SUB1 DIM0) as VERTMARK in VERTMARKS
do (push ACTIVEREGIONS (create ICMLARRAY.ACTIVEREGION
REGION ←(CREATEREGION 0 VERTMARK FIELDWIDTH
FHEIGHT)
FUNCTION ←(FUNCTION ONED.MENUFN)
DATA ← I)))
(WINDOWPROP WINDOW (QUOTE VERTMARKS)
VERTMARKS)
(WINDOWPROP WINDOW (QUOTE ACTIVEREGIONS)
ACTIVEREGIONS)
[WINDOWPROP WINDOW (QUOTE EXTENT)
(CREATEREGION 0 (CAR (LAST VERTMARKS))
FIELDWIDTH
(DIFFERENCE WINDOWHEIGHT (CAR (LAST VERTMARKS]
(WINDOWPROP (WINDOWPROP WINDOW (QUOTE RIGHTWINDOW))
(QUOTE EXTENT)
(CREATEREGION 0 (CAR (LAST VERTMARKS))
(WINDOWPROP (WINDOWPROP WINDOW (QUOTE RIGHTWINDOW))
(QUOTE WIDTH))
(DIFFERENCE WINDOWHEIGHT (CAR (LAST VERTMARKS])
(ONED.MENUFN
[LAMBDA (WINDOW SELECTEDREGION) (* jop: "28-Jul-85 16:46")
(* * Called from ONED.BUTTONEVENTFN)
(PROG ((SLICE (WINDOWPROP WINDOW (QUOTE SLICE)))
[PMENU (CONSTANT (create MENU
ITEMS ←(QUOTE ((Inspect (QUOTE INSPECT)
"Inspect item")
(Set (QUOTE SET)
"Set item")
(Indices (QUOTE INDICES)
"Display element indices ")
(IT% ←% Datum
(QUOTE SETIT)
"Bind IT to selected item"]
[OMENU (CONSTANT (create MENU
ITEMS ←(QUOTE ((Set (QUOTE SET)
"Set item")
(Indices (QUOTE INDICES)
"Display element indices ")
(IT% ←% Datum
(QUOTE SETIT)
"Bind IT to selected item"]
(DATA (fetch (ICMLARRAY.ACTIVEREGION DATA) of SELECTEDREGION))
MODE DATUM)
(if SELECTEDREGION
then (SETQ DATUM (SLICEREF SLICE DATA))
(if (OR (NUMBERP DATUM)
(NULL DATUM))
then (SETQ MODE (MENU OMENU))
else (SETQ MODE (MENU PMENU)))
(SELECTQ MODE
(INSPECT (* uses VALUECMDFN to get auxillary menus that depend
on type. Assumes one arg to VALUECMDFN suffices)
(if (NULL DATUM)
then (printout (GETPROMPTWINDOW WINDOW)
T "CAN'T INSPECT NIL")
elseif (OR (LISTP DATUM)
(LITATOM DATUM))
then (DEFAULT.INSPECTW.VALUECOMMANDFN DATUM)
else (INSPECT DATUM)))
(SET (ONED.SETVALUE SLICE SELECTEDREGION WINDOW))
(SETIT (SETQ IT (SLICEREF SLICE DATA)))
(INDICES (ONED.INDICES SLICE SELECTEDREGION WINDOW))
NIL])
(ONED.PRTELEMENT
[LAMBDA (SLICE I WINDOW VMARK) (* jop: "23-Jul-85 16:07")
(PROG ((ELT (SLICEREF SLICE I)))
(MOVETO 0 (PLUS VMARK (FONTPROP WINDOW (QUOTE DESCENT)))
WINDOW)
(printout WINDOW ELT])
(ONED.REPAINTFN
[LAMBDA (WINDOW WINDOWREGION) (* jop: "23-Jul-85 16:09")
(if (NULL WINDOWREGION)
then (SETQ WINDOWREGION (DSPCLIPPINGREGION NIL WINDOW)))
(RESETLST [RESETSAVE (PRINTLEVEL (QUOTE (2 . 5]
(RESETSAVE PLVLFILEFLG T)
(PROG ((SLICE (WINDOWPROP WINDOW (QUOTE SLICE)))
(SELECTEDREGION (WINDOWPROP WINDOW (QUOTE SELECTEDREGION)))
(TOP (fetch TOP of WINDOWREGION))
(BOTTOM (fetch BOTTOM of WINDOWREGION))
(VERTMARKS (WINDOWPROP WINDOW (QUOTE VERTMARKS)))
(LF (DSPLINEFEED NIL WINDOW))
(FIELDWIDTH (WINDOWPROP WINDOW (QUOTE FIELDWIDTH)))
DIM0 FIRSTI LASTI)
(if (NULL SLICE)
then (RETURN))
(SETQ DIM0 (SLICEDIMENSION SLICE 0))
(SETQ FIRSTI (for MARK in VERTMARKS as I from 0 to (SUB1 DIM0)
until (LESSP MARK TOP) finally (RETURN I)))
(if (LESSP FIRSTI DIM0)
then [SETQ LASTI (for MARK in (NTH VERTMARKS (ADD1 FIRSTI)) as I
from FIRSTI to (SUB1 DIM0) until (LESSP MARK BOTTOM)
finally (RETURN (IMIN I (SUB1 DIM0]
[SETQ VMARK (CAR (NTH VERTMARKS (ADD1 FIRSTI]
(for I from FIRSTI to LASTI as VMARK in (NTH VERTMARKS (ADD1 FIRSTI))
do (ONED.PRTELEMENT SLICE I WINDOW VMARK))
(if SELECTEDREGION
then (INVERTREGION WINDOW SELECTEDREGION])
(ONED.RESHAPEFN
[LAMBDA (WINDOW) (* jop: "23-Jul-85 15:18")
(PROG ((SELECTEDREGION (WINDOWPROP WINDOW (QUOTE SELECTEDREGION)))
I)
(DSPRESET WINDOW)
(ONED.MAKEREGIONS WINDOW) (* This song and dance is to insure that the
SELECTEDREGION is properly placed)
[if SELECTEDREGION
then (SETQ I (fetch (ICMLARRAY.ACTIVEREGION DATA) of SELECTEDREGION))
(WINDOWPROP WINDOW (QUOTE SELECTEDREGION)
(bind FOUNDIT DATA for AREGION in (WINDOWPROP WINDOW (QUOTE
ACTIVEREGIONS))
until FOUNDIT
do (SETQ DATA (fetch (ICMLARRAY.ACTIVEREGION DATA) of AREGION))
(if (EQP DATA I)
then (SETQ FOUNDIT AREGION))
finally (RETURN FOUNDIT]
(ONED.REPAINTFN WINDOW])
(ONED.SCROLLFN
[LAMBDA (WINDOW DX DY FLG) (* jop: "25-Jul-85 16:44")
(* * Makes the ONEDRIGHTW scroll in tandem)
(PROG [(RIGHTWINDOW (WINDOWPROP WINDOW (QUOTE RIGHTWINDOW]
(if (OR (NOT (EQP 0 DY))
(FLOATP DY))
then (APPLY* (WINDOWPROP RIGHTWINDOW (QUOTE SCROLLFN))
RIGHTWINDOW 0 DY FLG))
(SCROLLBYREPAINTFN WINDOW DX DY FLG])
(ONED.SETVALUE
[LAMBDA (SLICE SELECTEDREGION WINDOW) (* jop: "28-Jul-85 16:07")
(* * Set the value of the selected item)
(PROG ((PRTWINDOW (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE PRTWINDOW)))
(I (fetch (ICMLARRAY.ACTIVEREGION DATA) of SELECTEDREGION))
(VERTMARKS (WINDOWPROP WINDOW (QUOTE VERTMARKS)))
(FIELDWIDTH (WINDOWPROP WINDOW (QUOTE FIELDWIDTH)))
NEWVALUE VMARK)
[RESETFORM (SET.TTYINEDIT.WINDOW PRTWINDOW)
(SETQ NEWVALUE (EVAL (CAR (TTYIN "NEWVALUE? " NIL NIL (QUOTE EVALQT)
NIL NIL NIL T]
(SLICESET SLICE NEWVALUE I)
(RESETLST [RESETSAVE (PRINTLEVEL (QUOTE (2 . 5]
(RESETSAVE PLVLFILEFLG T)
(if (LESSP (PLSTRINGWIDTH NEWVALUE WINDOW)
FIELDWIDTH)
then (* Update the right field)
[SETQ VMARK (CAR (NTH VERTMARKS (ADD1 I]
(BITBLT NIL NIL NIL WINDOW 0 VMARK FIELDWIDTH (FONTPROP WINDOW
(QUOTE HEIGHT))
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(ONED.PRTELEMENT SLICE I WINDOW VMARK)
(INVERTREGION WINDOW SELECTEDREGION)
else (* Remake the entire display)
(ONED.RESHAPEFN WINDOW)
(ONEDRIGHTW.RESHAPEFN (WINDOWPROP WINDOW (QUOTE RIGHTWINDOW])
(ONEDRIGHTW.REPAINTFN
[LAMBDA (WINDOW WINDOWREGION) (* jop: "23-Jul-85 15:23")
(if (NULL WINDOWREGION)
then (SETQ WINDOWREGION (DSPCLIPPINGREGION NIL WINDOW)))
(PROG ((DWINDOW (MAINWINDOW WINDOW))
(TOP (fetch TOP of WINDOWREGION))
(BOTTOM (fetch BOTTOM of WINDOWREGION))
VERTMARKS DIM0 FIRSTI LASTI)
(if (NULL (WINDOWPROP DWINDOW (QUOTE SLICE)))
then (RETURN))
(SETQ VERTMARKS (WINDOWPROP DWINDOW (QUOTE VERTMARKS)))
(SETQ DIM0 (LENGTH VERTMARKS))
(SETQ FIRSTI (for MARK in VERTMARKS as I from 0 to (SUB1 DIM0) until (LESSP MARK TOP)
finally (RETURN I)))
(if (LESSP FIRSTI DIM0)
then [SETQ LASTI (for MARK in (NTH VERTMARKS (ADD1 FIRSTI)) as I from FIRSTI
to (SUB1 DIM0) until (LESSP MARK BOTTOM)
finally (RETURN (IMIN I (SUB1 DIM0]
(MOVETO 0 (PLUS (CAR (NTH VERTMARKS (ADD1 FIRSTI)))
(FONTPROP WINDOW (QUOTE DESCENT)))
WINDOW)
(bind [FORMAT ←(LIST (QUOTE FIX)
(NCHARS (SUB1 DIM0]
for I from FIRSTI to LASTI do (printout WINDOW .N FORMAT I T])
(ONEDRIGHTW.RESHAPEFN
[LAMBDA (WINDOW) (* jop: "23-Jul-85 15:23")
(DSPRESET WINDOW)
(ONEDRIGHTW.REPAINTFN WINDOW (DSPCLIPPINGREGION NIL WINDOW])
(OUTLINEREGION
[LAMBDA (WINDOW ACTIVEREGION) (* jop: "28-Jul-85 15:15")
(PROG ((REGION (fetch REGION of ACTIVEREGION))
LEFT BOTTOM TOP RIGHT)
(SETQ LEFT (fetch LEFT of REGION))
(SETQ BOTTOM (fetch BOTTOM of REGION))
(SETQ TOP (fetch TOP of REGION))
(SETQ RIGHT (fetch RIGHT of REGION))
(DRAWLINE LEFT BOTTOM (SUB1 RIGHT)
BOTTOM 1 (QUOTE INVERT)
WINDOW)
(DRAWLINE RIGHT BOTTOM RIGHT (SUB1 TOP)
1
(QUOTE INVERT)
WINDOW)
(DRAWLINE RIGHT TOP (ADD1 LEFT)
TOP 1 (QUOTE INVERT)
WINDOW)
(DRAWLINE LEFT TOP LEFT (ADD1 BOTTOM)
1
(QUOTE INVERT)
WINDOW])
(PLNCHARS
[LAMBDA (STR FLG RDTBL) (* jop: "25-Jul-85 16:46")
(* * A VERSION OF NCHARS WHICH PAYS ATTENTION TO PRINT LEVEL)
(if (OR (NOT (LISTP STR))
(LESSP (CDR (PRINTLEVEL))
0)
(LESSP (CAR (PRINTLEVEL))
0))
then (NCHARS STR FLG RDTBL)
else (LISTNCHARS STR 0 FLG RDTBL])
(PLSTRINGREGION
[LAMBDA (STR STREAM FLG RDTBL) (* jop: "21-Jul-85 13:42")
(* * A VERSION OF STRINREGION WHICH PAYS ATTENTION TO PRINT LEVEL)
(if (OR (NOT (LISTP STR))
(LESSP (CDR (PRINTLEVEL))
0)
(LESSP (CAR (PRINTLEVEL))
0))
then (STRINGREGION STR STREAM FLG RDTBL)
else (CREATEREGION (DSPXPOSITION NIL STREAM)
(DIFFERENCE (DSPYPOSITION NIL STREAM)
(FONTPROP STREAM (QUOTE DESCENT)))
(PLSTRINGWIDTH STR STREAM FLG RDTBL)
(FONTPROP STREAM (QUOTE HEIGHT])
(PLSTRINGWIDTH
[LAMBDA (STR FONT FLG RDTBL) (* jop: "19-Jul-85 16:16")
(* * A VERSION OF STRINGWIDTH WHICH PAYS ATTENTION TO PRINT LEVEL)
(if (OR (NOT (LISTP STR))
(LESSP (CDR (PRINTLEVEL))
0)
(LESSP (CAR (PRINTLEVEL))
0))
then (STRINGWIDTH STR FONT FLG RDTBL)
else (LISTSTRWIDTH STR 0 FONT FLG RDTBL])
(RIGHTW.REPAINTFN
[LAMBDA (WINDOW WINDOWREGION) (* jop: "23-Jul-85 17:01")
(if (NULL WINDOWREGION)
then (SETQ WINDOWREGION (DSPCLIPPINGREGION NIL WINDOW)))
(PROG ((DWINDOW (MAINWINDOW WINDOW))
(TOP (fetch TOP of WINDOWREGION))
(BOTTOM (fetch BOTTOM of WINDOWREGION))
VERTMARKS DIM0 FIRSTI LASTI)
(if (NULL (WINDOWPROP DWINDOW (QUOTE SLICE)))
then (RETURN))
(SETQ VERTMARKS (WINDOWPROP DWINDOW (QUOTE VERTMARKS)))
(SETQ DIM0 (LENGTH VERTMARKS))
(SETQ FIRSTI (for MARK in VERTMARKS as I from 0 to (SUB1 DIM0) until (LESSP MARK TOP)
finally (RETURN I)))
(if (LESSP FIRSTI DIM0)
then [SETQ LASTI (for MARK in (NTH VERTMARKS (ADD1 FIRSTI)) as I from FIRSTI
to (SUB1 DIM0) until (LESSP MARK BOTTOM)
finally (RETURN (IMIN I (SUB1 DIM0]
(MOVETO 0 (PLUS (CAR (NTH VERTMARKS (ADD1 FIRSTI)))
(FONTPROP WINDOW (QUOTE DESCENT)))
WINDOW)
(bind [FORMAT ←(LIST (QUOTE FIX)
(NCHARS (SUB1 DIM0]
for I from FIRSTI to LASTI do (printout WINDOW .N FORMAT I T])
(RIGHTW.RESHAPEFN
[LAMBDA (WINDOW) (* jop: "17-Jul-85 21:53")
(DSPRESET WINDOW)
(RIGHTW.REPAINTFN WINDOW (DSPCLIPPINGREGION NIL WINDOW])
(SLICEDIMENSION
[LAMBDA (SLICE VDIM) (* jop: "28-Jul-85 17:34")
(PROG ((ARRAY (fetch (ICMLARRAY.ARRAYSLICE ARRAY) of SLICE))
(REALINDICES (fetch (ICMLARRAY.ARRAYSLICE REALINDICES) of SLICE)))
(RETURN (if (EQP VDIM 0)
then (ARRAY-DIMENSION ARRAY (CAR REALINDICES))
else (ARRAY-DIMENSION ARRAY (CADR REALINDICES])
(SLICERANK
[LAMBDA (SLICE) (* jop: "18-Jul-85 13:14")
(PROG ((REALINDICES (fetch (ICMLARRAY.ARRAYSLICE REALINDICES) of SLICE)))
(RETURN (if (EQP (LENGTH REALINDICES)
1)
then 1
else 2])
(SLICEREF
[LAMBDA (ASLICE INDEX1 INDEX2) (* jop: " 3-Jun-85 21:44")
(PROG ((REFLIST (fetch REFLIST of ASLICE))
(FIRSTINDEX (fetch FIRSTINDEX of ASLICE))
(SECONDINDEX (fetch SECONDINDEX of ASLICE))
(TWOD? (fetch TWOD? of ASLICE)))
(RPLACA FIRSTINDEX (if (NULL INDEX1)
then (HELP "NULL INDEX1" INDEX1)
else INDEX1))
(if TWOD?
then (RPLACA SECONDINDEX (if (NULL INDEX2)
then (HELP "NULL INDEX2" INDEX2)
else INDEX2)))
(RETURN (APPLY (FUNCTION AREF)
REFLIST])
(SLICESET
[LAMBDA (ASLICE VALUE INDEX1 INDEX2) (* jop: " 3-Jun-85 21:56")
(PROG ((SETLIST (fetch SETLIST of ASLICE))
(FIRSTINDEX (fetch FIRSTINDEX of ASLICE))
(SECONDINDEX (fetch SECONDINDEX of ASLICE))
(TWOD? (fetch TWOD? of ASLICE)))
(RPLACA FIRSTINDEX (if (NULL INDEX1)
then (HELP "NULL INDEX1" INDEX1)
else INDEX1))
(if TWOD?
then (RPLACA SECONDINDEX (if (NULL INDEX2)
then (HELP "NULL INDEX2" INDEX2)
else INDEX2)))
(RPLACA SETLIST VALUE)
(RETURN (APPLY (FUNCTION ASET)
SETLIST])
(STATUSW.BUTTONEVENTFN
[LAMBDA (WINDOW) (* jop: "28-Jul-85 16:43")
(* * Will only be called if (EQP (ARRAYRANK CMLARRAY) 0))
(TOTOPW WINDOW)
(PROG ((CMLARRAY (WINDOWPROP WINDOW (QUOTE CMLARRAY)))
(ACTIVEREGION (WINDOWPROP WINDOW (QUOTE ACTIVEREGION)))
[PMENU (CONSTANT (create MENU
ITEMS ←(QUOTE ((Inspect (QUOTE INSPECT)
"Inspect value")
(Set (QUOTE SET)
"Set value")
(IT% ←% Datum
(QUOTE SETIT)
"Bind IT to selected item"]
[OMENU (CONSTANT (create MENU
ITEMS ←(QUOTE ((Set (QUOTE SET)
"Set value")
(IT% ←% Datum
(QUOTE SETIT)
"Bind IT to selected item"]
MODE DATUM DATA)
(SETQ DATA (fetch (ICMLARRAY.ACTIVEREGION DATA) of ACTIVEREGION))
(SETQ DATUM (AREF CMLARRAY))
(if (MOUSESTATE LEFT)
then (INVERTREGION WINDOW ACTIVEREGION)
(replace (ICMLARRAY.ACTIVEREGION DATA) of ACTIVEREGION with (QUOTE SELECTED))
elseif (MOUSESTATE MIDDLE)
then (if (OR (NUMBERP DATUM)
(NULL DATUM))
then (SETQ MODE (MENU OMENU))
else (SETQ MODE (MENU PMENU)))
(SELECTQ MODE
(INSPECT (* uses VALUECMDFN to get auxillary menus that depend
on type. Assumes one arg to VALUECMDFN suffices)
(if (OR (LISTP DATUM)
(LITATOM DATUM))
then (DEFAULT.INSPECTW.VALUECOMMANDFN DATUM)
else (INSPECT DATUM)))
(SET (ZEROD.SETVALUE CMLARRAY WINDOW))
(SETIT (SETQ IT (AREF CMLARRAY)))
NIL])
(STATUSW.REPAINTFN
[LAMBDA (WINDOW) (* jop: "28-Jul-85 17:35")
(PROG ((CMLARRAY (WINDOWPROP WINDOW (QUOTE CMLARRAY)))
(LLENGTH (LINELENGTH NIL WINDOW))
ACTIVEREGION)
(DSPRESET WINDOW)
(printout WINDOW "Element Type: " (if (EQ (ARRAY-ELEMENT-TYPE CMLARRAY)
T)
then (QUOTE POINTER)
else (ARRAY-ELEMENT-TYPE CMLARRAY))
.FR LLENGTH (CONCAT "Rank: " (ARRAY-RANK CMLARRAY))
T)
(printout WINDOW "Total Size: " (ARRAY-TOTAL-SIZE CMLARRAY)
T T)
(if (GREATERP (ARRAY-RANK CMLARRAY)
0)
then (first (printout WINDOW "Dimensions: ") for I from 0 to (SUB1 (ARRAY-RANK CMLARRAY)
)
do (printout WINDOW (ARRAY-DIMENSION CMLARRAY I))
(if (LESSP I (SUB1 (ARRAY-RANK CMLARRAY)))
then (printout WINDOW " x ")))
else (* Display the value of the zero-d array)
(RESETLST [RESETSAVE (PRINTLEVEL (QUOTE (2 . 5]
(RESETSAVE PLVLFILEFLG T)
(printout WINDOW "Value: ")
[SETQ ACTIVEREGION (create ICMLARRAY.ACTIVEREGION
REGION ←(CREATEREGION
(DSPXPOSITION NIL WINDOW)
(DIFFERENCE (DSPYPOSITION NIL WINDOW)
(FONTPROP WINDOW (QUOTE DESCENT)))
(PLSTRINGWIDTH (AREF CMLARRAY)
WINDOW)
(FONTPROP WINDOW (QUOTE HEIGHT)))
DATA ←(AND (WINDOWPROP WINDOW (QUOTE
ACTIVEREGION))
(fetch (ICMLARRAY.ACTIVEREGION
DATA)
of (WINDOWPROP WINDOW
(QUOTE
ACTIVEREGION]
(printout WINDOW (AREF CMLARRAY))
(WINDOWPROP WINDOW (QUOTE ACTIVEREGION)
ACTIVEREGION)
(if (fetch (ICMLARRAY.ACTIVEREGION DATA) of ACTIVEREGION)
then (INVERTREGION WINDOW ACTIVEREGION])
(TOPW.REPAINTFN
[LAMBDA (WINDOW WINDOWREGION) (* jop: "10-Jun-85 17:39")
(if (NULL WINDOWREGION)
then (SETQ WINDOWREGION (DSPCLIPPINGREGION NIL WINDOW)))
(PROG ((DISPLAYW (MAINWINDOW WINDOW))
(LEFT (fetch LEFT of WINDOWREGION))
(RIGHT (fetch RIGHT of WINDOWREGION))
HORZMARKS CMLARRAY DIM1 FIRSTJ LASTJ)
(if (NULL (WINDOWPROP DISPLAYW (QUOTE SLICE)))
then (RETURN))
(SETQ HORZMARKS (WINDOWPROP DISPLAYW (QUOTE HORZMARKS)))
(SETQ DIM1 (LENGTH HORZMARKS))
(SETQ FIRSTJ (for MARK in HORZMARKS as J from 0 to (SUB1 DIM1) until (GREATERP MARK LEFT)
finally (RETURN J)))
(if (LESSP FIRSTJ DIM1)
then [SETQ LASTJ (for MARK in (NTH HORZMARKS (ADD1 FIRSTJ)) as J from FIRSTJ
to (SUB1 DIM1) until (GREATERP MARK RIGHT)
finally (RETURN (IMIN J (SUB1 DIM1]
(MOVETO 0 0 WINDOW)
(for J from FIRSTJ to LASTJ as HMARK in (NTH HORZMARKS (ADD1 FIRSTJ))
do (MOVETO (DIFFERENCE HMARK (STRINGWIDTH J WINDOW))
0 WINDOW)
(printout WINDOW J)
finally (printout WINDOW T T])
(TOPW.RESHAPEFN
[LAMBDA (WINDOW) (* jop: "10-Jun-85 17:19")
(PROG [(DWINDOW (WINDOWPROP WINDOW (QUOTE DISPLAYWINDOW]
(DSPRESET WINDOW)
(TOPW.REPAINTFN WINDOW (DSPCLIPPINGREGION NIL WINDOW])
(TWOD.BUTTONEVENTFN
[LAMBDA (WINDOW) (* jop: "28-Jul-85 16:02")
(PROG [(ACTIVEREGIONS (WINDOWPROP WINDOW (QUOTE ACTIVEREGIONS)))
(SELECTEDREGION (WINDOWPROP WINDOW (QUOTE SELECTEDREGION]
(TOTOPW WINDOW)
[while (MOUSESTATE LEFT) do (bind (CURSOR ←(CURSORPOSITION NIL WINDOW))
FOUNDIT for AREGION in ACTIVEREGIONS until FOUNDIT
do (if (INSIDEP (fetch REGION of AREGION)
CURSOR)
then (SETQ FOUNDIT AREGION))
finally (if (AND FOUNDIT (NOT (EQ SELECTEDREGION FOUNDIT)))
then (if SELECTEDREGION
then (INVERTREGION WINDOW
SELECTEDREGION))
(INVERTREGION WINDOW FOUNDIT)
(WINDOWPROP WINDOW (QUOTE SELECTEDREGION)
FOUNDIT)
(SETQ SELECTEDREGION FOUNDIT]
(if (MOUSESTATE MIDDLE)
then (if SELECTEDREGION
then (APPLY* (fetch (ICMLARRAY.ACTIVEREGION FUNCTION) of SELECTEDREGION)
WINDOW SELECTEDREGION])
(TWOD.DOWINDOWCOMFN
[LAMBDA (TWODWINDOW) (* jop: "25-Jul-85 16:48")
(* * Pass on the usual comms, except for SHAPEW)
(PROG (COM)
(SETQ COM (MENU WindowMenu))
(SELECTQ COM
(NIL NIL)
[SHAPEW (SHAPEW TWODWINDOW (GETREGION NIL NIL NIL (FUNCTION ICMLARRAY.GETREGIONFN)
(CONS TWODWINDOW (QUOTE CLOSED]
((MOVEW CLOSEW SHRINKW BURYW)
(APPLY* COM (MAINWINDOW TWODWINDOW)))
(APPLY* COM TWODWINDOW])
(TWOD.INDICES
[LAMBDA (SLICE SELECTEDREGION WINDOW) (* jop: "28-Jul-85 17:32")
(* * Display the indices of the selected item)
(PROG ((DISPLAYEDLEVELS (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE DISPLAYEDLEVELS)))
(PRTWINDOW (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE PRTWINDOW)))
(DATA (fetch (ICMLARRAY.ACTIVEREGION DATA) of SELECTEDREGION))
FIRSTFLG)
(printout PRTWINDOW T "INDICES: ")
(for LEVEL in DISPLAYEDLEVELS as I from 0 to (SUB1 (ARRAY-RANK (fetch (ICMLARRAY.ARRAYSLICE
ARRAY)
of SLICE)))
do (if (EQ LEVEL (QUOTE ALL))
then (if FIRSTFLG
then (printout PRTWINDOW .I5 (CDR DATA))
else (SETQ FIRSTFLG T)
(printout PRTWINDOW .I5 (CAR DATA)))
else (printout PRTWINDOW .I5 LEVEL])
(TWOD.MAKEREGIONS
[LAMBDA (WINDOW) (* jop: "25-Jul-85 16:49")
(* * Sets up windowprops and activeregions)
(RESETFORM (PRINTLEVEL (QUOTE (2 . 5)))
(PROG ((SLICE (WINDOWPROP WINDOW (QUOTE SLICE)))
(WINDOWHEIGHT (WINDOWPROP WINDOW (QUOTE HEIGHT)))
(LF (DSPLINEFEED NIL WINDOW))
FIELDWIDTHS ACTIVEFIELDWIDTH ACTIVEREGIONS VERTMARKS HORZMARKS DIM0 DIM1)
(if (NULL SLICE)
then (RETURN))
(SETQ DIM0 (SLICEDIMENSION SLICE 0))
(SETQ DIM1 (SLICEDIMENSION SLICE 1))
[WINDOWPROP WINDOW (QUOTE FIELDWIDTHS)
(SETQ FIELDWIDTHS (for J from 0 to (SUB1 DIM1)
collect (COMPUTETWODCOLUMNWIDTH SLICE J WINDOW]
(SETQ VERTMARKS (for I from 1 to DIM0 as MARK from (PLUS WINDOWHEIGHT LF)
by LF collect MARK))
[SETQ HORZMARKS (bind (MARK ← 0) for I from 1 to DIM1 as FIELDWIDTH
in FIELDWIDTHS collect (SETQ MARK (PLUS MARK FIELDWIDTH]
[bind (FHEIGHT ←(FONTPROP WINDOW (QUOTE HEIGHT))) for J from 0
to (SUB1 DIM1) as HORZMARK in HORZMARKS
do (bind (ACTIVEFIELDWIDTH ←(DIFFERENCE (CAR (NTH FIELDWIDTHS (ADD1 J)))
(STRINGWIDTH " " WINDOW)))
for I from 0 to (SUB1 DIM0) as VERTMARK in VERTMARKS
do (push ACTIVEREGIONS (create ICMLARRAY.ACTIVEREGION
REGION ←(CREATEREGION (DIFFERENCE
HORZMARK
ACTIVEFIELDWIDTH)
VERTMARK
ACTIVEFIELDWIDTH
FHEIGHT)
FUNCTION ←(FUNCTION TWOD.MENUFN)
DATA ←(CONS I J]
(WINDOWPROP WINDOW (QUOTE VERTMARKS)
VERTMARKS)
(WINDOWPROP WINDOW (QUOTE HORZMARKS)
HORZMARKS)
(WINDOWPROP WINDOW (QUOTE ACTIVEREGIONS)
ACTIVEREGIONS)
[WINDOWPROP WINDOW (QUOTE EXTENT)
(CREATEREGION 0 (CAR (LAST VERTMARKS))
(CAR (LAST HORZMARKS))
(DIFFERENCE WINDOWHEIGHT (CAR (LAST VERTMARKS]
[WINDOWPROP (WINDOWPROP WINDOW (QUOTE TOPWINDOW))
(QUOTE EXTENT)
(CREATEREGION 0 0 (CAR (LAST HORZMARKS))
(WINDOWPROP (WINDOWPROP WINDOW (QUOTE TOPWINDOW))
(QUOTE HEIGHT]
(WINDOWPROP (WINDOWPROP WINDOW (QUOTE RIGHTWINDOW))
(QUOTE EXTENT)
(CREATEREGION 0 (CAR (LAST VERTMARKS))
(WINDOWPROP (WINDOWPROP WINDOW (QUOTE RIGHTWINDOW))
(QUOTE WIDTH))
(DIFFERENCE WINDOWHEIGHT (CAR (LAST VERTMARKS])
(TWOD.MENUFN
[LAMBDA (WINDOW SELECTEDREGION) (* jop: "28-Jul-85 16:45")
(* * Called from TWOD.BUTTONEVENTFN)
(PROG ((SLICE (WINDOWPROP WINDOW (QUOTE SLICE)))
[PMENU (CONSTANT (create MENU
ITEMS ←(QUOTE ((Inspect (QUOTE INSPECT)
"Inspect item")
(Set (QUOTE SET)
"Set item")
(Indices (QUOTE INDICES)
"Display element indices ")
(IT% ←% Datum
(QUOTE SETIT)
"Bind IT to selected item"]
[OMENU (CONSTANT (create MENU
ITEMS ←(QUOTE ((Set (QUOTE SET)
"Set item")
(Indices (QUOTE INDICES)
"Display element indices ")
(IT% ←% Datum
(QUOTE SETIT)
"Bind IT to selected item"]
(DATA (fetch (ICMLARRAY.ACTIVEREGION DATA) of SELECTEDREGION))
MODE DATUM)
(if SELECTEDREGION
then (SETQ DATUM (SLICEREF SLICE (CAR DATA)
(CDR DATA)))
(if (OR (NUMBERP DATUM)
(NULL DATUM))
then (SETQ MODE (MENU OMENU))
else (SETQ MODE (MENU PMENU)))
(SELECTQ MODE
(INSPECT (* uses VALUECMDFN to get auxillary menus that depend
on type. Assumes one arg to VALUECMDFN suffices)
(if (OR (LISTP DATUM)
(LITATOM DATUM))
then (DEFAULT.INSPECTW.VALUECOMMANDFN DATUM)
else (INSPECT DATUM)))
(SET (TWOD.SETVALUE SLICE SELECTEDREGION WINDOW))
[SETIT (SETQ IT (SLICEREF SLICE (CAR DATA)
(CDR DATA]
(INDICES (TWOD.INDICES SLICE SELECTEDREGION WINDOW))
NIL])
(TWOD.PRTELEMENT
[LAMBDA (SLICE I J WINDOW VMARK HMARK) (* jop: "23-Jul-85 16:51")
(PROG ((ELT (SLICEREF SLICE I J)))
(MOVETO (DIFFERENCE HMARK (PLSTRINGWIDTH ELT WINDOW))
(PLUS VMARK (FONTPROP WINDOW (QUOTE DESCENT)))
WINDOW)
(printout WINDOW ELT])
(TWOD.REPAINTFN
[LAMBDA (WINDOW WINDOWREGION) (* jop: "23-Jul-85 16:51")
(if (NULL WINDOWREGION)
then (SETQ WINDOWREGION (DSPCLIPPINGREGION NIL WINDOW)))
(RESETLST [RESETSAVE (PRINTLEVEL (QUOTE (2 . 5]
(RESETSAVE PLVLFILEFLG T)
(PROG ((SLICE (WINDOWPROP WINDOW (QUOTE SLICE)))
(SELECTEDREGION (WINDOWPROP WINDOW (QUOTE SELECTEDREGION)))
(TOP (fetch TOP of WINDOWREGION))
(BOTTOM (fetch BOTTOM of WINDOWREGION))
(LEFT (fetch LEFT of WINDOWREGION))
(RIGHT (fetch RIGHT of WINDOWREGION))
(VERTMARKS (WINDOWPROP WINDOW (QUOTE VERTMARKS)))
(HORZMARKS (WINDOWPROP WINDOW (QUOTE HORZMARKS)))
(LF (DSPLINEFEED NIL WINDOW))
DIM0 DIM1 FIRSTI LASTI FIRSTJ LASTJ)
(if (NULL SLICE)
then (RETURN))
(SETQ DIM0 (SLICEDIMENSION SLICE 0))
(SETQ DIM1 (SLICEDIMENSION SLICE 1))
(SETQ FIRSTI (for MARK in VERTMARKS as I from 0 to (SUB1 DIM0)
until (LESSP MARK TOP) finally (RETURN I)))
(SETQ FIRSTJ (for MARK in HORZMARKS as J from 0 to (SUB1 DIM1)
until (GREATERP MARK LEFT) finally (RETURN J)))
(if (AND (LESSP FIRSTI DIM0)
(LESSP FIRSTJ DIM1))
then [SETQ LASTI (for MARK in (NTH VERTMARKS (ADD1 FIRSTI)) as I
from FIRSTI to (SUB1 DIM0) until (LESSP MARK BOTTOM)
finally (RETURN (IMIN I (SUB1 DIM0]
[SETQ LASTJ (for MARK in (NTH HORZMARKS (ADD1 FIRSTJ)) as J
from FIRSTJ to (SUB1 DIM1) until (GREATERP MARK RIGHT)
finally (RETURN (IMIN J (SUB1 DIM1]
(for I from FIRSTI to LASTI as VMARK in (NTH VERTMARKS (ADD1 FIRSTI))
do (for J from FIRSTJ to LASTJ as HMARK in (NTH HORZMARKS
(ADD1 FIRSTJ))
do (TWOD.PRTELEMENT SLICE I J WINDOW VMARK HMARK)))
(if SELECTEDREGION
then (INVERTREGION WINDOW SELECTEDREGION])
(TWOD.RESHAPEFN
[LAMBDA (WINDOW) (* jop: "22-Jul-85 23:23")
(PROG ((SELECTEDREGION (WINDOWPROP WINDOW (QUOTE SELECTEDREGION)))
I J)
(DSPRESET WINDOW)
(TWOD.MAKEREGIONS WINDOW) (* This song and dance is to insure that the
SELECTEDREGION is properly placed)
[if SELECTEDREGION
then (SETQ I (CAR (fetch (ICMLARRAY.ACTIVEREGION DATA) of SELECTEDREGION)))
(SETQ J (CDR (fetch (ICMLARRAY.ACTIVEREGION DATA) of SELECTEDREGION)))
(WINDOWPROP WINDOW (QUOTE SELECTEDREGION)
(bind FOUNDIT DATA for AREGION in (WINDOWPROP WINDOW (QUOTE
ACTIVEREGIONS))
until FOUNDIT
do (SETQ DATA (fetch (ICMLARRAY.ACTIVEREGION DATA) of AREGION))
(if (AND (EQP (CAR DATA)
I)
(EQP (CDR DATA)
J))
then (SETQ FOUNDIT AREGION))
finally (RETURN FOUNDIT]
(TWOD.REPAINTFN WINDOW])
(TWOD.SCROLLFN
[LAMBDA (WINDOW DX DY FLG) (* jop: "18-Jul-85 13:50")
(PROG [(TOPWINDOW (WINDOWPROP WINDOW (QUOTE TOPWINDOW)))
(RIGHTWINDOW (WINDOWPROP WINDOW (QUOTE RIGHTWINDOW]
(if (OR (NOT (EQP 0 DX))
(FLOATP DX))
then (APPLY* (WINDOWPROP TOPWINDOW (QUOTE SCROLLFN))
TOPWINDOW DX 0 FLG))
(if (OR (NOT (EQP 0 DY))
(FLOATP DY))
then (APPLY* (WINDOWPROP RIGHTWINDOW (QUOTE SCROLLFN))
RIGHTWINDOW 0 DY FLG))
(SCROLLBYREPAINTFN WINDOW DX DY FLG])
(TWOD.SETVALUE
[LAMBDA (SLICE SELECTEDREGION WINDOW) (* jop: "28-Jul-85 16:06")
(PROG ((PRTWINDOW (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE PRTWINDOW)))
(DATA (fetch (ICMLARRAY.ACTIVEREGION DATA) of SELECTEDREGION))
(VERTMARKS (WINDOWPROP WINDOW (QUOTE VERTMARKS)))
(HORZMARKS (WINDOWPROP WINDOW (QUOTE HORZMARKS)))
(FIELDWIDTHS (WINDOWPROP WINDOW (QUOTE FIELDWIDTHS)))
NEWVALUE VMARK HMARK I J FIELDWIDTH)
(SETQ I (CAR DATA))
(SETQ J (CDR DATA))
[SETQ FIELDWIDTH (CAR (NTH FIELDWIDTHS (ADD1 J] (* Flush previous output)
[RESETFORM (SET.TTYINEDIT.WINDOW PRTWINDOW)
(SETQ NEWVALUE (EVAL (CAR (TTYIN "NEWVALUE? " NIL NIL (QUOTE EVALQT)
NIL NIL NIL T]
(SLICESET SLICE NEWVALUE I J)
(RESETLST [RESETSAVE (PRINTLEVEL (QUOTE (2 . 5]
(RESETSAVE PLVLFILEFLG T)
(if (LESSP (PLSTRINGWIDTH NEWVALUE WINDOW)
(DIFFERENCE FIELDWIDTH (STRINGWIDTH " " WINDOW)))
then (* Update the right field)
[SETQ VMARK (CAR (NTH VERTMARKS (ADD1 I]
[SETQ HMARK (CAR (NTH HORZMARKS (ADD1 J]
(BITBLT NIL NIL NIL WINDOW (DIFFERENCE HMARK FIELDWIDTH)
VMARK FIELDWIDTH (FONTPROP WINDOW (QUOTE HEIGHT))
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(TWOD.PRTELEMENT SLICE I J WINDOW VMARK HMARK)
(INVERTREGION WINDOW SELECTEDREGION)
else (* Remake the entire display)
(TWOD.RESHAPEFN WINDOW)
(TOPW.RESHAPEFN (WINDOWPROP WINDOW (QUOTE TOPWINDOW)))
(RIGHTW.RESHAPEFN (WINDOWPROP WINDOW (QUOTE RIGHTWINDOW])
(ZEROD.SETVALUE
[LAMBDA (ARRAY WINDOW) (* jop: "25-Jul-85 14:46")
(PROG ((PRTWINDOW (WINDOWPROP WINDOW (QUOTE PRTWINDOW)))
NEWVALUE)
[RESETFORM (SET.TTYINEDIT.WINDOW PRTWINDOW)
(SETQ NEWVALUE (EVAL (CAR (TTYIN "NEWVALUE? " NIL NIL (QUOTE EVALQT)
NIL NIL NIL T]
(ASET NEWVALUE ARRAY)
(REDISPLAYW WINDOW])
)
[DECLARE: EVAL@COMPILE
(DATATYPE ICMLARRAY.ACTIVEREGION (REGION FUNCTION DATA))
(DATATYPE ICMLARRAY.ARRAYSLICE (ARRAY SETLIST REFLIST INDEXLIST FIRSTINDEX SECONDINDEX TWOD?
REALINDICES))
]
(/DECLAREDATATYPE (QUOTE ICMLARRAY.ACTIVEREGION)
(QUOTE (POINTER POINTER POINTER))
(QUOTE ((ICMLARRAY.ACTIVEREGION 0 POINTER)
(ICMLARRAY.ACTIVEREGION 2 POINTER)
(ICMLARRAY.ACTIVEREGION 4 POINTER)))
(QUOTE 6))
(/DECLAREDATATYPE (QUOTE ICMLARRAY.ARRAYSLICE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((ICMLARRAY.ARRAYSLICE 0 POINTER)
(ICMLARRAY.ARRAYSLICE 2 POINTER)
(ICMLARRAY.ARRAYSLICE 4 POINTER)
(ICMLARRAY.ARRAYSLICE 6 POINTER)
(ICMLARRAY.ARRAYSLICE 8 POINTER)
(ICMLARRAY.ARRAYSLICE 10 POINTER)
(ICMLARRAY.ARRAYSLICE 12 POINTER)
(ICMLARRAY.ARRAYSLICE 14 POINTER)))
(QUOTE 16))
(ADDTOVAR INSPECTMACROS ((FUNCTION CMLARRAYP) . ICMLARRAY))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1715 74167 (CMLARRAYP 1725 . 1820) (COMPUTEONEDFIELDWIDTH 1822 . 2307) (
COMPUTETWODCOLUMNWIDTH 2309 . 2919) (COMPUTETWODTOTALWIDTH 2921 . 3163) (CREATE.ARRAYSLICE 3165 . 5041
) (DISPLAY.ONEDSLICE 5043 . 5984) (DISPLAY.TWODSLICE 5986 . 7067) (DISPLAYSLICE 7069 . 8365) (
ICMLARRAY 8367 . 9689) (ICMLARRAY.GETONEDWINDOWGROUP 9691 . 13191) (ICMLARRAY.GETREGIONFN 13193 .
14713) (ICMLARRAY.GETSTATUSWINDOWGROUP 14715 . 18631) (ICMLARRAY.GETTWODWINDOWGROUP 18633 . 23879) (
INVERTREGION 23881 . 24295) (LISTNCHARS 24297 . 25220) (LISTSTRREGION 25222 . 25685) (LISTSTRWIDTH
25687 . 26964) (MENU.GETLEVEL 26966 . 28334) (MENUW.APPLY 28336 . 29146) (MENUW.BUTTONEVENTFN 29148 .
30003) (MENUW.CURSORMOVEDFN 30005 . 31286) (MENUW.CURSOROUTFN 31288 . 31645) (MENUW.MAKEREGIONS 31647
. 33458) (MENUW.REPAINTFN 33460 . 34497) (MENUW.RESHAPEFN 34499 . 34680) (MENUW.SHOW 34682 . 35070) (
ONED.BUTTONEVENTFN 35072 . 36249) (ONED.DOWINDOWCOMFN 36251 . 36819) (ONED.INDICES 36821 . 37669) (
ONED.MAKEREGIONS 37671 . 39557) (ONED.MENUFN 39559 . 41454) (ONED.PRTELEMENT 41456 . 41749) (
ONED.REPAINTFN 41751 . 43387) (ONED.RESHAPEFN 43389 . 44355) (ONED.SCROLLFN 44357 . 44834) (
ONED.SETVALUE 44836 . 46370) (ONEDRIGHTW.REPAINTFN 46372 . 47764) (ONEDRIGHTW.RESHAPEFN 47766 . 47982)
(OUTLINEREGION 47984 . 48821) (PLNCHARS 48823 . 49242) (PLSTRINGREGION 49244 . 49893) (PLSTRINGWIDTH
49895 . 50341) (RIGHTW.REPAINTFN 50343 . 51731) (RIGHTW.RESHAPEFN 51733 . 51941) (SLICEDIMENSION 51943
. 52394) (SLICERANK 52396 . 52703) (SLICEREF 52705 . 53388) (SLICESET 53390 . 54110) (
STATUSW.BUTTONEVENTFN 54112 . 55985) (STATUSW.REPAINTFN 55987 . 58135) (TOPW.REPAINTFN 58137 . 59525)
(TOPW.RESHAPEFN 59527 . 59816) (TWOD.BUTTONEVENTFN 59818 . 60995) (TWOD.DOWINDOWCOMFN 60997 . 61565) (
TWOD.INDICES 61567 . 62532) (TWOD.MAKEREGIONS 62534 . 65425) (TWOD.MENUFN 65427 . 67262) (
TWOD.PRTELEMENT 67264 . 67615) (TWOD.REPAINTFN 67617 . 69936) (TWOD.RESHAPEFN 69938 . 71084) (
TWOD.SCROLLFN 71086 . 71739) (TWOD.SETVALUE 71741 . 73705) (ZEROD.SETVALUE 73707 . 74165)))))
STOP