(FILECREATED " 3-Dec-84 22:12:35" {ERIS}<LISPCORE>SOURCES>DSPRINTDEF.;7 33223
changes to: (FNS REPPTANGLEDP ADJUSTXTAIL ADJUSTYTAIL)
previous date: "30-Sep-84 14:21:32" {ERIS}<LISPCORE>SOURCES>DSPRINTDEF.;6)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DSPRINTDEFCOMS)
(RPAQQ DSPRINTDEFCOMS ([COMS (* NEWPRINTDEF primitives for a display that maintains a map as it PPs)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS ADJXPOS BLANKS WIDTH XPOSITION
YPOSITION)
(GLOBALVARS PPDSP \DEDITDSPS \DSPRINTBP \DEDITMEHASH
\DEDITDPHASH \DEDITFONT# \DEDITFONTS)
(CONSTANTS DOTSTRING)
(FILES (LOADCOMP)
NEWPRINTDEF))
(FNS PRINOPEN PRINSHUT PRIN1S PRIN2S PRINENDLINE PRINDOTP SETFONT
MAKEMAPENTRY DSPDSFOR MAKEDOTPTAIL)
(FNS RESETDEF TTYPRINOPEN TTYPRINSHUT TTYPRIN1S TTYPRIN2S TTYENDLINE)
(DECLARE: DONTCOPY (RECORDS DEDITMAP))
(INITRECORDS DEDITMAP)
(FNS SHOWDEDITMAP)
(P (DEFPRINT (QUOTE DEDITMAP)
(QUOTE SHOWDEDITMAP]
(COMS (* DEDIT entry and incremental reprettyprinting)
(FNS DEPRINTDEF)
(FNS REPP REPPCHANGES REPPUNRAVEL REPPDELETE REPPINSERT REPPTANGLEDP
LEADSPACE SPACINGRULE UNPP NXTUSEDX ONELINEP)
(FNS MOVEDSMAP ADJUSTXTAIL ADJUSTYTAIL ADJDEEXTENT DSLINEFONT
DSLINEFONT1 MAXFONT)
(FNS REFRESHIF REFRESHIF1)
(FNS COMMENTP HIPT LOWPT WIPE)
(FNS RESETCLIP))))
(* NEWPRINTDEF primitives for a display that maintains a map as it PPs)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS ADJXPOS MACRO [(DX)
(XPOSITION (IPLUS DX (XPOSITION])
(PUTPROPS BLANKS MACRO ((N)
(ITIMES N SPACESIZE)))
(PUTPROPS WIDTH MACRO ((STR FNT P2FLG)
(STRINGWIDTH STR (OR FNT PPDSP)
P2FLG)))
(PUTPROPS XPOSITION MACRO [ARGS (COND
[(CAR ARGS)
(BQUOTE (PROG1 (fetch DDXPOSITION of (fetch IMAGEDATA
of PPDSP))
(replace DDXPOSITION of (fetch IMAGEDATA
of PPDSP)
with , (CAR ARGS]
(T (QUOTE (fetch DDXPOSITION of (fetch IMAGEDATA of PPDSP])
(PUTPROPS YPOSITION MACRO [ARGS (COND
[(CAR ARGS)
(BQUOTE (PROG1 (fetch DDYPOSITION of (fetch IMAGEDATA
of PPDSP))
(replace DDYPOSITION of (fetch IMAGEDATA
of PPDSP)
with , (CAR ARGS]
(T (QUOTE (fetch DDYPOSITION of (fetch IMAGEDATA of PPDSP])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PPDSP \DEDITDSPS \DSPRINTBP \DEDITMEHASH \DEDITDPHASH \DEDITFONT# \DEDITFONTS)
)
(DECLARE: EVAL@COMPILE
(RPAQQ DOTSTRING " . ")
(CONSTANTS DOTSTRING)
)
(FILESLOAD (LOADCOMP)
NEWPRINTDEF)
)
(DEFINEQ
(PRINOPEN
[LAMBDA (TAIL PAREN) (* bas: "18-Mar-84 21:23")
(SETQ \DSPRINTBP (MAKEMAPENTRY TAIL \DSPRINTBP (XPOSITION)
(YPOSITION)
0 0 \DEDITFONT#))
(PRIN3 PAREN PPDSP])
(PRINSHUT
[LAMBDA (TAIL PAREN) (* bas: "12-Feb-84 21:25")
(AND PAREN (PRIN3 PAREN PPDSP))
(replace STOPX of \DSPRINTBP with (XPOSITION))
(replace STOPY of \DSPRINTBP with (YPOSITION))
(SETQ \DSPRINTBP (fetch BP of \DSPRINTBP])
(PRIN1S
[LAMBDA (STR TAIL) (* bas: "18-Mar-84 21:22")
(MAKEMAPENTRY TAIL \DSPRINTBP (XPOSITION)
(YPOSITION)
(PROGN (PRIN3 STR PPDSP)
(XPOSITION))
(YPOSITION)
\DEDITFONT#)
STR])
(PRIN2S
[LAMBDA (STR TAIL) (* bas: "18-Mar-84 21:23")
(MAKEMAPENTRY TAIL \DSPRINTBP (XPOSITION)
(YPOSITION)
(PROGN (PRIN4 STR PPDSP)
(XPOSITION))
(YPOSITION)
\DEDITFONT#)
STR])
(PRINENDLINE
[LAMBDA (L) (* bas: "15-NOV-82 20:38")
(MOVETO L (IPLUS (DSPYPOSITION NIL PPDSP)
(DSPLINEFEED NIL PPDSP))
PPDSP])
(PRINDOTP
[LAMBDA (V) (* bas: "18-Mar-84 21:10")
(PRIN3 DOTSTRING PPDSP) (* Prints CDR of a dotted pair.)
(PRIN2S V (MAKEDOTPTAIL V \DSPRINTBP])
(SETFONT
[LAMBDA (FONT) (* rmk: "12-Sep-84 22:55")
(* FONT can be a font, a number or a FONTCLASS.
Returns a display fontdescriptor.)
(if FONT
then (* if FONT is NIL, leave things alone.)
(PROG1 \DEDITFONT# (PROG [(NF (if (SMALLP FONT)
then (ffetch (FONTCLASS DISPLAYFD)
of (ELT \DEDITFONTS (SETQ \DEDITFONT# FONT)))
elseif (type? FONTCLASS FONT)
then (SETQ \DEDITFONT# (fetch (FONTCLASS PRETTYFONT#)
of FONT))
(ffetch (FONTCLASS DISPLAYFD) of FONT)
elseif (FONTP FONT)
then [SETQ \DEDITFONT#
(for I to (ARRAYSIZE \DEDITFONTS)
thereis (EQ FONT (fetch (FONTCLASS
PRETTYFONT#)
of (ELT \DEDITFONTS I]
FONT
else (SHOULDNT]
(SETQ SPACESIZE (CHARWIDTH (CHARCODE SPACE)
NF))
(DSPFONT NF PPDSP])
(MAKEMAPENTRY
[LAMBDA (TAIL BACK SX SY EX EY FONTN) (* bas: "18-Mar-84 21:24")
(* Used to check for existing hashlink and do something
fancy. Now should not happen except from dummy blocks.)
(PUTHASH TAIL
(create DEDITMAP
BP ← BACK
TAIL ← TAIL
STARTX ← SX
STARTY ← SY
STOPX ← EX
STOPY ← EY
D# ←(if BACK
then (fetch D# of BACK)
else (DSPDSFOR PPDSP))
F# ← FONTN)
\DEDITMEHASH])
(DSPDSFOR
[LAMBDA (DS) (* bas: "17-Mar-84 13:35")
(PROG [(V (OR [for I to (ARRAYSIZE \DEDITDSPS) thereis (OR (NOT (DISPLAYSTREAMP (ELT \DEDITDSPS I)
))
(EQ DS (ELT \DEDITDSPS I]
(bind [NU ←(ARRAY (ITIMES 2 (ARRAYSIZE \DEDITDSPS] for J to (ARRAYSIZE \DEDITDSPS)
do (SETA NU J (ELT \DEDITDSPS J))
finally (SETQ \DEDITDSPS NU)
(RETURN J]
(SETA \DEDITDSPS V DS)
(RETURN V])
(MAKEDOTPTAIL
[LAMBDA (V B) (* bas: "18-Mar-84 21:10")
(* DPs have map entries keyed off a dummy CONS which is found by a hash link off the parent CONS thru the
\DEDITDPHASH array. Done this way so we have a CONS to push on the selection stack which makes most of the
changing functions transparent and which can be found quickly and repeatably. Usually we do not have the DP cons
itself in hand, hence use of the parent CONS.)
(* If there is a dummy CONS for the DP, we must preserve it because it may be being used as a key e.g. from the
selection stack. But we must also ensure that it has the right contents, namely V)
(PUTHASH (fetch TAIL of B)
(RPLNODE (OR (GETHASH (fetch TAIL of B)
\DEDITDPHASH)
(CONS))
V V)
\DEDITDPHASH])
)
(DEFINEQ
(RESETDEF
[LAMBDA (C D) (* bas: "17-NOV-82 11:29")
(if (LISTP C)
then (SETQ D (CADR C))
(SETQ C (CAR C)))
(if (LITATOM D)
then (SETQ D (GETD D)))
(PROG1 (LIST C (GETD C))
(PUTD C D T])
(TTYPRINOPEN
[LAMBDA (TAIL PAREN) (* bas: "15-NOV-82 20:48")
(PRIN3 PAREN PPDSP])
(TTYPRINSHUT
[LAMBDA (TAIL PAREN) (* bas: "15-NOV-82 20:48")
(AND PAREN (PRIN3 PAREN PPDSP])
(TTYPRIN1S
[LAMBDA (STR TAIL) (* bas: "15-NOV-82 20:49")
(PRIN3 STR PPDSP])
(TTYPRIN2S
[LAMBDA (STR TAIL) (* bas: "15-NOV-82 20:49")
(PRIN4 STR PPDSP])
(TTYENDLINE
[LAMBDA (L) (* bas: "24-NOV-82 17:34")
(TERPRI PPDSP)
(XPOSITION L])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE DEDITMAP ((D# BYTE)
TAIL
(F# BYTE)
BP
(STARTX WORD)
(STOPX WORD)
(STARTY WORD)
(STOPY WORD))
[ACCESSFNS ((FNT (ELT \DEDITFONTS (fetch F# of DATUM)))
(PDSP (ELT \DEDITDSPS (fetch D# of DATUM)))
(SELEXP (CAR (fetch TAIL of DATUM)))
[LPEND (IPLUS (fetch STARTX of DATUM)
(CHARWIDTH (CHARCODE %()
(fetch FNT of DATUM]
(RPSTART (IDIFFERENCE (fetch STOPX of DATUM)
(CHARWIDTH (CHARCODE %))
(fetch FNT of DATUM])
]
(/DECLAREDATATYPE (QUOTE DEDITMAP)
(QUOTE (BYTE POINTER BYTE POINTER WORD WORD WORD WORD)))
)
(/DECLAREDATATYPE (QUOTE DEDITMAP)
(QUOTE (BYTE POINTER BYTE POINTER WORD WORD WORD WORD)))
(DEFINEQ
(SHOWDEDITMAP
[LAMBDA (ME) (* bas: " 8-Mar-84 13:11")
(CONS [APPLY (QUOTE CONCAT)
(APPEND (LIST "{")
[bind V TL (Q ←(CAR (fetch TAIL of ME))) while (LISTP Q)
do (push V "(")
(push TL (if (CDR Q)
then (QUOTE " --)")
else ")"))
(SETQ Q (CAR Q))
finally (RETURN (if V
then (APPEND V (CONS Q TL))
else (LIST Q]
(LIST " @ " (CONCAT "<" (fetch STARTX of ME)
","
(fetch STARTY of ME)
" - "
(fetch STOPX of ME)
","
(fetch STOPY of ME)
">"))
(LIST (if (UNPURGEDP ME)
then "}"
else " PURGED}"]
(PACK])
)
(DEFPRINT (QUOTE DEDITMAP)
(QUOTE SHOWDEDITMAP))
(* DEDIT entry and incremental reprettyprinting)
(DEFINEQ
(DEPRINTDEF
[LAMBDA (TAIL LEFT FONT FILE) (* bas: "12-Apr-84 23:37")
(RESETVARS ((PPDSP FILE)
(\DSPRINTBP NIL)
(PRETTYPRINTMACROS NIL)
(**COMMENT**FLG NIL)
(#RPARS NIL))
(SETQ \DEDITFONTS (FONTMAPARRAY NIL (QUOTE DISPLAY)))
(if (type? DEDITMAP TAIL)
then (SETQ \DSPRINTBP (fetch BP of TAIL))
(OR FILE (SETQ PPDSP (fetch PDSP of TAIL)))
[OR FONT (SETQ FONT (fetch FNT of (OR \DSPRINTBP TAIL]
(OR LEFT (SETQ LEFT (fetch STARTX of TAIL)))
(SETQ TAIL (fetch TAIL of TAIL)))
(PROG ((FIRSTPOS (DSPLEFTMARGIN NIL PPDSP))
[LASTPOS (IPLUS (DSPLEFTMARGIN NIL PPDSP)
(IDIFFERENCE (fetch WIDTH of (WINDOWPROP PPDSP (QUOTE REGION)))
(ITIMES 2 (WINDOWPROP PPDSP (QUOTE BORDER]
COMMENTCOL FNSLST TAILFLG FILEFLG CHANGEFLG (FORMFLG T))
(SETFONT FONT)
(XPOSITION LEFT)
(SUPERPRINT (CAR TAIL)
TAIL)))
(GETME4 TAIL T])
)
(DEFINEQ
(REPP
[LAMBDA (ENT) (* bas: "30-Sep-84 13:07")
(bind OLDE
do (SETQ OLDE ENT) (* Save current value)
[if (fetch BP of ENT)
then (MOVETO (fetch STARTX of ENT)
(fetch STARTY of ENT)
(fetch PDSP of ENT))
(RESETFORM (RESETCLIP (CONS (fetch PDSP of ENT)
(UNPP ENT)))
(SETQ ENT (DEPRINTDEF ENT)))
else (RETURN (SETDEDITMAP (fetch PDSP of ENT)
(fetch TAIL of ENT]
repeatwhile (SETQ ENT (MOVEDSMAP ENT (fetch STOPX of OLDE)
(fetch STOPY of OLDE)
(fetch STOPX of ENT)
(fetch STOPY of ENT])
(REPPCHANGES
[LAMBDA (UL) (* bas: "12-Sep-84 13:57")
(for I
in (bind CL TEM for UE in (SETQ UL (REPPUNRAVEL UL))
when [AND (SETQ TEM (GETME4 (CAR UE)))
(PROG (SCR (BK (OR (fetch BP of TEM)
TEM))
(OLDCAR (CADR UE))
(OLDCDR (CDDR UE))
(NEWCAR (CAAR UE))
(NEWCDR (CDAR UE)))
(RETURN (if (NEQ (NLISTP NEWCAR)
(NLISTP OLDCAR))
then (SETQ TEM BK)
elseif (EQ NEWCDR OLDCDR)
then (NEQ OLDCAR NEWCAR)
elseif (REPPTANGLEDP (CAR UE)
UL)
then (SETQ TEM BK)
elseif (for I in CL thereis (DOMINATE? I TEM))
then (SETQ TEM BK)
else (OR (SELECTQ (SETQ SCR (REPPINSERT TEM OLDCDR NEWCDR))
(NIL NIL)
(T (SELECTQ (SETQ SCR (REPPDELETE TEM OLDCDR
NEWCDR))
(NIL NIL)
(T (SETQ TEM BK))
(SETQ TEM SCR)))
(SETQ TEM SCR))
(NEQ OLDCAR NEWCAR]
unless (for I in CL thereis (DOMINATE? I TEM)) do (push CL TEM) finally (RETURN CL))
when (UNPURGEDP I)
do (* Earlier elements of CL may dominate later ones.
If so, the latter will be purged by the former's REPP.)
(REPP I])
(REPPUNRAVEL
[LAMBDA (UL) (* bas: "25-JUL-82 21:05")
(* Reverses and unpacks LISPXHIST entries)
(PROG (RSLT)
LP (if (NULL UL)
then (RETURN RSLT)
elseif (EQ (QUOTE LISPXHIST)
(CAAR UL))
then [for I in (CDAR UL) do (if (LISTP (CAR I))
then (push RSLT I)
elseif (EQ (CAR I)
(QUOTE /RPLACA))
then (push RSLT (CONS (CADR I)
(CONS (CADDR I)
(CDADR I]
else (push RSLT (CAR UL)))
(SETQ UL (CDR UL))
(GO LP])
(REPPDELETE
[LAMBDA (ENT OCDR NCDR) (* bas: " 7-Mar-84 18:09")
(PROG ([EDGE (for I on OCDR thereis (EQ NCDR (CDR I]
NCE OCE SX SY)
(if (SETQ EDGE (GETME4 EDGE))
then (SETQ OCE (GETME4 OCDR T))
[AND NCDR (SETQ NCE (GETME4 NCDR (fetch BP of EDGE)))
(if (COMMENTP (CAR NCDR))
then (SETQ SX (fetch STARTX of NCE]
[bind IM for I on OCDR until (EQ I NCDR) when (SETQ IM (GETME4 I))
do (if (COMMENTP (CAR I))
then (UNPP IM)
else (if (COMMENTP (CAR NCDR))
then (UNPP IM))
(OR SX (SETQ SX (fetch STARTX of IM)))
(OR SY (SETQ SY (fetch STARTY of IM]
[RETURN (if NCDR
then [AND SX (DPCDRSEL NCE)
(add SX (WIDTH DOTSTRING (fetch FNT of NCE]
[MOVEDSMAP ENT (fetch STARTX of NCE)
(fetch STARTY of NCE)
(OR SX (fetch STARTX of NCE))
(OR SY (IDIFFERENCE (fetch STOPY of ENT)
(IDIFFERENCE (fetch STOPY
of EDGE)
(fetch STARTY
of NCE]
else (MOVEDSMAP ENT (fetch STOPX of EDGE)
(fetch STOPY of EDGE)
(fetch STOPX of ENT)
(fetch STOPY of ENT]
else (RETURN T])
(REPPINSERT
[LAMBDA (ENT OCDR NCDR) (* bas: " 7-MAR-83 09:31")
(if (AND (LISTP NCDR)
(OR (NULL OCDR)
(TAILP OCDR NCDR)))
then (PROG ((EDS (fetch PDSP of ENT))
(ALIGN (SPACINGRULE (fetch BP of ENT)))
(DELTAX (CHARWIDTH (CHARCODE SPACE)
(fetch FNT of ENT)))
(SX (fetch STOPX of ENT))
(SY (fetch STOPY of ENT))
NX NY TMP) (* Doesnt enter PROG unless its an insertion)
(SETQ ALIGN (if ALIGN
then (fetch STARTX of ALIGN)
else (IPLUS DELTAX SX)))
(RESETFORM (RESETCLIP (CONS EDS
(create REGION
LEFT ← SX
BOTTOM ← SY
WIDTH ← 0
HEIGHT ← 0)))
(MOVETO SX SY EDS)
(for E on NCDR until (EQ E OCDR) first (SETQ TMP ENT)
do (LEADSPACE E TMP ALIGN DELTAX EDS)
(SETQ TMP (DEPRINTDEF E (DSPXPOSITION NIL EDS)
(fetch FNT of (fetch BP of ENT))
EDS))
(replace BP of TMP with (fetch BP of ENT))
finally (LEADSPACE OCDR TMP ALIGN DELTAX EDS)))
(SETQ NX (DSPXPOSITION NIL EDS))
(SETQ NY (DSPYPOSITION NIL EDS))
[PROG (NSY (QV (GETME4 OCDR)))
(if QV
then (SETQ NSY (fetch STARTY of QV))
(SETQ SX (fetch STARTX of QV))
(if (ILESSP NSY SY)
then (REFRESHIF EDS (HIPT ENT)
(ADD1 (HIPT QV)))
(* Some action at the end of ENT's line?)
(SETQ SY NSY)
elseif (EQ NSY SY)
then (* Dont move if insert did not reach rest of line eg a
comment)
(SETQ NX (IMAX NX SX]
(RETURN (MOVEDSMAP TMP SX SY NX NY)))
else T])
(REPPTANGLEDP
[LAMBDA (E L) (* bas: " 3-Dec-84 21:45")
(* Can only handle one change per cell because of
cancelling changes or one CDR change per command lest
different CDR changes share elements)
(bind EC CCC for I in L when (GETME4 (CAR I))
do (if (NEQ E (CAR I))
elseif EC
then (RETURN T)
else (SETQ EC T))
(if (EQ (CDAR I)
(CDDR I))
elseif CCC
then (RETURN T)
else (SETQ CCC T])
(LEADSPACE
[LAMBDA (E PRV ALIGN DELTAX EDS) (* bas: " 3-DEC-82 18:40")
(if (NOT E)
elseif [AND (LISTP (CAR (fetch TAIL of PRV)))
(NOT (COMMENTP (CAR E]
then (MOVETO ALIGN (IPLUS (DSPYPOSITION NIL EDS)
(DSPLINEFEED NIL EDS))
EDS)
else (RELMOVETO DELTAX 0 EDS])
(SPACINGRULE
[LAMBDA (BME) (* bas: "12-Sep-84 10:46")
(* Looks for someone who might know what the current
left margin is and returns that someone.)
(bind P Q for E on (fetch SELEXP of BME) unless (COMMENTP (CAR E)) when (SETQ Q (GETSELMAP E))
do (if (NEQ (fetch STARTY of Q)
(fetch STARTY of BME))
then (RETURN Q)
elseif P
else (SETQ P Q))
finally (RETURN P])
(UNPP
[LAMBDA (ENT) (* bas: " 4-OCT-82 15:25")
(* Clears region printed by ENT, carefully)
(PROG ((EDS (fetch PDSP of ENT))
(H (FONTPROP (fetch FNT of ENT)
(QUOTE HEIGHT)))
(HI (ADD1 (HIPT ENT)))
(LO (LOWPT ENT))
R)
(SETQ R (DSPCLIPPINGREGION NIL EDS))
(if (NOT (fetch BP of ENT))
then (WIPE (fetch LEFT of R)
(fetch BOTTOM of R)
(fetch WIDTH of R)
(fetch HEIGHT of R)
EDS)
(RETURN R)
elseif (ONELINEP ENT)
then (WIPE (fetch STARTX of ENT)
LO
(IDIFFERENCE (fetch STOPX of ENT)
(fetch STARTX of ENT))
H EDS)
else (WIPE (fetch STARTX of ENT)
(IDIFFERENCE HI H)
(IDIFFERENCE (fetch PRIGHT of R)
(fetch STARTX of ENT))
H EDS) (* Amazingly enough this is as good as one can do)
(WIPE (fetch LEFT of R)
(IPLUS LO H)
(fetch WIDTH of R)
(IDIFFERENCE (IDIFFERENCE HI H)
(IPLUS LO H))
EDS)
(WIPE (fetch LEFT of R)
LO
(ADD1 (IDIFFERENCE (fetch STOPX of ENT)
(fetch LEFT of R)))
H EDS))
(RETURN (create REGION
LEFT ←(fetch LEFT of R)
BOTTOM ←(IMAX LO (fetch BOTTOM of R))
WIDTH ←(if (ONELINEP ENT)
then (IDIFFERENCE (NXTUSEDX ENT)
(fetch LEFT of R))
else (fetch WIDTH of R))
HEIGHT ←(IMAX 0 (IDIFFERENCE (IMIN HI (fetch TOP of R))
(IMAX LO (fetch BOTTOM of R])
(NXTUSEDX
[LAMBDA (E) (* bas: " 5-Feb-84 21:06")
(* Finds the first used X loc on the same line as the
end of E)
(PROG (V)
(RETURN (OR (if (SETQ V (CDR (fetch TAIL of E)))
then [if (LISTP V)
then (SETQ V (GETME4 V (GETMEBP E)))
(if (EQ (fetch STARTY of V)
(fetch STOPY of E))
then (fetch STARTX of V))
else (* Dotted pair)
(IPLUS (fetch STOPX of E)
(CHARWIDTH (CHARCODE SPACE)
(fetch FNT of E]
elseif (SETQ V (fetch BP of E))
then (if (EQ (fetch STOPY of V)
(fetch STOPY of E))
then (fetch RPSTART of V)))
(fetch RIGHT of (DSPCLIPPINGREGION NIL (fetch PDSP of E])
(ONELINEP
[LAMBDA (ENT) (* bas: " 4-OCT-82 15:26")
(EQ (fetch STARTY of ENT)
(fetch STOPY of ENT])
)
(DEFINEQ
(MOVEDSMAP
[LAMBDA (ENT OX OY NX NY) (* bas: "30-Sep-84 14:02")
(* APOLOGY: This code and any path by which you got here is a frightful kludge. WARNING: It is also very tricky as
there are lots of special cases.)
(PROG (OLOW NLOW FONTH NEXT REG BOTTOM LEFT RIGHT WIDTH (DX (IDIFFERENCE NX OX))
(DY (IDIFFERENCE NY OY))
(LINEFONT (DSLINEFONT ENT OY))
(EPDS (fetch PDSP of ENT)))
(SETQ FONTH (FONTPROP LINEFONT (QUOTE DESCENT)))
(SETQ NLOW (IDIFFERENCE NY FONTH))
(SETQ OLOW (IDIFFERENCE OY FONTH))
(SETQ FONTH (FONTPROP LINEFONT (QUOTE HEIGHT)))
(SETQ REG (DSPCLIPPINGREGION NIL EPDS))
(SETQ BOTTOM (fetch BOTTOM of REG))
(SETQ LEFT (fetch LEFT of REG))
(SETQ RIGHT (fetch PRIGHT of REG))
(SETQ WIDTH (fetch WIDTH of REG))
(if (ZEROP DX)
else (for (B ← ENT) by (fetch BP of B) while (fetch BP of B)
do (SETQ NEXT (OR (ADJUSTXTAIL (CDR (fetch TAIL of B))
(fetch BP of B)
DX OY RIGHT)
NEXT))) (* Move the rest of the line)
(if (AND (ILESSP DX 0)
(IGEQ DY 0))
then (BITBLT EPDS OX OLOW EPDS NX OLOW (IDIFFERENCE RIGHT OX)
FONTH
(QUOTE INPUT)
(QUOTE REPLACE)) (* Move in then blank out far edge)
(WIPE (IPLUS RIGHT DX)
OLOW
(IMINUS DX)
FONTH EPDS)
else (* Image is filled in at exit)
(WIPE OX OLOW (IDIFFERENCE RIGHT OX)
FONTH EPDS)))
(if (ZEROP DY)
else (BITBLT EPDS LEFT BOTTOM EPDS LEFT (IPLUS BOTTOM DY)
WIDTH
(IDIFFERENCE OLOW BOTTOM)
(QUOTE INPUT)
(QUOTE REPLACE))
(for (B ← ENT) by (fetch BP of B) while (fetch BP of B)
do (* Map over everything to the bottom right moving it
vertically)
(ADJUSTYTAIL (CDR (fetch TAIL of B))
(fetch BP of B)
OY DY))
(ADJDEEXTENT EPDS DY) (* Fix extent and blank inserted space)
(if (IGREATERP DY 0)
then (WIPE LEFT (IMIN BOTTOM OLOW)
WIDTH DY EPDS) (* Repaint into cleared space)
(REFRESHIF EPDS (IPLUS BOTTOM DY)
BOTTOM) (* Clear rest of new line)
(WIPE NX NLOW (IDIFFERENCE RIGHT NX)
FONTH EPDS)
else [SETQ NLOW (IMIN NLOW (IPLUS DY (fetch PTOP of REG]
(WIPE LEFT NLOW WIDTH (IMINUS DY)
EPDS) (* Clear possible trash thru which we extended)
(WIPE LEFT OLOW WIDTH FONTH EPDS)))
(REFRESHIF EPDS (IPLUS FONTH -1 (IMAX NLOW OLOW))
(ADD1 NLOW))
(* Another small kludge. A slightly bigger font like CLISPFONT on the next line might stick up into NLOW and thus
get refreshed. Unfortunately, there is no guarrantee that that line will be valid to refresh.
Correct solution is to make line spacing on printing such that no two lines touch. For now, we diddle the NLOW value
to avoid touching the next line down.)
(RETURN NEXT])
(ADJUSTXTAIL
[LAMBDA (TAIL BK DX YLINE RIGHT) (* bas: " 3-Dec-84 22:07")
(PROG (OVER)
[bind IM for I on TAIL when (SETQ IM (GETME4 I))
do (if (NEQ YLINE (fetch STARTY of IM))
then (RETURN)
elseif (IGREATERP RIGHT (add (fetch STARTX of IM)
DX))
else (SETQ OVER BK))
(AND (if (LISTP (CAR I))
then (ADJUSTXTAIL (CAR I)
IM DX YLINE RIGHT)
elseif (EQ YLINE (fetch STOPY of IM))
then (ILEQ RIGHT (add (fetch STOPX of IM)
DX)))
(SETQ OVER BK))
finally (if (SETQ IM (GETME4 I BK))
then (AND (EQ YLINE (fetch STARTY of IM))
(ILEQ RIGHT (add (fetch STARTX of IM)
DX))
(SETQ OVER BK))
(AND (EQ YLINE (fetch STOPY of IM))
(ILEQ RIGHT (add (fetch STOPX of IM)
DX))
(SETQ OVER BK]
(AND (EQ YLINE (fetch STOPY of BK))
(ILEQ RIGHT (add (fetch STOPX of BK)
DX))
(SETQ OVER (OR (fetch BP of BK)
BK)))
(RETURN OVER])
(ADJUSTYTAIL
[LAMBDA (TAIL BK OY D) (* bas: " 3-Dec-84 22:07")
(bind IM for I on TAIL when (SETQ IM (GETME4 I))
do (add (fetch STARTY of IM)
D)
(if (LISTP (CAR I))
then (ADJUSTYTAIL (CAR I)
IM OY D)
else (add (fetch STOPY of IM)
D))
finally (if (SETQ IM (GETME4 I BK))
then (add (fetch STARTY of IM)
D)
(add (fetch STOPY of IM)
D)))
(add (fetch STOPY of BK)
D])
(ADJDEEXTENT
[LAMBDA (EX DY) (* bas: "19-JUL-82 17:05")
(OR (SETQ EX (WINDOWPROP EX (QUOTE EXTENT)))
(SHOULDNT))
(add (fetch BOTTOM of EX)
DY)
(add (fetch HEIGHT of EX)
(IMINUS DY])
(DSLINEFONT
[LAMBDA (E Y) (* bas: "30-Mar-84 11:22")
(DSLINEFONT1 [for old E by (fetch BP of E) thereis (OR (NOT (fetch BP of E))
(AND (ILESSP Y (fetch STARTY of E))
(IGREATERP Y (fetch STOPY
of E]
Y])
(DSLINEFONT1
[LAMBDA (ENT YLINE) (* bas: "30-Mar-84 10:52")
(AND ENT (bind IM (MFONT ←(AND (OR (EQ YLINE (fetch STARTY of ENT))
(EQ YLINE (fetch STOPY of ENT)))
(fetch FNT of ENT)))
for I on (LISTP (fetch SELEXP of ENT)) do (SETQ MFONT (MAXFONT MFONT
(DSLINEFONT1
(GETME4 I)
YLINE)))
finally (RETURN MFONT])
(MAXFONT
[LAMBDA (F1 F2) (* bas: "30-Mar-84 10:17")
(if (IGREATERP (if (FONTP F1)
then (FONTPROP F1 (QUOTE HEIGHT))
else 0)
(if (FONTP F2)
then (FONTPROP F2 (QUOTE HEIGHT))
else 0))
then F1
else F2])
)
(DEFINEQ
(REFRESHIF
[LAMBDA (WDS HI LO) (* bas: " 9-MAR-83 16:32")
(* Repaints stuff LOWER than HI and on or above LO)
(DSPRIGHTMARGIN [PROG1 (DSPRIGHTMARGIN 10000 WDS) (* We reset margin b/c REFRESHIF is sometimes called
with things that would overflow)
(PROG ((R (DSPCLIPPINGREGION NIL WDS)))
(REFRESHIF1 (GETMAP? WDS)
WDS
(IMIN HI (fetch PTOP of R))
(IMAX LO (fetch BOTTOM of R]
WDS])
(REFRESHIF1
[LAMBDA (M DS HI LO) (* bas: "30-Mar-84 12:01")
(AND M (OVERLAP HI LO (HIPT M)
(LOWPT M))
(if (LISTP (fetch SELEXP of M))
then (if [IGREATERP HI (IDIFFERENCE (fetch STARTY of M)
(FONTPROP (fetch FNT of M)
(QUOTE DESCENT]
then (MOVETO (fetch STARTX of M)
(fetch STARTY of M)
DS)
(DSPFONT (fetch FNT of M)
DS)
(PRIN3 (QUOTE %()
DS))
(for I on (fetch SELEXP of M) do (REFRESHIF1 (GETME4 I M)
DS HI LO)
finally (if I
then (SETQ I (GETME4 I M))
(MOVETO (IDIFFERENCE (fetch STARTX of I)
(STRINGWIDTH DOTSTRING
(fetch FNT of M)))
(fetch STARTY of I)
DS)
(PRIN3 DOTSTRING DS)
(* Dotted pair)
(REFRESHIF1 I DS HI LO)))
(if [ILEQ LO (IPLUS (fetch STOPY of M)
(FONTPROP (fetch FNT of M)
(QUOTE ASCENT]
then (MOVETO (fetch RPSTART of M)
(fetch STOPY of M)
DS)
(DSPFONT (fetch FNT of M)
DS)
(PRIN3 (QUOTE %))
DS))
else (MOVETO (fetch STARTX of M)
(fetch STARTY of M)
DS)
(DSPFONT (fetch FNT of M)
DS)
(PRIN4 (fetch SELEXP of M)
DS])
)
(DEFINEQ
(COMMENTP
[LAMBDA (E) (* bas: "15-NOV-82 22:01")
(AND COMMENTFLG (EQ COMMENTFLG (CAR (LISTP E])
(HIPT
[LAMBDA (ENT) (* bas: " 4-OCT-82 15:25")
(IPLUS (fetch STARTY of ENT)
(FONTPROP (fetch FNT of ENT)
(QUOTE ASCENT))
-1])
(LOWPT
[LAMBDA (E) (* bas: " 4-OCT-82 15:25")
(IDIFFERENCE (fetch STOPY of E)
(FONTPROP (fetch FNT of E)
(QUOTE DESCENT])
(WIPE
[LAMBDA (X Y W H DS) (* bas: "19-AUG-82 15:18")
(BITBLT NIL NIL NIL DS X Y W H (QUOTE TEXTURE)
(QUOTE REPLACE)
(DSPTEXTURE NIL DS])
)
(DEFINEQ
(RESETCLIP
[LAMBDA (C) (* bas: " 8-NOV-82 15:35")
(* For use in RESETFORM. Takes a CONS of a DSP and its
new region)
(CONS (CAR C)
(DSPCLIPPINGREGION (CDR C)
(CAR C])
)
(PUTPROPS DSPRINTDEF COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2948 7790 (PRINOPEN 2958 . 3199) (PRINSHUT 3201 . 3523) (PRIN1S 3525 . 3783) (PRIN2S
3785 . 4043) (PRINENDLINE 4045 . 4244) (PRINDOTP 4246 . 4500) (SETFONT 4502 . 5740) (MAKEMAPENTRY 5742
. 6345) (DSPDSFOR 6347 . 6882) (MAKEDOTPTAIL 6884 . 7788)) (7791 8772 (RESETDEF 7801 . 8080) (
TTYPRINOPEN 8082 . 8215) (TTYPRINSHUT 8217 . 8361) (TTYPRIN1S 8363 . 8492) (TTYPRIN2S 8494 . 8623) (
TTYENDLINE 8625 . 8770)) (9653 10483 (SHOWDEDITMAP 9663 . 10481)) (10593 11625 (DEPRINTDEF 10603 .
11623)) (11626 22828 (REPP 11636 . 12465) (REPPCHANGES 12467 . 13931) (REPPUNRAVEL 13933 . 14644) (
REPPDELETE 14646 . 16107) (REPPINSERT 16109 . 18137) (REPPTANGLEDP 18139 . 18823) (LEADSPACE 18825 .
19182) (SPACINGRULE 19184 . 19793) (UNPP 19795 . 21667) (NXTUSEDX 21669 . 22650) (ONELINEP 22652 .
22826)) (22829 29846 (MOVEDSMAP 22839 . 26435) (ADJUSTXTAIL 26437 . 27774) (ADJUSTYTAIL 27776 . 28402)
(ADJDEEXTENT 28404 . 28679) (DSLINEFONT 28681 . 29024) (DSLINEFONT1 29026 . 29506) (MAXFONT 29508 .
29844)) (29847 32003 (REFRESHIF 29857 . 30455) (REFRESHIF1 30457 . 32001)) (32004 32799 (COMMENTP
32014 . 32170) (HIPT 32172 . 32387) (LOWPT 32389 . 32596) (WIPE 32598 . 32797)) (32800 33132 (
RESETCLIP 32810 . 33130)))))
STOP