(FILECREATED " 8-Jun-87 18:30:59" {QV}<NOTECARDS>1.3K>NEXT>KOTOTEDITPATCHES.;7 10964
changes to: (FNS BMOBJ.BUTTONEVENTINFN)
(VARS KOTOTEDITPATCHESCOMS)
previous date: "23-Apr-87 19:48:01" {QV}<NOTECARDS>1.3K>NEXT>KOTOTEDITPATCHES.;5)
(* Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT KOTOTEDITPATCHESCOMS)
(RPAQQ KOTOTEDITPATCHESCOMS ((FNS \TEDIT.FOREIGN.COPY? TEDIT.GETINPUT BMOBJ.GETFN3 BMOBJ.DISPLAYFN
BMOBJ.BUTTONEVENTINFN)
(ADVISE (PROCESS.APPLY IN \TEDIT.BUTTONEVENTFN))))
(DEFINEQ
(\TEDIT.FOREIGN.COPY?
(LAMBDA (SEL) (* rht: "15-Dec-86 19:03")
(* IF the current process's window isn't a TEdit window, do a "Copy" by BKSYSBUFing the selected text.
Then turn off all the various indicators.)
(* * rht&rg 12/15/86: Now checks that SEL's CH# is reasonable before calling \SETUPGETCH.)
(PROG (PROCW (SOURCE.TEXTOBJ (fetch \TEXTOBJ of SEL))
CH STREAM DEST.TEDIT? DEST.TEXTOBJ)
(SETQ DEST.TEDIT? (AND (SETQ PROCW (PROCESSPROP (TTY.PROCESS)
(QUOTE WINDOW)))
(SETQ DEST.TEXTOBJ (WINDOWPROP PROCW (QUOTE TEXTOBJ)))
(NOT (TEXTPROP DEST.TEXTOBJ (QUOTE COPYBYBKSYSBUF)))))
(* Treat the destination specially if (1) the recipient process has a window, and (2) it's a TEdit window, and
(3) the TEdit isn't declining special treatment by having COPYBYBKSYSBUF set in its props.)
(COND
((OR (NOT DEST.TEDIT?)
(AND PROCW DEST.TEXTOBJ (NEQ SOURCE.TEXTOBJ DEST.TEXTOBJ)
(fetch EDITOPACTIVE of DEST.TEXTOBJ)))
(* OK -- receiver isn't TEdit.
Do it the hard way.)
(if (LESSP (fetch CH# of SEL)
(fetch CHLIM of SEL))
then
(* * Only do this if mouse is not off the end of text.)
(\SETUPGETCH (fetch CH# of SEL)
SOURCE.TEXTOBJ) (* Go to the first character to be copied)
(SETQ STREAM (fetch STREAMHINT of SOURCE.TEXTOBJ))
(for I from 1 to (fetch DCH of SEL)
do (* Run thru the selected text, copying only those
items that really ARE characters--IMAGEOBJs don't get
copied by this route.)
(COND
((FIXP (SETQ CH (\BIN STREAM)))
(BKSYSBUF (CHARACTER CH)))
(T (COPYINSERT CH))))
(\SHOWSEL SEL NIL NIL) (* Then reset the copy-pending flags.)
(SETQ TEDIT.COPY.PENDING NIL)))))))
(TEDIT.GETINPUT
[LAMBDA (STREAM PROMPTSTRING DEFAULTSTRING DELIMITER.LIST)
(* Randy.Gobbel "22-Apr-87 15:22")
(* Ask for input (file names, &c) for TEdit, perhaps
with a default.)
(* * RG 4/22/87 fixed ambiguous PROMPTWINDOW record field reference)
(PROG [(TEXTOBJ (TEXTOBJ STREAM))
(TPROMPT (OR (fetch (TEXTOBJ PROMPTWINDOW) of (TEXTOBJ STREAM))
(GETPROMPTWINDOW (\TEDIT.MAINW STREAM)
NIL NIL T]
(COND
(TPROMPT (* If it's our own promptwindow, just clear it.)
(CLEARW TPROMPT))
(T (* If it's the system's window, just move to a new
line.)
(FRESHLINE PROMPTWINDOW)))
(RETURN (PROG1 (PROMPTFORWORD PROMPTSTRING DEFAULTSTRING NIL (OR TPROMPT
PROMPTWINDOW)
NIL
(QUOTE TTY)
(OR DELIMITER.LIST (CHARCODE (EOL LF TAB ESCAPE)))
NIL) (* Get what the guy wants to tell us)
(WINDOWPROP (OR TPROMPT PROMPTWINDOW)
(QUOTE PROCESS)
NIL) (* Now detach the prompt window from its process, to
avoid a circularity.)
])
(BMOBJ.GETFN3
[LAMBDA (STREAM) (* rht: " 9-May-87 21:18")
(* ;;;
"reads a bitmap image object from a file. This version stores the binary data rather than the character representation used by READBITMAP."
)
(COND
((IEQP (\PEEKBIN STREAM)
(CHARCODE CR)) (* ;
"This is an old-format sketch with bitmap included. Skip the interfering CR.")
(BIN STREAM)))
(PROG [(SCALE (FPLUS (PLUS (LSH (BIN STREAM)
8)
(BIN STREAM))
(FQUOTIENT (PLUS (LSH (BIN STREAM)
8)
(BIN STREAM))
32768)))
(ROT (PLUS (LSH (BIN STREAM)
8)
(BIN STREAM]
(RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
SCALE ROT])
(BMOBJ.DISPLAYFN
[LAMBDA (IMAGEOBJ IMAGE.STREAM) (* ; "Edited 17-Apr-87 15:02 by jds")
(* ;
"function which displays a scaled bitmap on only an interpress stream for now")
(PROG ([FACTOR (fetch (BITMAPOBJ BMOBJSCALEFACTOR) of (IMAGEOBJPROP IMAGEOBJ
(QUOTE OBJECTDATUM]
[BITMAP (fetch (BITMAPOBJ BITMAP) of (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM]
(CACHE (IMAGEOBJPROP IMAGEOBJ (QUOTE CACHED.BITMAP)))
SHRUNK.BITMAP) (* ; "(IMAGESTREAMTYPE IMAGE.STREAM)")
(SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM)
(INTERPRESS (* ;
"Printing to an Interpress stream, so use the specialized method.")
(SHOWBITMAP.IP IMAGE.STREAM BITMAP NIL FACTOR 0))
(PROGN (* ;
"This is the default case, press display and everyone else prints the junky shrunk bitmap")
(COND
((NOT (SETQ SHRUNK.BITMAP CACHE))
[COND
[(LEQ FACTOR 1.0) (* ;
"We're shrinking the bitmap. Create a shrunk image for display")
(SETQ SHRUNK.BITMAP (SHRINKBITMAP BITMAP
(FQUOTIENT 1.0 FACTOR)
(FQUOTIENT 1.0 FACTOR]
(T (* ; "We're expanding it. Create a bigger one.")
(SETQ SHRUNK.BITMAP (EXPANDBITMAP BITMAP FACTOR FACTOR]
(IMAGEOBJPROP IMAGEOBJ (QUOTE CACHED.BITMAP)
SHRUNK.BITMAP)))
(BITBLT SHRUNK.BITMAP NIL NIL IMAGE.STREAM (DSPXPOSITION NIL
IMAGE.STREAM)
(DSPYPOSITION NIL IMAGE.STREAM)
(FIXR (FTIMES FACTOR (BITMAPWIDTH BITMAP)))
(FIXR (FTIMES FACTOR (BITMAPHEIGHT BITMAP])
(BMOBJ.BUTTONEVENTINFN
[LAMBDA (IMAGEOBJ WINDOW SELECTION X Y SELWINDOW TEXTSTREAM BUTTON OPERATION)
(* Randy.Gobbel " 8-Jun-87 18:30")
(* ;;;
"the user has pressed a button inside the bitmap object IMAGEOBJ. Bring up a menu of bitmap edit operations.")
(* * rht&pmi 5/8/87: Removed TEdit dependent stuff used in the CHANGE.SCALE option; replaced with PROMPTFORWORD)
(PROG* ((OBJ (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM)))
(OLDSCALE (fetch (BITMAPOBJ BMOBJSCALEFACTOR) of OBJ))
NEW.BITMAP COMMAND.MENU COMMAND PREVIOUS.BITMAP NAME TEMP X Y PROMPT.WINDOW)
(COND
([OR (EQ BUTTON (QUOTE RIGHT))
(AND OPERATION (NEQ OPERATION (QUOTE NORMAL]
(* ;
" If he's extending a selection, or is selecting for move/copy/delete, DON'T bring up the bitmap editing menu!")
(RETURN)))
(SETQ PREVIOUS.BITMAP (BITMAPCOPY (fetch (BITMAPOBJ BITMAP) of OBJ)))
(SETQ NEW.BITMAP (SELECTQ [MENU (COND
((type? MENU BITMAP.OBJ.MENU)
BITMAP.OBJ.MENU)
(T (SETQ BITMAP.OBJ.MENU (BMOBJ.CREATE.MENU]
(CHANGE.SCALE (* ; "Change the scale on the bitmap.")
[CLEARW (SETQ PROMPT.WINDOW
(GETPROMPTWINDOW
(OR (WINDOWP WINDOW)
(WFROMDS WINDOW]
(replace (BITMAPOBJ BMOBJSCALEFACTOR)
of OBJ
with (OR (NUMBERP
(MKATOM (PROMPTFORWORD
"Scale Factor: "
OLDSCALE NIL
PROMPT.WINDOW)))
OLDSCALE))
(* ;
"Return the prevous bitmap, so we don't change the bits.")
PREVIOUS.BITMAP)
(HAND.EDIT (EDITBM PREVIOUS.BITMAP))
(TRIM (TRIM.BITMAP PREVIOUS.BITMAP))
(INVERT.HORIZONTALLY (INVERT.BITMAP.HORIZONTALLY
PREVIOUS.BITMAP))
(INVERT.VERTICALLY (INVERT.BITMAP.VERTICALLY
PREVIOUS.BITMAP))
(INVERT.DIAGONALLY (INVERT.BITMAP.DIAGONALLY
PREVIOUS.BITMAP))
(ROTATE.BITMAP.LEFT (ROTATE.BITMAP.LEFT PREVIOUS.BITMAP))
(ROTATE.BITMAP.RIGHT (ROTATE.BITMAP.RIGHT
PREVIOUS.BITMAP))
(SHIFT.LEFT (INTERACT&SHIFT.BITMAP.LEFT PREVIOUS.BITMAP))
(SHIFT.RIGHT (INTERACT&SHIFT.BITMAP.RIGHT PREVIOUS.BITMAP))
(SHIFT.DOWN (INTERACT&SHIFT.BITMAP.DOWN PREVIOUS.BITMAP))
(SHIFT.UP (INTERACT&SHIFT.BITMAP.UP PREVIOUS.BITMAP))
(INTERCHANGE.BLACK/WHITE (INVERT.BITMAP.B/W
PREVIOUS.BITMAP))
(ADD.BORDER (INTERACT&ADD.BORDER.TO.BITMAP PREVIOUS.BITMAP)
)
(RETURN NIL)))
(replace (BITMAPOBJ BITMAP) of OBJ with NEW.BITMAP)
(IMAGEOBJPROP IMAGEOBJ (QUOTE CACHED.BITMAP)
NIL) (* ;
"And clear any cached shrunk bitmaps so the display looks reasonable.")
(RETURN (QUOTE CHANGED])
)
(PUTPROPS PROCESS.APPLY-IN-\TEDIT.BUTTONEVENTFN READVICE [(\TEDIT.BUTTONEVENTFN . PROCESS.APPLY)
(AROUND NIL (ADD.PROCESS
(LIST USERFN (KWOTE W])
(READVISE PROCESS.APPLY-IN-\TEDIT.BUTTONEVENTFN)
(PUTPROPS KOTOTEDITPATCHES COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (579 10642 (\TEDIT.FOREIGN.COPY? 589 . 2832) (TEDIT.GETINPUT 2834 . 4292) (BMOBJ.GETFN3
4294 . 5262) (BMOBJ.DISPLAYFN 5264 . 7240) (BMOBJ.BUTTONEVENTINFN 7242 . 10640)))))
STOP