TEDITSCREEN: Cleanup \DISPLAYLINE
Test argument validity at top so ffetch can be used consistently. Remove unused variables, and move some other variable bindings to their proper scope
This commit is contained in:
rmkaplan
parent
f58936e762
commit
388d54b713
@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "21-Sep-2021 12:53:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITSCREEN.;4 214736
|
||||
|
||||
changes to%: (MACROS MI-TEDIT.BLTCHAR)
|
||||
(VARS TEDITSCREENCOMS)
|
||||
(FNS \MAIKO.DISPLAYLINE \DISPLAYLINE)
|
||||
(FILECREATED "29-Sep-2021 22:03:57"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITSCREEN.;8 214517
|
||||
|
||||
previous date%: "30-Apr-2021 14:42:15"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITSCREEN.;1)
|
||||
changes to%: (FNS \DISPLAYLINE)
|
||||
|
||||
previous date%: "21-Sep-2021 12:53:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITSCREEN.;7)
|
||||
|
||||
|
||||
(* ; "
|
||||
@ -1094,247 +1093,245 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(\DISPLAYLINE
|
||||
[LAMBDA (TEXTOBJ LINE WINDOW) (* ; "Edited 21-Sep-2021 12:47 by rmk:")
|
||||
[LAMBDA (TEXTOBJ LINE WINDOW) (* ; "Edited 28-Sep-2021 15:00 by rmk:")
|
||||
|
||||
(* ;; "Display the line of text LINE in the edit window where it belongs.")
|
||||
|
||||
(PROG ((CH 0)
|
||||
(CHLIST (fetch (THISLINE CHARS) of (fetch (TEXTOBJ THISLINE) of TEXTOBJ)))
|
||||
(WLIST (fetch (THISLINE WIDTHS) of (fetch (TEXTOBJ THISLINE) of TEXTOBJ)))
|
||||
(LOOKS (fetch (THISLINE LOOKS) of (fetch (TEXTOBJ THISLINE) of TEXTOBJ)))
|
||||
(WINDOWDS (WINDOWPROP (OR WINDOW (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)))
|
||||
'DSP))
|
||||
(TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))
|
||||
(THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ))
|
||||
(TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ))
|
||||
(STREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))
|
||||
(OLDCACHE (fetch LCBITMAP of (fetch (TEXTOBJ DISPLAYCACHE) of TEXTOBJ)))
|
||||
(DS (fetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ))
|
||||
(HCPYDS (fetch (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ))
|
||||
(HARDCOPYMODE (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC)
|
||||
of LINE)))
|
||||
LOOKSTARTX CACHE \PCHARSLEFT \PSTRING \PFILE FONT OFONT OLOOKS XOFFSET CLIPLEFT CLIPRIGHT
|
||||
DISPLAYDATA DDPILOTBBT DDWIDTHCACHE DDOFFSETCACHE CURY LHEIGHT SCALE)
|
||||
[SETQ LHEIGHT (COND
|
||||
((fetch (LINEDESCRIPTOR PREVLINE) of LINE)
|
||||
(* ;; "Validate the incoming arguments so ffetch can be used consistently for all their field extractions.")
|
||||
|
||||
(\DTEST TEXTOBJ 'TEXTOBJ)
|
||||
(\DTEST LINE 'LINEDESCRIPTOR)
|
||||
(LET ((LOOKS (ffetch (THISLINE LOOKS) of (ffetch (TEXTOBJ THISLINE) of TEXTOBJ)))
|
||||
(WINDOWDS (WINDOWPROP (OR WINDOW (CAR (ffetch (TEXTOBJ \WINDOW) of TEXTOBJ)))
|
||||
'DSP))
|
||||
(THISLINE (\DTEST (ffetch (TEXTOBJ THISLINE) of TEXTOBJ)
|
||||
'THISLINE))
|
||||
(OLDCACHE (fetch (LINECACHE LCBITMAP) of (ffetch (TEXTOBJ DISPLAYCACHE)
|
||||
of TEXTOBJ)))
|
||||
(DS (ffetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ))
|
||||
(HCPYDS (ffetch (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ))
|
||||
(HARDCOPYMODE (fetch (FMTSPEC FMTHARDCOPY) of (ffetch (LINEDESCRIPTOR LFMTSPEC)
|
||||
of LINE)))
|
||||
CACHE OFONT OLOOKS XOFFSET CLIPLEFT CLIPRIGHT DISPLAYDATA DDPILOTBBT DDWIDTHCACHE
|
||||
DDOFFSETCACHE CURY LHEIGHT SCALE)
|
||||
[SETQ LHEIGHT (COND
|
||||
((ffetch (LINEDESCRIPTOR PREVLINE) of LINE)
|
||||
(* ;
|
||||
"So if theres a base-to-base measure, we clear everything right.")
|
||||
(IMAX (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT)
|
||||
of (fetch (LINEDESCRIPTOR PREVLINE)
|
||||
of LINE))
|
||||
(fetch (LINEDESCRIPTOR YBOT) of LINE))
|
||||
(fetch (LINEDESCRIPTOR LHEIGHT) of LINE)))
|
||||
(T (fetch (LINEDESCRIPTOR LHEIGHT) of LINE]
|
||||
(COND
|
||||
(HARDCOPYMODE (* ;
|
||||
(IMAX (IDIFFERENCE (ffetch (LINEDESCRIPTOR YBOT)
|
||||
of (ffetch (LINEDESCRIPTOR PREVLINE)
|
||||
of LINE))
|
||||
(ffetch (LINEDESCRIPTOR YBOT) of LINE))
|
||||
(ffetch (LINEDESCRIPTOR LHEIGHT) of LINE)))
|
||||
(T (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE]
|
||||
(SETQ SCALE (COND
|
||||
(HARDCOPYMODE (* ;
|
||||
"This is a hardcopy-mode line. Scale things.")
|
||||
(* ; "(SETQ DS HCPYDS)")
|
||||
(SETQ SCALE (DSPSCALE NIL HCPYDS)))
|
||||
(T (SETQ SCALE 1)))
|
||||
(SETQ CACHE (\TEDIT.LINECACHE (fetch (TEXTOBJ DISPLAYCACHE) of TEXTOBJ)
|
||||
(COND
|
||||
(HARDCOPYMODE (FIXR (FQUOTIENT (fetch (LINEDESCRIPTOR RIGHTMARGIN
|
||||
(DSPSCALE NIL HCPYDS))
|
||||
(T 1)))
|
||||
(SETQ CACHE (\TEDIT.LINECACHE (ffetch (TEXTOBJ DISPLAYCACHE) of TEXTOBJ)
|
||||
(COND
|
||||
(HARDCOPYMODE (FIXR (FQUOTIENT (ffetch (LINEDESCRIPTOR RIGHTMARGIN
|
||||
) of LINE)
|
||||
SCALE)))
|
||||
(T (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE)))
|
||||
LHEIGHT))
|
||||
(COND
|
||||
((NEQ CACHE OLDCACHE) (* ;
|
||||
SCALE)))
|
||||
(T (ffetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE)))
|
||||
LHEIGHT))
|
||||
(COND
|
||||
((NEQ CACHE OLDCACHE) (* ;
|
||||
"We changed the bitmaps because this line was bigger--update the displaystream, too")
|
||||
(DSPDESTINATION CACHE DS)
|
||||
(DSPCLIPPINGREGION (create REGION
|
||||
LEFT _ 0
|
||||
BOTTOM _ 0
|
||||
WIDTH _ (fetch BITMAPWIDTH of CACHE)
|
||||
HEIGHT _ (fetch BITMAPHEIGHT of CACHE))
|
||||
DS)))
|
||||
(BITBLT NIL 0 0 CACHE 0 0 NIL NIL 'TEXTURE 'REPLACE WHITESHADE)
|
||||
(DSPDESTINATION CACHE DS)
|
||||
(DSPCLIPPINGREGION (create REGION
|
||||
LEFT _ 0
|
||||
BOTTOM _ 0
|
||||
WIDTH _ (fetch BITMAPWIDTH of CACHE)
|
||||
HEIGHT _ (fetch BITMAPHEIGHT of CACHE))
|
||||
DS)))
|
||||
(BITBLT NIL 0 0 CACHE 0 0 NIL NIL 'TEXTURE 'REPLACE WHITESHADE)
|
||||
(* ; "Clear the line cache")
|
||||
(COND
|
||||
(HARDCOPYMODE (* ;
|
||||
"This is a hardcopy-mode line. Scale things.")
|
||||
(* ; "(SETQ DS HCPYDS)")
|
||||
(SETQ SCALE (DSPSCALE NIL HCPYDS)))
|
||||
(T (SETQ SCALE 1)))
|
||||
[COND
|
||||
((AND (NOT (ZEROP (fetch (LINEDESCRIPTOR CHAR1) of LINE)))
|
||||
(ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE)
|
||||
TEXTLEN)
|
||||
(IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)))
|
||||
[COND
|
||||
((AND (NOT (ZEROP (fetch (LINEDESCRIPTOR CHAR1) of LINE)))
|
||||
(ILEQ (ffetch (LINEDESCRIPTOR CHAR1) of LINE)
|
||||
(ffetch (TEXTOBJ TEXTLEN) of TEXTOBJ))
|
||||
(IGEQ (ffetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(ffetch (TEXTOBJ WBOTTOM) of TEXTOBJ)))
|
||||
|
||||
(* ;; "Only display the line of it contains text (CHAR1 > 0), appears before the end of the test, and is on-screen.")
|
||||
(* ;; "Only display the line of it contains text (CHAR1 > 0), appears before the end of the test, and is on-screen.")
|
||||
|
||||
(COND
|
||||
((NEQ (fetch (THISLINE DESC) of THISLINE)
|
||||
LINE) (* ;
|
||||
(COND
|
||||
((NEQ (fetch (THISLINE DESC) of THISLINE)
|
||||
LINE) (* ;
|
||||
"No image cache -- re-format and display")
|
||||
(\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) of LINE)
|
||||
LINE)))
|
||||
(MOVETO (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)
|
||||
(fetch (LINEDESCRIPTOR DESCENT) of LINE)
|
||||
DS)
|
||||
(SETQ DISPLAYDATA (fetch (STREAM IMAGEDATA) of DS))
|
||||
(SETQ DDPILOTBBT (ffetch DDPILOTBBT of DISPLAYDATA))
|
||||
(SETQ XOFFSET (fetch DDXOFFSET of DISPLAYDATA))
|
||||
(\FORMATLINE TEXTOBJ NIL (ffetch (LINEDESCRIPTOR CHAR1) of LINE)
|
||||
LINE)))
|
||||
(MOVETO (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)
|
||||
(ffetch (LINEDESCRIPTOR DESCENT) of LINE)
|
||||
DS)
|
||||
(SETQ DISPLAYDATA (fetch (STREAM IMAGEDATA) of DS))
|
||||
(SETQ DDPILOTBBT (ffetch DDPILOTBBT of DISPLAYDATA))
|
||||
(SETQ XOFFSET (fetch DDXOFFSET of DISPLAYDATA))
|
||||
|
||||
(* ;; "The X position of the left edge of the window, since \TEDIT.BLTCHAR works on the screen bitmap itself.")
|
||||
(* ;; "The X position of the left edge of the window, since \TEDIT.BLTCHAR works on the screen bitmap itself.")
|
||||
|
||||
(SETQ CLIPLEFT (fetch DDClippingLeft of DISPLAYDATA))
|
||||
(SETQ CLIPLEFT (fetch DDClippingLeft of DISPLAYDATA))
|
||||
(* ;
|
||||
"The left and right edges of the clipping region for the text display window.")
|
||||
(SETQ CLIPRIGHT (fetch DDClippingRight of DISPLAYDATA))
|
||||
(SETQ OFONT (DSPFONT (fetch CLFONT of (SETQ OLOOKS (\EDITELT LOOKS 0)))
|
||||
DS)) (* ; "The starting font")
|
||||
(SETQ DDWIDTHCACHE (ffetch DDWIDTHSCACHE of DISPLAYDATA))
|
||||
(SETQ CLIPRIGHT (fetch DDClippingRight of DISPLAYDATA))
|
||||
(SETQ OFONT (DSPFONT (fetch CLFONT of (SETQ OLOOKS (\EDITELT LOOKS 0)))
|
||||
DS)) (* ; "The starting font")
|
||||
(SETQ DDWIDTHCACHE (ffetch DDWIDTHSCACHE of DISPLAYDATA))
|
||||
(* ;
|
||||
"Cache the character-image widths")
|
||||
(SETQ DDOFFSETCACHE (ffetch DDOFFSETSCACHE of DISPLAYDATA))
|
||||
(SETQ DDOFFSETCACHE (ffetch DDOFFSETSCACHE of DISPLAYDATA))
|
||||
(* ;
|
||||
"And the offset-into-strike-bitmap array")
|
||||
(SETQ LOOKSTARTX (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE))
|
||||
(* ;
|
||||
"Starting X position for the current-looks text.")
|
||||
(AND (fetch CLOFFSET of OLOOKS)
|
||||
(RELMOVETO 0 (FIXR (FTIMES SCALE (fetch CLOFFSET of OLOOKS)))
|
||||
DS)) (* ;
|
||||
"LOOKSTARTX: Starting X position for the current-looks text.")
|
||||
(AND (fetch CLOFFSET of OLOOKS)
|
||||
(RELMOVETO 0 (FIXR (FTIMES SCALE (fetch CLOFFSET of OLOOKS)))
|
||||
DS)) (* ;
|
||||
"Any sub- or superscripting at start of line")
|
||||
(bind (LOOKNO _ 1)
|
||||
DX
|
||||
(TX _ (IPLUS XOFFSET (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)))
|
||||
for I from 0 to (fetch (THISLINE LEN) of THISLINE)
|
||||
do
|
||||
(bind (LOOKNO _ 1)
|
||||
DX CH (CHLIST _ (fetch (THISLINE CHARS) of (ffetch (TEXTOBJ THISLINE)
|
||||
of TEXTOBJ)))
|
||||
(WLIST _ (fetch (THISLINE WIDTHS) of (ffetch (TEXTOBJ THISLINE)
|
||||
of TEXTOBJ)))
|
||||
(TX _ (IPLUS XOFFSET (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)))
|
||||
(TERMSA _ (ffetch (TEXTOBJ TXTTERMSA) of TEXTOBJ))
|
||||
(LOOKSTARTX _ (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) for
|
||||
I
|
||||
from 0 to (ffetch (THISLINE LEN) of THISLINE)
|
||||
do
|
||||
|
||||
(* ;; "Display the line character by character")
|
||||
(* ;; "Display the line character by character")
|
||||
|
||||
(SETQ CH (\EDITELT CHLIST I)) (* ;
|
||||
(SETQ CH (\EDITELT CHLIST I)) (* ;
|
||||
"Grab the character (or IMAGEOBJ) to display")
|
||||
(SETQ DX (\EDITELT WLIST I)) (* ; "And its width")
|
||||
[SELECTC CH
|
||||
(LMInvisibleRun (* ;
|
||||
(SETQ DX (\EDITELT WLIST I)) (* ; "And its width")
|
||||
[SELECTC CH
|
||||
(LMInvisibleRun (* ;
|
||||
"An INVISIBLE run -- skip it, and skip over the char count")
|
||||
(add LOOKNO 1))
|
||||
(LMLooksChange (* ; "A LOOKS change")
|
||||
(replace DDXPOSITION of DISPLAYDATA
|
||||
with (IDIFFERENCE TX XOFFSET))
|
||||
(add LOOKNO 1))
|
||||
(LMLooksChange (* ; "A LOOKS change")
|
||||
(replace DDXPOSITION of DISPLAYDATA
|
||||
with (IDIFFERENCE TX XOFFSET))
|
||||
(* ;
|
||||
"Make the displaystream reflect our current X position")
|
||||
(TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS
|
||||
(fetch (LINEDESCRIPTOR DESCENT) of LINE))
|
||||
(TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS
|
||||
(ffetch (LINEDESCRIPTOR DESCENT) of LINE))
|
||||
(* ;
|
||||
"Make any necessary changes to the preceding characters (underline, strike-out &c)")
|
||||
(DSPFONT (fetch CLFONT of (SETQ OLOOKS
|
||||
(\EDITELT LOOKS LOOKNO))
|
||||
)
|
||||
DS) (* ; "Set the new font")
|
||||
(add LOOKNO 1) (* ; "Grab the next set of char looks")
|
||||
(AND (fetch CLOFFSET of OLOOKS)
|
||||
(RELMOVETO 0 (fetch CLOFFSET of OLOOKS)
|
||||
DS)) (* ; "Account for super/subscripting")
|
||||
(SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET))
|
||||
(DSPFONT (fetch CLFONT of (SETQ OLOOKS
|
||||
(\EDITELT LOOKS LOOKNO)))
|
||||
DS) (* ; "Set the new font")
|
||||
(add LOOKNO 1) (* ; "Grab the next set of char looks")
|
||||
(AND (fetch CLOFFSET of OLOOKS)
|
||||
(RELMOVETO 0 (fetch CLOFFSET of OLOOKS)
|
||||
DS)) (* ; "Account for super/subscripting")
|
||||
(SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET))
|
||||
(* ;
|
||||
"Remember the starting Xpos for possible later underlining &c")
|
||||
)
|
||||
((CHARCODE (TAB %#^I)) (* ;
|
||||
)
|
||||
((CHARCODE (TAB %#^I)) (* ;
|
||||
"TAB: use the width from the cache to decide the right formatting.")
|
||||
[COND
|
||||
((OR (IEQP CH (CHARCODE %#^I))
|
||||
(fetch CLLEADER of OLOOKS)
|
||||
(EQ (fetch CLUSERINFO of OLOOKS)
|
||||
'DOTTEDLEADER))
|
||||
(LET* [[LEADERFONT (COND
|
||||
(HARDCOPYMODE (FONTCOPY (fetch CLFONT
|
||||
of OLOOKS)
|
||||
'DEVICE HCPYDS))
|
||||
(T (fetch CLFONT of OLOOKS]
|
||||
(DOTWIDTH (CHARWIDTH (CHARCODE %.)
|
||||
LEADERFONT))
|
||||
(TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH
|
||||
(IREMAINDER TX DOTWIDTH]
|
||||
(while (ILEQ TTX (IPLUS TX DX))
|
||||
do (COND
|
||||
(HARDCOPYMODE
|
||||
(MI-TEDIT.BLTCHAR (CHARCODE %.)
|
||||
DS
|
||||
(FIXR (FQUOTIENT (IDIFFERENCE TTX
|
||||
DOTWIDTH)
|
||||
SCALE))
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT))
|
||||
((OR TERMSA HARDCOPYMODE)
|
||||
[COND
|
||||
((OR (IEQP CH (CHARCODE %#^I))
|
||||
(fetch CLLEADER of OLOOKS)
|
||||
(EQ (fetch CLUSERINFO of OLOOKS)
|
||||
'DOTTEDLEADER))
|
||||
(LET* [[LEADERFONT (COND
|
||||
(HARDCOPYMODE (FONTCOPY (fetch CLFONT
|
||||
of OLOOKS)
|
||||
'DEVICE HCPYDS))
|
||||
(T (fetch CLFONT of OLOOKS]
|
||||
(DOTWIDTH (CHARWIDTH (CHARCODE %.)
|
||||
LEADERFONT))
|
||||
(TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH
|
||||
(IREMAINDER TX DOTWIDTH]
|
||||
(while (ILEQ TTX (IPLUS TX DX))
|
||||
do (COND
|
||||
(HARDCOPYMODE (MI-TEDIT.BLTCHAR
|
||||
(CHARCODE %.)
|
||||
DS
|
||||
(FIXR (FQUOTIENT (IDIFFERENCE
|
||||
TTX DOTWIDTH)
|
||||
SCALE))
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT
|
||||
))
|
||||
((OR TERMSA HARDCOPYMODE)
|
||||
(* ;
|
||||
"Using special instrns from TERMSA")
|
||||
(\DSPPRINTCHAR DS (CHARCODE %.)))
|
||||
(T (* ; "Native charcodes")
|
||||
(MI-TEDIT.BLTCHAR (CHARCODE %.)
|
||||
DS
|
||||
(IDIFFERENCE TTX DOTWIDTH)
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT)))
|
||||
(add TTX DOTWIDTH])
|
||||
((CHARCODE (EOL LF CR)) (* ; "It's a CR")
|
||||
NIL)
|
||||
(NIL (* ; "NIL signifies a character we've suppressed as part of line formatting (e.g., a discretionary hyphen we didn't use to break the line). Show it as a thin black line.")
|
||||
(BLTSHADE BLACKSHADE DS TX 0 1 100 'PAINT))
|
||||
(COND
|
||||
[(SMALLP CH) (* ;
|
||||
(\DSPPRINTCHAR DS (CHARCODE %.)))
|
||||
(T (* ; "Native charcodes")
|
||||
(MI-TEDIT.BLTCHAR (CHARCODE %.)
|
||||
DS
|
||||
(IDIFFERENCE TTX DOTWIDTH)
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT)))
|
||||
(add TTX DOTWIDTH])
|
||||
((CHARCODE (EOL LF CR)) (* ; "It's a CR")
|
||||
NIL)
|
||||
(NIL (* ; "NIL signifies a character we've suppressed as part of line formatting (e.g., a discretionary hyphen we didn't use to break the line). Show it as a thin black line.")
|
||||
(BLTSHADE BLACKSHADE DS TX 0 1 100 'PAINT))
|
||||
(COND
|
||||
[(SMALLP CH) (* ;
|
||||
"Normal character -- just display it.")
|
||||
(COND
|
||||
(HARDCOPYMODE (MI-TEDIT.BLTCHAR CH DS (FIXR (FQUOTIENT TX SCALE))
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT))
|
||||
((OR TERMSA HARDCOPYMODE) (* ;
|
||||
(COND
|
||||
(HARDCOPYMODE (MI-TEDIT.BLTCHAR CH DS (FIXR (FQUOTIENT TX SCALE))
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT))
|
||||
((OR TERMSA HARDCOPYMODE) (* ;
|
||||
"Using special instrns from TERMSA")
|
||||
(\DSPPRINTCHAR DS CH))
|
||||
(T (* ; "Native charcodes")
|
||||
(MI-TEDIT.BLTCHAR CH DS TX DISPLAYDATA DDPILOTBBT CLIPRIGHT]
|
||||
(T (* ; "CH is an object.")
|
||||
(MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
|
||||
XOFFSET)
|
||||
(SETQ CURY (DSPYPOSITION NIL DS))
|
||||
DS) (* ;
|
||||
(\DSPPRINTCHAR DS CH))
|
||||
(T (* ; "Native charcodes")
|
||||
(MI-TEDIT.BLTCHAR CH DS TX DISPLAYDATA DDPILOTBBT CLIPRIGHT]
|
||||
(T (* ; "CH is an object.")
|
||||
(MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
|
||||
XOFFSET)
|
||||
(SETQ CURY (DSPYPOSITION NIL DS))
|
||||
DS) (* ;
|
||||
"Go to the base line, left edge of the image region.")
|
||||
(APPLY* (IMAGEOBJPROP CH 'DISPLAYFN)
|
||||
CH DS 'DISPLAY (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ
|
||||
))
|
||||
(APPLY* (IMAGEOBJPROP CH 'DISPLAYFN)
|
||||
CH DS 'DISPLAY (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ
|
||||
))
|
||||
(* ;
|
||||
"Tell him to display himself here.")
|
||||
(DSPFONT (fetch CLFONT of OLOOKS)
|
||||
DS)
|
||||
(MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
|
||||
XOFFSET)
|
||||
CURY DS) (* ;
|
||||
(DSPFONT (fetch CLFONT of OLOOKS)
|
||||
DS)
|
||||
(MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
|
||||
XOFFSET)
|
||||
CURY DS) (* ;
|
||||
"Move to after the object's image")
|
||||
]
|
||||
(add TX DX) (* ; "Update our X position")
|
||||
finally (replace DDXPOSITION of DISPLAYDATA
|
||||
with (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
|
||||
XOFFSET)) (* ;
|
||||
]
|
||||
(add TX DX) (* ; "Update our X position")
|
||||
finally (replace DDXPOSITION of DISPLAYDATA
|
||||
with (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
|
||||
XOFFSET)) (* ;
|
||||
"Make any necessary looks mods to the last run of characters")
|
||||
(TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS (fetch (LINEDESCRIPTOR
|
||||
(TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS (ffetch (LINEDESCRIPTOR
|
||||
DESCENT)
|
||||
of LINE]
|
||||
(BITBLT CACHE 0 0 WINDOWDS 0 (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(fetch (TEXTOBJ WRIGHT) of TEXTOBJ)
|
||||
LHEIGHT
|
||||
'INPUT
|
||||
'REPLACE) (* ;
|
||||
of LINE]
|
||||
(BITBLT CACHE 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(ffetch (TEXTOBJ WRIGHT) of TEXTOBJ)
|
||||
LHEIGHT
|
||||
'INPUT
|
||||
'REPLACE) (* ;
|
||||
"Paint the cached image on the screen (this lessens flicker during update)")
|
||||
(COND
|
||||
((fetch (FMTSPEC FMTREVISED) of (fetch (LINEDESCRIPTOR LFMTSPEC)
|
||||
of LINE))
|
||||
(COND
|
||||
((fetch (FMTSPEC FMTREVISED) of (ffetch (LINEDESCRIPTOR LFMTSPEC)
|
||||
of LINE))
|
||||
(* ;
|
||||
"This paragraph has been revised, so mark it.")
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)
|
||||
WINDOWDS LINE)))
|
||||
(SELECTQ (fetch (LINEDESCRIPTOR LMARK) of LINE)
|
||||
(GREY (* ;
|
||||
(\TEDIT.MARK.REVISION TEXTOBJ (ffetch (LINEDESCRIPTOR LFMTSPEC) of LINE)
|
||||
WINDOWDS LINE)))
|
||||
(SELECTQ (ffetch (LINEDESCRIPTOR LMARK) of LINE)
|
||||
(GREY (* ;
|
||||
"This line has some property that isn't visible to the user. Tell him to be careful")
|
||||
(BITBLT NIL 0 0 WINDOWDS 0 (fetch (LINEDESCRIPTOR YBASE) of LINE)
|
||||
6 6 'TEXTURE 'PAINT 42405))
|
||||
(SOLID (* ;
|
||||
(BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE)
|
||||
6 6 'TEXTURE 'PAINT 42405))
|
||||
(SOLID (* ;
|
||||
"This line has some property that isn't visible to the user. Tell him to be careful")
|
||||
(BITBLT NIL 0 0 WINDOWDS 0 (fetch (LINEDESCRIPTOR YBASE) of LINE)
|
||||
6 6 'TEXTURE 'PAINT BLACKSHADE))
|
||||
(BITBLT NIL 0 0 WINDOWDS 0 (fetch (LINEDESCRIPTOR YBASE) of LINE)
|
||||
6 6 'TEXTURE 'REPLACE WHITESHADE])
|
||||
(BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE)
|
||||
6 6 'TEXTURE 'PAINT BLACKSHADE))
|
||||
(BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE)
|
||||
6 6 'TEXTURE 'REPLACE WHITESHADE])
|
||||
|
||||
(\TEDIT.LINECACHE
|
||||
(LAMBDA (CACHE WIDTH HEIGHT) (* jds "21-Apr-84 00:52")
|
||||
@ -2991,16 +2988,16 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
(PUTPROPS TEDITSCREEN COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1992 1993 1994 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2874 76866 (\FORMATLINE 2884 . 56612) (\TEDIT.NSCHAR.RUN 56614 . 63431) (
|
||||
\TEDIT.PURGE.SPACES 63433 . 63891) (\DOFORMATTING 63893 . 76864)) (76867 98847 (\DISPLAYLINE 76877 .
|
||||
94847) (\TEDIT.LINECACHE 94849 . 95600) (\TEDIT.CREATE.LINECACHE 95602 . 96346) (\TEDIT.BLTCHAR 96348
|
||||
. 98845)) (99561 214016 (TEDIT.CR.UPDATESCREEN 99571 . 100822) (TEDIT.DELETELINE 100824 . 101858) (
|
||||
TEDIT.INSERT.DISPLAYTEXT 101860 . 117099) (TEDIT.INSERT.UPDATESCREEN 117101 . 123853) (
|
||||
TEDIT.UPDATE.SCREEN 123855 . 125073) (\BACKFORMAT 125075 . 129386) (\FILLWINDOW 129388 . 144492) (
|
||||
\FIXDLINES 144494 . 151731) (\FIXILINES 151733 . 159708) (\SHOWTEXT 159710 . 162966) (
|
||||
\TEDIT.ADJUST.LINES 162968 . 170435) (\TEDIT.CLEAR.SCREEN.BELOW.LINE 170437 . 171167) (
|
||||
\TEDIT.CLOSEUPLINES 171169 . 179685) (\TEDIT.COPY.LINEDESCRIPTOR 179687 . 185253) (
|
||||
\TEDIT.FIXCHANGEDLINE 185255 . 196434) (\TEDIT.FIXCHANGEDPART 196436 . 208863) (\TEDIT.INSERTLINE
|
||||
208865 . 209685) (\TEDIT.LINE.LIST 209687 . 210013) (\TEDIT.MARK.LINES.DIRTY 210015 . 211701) (
|
||||
\TEDIT.NEXT.LINE.BOTTOM 211703 . 214014)))))
|
||||
(FILEMAP (NIL (2767 76759 (\FORMATLINE 2777 . 56505) (\TEDIT.NSCHAR.RUN 56507 . 63324) (
|
||||
\TEDIT.PURGE.SPACES 63326 . 63784) (\DOFORMATTING 63786 . 76757)) (76760 98628 (\DISPLAYLINE 76770 .
|
||||
94628) (\TEDIT.LINECACHE 94630 . 95381) (\TEDIT.CREATE.LINECACHE 95383 . 96127) (\TEDIT.BLTCHAR 96129
|
||||
. 98626)) (99342 213797 (TEDIT.CR.UPDATESCREEN 99352 . 100603) (TEDIT.DELETELINE 100605 . 101639) (
|
||||
TEDIT.INSERT.DISPLAYTEXT 101641 . 116880) (TEDIT.INSERT.UPDATESCREEN 116882 . 123634) (
|
||||
TEDIT.UPDATE.SCREEN 123636 . 124854) (\BACKFORMAT 124856 . 129167) (\FILLWINDOW 129169 . 144273) (
|
||||
\FIXDLINES 144275 . 151512) (\FIXILINES 151514 . 159489) (\SHOWTEXT 159491 . 162747) (
|
||||
\TEDIT.ADJUST.LINES 162749 . 170216) (\TEDIT.CLEAR.SCREEN.BELOW.LINE 170218 . 170948) (
|
||||
\TEDIT.CLOSEUPLINES 170950 . 179466) (\TEDIT.COPY.LINEDESCRIPTOR 179468 . 185034) (
|
||||
\TEDIT.FIXCHANGEDLINE 185036 . 196215) (\TEDIT.FIXCHANGEDPART 196217 . 208644) (\TEDIT.INSERTLINE
|
||||
208646 . 209466) (\TEDIT.LINE.LIST 209468 . 209794) (\TEDIT.MARK.LINES.DIRTY 209796 . 211482) (
|
||||
\TEDIT.NEXT.LINE.BOTTOM 211484 . 213795)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user