(FILECREATED "27-Apr-84 16:16:24" {PHYLUM}<LISPCORE>LIBRARY>DSPVTS.;2 15982
changes to: (FNS CURSORCOLUMN CURSORROW DSPCLEOP CURSORUP \DSPINSDELCHAR CURSORMOVETO)
previous date: "27-SEP-83 23:10:03" {PHYLUM}<LISP>LIBRARY>DSPVTS.;10)
(* Copyright (c) 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT DSPVTSCOMS)
(RPAQQ DSPVTSCOMS ((DECLARE: EVAL@COMPILE DONTCOPY (MACROS \GETDDTOPY \GETDDBOTY \MACRO.MX))
(MACROS CURSORLEFT CURSORRIGHT DSPSCROLLUP DSPSCROLLDOWN DSPINSCHAR DSPDELCHAR
DSPINSLINE DSPDELLINE)
(FNS CURSORLEFT CURSORRIGHT DSPSCROLLUP DSPSCROLLDOWN \DSPSCROLLUPDOWN DSPINSCHAR
DSPDELCHAR \DSPINSDELCHAR DSPINSLINE DSPDELLINE \DSPINSDELLINE)
(FNS \DSPVTSMOVETO CURSORHOMEUP CURSORHOMEDOWN CURSORUP CURSORDOWN CURSORMOVETO)
(FNS CURSORROW CURSORCOLUMN)
(FNS DSPCLEOP DSPSTANDOUT)))
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \GETDDTOPY MACRO (OPENLAMBDA (DD)
(* Gets the Y coordinate, in displaystream coordinate system, where the uppermost line of text can be placed.
DD is the \GETDISPLAYDATA of the display stream.)
(IDIFFERENCE (ADD1 (fetch (REGION TOP) of (ffetch DDClippingRegion of DD)))
(FONTASCENT (ffetch DDFONT of DD)))))
(PUTPROPS \GETDDBOTY MACRO (OPENLAMBDA (DD)
(* Gets the Y coordinate in displaystream coordinate system where the "last" line would fall, assuming that the
topmost line is aligned as by \GETDDTOPY)
(IPLUS (IREMAINDER (fetch (REGION HEIGHT) of (ffetch DDClippingRegion of DD))
(ffetch DDLINEFEED of DD))
(FONTDESCENT (ffetch DDFONT of DD)))))
(PUTPROPS \MACRO.MX MACRO (Z
(PROG ((X (EXPANDMACRO (CAR Z)
T)))
(COND
((EQ X (CAR Z))
(ERROR "No macro property -- \MACRO.MX" X))
(T (RETURN X))))))
)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS CURSORLEFT MACRO ((DS CHAR TTBL)
(\DSPMOVELR DS CHAR NIL NIL TTBL)))
(PUTPROPS CURSORRIGHT MACRO ((DS CHAR TTBL)
(\DSPMOVELR DS CHAR NIL NIL TTBL T)))
(PUTPROPS DSPSCROLLUP MACRO ((DS YBOT YTOP AMOUNT)
(\DSPSCROLLUPDOWN DS YBOT YTOP AMOUNT)))
(PUTPROPS DSPSCROLLDOWN MACRO ((DS YBOT YTOP AMOUNT)
(\DSPSCROLLUPDOWN DS YBOT YTOP AMOUNT T)))
(PUTPROPS DSPINSCHAR MACRO ((DS CHAR X Y TTBL)
(\DSPINSDELCHAR DS CHAR X Y TTBL NIL)))
(PUTPROPS DSPDELCHAR MACRO ((DS CHAR X Y TTBL)
(\DSPINSDELCHAR DS CHAR X Y TTBL T)))
(PUTPROPS DSPINSLINE MACRO ((DS YPOS)
(\DSPINSDELLINE DS YPOS)))
(PUTPROPS DSPDELLINE MACRO ((DS YPOS)
(\DSPINSDELLINE DS YPOS T)))
)
(DEFINEQ
(CURSORLEFT
(LAMBDA (DISPLAYSTREAM CHAR TTBL) (* JonL "27-SEP-83 20:55")
(\MACRO.MX (CURSORLEFT DISPLAYSTREAM CHAR TTBL))))
(CURSORRIGHT
(LAMBDA (DISPLAYSTREAM CHAR TTBL) (* JonL "27-SEP-83 20:56")
(\MACRO.MX (CURSORRIGHT DISPLAYSTREAM CHAR TTBL))))
(DSPSCROLLUP
(LAMBDA (DISPLAYSTREAM YBOT YTOP AMOUNT) (* JonL "27-SEP-83 21:40")
(\MACRO.MX (DSPSCROLLUP DISPLAYSTREAM YBOT YTOP AMOUNT))))
(DSPSCROLLDOWN
(LAMBDA (DISPLAYSTREAM YBOT YTOP AMOUNT) (* JonL "27-SEP-83 21:40")
(\MACRO.MX (DSPSCROLLDOWN DISPLAYSTREAM YBOT YTOP AMOUNT))))
(\DSPSCROLLUPDOWN
(LAMBDA (DISPLAYSTREAM YBOT YTOP AMOUNT DOWNFLG) (* JonL "27-SEP-83 22:14")
(if DISPLAYSTREAM
then ((LAMBDA (DD)
(PROG ((REG (ffetch DDClippingRegion of DD))
(LEFT (ffetch DDLeftMargin of DD))
(RIGHT (ffetch DDRightMargin of DD))
TOPLINE BOTTOMLINE YSRC YDEST)
(OR (FIXP AMOUNT)
(SETQ AMOUNT (IABS (ffetch DDLINEFEED of DD))))
(SETQ TOPLINE (fetch (REGION TOP) of REG))
(SETQ BOTTOMLINE (fetch (REGION BOTTOM) of REG))
(SETQ YTOP (if (FIXP YTOP)
then (IMAX BOTTOMLINE (IMIN TOPLINE YTOP))
else TOPLINE))
(SETQ YBOT (if (FIXP YBOT)
then (IMIN TOPLINE (IMAX BOTTOMLINE YBOT))
else BOTTOMLINE))
(if (IGREATERP YBOT YTOP)
then (RETURN))
(SETQ YDEST (IPLUS AMOUNT (SETQ YSRC YBOT)))
(if DOWNFLG
then (swap YSRC YDEST))
(BITBLT DISPLAYSTREAM LEFT YSRC DISPLAYSTREAM LEFT YDEST (IDIFFERENCE RIGHT
LEFT)
(ADD1 (IDIFFERENCE YTOP YDEST))
(QUOTE INPUT)
(QUOTE REPLACE))
(DSPCLEOL DISPLAYSTREAM LEFT (if DOWNFLG
then (ADD1 (IDIFFERENCE YTOP AMOUNT))
else YSRC)
AMOUNT)
(RETURN T)))
(\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))))
(DSPINSCHAR
(LAMBDA (DISPLAYSTREAM CHAR X Y TTBL) (* JonL "27-SEP-83 20:54")
(\MACRO.MX (DSPINSCHAR DISPLAYSTREAM CHAR X Y TTBL))))
(DSPDELCHAR
(LAMBDA (DISPLAYSTREAM CHAR X Y TTBL) (* JonL "27-SEP-83 20:54")
(\MACRO.MX (DSPDELCHAR DISPLAYSTREAM CHAR X Y TTBL))))
(\DSPINSDELCHAR
(LAMBDA (DISPLAYSTREAM CHAR X Y TTBL DELFLG) (* JonL "27-Apr-84 16:12")
(AND DISPLAYSTREAM ((LAMBDA (DD FONT)
(SETQ FONT (ffetch DDFONT of DD))
(PROG ((DEFAULTPOS? (AND (NULL X)
(NULL Y)))
(RMARG (ffetch DDRightMargin of DD))
(X'(IPLUS (OR (FIXP X)
(SETQ X (ffetch DDXPOSITION of DD)))
(\STREAMCHARWIDTH CHAR DISPLAYSTREAM TTBL)))
(BTMLINE (OR (FIXP Y)
(IDIFFERENCE (SETQ Y (ffetch DDYPOSITION of DD))
(FONTDESCENT FONT))))
(HEIGHT (IABS (ffetch DDLINEFEED of DD)))
XSRC XDEST WIDTH CURRX CURRY)
(SETQ WIDTH (IDIFFERENCE RMARG X'))
(if (NOT DELFLG)
then (if (ILESSP WIDTH 0)
then (RETURN)) (* Can't do the insertion on this line if there ins't
even room enough for this one char)
(SETQ XSRC X)
(SETQ XDEST X')
else (if (ILESSP WIDTH 0)
then (SETQ WIDTH (IMAX 0 (IDIFFERENCE RMARG X)))
(SETQ X' X))
(SETQ XSRC X')
(SETQ XDEST X))
(\CHECKCARET DISPLAYSTREAM) (* Take down the caret, if there is one, just in case we
are backing up over it.)
(SETQ CURRX (ffetch DDXPOSITION of DD))
(SETQ CURRY (ffetch DDYPOSITION of DD))
(BITBLT DISPLAYSTREAM XSRC BTMLINE DISPLAYSTREAM XDEST BTMLINE WIDTH HEIGHT
(QUOTE INPUT)
(QUOTE REPLACE)) (* Moby shift of line over (left or right) by one space)
(if (NOT DELFLG)
then (if DEFAULTPOS?
then (UNINTERRUPTABLY
(BLTCHAR CHAR DISPLAYSTREAM)
(DSPXPOSITION CURRX DISPLAYSTREAM))
else (RESETFORM (\DSPVTSMOVETO (LIST X Y DISPLAYSTREAM)
T)
(BLTCHAR CHAR DISPLAYSTREAM)))
else (DSPCLEOL DISPLAYSTREAM (IPLUS X WIDTH)
BTMLINE HEIGHT))
(RETURN T) (* Move all the bits over to the right to make room for
this char)
))
(\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))))
(DSPINSLINE
(LAMBDA (DISPLAYSTREAM YPOS) (* JonL "27-SEP-83 21:40")
(\MACRO.MX (DSPINSLINE DISPLAYSTREAM YPOS))))
(DSPDELLINE
(LAMBDA (DISPLAYSTREAM YPOS) (* JonL "27-SEP-83 21:39")
(\MACRO.MX (DSPDELLINE DISPLAYSTREAM YPOS))))
(\DSPINSDELLINE
(LAMBDA (DISPLAYSTREAM YPOS DELFLG) (* JonL "27-SEP-83 21:50")
(if DISPLAYSTREAM
then ((LAMBDA (DD)
(\CHECKCARET DISPLAYSTREAM)
(OR (FIXP YPOS)
(SETQ YPOS (IDIFFERENCE (ffetch DDYPOSITION of DD)
(FONTDESCENT (ffetch DDFONT of DD)))))
(PROG ((XPOS (ffetch DDXPOSITION of DD))
(LEFT (ffetch DDLeftMargin of DD))
(RIGHT (ffetch DDRightMargin of DD))
(BOTTOM 0)
(LINEHEIGHT (IABS (ffetch DDLINEFEED of DD)))
NEXTBOTTOM)
(SETQ NEXTBOTTOM (IPLUS BOTTOM LINEHEIGHT))
(if DELFLG
then (swap BOTTOM NEXTBOTTOM))
(BITBLT DISPLAYSTREAM LEFT NEXTBOTTOM DISPLAYSTREAM LEFT BOTTOM
(IDIFFERENCE RIGHT LEFT)
YPOS
(QUOTE INPUT)
(QUOTE REPLACE)) (* Bubble bits either up or down)
(DSPCLEOL DISPLAYSTREAM LEFT (if DELFLG
then 0
else (DSPXPOSITION LEFT DISPLAYSTREAM)
YPOS))
(* and clean out the line vacated)
(RETURN T)))
(\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))))
)
(DEFINEQ
(\DSPVTSMOVETO
(LAMBDA (L CLOBBERLISTWITHOLD?) (* JonL "27-SEP-83 23:09")
(PROG ((X (CAR L))
(Y (CADR L))
(DISPLAYSTREAM (CADDR L))
OLDX OLDY)
(if CLOBBERLISTWITHOLD?
then (SETQ OLDX (DSPXPOSITION NIL DISPLAYSTREAM))
(SETQ OLDY (DSPYPOSITION NIL DISPLAYSTREAM)))
(MOVETO X Y DISPLAYSTREAM)
(if CLOBBERLISTWITHOLD?
then (FRPLACA L OLDX)
(FRPLACA (CDR L)
OLDY)
(RETURN L)))))
(CURSORHOMEUP
(LAMBDA (DISPLAYSTREAM) (* JonL "27-SEP-83 20:37")
(if DISPLAYSTREAM
then ((LAMBDA (DD)
(DSPXPOSITION (ffetch DDLeftMargin of DD)
DISPLAYSTREAM)
(DSPYPOSITION (\GETDDTOPY DD)
DISPLAYSTREAM)
T)
(\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))))
(CURSORHOMEDOWN
(LAMBDA (DISPLAYSTREAM) (* JonL "27-SEP-83 20:25")
(if DISPLAYSTREAM
then ((LAMBDA (DD)
(DSPXPOSITION (ffetch DDLeftMargin of DD)
DISPLAYSTREAM)
(DSPYPOSITION (\GETDDBOTY DD)
DISPLAYSTREAM)
T)
(\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))))
(CURSORUP
(LAMBDA (DISPLAYSTREAM) (* JonL "27-Apr-84 15:48")
(if DISPLAYSTREAM
then ((LAMBDA (DD NEWY)
(if (ILEQ (SETQ NEWY (IDIFFERENCE (ffetch DDYPOSITION of DD)
(ffetch DDLINEFEED of DD)))
(\GETDDTOPY DD))
then (DSPYPOSITION NEWY DISPLAYSTREAM)
T))
(\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))))
(CURSORDOWN
(LAMBDA (DISPLAYSTREAM) (* JonL "27-SEP-83 20:41")
(if DISPLAYSTREAM
then ((LAMBDA (DD NEWY)
(if (IGEQ (SETQ NEWY (IPLUS (ffetch DDYPOSITION of DD)
(ffetch DDLINEFEED of DD)))
(\GETDDBOTY DD))
then (DSPYPOSITION NEWY DISPLAYSTREAM)
T))
(\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))))
(CURSORMOVETO
(LAMBDA (DISPLAYSTREAM ROW COL) (* JonL "27-Apr-84 16:02")
(* 0-Origin address by rows and columns)
(AND DISPLAYSTREAM ((LAMBDA (DD)
(PROG ((FONT (ffetch DDFONT of DD))
(LINEHEIGHT (IABS (ffetch DDLINEFEED of DD)))
(REG (ffetch DDClippingRegion of DD))
HEIGHT NEWY NEWX)
(SETQ HEIGHT (fetch (REGION HEIGHT) of REG))
(if ROW
then ((LAMBDA (NEWY)
(if (OR (ILESSP ROW 0)
(ILESSP NEWY (PROGN
(* Quick open-coding of \GETDDBOTY)
(IPLUS (IREMAINDER HEIGHT LINEHEIGHT)
(FONTDESCENT FONT)))))
then (RETURN)
else (SETQ ROW NEWY)))
(IDIFFERENCE (PROGN (* Quick open-coding of \GETDDTOPY)
(IDIFFERENCE (IPLUS HEIGHT (fetch (REGION BOTTOM)
of REG))
(FONTASCENT FONT)))
(ITIMES ROW LINEHEIGHT))))
(if COL
then ((LAMBDA (NEWX)
(if (OR (ILESSP NEWX (ffetch DDLeftMargin of DD))
(IGREATERP NEWX (ffetch DDRightMargin of DD)))
then (RETURN)
else (SETQ COL NEWX)))
(ITIMES COL (\STREAMCHARWIDTH (CHARCODE A)
DISPLAYSTREAM))))
(AND ROW (DSPYPOSITION ROW DISPLAYSTREAM))
(AND COL (DSPXPOSITION COL DISPLAYSTREAM))
(RETURN T)))
(\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))))
)
(DEFINEQ
(CURSORROW
(LAMBDA (ROW DISPLAYSTREAM) (* JonL "27-Apr-84 15:08")
(* * Returns the old value, unless it can't "go" to row ROW, in which case it return NIL)
(if DISPLAYSTREAM
then ((LAMBDA (DD)
(PROG ((TOPY (\GETDDTOPY DD))
(LINEHEIGHT (IABS (ffetch DDLINEFEED of DD))))
(RETURN (PROG1 (IQUOTIENT (IDIFFERENCE TOPY (ffetch DDYPOSITION of DD))
LINEHEIGHT)
(if ROW
then ((LAMBDA (NEWY)
(if (OR (ILESSP ROW 0)
(ILESSP NEWY (\GETDDBOTY DD)))
then (RETURN))
(DSPYPOSITION NEWY DISPLAYSTREAM))
(IDIFFERENCE TOPY (ITIMES ROW LINEHEIGHT))))))))
(\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))))
(CURSORCOLUMN
(LAMBDA (COL DISPLAYSTREAM) (* JonL "27-Apr-84 15:06")
(* * Returns the old value, unless it can't "go" to column COL, in which case it return NIL)
(if DISPLAYSTREAM
then (PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM))
WIDTH)
(SETQ WIDTH (\STREAMCHARWIDTH (CHARCODE A)
DISPLAYSTREAM))
(RETURN (PROG1 (IQUOTIENT (ffetch DDXPOSITION of DD)
WIDTH)
(if COL
then ((LAMBDA (NEWX)
(if (OR (ILESSP NEWX (ffetch DDLeftMargin
of DD))
(IGREATERP NEWX (ffetch DDRightMargin
of DD)))
then (RETURN))
(DSPXPOSITION NEWX DISPLAYSTREAM))
(ITIMES COL WIDTH)))))))))
)
(DEFINEQ
(DSPCLEOP
(LAMBDA (DISPLAYSTREAM XPOS YPOS) (* JonL "27-Apr-84 15:58")
(if DISPLAYSTREAM
then ((LAMBDA (DD)
(\CHECKCARET DISPLAYSTREAM)
(PROG ((LEFT (ffetch DDLeftMargin of DD))
(RIGHT (ffetch DDRightMargin of DD)))
(OR (FIXP XPOS)
(SETQ XPOS (ffetch DDXPOSITION of DD)))
(OR (FIXP YPOS)
(SETQ YPOS (IDIFFERENCE (ffetch DDYPOSITION of DD)
(FONTDESCENT (ffetch DDFONT of DD)))))
(if (ILESSP XPOS RIGHT)
then (DSPCLEOL DISPLAYSTREAM XPOS YPOS))
(BITBLT NIL NIL NIL DISPLAYSTREAM LEFT (fetch (REGION BOTTOM)
of (ffetch DDClippingRegion
of DD))
(IDIFFERENCE RIGHT LEFT)
YPOS
(QUOTE TEXTURE)
(QUOTE REPLACE))
(RETURN T)))
(\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)))))
(DSPSTANDOUT
(LAMBDA (DISPLAYSTREAM FLG) (* JonL "27-SEP-83 17:40")
(PROG ((DD (\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM))
CURRENTFONT BOLDP)
(SETQ CURRENTFONT (ffetch DDFONT of DD))
(SETQ BOLDP (EQ (FONTPROP CURRENTFONT (QUOTE WEIGHT))
(QUOTE BOLD)))
(if (if FLG
then (NOT BOLDP)
else BOLDP)
then (* Not in correct mode)
(DSPFONT (FONTCOPY CURRENTFONT (QUOTE WEIGHT)
(if BOLDP
then (QUOTE MEDIUM)
else (QUOTE BOLD)))
DISPLAYSTREAM))
(RETURN BOLDP))))
)
(PUTPROPS DSPVTS COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2656 8950 (CURSORLEFT 2666 . 2832) (CURSORRIGHT 2834 . 3002) (DSPSCROLLUP 3004 . 3179)
(DSPSCROLLDOWN 3181 . 3360) (\DSPSCROLLUPDOWN 3362 . 4780) (DSPINSCHAR 4782 . 4952) (DSPDELCHAR 4954
. 5124) (\DSPINSDELCHAR 5126 . 7384) (DSPINSLINE 7386 . 7547) (DSPDELLINE 7549 . 7710) (
\DSPINSDELLINE 7712 . 8948)) (8951 12648 (\DSPVTSMOVETO 8961 . 9469) (CURSORHOMEUP 9471 . 9830) (
CURSORHOMEDOWN 9832 . 10193) (CURSORUP 10195 . 10616) (CURSORDOWN 10618 . 11036) (CURSORMOVETO 11038
. 12646)) (12649 14273 (CURSORROW 12659 . 13442) (CURSORCOLUMN 13444 . 14271)) (14274 15900 (DSPCLEOP
14284 . 15215) (DSPSTANDOUT 15217 . 15898)))))
STOP