(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "17-Sep-87 15:17:45" |{MCS:MCS:STANFORD}<LANE>STORAGE.;16|
 16510  

      changes to%:  (VARS STORAGECOMS)
                    (FNS SHOWSTORAGEREPAINT)

      previous date%: " 9-Sep-87 10:06:41" |{MCS:MCS:STANFORD}<LANE>STORAGE.;13|)


(* "
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 
                         SHOWSTORAGEALLOCMDS)
                    (ADDVARS (SHOWSTORAGEIGNORE SMALLP LITATOM CHARACTER CL::STRUCTURE-OBJECT))
                    (INITVARS (SHOWSTORAGEMODES '(ITEM PAGE BOX))
                           (SHOWSTORAGEWINDOWSIZE 275)
                           (SHOWSTORAGEDEFAULTTHRESHOLD 1)
                           (SHOWSTORAGEFONT (bind FONT for ROTATION in '(90 0) thereis
                                                  (for SIZE from 5 to 10 thereis
                                                       (SETQ FONT (FONTCREATE 'HELVETICA SIZE
                                                                         'MRR ROTATION 'DISPLAY T)))
                                                  finally
                                                  (RETURN FONT)))
                           SHOWSTORAGEPRIN2FLG)
                    (GLOBALVARS SHOWSTORAGEIGNORE SHOWSTORAGEMODES SHOWSTORAGEWINDOWSIZE 
                           SHOWSTORAGEDEFAULTTHRESHOLD SHOWSTORAGEFONT SHOWSTORAGEPRIN2FLG)
                    (DECLARE%: DONTCOPY (CONSTANTS (SHOWSTORAGESHADE 42405])
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DEFINEQ

(SHOWSTORAGE

  [LAMBDA (PAGETHRESHOLD MODE ROTATION)
                      (* ; "Edited  9-Sep-87 10:06 by cdl")


    (if
 (NOT (MEMB MODE SHOWSTORAGEMODES))
        then
 (SETQ MODE (CAR SHOWSTORAGEMODES)))
    (if
 (NOT (NUMBERP PAGETHRESHOLD))
        then
 (SETQ PAGETHRESHOLD SHOWSTORAGEDEFAULTTHRESHOLD))
    (LET (WINDOW SIZE (TYPES (SHOWSTORAGEALLOCMDS
 PAGETHRESHOLD))
                (FONT (if
 ROTATION
                          then
 (FONTCOPY SHOWSTORAGEFONT 'ROTATION ROTATION)
                        else
 SHOWSTORAGEFONT)))
         [SETQ SIZE (TIMES (LENGTH TYPES)
                           (FONTPROP FONT 'HEIGHT]
         (SETQ WINDOW (CREATEW (SELECTQ (FONTPROP FONT 'ROTATION)
                                   (90 (GETBOXREGION (WIDTHIFWINDOW SIZE)
                                              (HEIGHTIFWINDOW SHOWSTORAGEWINDOWSIZE T)))
                                   (GETBOXREGION (WIDTHIFWINDOW SHOWSTORAGEWINDOWSIZE)
                                          (HEIGHTIFWINDOW SIZE T)))
                             (CONCAT "Datatype Storage by " MODE " count, threshold = " PAGETHRESHOLD
                                    )))
         (DSPFONT FONT 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)
         (WINDOWPROP WINDOW 'THRESHOLD PAGETHRESHOLD)
         (WINDOWPROP WINDOW 'ALLOCMDS TYPES)
         (REDISPLAYW WINDOW])
)
(DEFINEQ

(SHOWSTORAGEBUTTONFN

  [LAMBDA (WINDOW)
                                           (* ; "Edited  9-Sep-87 08:10 by cdl")


    (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, threshold = " (WINDOWPROP WINDOW
                                                                                 'THRESHOLD]
             (DSPFILL (SELECTQ (FONTPROP (DSPFONT NIL WINDOW)
                                      'ROTATION)
                          (90 (create
 REGION
                                     HEIGHT _ (WINDOWPROP WINDOW 'DIVISION) using
 (DSPCLIPPINGREGION
                                                                                   NIL WINDOW)))
                          (create
 REGION
                                 WIDTH _ (WINDOWPROP WINDOW 'DIVISION) using
 (DSPCLIPPINGREGION
                                                                              NIL WINDOW)))
                    WHITESHADE
                    'REPLACE WINDOW)
             (SHOWSTORAGEUPDATE
 WINDOW))
    (until
 (MOUSESTATE UP) do
 (BLOCK])

(SHOWSTORAGEREPAINT

  [LAMBDA (WINDOW)
                                           (* ; "Edited 17-Sep-87 15:07 by cdl")


    (PROG ((FONT (DSPFONT NIL WINDOW))
           (REGION (DSPCLIPPINGREGION NIL WINDOW))
           DATATYPES SIZE DIVISION FONTHEIGHT ROTATION)
          [if
 [NULL (SETQ DATATYPES (WINDOWPROP WINDOW 'ALLOCMDS]
              then
 (WINDOWPROP WINDOW 'ALLOCMDS (SETQ DATATYPES (SHOWSTORAGEALLOCMDS

                                                                 (WINDOWPROP WINDOW 'THRESHOLD]
          (WINDOWPROP WINDOW 'DATATYPES (SETQ DATATYPES (in
 DATATYPES collect
 CAR)))
          (if
 (NEQ [SETQ SIZE (TIMES (LENGTH DATATYPES)
                                     (SETQ FONTHEIGHT (FONTPROP FONT 'HEIGHT]
                   (with
 REGION REGION (SELECTQ (SETQ ROTATION (FONTPROP FONT 'ROTATION))
                                           (90 WIDTH)
                                           HEIGHT)))
              then
 [SHAPEW WINDOW (SELECTQ ROTATION
                                      (90 (create
 REGION
                                                 WIDTH _ (WIDTHIFWINDOW SIZE)
                                             using
 (WINDOWPROP WINDOW 'REGION)))
                                      (create
 REGION
                                             HEIGHT _ (HEIGHTIFWINDOW SIZE T)
                                         using
 (WINDOWPROP WINDOW 'REGION]
                   (RETURN))
          [WINDOWPROP WINDOW 'DIVISION (SETQ DIVISION (DIFFERENCE (with
 REGION REGION
                                                                        (SELECTQ ROTATION
                                                                            (90 TOP)
                                                                            RIGHT))
                                                             (STRINGWIDTH (for
 DATATYPE in
 DATATYPES
                                                                             largest
 (NCHARS DATATYPE 
                                                                                  SHOWSTORAGEPRIN2FLG
                                                                                            ))
                                                                    FONT SHOWSTORAGEPRIN2FLG]
          (bind
 (WIDTH _ (ADD1 DIVISION))
                [HEIGHT _ (SELECTQ ROTATION
                              (90 (FONTPROP FONT 'ASCENT))
                              (FONTPROP FONT 'DESCENT] for
 DATATYPE in
 DATATYPES
             do
 (SELECTQ ROTATION
                    (90 (MOVETO HEIGHT WIDTH WINDOW))
                    (MOVETO WIDTH HEIGHT WINDOW))
                (if
 SHOWSTORAGEPRIN2FLG
                    then
 (printout WINDOW |.P2| DATATYPE)
                  else
 (printout WINDOW DATATYPE))
                (add
 HEIGHT FONTHEIGHT))
          (SHOWSTORAGEUPDATE
 WINDOW])

(SHOWSTORAGEUPDATE

  [LAMBDA (WINDOW)
                                           (* ; "Edited  9-Sep-87 07:48 by cdl")


    (DECLARE
 (SPECVARS WINDOW)
           (GLOBALVARS WAITINGCURSOR))
    (RESETFORM
     (CURSOR WAITINGCURSOR)
     (LET ((FONT (DSPFONT NIL WINDOW))
           (DIVISION (WINDOWPROP WINDOW 'DIVISION))
           (MODE (WINDOWPROP WINDOW 'MODE))
           (DATATYPES (WINDOWPROP WINDOW 'DATATYPES))
           (ALLOCMDSLST (WINDOWPROP WINDOW 'ALLOCMDS NIL))
           (FREE (CREATECELL \FIXP))
           ALLOCMDS DATATYPE REGION ITEMSPERMDS TYPENUMBER ROTATION FONTHEIGHT)
          (DECLARE
 (SPECVARS ALLOCMDS))
          (SETQ FONTHEIGHT (FONTPROP FONT 'HEIGHT))
          (SETQ REGION (SELECTQ (SETQ ROTATION (FONTPROP FONT 'ROTATION))
                           (90 (create
 REGION
                                      WIDTH _ FONTHEIGHT
                                      LEFT _ 1))
                           (create
 REGION
                                  HEIGHT _ FONTHEIGHT
                                  BOTTOM _ 0)))
          (for
 DATATYPE in
 DATATYPES
             do
 (SETQ TYPENUMBER (\TYPENUMBERFROMNAME DATATYPE))
                (SELECTQ MODE
                    ((PAGE ITEM) 
                         (\StatsZero FREE)
                         (if
 (NULL ALLOCMDSLST)
                             then
 (SETQ ALLOCMDSLST (SHOWSTORAGEALLOCMDS
 (WINDOWPROP WINDOW
                                                                                'THRESHOLD)
                                                           DATATYPE)))
                         (SETQ ALLOCMDS (CADR (pop
 ALLOCMDSLST)))
                         [if
 (EQ 'LISTP (\TYPENAMEFROMNUMBER TYPENUMBER))
                             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))
                    (ITEM (SHOWSTORAGEDISPLAY
 (TIMES ALLOCMDS ITEMSPERMDS)
                                 FREE WINDOW REGION))
                    (BOX (SHOWSTORAGEDISPLAY
 (BOXCOUNT TYPENUMBER)
                                NIL WINDOW REGION))
                    (SHOULDNT))
                (with
 REGION REGION (SELECTQ ROTATION
                                        (90 (add
 LEFT FONTHEIGHT))
                                        (add
 BOTTOM FONTHEIGHT])

(SHOWSTORAGEDISPLAY

  [LAMBDA (TOTAL FREE WINDOW REGION)
                         (* cdl "28-Jan-87 18:22")

    (PROG ((FONT (DSPFONT NIL WINDOW))
           (DIVISION (WINDOWPROP WINDOW 'DIVISION))
           ROTATION INUSE OFFSET STRINGWIDTH)
          (with
 REGION REGION [SELECTQ (SETQ ROTATION (FONTPROP FONT 'ROTATION))
                                  (90 (SETQ HEIGHT TOTAL)
                                      (SETQ BOTTOM (DIFFERENCE DIVISION TOTAL))
                                      [SETQ OFFSET (PLUS LEFT (SUB1 (FONTPROP FONT 'ASCENT])
                                  (PROGN (SETQ WIDTH TOTAL)
                                         (SETQ LEFT (DIFFERENCE DIVISION TOTAL))
                                         (SETQ OFFSET (PLUS BOTTOM (FONTPROP FONT 'DESCENT]
                (DSPFILL REGION BLACKSHADE NIL WINDOW)
                (if
 (NULL FREE)
                    then
 (if
 (GREATERP TOTAL (STRINGWIDTH TOTAL FONT))
                             then
 (SELECTQ ROTATION
                                      (90 (MOVETO OFFSET (ADD1 (MAX BOTTOM 0))
                                                 WINDOW))
                                      (MOVETO (ADD1 (MAX LEFT 0))
                                             OFFSET WINDOW))
                                  (printout WINDOW TOTAL))
                         (RETURN))
                (if
 (GREATERP (SETQ INUSE (DIFFERENCE TOTAL FREE))
                           (STRINGWIDTH INUSE FONT))
                    then
 (SELECTQ ROTATION
                             (90 (MOVETO OFFSET (ADD1 (MAX (PLUS BOTTOM FREE)
                                                           0))
                                        WINDOW))
                             (MOVETO (ADD1 (MAX (PLUS LEFT FREE)
                                                0))
                                    OFFSET WINDOW))
                         (DSPOPERATION 'INVERT WINDOW)
                         (PRIN1 INUSE WINDOW)
                         (DSPOPERATION 'REPLACE WINDOW))
                (SELECTQ ROTATION
                    (90 (SETQ HEIGHT FREE))
                    (SETQ WIDTH FREE))
                (DSPFILL REGION SHOWSTORAGESHADE NIL WINDOW)
                (if
 (AND (GREATERP FREE (SETQ STRINGWIDTH (STRINGWIDTH FREE FONT)))
                         (GREATERP (DIFFERENCE DIVISION INUSE)
                                STRINGWIDTH))
                    then
 (SELECTQ ROTATION
                             (90 (MOVETO OFFSET (ADD1 (MAX BOTTOM 0))
                                        WINDOW))
                             (MOVETO (ADD1 (MAX LEFT 0))
                                    OFFSET WINDOW))
                         (PRIN1 FREE WINDOW])

(SHOWSTORAGEALLOCMDS

  [LAMBDA (THRESHOLD TYPES)
                                  (* ; "Edited  9-Sep-87 10:05 by cdl")


    (DECLARE
 (SPECVARS THRESHOLD)
           (GLOBALVARS WAITINGCURSOR))
    (RESETFORM (CURSOR WAITINGCURSOR)
           (bind
 ALLOCMDS declare%:
 (SPECVARS ALLOCMDS) for
 DATATYPE
              inside
 (OR TYPES (LDIFFERENCE (DATATYPES)
                                      SHOWSTORAGEIGNORE)) eachtime
 (SETQ ALLOCMDS 0)
                                                                [\MAPMDS (\TYPENUMBERFROMNAME 
                                                                                DATATYPE)
                                                                       (FUNCTION (LAMBDA NIL
                                                                                   (ADD1VAR ALLOCMDS]
              when
 (GEQ (TIMES ALLOCMDS (QUOTIENT \MDSIncrement WORDSPERPAGE))
                        THRESHOLD) collect
 (LIST DATATYPE ALLOCMDS])
)

(ADDTOVAR SHOWSTORAGEIGNORE
 SMALLP LITATOM CHARACTER CL::STRUCTURE-OBJECT)

(RPAQ? SHOWSTORAGEMODES
 '(ITEM PAGE BOX))

(RPAQ? SHOWSTORAGEWINDOWSIZE
 275)

(RPAQ? SHOWSTORAGEDEFAULTTHRESHOLD
 1)

(RPAQ? SHOWSTORAGEFONT
 (bind FONT for ROTATION in '(90 0) thereis
                             (for SIZE from 5 to 10 thereis (SETQ FONT (FONTCREATE 'HELVETICA SIZE
                                                                              'MRR ROTATION
                                                                              'DISPLAY T)))
                             finally
                             (RETURN FONT)))

(RPAQ? SHOWSTORAGEPRIN2FLG
 NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS SHOWSTORAGEIGNORE SHOWSTORAGEMODES SHOWSTORAGEWINDOWSIZE SHOWSTORAGEDEFAULTTHRESHOLD 
       SHOWSTORAGEFONT SHOWSTORAGEPRIN2FLG)
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(RPAQQ SHOWSTORAGESHADE
 42405)

(CONSTANTS (SHOWSTORAGESHADE 42405))
)
)
(PUTPROPS STORAGE COPYRIGHT ("Stanford University" 1984 1985 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1791 3480 (SHOWSTORAGE 1801 . 3478)) (3481 15428 (SHOWSTORAGEBUTTONFN 3491 . 4996) (
SHOWSTORAGEREPAINT 4998 . 7973) (SHOWSTORAGEUPDATE 7975 . 11637) (SHOWSTORAGEDISPLAY 11639 . 14411) (
SHOWSTORAGEALLOCMDS 14413 . 15426)))))
STOP