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

(FILECREATED "14-Mar-88 17:29:38" |{MCS:MCS:STANFORD}<LANE>MONITOR.;9|
 10032  

      changes to%:  (VARS MONITORCOMS)
                    (FNS MONITOR.GET.BITMAP MONITOR MONITOR.BUTTONEVENTFN MONITOR.SHRINK.BITMAP 
                         MONITOR.SEND.BITMAP)
                    (COURIERPROGRAMS MONITOR)

      previous date%: "14-Mar-88 09:15:11" |{MCS:MCS:STANFORD}<LANE>MONITOR.;1|)


(PRETTYCOMPRINT MONITORCOMS)

(RPAQQ MONITORCOMS
 ((FNS MONITOR MONITOR.GET.BITMAP MONITOR.BUTTONEVENTFN MONITOR.SHRINK.BITMAP 
                         MONITOR.SEND.BITMAP)
                    (COURIERPROGRAMS MONITOR)
                    (INITVARS (MONITOR.SCALE 3)
                           MONITOR.SCRATCH.BITMAPS)
                    (GLOBALVARS MONITOR.SCALE MONITOR.SCRATCH.BITMAPS)
                    (DECLARE%: DONTCOPY (RECORDS MONITOR.SCRATCH.BITMAP))
                    (FILES COURIERSERVE BITMAPFNS)
                    (P (COURIER.START.SERVER))))
(DEFINEQ

(MONITOR

  [LAMBDA (HOST SCALE)
                                       (* ; "Edited 14-Mar-88 13:46 by cdl")


    (LET ((COURIER.STREAM (COURIER.OPEN HOST))
          BITMAP SCREEN.WINDOW CLOSEUP.WINDOW)
         (if
 (NULL SCALE)
             then
 (SETQ SCALE MONITOR.SCALE))
         (SETQ BITMAP (MONITOR.GET.BITMAP
 COURIER.STREAM SCALE))
         [SETQ SCREEN.WINDOW (CREATEW (with
 REGION (GETBOXREGION (WIDTHIFWINDOW (BITMAPWIDTH BITMAP))
                                                          (TIMES (HEIGHTIFWINDOW (BITMAPHEIGHT BITMAP
                                                                                        ))
                                                                 2))
                                            (CREATEREGION LEFT BOTTOM WIDTH (QUOTIENT HEIGHT 2]
         (BITBLT BITMAP NIL NIL SCREEN.WINDOW)
         (SETQ CLOSEUP.WINDOW
          (CREATEW (with
 REGION (WINDOWPROP SCREEN.WINDOW 'REGION)
                         (create
 REGION
                                LEFT _ LEFT
                                BOTTOM _ PTOP
                                WIDTH _ WIDTH
                                HEIGHT _ (HEIGHTIFWINDOW (BITMAPHEIGHT BITMAP)
                                                HOST)))
                 HOST))
         (ATTACHWINDOW CLOSEUP.WINDOW SCREEN.WINDOW)
         (BITBLT (MONITOR.GET.BITMAP
 COURIER.STREAM SCALE (DSPCLIPPINGREGION NIL SCREEN.WINDOW))
                NIL NIL CLOSEUP.WINDOW)
         (WINDOWPROP SCREEN.WINDOW 'MONITOR.SCALE SCALE)
         (WINDOWPROP SCREEN.WINDOW 'COURIER.STREAM COURIER.STREAM)
         (WINDOWPROP SCREEN.WINDOW 'CLOSEUP.WINDOW CLOSEUP.WINDOW)
         (WINDOWPROP SCREEN.WINDOW 'BUTTONEVENTFN (FUNCTION MONITOR.BUTTONEVENTFN))
         [WINDOWADDPROP SCREEN.WINDOW 'CLOSEFN (FUNCTION (LAMBDA (WINDOW)
                                                           (CLOSEF? (WINDOWPROP WINDOW '
                                                                           COURIER.STREAM))
                                                           (WINDOWPROP WINDOW 'CLOSEUP.WINDOW NIL]
         SCREEN.WINDOW])

(MONITOR.GET.BITMAP

  [LAMBDA (STREAM SCALE REGION)
                              (* ; "Edited 14-Mar-88 14:01 by cdl")


    (LET (BULK.DATA.STREAM)
         (RESETLST [RESETSAVE NIL `(CLOSEF? ,(SETQ BULK.DATA.STREAM (COURIER.CALL STREAM 'MONITOR
                                                                           'SEND.BITMAP SCALE REGION 
                                                                           NIL]
                (READBM BULK.DATA.STREAM])

(MONITOR.BUTTONEVENTFN

  [LAMBDA (WINDOW)
                                           (* ; "Edited 14-Mar-88 13:33 by cdl")


    (LET ((SCALE (WINDOWPROP WINDOW 'MONITOR.SCALE))
          REGION POSITION CLIPPINGREGION)
         (if
 (MOUSESTATE LEFT)
             then
 [with
 REGION (SETQ CLIPPINGREGION (DSPCLIPPINGREGION NIL WINDOW))
                        (SETQ REGION (CREATEREGION NIL NIL (QUOTIENT WIDTH SCALE)
                                            (QUOTIENT HEIGHT SCALE]
                  (until
 (MOUSESTATE UP)
                     do
 (if
 [with
 POSITION (SETQ POSITION (CURSORPOSITION NIL WINDOW POSITION))
                                  (with
 REGION REGION (OR (NEQ XCOORD LEFT)
                                                          (NEQ YCOORD BOTTOM]
                            then
 (with
 REGION REGION (if
 LEFT
                                                         then
 (DSPFILL REGION BLACKSHADE 'INVERT 
                                                                     WINDOW))
                                       (with
 POSITION POSITION (SETQ LEFT XCOORD)
                                             (SETQ BOTTOM YCOORD)))
                                 (DSPFILL REGION BLACKSHADE 'INVERT WINDOW)
                          else
 (BLOCK)) finally
 (if
 (with
 REGION REGION LEFT)
                                                    then
 (DSPFILL REGION BLACKSHADE 'INVERT WINDOW)))
                  (BITBLT [MONITOR.GET.BITMAP
 (WINDOWPROP WINDOW 'COURIER.STREAM)
                                 SCALE
                                 (with
 REGION CLIPPINGREGION
                                       (with
 POSITION (CURSORPOSITION NIL WINDOW POSITION)
                                             (create
 REGION
                                                    LEFT _ (TIMES SCALE XCOORD)
                                                    BOTTOM _ (TIMES SCALE YCOORD)
                                                    WIDTH _ WIDTH
                                                    HEIGHT _ HEIGHT smashing
 REGION]
                         NIL NIL (WINDOWPROP WINDOW 'CLOSEUP.WINDOW))
           elseif
 (MOUSESTATE MIDDLE)
             then
 (RESETFORM (CURSOR WAITINGCURSOR)
                         (BITBLT (MONITOR.GET.BITMAP
 (WINDOWPROP WINDOW 'COURIER.STREAM)
                                        SCALE)
                                NIL NIL WINDOW])

(MONITOR.SHRINK.BITMAP

  [LAMBDA (SOURCE SCALE DESTINATION SCRATCH)
                 (* ; "Edited 14-Mar-88 11:37 by cdl")

                                                             (* Specialized rewrite of SHRINKBITMAP)

    [if
 (EQP SCALE 1)
        then
 (BITBLT SOURCE NIL NIL DESTINATION)
      else
 (BLTSHADE WHITESHADE SCRATCH)
           (BLTSHADE WHITESHADE DESTINATION)
           (LET ((HEIGHT (BITMAPHEIGHT SOURCE))
                 (WIDTH (BITMAPWIDTH SOURCE)))
                (for
 Y from
 0 to
 (SUB1 HEIGHT) do
 (BITBLT SOURCE 0 Y SCRATCH 0 (QUOTIENT Y SCALE)
                                                         WIDTH 1 'INPUT 'PAINT))
                (for
 X from
 0 to
 (SUB1 WIDTH) do
 (BITBLT SCRATCH X 0 DESTINATION (QUOTIENT X SCALE)
                                                        0 1 HEIGHT 'INPUT 'PAINT]
    DESTINATION])

(MONITOR.SEND.BITMAP

  [LAMBDA (COURIERSTREAM PROGRAM PROCEDURE SCALE REGION BULK.DATA.STREAM)

                                                             (* ; "Edited 14-Mar-88 11:37 by cdl")


    [LET ((SCRATCH.BITMAP (ASSOC SCALE MONITOR.SCRATCH.BITMAPS)))
         [if
 (NULL SCRATCH.BITMAP)
             then
 (push
 MONITOR.SCRATCH.BITMAPS (SETQ SCRATCH.BITMAP
                                                 (with
 REGION WHOLESCREEN
                                                       (create
 MONITOR.SCRATCH.BITMAP
                                                              BITMAPSCALE _ SCALE
                                                              DESTINATION _ (BITMAPCREATE
                                                                             (QUOTIENT WIDTH SCALE)
                                                                             (QUOTIENT HEIGHT SCALE))
                                                              SCRATCH _ (BITMAPCREATE WIDTH
                                                                               (QUOTIENT HEIGHT SCALE
                                                                                      ]
         (with
 MONITOR.SCRATCH.BITMAP SCRATCH.BITMAP (if
 REGION
                                                         then
 (BLTSHADE WHITESHADE DESTINATION)
                                                              (with
 REGION REGION
                                                                    (BITBLT (SCREENBITMAP)
                                                                           LEFT BOTTOM DESTINATION))
                                                              (WRITEBM BULK.DATA.STREAM DESTINATION)
                                                       else
 (WRITEBM BULK.DATA.STREAM
                                                                   (MONITOR.SHRINK.BITMAP
 (
                                                                                         SCREENBITMAP
                                                                                           )
                                                                          SCALE DESTINATION SCRATCH]
    '(RETURN])
)

(COURIERPROGRAM MONITOR
 (1118 0)
    TYPES

      ((SCALE INTEGER)
       (REGION (SEQUENCE INTEGER)))
    PROCEDURES

      ((SEND.BITMAP 0 (SCALE REGION BULK.DATA.SINK)
              RETURNS NIL REPORTS NIL IMPLEMENTEDBY MONITOR.SEND.BITMAP))
    ERRORS

      NIL)

(RPAQ? MONITOR.SCALE
 3)

(RPAQ? MONITOR.SCRATCH.BITMAPS
 NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS MONITOR.SCALE MONITOR.SCRATCH.BITMAPS)
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE

(RECORD MONITOR.SCRATCH.BITMAP
 (BITMAPSCALE DESTINATION SCRATCH))
)
)
(FILESLOAD COURIERSERVE BITMAPFNS)
(COURIER.START.SERVER)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1029 9390 (MONITOR 1039 . 3201) (MONITOR.GET.BITMAP 3203 . 3685) (MONITOR.BUTTONEVENTFN
 3687 . 6211) (MONITOR.SHRINK.BITMAP 6213 . 7126) (MONITOR.SEND.BITMAP 7128 . 9388)))))
STOP