(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "14-Mar-88 17:29:38" |{MCS:MCS:STANFORD}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}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