(FILECREATED "16-Jan-87 11:55:57" {MCS:MCS:STANFORD}<LANE>STORAGE.LSP;59
changes to: (FNS SHOWSTORAGE)
(VARS STORAGECOMS)
previous date: "16-Jan-87 08:03:50" {MCS:MCS:STANFORD}<LANE>STORAGE.LSP;57)
(* Copyright (c) 1984, 1985, 1986, 1987 by Stanford University. All rights reserved.)
(PRETTYCOMPRINT STORAGECOMS)
(RPAQQ STORAGECOMS [(LOCALVARS . T)
(FNS SHOWSTORAGE)
(FNS SHOWSTORAGEBUTTONFN SHOWSTORAGEREPAINT SHOWSTORAGEUPDATE
SHOWSTORAGEDISPLAY)
(ADDVARS (SHOWSTORAGEIGNORE SMALLP LITATOM CHARACTER))
[INITVARS (SHOWSTORAGEMODES '(ITEM PAGE BOX))
(SHOWSTORAGEWINDOWHEIGHT 200)
(SHOWSTORAGEFONT (bind FONT for SIZE from 5 to 10 thereis
(SETQ FONT (FONTCREATE 'HELVETICA
SIZE
'MRR
90
'DISPLAY
T))
finally
(RETURN FONT]
(GLOBALVARS SHOWSTORAGEIGNORE SHOWSTORAGEMODES SHOWSTORAGEWINDOWHEIGHT
SHOWSTORAGEFONT)
(DECLARE: DONTCOPY (CONSTANTS (SHOWSTORAGESHADE 42405])
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DEFINEQ
(SHOWSTORAGE
[LAMBDA (MODE) (* cdl "16-Jan-87 11:51")
(if (NOT (MEMB MODE SHOWSTORAGEMODES))
then (SETQ MODE (CAR SHOWSTORAGEMODES)))
(LET [(WINDOW (CREATEW (GETBOXREGION [WIDTHIFWINDOW (TIMES (DIFFERENCE (LENGTH
(DATATYPES))
(LENGTH
SHOWSTORAGEIGNORE))
(FONTPROP SHOWSTORAGEFONT
'HEIGHT]
(HEIGHTIFWINDOW SHOWSTORAGEWINDOWHEIGHT T))
(CONCAT "Datatype Storage by " MODE " count"]
(DSPFONT SHOWSTORAGEFONT WINDOW)
(WINDOWPROP WINDOW 'BUTTONEVENTFN
(FUNCTION SHOWSTORAGEBUTTONFN))
(WINDOWPROP WINDOW 'RESHAPEFN
(FUNCTION SHOWSTORAGEREPAINT))
(WINDOWPROP WINDOW 'REPAINTFN
(FUNCTION SHOWSTORAGEREPAINT))
(WINDOWPROP WINDOW 'EXPANDFN
(FUNCTION SHOWSTORAGEUPDATE))
(WINDOWPROP WINDOW 'MODE
MODE)
(REDISPLAYW WINDOW])
)
(DEFINEQ
(SHOWSTORAGEBUTTONFN
[LAMBDA (WINDOW) (* cdl "15-Jan-87 09:33")
(if (MOUSESTATE LEFT)
then (SHOWSTORAGEUPDATE WINDOW)
elseif (MOUSESTATE MIDDLE)
then (LET [(MODE (OR (CADR (MEMB (WINDOWPROP WINDOW 'MODE)
SHOWSTORAGEMODES))
(CAR SHOWSTORAGEMODES]
(WINDOWPROP WINDOW 'MODE
MODE)
(WINDOWPROP WINDOW 'TITLE
(CONCAT "Datatype Storage by " MODE " count")))
(DSPFILL (create REGION
HEIGHT ←(WINDOWPROP WINDOW 'DIVISION) using (
DSPCLIPPINGREGION
NIL WINDOW))
WHITESHADE
'REPLACE
WINDOW)
(SHOWSTORAGEUPDATE WINDOW))
(until (MOUSESTATE UP) do (BLOCK])
(SHOWSTORAGEREPAINT
[LAMBDA (WINDOW) (* cdl "15-Jan-87 09:21")
(PROG ((FONTHEIGHT (FONTPROP SHOWSTORAGEFONT 'HEIGHT))
(TYPES (for TYPE in (DATATYPES) unless (MEMB TYPE SHOWSTORAGEIGNORE)
collect TYPE))
WINDOWWIDTH DIVISION)
(if (NEQ (SETQ WINDOWWIDTH (TIMES (LENGTH TYPES)
FONTHEIGHT))
(WINDOWPROP WINDOW 'WIDTH))
then [SHAPEW WINDOW (create REGION
WIDTH ←(WIDTHIFWINDOW WINDOWWIDTH)
using (WINDOWPROP WINDOW 'REGION]
(RETURN))
[WINDOWPROP WINDOW 'DIVISION
(SETQ DIVISION (DIFFERENCE (WINDOWPROP WINDOW 'HEIGHT)
(STRINGWIDTH (in TYPES largest NCHARS)
SHOWSTORAGEFONT]
(bind (EDGE ←(FONTPROP SHOWSTORAGEFONT 'ASCENT)) for DATATYPE in TYPES
do (MOVETO EDGE DIVISION WINDOW)
(printout WINDOW DATATYPE)
(add EDGE FONTHEIGHT))
(WINDOWPROP WINDOW 'DATATYPES
TYPES)
(SHOWSTORAGEUPDATE WINDOW])
(SHOWSTORAGEUPDATE
[LAMBDA (WINDOW) (* cdl "15-Jan-87 17:37")
(DECLARE (SPECVARS WINDOW)
(GLOBALVARS WAITINGCURSOR))
(RESETFORM (CURSOR WAITINGCURSOR)
(LET ((FONTHEIGHT (FONTPROP SHOWSTORAGEFONT 'HEIGHT))
(DIVISION (WINDOWPROP WINDOW 'DIVISION))
(MODE (WINDOWPROP WINDOW 'MODE))
(FREE (CREATECELL \FIXP))
ALLOCMDS REGION ITEMSPERMDS TYPENUMBER)
(DECLARE (SPECVARS ALLOCMDS))
(SETQ REGION (create REGION
WIDTH ← FONTHEIGHT
LEFT ← 1))
(for TYPE in (WINDOWPROP WINDOW 'DATATYPES)
do (SETQ TYPENUMBER (\TYPENUMBERFROMNAME TYPE))
(SELECTQ MODE
[(PAGE ITEM)
(\StatsZero FREE)
(SETQ ALLOCMDS 0)
[\MAPMDS TYPENUMBER (FUNCTION (LAMBDA NIL
(ADD1VAR ALLOCMDS]
(if (EQ TYPE 'LISTP)
then [SETQ ITEMSPERMDS
(CONSTANT (FIX (FQUOTIENT \MDSIncrement
2.2]
(for (LSTPAG ←(create POINTER
PAGE# ←(fetch
(DTD DTDNEXTPAGE)
of
\LISTPDTD)))
by (create POINTER
PAGE# ←(fetch (CONSPAGE
NEXTPAGE)
of LSTPAG))
while LSTPAG
do (\BOXIPLUS FREE (fetch
(CONSPAGE CNT)
of LSTPAG)))
else (with DTD (\GETDTD TYPENUMBER)
(SETQ ITEMSPERMDS (QUOTIENT
\MDSIncrement
DTDSIZE))
(for (PTR ← DTDFREE)
by (\GETBASEPTR PTR 0)
while PTR do (\BOXIPLUS FREE 1]
NIL)
(SELECTQ MODE
(PAGE (SHOWSTORAGEDISPLAY (TIMES ALLOCMDS
(QUOTIENT
\MDSIncrement
WORDSPERPAGE))
(TIMES (QUOTIENT FREE
ITEMSPERMDS)
(QUOTIENT
\MDSIncrement
WORDSPERPAGE))
WINDOW REGION DIVISION))
(ITEM (SHOWSTORAGEDISPLAY (TIMES ALLOCMDS ITEMSPERMDS)
FREE WINDOW REGION DIVISION))
(BOX (SHOWSTORAGEDISPLAY (BOXCOUNT TYPENUMBER)
NIL WINDOW REGION DIVISION))
(SHOULDNT))
(with REGION REGION (add LEFT FONTHEIGHT])
(SHOWSTORAGEDISPLAY
[LAMBDA (TOTAL FREE WINDOW REGION DIVISION) (* cdl "15-Jan-87 10:09")
(PROG (INUSE OFFSET STRINGWIDTH)
(with REGION REGION (SETQ HEIGHT TOTAL)
(SETQ BOTTOM (DIFFERENCE DIVISION TOTAL))
(DSPFILL REGION BLACKSHADE NIL WINDOW)
[SETQ OFFSET (PLUS LEFT (SUB1 (FONTPROP SHOWSTORAGEFONT 'ASCENT]
(if (NULL FREE)
then (if (GREATERP TOTAL (STRINGWIDTH TOTAL SHOWSTORAGEFONT))
then (MOVETO OFFSET (ADD1 (MAX BOTTOM 0))
WINDOW)
(printout WINDOW TOTAL))
(RETURN))
(if (GREATERP (SETQ INUSE (DIFFERENCE TOTAL FREE))
(STRINGWIDTH INUSE SHOWSTORAGEFONT))
then (MOVETO OFFSET (ADD1 (MAX (PLUS BOTTOM FREE)
0))
WINDOW)
(DSPOPERATION 'INVERT
WINDOW)
(PRIN1 INUSE WINDOW)
(DSPOPERATION 'REPLACE
WINDOW))
(SETQ HEIGHT FREE)
(DSPFILL REGION SHOWSTORAGESHADE NIL WINDOW)
(if (AND (GREATERP FREE (SETQ STRINGWIDTH (STRINGWIDTH FREE
SHOWSTORAGEFONT)))
(GREATERP (DIFFERENCE DIVISION INUSE)
STRINGWIDTH))
then (MOVETO OFFSET (ADD1 (MAX BOTTOM 0))
WINDOW)
(PRIN1 FREE WINDOW])
)
(ADDTOVAR SHOWSTORAGEIGNORE SMALLP LITATOM CHARACTER)
(RPAQ? SHOWSTORAGEMODES '(ITEM PAGE BOX))
(RPAQ? SHOWSTORAGEWINDOWHEIGHT 200)
(RPAQ? SHOWSTORAGEFONT (bind FONT for SIZE from 5 to 10 thereis (SETQ FONT (FONTCREATE
'HELVETICA
SIZE
'MRR
90
'DISPLAY
T))
finally
(RETURN FONT)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SHOWSTORAGEIGNORE SHOWSTORAGEMODES SHOWSTORAGEWINDOWHEIGHT SHOWSTORAGEFONT)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ SHOWSTORAGESHADE 42405)
(CONSTANTS (SHOWSTORAGESHADE 42405))
)
)
(PUTPROPS STORAGE.LSP COPYRIGHT ("Stanford University" 1984 1985 1986 1987))
STOP