(FILECREATED " 2-AUG-83 17:02:41" {PHYLUM}<LISPCORE>SOURCES>DSPVTS.;2 11660
changes to: (VARS DSPVTSCOMS)
(FNS DSPSTANDOUT)
previous date: " 6-MAY-83 01:31:20" {PHYLUM}<LISPCORE>SOURCES>DSPVTS.;1)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT DSPVTSCOMS)
(RPAQQ DSPVTSCOMS ((DECLARE: EVAL@COMPILE DONTCOPY (MACROS \GETDSTOPY \GETDSBOTY \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 DSPCLEOP DSPSTANDOUT)))
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \GETDSTOPY MACRO (OPENLAMBDA (DS)
(* Gets the Y coordinate, in DS's displaystream
coordinate system, where the uppermost line of text can
be placed.)
(IDIFFERENCE (ADD1 (fetch (REGION TOP) of (ffetch \SFClippingRegion of DS)))
(FONTASCENT (ffetch \SFFONT of DS)))))
(PUTPROPS \GETDSBOTY MACRO (OPENLAMBDA (DS)
(* Gets the Y coordinate in DS's displaystream coordinate system where the "last" line would fall, assuming that
the topmost line is aligned as by \GETDSTOPY)
(IPLUS (IREMAINDER (fetch (REGION HEIGHT) of (ffetch \SFClippingRegion of DS))
(ffetch \SFLINEFEED of DS))
(FONTDESCENT (ffetch \SFFONT of DS)))))
(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 (DS CHAR TTBL) (* JonL "30-APR-83 13:06")
(\MACRO.MX (CURSORLEFT DS CHAR TTBL))))
(CURSORRIGHT
(LAMBDA (DS CHAR TTBL) (* JonL " 1-MAY-83 05:03")
(\MACRO.MX (CURSORRIGHT DS CHAR TTBL))))
(DSPSCROLLUP
(LAMBDA (DS YBOT YTOP AMOUNT) (* JonL " 2-MAY-83 22:11")
(\MACRO.MX (DSPSCROLLUP DS YBOT YTOP AMOUNT))))
(DSPSCROLLDOWN
(LAMBDA (DS YBOT YTOP AMOUNT) (* JonL " 2-MAY-83 22:11")
(\MACRO.MX (DSPSCROLLDOWN DS YBOT YTOP AMOUNT))))
(\DSPSCROLLUPDOWN
(LAMBDA (DS YBOT YTOP AMOUNT DOWNFLG) (* JonL " 2-MAY-83 23:11")
(SETQ DS (\SFInsureDisplayStream DS))
(OR (FIXP AMOUNT)
(SETQ AMOUNT (IMINUS (ffetch \SFLINEFEED of DS))))
(PROG ((REG (ffetch \SFClippingRegion of DS))
(LMARG (DSPLEFTMARGIN NIL DS))
(RMARG (DSPRIGHTMARGIN NIL DS))
TOPLINE BOTTOMLINE YSRC YDEST)
(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 (SETQ YSRC (PROG1 YDEST (SETQ YDEST YSRC))))
(BITBLT DS LMARG YSRC DS LMARG YDEST (ADD1 (IDIFFERENCE RMARG LMARG))
(ADD1 (IDIFFERENCE YTOP YDEST))
(QUOTE INPUT)
(QUOTE REPLACE))
(DSPCLEOL DS LMARG (if DOWNFLG
then (ADD1 (IDIFFERENCE YTOP AMOUNT))
else YBOT)
AMOUNT)
(RETURN T))))
(DSPINSCHAR
(LAMBDA (DS CHAR X Y TTBL) (* JonL " 2-MAY-83 19:04")
(\MACRO.MX (DSPINSCHAR DS CHAR X Y TTBL))))
(DSPDELCHAR
(LAMBDA (DS CHAR X Y TTBL) (* JonL " 2-MAY-83 19:04")
(\MACRO.MX (DSPDELCHAR DS CHAR X Y TTBL))))
(\DSPINSDELCHAR
(LAMBDA (DS CHAR X Y TTBL DELFLG) (* JonL " 2-MAY-83 23:47")
(SETQ DS (\SFInsureDisplayStream DS))
((LAMBDA (FONT)
(PROG ((DEFAULTPOS? (AND (NULL X)
(NULL Y)))
(RMARG (DSPRIGHTMARGIN NIL DS))
(X'(IPLUS (OR (FIXP X)
(SETQ X (DSPXPOSITION NIL DS)))
(\DSPTOTALCHARWIDTH FONT CHAR TTBL)))
(BTMLINE (IDIFFERENCE (OR (FIXP Y)
(SETQ Y (DSPYPOSITION NIL DS)))
(FONTDESCENT FONT)))
(HEIGHT (FONTHEIGHT FONT))
XSRC XDEST WIDTH)
(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 DS) (* Take down the caret, if there is one, just in case we
are backing up over it.)
(BITBLT DS XSRC BTMLINE DS 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 (BLTCHAR CHAR DS)
else (RESETFORM (\DSPVTSMOVETO (LIST X Y DS))
(BLTCHAR CHAR DS)))
else (DSPCLEOL DS (IPLUS X WIDTH)
Y HEIGHT))
(RETURN T) (* Move all the bits over to the right to make room for
this char)
))
(ffetch \SFFONT of DS))))
(DSPINSLINE
(LAMBDA (DS YPOS) (* JonL " 1-MAY-83 05:16")
(\MACRO.MX (DSPINSLINE DS YPOS))))
(DSPDELLINE
(LAMBDA (DS YPOS) (* JonL " 1-MAY-83 05:17")
(\MACRO.MX (DSPDELLINE DS YPOS))))
(\DSPINSDELLINE
(LAMBDA (DS YPOS DELFLG) (* JonL " 2-MAY-83 23:27")
(SETQ DS (\SFInsureDisplayStream DS))
(SETQ YPOS (OR (FIXP YPOS)
(IDIFFERENCE (DSPYPOSITION NIL DS)
(FONTDESCENT DS))))
(\CHECKCARET DS)
(PROG ((LINEHEIGHT (IMINUS (ffetch \SFLINEFEED of DS)))
(LEFT (DSPLEFTMARGIN NIL DS))
(BTM 0)
NXTBTM WIDTH)
(SETQ NXTBTM (IPLUS BTM LINEHEIGHT))
(SETQ WIDTH (IDIFFERENCE (DSPRIGHTMARGIN NIL DS)
LEFT))
(if DELFLG
then (SETQ BTM (PROG1 NXTBTM (SETQ NXTBTM BTM))))
(BITBLT DS LEFT NXTBTM DS LEFT BTM WIDTH (IDIFFERENCE (IPLUS YPOS LINEHEIGHT)
BTM)
(QUOTE INPUT)
(QUOTE REPLACE))
(DSPCLEOL DS LEFT (if DELFLG
then 0
else YPOS))
(RETURN T))))
)
(DEFINEQ
(\DSPVTSMOVETO
(LAMBDA (X) (* JonL " 2-MAY-83 23:45")
(PROG ((X (CAR X))
(Y (CADR X))
(DS (CADDR X))
OLD)
(SETQ OLD (LIST (DSPXPOSITION NIL DS)
(DSPYPOSITION NIL DS)
DS))
(MOVETO X Y DS)
(RETURN OLD))))
(CURSORHOMEUP
(LAMBDA (DS) (* JonL " 1-MAY-83 04:19")
(SETQ DS (\SFInsureDisplayStream DS))
(DSPXPOSITION (DSPLEFTMARGIN NIL DS)
DS)
(DSPYPOSITION (\GETDSTOPY DS)
DS)
T))
(CURSORHOMEDOWN
(LAMBDA (DS) (* JonL " 2-MAY-83 19:48")
(SETQ DS (\SFInsureDisplayStream DS))
(DSPXPOSITION (DSPLEFTMARGIN NIL DS)
DS)
(DSPYPOSITION (\GETDSBOTY DS)
DS)
T))
(CURSORUP
(LAMBDA (DS) (* JonL " 2-MAY-83 20:12")
(SETQ DS (\SFInsureDisplayStream DS))
((LAMBDA (NEWY)
(if (ILEQ NEWY (\GETDSTOPY DS))
then (DSPYPOSITION NEWY DS)
T))
(IDIFFERENCE (DSPYPOSITION NIL DS)
(ffetch \SFLINEFEED of DS)))))
(CURSORDOWN
(LAMBDA (DS) (* JonL " 2-MAY-83 20:14")
(SETQ DS (\SFInsureDisplayStream DS))
((LAMBDA (NEWY)
(if (IGEQ NEWY (\GETDSBOTY DS))
then (DSPYPOSITION NEWY DS)
T))
(IPLUS (DSPYPOSITION NIL DS)
(ffetch \SFLINEFEED of DS)))))
(CURSORMOVETO
(LAMBDA (ROW COL DS) (* JonL " 6-MAY-83 01:29")
(* 0-Origin address by rows and columns)
(SETQ DS (\SFInsureDisplayStream DS))
(PROG ((FONT (ffetch \SFFONT of DS))
(REG (ffetch \SFClippingRegion of DS))
TEM)
(if ROW
then (if (ILESSP ROW 0)
then (RETURN))
(SETQ TEM (IPLUS (\GETDSTOPY DS)
(ITIMES ROW (ffetch \SFLINEFEED of DS))))
(if (ILESSP TEM (IPLUS (fetch (REGION BOTTOM) of REG)
(FONTDESCENT FONT)))
then (RETURN))
(DSPYPOSITION TEM DS))
(if COL
then (if (ILESSP COL 0)
then (RETURN))
(SETQ TEM (ITIMES COL (\DSPTOTALCHARWIDTH FONT)))
(if (IGREATERP TEM (DSPRIGHTMARGIN NIL DS))
then (RETURN))
(DSPXPOSITION TEM DS))
(RETURN T))))
)
(DEFINEQ
(DSPCLEOP
(LAMBDA (DS XPOS YPOS) (* JonL " 2-MAY-83 23:55")
(SETQ DS (\SFInsureDisplayStream DS))
(\CHECKCARET DS)
(PROG ((REG (DSPCLIPPINGREGION NIL DS))
BTM)
(OR (FIXP XPOS)
(SETQ XPOS (DSPLEFTMARGIN NIL DS)))
(OR (FIXP YPOS)
(SETQ YPOS (IDIFFERENCE (DSPYPOSITION NIL DS)
(FONTDESCENT (ffetch \SFFONT of DS)))))
(DSPCLEOL DS XPOS YPOS)
(BITBLT NIL NIL NIL DS 0 0 (IDIFFERENCE (DSPLEFTMARGIN NIL DS)
(DSPRIGHTMARGIN NIL DS))
YPOS
(QUOTE TEXTURE)
(QUOTE REPLACE)))))
(DSPSTANDOUT
(LAMBDA (DS FLG) (* JonL " 2-AUG-83 17:01")
(SETQ DS (\SFInsureDisplayStream DS))
(PROG ((CF (DSPFONT NIL DS))
BOLDP)
(SETQ BOLDP (EQ (FONTPROP CF (QUOTE WEIGHT))
(QUOTE BOLD)))
(if (if FLG
then (NOT BOLDP)
else BOLDP)
then (* Not in correct mode)
(DSPFONT (FONTCOPY CF (QUOTE WEIGHT)
(if BOLDP
then (QUOTE MEDIUM)
else (QUOTE BOLD)))
DS))
(RETURN BOLDP))))
)
(PUTPROPS DSPVTS COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2623 7864 (CURSORLEFT 2633 . 2788) (CURSORRIGHT 2790 . 2947) (DSPSCROLLUP 2949 . 3113)
(DSPSCROLLDOWN 3115 . 3283) (\DSPSCROLLUPDOWN 3285 . 4579) (DSPINSCHAR 4581 . 4740) (DSPDELCHAR 4742
. 4901) (\DSPINSDELCHAR 4903 . 6698) (DSPINSLINE 6700 . 6850) (DSPDELLINE 6852 . 7002) (
\DSPINSDELLINE 7004 . 7862)) (7865 10350 (\DSPVTSMOVETO 7875 . 8190) (CURSORHOMEUP 8192 . 8442) (
CURSORHOMEDOWN 8444 . 8696) (CURSORUP 8698 . 9031) (CURSORDOWN 9033 . 9363) (CURSORMOVETO 9365 . 10348
)) (10351 11583 (DSPCLEOP 10361 . 10985) (DSPSTANDOUT 10987 . 11581)))))
STOP