(FILECREATED " 2-Oct-85 10:56:48" {PHYLUM}<PAPERWORKS>SKETCHEDIT.;78 71925 changes to: (FNS WB.ADD.NEW.POINT) previous date: "12-Sep-85 14:40:49" {PHYLUM}<PAPERWORKS>SKETCHEDIT.;77) (* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.) (PRETTYCOMPRINT SKETCHEDITCOMS) (RPAQQ SKETCHEDITCOMS ((COMS (* selection functions) (FNS BUTLAST CHAR.BEGIN CLOSEST.CHAR CLOSEST.LINE FLASHW HILITE.LINE HILITE.TEXT IN.TEXT.EXTEND INIMAGEOBJ INTEXT NEW.TEXT.EXTEND NEW.TEXT.SELECTIONP NTHCHARWIDTH NTHLOCALREGION ONCHAR SHOW.EXTENDED.SELECTION.FEEDBACK SHOW.FEEDBACK SHOW.FEEDBACK.BOX SELECTION.POSITION SKED.CLEAR.SELECTION SKED.REMOVE.OTHER.SELECTIONS SKED.EXTEND.SELECTION SKED.MOVE.SELECTION CREATE.TEXT.SELECTION SKED.SELECTION.FEEDBACK SKED.SET.EXTENDSELECTION SKED.SET.SELECTION LINE.BEGIN SELECTION.GREATERP) (DECLARE: DONTCOPY (RECORDS TEXTELTSELECTION)) (UGLYVARS IN.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.SHADE SELECTION.HIGHLIGHT.SHADE) (GLOBALVARS IN.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.SHADE SELECTION.HIGHLIGHT.SHADE)) (COMS (* editting functions) (FNS WB.EDITOR SK.TTYENTRYFN SK.TTYEXITFN SKED.INSERT SKED.CREATE.NEW.TEXTBOX SKED.CHARACTERPOSITION SKED.LINE.AND.CHAR# \SKED.DELETE.WORD.FROM.STRING \SKED.INSERT.CHARS.TO.STR JOINCHARS STRINGFROMCHARACTERS GETALLCHARS CLEANUP.EDIT SKED.NEW.TEXTELT)) (COMS (* line adding functions) (FNS MAP.SCREEN.POSITION.ONTO.GRID NEAREST.ON.GRID SK.MIDDLE.TITLEFN WB.BUTTON.HANDLER WB.ADD.NEW.POINT WB.DRAWLINE WB.RUBBERBAND.POSITION RESET.LINE.BEING.INPUT) (FNS NEAREST.EXISTING.POSITION WB.NEARPT LASTMOUSEPOSITION)))) (* selection functions) (DEFINEQ (BUTLAST [LAMBDA (LST) (* rrb "17-JUL-83 13:58") (* returns a list that has everything but the last element of the list.) (COND ((OR (NULL LST) (NULL (CDR LST))) NIL) (T (CONS (CAR LST) (BUTLAST (CDR LST]) (CHAR.BEGIN [LAMBDA (CHAR# LINE# TEXTELT STRM) (* rrb "14-Jan-85 15:40") (* determines the x position of the first bit of character CHAR# in LINE# of TEXTELT.) (PROG ((LTEXT (fetch (SCREENELT LOCALPART) of TEXTELT)) TEXT XPOS LFONT LREGION) (SETQ TEXT (CAR (NTH (fetch (LOCALTEXT LOCALLISTOFCHARACTERS) of LTEXT) LINE#))) [SETQ XPOS (fetch (REGION LEFT) of (SETQ LREGION (CAR (NTH (fetch (LOCALTEXT LINEREGIONS) of LTEXT) LINE#] (COND ((EQ CHAR# 0) (* before the first character.) (RETURN XPOS))) (SETQ LFONT (fetch (LOCALTEXT LOCALFONT) of LTEXT)) (RETURN (IPLUS XPOS (COND ((IMAGESTREAMTYPEP STRM (QUOTE HARDCOPY)) (* hardcopy streams must pass the stream so correction in widths is accounted for.) (DSPFONT LFONT STRM) (STRINGWIDTH (SUBSTRING TEXT 1 CHAR#) STRM)) ((FONTP LFONT) (for I from 1 to CHAR# sum (CHARWIDTH (CHCON1 (NTHCHAR TEXT I)) LFONT))) (T (* if it is printed in shade, put cursor a percentage of the way across the area.) (IQUOTIENT (ITIMES CHAR# (fetch (REGION WIDTH) of LREGION)) (NCHARS TEXT]) (CLOSEST.CHAR [LAMBDA (XPOS LINE# TEXTELT STRM) (* rrb "28-Apr-85 15:48") (* * determines the the slot between characters that is closest to XPOS. it will return 0 if the position is in the first half of the first character or before the first character) (PROG ((LTEXT (fetch (SCREENELT LOCALPART) of TEXTELT)) TEXT LREGION LFONT LEFT THISCHARWIDTH) (SETQ TEXT (CAR (NTH (fetch (LOCALTEXT LOCALLISTOFCHARACTERS) of LTEXT) LINE#))) (SETQ LFONT (fetch (LOCALTEXT LOCALFONT) of LTEXT)) (RETURN (COND ((IGREATERP [SETQ LEFT (fetch (REGION LEFT) of (SETQ LREGION (CAR (NTH (fetch (LOCALTEXT LINEREGIONS) of LTEXT) LINE#] XPOS) (* before the first character.) 0) ((IGEQ XPOS (IPLUS LEFT (fetch (REGION WIDTH) of LREGION))) (* past the rightmost character.) (NCHARS TEXT)) [(IMAGESTREAMTYPEP STRM (QUOTE HARDCOPY)) (* hardcopy stream code is cobbled from STRINGWIDTH. Must be done because widths of characters is not an integral number of points and error would accumulate through the line.) (PROG ([FONT (FONTCREATE LFONT NIL NIL NIL (STREAMPROP STRM (QUOTE HARDCOPYIMAGETYPE] (LEFTMICAPOS (ITIMES (CONSTANT IMICASPERPT) LEFT)) (XMICAPOS (ITIMES (CONSTANT IMICASPERPT) XPOS))) (COND [(STRINGP TEXT) (* assumes PRIN1 mode.) (RETURN (for C instring TEXT as CHAR# from 1 when (IGREATERP [SETQ LEFTMICAPOS (IPLUS LEFTMICAPOS (SETQ THISCHARWIDTH (CHARWIDTH C FONT] XMICAPOS) do (RETURN (COND ((IGREATERP (IDIFFERENCE LEFTMICAPOS (LRSH THISCHARWIDTH 1)) XMICAPOS) (SUB1 CHAR#)) (T CHAR#))) finally (RETURN (SUB1 CHAR#] (T (\ILLEGAL.ARG TEXT] (T (for CHAR# from 1 to (NCHARS TEXT) when (IGREATERP [SETQ LEFT (IPLUS LEFT (SETQ THISCHARWIDTH (NTHCHARWIDTH TEXT CHAR# LFONT] XPOS) do (* have the hotspot be between the characters.) (RETURN (COND ((IGREATERP (IDIFFERENCE LEFT (LRSH THISCHARWIDTH 1)) XPOS) (SUB1 CHAR#)) (T CHAR#))) finally (RETURN (SUB1 CHAR#]) (CLOSEST.LINE [LAMBDA (TEXTELT Y) (* rrb " 1-MAY-83 10:15") (* determines the line of TEXTELT that Y is closest to.) (* assumes that the text elements are ordered from top to bottom.) (for LREGION in (fetch (LOCALTEXT LINEREGIONS) of (fetch (SCREENELT LOCALPART) of TEXTELT)) as LINE# from 1 when (IGEQ Y (fetch (REGION BOTTOM) of LREGION)) do (RETURN LINE#) finally (RETURN (SUB1 LINE#]) (FLASHW [LAMBDA (WIN) (* flashs a window.) (INVERTW WIN) (DISMISS BELLRATE) (INVERTW WIN]) (HILITE.LINE [LAMBDA (TEXTELT LINE# MINLEFT MAXLEFT WINDOW) (* rrb " 1-MAY-83 09:54") (* highlights within a single line of text between MINLEFT and MAXLEFT. If MINLEFT is NIL it uses the beginning of the line. If MAXLEFT is NIL it uses the end of the line.) (PROG ((LREGION (NTHLOCALREGION TEXTELT LINE#))) (BITBLT NIL NIL NIL WINDOW (OR MINLEFT (SETQ MINLEFT (FETCH (REGION LEFT) OF LREGION))) (fetch (REGION BOTTOM) of LREGION) (IDIFFERENCE (OR MAXLEFT (FETCH (REGION PRIGHT) OF LREGION)) MINLEFT) (fetch (REGION HEIGHT) of LREGION) (QUOTE TEXTURE) (QUOTE INVERT) SELECTION.HIGHLIGHT.SHADE]) (HILITE.TEXT [LAMBDA (TEXTELT SELLEFT SELLINE# EXTLEFT EXTLINE# WINDOW) (* rrb "30-Dec-84 17:59") (* high lights between two positions in a text element.) (COND ((EQ SELLINE# EXTLINE#) (* on the same line, highlight between them.) (PROG (MIN MAX) (COND ((NULL SELLEFT) (* SELLEFT is NIL during recursive calls and means use the beginning of the text.) (SETQ MIN NIL) (SETQ MAX EXTLEFT)) ((IGREATERP SELLEFT EXTLEFT) (SETQ MIN EXTLEFT) (SETQ MAX SELLEFT)) (T (SETQ MIN SELLEFT) (SETQ MAX EXTLEFT))) (HILITE.LINE TEXTELT SELLINE# MIN MAX WINDOW))) ((IGREATERP EXTLINE# SELLINE#) (* fill from SEL to end of its line and recurse.) (HILITE.LINE TEXTELT SELLINE# SELLEFT NIL WINDOW) (HILITE.TEXT TEXTELT NIL (ADD1 SELLINE#) EXTLEFT EXTLINE# WINDOW)) (T (* fill from EXT to the end of its line and recurse.) (HILITE.LINE TEXTELT EXTLINE# EXTLEFT NIL WINDOW) (* always recurse to have highest selection first.) (HILITE.TEXT TEXTELT NIL (ADD1 EXTLINE#) SELLEFT SELLINE# WINDOW]) (IN.TEXT.EXTEND [LAMBDA (SELECTION SKW) (* rrb "22-May-85 11:40") (* the user has right buttoned and the first selection was to in existing text.) (* current selection has already been undisplayed.) (PROG [(OLDLINE (fetch (TEXTELTSELECTION SKLINE#) of SELECTION)) (OLDX (fetch (TEXTELTSELECTION SKLEFT) of SELECTION)) (INTEXT (fetch (TEXTELTSELECTION SKTEXTELT) of SELECTION)) FEEDBACKX FEEDBACKY FEEDBACKLINE FEEDBACKCHAR (REGION (DSPCLIPPINGREGION NIL SKW)) (DSP (WINDOWPROP SKW (QUOTE DSP] (while (MOUSESTATE RIGHT) do (* track with the appropriate feedback) (COND ([NOT (INSIDEP REGION (SETQ FEEDBACKX (LASTMOUSEX DSP)) (SETQ FEEDBACKY (LASTMOUSEY DSP] (* cursor moved outside of the window. Reset selection and quit.) (SKED.SELECTION.FEEDBACK SKW) (RETURN))) (SETQ FEEDBACKLINE (CLOSEST.LINE INTEXT FEEDBACKY)) (* inside of a text element.) (SETQ FEEDBACKX (CHAR.BEGIN (SETQ FEEDBACKCHAR (CLOSEST.CHAR FEEDBACKX FEEDBACKLINE INTEXT DSP)) FEEDBACKLINE INTEXT DSP)) (COND ((OR (NEQ OLDX FEEDBACKX) (NEQ OLDLINE FEEDBACKLINE)) (HILITE.TEXT INTEXT OLDX OLDLINE (SETQ OLDX FEEDBACKX) (SETQ OLDLINE FEEDBACKLINE) SKW))) finally (* erase feedback. It will be put in as a result of setting the extention selection.) (HILITE.TEXT INTEXT OLDX OLDLINE (fetch (TEXTELTSELECTION SKLEFT) of SELECTION) (fetch (TEXTELTSELECTION SKLINE#) of SELECTION) SKW) (SKED.SET.EXTENDSELECTION (create TEXTELTSELECTION SKTEXTELT ← INTEXT SKLINE# ← OLDLINE SKCHAR# ← FEEDBACKCHAR SKLEFT ← OLDX SKBOTTOM ←(LINE.BEGIN (OR FEEDBACKLINE 1) INTEXT)) SKW]) (INIMAGEOBJ [LAMBDA (SKIMAGEOBJSCREENELT X Y) (* rrb "31-Mar-84 11:43") (* return T if X Y is inside of the image object SKIMAGEOBJSCREENELT.) (INSIDEP (fetch (LOCALSKIMAGEOBJ SKIMOBJLOCALREGION) of (fetch (SCREENELT LOCALPART) of SKIMAGEOBJSCREENELT)) X Y]) (INTEXT [LAMBDA (TEXTELT XORPT Y) (* rrb " 6-MAY-83 19:37") (* determines which line if any a position is on.) (for LREGION in (fetch (LOCALTEXT LINEREGIONS) of (fetch (SCREENELT LOCALPART) of TEXTELT)) as LINE# from 1 when (INSIDEP LREGION XORPT Y) do (RETURN LINE#]) (NEW.TEXT.EXTEND [LAMBDA (SELECTION SKW) (* rrb "30-APR-83 16:25") (* the user has right buttoned and the first selection was to new text.) (* current selection has already been undisplayed.) (PROG (FEEDBACKX FEEDBACKY EXTENDEDSEL OLDX OLDY OLDCUR) (until (MOUSESTATE (NOT RIGHT)) do (* track with the appropriate feedback) (SETQ FEEDBACKX (LASTMOUSEX SKW)) (SETQ FEEDBACKY (LASTMOUSEY SKW)) (COND ((OR (NEQ OLDX FEEDBACKX) (NEQ OLDY FEEDBACKY)) (* erase previous feedback) (AND EXTENDEDSEL (SHOW.FEEDBACK.BOX SELECTION EXTENDEDSEL SKW)) (SHOW.FEEDBACK.BOX SELECTION (SETQ EXTENDEDSEL (create POSITION XCOORD ←(SETQ OLDX FEEDBACKX) YCOORD ←(SETQ OLDY FEEDBACKY))) SKW))) finally (AND EXTENDEDSEL (SHOW.FEEDBACK.BOX SELECTION EXTENDEDSEL SKW)) (SKED.SET.EXTENDSELECTION EXTENDEDSEL SKW]) (NEW.TEXT.SELECTIONP [LAMBDA (SELECTION) (* determines if a selection is pointing to new text location or existing text.) (POSITIONP SELECTION]) (NTHCHARWIDTH [LAMBDA (STR N FONT) (* rrb "23-Aug-84 09:43") (* returns the character width of the Nth character in STR.) (CHARWIDTH (CHCON1 (NTHCHAR STR N)) FONT]) (NTHLOCALREGION [LAMBDA (TEXTELT N) (* rrb " 1-MAY-83 09:53") (CAR (NTH (fetch (LOCALTEXT LINEREGIONS) of (fetch (SCREENELT LOCALPART) of TEXTELT)) N]) (ONCHAR [LAMBDA (XPOS LINE# TEXTELT STRM) (* rrb "24-Aug-84 11:14") (* determines the character number that XPOS is on in a particular line of a text element.) (* will return 1 if the position is in the first half of the first character.) (CLOSEST.CHAR XPOS LINE# TEXTELT STRM NIL]) (SHOW.EXTENDED.SELECTION.FEEDBACK [LAMBDA (SEL EXTENDSEL SKW) (* rrb " 1-MAY-83 09:55") (* hi lights the selection between SEL and EXTENDSEL) (COND ((NEQ (fetch (TEXTELTSELECTION SKTEXTELT) of SEL) (fetch (TEXTELTSELECTION SKTEXTELT) of EXTENDSEL)) (* if the two selections aren't in the same text element, things are confused.) (SHOULDNT))) (HILITE.TEXT (fetch (TEXTELTSELECTION SKTEXTELT) of SEL) (fetch (TEXTELTSELECTION SKLEFT) of SEL) (fetch (TEXTELTSELECTION SKLINE#) of SEL) (fetch (TEXTELTSELECTION SKLEFT) of EXTENDSEL) (fetch (TEXTELTSELECTION SKLINE#) of EXTENDSEL) SKW]) (SHOW.FEEDBACK [LAMBDA (FEEDBACKCUR FEEDBACKX FEEDBACKY WINDOW) (* rrb "30-APR-83 15:56") (* displays a cursor in XOR mode at a position.) (BITBLT (fetch (CURSOR CURSORBITMAP) of FEEDBACKCUR) 0 0 WINDOW (IDIFFERENCE FEEDBACKX (fetch (CURSOR CURSORHOTSPOTX) of FEEDBACKCUR)) (IDIFFERENCE FEEDBACKY (fetch (CURSOR CURSORHOTSPOTY) of FEEDBACKCUR)) NIL NIL (QUOTE INPUT) (QUOTE INVERT]) (SHOW.FEEDBACK.BOX [LAMBDA (P1 P2 WINDOW) (* rrb "30-APR-83 16:23") (* draws a box between two points.) (PROG ((X1 (fetch (POSITION XCOORD) of SELECTION P1)) (Y1 (fetch (POSITION YCOORD) of SELECTION P1)) (X2 (fetch (POSITION XCOORD) of SELECTION P2)) (Y2 (fetch (POSITION YCOORD) of SELECTION P2))) (BITBLT NIL NIL NIL WINDOW (IMIN X1 X2) (IMIN Y1 Y2) (ABS (IDIFFERENCE X1 X2)) (ABS (IDIFFERENCE Y1 Y2)) (QUOTE TEXTURE) (QUOTE INVERT) NEW.TEXT.FEEDBACK.SHADE) (* put cursor where the center would be.) (SHOW.FEEDBACK NEW.TEXT.FEEDBACK.CURSOR (IQUOTIENT (IPLUS X1 X2) 2) (IQUOTIENT (IPLUS Y1 Y2) 2) WINDOW]) (SELECTION.POSITION [LAMBDA (FIRSTPT SECONDPT) (* rrb " 6-MAY-83 18:09") (* returns the place where the text should go from one or two selections in open space.) (COND (SECONDPT (create POSITION XCOORD ←(IQUOTIENT (IPLUS (fetch (POSITION XCOORD) of FIRSTPT) (fetch (POSITION XCOORD) of SECONDPT)) 2) YCOORD ←(IQUOTIENT (IPLUS (fetch (POSITION YCOORD) of FIRSTPT) (fetch (POSITION YCOORD) of SECONDPT)) 2))) (T FIRSTPT]) (SKED.CLEAR.SELECTION [LAMBDA (SKW DONTDISPLAYFLG) (* rrb " 5-Sep-85 11:19") (* clears the selection and removes it from the display.) (COND ((OR DONTDISPLAYFLG (SKED.SELECTION.FEEDBACK SKW)) (WINDOWPROP SKW (QUOTE SELECTION) NIL) (WINDOWPROP SKW (QUOTE EXTENDSELECTION) NIL]) (SKED.REMOVE.OTHER.SELECTIONS [LAMBDA (SKW) (* rrb " 2-MAY-83 12:31") (* removes and undisplays any selections in any other windows onto the same sketch as SKW.) (for SKETCHWINDOW in (ALL.SKETCH.VIEWERS (SKETCH.FROM.VIEWER SKW)) do (SKED.CLEAR.SELECTION SKETCHWINDOW]) (SKED.EXTEND.SELECTION [LAMBDA (SKW) (* rrb "17-Jul-85 20:11") (* the user has left buttoned in a sketch window. Put the caret there.) (* take down the current selection.) (PROG [(SELECTION (WINDOWPROP SKW (QUOTE SELECTION))) (EXTENSION (WINDOWPROP SKW (QUOTE EXTENDSELECTION] (RETURN (COND [SELECTION (COND [(NEW.TEXT.SELECTIONP SELECTION) (* if the previous selection was in new text, treat the right the same as the left.) (SKED.MOVE.SELECTION SKW (NOT (WINDOWPROP SKW (QUOTE USEGRID] (T (SKED.SELECTION.FEEDBACK SKW) (* extend within text.) (* MAYBE SHOULD DO - if there is already an extension, make the fixed point be the one of the two selections that is farthest from the current position.) (IN.TEXT.EXTEND SELECTION SKW] (T (* here is a right button before any left ones. Treat as if it were left.) (SKED.MOVE.SELECTION SKW (NOT (WINDOWPROP SKW (QUOTE USEGRID]) (SKED.MOVE.SELECTION [LAMBDA (SKW USEGRID) (* rrb "17-Jul-85 20:11") (* the user has left buttoned in a sketch window. Put the caret there.) (SKED.CLEAR.SELECTION SKW) (PROG (FEEDBACKX FEEDBACKY OLDGRIDX OLDGRIDY OLDX OLDY OLDCUR FEEDBACKCUR INTEXT INIMAGEOBJ STARTLINE STARTCHAR X Y (DSP (WINDOWPROP SKW (QUOTE DSP))) (SCALE (WINDOW.SCALE SKW)) (GRID (SK.GRIDFACTOR SKW))) (until (MOUSESTATE UP) do (* track with the appropriate caret depending upon whether the cursor is inside of existing text or not.) (SETQ X (LASTMOUSEX DSP)) (SETQ Y (LASTMOUSEY DSP)) (COND ((OR (NEQ OLDX X) (NEQ OLDY Y)) (* only look for things when the cursor position has changed.) (SETQ OLDX X) (SETQ OLDY Y) [COND ((SETQ INTEXT (for ELT in (LOCALSPECS.FROM.VIEWER SKW) when (SELECTQ (fetch (SCREENELT GTYPE) of ELT) [TEXT (AND (NEQ (fetch (LOCALTEXT LOCALFONT) of (fetch (SCREENELT LOCALPART) of ELT)) (QUOTE SHADE)) (SETQ STARTLINE (INTEXT ELT X Y] [TEXTBOX (AND (NEQ (fetch (LOCALTEXTBOX LOCALFONT) of (fetch (SCREENELT LOCALPART) of ELT)) (QUOTE SHADE)) (INSIDE? (fetch (LOCALTEXTBOX LOCALTEXTBOXREGION) of (fetch (SCREENELT LOCALPART) of ELT)) X Y) (SETQ STARTLINE (CLOSEST.LINE ELT Y] NIL) do (RETURN ELT))) (* inside of a text element.) (SETQ FEEDBACKCUR IN.TEXT.FEEDBACK.CURSOR) (SETQ FEEDBACKX (CHAR.BEGIN (SETQ STARTCHAR (CLOSEST.CHAR X STARTLINE INTEXT DSP)) STARTLINE INTEXT DSP)) (SETQ FEEDBACKY (LINE.BEGIN STARTLINE INTEXT))) (T (SETQ FEEDBACKCUR NEW.TEXT.FEEDBACK.CURSOR) (COND (USEGRID (SETQ FEEDBACKX (MAP.WINDOW.ONTO.GRID X SCALE GRID)) (SETQ FEEDBACKY (MAP.WINDOW.ONTO.GRID Y SCALE GRID))) (T (* no grid) (SETQ FEEDBACKX X) (SETQ FEEDBACKY Y] (COND ((OR (NEQ OLDGRIDX FEEDBACKX) (NEQ OLDGRIDY FEEDBACKY) (NEQ OLDCUR FEEDBACKCUR)) (AND OLDGRIDX (SHOW.FEEDBACK OLDCUR OLDGRIDX OLDGRIDY SKW)) (SHOW.FEEDBACK (SETQ OLDCUR FEEDBACKCUR) (SETQ OLDGRIDX FEEDBACKX) (SETQ OLDGRIDY FEEDBACKY) SKW))) (* give the coordinate display window a shot.) (SKETCHW.UPDATE.LOCATORS SKW))) finally (AND OLDGRIDX (SHOW.FEEDBACK OLDCUR OLDGRIDX OLDGRIDY SKW)) (COND ((EQ OLDCUR IN.TEXT.FEEDBACK.CURSOR) (* selection is existing text) (SKED.SET.SELECTION (CREATE.TEXT.SELECTION INTEXT STARTLINE STARTCHAR OLDGRIDX OLDGRIDY DSP) SKW)) (OLDGRIDX (SKED.SET.SELECTION (create POSITION XCOORD ← OLDGRIDX YCOORD ← OLDGRIDY) SKW]) (CREATE.TEXT.SELECTION [LAMBDA (TEXTELT LINE# CHAR# LFT BTM STRM) (* rrb "23-Aug-84 13:48") (* creates a text selection object. If LFT or BTM are NIL they are computed from the other arguments.) (create TEXTELTSELECTION SKTEXTELT ← TEXTELT SKLINE# ← LINE# SKCHAR# ← CHAR# SKLEFT ←(OR LFT (CHAR.BEGIN CHAR# LINE# TEXTELT STRM)) SKBOTTOM ←(OR BTM (LINE.BEGIN LINE# TEXTELT]) (SKED.SELECTION.FEEDBACK [LAMBDA (SKETCHW) (* rrb "14-Sep-84 18:20") (* displays the feedback to the user about what the current selection is. Returns NIL if there is no selection, T otherwise.) (PROG ((SELECTION (WINDOWPROP SKETCHW (QUOTE SELECTION))) EXTENDSELECTION) (OR SELECTION (RETURN)) (SETQ EXTENDSELECTION (WINDOWPROP SKETCHW (QUOTE EXTENDSELECTION))) [COND [(NEW.TEXT.SELECTIONP SELECTION) (* outside of existing text region) (COND (EXTENDSELECTION (* display a box whose center will be used as the center of mass of the text.) (SHOW.FEEDBACK.BOX SELECTION EXTENDSELECTION SKETCHW)) (T (SHOW.FEEDBACK NEW.TEXT.FEEDBACK.CURSOR (fetch (POSITION XCOORD) of SELECTION) (fetch (POSITION YCOORD) of SELECTION) SKETCHW] (T (COND (EXTENDSELECTION (* display a box whose center will be used as the center of mass of the text.) (SHOW.EXTENDED.SELECTION.FEEDBACK SELECTION EXTENDSELECTION SKETCHW) ) (T (SHOW.FEEDBACK IN.TEXT.FEEDBACK.CURSOR (fetch (TEXTELTSELECTION SKLEFT) of SELECTION) (fetch (TEXTELTSELECTION SKBOTTOM) of SELECTION) SKETCHW] (RETURN T]) (SKED.SET.EXTENDSELECTION [LAMBDA (SELECTION SKETCHW) (* rrb "30-APR-83 16:36") (* stores the selection for a sketch window and displays its feedback.) (WINDOWPROP SKETCHW (QUOTE EXTENDSELECTION) SELECTION) (SKED.SELECTION.FEEDBACK SKETCHW]) (SKED.SET.SELECTION [LAMBDA (SELECTION SKETCHW) (* rrb " 2-MAY-83 12:29") (* stores the selection for a sketch window and displays its feedback.) (WINDOWPROP SKETCHW (QUOTE SELECTION) SELECTION) (* clear the extension also.) (WINDOWPROP SKETCHW (QUOTE EXTENDSELECTION) NIL) (SKED.SELECTION.FEEDBACK SKETCHW]) (LINE.BEGIN [LAMBDA (LINE# TEXTELT) (* rrb "30-APR-83 15:45") (* returns the bottom of the LINE# th text element of TEXTELT.) (fetch (REGION BOTTOM) of (CAR (NTH (fetch (LOCALTEXT LINEREGIONS) of (fetch (SCREENELT LOCALPART) of TEXTELT)) LINE#]) (SELECTION.GREATERP [LAMBDA (SEL1 SEL2) (* rrb " 1-MAY-83 11:31") (* return T if SEL1 appears before SEL2) (PROG (L1 L2) (RETURN (COND ((IGREATERP (SETQ L2 (fetch (TEXTELTSELECTION SKLINE#) of SEL2)) (SETQ L1 (fetch (TEXTELTSELECTION SKLINE#) of SEL1))) T) ((EQ L1 L2) (* look at characters) (IGREATERP (fetch (TEXTELTSELECTION SKCHAR#) of SEL2) (fetch (TEXTELTSELECTION SKCHAR#) of SEL1]) ) (DECLARE: DONTCOPY [DECLARE: EVAL@COMPILE (RECORD TEXTELTSELECTION (SKTEXTELT SKLINE# SKCHAR# SKLEFT SKBOTTOM)) ] ) (READVARS IN.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.SHADE SELECTION.HIGHLIGHT.SHADE) (({(READBITMAP)(16 16 "@@@@" "@@@@" "L@@@" "L@@@" "L@@@" "L@@@" "L@@@" "L@@@" "L@@@" "L@@@" "L@@@" "L@@@" "L@@@" "L@@@" "L@@@" "L@@@")} 1 . 0) ({(READBITMAP)(16 16 "@@@@" "@@@@" "@@@@" "@@@@" "@@@@" "@@@@" "@@@@" "@@@@" "@@@@" "@@@@" "@@@@" "@H@@" "AL@@" "CF@@" "FC@@" "LAH@")} 4 . 4) 8 65535) (DECLARE: DOEVAL@COMPILE DONTCOPY (GLOBALVARS IN.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.CURSOR NEW.TEXT.FEEDBACK.SHADE SELECTION.HIGHLIGHT.SHADE) ) (* editting functions) (DEFINEQ (WB.EDITOR [LAMBDA (SKW) (* rrb "17-Jul-85 15:53") (* the process that looks for characters and adds them to the white board as text elements.) (* save the value of del as an interrupt character so it is restored when this process exits. This is also done by TTYENTRYFN and TTYEXITFN on the process.) (RESETFORM (INTERRUPTCHAR 127 T) (PROG (CHARS EDITINPROGRESS) (TTYDISPLAYSTREAM SKW) LP (COND ((\SYSBUFP) (* a character has been typed, read all of the characters, delete the current selection if extended and insert the new characters.) (RESET.LINE.BEING.INPUT SKW) (SKED.INSERT (GETALLCHARS T) SKW) (SETQ EDITINPROGRESS T)) ((AND EDITINPROGRESS (NOT (INSIDEP (WINDOWPROP SKW (QUOTE REGION)) LASTMOUSEX LASTMOUSEY))) (CLEANUP.EDIT SKW) (SETQ EDITINPROGRESS NIL))) (* let the mouse process run.) (BLOCK) (GO LP]) (SK.TTYENTRYFN [LAMBDA (SKPROC) (* rrb "20-Jun-85 14:13") (* the sketch process just got the tty. Turns off DEL as an interrupt) (PROCESSPROP SKPROC (QUOTE OLDINTERRUPTVALUE) (INTERRUPTCHAR 127 NIL]) (SK.TTYEXITFN [LAMBDA (SKPROC) (* rrb "20-Jun-85 13:55") (* the sketch process just got the tty. Turns off DEL as an interrupt) (INTERRUPTCHAR (PROCESSPROP SKPROC (QUOTE OLDINTERRUPTVALUE]) (SKED.INSERT [LAMBDA (CHARCODES SKW ATSCALE) (* rrb " 4-Sep-85 14:34") (* deletes the characters in the extension and inserts characters into the currently selected position of SKW and leaves the selection at the end of the insertion.) (PROG ((SELECTION (WINDOWPROP SKW (QUOTE SELECTION))) (EXTENSION (WINDOWPROP SKW (QUOTE EXTENDSELECTION))) TEXTELT ELTTYPE GTEXTELT FIRSTLINE# FIRSTCHAR# LASTLINE# LASTCHAR# STRLST NEWSTRS NEWELT STRPIECE NEWLINE# NEWCHAR# SKCONTEXT PTRCHAR# CONTROLCHARTAIL) (COND ((NULL SELECTION) (* add a new text element with these characters.) (STATUSPRINT SKW " " "Indicate the position the typing should go with the left button.") (RETURN))) (SKED.REMOVE.OTHER.SELECTIONS SKW) [COND [(NEW.TEXT.SELECTIONP SELECTION) (* selection is in open space, create a new text element.) (* merge the characters into strings of each line.) (SETQ ELTTYPE (QUOTE TEXT)) (SETQ CONTROLCHARTAIL (\SKED.INSERT.CHARS.TO.STR CHARCODES)) (COND ((OR NEWSTRS STRPIECE) (* if there are any new characters, add a new text element.) (SETQ NEWELT (SKETCH.ADD.AND.DISPLAY (CREATE.TEXT.ELEMENT (SETQ NEWSTRS (NCONC1 NEWSTRS STRPIECE)) (SK.MAP.INPUT.PT.TO.GLOBAL (create INPUTPT INPUT.ONGRID? ← T INPUT.POSITION ←( SELECTION.POSITION SELECTION EXTENSION)) SKW) (OR (NUMBERP ATSCALE) (SK.INPUT.SCALE SKW)) [fetch (SKETCHCONTEXT SKETCHTEXTALIGNMENT) of (SETQ SKCONTEXT (WINDOWPROP SKW (QUOTE SKETCHCONTEXT] (fetch (SKETCHCONTEXT SKETCHFONT) of SKCONTEXT)) SKW))) (CONTROLCHARTAIL (* user typed control return to get textbox in the middle of no where.) (SKED.CREATE.NEW.TEXTBOX NIL SKW (CDR CONTROLCHARTAIL) ATSCALE) (RETURN)) (T (* user typed backspace, etc. when no text exists. Put caret back in same place.) (SKED.SET.SELECTION SELECTION SKW) (RETURN))) (* put selection marker at the end.) (SETQ NEWLINE# (LENGTH NEWSTRS)) (SETQ NEWCHAR# (NCHARS (CAR (LAST NEWSTRS] (T [SETQ GTEXTELT (fetch (SCREENELT INDIVIDUALGLOBALPART) of (SETQ TEXTELT (fetch (TEXTELTSELECTION SKTEXTELT) of SELECTION] (SETQ ELTTYPE (fetch (INDIVIDUALGLOBALPART GTYPE) of GTEXTELT)) (SETQ STRLST (fetch (LOCALTEXT LOCALLISTOFCHARACTERS) of (fetch (SCREENELT LOCALPART) of TEXTELT))) (* set up points to beginning and end of selection.) [COND [(NULL EXTENSION) (SETQ LASTCHAR# (SETQ FIRSTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of SELECTION))) (SETQ LASTLINE# (SETQ FIRSTLINE# (fetch (TEXTELTSELECTION SKLINE#) of SELECTION] ((SELECTION.GREATERP SELECTION EXTENSION) (SETQ FIRSTLINE# (fetch (TEXTELTSELECTION SKLINE#) of SELECTION)) (SETQ FIRSTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of SELECTION)) (SETQ LASTLINE# (fetch (TEXTELTSELECTION SKLINE#) of EXTENSION)) (SETQ LASTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of EXTENSION)) (* make SELECTION be the candidate for the selection after the deletion.) (SETQ SELECTION EXTENSION)) (T (SETQ FIRSTLINE# (fetch (TEXTELTSELECTION SKLINE#) of EXTENSION)) (SETQ FIRSTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of EXTENSION)) (SETQ LASTLINE# (fetch (TEXTELTSELECTION SKLINE#) of SELECTION)) (SETQ LASTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of SELECTION] (WINDOWPROP SKW (QUOTE EXTENDSELECTION) NIL) [for STR in STRLST as LINE# from 1 do [COND ((ILESSP LINE# FIRSTLINE#) (* before the first, copy across) (SETQ NEWSTRS (NCONC1 NEWSTRS STR))) ((IGREATERP LINE# LASTLINE#) (* After the last, copy across) (SETQ NEWSTRS (NCONC1 NEWSTRS STR))) ((EQ LINE# FIRSTLINE#) (* on the first, save the part before.) (SETQ STRPIECE (SUBSTRING STR 1 FIRSTCHAR#)) (* insert new text.) (COND [CHARCODES [SETQ CONTROLCHARTAIL (\SKED.INSERT.CHARS.TO.STR CHARCODES (EQ ELTTYPE (QUOTE TEXTBOX] (SETQ NEWCHAR# (COND (STRPIECE (NCHARS STRPIECE)) (T 0))) (SETQ NEWLINE# (ADD1 (LENGTH NEWSTRS] (T (SETQ NEWCHAR# FIRSTCHAR#) (SETQ NEWLINE# FIRSTLINE#] (COND ((EQ LINE# LASTLINE#) (* on the last, copy the part before and the part after as one) (SETQ NEWSTRS (COND [STRPIECE (NCONC1 NEWSTRS (COND ((EQ LASTCHAR# (NCHARS STR)) (* special check because SUBSTRING returns NIL rather than the empty string.) STRPIECE) (T (CONCAT STRPIECE (SUBSTRING STR (ADD1 LASTCHAR#] [(NEQ LASTCHAR# (NCHARS STR)) (NCONC1 NEWSTRS (SUBSTRING STR (ADD1 LASTCHAR#] (T NEWSTRS] (* any other windows that had this selection have had it deleted already so this doesn't do anything for them.) [COND ((IGREATERP NEWLINE# (LENGTH NEWSTRS)) (* this corresponds to deleting every thing in a line. Make sure that if it is the last line that the selection is reset) (* SHOULD CHECK HERE FOR DELETING EVERYTHING WHEN del CHARACTER GETS INCLUDED.) (COND ((AND (EQ (SETQ NEWLINE# (LENGTH NEWSTRS)) 0) (EQ ELTTYPE (QUOTE TEXT))) (* deleted everything in a text element, delete the text element and set the selection to new text cursor.) (SK.DELETE.ELEMENT (LIST TEXTELT) SKW) (SKED.SET.SELECTION (create POSITION XCOORD ←(CHAR.BEGIN 0 1 TEXTELT SKW) YCOORD ←(LINE.BEGIN 1 TEXTELT)) SKW) (RETURN NIL))) (SETQ NEWCHAR# (NCHARS (CAR (LAST NEWSTRS] (SETQ PTRCHAR# (SKED.CHARACTERPOSITION NEWSTRS NEWLINE# NEWCHAR#)) (SETQ NEWELT (SK.UPDATE.ELEMENT (fetch (SCREENELT GLOBALPART) of TEXTELT) (SKED.NEW.TEXTELT (fetch (SCREENELT GLOBALPART) of TEXTELT) NEWSTRS) SKW)) (* recalculate the line # and char # of the insertion point as the textboxes at least do justification.) [SETQ NEWCHAR# (CDR (SETQ NEWLINE# (SKED.LINE.AND.CHAR# (fetch (LOCALTEXTBOX LOCALLISTOFCHARACTERS) of (fetch (SCREENELT LOCALPART) of NEWELT)) PTRCHAR#] (SETQ NEWLINE# (CAR NEWLINE#] (COND ((NULL CONTROLCHARTAIL) (* set the selection to where the characters were just inserted.) (SKED.SET.SELECTION (CREATE.TEXT.SELECTION NEWELT NEWLINE# NEWCHAR# NIL NIL (WINDOWPROP SKW (QUOTE DSP))) SKW)) (T (* user typed a character command to create a new text box. Create it and put the remaining characters in it and set the cursor there.) (SKED.CREATE.NEW.TEXTBOX (fetch (SCREENELT INDIVIDUALGLOBALPART) of NEWELT) SKW (CDR CONTROLCHARTAIL]) (SKED.CREATE.NEW.TEXTBOX [LAMBDA (TEXTELT SKW CHARSTOINSERT ATSCALE) (* rrb " 4-Sep-85 15:53") (* create a new text box. Create it and put the remaining characters in it and set the cursor there.) (PROG (CURRENTREGION NEWELT) [SETQ CURRENTREGION (COND [(NULL TEXTELT) (* create a region around the cursor) (UNSCALE.REGION (CREATEREGION (DIFFERENCE (LASTMOUSEX SKW) 50) (DIFFERENCE (LASTMOUSEY SKW) 35) 100 70) (OR (NUMBERP ATSCALE) (WINDOW.SCALE SKW] (T (* create a region below the current element.) [SETQ CURRENTREGION (COND ((EQ (fetch (INDIVIDUALGLOBALPART GTYPE) of TEXTELT) (QUOTE TEXTBOX)) (* current element is a textbox,) (fetch (TEXTBOX TEXTBOXREGION) of TEXTELT)) (T (APPLY (FUNCTION UNIONREGIONS) (fetch (TEXT LISTOFREGIONS) of TEXTELT] (* should limit the dimensions of this box and put it to right if it would appear off the screen. Later) (create REGION using CURRENTREGION BOTTOM ←(DIFFERENCE (fetch (REGION BOTTOM) of CURRENTREGION) (PLUS (fetch (REGION HEIGHT) of CURRENTREGION) (TIMES (OR (NUMBERP ATSCALE) (WINDOW.SCALE SKW)) 16] (SETQ CURRENTREGION (MAP.GLOBAL.REGION.ONTO.GRID CURRENTREGION SKW)) [SETQ NEWELT (COND ((NULL TEXTELT) (* create a default textbox) (SK.TEXTBOX.CREATE CURRENTREGION (fetch (SKETCHCONTEXT SKETCHBRUSH) of (WINDOWPROP SKW (QUOTE SKETCHCONTEXT))) (OR (NUMBERP ATSCALE) (SK.INPUT.SCALE SKW)) SKW)) ((EQ (fetch (INDIVIDUALGLOBALPART GTYPE) of TEXTELT) (QUOTE TEXTBOX)) (* copy the characteristics of the current text box) (SK.TEXTBOX.CREATE1 CURRENTREGION (fetch (TEXTBOX TEXTBOXBRUSH) of TEXTELT) (LIST "") (fetch (TEXTBOX INITIALSCALE) of TEXTELT) (fetch (TEXTBOX TEXTSTYLE) of TEXTELT) (fetch (TEXTBOX FONT) of TEXTELT) (fetch (TEXTBOX TEXTBOXDASHING) of TEXTELT) (fetch (TEXTBOX TEXTBOXFILLING) of TEXTELT))) (T (* copy from text element or default context) (SK.TEXTBOX.CREATE CURRENTREGION (fetch (SKETCHCONTEXT SKETCHTEXTBOXALIGNMENT) of (WINDOWPROP SKW (QUOTE SKETCHCONTEXT))) (fetch (TEXT INITIALSCALE) of TEXTELT) SKW] (SKED.SET.SELECTION (CREATE.TEXT.SELECTION (SKETCH.ADD.AND.DISPLAY NEWELT SKW) 1 0 NIL NIL (WINDOWPROP SKW (QUOTE DSP))) SKW) (* put the remaining characters in the new textbox.) (AND CHARSTOINSERT (SKED.INSERT CHARSTOINSERT SKW ATSCALE]) (SKED.CHARACTERPOSITION [LAMBDA (STRLST LINE# CHAR#) (* rrb "22-Jan-85 15:39") (* returns the character position of the character at line number LINE# and character position CHAR#) (PROG ((CHARPOS 0)) [bind NCHARS for STR in STRLST as N from 1 to (SUB1 LINE#) do [SETQ CHARPOS (PLUS CHARPOS (SETQ NCHARS (NCHARS STR] (COND ((NEQ (NTHCHARCODE STR NCHARS) (CHARCODE EOL)) (* unless the last character in the string is CR, add one for the implied space or CR.) (SETQ CHARPOS (ADD1 CHARPOS] (RETURN (PLUS CHARPOS CHAR#]) (SKED.LINE.AND.CHAR# [LAMBDA (STRLST CHARPOS) (* rrb "14-Jun-85 18:12") (* returns a dotted pair of the line number and character within line position of a character position.) (bind NCHARS (CHARSLEFT ← CHARPOS) for STR in STRLST as N from 1 do [COND [(EQ (SETQ NCHARS (NCHARS STR)) CHARSLEFT) (* at end of a line. If the line ends in CR, return ptr to beginning of next line.) (COND ((AND (EQ (NTHCHARCODE STR NCHARS) (CHARCODE EOL)) (GREATERP (LENGTH STRLST) N)) (RETURN (CONS (ADD1 N) 0))) (T (RETURN (CONS N CHARSLEFT] ((IGREATERP NCHARS CHARSLEFT) (RETURN (CONS N CHARSLEFT))) (T (SETQ CHARSLEFT (DIFFERENCE CHARSLEFT (COND ((EQ (NTHCHARCODE STR NCHARS) (CHARCODE EOL)) (* if the line ends in CR, don't add one for the) NCHARS) (T (ADD1 NCHARS] finally (* return something that is after last character of last line.) (RETURN (CONS (LENGTH STRLST) (NCHARS (CAR (LAST STRLST]) (\SKED.DELETE.WORD.FROM.STRING [LAMBDA (STRING) (* rrb "27-Dec-84 18:17") (* returns a string that has the last word of STRING deleted.) (PROG ((END (NCHARS STRING)) CLASS) SKBLANKS (COND ((EQ END 0) (* ran out of characters.) (RETURN)) ((EQ (SETQ CLASS (TEDIT.WORDGET (NTHCHARCODE STRING END))) 22) (SETQ END (SUB1 END)) (GO SKBLANKS))) (* now skip characters that have the same class as the first one encountered.) SKSAME (SETQ END (SUB1 END)) (COND ((EQ END 0) (* ran out of characters.) (RETURN)) ((EQ (TEDIT.WORDGET (NTHCHARCODE STRING END)) CLASS) (GO SKSAME)) (T (RETURN (SUBSTRING STRING 1 END]) (\SKED.INSERT.CHARS.TO.STR [LAMBDA (CHARCODES INCLUDECR) (* rrb "14-Jun-85 18:28") (DECLARE (SPECVARS NEWSTRS STRPIECE)) (* takes a list of characters and makes it into strings on the free variable NEWSTRS. The variable STRPIECE is set to the last line of characters. NEWSTRS is a list of the strings that precede this one which is used in the case of backspace onto the previous line.) (PROG (LINELST THISLINE REMAININGCHARS CLASS) [for CHAR in CHARCODES do (SELECTQ (TEDIT.GETSYNTAX CHAR TEDIT.READTABLE) [CHARDELETE (* delete the previous character.) (COND (THISLINE (* easy case of deleting type in.) (SETQ THISLINE (CDR THISLINE))) (LINELST (* deleting a typed in CR.) (SETQ THISLINE (CAR LINELST)) (SETQ LINELST (CDR LINELST))) [STRPIECE (* remove the previous character from the current string.) (COND ((EQ (NCHARS STRPIECE) 1) (SETQ STRPIECE NIL)) (T (SETQ STRPIECE (SUBSTRING STRPIECE 1 -2] [NEWSTRS (SETQ STRPIECE (CAR (LAST NEWSTRS))) (SETQ NEWSTRS (BUTLAST NEWSTRS)) (COND ((EQ (NTHCHARCODE STRPIECE -1) (CHARCODE EOL)) (* remove previous eol) (COND ((EQ (NCHARS STRPIECE) 1) (SETQ STRPIECE NIL)) (T (SETQ STRPIECE (SUBSTRING STRPIECE 1 -2] (T (* no characters to delete) (FLASHW (TTYDISPLAYSTREAM] [WORDDELETE (* delete the previous word) (* use the TEdit word bounding readtable. Code are: character = 21 - space = 22 - punctuation = 20) (COND [[OR THISLINE (PROG1 (SETQ THISLINE (CAR LINELST)) (SETQ LINELST (CDR LINELST] (* easy case of deleting type in.) (* if this line was empty, skip the cr that created it as part of the white space before the word.) (* skip any whitespace) (COND ([NULL (SETQ THISLINE (for TAIL on THISLINE while (EQ (TEDIT.WORDGET (CAR TAIL)) 22) finally (RETURN TAIL] (* the whitespace backed up to the beginning of a line. quit there.) NIL) (T (SETQ CLASS (TEDIT.WORDGET (CAR THISLINE))) (* skip all things of the same class as the first character before the whitespace) (SETQ THISLINE (for TAIL on THISLINE until (NEQ (TEDIT.WORDGET (CAR TAIL)) CLASS) finally (RETURN TAIL] (STRPIECE (* remove the previous character from the current string.) (SETQ STRPIECE (\SKED.DELETE.WORD.FROM.STRING STRPIECE))) (NEWSTRS [SETQ STRPIECE (\SKED.DELETE.WORD.FROM.STRING (CAR (LAST NEWSTRS] (SETQ NEWSTRS (BUTLAST NEWSTRS))) (T (* no characters to delete) (FLASHW (TTYDISPLAYSTREAM] (DELETE (* delete selection. Here that means don't insert anything.)) ((UNDO REDO FN CMD) (STATUSPRINT SKW " " "Not implemented in this editor. Sorry.")) (COND [(EQ CHAR (CHARCODE EOL)) (* eol) (COND ((KEYDOWNP (QUOTE CTRL)) (* user entered control return, save remaining characters and return indicator) (SETQ REMAININGCHARS (MEMB (CHARCODE EOL) CHARCODES)) (RETURN)) (T (SETQ LINELST (CONS (COND (INCLUDECR (* text boxes need to have the CRs left in.) (CONS CHAR THISLINE)) (T THISLINE)) LINELST)) (SETQ THISLINE NIL] (T (* add this character onto the front of this line; reversal will happen before conversion to string and return.) (SETQ THISLINE (CONS CHAR THISLINE] (COND [LINELST (* had a cr in the character set.) [SETQ NEWSTRS (NCONC NEWSTRS [CONS (JOINCHARS STRPIECE (REVERSE (CAR (LAST LINELST] (for CHLST in (REVERSE (BUTLAST LINELST)) collect (STRINGFROMCHARACTERS (REVERSE CHLST] (SETQ STRPIECE (STRINGFROMCHARACTERS (REVERSE THISLINE] [THISLINE (* no new lines, add these characters onto STRPIECE) (SETQ STRPIECE (JOINCHARS STRPIECE (REVERSE THISLINE] (T (* no new lines, or characters, leave STRPIECE alone.) NIL)) (RETURN REMAININGCHARS]) (JOINCHARS [LAMBDA (STR CHARCODES) (* rrb "27-Dec-84 16:56") (* makes a string by attaching the list of character codes CHARCODES onto the end of the string STR.) (COND ((NULL STR) (STRINGFROMCHARACTERS CHARCODES)) (T (CONCAT STR (STRINGFROMCHARACTERS CHARCODES]) (STRINGFROMCHARACTERS [LAMBDA (CHARS) (* rrb "27-Dec-84 16:56") (* makes a string from a list of characters) (MKSTRING (PACKC CHARS]) (GETALLCHARS [LAMBDA (FILE) (* bvm: "17-Jul-85 14:09") (* reads all of the characters that are on FILE.) (while (\SYSBUFP) collect (* used to (READC FILE TEDIT.READTABLE)) (\GETKEY]) (CLEANUP.EDIT [LAMBDA (SKW) (* rrb "12-Oct-84 11:23") (* Place holder to propagates the current edit into other windows that might be viewing the same sketch.) (* called when the cursor leaves the sketch window.) NIL]) (SKED.NEW.TEXTELT [LAMBDA (OLDGTEXTELT NEWSTRLST) (* rrb "26-Apr-85 15:59") (* creates a new text element by replacing only the list of characters of an old one.) (create GLOBALPART COMMONGLOBALPART ←(fetch (GLOBALPART COMMONGLOBALPART) of OLDGTEXTELT) INDIVIDUALGLOBALPART ←(COND ((EQ (fetch (GLOBALPART GTYPE) of OLDGTEXTELT) (QUOTE TEXT)) (TEXT.SET.GLOBAL.REGIONS (create TEXT using (fetch (GLOBALPART INDIVIDUALGLOBALPART) of OLDGTEXTELT) LISTOFCHARACTERS ← NEWSTRLST))) (T (TEXTBOX.SET.GLOBAL.REGIONS (create TEXTBOX using (fetch (GLOBALPART INDIVIDUALGLOBALPART) of OLDGTEXTELT) LISTOFCHARACTERS ←(OR NEWSTRLST (QUOTE (""]) ) (* line adding functions) (DEFINEQ (MAP.SCREEN.POSITION.ONTO.GRID [LAMBDA (PT WINDOW FLIPGRIDSENSEFLG) (* rrb "11-Jul-85 14:37") (* maps a point in screen coordinates into the screen coordinate that is closest to the grid in WINDOW. FLIPGRIDSENSEFLG is used to flip whether to use the grid or not and allows right buttoning to be the opposite of standard.) (COND [(COND ((WINDOWPROP WINDOW (QUOTE USEGRID)) (* window is calling for grid. Use it unless grid sense is switched.) (NOT FLIPGRIDSENSEFLG)) (T (* window is not calling for grid, don't use it unless grid sense is switched.) FLIPGRIDSENSEFLG)) (PROG ((GRID (SK.GRIDFACTOR WINDOW)) (SCALE (WINDOW.SCALE WINDOW))) (RETURN (create POSITION XCOORD ←(MAP.SCREEN.ONTO.GRID (fetch (POSITION XCOORD) of PT) SCALE GRID (DSPXOFFSET NIL WINDOW)) YCOORD ←(MAP.SCREEN.ONTO.GRID (fetch (POSITION YCOORD) of PT) SCALE GRID (DSPYOFFSET NIL WINDOW] (T (* avoid pt creation in the non-grid case.) PT]) (NEAREST.ON.GRID [LAMBDA (X GRIDSIZE) (* rrb "20-Jun-84 15:49") (* returns the point on a grid of size GRIDSIZE that is closest to X) (FTIMES GRIDSIZE (FIX (FQUOTIENT [COND ((GREATERP X 0.0) (* assymetry around 0.0) (FPLUS X (FQUOTIENT GRIDSIZE 2.0))) (T (FDIFFERENCE X (FQUOTIENT GRIDSIZE 2.0] GRIDSIZE]) (SK.MIDDLE.TITLEFN [LAMBDA (SKW POPUPONLYFLG) (* rrb "12-Sep-85 14:28") (* the middle button when down in the title bar. If the operations menu is not up, put it up, wait for a selection then take it down.) (PROG (OPMENUW FIXED?) [COND ((AND (NULL POPUPONLYFLG) (SETQ OPMENUW (WINDOWPROP SKW (QUOTE SKETCHFIXEDMENU))) (WINDOWPROP OPMENUW (QUOTE MAINWINDOW))) (* menu is already fixed, unattach it.) (SETQ FIXED? T) (DETACHWINDOW OPMENUW)) (T (SETQ OPMENUW (SK.INSURE.HAS.MENU SKW T (NOT POPUPONLYFLG] (* move opmenu to near cursor) [MOVEW OPMENUW [IMIN (ADD1 LASTMOUSEX) (IDIFFERENCE SCREENWIDTH (WINDOWPROP OPMENUW (QUOTE WIDTH] (IMAX 0 (IMIN (IDIFFERENCE LASTMOUSEY (IQUOTIENT (WINDOWPROP OPMENUW (QUOTE HEIGHT)) 2)) (IDIFFERENCE SCREENHEIGHT (WINDOWPROP OPMENUW (QUOTE HEIGHT] (RETURN (PROG ([OPMENU (CAR (WINDOWPROP OPMENUW (QUOTE MENU] (DSP (WINDOWPROP OPMENUW (QUOTE DSP))) SELCOMMAND) [SETQ SELCOMMAND (CADR (CAR (RESETLST (RESETSAVE (OPENW OPMENUW) (LIST (QUOTE CLOSEW) OPMENUW)) (MENU.HANDLER OPMENU DSP T T NIL] (* evaluate menu form after image has been taken down.) (RETURN (PROG1 (SK.APPLY.MENU.COMMAND SELCOMMAND SKW) (AND FIXED? (SK.FIX.MENU SKW]) (WB.BUTTON.HANDLER [LAMBDA (W) (* rrb "19-Aug-85 16:28") (* handles a button event in a whiteboard window.) (TOTOPW W) (PROG (TARGETIMOBJELT X Y) (RETURN (COND ((OR (.DELETEKEYDOWNP.) (.MOVEKEYDOWNP.)) (* if the DELETE key is held down, handle it with the copy button event fn.) (SK.COPY.BUTTONEVENTFN W)) [(AND [NOT (INSIDEP (DSPCLIPPINGREGION NIL W) (SETQ X (LASTMOUSEX W)) (SETQ Y (LASTMOUSEY W] (LASTMOUSESTATE (NOT UP))) (* title bar or border action) (COND ((LASTMOUSESTATE MIDDLE) (* offer command menu) (SK.MIDDLE.TITLEFN W)) ((LASTMOUSESTATE RIGHT) (DOWINDOWCOM W] [[AND (LASTMOUSESTATE (OR LEFT MIDDLE)) (SETQ TARGETIMOBJELT (for ELT in (LOCALSPECS.FROM.VIEWER W) when (AND (type? SKIMAGEOBJ (fetch (SCREENELT INDIVIDUALGLOBALPART) of ELT)) (INIMAGEOBJ ELT X Y)) do (RETURN ELT] (* inside of a imageobj, run its BUTTONEVENTINFN element.) (* there are miriad other arguments to the BUTTONEVENTINFN that are not applicable.) (COND ((EQ (RESETLST (RESETSAVE NIL (LIST (QUOTE DSPCLIPPINGREGION) (DSPCLIPPINGREGION (INTERSECTREGIONS (fetch (LOCALSKIMAGEOBJ SKIMOBJLOCALREGION) of (fetch (SCREENELT LOCALPART) of TARGETIMOBJELT)) (DSPCLIPPINGREGION NIL W)) W) W)) (APPLY* [fetch (IMAGEFNS BUTTONEVENTINFN) of (fetch (IMAGEOBJ IMAGEOBJFNS) of (SETQ X (fetch (SKIMAGEOBJ SKIMAGEOBJ) of (fetch (SCREENELT INDIVIDUALGLOBALPART) of TARGETIMOBJELT] X W)) (QUOTE CHANGED)) (* element changed, update the local fields and redisplay it.) (SKETCH.ELEMENT.CHANGED W (fetch (SCREENELT GLOBALPART) of TARGETIMOBJELT) W] [(LASTMOUSESTATE LEFT) (* move cursor) (RESET.LINE.BEING.INPUT W) (SKED.MOVE.SELECTION W (WINDOWPROP W (QUOTE USEGRID] ((LASTMOUSESTATE RIGHT) (* extend selection) (RESET.LINE.BEING.INPUT W) (SKED.EXTEND.SELECTION W)) ((LASTMOUSESTATE MIDDLE) (* add a point to the current line) (WB.ADD.NEW.POINT W]) (WB.ADD.NEW.POINT [LAMBDA (WIN) (* rrb " 2-Oct-85 10:00") (* tracks the cursor with a point cursor drawing a rubberband line until the cursor is let up. Nothing happens if cursor goes outside. Adds line segment to the currently being built line.) (PROG ((LINEPTS (WINDOWPROP WIN (QUOTE INPUTLINE))) PT ELT) (* INPUTLINE are the points on the curve being input in most recently added first.) (COND [(NULL LINEPTS) (* this is the first point being put down;) (COND ((SETQ PT (GETSKWPOSITION WIN POINTREADINGCURSOR T)) (* put the local wire element on the property list so that it can be added to.) (WINDOWPROP WIN (QUOTE INPUTLINE) PT] [(type? INPUTPT LINEPTS) (* this is the second point being put down, make a line for it) (COND ((SETQ PT (WB.RUBBERBAND.POSITION (fetch (INPUTPT INPUT.POSITION) of LINEPTS) WIN)) (* read the second point of the line on the upclick and make a sketch element) (SETQ ELT (SKETCH.ADD.AND.DISPLAY (WIRE.INPUTFN WIN (LIST (SK.MAP.INPUT.PT.TO.GLOBAL LINEPTS WIN) (SK.MAP.INPUT.PT.TO.GLOBAL PT WIN))) WIN T)) (WINDOWPROP WIN (QUOTE INPUTLINE) (COND ((fetch (SKETCHCONTEXT SKETCHLINEMODE) of (WINDOWPROP WIN (QUOTE SKETCHCONTEXT))) (* T indicates two point default. Start a new line.) NIL) (T (* put the local wire element on the property list so that it can be added to.) ELT] ((type? WIRE (fetch (SCREENELT INDIVIDUALGLOBALPART) of LINEPTS)) (* add this point to all this sketch.) (COND ((SETQ PT (WB.RUBBERBAND.POSITION [CAR (LAST (fetch KNOTS of (fetch (SCREENELT LOCALPART) of LINEPTS] WIN)) (WINDOWPROP WIN (QUOTE INPUTLINE) (WIRE.ADD.POINT.TO.END LINEPTS PT WIN]) (WB.DRAWLINE [LAMBDA (WIREELT STREAM REG OPERATION CLOSEDFLG DASHING BRUSH) (* rrb " 5-Jun-85 11:30") (* draws a line from its white board element.) (PROG ((LWIRE (fetch (SCREENELT LOCALPART) of WIREELT)) (GWIRE (fetch (SCREENELT INDIVIDUALGLOBALPART) of WIREELT)) BRUSHSIZE PTS (BRUSHCOLOR (fetch (BRUSH BRUSHCOLOR) of BRUSH))) (SETQ BRUSHSIZE (IMAX (FIXR (fetch (BRUSH BRUSHSIZE) of BRUSH)) 1)) (COND ((SETQ PTS (fetch (LOCALWIRE KNOTS) of LWIRE)) (COND [(NEQ (fetch (BRUSH BRUSHSHAPE) of BRUSH) (QUOTE ROUND)) (* use the slower curve drawing method that handles brushes) (for PTTAIL on PTS while (CDR PTTAIL) do (DRAWCURVE (LIST (CAR PTTAIL) (CADR PTTAIL)) NIL BRUSH DASHING STREAM) finally (COND (CLOSEDFLG (* if closed, finish with a line back to the origin.) (DRAWCURVE (LIST (CAR PTTAIL) (CAR PTS)) NIL BRUSH DASHING STREAM)) (T (* if not closed, check for arrowheads.) (DRAWARROWHEADS (fetch (WIRE WIREARROWHEADS) of GWIRE) (fetch (LOCALWIRE ARROWHEADPTS) of LWIRE) STREAM BRUSH OPERATION] (T (OR (EQ BRUSHSIZE 1) (DRAWCURVE (LIST (CAR PTS)) NIL BRUSH NIL STREAM)) (for PTTAIL on PTS while (CDR PTTAIL) do (DRAWLINE (fetch (POSITION XCOORD) of (CAR PTTAIL)) (fetch (POSITION YCOORD) of (CAR PTTAIL)) (fetch (POSITION XCOORD) of (CADR PTTAIL)) (fetch (POSITION YCOORD) of (CADR PTTAIL)) BRUSHSIZE OPERATION STREAM BRUSHCOLOR DASHING) (* put a round shape at each intersection point.) (OR (EQ BRUSHSIZE 1) (DRAWCURVE (LIST (CADR PTTAIL)) NIL BRUSH NIL STREAM)) finally (COND (CLOSEDFLG (* if closed, finish with a line back to the origin.) (DRAWLINE (fetch (POSITION XCOORD) of (CAR PTTAIL)) (fetch (POSITION YCOORD) of (CAR PTTAIL)) (fetch (POSITION XCOORD) of (CAR PTS)) (fetch (POSITION YCOORD) of (CAR PTS)) BRUSHSIZE OPERATION STREAM BRUSHCOLOR DASHING)) (T (* if not closed, check for arrowheads.) (DRAWARROWHEADS (fetch (WIRE WIREARROWHEADS) of GWIRE) (fetch (LOCALWIRE ARROWHEADPTS) of LWIRE) STREAM BRUSH OPERATION]) (WB.RUBBERBAND.POSITION [LAMBDA (STARTPOSITION WINDOW) (* rrb " 4-Sep-85 15:59") (* gets the other end of a line via a rubberband prompting) (PROG ((X0 (fetch (POSITION XCOORD) of STARTPOSITION)) (Y0 (fetch (POSITION YCOORD) of STARTPOSITION)) (DS (WINDOWPROP WINDOW (QUOTE DSP))) (USEGRID (WINDOWPROP WINDOW (QUOTE USEGRID))) (GRID (SK.GRIDFACTOR WINDOW)) (SCALE (WINDOW.SCALE WINDOW)) [CURRENTWBBRUSHSIZE (TIMES [fetch (BRUSH BRUSHSIZE) of (fetch (SKETCHCONTEXT SKETCHBRUSH) of (WINDOWPROP WINDOW (QUOTE SKETCHCONTEXT] (QUOTIENT (SK.INPUT.SCALE WINDOW) (WINDOW.SCALE WINDOW] X1 Y1 NEW.X1 NEW.Y1 XGRID YGRID DONE DOWN REGION ONGRID?) (SETQ REGION (DSPCLIPPINGREGION NIL DS)) [until DONE do ((GETMOUSESTATE) (COND ((AND (NOT DOWN) (LASTMOUSESTATE (NOT UP))) (* not down, wait for it to go down.) (SETQ DOWN T))) [COND [(INSIDEP REGION (SETQ NEW.X1 (LASTMOUSEX DS)) (SETQ NEW.Y1 (LASTMOUSEY DS))) (* if down, save point.) (AND DOWN (COND ((OR (NEQ X1 NEW.X1) (NEQ Y1 NEW.Y1)) (SKETCHW.UPDATE.LOCATORS WINDOW) (SETQ X1 NEW.X1) (SETQ Y1 NEW.Y1) [COND ((SETQ ONGRID? (COND ((LASTMOUSESTATE RIGHT) (* if right is down, flip sense of using grid) (NOT USEGRID)) (T (* otherwise use the grid if told to.) USEGRID))) (* set on grid if one is being used.) (SETQ NEW.X1 (MAP.WINDOW.ONTO.GRID NEW.X1 SCALE GRID)) (SETQ NEW.Y1 (MAP.WINDOW.ONTO.GRID NEW.Y1 SCALE GRID] (COND ((OR (NEQ XGRID NEW.X1) (NEQ YGRID NEW.Y1)) (COND (XGRID (DRAWLINE X0 Y0 XGRID YGRID CURRENTWBBRUSHSIZE (QUOTE INVERT) DS))) (SETQ XGRID NEW.X1) (SETQ YGRID NEW.Y1) (DRAWLINE X0 Y0 XGRID YGRID CURRENTWBBRUSHSIZE (QUOTE INVERT) DS] (T (* cursor moved out, (keep control but remove line.)) (COND (XGRID (DRAWLINE X0 Y0 XGRID YGRID CURRENTWBBRUSHSIZE (QUOTE INVERT) DS) (SETQ XGRID NIL] (AND DOWN (COND ((LASTMOUSESTATE UP) (* button is up now and has been down; return the position.) (SETQ DONE T)) ((LASTMOUSESTATE (NOT (OR MIDDLE RIGHT))) (* anything other than middle or right means abort.) (SETQ DONE NIL) (RETURN] (COND (XGRID (DRAWLINE X0 Y0 XGRID YGRID CURRENTWBBRUSHSIZE (QUOTE INVERT) DS))) (RETURN (COND ((AND DONE XGRID) (create INPUTPT INPUT.ONGRID? ← ONGRID? INPUT.POSITION ←(create POSITION XCOORD ← XGRID YCOORD ← YGRID]) (RESET.LINE.BEING.INPUT [LAMBDA (SKW) (* rrb "31-MAR-83 18:03") (* resets the line that is being input by the user.) (WINDOWPROP SKW (QUOTE INPUTLINE) NIL]) ) (DEFINEQ (NEAREST.EXISTING.POSITION [LAMBDA (SKW) (* returns the existing position of skw that is closed to the lastmouse x and y.) (LASTMOUSEPOSITION SKW]) (WB.NEARPT [LAMBDA (TARGETPT HITPT) (* rrb " 4-MAR-83 16:22") (* returns T if HITPT is "near" TARGETPT.) (PROG ((TX (fetch (POSITION XCOORD) of TARGETPT)) (TY (fetch (POSITION YCOORD) of TARGETPT)) (HX (fetch (POSITION XCOORD) of HITPT)) (HY (fetch (POSITION YCOORD) of HITPT)) (WB.POINT.WIDTH 4)) (RETURN (AND (IGREATERP HX (IDIFFERENCE TX WB.POINT.WIDTH)) (IGREATERP (IPLUS TX WB.POINT.WIDTH) HX) (IGREATERP HY (IDIFFERENCE TY WB.POINT.WIDTH)) (IGREATERP (IPLUS TY WB.POINT.WIDTH) HY]) (LASTMOUSEPOSITION [LAMBDA (WIN) (create POSITION XCOORD ←(LASTMOUSEX WIN) YCOORD ←(LASTMOUSEY WIN]) ) (PUTPROPS SKETCHEDIT COPYRIGHT ("Xerox Corporation" 1983 1984 1985)) (DECLARE: DONTCOPY (FILEMAP (NIL (1853 28290 (BUTLAST 1863 . 2238) (CHAR.BEGIN 2240 . 3893) (CLOSEST.CHAR 3895 . 6727) ( CLOSEST.LINE 6729 . 7416) (FLASHW 7418 . 7575) (HILITE.LINE 7577 . 8301) (HILITE.TEXT 8303 . 9769) ( IN.TEXT.EXTEND 9771 . 12168) (INIMAGEOBJ 12170 . 12585) (INTEXT 12587 . 13022) (NEW.TEXT.EXTEND 13024 . 14232) (NEW.TEXT.SELECTIONP 14234 . 14448) (NTHCHARWIDTH 14450 . 14756) (NTHLOCALREGION 14758 . 14993) (ONCHAR 14995 . 15483) (SHOW.EXTENDED.SELECTION.FEEDBACK 15485 . 16350) (SHOW.FEEDBACK 16352 . 16867) (SHOW.FEEDBACK.BOX 16869 . 17733) (SELECTION.POSITION 17735 . 18368) (SKED.CLEAR.SELECTION 18370 . 18820) (SKED.REMOVE.OTHER.SELECTIONS 18822 . 19260) (SKED.EXTEND.SELECTION 19262 . 20709) ( SKED.MOVE.SELECTION 20711 . 24322) (CREATE.TEXT.SELECTION 24324 . 24861) (SKED.SELECTION.FEEDBACK 24863 . 26369) (SKED.SET.EXTENDSELECTION 26371 . 26748) (SKED.SET.SELECTION 26750 . 27238) (LINE.BEGIN 27240 . 27667) (SELECTION.GREATERP 27669 . 28288)) (29009 54644 (WB.EDITOR 29019 . 30239) ( SK.TTYENTRYFN 30241 . 30592) (SK.TTYEXITFN 30594 . 30932) (SKED.INSERT 30934 . 39613) ( SKED.CREATE.NEW.TEXTBOX 39615 . 42975) (SKED.CHARACTERPOSITION 42977 . 43786) (SKED.LINE.AND.CHAR# 43788 . 45286) (\SKED.DELETE.WORD.FROM.STRING 45288 . 46367) (\SKED.INSERT.CHARS.TO.STR 46369 . 52205) (JOINCHARS 52207 . 52634) (STRINGFROMCHARACTERS 52636 . 52899) (GETALLCHARS 52901 . 53287) ( CLEANUP.EDIT 53289 . 53713) (SKED.NEW.TEXTELT 53715 . 54642)) (54679 70697 ( MAP.SCREEN.POSITION.ONTO.GRID 54689 . 55994) (NEAREST.ON.GRID 55996 . 56515) (SK.MIDDLE.TITLEFN 56517 . 58259) (WB.BUTTON.HANDLER 58261 . 61226) (WB.ADD.NEW.POINT 61228 . 63767) (WB.DRAWLINE 63769 . 66774) (WB.RUBBERBAND.POSITION 66776 . 70403) (RESET.LINE.BEING.INPUT 70405 . 70695)) (70698 71834 ( NEAREST.EXISTING.POSITION 70708 . 70935) (WB.NEARPT 70937 . 71698) (LASTMOUSEPOSITION 71700 . 71832))) )) STOP