(FILECREATED "11-Dec-85 11:06:31" {PHYLUM}<PAPERWORKS>SKETCHEDIT.;93 80114
changes to: (FNS SKED.INSERT SKETCH.CLEANUP WB.BUTTON.HANDLER SK.ENTER.EDIT.CHANGE
\SKED.INSERT.CHARS.TO.STR)
(VARS SKETCHEDITCOMS)
previous date: " 5-Dec-85 18:31:35" {PHYLUM}<PAPERWORKS>SKETCHEDIT.;87)
(* 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 SKETCH.CLEANUP
SK.ENTER.EDIT.CHANGE 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 DONTMAKEHISTEVENTFLG) (* rrb " 5-Dec-85 14:30")
(* clears the selection and removes it from the
display.)
(OR DONTMAKEHISTEVENTFLG (SKETCH.CLEANUP SKW))
(COND
((OR DONTDISPLAYFLG (SKED.SELECTION.FEEDBACK SKW))
(WINDOWPROP SKW (QUOTE SELECTION)
NIL)
(WINDOWPROP SKW (QUOTE EXTENDSELECTION)
NIL])
(SKETCH.CLEANUP
[LAMBDA (SKETCHWINDOW) (* rrb "10-Dec-85 14:26")
(* finishes up the currently being edited element.)
(PROG (INITSELECTION NEWELT)
(COND
((NOT (WINDOWP SKETCHWINDOW)) (* only one of the viewers should have any changes but
do this in lieu of figuring out which one.)
(for VIEWER in (ALL.SKETCH.VIEWERS (INSURE.SKETCH SKETCHWINDOW))
do (SKETCH.CLEANUP VIEWER)))
((SETQ INITSELECTION (WINDOWPROP SKETCHWINDOW (QUOTE CHANGEDTEXTELT)
NIL)) (* also checks to see if the current selection was
edited and makes a history event if necessary.)
[SETQ NEWELT (fetch (SCREENELT GLOBALPART)
of (fetch (TEXTELTSELECTION SKTEXTELT)
of (OR (WINDOWPROP SKETCHWINDOW (QUOTE SELECTION))
(ERROR "NO SELECTION WHEN THERE SHOULD BE"]
(COND
((POSITIONP INITSELECTION) (* add an ADD event because previously there was
nothing here.)
(SK.ADD.HISTEVENT (QUOTE ADD)
(LIST NEWELT)
SKETCHWINDOW)
(SK.CHECK.WHENEDITEDFN SKETCHWINDOW NIL NEWELT))
(T (SK.ENTER.EDIT.CHANGE SKETCHWINDOW (fetch (SCREENELT GLOBALPART)
of (fetch (TEXTELTSELECTION
SKTEXTELT)
of INITSELECTION))
NEWELT])
(SK.ENTER.EDIT.CHANGE
[LAMBDA (VIEWER OLDELT NEWELT) (* rrb " 9-Dec-85 15:54")
(* adds a history event for the change operation that occurs at the end of a series of edits and calls the when
edited function.)
(SK.CHECK.WHENEDITEDFN VIEWER OLDELT NEWELT)
(SK.ADD.HISTEVENT (QUOTE CHANGE)
(LIST (LIST OLDELT NEWELT))
VIEWER])
(SKED.REMOVE.OTHER.SELECTIONS
[LAMBDA (SKW) (* rrb " 5-Dec-85 12:12")
(* 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))
when (NEQ SKETCHWINDOW 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 " 5-Dec-85 11:16")
(* 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
([AND (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)))
(NOT (SK.ELEMENT.PROTECTED? (fetch (SCREENELT GLOBALPART)
of INTEXT)
(QUOTE CHANGE]
(* 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 "10-Dec-85 15:40")
(* 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
((EQ (TEDIT.GETSYNTAX (CAR CHARCODES)
TEDIT.READTABLE)
(QUOTE UNDO)) (* user typed an undo Avoid the overhead of inserting
no characters and allow undo to be typed without a
selection.)
(SETQ CONTROLCHARTAIL (QUOTE UNDO))
(GO UNDO)))
(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.CLEAR.SELECTION SKW NIL T)
(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 NIL SKW))
(COND
((OR NEWSTRS STRPIECE) (* if there are any new characters, add a new text
element.)
(* save the selection that marked the spot where the new text goes and add the text but not in a way that puts an
event on the history list. this is done during clean up.)
(WINDOWPROP SKW (QUOTE CHANGEDTEXTELT)
SELECTION)
(SETQ NEWELT (SK.ADD.ELEMENT (CREATE.TEXT.ELEMENT
(SETQ NEWSTRS (NCONC1 NEWSTRS STRPIECE))
(SK.MAP.INPUT.PT.TO.GLOBAL
(create INPUTPT
INPUT.ONGRID? ← NIL
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)
(fetch (BRUSH BRUSHCOLOR)
of (fetch (SKETCHCONTEXT SKETCHBRUSH)
of SKCONTEXT)))
SKW T)))
(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]
[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))
SKW))
(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)
(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.)
(COND
[(WINDOWPROP SKW (QUOTE CHANGEDTEXTELT))
(* make the history event for this edit so that it
will restore the original text element)
(PROG ((INITSELECTION (WINDOWPROP SKW (QUOTE CHANGEDTEXTELT)
NIL)))
(COND
((POSITIONP INITSELECTION)
(* this text element was typing that was never
officially added, don't record the deletion either.)
(SK.DELETE.ELEMENT (LIST TEXTELT)
SKW
(QUOTE DON'T)))
(T (* selection was existing text, record this as a
delete event.)
(SK.DELETE.ELEMENT (LIST TEXTELT)
SKW
(LIST (fetch (SCREENELT GLOBALPART)
of (fetch (
TEXTELTSELECTION SKTEXTELT) of INITSELECTION]
(T (SK.DELETE.ELEMENT (LIST TEXTELT)
SKW)))
(SKED.SET.SELECTION (SK.SCALE.POSITION.INTO.VIEWER
(fetch (TEXT LOCATIONLATLON)
of (fetch (SCREENELT INDIVIDUALGLOBALPART)
of TEXTELT))
(WINDOW.SCALE SKW))
SKW)
(RETURN NIL)))
(SETQ NEWCHAR# (NCHARS (CAR (LAST NEWSTRS]
(SETQ PTRCHAR# (SKED.CHARACTERPOSITION NEWSTRS NEWLINE# NEWCHAR#))
(COND
((WINDOWPROP SKW (QUOTE CHANGEDTEXTELT))
(* this is not the first change to the text element. Collect the changes so that only one element is put on the
undo stack, not one for each character.)
(SETQ NEWELT (SK.UPDATE.ELEMENT (fetch (SCREENELT GLOBALPART)
of TEXTELT)
(SK.REPLACE.TEXT.IN.ELEMENT
(fetch (SCREENELT GLOBALPART)
of TEXTELT)
NEWSTRS)
SKW T)))
(T
(* this is the first edit change to a new element, call the PREEDITFN and save old text element so undo event can
be constructed when the selection changes.)
(OR (SK.CHECK.PREEDITFN SKW (fetch (SCREENELT GLOBALPART) of TEXTELT))
(RETURN NIL))
(SETQ NEWELT (SK.UPDATE.ELEMENT (fetch (SCREENELT GLOBALPART)
of TEXTELT)
(SKED.NEW.TEXTELT (fetch (SCREENELT
GLOBALPART)
of TEXTELT)
NEWSTRS)
SKW))
(WINDOWPROP SKW (QUOTE CHANGEDTEXTELT)
SELECTION))) (* 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#]
UNDO(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))
[(EQ CONTROLCHARTAIL (QUOTE UNDO)) (* user types in an undo after some characters or
while selection was in the middle of text.)
(PROG (INITSELECTION EDITEDELT)
(COND
((SETQ INITSELECTION (WINDOWPROP SKW (QUOTE CHANGEDTEXTELT)
NIL))
(* in the middle of editing, undo these edits.)
[SETQ EDITEDELT (fetch (SCREENELT GLOBALPART)
of (OR NEWELT (fetch (TEXTELTSELECTION
SKTEXTELT)
of (OR SELECTION
(ERROR
"NO SELECTION WHEN THERE SHOULD BE"]
(* add event to history list so the undo can be
undone.)
(COND
((POSITIONP INITSELECTION) (* add an ADD event because previously there was
nothing here.)
(SK.ADD.HISTEVENT (QUOTE ADD)
(LIST EDITEDELT)
SKW)
(SK.CHECK.WHENEDITEDFN SKW NIL EDITEDELT))
(T (SK.ENTER.EDIT.CHANGE SKW (fetch (SCREENELT GLOBALPART)
of (fetch (TEXTELTSELECTION
SKTEXTELT)
of INITSELECTION))
EDITEDELT)))
(SK.UNDO.LAST SKW)
(SKED.SET.SELECTION INITSELECTION SKW))
(T (* haven't edited any characters in the current
element, just undo the last thing.)
(SK.UNDO.LAST 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 "16-Oct-85 17:56")
(* 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)
(fetch (TEXTBOX TEXTCOLOR) 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 SKW) (* rrb " 8-Dec-85 21:08")
(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 (* by side effect this flushes any characters typed
after the undo but it's not clear where they should go
anyway.)
(RETURN (QUOTE UNDO)))
((REDO FN CMD)
(STATUSPRINT SKW "
" "Not implemented in this editor. Sorry."))
(COND
[(OR (EQ CHAR (CHARCODE EOL))
(EQ CHAR (CHARCODE LINEFEED)))
(* eol)
(COND
((KEYDOWNP (QUOTE CTRL))
(* user entered control return, save remaining
characters and return indicator)
(SETQ REMAININGCHARS (MEMB CHAR CHARCODES))
(RETURN))
(T (SETQ LINELST (CONS (COND
(INCLUDECR
(* text boxes need to have the CRs left in.)
(CONS (CHARCODE
EOL)
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 " 9-Dec-85 17:05")
(* handles a button event in a whiteboard window.)
(TOTOPW W)
(PROG (ACTIVEREGION BUTTONFN 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))
(for ELT in (LOCALSPECS.FROM.VIEWER W)
do
(COND
((AND (SETQ ACTIVEREGION (fetch (SCREENELT LOCALHOTREGION)
of ELT))
(SETQ BUTTONFN (GETSKETCHPROP W (QUOTE BUTTONEVENTINFN)))
(INSIDEP ACTIVEREGION X Y))
(* look for an element with a hot region. This is done before the image object region so that the image objects
function can be overridden.)
(* inside of the hot region for an element with a
button event fn.)
(APPLY* BUTTONFN W (fetch (SCREENELT GLOBALPART) of ELT))
(RETURN T))
((AND (type? SKIMAGEOBJ (fetch (SCREENELT INDIVIDUALGLOBALPART)
of ELT))
(INIMAGEOBJ ELT X Y)) (* 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 ELT))
(DSPCLIPPINGREGION NIL W))
W)
W))
(APPLY* [fetch (IMAGEFNS BUTTONEVENTINFN)
of (fetch (IMAGEOBJ IMAGEOBJFNS)
of (SETQ X
(fetch (SKIMAGEOBJ SKIMAGEOBJ)
of (fetch (SCREENELT
INDIVIDUALGLOBALPART)
of ELT]
X W))
(QUOTE CHANGED)) (* element changed, update the local fields and
redisplay it.)
(SKETCH.ELEMENT.CHANGED W (fetch (SCREENELT GLOBALPART)
of ELT)
W)))
(* exit loop)
(RETURN T]
[(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 (2016 30894 (BUTLAST 2026 . 2401) (CHAR.BEGIN 2403 . 4047) (CLOSEST.CHAR 4049 . 7007) (
CLOSEST.LINE 7009 . 7704) (FLASHW 7706 . 7863) (HILITE.LINE 7865 . 8589) (HILITE.TEXT 8591 . 10057) (
IN.TEXT.EXTEND 10059 . 12456) (INIMAGEOBJ 12458 . 12878) (INTEXT 12880 . 13324) (NEW.TEXT.EXTEND 13326
. 14534) (NEW.TEXT.SELECTIONP 14536 . 14750) (NTHCHARWIDTH 14752 . 15058) (NTHLOCALREGION 15060 .
15292) (ONCHAR 15294 . 15782) (SHOW.EXTENDED.SELECTION.FEEDBACK 15784 . 16649) (SHOW.FEEDBACK 16651 .
17166) (SHOW.FEEDBACK.BOX 17168 . 18032) (SELECTION.POSITION 18034 . 18667) (SKED.CLEAR.SELECTION
18669 . 19182) (SKETCH.CLEANUP 19184 . 20728) (SK.ENTER.EDIT.CHANGE 20730 . 21150) (
SKED.REMOVE.OTHER.SELECTIONS 21152 . 21628) (SKED.EXTEND.SELECTION 21630 . 23077) (SKED.MOVE.SELECTION
23079 . 26930) (CREATE.TEXT.SELECTION 26932 . 27469) (SKED.SELECTION.FEEDBACK 27471 . 28977) (
SKED.SET.EXTENDSELECTION 28979 . 29356) (SKED.SET.SELECTION 29358 . 29846) (LINE.BEGIN 29848 . 30271)
(SELECTION.GREATERP 30273 . 30892)) (31613 62078 (WB.EDITOR 31623 . 32843) (SK.TTYENTRYFN 32845 .
33196) (SK.TTYEXITFN 33198 . 33536) (SKED.INSERT 33538 . 46465) (SKED.CREATE.NEW.TEXTBOX 46467 . 49857
) (SKED.CHARACTERPOSITION 49859 . 50668) (SKED.LINE.AND.CHAR# 50670 . 52168) (
\SKED.DELETE.WORD.FROM.STRING 52170 . 53249) (\SKED.INSERT.CHARS.TO.STR 53251 . 59596) (JOINCHARS
59598 . 60025) (STRINGFROMCHARACTERS 60027 . 60290) (GETALLCHARS 60292 . 60678) (CLEANUP.EDIT 60680 .
61104) (SKED.NEW.TEXTELT 61106 . 62076)) (62113 78886 (MAP.SCREEN.POSITION.ONTO.GRID 62123 . 63428) (
NEAREST.ON.GRID 63430 . 63949) (SK.MIDDLE.TITLEFN 63951 . 65693) (WB.BUTTON.HANDLER 65695 . 69264) (
WB.ADD.NEW.POINT 69266 . 71890) (WB.DRAWLINE 71892 . 74963) (WB.RUBBERBAND.POSITION 74965 . 78592) (
RESET.LINE.BEING.INPUT 78594 . 78884)) (78887 80023 (NEAREST.EXISTING.POSITION 78897 . 79124) (
WB.NEARPT 79126 . 79887) (LASTMOUSEPOSITION 79889 . 80021)))))
STOP