(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "24-Sep-2023 14:29:56" {WMEDLEY}SHOWTIME.;2 26541 :EDIT-BY rmk :CHANGES-TO (VARS SHOWTIMECOMS SHOWTIME.ICON SHOWTIME.MASK) (FNS INFORES SHOWTIME.READ.PRESS) :PREVIOUS-DATE "10-Apr-89 18:56:29" {WMEDLEY}SHOWTIME.;1) (* ; " Copyright (c) 1986-1989 by Xerox Corporation. ") (PRETTYCOMPRINT SHOWTIMECOMS) (RPAQQ SHOWTIMECOMS ( (* ;;; "Mitch Gaarnat and (Mike?) Gocek wrote the original versions of these fns in 1985. They were later modified added to by T. Bigham in 1986 and 1987. Ron Fischer at Xerox AI Systems made a quick pass to convert the file to run in Medley XAIE.") (FNS GET.SHOWTIME.MENU MAKEBRUSH MAKEBRUSH.HEADER&BITMAP INFORES READ.RES SHOWTIME SHOWTIME.BUTTONEVENTFN SHOWTIME.GET.NAME SHOWTIME.ICONFN SHOWTIME.LOAD.BITMAP SHOWTIME.LOAD.BRUSH SHOWTIME.LOAD.DIF.FILE SHOWTIME.LOAD.RES.FILE SHOWTIME.MAKE.RES SHOWTIME.MAKE.RES.HEADER SHOWTIME.MAKE.RES.TAIL SHOWTIME.READ.BRUSH SHOWTIME.READ.LISPBM SHOWTIME.READ.PRESS SHOWTIME.READ.RES SHOWTIME.RES.CHECK&MASSAGE SHOWTIME.RESHAPE.WINDOW SHOWTIME.SAVE.BITMAP SHOWTIME.SAVE.LISPBM SHOWTIME.SCALE.BITMAP SHOWTIME.ADD.FORMAT SHOWTIME.SETUP.WINDOWPROPS SHOWTIME.SHOW.BITMAP SHOWTIME.WRITEBM) [VARS SHOWTIME.ICON SHOWTIME.MASK (SHOWTIME.LOAD.SUBITEMS) (SHOWTIME.SAVE.SUBITEMS) (SHOWTIME.MENU) (SHOWTIMETITLEREGION '(7 7 56 29)) (SHOWTIME.DEFAULT.FORMAT 'LISP) (BackgroundMenu) (SHOWTIME.FORMAT.FNS '(SHOWTIME.FORMAT.FNS (RES READ.RES SHOWTIME.MAKE.RES) (LISP SHOWTIME.READ.LISPBM SHOWTIME.SAVE.LISPBM) (DIF SHOWTIME.LOAD.DIF.FILE NIL) (BRUSH SHOWTIME.LOAD.BRUSH MAKEBRUSH) (PRESS READPRESS PRESSBITMAP] (APPENDVARS (BackgroundMenuCommands (Showtime '(SHOWTIME) "Opens a showtime window for use."))) (FILES BITMAPFNS SCALEBITMAP READBRUSH) (P (SHOWTIME.ADD.FORMAT)))) (* ;;; "Mitch Gaarnat and (Mike?) Gocek wrote the original versions of these fns in 1985. They were later modified added to by T. Bigham in 1986 and 1987. Ron Fischer at Xerox AI Systems made a quick pass to convert the file to run in Medley XAIE." ) (DEFINEQ (GET.SHOWTIME.MENU (LAMBDA NIL (* ; "Edited 13-May-88 15:19 by raf") (DECLARE (GLOBALVARS SHOWTIME.MENU)) (OR SHOWTIME.MENU (SETQ SHOWTIME.MENU (create MENU TITLE _ "Viewer Options" CENTERFLG _ T MENUFONT _ (FONTCREATE (QUOTE TIMESROMAN) 12) ITEMS _ (BQUOTE ((" Load Another Picture " (QUOTE LOAD) NIL (SUBITEMS (\,@ SHOWTIME.LOAD.SUBITEMS))) ("Show a Bitmap" (QUOTE SHOW) NIL (SUBITEMS ("Put bitmap in this window" (QUOTE SHOW)) ("Reshape window to fit new Bitmap" (QUOTE RESHAPE&SHOW)))) ("Edit Bitmap" (QUOTE EDIT)) ("Redisplay" (QUOTE REDISPLAY) NIL (SUBITEMS ("Redisplay bitmap in this window" (QUOTE REDISPLAY)) ("Reshape window to fit this bitmap" (QUOTE RESHAPE&SHOW)))) ("Scale" (QUOTE SCALE)) ("Save this Picture" (QUOTE SAVE) NIL (SUBITEMS (\,@ SHOWTIME.SAVE.SUBITEMS))))))))) ) (MAKEBRUSH (LAMBDA (FILESPEC BITMAP) (* ; "Edited 13-May-88 16:00 by raf") (LET ((STREAM (GETSTREAM FILESPEC (QUOTE OUTPUT)))) (MAKEBRUSH.HEADER&BITMAP BITMAP STREAM) (CLOSEF STREAM))) ) (MAKEBRUSH.HEADER&BITMAP (LAMBDA (BITMAP STREAM) (* ; "Edited 13-May-88 16:01 by raf") (LET ((BASE (fetch BITMAPBASE of BITMAP)) (HEIGHT (fetch BITMAPHEIGHT of BITMAP)) (WIDTH (fetch BITMAPWIDTH of BITMAP)) (RWIDTH (fetch BITMAPRASTERWIDTH of BITMAP))) (BOUT STREAM 1) (BOUT STREAM 0) (BOUT STREAM (LRSH (LOGAND WIDTH 65280) 8)) (BOUT STREAM (LOGAND WIDTH 255)) (BOUT STREAM (LRSH (LOGAND HEIGHT 65280) 8)) (BOUT STREAM (LOGAND HEIGHT 255)) (for I from 1 to 8 do (BOUT STREAM 0)) (BOUT STREAM (LRSH (LOGAND RWIDTH 65280) 8)) (BOUT STREAM (LOGAND RWIDTH 255)) (for Y from 0 to (SUB1 HEIGHT) do (for X from 0 to (SUB1 RWIDTH) do (BOUT STREAM (\GETBASEBYTE BASE 0)) (BOUT STREAM (\GETBASEBYTE BASE 1)) (SETQ BASE (\ADDBASE BASE 1)))))) ) (INFORES [LAMBDA (FILE) (* ; "Edited 24-Sep-2023 14:28 by rmk") (* ; "Edited 13-May-88 16:01 by raf") (LET (STREAM PATTERN WIDTH HEIGHT HI.X LO.X HI.Y LO.Y REAL.X REAL.Y (Header ' Interpress/Xerox/2.1/RasterEncoding/1.0% )) (* ;  "Return the width, height, bits per pixel and address of the first data byte as a list.") (SETQ STREAM (OPENSTREAM FILE 'INPUT)) (if [EQ Header (PACK (for X from 1 to 40 collect (CHARACTER (\BIN STREAM] then (* ;  "bypass BEGIN 254/720000 DUP 2 MAKEVEC") [until (EQUAL (NTH (REVERSE PATTERN) (IDIFFERENCE (LENGTH PATTERN) 4)) '(181 15 162 161 27)) do (SETQ PATTERN (push PATTERN (\BIN STREAM] (SETQ HI.X (\BIN STREAM)) (SETQ LO.X (\BIN STREAM)) (SETQ HI.Y (\BIN STREAM)) (SETQ LO.Y (\BIN STREAM)) (SETQ REAL.X (IDIFFERENCE (PLUS (LSH HI.X 8) LO.X) 4000)) (SETQ REAL.Y (IDIFFERENCE (PLUS (LSH HI.Y 8) LO.Y) 4000)) (LIST REAL.X REAL.Y STREAM) else (CLOSEF STREAM) NIL]) (READ.RES (LAMBDA (FILE) (* ; "Edited 13-May-88 16:02 by raf") (LET (STREAM A B BITMAP BASE WORDS Attributes WIDTH HEIGHT) (if (SETQ FILE (FULLNAME FILE)) then (* ; "If the file exists, check to see if it's RES format.") (if (SETQ Attributes (INFORES FILE)) then (SETQ WIDTH (CAR Attributes)) (SETQ HEIGHT (CADR Attributes)) (SETQ STREAM (CADDR Attributes)) (SETQ BITMAP (BITMAPCREATE WIDTH HEIGHT 1)) (SETQ BASE (fetch (BITMAP BITMAPBASE) of BITMAP)) (* ; "RESINFO leaves the file open at byte 62.0 Image data begins at byte 95") (for X from 63 to 94 do (\BIN STREAM)) (for X from 1 to (IQUOTIENT (ITIMES WIDTH HEIGHT) 16) do (SETQ A (\BIN STREAM)) (SETQ B (\BIN STREAM)) (\PUTBASE BASE 0 (LOGOR (LLSH A 8) B)) (SETQ BASE (\ADDBASE BASE 1)) (ZEROP (LOGAND X 1023))) (CLOSEF STREAM) BITMAP else (printout PROMPTWINDOW T FILE "isn't an RES file")) else (printout PROMPTWINDOW T "Can't find " FILE) NIL))) ) (SHOWTIME (LAMBDA (FILENAME FORMAT) (* TBigham " 7-Feb-87 18:05") (LET (BITMAP WIDTH HEIGHT WINDOW BITMAP.NAME) (if FILENAME then (SETQ FILENAME (\ADD.CONNECTED.DIR FILENAME)) (if (BITMAPP (SETQ BITMAP (SHOWTIME.LOAD.BITMAP FILENAME FORMAT))) then (SETQ WIDTH (BITMAPWIDTH BITMAP)) (SETQ HEIGHT (BITMAPHEIGHT BITMAP)) (SETQ WINDOW (CREATEW (LIST 200 200 WIDTH HEIGHT))) (WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN) (FUNCTION SHOWTIME.BUTTONEVENTFN)) (WINDOWPROP WINDOW (QUOTE ICONFN) (FUNCTION SHOWTIME.ICONFN)) (CLEARW WINDOW) (BITBLT BITMAP 0 0 WINDOW) (SETQ BITMAP.NAME (SET (U-CASE (FILENAMEFIELD FILENAME (QUOTE NAME))) BITMAP)) (SHOWTIME.SETUP.WINDOWPROPS WINDOW BITMAP FILENAME) else (PROMPTPRINT (CONCAT "Couldn't find " FILENAME))) else (SETQ WINDOW (CREATEW NIL "Empty Viewer")) (WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN) (FUNCTION SHOWTIME.BUTTONEVENTFN)) (WINDOWPROP WINDOW (QUOTE ICONFN) (FUNCTION SHOWTIME.ICONFN)) (WINDOWPROP WINDOW (QUOTE BITMAP.VALUE) NIL) (WINDOWPROP WINDOW (QUOTE BITMAP.NAME) NIL)))) ) (SHOWTIME.BUTTONEVENTFN (LAMBDA (WINDOW) (* ; "Edited 13-May-88 15:35 by raf") (DECLARE (GLOBALVARS PROMPTWINDOW)) (LET (BITMAP SELECTION BITMAP.NAME ICON PERIOD.POS SWITCH) (SETQ SELECTION (MENU (GET.SHOWTIME.MENU))) (if (SETQ PERIOD.POS (STRPOS "." SELECTION)) then (SETQ SWITCH (MKATOM (SUBSTRING SELECTION 1 (SUB1 PERIOD.POS)))) else (SETQ SWITCH SELECTION)) (SELECTQ SWITCH (LOAD (SHOWTIME.LOAD.BITMAP NIL (MKATOM (SUBSTRING SELECTION 6)) WINDOW)) (SHOW (SETQ BITMAP.NAME (SHOWTIME.GET.NAME "Bitmap Name (CR to end)")) (if BITMAP.NAME then (SETQ BITMAP (EVAL BITMAP.NAME)) (SHOWTIME.SHOW.BITMAP BITMAP BITMAP.NAME WINDOW SELECTION))) (RESHAPE&SHOW (SETQ BITMAP (WINDOWPROP WINDOW (QUOTE BITMAP))) (if (BITMAPP BITMAP) then (SHOWTIME.SHOW.BITMAP BITMAP (WINDOWPROP WINDOW (QUOTE BITMAP.NAME)) WINDOW SELECTION))) (RESHAPE (SHOWTIME.RESHAPE.WINDOW BITMAP WINDOW) (CLEARW WINDOW) (BITBLT BITMAP 0 0 WINDOW)) (REDISPLAY (SETQ BITMAP (WINDOWPROP WINDOW (QUOTE BITMAP))) (CLEARW WINDOW) (BITBLT BITMAP 0 0 WINDOW)) (EDIT (if (BITMAPP (SETQ BITMAP (WINDOWPROP WINDOW (QUOTE BITMAP)))) then (SETQ BITMAP (EDIT.BITMAP BITMAP)) (WINDOWPROP WINDOW (QUOTE BITMAP) BITMAP) (CLEARW WINDOW) (BITBLT BITMAP 0 0 WINDOW) else (printout PROMPTWINDOW T "No bitmap in Viewer to edit!"))) (SAVE (if (BITMAPP (SETQ BITMAP (WINDOWPROP WINDOW (QUOTE BITMAP)))) then (SHOWTIME.SAVE.BITMAP NIL BITMAP (MKATOM (SUBSTRING SELECTION 6))))) (SCALE (SHOWTIME.SCALE.BITMAP (WINDOWPROP WINDOW (QUOTE BITMAP)) WINDOW)) NIL) (if (SETQ ICON (WINDOWPROP WINDOW (QUOTE ICONWINDOW))) then (ICONW.TITLE ICON BITMAP.NAME)))) ) (SHOWTIME.GET.NAME (LAMBDA (PROMPTSTRING USE.EOL) (* TBigham "27-Mar-86 10:42") (DECLARE (GLOBALVARS LASTMOUSEX LASTMOUSEY)) (OR PROMPTSTRING (SETQ PROMPTSTRING "Name (CR to end) ")) (LET* ((FONT (DEFAULTFONT)) (WIDTH (IPLUS (STRINGWIDTH PROMPTSTRING FONT) (ITIMES 60 (CHARWIDTH (CHARCODE A) FONT)))) (PROMPTW (CREATEW (MAKEWITHINREGION (CREATEREGION LASTMOUSEX LASTMOUSEY (WIDTHIFWINDOW WIDTH) (HEIGHTIFWINDOW (FONTPROP FONT (QUOTE HEIGHT))))) NIL NIL T))) (if USE.EOL then (RESETLST (RESETSAVE (OPENW PROMPTW) (BQUOTE (CLOSEW %, PROMPTW))) (MKATOM (PROMPTFORWORD PROMPTSTRING NIL NIL PROMPTW NIL NIL (CHARCODE EOL)))) else (RESETLST (RESETSAVE (OPENW PROMPTW) (BQUOTE (CLOSEW %, PROMPTW))) (MKATOM (PROMPTFORWORD PROMPTSTRING NIL NIL PROMPTW NIL)))))) ) (SHOWTIME.ICONFN (LAMBDA (WINDOW OLDICON) (* TBigham " 7-Feb-87 18:10") (DECLARE (GLOBALVARS SHOWTIME.ICON SHOWTIME.MASK SHOWTIMETITLEREGION)) (OR OLDICON (TITLEDICONW (create TITLEDICON ICON _ SHOWTIME.ICON MASK _ SHOWTIME.MASK TITLEREG _ SHOWTIMETITLEREGION) (WINDOWPROP WINDOW (QUOTE BITMAP.NAME)) (FONTCREATE (QUOTE GACHA) 8)))) ) (SHOWTIME.LOAD.BITMAP (LAMBDA (FILENAME FORMAT WINDOW) (* ; "Edited 13-May-88 16:18 by raf") (DECLARE (GLOBALVARS SHOWTIME.DEFAULT.FORMAT PROMPTWINDOW SHOWTIME.FORMAT.FNS WAITINGCURSOR)) (OR FILENAME (SETQ FILENAME (SHOWTIME.GET.NAME NIL T))) (OR FORMAT (SETQ FORMAT SHOWTIME.DEFAULT.FORMAT)) (LET ((NAME (U-CASE (FILENAMEFIELD FILENAME (QUOTE NAME)))) (LOADFN (CADR (FASSOC FORMAT SHOWTIME.FORMAT.FNS))) ICON BITMAP OPTION) (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) (if (NULL (INFILEP FILENAME)) THEN (printout PROMPTWINDOW T "Couldn't find " FILENAME) ELSEIF (NULL LOADFN) THEN (printout PROMPTWINDOW T "Can't read bitmaps in " FORMAT " format.") ELSEIF (NULL (BITMAPP (PROGN (printout PROMPTWINDOW T "Loading " FILENAME "...") (SETQ BITMAP (EVAL (LIST LOADFN (KWOTE FILENAME))))))) THEN (printout PROMPTWINDOW T "Problem loading " FORMAT " format " FILENAME) ELSE (SHOWTIME.SHOW.BITMAP BITMAP NAME WINDOW OPTION) (SETTOPVAL (U-CASE (FILENAMEFIELD FILENAME (QUOTE NAME))) BITMAP) (if (WINDOWP WINDOW) then (WINDOWPROP WINDOW (QUOTE BITMAP.NAME) NAME) (if (SETQ ICON (WINDOWPROP WINDOW (QUOTE ICONWINDOW))) then (ICONW.TITLE ICON NAME))) (printout PROMPTWINDOW "done!"))))) ) (SHOWTIME.LOAD.BRUSH (LAMBDA (FILE) (* TBigham "11-Feb-87 20:26") (CAR (READBRUSHFILE FILE)))) (SHOWTIME.LOAD.DIF.FILE (LAMBDA (FILE) (* TBigham "10-Jun-86 14:34") (* Mitch Garnaat) (LET (BITMAP BASE BITMAPRASTERWIDTH TEMPBASE WIDTH WIDTHLOW WIDTHHIGH HEIGHT HEIGHTLOW HEIGHTHIGH FILENAME STREAM) (if (INFILEP FILE) then (SETQ STREAM (OPENSTREAM FILE (QUOTE INPUT))) (for I from 0 to 7 do (\BIN STREAM)) (SETQ WIDTHLOW (\BIN STREAM)) (SETQ WIDTHHIGH (\BIN STREAM)) (SETQ WIDTH (LOGOR WIDTHLOW (LLSH WIDTHHIGH 8))) (SETQ HEIGHTLOW (\BIN STREAM)) (SETQ HEIGHTHIGH (\BIN STREAM)) (SETQ HEIGHT (LOGOR HEIGHTLOW (LLSH HEIGHTHIGH 8))) (for I from 12 to 63 do (\BIN STREAM)) (SETQ BITMAP (BITMAPCREATE (ITIMES WIDTH 8) HEIGHT 1)) (SETQ BASE (fetch BITMAPBASE of BITMAP)) (SETQ BITMAPRASTERWIDTH (fetch BITMAPRASTERWIDTH of BITMAP)) (for Y from 0 to (SUB1 HEIGHT) do (SETQ TEMPBASE (\ADDBASE BASE (ITIMES Y BITMAPRASTERWIDTH))) (for X from 0 to (SUB1 WIDTH) do (\PUTBASEBYTE TEMPBASE (IREMAINDER X 2) (\BIN STREAM)) (COND ((EQUAL (IREMAINDER X 2) 1) (SETQ TEMPBASE (\ADDBASE TEMPBASE 1)))))) (CLOSEF? STREAM) BITMAP else (PROMPTPRINT (CONCAT "Couldn't find " FILE))))) ) (SHOWTIME.LOAD.RES.FILE (LAMBDA (FILENAME) (* TBigham "30-Dec-86 12:03") (* load an RES image and makes it into a lisp bitmap) (DECLARE (GLOBALVARS WAITINGCURSOR)) (LET (BITMAP) (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) (SETQ BITMAP (READ.RES FILENAME))))) ) (SHOWTIME.MAKE.RES (LAMBDA (FILENAME BITMAP) (* TBigham " 1-Mar-87 18:24") (LET (STREAM) (if (AND FILENAME (SETQ STREAM (OPENSTREAM FILENAME (QUOTE OUTPUT)))) then (SETQ BITMAP (SHOWTIME.RES.CHECK&MASSAGE BITMAP)) (SHOWTIME.MAKE.RES.HEADER STREAM BITMAP) (SHOWTIME.WRITEBM BITMAP STREAM) (SHOWTIME.MAKE.RES.TAIL STREAM) (SETFILEINFO (CLOSEF? STREAM) (QUOTE TYPE) 4428)))) ) (SHOWTIME.MAKE.RES.HEADER (LAMBDA (STREAM BITMAP) (* TBigham "26-Jun-87 09:11") (LET* ((WIDTH (BITMAPWIDTH BITMAP)) (HEIGHT (BITMAPHEIGHT BITMAP)) (HEADER (QUOTE Interpress/Xerox/2.1/RasterEncoding/1.0% )) (OFFSETWIDTH (PLUS 4000 WIDTH)) (OFFSETHEIGHT 400 HEIGHT) (CLEANX (LOGAND 65535 (PLUS 4000 WIDTH))) (CLEANY (LOGAND 65535 (PLUS 4000 HEIGHT))) (LO.X.ICS (LOGAND 255 CLEANX)) (HI.X.ICS (RSH CLEANX 8)) (LO.Y.ICS (LOGAND 255 CLEANY)) (HI.Y.ICS (RSH CLEANY 8)) BOUNDARY) (SETQ BOUNDARY (for NUMBER from 32 by 32 thereis (if (ILEQ WIDTH NUMBER) then NUMBER else NIL))) (for CHAR in (UNPACK HEADER) do (PRINTCCODE (CAR (CHCON CHAR)) STREAM)) (* BEGIN |254/720000| DUP 2 MAKEVEC) (for BYTE in (QUOTE (160 102 196 8 0 0 0 254 0 10 252 128 160 181 15 162 161 27)) do (\BOUT STREAM BYTE)) (* x dimension in TCS) (\BOUT STREAM HI.X.ICS) (\BOUT STREAM LO.X.ICS) (* y dimension in TCS) (\BOUT STREAM HI.Y.ICS) (\BOUT STREAM LO.Y.ICS) (* mask image -- null) (\BOUT STREAM (QUOTE 15)) (\BOUT STREAM (QUOTE 160)) (* x dimension in ICS same as y dimension in TCS) (\BOUT STREAM HI.Y.ICS) (\BOUT STREAM LO.Y.ICS) (* y dimension in ICS same as x dimension in TCS) (\BOUT STREAM HI.X.ICS) (\BOUT STREAM LO.X.ICS) (* samples per pixel) (\BOUT STREAM (QUOTE 15)) (\BOUT STREAM (QUOTE 161)) (* max sample value) (\BOUT STREAM (QUOTE 15)) (\BOUT STREAM (QUOTE 161)) (* samples interleaved) (\BOUT STREAM (QUOTE 15)) (\BOUT STREAM (QUOTE 160)) (* first transformation from ICS to TCS) (\BOUT STREAM (QUOTE 15)) (* -90 rotate) (\BOUT STREAM (QUOTE 70)) (* second transformation from ICS to TCS) (\BOUT STREAM (QUOTE 160)) (\BOUT STREAM (QUOTE 163)) (* short integer) (\BOUT STREAM (QUOTE 15)) (\BOUT STREAM (QUOTE 160)) (* sense of the transform) (\BOUT STREAM HI.Y.ICS) (\BOUT STREAM LO.Y.ICS) (* translate transform) (\BOUT STREAM (QUOTE 160)) (\BOUT STREAM (QUOTE 162)) (* CONCAT) (\BOUT STREAM (QUOTE 160)) (\BOUT STREAM (QUOTE 165)) (\BOUT STREAM (QUOTE 233)) (LET (HI.NIBBLE MID.NIBBLE LO.NIBBLE PACKED.PIXEL.VECTOR.SIZE CLEANNUM) (SETQ PACKED.PIXEL.VECTOR.SIZE (PLUS 4 (IQUOTIENT (ITIMES BOUNDARY HEIGHT) 8))) (SETQ CLEANNUM (LOGAND 16777215 PACKED.PIXEL.VECTOR.SIZE)) (SETQ HI.NIBBLE (RSH (LOGAND 16711680 CLEANNUM) 16)) (SETQ MID.NIBBLE (RSH (LOGAND 65280 CLEANNUM) 8)) (SETQ LO.NIBBLE (LOGAND 255 CLEANNUM)) (\BOUT STREAM HI.NIBBLE) (\BOUT STREAM MID.NIBBLE) (\BOUT STREAM LO.NIBBLE)) (* bits per sample) (\BOUT STREAM (QUOTE 0)) (\BOUT STREAM (QUOTE 1)) (\BOUT STREAM HI.X.ICS) (\BOUT STREAM LO.X.ICS))) ) (SHOWTIME.MAKE.RES.TAIL (LAMBDA (STREAM) (* TBigham " 4-Apr-86 06:38") (LET ((DATA (QUOTE (161 194 15 160 15 161 15 160 15 163 197 5 88 101 114 111 120 197 10 71 114 97 121 76 105 110 101 97 114 15 162 161 27 161 166 160 231 15 160 66 190 160 103)))) (for BYTE in DATA do (BOUT STREAM BYTE)))) ) (SHOWTIME.READ.BRUSH (LAMBDA (FILENAME) (* TBigham "30-Dec-86 12:00") (CAR (READBRUSHFILE FILENAME)))) (SHOWTIME.READ.LISPBM (LAMBDA (FILENAME) (* ; "Edited 10-Apr-89 18:51 by Briggs") (LET ((STREAM (OPENSTREAM FILENAME (QUOTE INPUT)))) (if (STREAMP STREAM) then (PROG1 (READBM STREAM) (CLOSEF STREAM)) else NIL))) ) (SHOWTIME.READ.PRESS [LAMBDA (FILENAME) (* ; "Edited 24-Sep-2023 14:29 by rmk") (* TBigham "30-Dec-86 11:59") (READPRESS FILENAME]) (SHOWTIME.READ.RES (LAMBDA (FILENAME) (* TBigham "30-Dec-86 12:03") (* load an RES image and makes it into a lisp bitmap) (DECLARE (GLOBALVARS WAITINGCURSOR)) (LET (BITMAP) (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) (SETQ BITMAP (READ.RES FILENAME))))) ) (SHOWTIME.RES.CHECK&MASSAGE (LAMBDA (BITMAP) (* TBigham " 1-Mar-87 19:31") (LET ((HEIGHT (fetch BITMAPHEIGHT of BITMAP)) (WIDTH (fetch BITMAPWIDTH of BITMAP)) BOUNDARY BM) (* if the bitmap doesn't fit on a 32 bit boundary, extend the bitmap to do so) (if (ZEROP (REMAINDER WIDTH 32)) then BITMAP else (SETQ BOUNDARY (for NUMBER from 32 by 32 thereis (if (ILEQ WIDTH NUMBER) then NUMBER))) (SETQ BM (BITMAPCREATE BOUNDARY HEIGHT)) (BITBLT BITMAP 0 0 BM) BM))) ) (SHOWTIME.RESHAPE.WINDOW (LAMBDA (BITMAP WINDOW) (* TBigham "10-Mar-86 15:51") (LET NIL (SHAPEW WINDOW (CREATEREGION (CAR (WINDOWPROP WINDOW (QUOTE REGION))) (CADR (WINDOWPROP WINDOW (QUOTE REGION))) (WIDTHIFWINDOW (BITMAPWIDTH BITMAP)) (HEIGHTIFWINDOW (BITMAPHEIGHT BITMAP) T))))) ) (SHOWTIME.SAVE.BITMAP (LAMBDA (FILENAME BITMAP FORMAT) (* ; "Edited 13-May-88 15:56 by raf") (DECLARE (GLOBALVARS SHOWTIME.DEFAULT.FORMAT PROMPTWINDOW SHOWTIME.FORMAT.FNS WAITINGCURSOR)) (OR FILENAME (SETQ FILENAME (SHOWTIME.GET.NAME NIL T))) (OR FORMAT (SETQ FORMAT SHOWTIME.DEFAULT.FORMAT)) (LET ((SAVEFN (CADDR (FASSOC FORMAT SHOWTIME.FORMAT.FNS)))) (if (NULL FILENAME) THEN (printout PROMPTWINDOW "Null filename.") ELSEIF (NOT (BITMAPP BITMAP)) THEN (printout PROMPTWINDOW BITMAP " not a bitmap.") ELSEIF (NULL SAVEFN) THEN (printout PROMPTWINDOW "Can't write bitmaps out in " FORMAT " format.") ELSE (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) (printout PROMPTWINDOW T "Saving " FILENAME "...") (EVAL (LIST SAVEFN (KWOTE FILENAME) (KWOTE BITMAP))) (printout PROMPTWINDOW "done!"))))) ) (SHOWTIME.SAVE.LISPBM (LAMBDA (FILENAME BITMAP) (* ; "Edited 13-May-88 15:59 by raf") (LET (STREAM) (if (AND FILENAME (SETQ STREAM (OPENSTREAM FILENAME (QUOTE OUTPUT)))) then (WRITEBM STREAM BITMAP) (CLOSEF STREAM)))) ) (SHOWTIME.SCALE.BITMAP (LAMBDA (BITMAP WINDOW) (* TBigham "31-Mar-86 15:42") (DECLARE (GLOBALVARS PROMPTWINDOW WAITINGCURSOR)) (LET (XSCALE YSCALE SCALE) (if (BITMAPP BITMAP) then (OR (SETQ XSCALE (RNUMBER "X SCALE FACTOR" NIL NIL NIL T T)) (SETQ XSCALE 1)) (OR (SETQ YSCALE (RNUMBER "Y SCALE FACTOR" NIL NIL NIL T T)) (SETQ YSCALE 1)) (SETQ SCALE (CONS (FLOAT XSCALE) (FLOAT YSCALE))) (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) (SETQ BITMAP (SCALEBITMAP BITMAP SCALE))) (WINDOWPROP WINDOW (QUOTE BITMAP) BITMAP) (SETTOPVAL (WINDOWPROP WINDOW (QUOTE BITMAP.NAME)) BITMAP) (CLEARW WINDOW) (BITBLT BITMAP 0 0 WINDOW) else (printout PROMPTWINDOW T (CONCAT BITMAP " not a bitmap."))))) ) (SHOWTIME.ADD.FORMAT (LAMBDA (FORMAT READFN WRITEFN) (* TBigham "30-Dec-86 13:11") (DECLARE (GLOBALVARS SHOWTIME.FORMAT.FNS SHOWTIME.LOAD.SUBITEMS SHOWTIME.MENU SHOWTIME.SAVE.SUBITEMS)) (* adds information to an assoc list which identifies read and write functions for different bitmap formats) (LET NIL (if FORMAT then (PUTASSOC FORMAT (LIST READFN WRITEFN) SHOWTIME.FORMAT.FNS)) (SETQ SHOWTIME.LOAD.SUBITEMS (for EACH in (CDR SHOWTIME.FORMAT.FNS) collect (LIST (CONCAT (CAR EACH) " Format") (KWOTE (MKATOM (CONCAT "LOAD." (CAR EACH))))))) (SETQ SHOWTIME.SAVE.SUBITEMS (for EACH in (CDR SHOWTIME.FORMAT.FNS) collect (LIST (CONCAT (CAR EACH) " Format") (KWOTE (MKATOM (CONCAT "SAVE." (CAR EACH))))))) (SETQ SHOWTIME.MENU))) ) (SHOWTIME.SETUP.WINDOWPROPS (LAMBDA (WINDOW BITMAP NAME) (* TBigham "27-Mar-86 10:41") (PROGN (WINDOWPROP WINDOW (QUOTE TITLE) (CONCAT "Viewer of " NAME)) (WINDOWPROP WINDOW (QUOTE BITMAP.NAME) NAME) (WINDOWPROP WINDOW (QUOTE BITMAP) BITMAP))) ) (SHOWTIME.SHOW.BITMAP (LAMBDA (BITMAP NAME WINDOW OPTION) (* TBigham " 7-Feb-87 18:43") (DECLARE (GLOBALVARS PROMPTWINDOW)) (LET NIL (if (BITMAPP BITMAP) then (OR NAME (SETQ NAME (WINDOWPROP WINDOW (QUOTE BITMAP.NAME)))) (if (EQ OPTION (QUOTE RESHAPE&SHOW)) then (SHOWTIME.RESHAPE.WINDOW BITMAP WINDOW)) (CLEARW WINDOW) (BITBLT BITMAP 0 0 WINDOW) (SHOWTIME.SETUP.WINDOWPROPS WINDOW BITMAP NAME) else (printout PROMPTWINDOW T BITMAP " not a bitmap")))) ) (SHOWTIME.WRITEBM (LAMBDA (BITMAP STREAM) (* TBigham " 1-Mar-87 18:19") (* "TBigham & Wall" " 7-Apr-86 10:19") (LET* ((BASE (fetch BITMAPBASE of BITMAP)) (HEIGHT (fetch BITMAPHEIGHT of BITMAP)) (WIDTH (fetch BITMAPWIDTH of BITMAP)) (RWIDTH (fetch BITMAPRASTERWIDTH of BITMAP)) BOUNDARY BM) (if (ZEROP (REMAINDER WIDTH 32)) then (for Y from 0 to (SUB1 HEIGHT) do (for X from 0 to (SUB1 RWIDTH) do (\BOUT STREAM (\GETBASEBYTE BASE 0)) (\BOUT STREAM (\GETBASEBYTE BASE 1)) (SETQ BASE (\ADDBASE BASE 1)))) else (SETQ BOUNDARY (for NUMBER from 32 by 32 thereis (if (ILEQ WIDTH NUMBER) then NUMBER))) (SETQ BM (BITMAPCREATE BOUNDARY HEIGHT)) (BITBLT BITMAP 0 0 BM) (SHOWTIME.WRITEBM BM STREAM)))) ) ) (RPAQQ SHOWTIME.ICON #*(80 84)@C@@@@@@@@@@@@@@@@@@@CO@@@@@@@@@@@@@@@@@@COO@@@@@@@@@@@@@@@@@CMOO@@@@@@@@@@@@@@@@GLAOO@@@@@@@@@@@@@@@GL@AOO@@@@@@@@@@@@@@GN@@OOO@@@@@@@@@@@@@GN@@OOOO@@@@@@@@@@@@ON@@GOMOO@@@@@@@@@@@ON@@GOLAOO@@@@@@@@@@OO@@GOL@AOO@@@@@@@@@OO@@GON@@OOO@@@@@@@AOO@@CON@@OOOO@@@@@@AOO@@CON@@GOMOO@@@@@AOOH@CON@@GOLAOO@@@@AOOH@COO@@GOL@AOO@@@AOOH@AOO@@GON@@OOO@@@AOO@AOO@@CON@@OOOO@@@AOOAOO@@CON@@OOMOO@@@AOOOOH@CON@@GOLAO@@@@AOOOH@COO@@GOL@C@@@@@AOOH@AOO@@GON@C@@@@@@AOO@AOO@@GON@G@@@@@@@AOOAOO@@CON@F@@@@@@@@AOOOOH@CON@F@@@@@@@@@AOOOH@COO@F@@@@@@@@@@AOOH@COO@N@@@@@@@@@@@AOO@AOO@L@@@@@@@@@@@@AOOAOO@L@@@@@@@@@@@@@AOOOOHL@@@@@@@@@@@@@@AOOOIL@@@@@@@@@@@@@@@AOOIH@@@@@@@@@@@@@@@@AOIH@@@@@@@@@@@@@@@@@AOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOHGALF@LGLD@DDOND@GHOGKKNMOFONMKFNGLNOGHOGOKNMOFNNOKNNCHNOOHOGOKNMOFFLOKNNKJNOOHOHGH@MOGFMOKNNIBN@OHOOKKNMOGFMOKNNMFNOOHOOKKNMOG@AOKNNLFNOOHOGKKNMOGKKOKNNNNNOGHOHGALF@OKKOALDGLD@GHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOH ) (RPAQQ SHOWTIME.MASK #*(80 84)@C@@@@@@@@@@@@@@@@@@@CO@@@@@@@@@@@@@@@@@@COO@@@@@@@@@@@@@@@@@COOO@@@@@@@@@@@@@@@@GOOOO@@@@@@@@@@@@@@@GOOOOO@@@@@@@@@@@@@@GOOOOOO@@@@@@@@@@@@@GOOOOOOO@@@@@@@@@@@@OOOOOOOOO@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@OOOOOOOOOOO@@@@@@@@@OOOOOOOOOOOO@@@@@@@AOOOOOOOOOOOOO@@@@@@AOOOOOOOOOOOOOO@@@@@AOOOOOOOOOOOOOOO@@@@AOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOO@@@@AOOOOOOOOOOOOOOO@@@@@AOOOOOOOOOOOOOO@@@@@@AOOOOOOOOOOOOO@@@@@@@AOOOOOOOOOOON@@@@@@@@AOOOOOOOOOON@@@@@@@@@AOOOOOOOOON@@@@@@@@@@AOOOOOOOON@@@@@@@@@@@AOOOOOOOL@@@@@@@@@@@@AOOOOOOL@@@@@@@@@@@@@AOOOOOL@@@@@@@@@@@@@@AOOOOL@@@@@@@@@@@@@@@AOOOH@@@@@@@@@@@@@@@@AOOH@@@@@@@@@@@@@@@@@AOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOH ) (RPAQQ SHOWTIME.LOAD.SUBITEMS NIL) (RPAQQ SHOWTIME.SAVE.SUBITEMS NIL) (RPAQQ SHOWTIME.MENU NIL) (RPAQQ SHOWTIMETITLEREGION (7 7 56 29)) (RPAQQ SHOWTIME.DEFAULT.FORMAT LISP) (RPAQQ BackgroundMenu NIL) (RPAQQ SHOWTIME.FORMAT.FNS (SHOWTIME.FORMAT.FNS (RES READ.RES SHOWTIME.MAKE.RES) (LISP SHOWTIME.READ.LISPBM SHOWTIME.SAVE.LISPBM) (DIF SHOWTIME.LOAD.DIF.FILE NIL) (BRUSH SHOWTIME.LOAD.BRUSH MAKEBRUSH) (PRESS READPRESS PRESSBITMAP))) (APPENDTOVAR BackgroundMenuCommands (Showtime '(SHOWTIME) "Opens a showtime window for use.")) (FILESLOAD BITMAPFNS SCALEBITMAP READBRUSH) (SHOWTIME.ADD.FORMAT) (PUTPROPS SHOWTIME COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2589 22191 (GET.SHOWTIME.MENU 2599 . 3394) (MAKEBRUSH 3396 . 3586) ( MAKEBRUSH.HEADER&BITMAP 3588 . 4326) (INFORES 4328 . 6301) (READ.RES 6303 . 7212) (SHOWTIME 7214 . 8234) (SHOWTIME.BUTTONEVENTFN 8236 . 9829) (SHOWTIME.GET.NAME 9831 . 10590) (SHOWTIME.ICONFN 10592 . 10930) (SHOWTIME.LOAD.BITMAP 10932 . 12115) (SHOWTIME.LOAD.BRUSH 12117 . 12215) ( SHOWTIME.LOAD.DIF.FILE 12217 . 13288) (SHOWTIME.LOAD.RES.FILE 13290 . 13555) (SHOWTIME.MAKE.RES 13557 . 13934) (SHOWTIME.MAKE.RES.HEADER 13936 . 16436) (SHOWTIME.MAKE.RES.TAIL 16438 . 16737) ( SHOWTIME.READ.BRUSH 16739 . 16845) (SHOWTIME.READ.LISPBM 16847 . 17064) (SHOWTIME.READ.PRESS 17066 . 17320) (SHOWTIME.READ.RES 17322 . 17582) (SHOWTIME.RES.CHECK&MASSAGE 17584 . 18048) ( SHOWTIME.RESHAPE.WINDOW 18050 . 18337) (SHOWTIME.SAVE.BITMAP 18339 . 19134) (SHOWTIME.SAVE.LISPBM 19136 . 19359) (SHOWTIME.SCALE.BITMAP 19361 . 20050) (SHOWTIME.ADD.FORMAT 20052 . 20781) ( SHOWTIME.SETUP.WINDOWPROPS 20783 . 21032) (SHOWTIME.SHOW.BITMAP 21034 . 21491) (SHOWTIME.WRITEBM 21493 . 22189))))) STOP