(FILECREATED " 4-Aug-88 10:36:50" {DSK}<LISPFILES>TRILLIUM>EDEN>GALAHAD>ITEMTYPES>SHOWTIME.;1 35465
changes to: (FNS SHOWTIME.MAKE.RES MAKEBRUSH)
previous date: "28-Jul-88 09:45:09" {PAWNEE1:HENR801C:XEROX}<LISPUSERS>KOTO>SHOWTIME.;3)
(* Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SHOWTIMECOMS)
(RPAQQ SHOWTIMECOMS ((FILES BITMAPFNS SCALEBITMAP READBRUSH)
(* * General *)
(FNS SHOWTIME GET.SHOWTIME.MENU SHOWTIME.ADD.FORMAT SHOWTIME.BUTTONEVENTFN
SHOWTIME.GET.NAME SHOWTIME.ICONFN SHOWTIME.LOAD.FILE
SHOWTIME.RESHAPE.WINDOW SHOWTIME.SETUP.WINDOWPROPS)
(* * RES *)
(FNS INFORES READ.RES SHOWTIME.LOAD.RES.FILE SHOWTIME.MAKE.RES
SHOWTIME.MAKE.RES.HEADER SHOWTIME.MAKE.RES.TAIL SHOWTIME.READ.RES
SHOWTIME.RES.CHECK&MASSAGE)
(* * Bitmap *)
(FNS SHOWTIME.LOAD.BITMAP SHOWTIME.READ.LISPBM SHOWTIME.SAVE.BITMAP
SHOWTIME.SAVE.LISPBM SHOWTIME.SCALE.BITMAP SHOWTIME.SHOW.BITMAP
SHOWTIME.WRITEBM)
(* * Brush and Press *)
(FNS MAKEBRUSH MAKEBRUSH.HEADER&BITMAP SHOWTIME.LOAD.BRUSH SHOWTIME.READ.BRUSH
SHOWTIME.READ.PRESS)
(* * DIF *)
(FNS SHOWTIME.LOAD.DIF.FILE)
(VARS (SHOWTIME.LOAD.SUBITEMS)
(SHOWTIME.SAVE.SUBITEMS)
(SHOWTIME.MENU)
(SHOWTIMETITLEREGION (QUOTE (7 7 56 29)))
(SHOWTIME.DEFAULT.FORMAT (QUOTE LISP))
(BackgroundMenu)
(BRUSHDIRECTORY)
[SHOWTIME.FORMAT.FNS (QUOTE (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]
SHOWTIME.ICON SHOWTIME.MASK)
(APPENDVARS (BackgroundMenuCommands (Showtime (QUOTE (SHOWTIME))
"Opens a ShowTime window for use.")))
(P (SHOWTIME.ADD.FORMAT))))
(FILESLOAD BITMAPFNS SCALEBITMAP READBRUSH)
(* * General *)
(DEFINEQ
(SHOWTIME
[LAMBDA (FILENAME FORMAT) (* TBigham " 7-Feb-87 18:05")
(LET (BITMAP WIDTH HEIGHT WINDOW BITMAP.NAME)
(COND
[FILENAME (SETQ FILENAME (\ADD.CONNECTED.DIR FILENAME))
(COND
((BITMAPP (SETQ BITMAP (SHOWTIME.LOAD.BITMAP FILENAME FORMAT)))
(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))
(T (PROMPTPRINT (CONCAT "Couldn't find " FILENAME]
(T (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])
(GET.SHOWTIME.MENU
[LAMBDA NIL (* TBigham "30-Dec-86 12:48")
(DECLARE (GLOBALVARS SHOWTIME.MENU))
(OR SHOWTIME.MENU (SETQ SHOWTIME.MENU (create MENU
TITLE ← "Viewer Options"
CENTERFLG ← T
MENUFONT ←(FONTCREATE (QUOTE TIMESROMAN)
12)
ITEMS ←(QUOTE
((" Load Another Picture " (QUOTE
LOAD)
NIL
(EVAL
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
(EVAL
SHOWTIME.SAVE.SUBITEMS])
(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
(COND
(FORMAT (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.BUTTONEVENTFN
[LAMBDA (WINDOW) (* TBigham "11-Feb-87 20:35")
(DECLARE (GLOBALVARS PROMPTWINDOW))
(LET (BITMAP SELECTION BITMAP.NAME ICON PERIOD.POS SWITCH)
(SETQ SELECTION (MENU (GET.SHOWTIME.MENU)))
(COND
[(SETQ PERIOD.POS (STRPOS "." SELECTION))
(SETQ SWITCH (MKATOM (SUBSTRING SELECTION 1 (SUB1 PERIOD.POS]
(T (SETQ SWITCH SELECTION)))
(SELECTQ SWITCH
(LOAD (SHOWTIME.LOAD.FILE NIL (MKATOM (SUBSTRING SELECTION 6))
WINDOW))
[SHOW (SETQ BITMAP.NAME (SHOWTIME.GET.NAME "Bitmap Name (CR to end)"))
(COND
(BITMAP.NAME (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 (COND
([BITMAPP (SETQ BITMAP (WINDOWPROP WINDOW (QUOTE BITMAP]
(SHOWTIME.SAVE.BITMAP BITMAP (MKATOM (SUBSTRING SELECTION 6]
(SCALE (SHOWTIME.SCALE.BITMAP (WINDOWPROP WINDOW (QUOTE BITMAP))
WINDOW))
NIL)
(COND
((SETQ ICON (WINDOWPROP WINDOW (QUOTE ICONWINDOW)))
(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)))
(COND
[USE.EOL (RESETLST (RESETSAVE (OPENW PROMPTW)
(BQUOTE (CLOSEW , PROMPTW)))
(MKATOM (PROMPTFORWORD PROMPTSTRING NIL NIL PROMPTW NIL NIL
(CHARCODE EOL]
(T (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.FILE
[LAMBDA (FILENAME FORMAT WINDOW) (* GaryG "27-Jul-88 13:02")
(* TBigham "30-Dec-86 12:29")
(DECLARE (GLOBALVARS SHOWTIME.DEFAULT.FORMAT))
(LET (BITMAP)
(COND
([OR (INFILEP FILENAME)
(INFILEP (SETQ FILENAME (SHOWTIME.GET.NAME NIL T]
(OR FORMAT (SETQ FORMAT SHOWTIME.DEFAULT.FORMAT))
(SETQ BITMAP (SHOWTIME.LOAD.BITMAP FILENAME FORMAT WINDOW)))
(T (PROMPTPRINT (CONCAT "Couldn't find " FILENAME])
(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.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])
)
(* * RES *)
(DEFINEQ
(INFORES
[LAMBDA (FILE) (* TBigham " 1-Mar-87 17:34")
(* Wall " 2-Sep-86 12:14")
(* fixed by TBigham & Wall)
(* originally written by Gocek)
(LET (STREAM WIDTH HEIGHT HI.X LO.X HI.Y LO.Y REAL.X REAL.Y (Header (QUOTE
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 (GETSTREAM (OPENFILE FILE (QUOTE INPUT))
(QUOTE INPUT)))
(if [EQ Header (PACK (for X from 1 to 40 collect (CHARACTER (\BIN STREAM]
then (* bypass BEGIN 254/720000 DUP 2 MAKEVEC)
(from 1 to 18 do (\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) (* TBigham " 1-Mar-87 18:29")
(* Gocek 1985)
(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 FILE)
BITMAP
else (printout PROMPTWINDOW T FILE "isn't an RES file"))
else (printout PROMPTWINDOW T "Can't find " FILE)
NIL])
(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) (* GaryG " 4-Aug-88 10:36")
(* TBigham " 1-Mar-87 18:24")
(AND (OR (ATOM FILENAME)
(STRINGP FILENAME))
(BITMAPP BITMAP)
(LET (STREAM)
(RESETLST (SETQ STREAM (OPENSTREAM FILENAME (QUOTE OUTPUT)))
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
STREAM))
(PROGN (SETQ BITMAP (SHOWTIME.RES.CHECK&MASSAGE BITMAP))
(SHOWTIME.MAKE.RES.HEADER STREAM BITMAP)
(SHOWTIME.WRITEBM BITMAP STREAM)
(SHOWTIME.MAKE.RES.TAIL STREAM)))
(SETFILEINFO FILENAME (QUOTE TYPE)
4428])
(SHOWTIME.MAKE.RES.HEADER
[LAMBDA (STREAM BITMAP) (* GaryG " 1-May-88 10:39")
(* edited: " 1-Mar-87 16:03")
(* TBigham "13-Feb-87 05:20")
(* "TBigham & Wall" " 7-Apr-86 10:14")
(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 (COND
((ILEQ WIDTH NUMBER)
NUMBER)
(T 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))
(* * For some reason, the next number isn't biased by 4000 (GaryG) *)
(\BOUT STREAM (RSH (LOGAND 65535 WIDTH)
8))
(\BOUT STREAM (LOGAND 255 WIDTH])
(SHOWTIME.MAKE.RES.TAIL
[LAMBDA (STREAM) (* GaryG " 1-May-88 10:40")
(* TBigham " 4-Apr-86 06:38")
(* * This didn't result in a VP readable file, so I fixed it (GaryG) *)
(LET [(DATA (QUOTE (161 194 15 160 15 161 15 160 15 163 161 27 197 5 88 101 114 111 120 197 10
71 114 97 121 76 105 110 101 97 114 15 164 161 27 66 190 160 103]
(for BYTE in DATA do (BOUT STREAM BYTE])
(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)
(COND
((ZEROP (REMAINDER WIDTH 32))
BITMAP)
(T [SETQ BOUNDARY (for NUMBER from 32 by 32 thereis (COND
((ILEQ WIDTH NUMBER)
NUMBER]
(SETQ BM (BITMAPCREATE BOUNDARY HEIGHT))
(BITBLT BITMAP 0 0 BM)
BM])
)
(* * Bitmap *)
(DEFINEQ
(SHOWTIME.LOAD.BITMAP
[LAMBDA (FILENAME FORMAT WINDOW) (* TBigham " 7-Feb-87 18:38")
(DECLARE (GLOBALVARS PROMPTWINDOW SHOWTIME.FORMAT.FNS WAITINGCURSOR))
(LET (NAME ICON BITMAP OPTION)
[SETQ NAME (U-CASE (FILENAMEFIELD FILENAME (QUOTE NAME]
(printout PROMPTWINDOW T "Loading " FILENAME "...")
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(COND
[(INFILEP FILENAME)
(COND
([BITMAPP (SETQ BITMAP (EVAL (LIST (CADR (FASSOC FORMAT
SHOWTIME.FORMAT.FNS))
(KWOTE FILENAME]
(SHOWTIME.SHOW.BITMAP BITMAP NAME WINDOW OPTION)
(SETTOPVAL (U-CASE (FILENAMEFIELD FILENAME (QUOTE NAME)))
BITMAP)
[COND
((WINDOWP WINDOW)
(WINDOWPROP WINDOW (QUOTE BITMAP.NAME)
NAME)
(COND
((SETQ ICON (WINDOWPROP WINDOW (QUOTE ICONWINDOW)))
(ICONW.TITLE ICON NAME]
(printout PROMPTWINDOW "done!"))
(T (printout PROMPTWINDOW T "Problem loading " FORMAT " Format " FILENAME]
(T (printout PROMPTWINDOW T "Couldn't find " FILENAME])
(SHOWTIME.READ.LISPBM
[LAMBDA (FILENAME) (* TBigham "30-Dec-86 12:05")
(READBM (OPENFILE FILENAME (QUOTE INPUT])
(SHOWTIME.SAVE.BITMAP
[LAMBDA (BITMAP FORMAT) (* TBigham "11-Feb-87 20:36")
(DECLARE (GLOBALVARS PROMPTWINDOW SHOWTIME.FORMAT.FNS WAITINGCURSOR))
(LET (FILENAME)
(SETQ FILENAME (SHOWTIME.GET.NAME NIL T))
(COND
((AND FILENAME (BITMAPP BITMAP))
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(printout PROMPTWINDOW T "Saving " FILENAME "...")
(EVAL (LIST (CADDR (FASSOC FORMAT SHOWTIME.FORMAT.FNS))
(KWOTE FILENAME)
(KWOTE BITMAP)))
(printout PROMPTWINDOW "done!"])
(SHOWTIME.SAVE.LISPBM
[LAMBDA (FILENAME BITMAP) (* GaryG "27-Jul-88 13:11")
(* TBigham "30-Dec-86 13:09")
(AND (OR (ATOM FILENAME)
(STRINGP FILENAME))
(BITMAPP BITMAP)
(LET (FILESTREAM)
(RESETLST (SETQ FILESTREAM (OPENSTREAM FILENAME (QUOTE OUTPUT)))
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
FILESTREAM))
(WRITEBM FILESTREAM BITMAP])
(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.SHOW.BITMAP
[LAMBDA (BITMAP NAME WINDOW OPTION) (* TBigham " 7-Feb-87 18:43")
(DECLARE (GLOBALVARS PROMPTWINDOW))
(LET NIL
(COND
((BITMAPP BITMAP)
[OR NAME (SETQ NAME (WINDOWPROP WINDOW (QUOTE BITMAP.NAME]
(COND
((EQ OPTION (QUOTE RESHAPE&SHOW))
(SHOWTIME.RESHAPE.WINDOW BITMAP WINDOW)))
(CLEARW WINDOW)
(BITBLT BITMAP 0 0 WINDOW)
(SHOWTIME.SETUP.WINDOWPROPS WINDOW BITMAP NAME))
(T (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)
(COND
[(ZEROP (REMAINDER WIDTH 32))
(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]
(T [SETQ BOUNDARY (for NUMBER from 32 by 32 thereis (COND
((ILEQ WIDTH NUMBER)
NUMBER]
(SETQ BM (BITMAPCREATE BOUNDARY HEIGHT))
(BITBLT BITMAP 0 0 BM)
(SHOWTIME.WRITEBM BM STREAM])
)
(* * Brush and Press *)
(DEFINEQ
(MAKEBRUSH
[LAMBDA (FILESPEC BITMAP) (* GaryG " 4-Aug-88 10:36")
(* TBigham " 7-Feb-87 18:01")
(* Mitch Garnaat wrote this fn)
(AND (OR (ATOM FILESPEC)
(STRINGP FILESPEC))
(BITMAPP BITMAP)
(LET (FILESTREAM)
(RESETLST (SETQ FILESTREAM (OPENSTREAM FILESPEC (QUOTE OUTPUT)))
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
FILESTREAM))
(MAKEBRUSH.HEADER&BITMAP BITMAP FILESTREAM))
(SETFILEINFO FILESPEC (QUOTE TYPE)
8888])
(MAKEBRUSH.HEADER&BITMAP
[LAMBDA (BITMAP STREAM) (* TBigham "17-Mar-86 17:25")
(* Mitch Garnaat wrote this fn)
(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])
(SHOWTIME.LOAD.BRUSH
[LAMBDA (FILE) (* TBigham "11-Feb-87 20:26")
(CAR (READBRUSHFILE FILE])
(SHOWTIME.READ.BRUSH
[LAMBDA (FILENAME) (* TBigham "30-Dec-86 12:00")
(CAR (READBRUSHFILE FILENAME])
(SHOWTIME.READ.PRESS
[LAMBDA (FILENAME) (* TBigham "30-Dec-86 11:59")
(READPRESS (OPENFILE FILENAME (QUOTE INPUT])
)
(* * DIF *)
(DEFINEQ
(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])
)
(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 BRUSHDIRECTORY 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)))
(RPAQ SHOWTIME.ICON (READBITMAP))
(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"
"@@@@@@@@@@@@@@@@@AOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OHGALF@LGLD@DDOND@GH"
"OGKKNMOFONMKFNGLNOGH"
"OGOKNMOFNNOKNNCHNOOH"
"OGOKNMOFFLOKNNKJNOOH"
"OHGH@MOGFMOKNNIBN@OH"
"OOKKNMOGFMOKNNMFNOOH"
"OOKKNMOG@AOKNNLFNOOH"
"OGKKNMOGKKOKNNNNNOGH"
"OHGALF@OKKOALDGLD@GH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"L@@@@@@@@@@@@@@@@@AH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH")
(RPAQ SHOWTIME.MASK (READBITMAP))
(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"
"@@@@@@@@@@@@@@@@@AOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOH")
(APPENDTOVAR BackgroundMenuCommands (Showtime (QUOTE (SHOWTIME))
"Opens a ShowTime window for use."))
(SHOWTIME.ADD.FORMAT)
(PUTPROPS SHOWTIME COPYRIGHT ("Xerox Corporation" 1986 1987 1988))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2202 10989 (SHOWTIME 2212 . 3607) (GET.SHOWTIME.MENU 3609 . 4802) (SHOWTIME.ADD.FORMAT
4804 . 5883) (SHOWTIME.BUTTONEVENTFN 5885 . 8094) (SHOWTIME.GET.NAME 8096 . 9139) (SHOWTIME.ICONFN
9141 . 9605) (SHOWTIME.LOAD.FILE 9607 . 10219) (SHOWTIME.RESHAPE.WINDOW 10221 . 10637) (
SHOWTIME.SETUP.WINDOWPROPS 10639 . 10987)) (11008 21364 (INFORES 11018 . 12534) (READ.RES 12536 .
14071) (SHOWTIME.LOAD.RES.FILE 14073 . 14496) (SHOWTIME.MAKE.RES 14498 . 15272) (
SHOWTIME.MAKE.RES.HEADER 15274 . 19680) (SHOWTIME.MAKE.RES.TAIL 19682 . 20231) (SHOWTIME.READ.RES
20233 . 20651) (SHOWTIME.RES.CHECK&MASSAGE 20653 . 21362)) (21386 26660 (SHOWTIME.LOAD.BITMAP 21396 .
22652) (SHOWTIME.READ.LISPBM 22654 . 22832) (SHOWTIME.SAVE.BITMAP 22834 . 23464) (SHOWTIME.SAVE.LISPBM
23466 . 24003) (SHOWTIME.SCALE.BITMAP 24005 . 24955) (SHOWTIME.SHOW.BITMAP 24957 . 25558) (
SHOWTIME.WRITEBM 25560 . 26658)) (26691 29111 (MAKEBRUSH 26701 . 27409) (MAKEBRUSH.HEADER&BITMAP 27411
. 28603) (SHOWTIME.LOAD.BRUSH 28605 . 28763) (SHOWTIME.READ.BRUSH 28765 . 28927) (SHOWTIME.READ.PRESS
28929 . 29109)) (29130 30759 (SHOWTIME.LOAD.DIF.FILE 29140 . 30757)))))
STOP