123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756 |
- %
- % V-SCREEN.SL - Utilities to handle "virtual screens" (alias "windows").
- %
- % Author: William F. Galway
- % Symbolic Computation Group
- % Computer Science Dept.
- % University of Utah
- % Date: 8 June 1982
- % Copyright (c) 1982 University of Utah
- %
- % These utilities implement "virtual screens" , and do screen refresh.
- % (Primarily designed to serve as a support package for EMODE, but may be
- % more generally useful.)
- % Some support routines for this package reside in the file
- % "V-SCREEN-SUPPORT.RED".
- % The current implementation is tentative--needs more thought, more
- % formalization of how refresh should work, better handling of terminals
- % with line insert/delete, better handling of scrolling, more consideration
- % of methods used for the Lisp Machine, etc. (Should there be fewer levels
- % of storage?)
- % Virtual screens are represented as vectors of strings, one string for
- % each row of the "screen". (Other information, such as virtual cursor
- % location, is also stored in the structure.)
- % Virtual screens are created with the function "CreateVirtualScreen". They
- % aren't actually displayed until you call "SelectScreen"--which assigns a
- % "screen number" for the screen (for masking) if it doesn't already have
- % one, and "draws" the new screen "on top" of all the others. (I.e. it
- % "activates" the screen.) Screens can be made to disappear by covering
- % them with other screens, or by calling "DeSelectScreen". It IS legal to
- % operate on inactive screens (i.e. write to them, move the virtual cursor,
- % etc). To completely get rid of a screen, get rid of all references to
- % it, and it will go away at the next garbage collection.
- % The philosophy is that these arrays will serve as caches for stuff that
- % can't actually make it to the "true screen" because of being covered by
- % other "virtual screens". The routines are optimized for writing
- % characters onto a virtual screen--moving screens, putting a new screen on
- % the top, etc., are much less efficiently handled.
- % (Talk about fact that the two "screen images" don't really work the same
- % way as virtual screens?)
- % Maximum number of "masks" allowed. (Corresponds to the largest number we
- % can fit into a byte.)
- (DefConst MaxMaskNumber 127)
- % Macro for indexing into a "virtual screen" (vector of strings).
- (DS index_screen (Scrn rw col)
- (igets (igetv Scrn rw) col)) % Fast string and vector accessors
- % "Left associative" version of "Expand". (Expand is right associative.)
- % Useful for expanding macros for N-ary versions of left associative
- % operators. (We should really have a "robust" version of this
- % utility--see "RobustExpand".)
- (BothTimes % CompileTime?
- (DE LeftAssociativeExpand (args Fn)
- (LeftAssociativeExpand1 Fn (car args) (cdr args)))
- )
- % Utility for implementing LeftAssociativeExpand.
- % Similar to tail recursive definition of "(reverse x)" as "(rev1 x nil)".
- (BothTimes % CompileTime?
- (DE LeftAssociativeExpand1 (Fn ProcessedArgs args)
- (cond
- % No arguments left to process
- ((null args) ProcessedArgs)
- (T (LeftAssociativeExpand1
- Fn
- (list Fn ProcessedArgs (car args))
- (cdr args)))))
- )
- % N-ary version of indx. (indexn X I J) is same as (indx (indx X I) J).
- (BothTimes % CompileTime?
- (DM indexn (U)
- (LeftAssociativeExpand (cdr U) 'Indx))
- )
- % Define components for a "range".
- (DefStruct (range fast-vector) % Make vector accesses "fast".
- MinRange % Minimum of a range.
- MaxRange % Maximum of a range.
- )
- % Return T if number "x" is within range "rnge".
- (DS WithinRangeP (x rnge)
- (and
- (LeQ (MinRange rnge) x)
- (LeQ x (MaxRange rnge))))
- % Update a "range" so that it "brackets" a new value.
- (DE PutValueIntoRange (x rnge)
- (progn
- % New minimum if x < old minimum
- (cond
- ((LessP x (MinRange rnge))
- (setf (MinRange rnge) x)))
- % New maximum if x > old maximum.
- (cond
- ((GreaterP x (MaxRange rnge))
- (setf (MaxRange rnge) x)))
- % Return the new (destructively modified) range.
- rnge))
- % Define components for a VirtualScreen
- (DefStruct (VirtualScreen fast-vector)
- MaskNumber % A number taken from FreeMaskList when "active",
- % negative when "inactive".
- VirtualImage % Vector of strings giving the "screen image".
- BlankRanges % Vector of ranges--indicating an "all blank" section of
- % each line of the virtual screen.
- % Position of virtual cursor. Not used for much except to position the
- % physical cursor at the topmost screen's virtual cursor. (In
- % particular, the virtual cursor doesn't have anything to do with where
- % the last character was written.)
- ScreensCursorRow
- ScreensCursorColumn
- % Perhaps the location of a screen shouldn't be stored with the
- % screen? These values may be NIL, when we don't really care?
- % Absolute coordinates (or, perhaps relative to "parent" screen) of upper
- % left hand corner.
- ScreensRowLocation
- ScreensColumnLocation
- )
- % Return the "height" of a virtual screen.
- % Actually returns the maximum row number (height - 1, due to 0 indexing).
- (DS VirtualScreenHeight (Scrn)
- (size (VirtualImage Scrn)))
- % Return the "width" of a virtual screen. (See above note about 0
- % indexing.)
- (DS VirtualScreenWidth (Scrn)
- % Return the "width" of a representative string.
- (size (igetv (VirtualImage Scrn) 0)))
- (FLUID
- '(
- MaxPhysicalRow % Dimensions of the "PhysicalScreenImage" (actual
- % number of rows is one plus this--due to 0
- % indexing.)
- MaxPhysicalColumn % (That was for rows, here's for columns.)
- PhysicalScreenImage % Our idea of what's currently on the screen.
- PhysicalCursorRow % Current location of the physical cursor.
- PhysicalCursorColumn
- NewScreenImage % What should go there next.
- MaskInfo % Used to handle overlapping windows.
- ChangedRowRange % Rows on NewScreenImage will differ from those on
- % PhysicalScreenImage only within this range.
- ChangedColumnRanges % Similar information for columns on each row.
- FreeMaskList % Used to allocate "mask numbers".
- ActiveScreenList % The allocated screens go onto this list.
- )
- )
- % Create a "screen image" (a vector of strings), filled with character
- % "chr".
- (DE CreateScreenImage (chr rws cols)
- (prog (result)
- (setf result (MkVect (sub1 rws)))
- (for (from i 0 (sub1 rws) 1)
- (do (setf (indexn result i) (MkString (sub1 cols) chr))))
- (return result)))
- % Write a "screen image" to a channel. (Not a "virtual screen", but the
- % actual vector of strings component of a virtual screen.)
- (DE WriteScreenImage (ScrnImage chn)
- (progn
- (WRS chn) % Select the channel for output.
- (for (from i 0 (size ScrnImage) 1)
- % Write out the line, followed by a "newline".
- (do (Prin2T (indexn ScrnImage i))))
- (WRS NIL) % Switch back to standard output.
- ))
- % Initialize the screen package--allocate space for "screen image", build
- % "free" and "active" list, clear the screen, etc. Must be using "raw" I/O
- % when this routine is called.
- (DE InitializeScreenPackage ()
- (progn
- % Numbers for "active" virtual screens are allocated from a free screen
- % list, which gets initialized here.
- (setf FreeMaskList NIL)
- (for (from i 1 (const MaxMaskNumber) 1)
- (do (setf FreeMaskList (cons i FreeMaskList))))
- % List of active screens is initially NIL.
- (setf ActiveScreenList NIL)
- % Maximum row number for the physical screen.
- (setf MaxPhysicalRow (Row ScreenDelta))
- % System's idea of width is assumed to always be good.
- (setf MaxPhysicalColumn (Column ScreenDelta))
- (EraseScreen) % Clear the screen.
- % Create PhysicalScreenImage--gets a blank screen array.
- (setf PhysicalScreenImage
- (CreateScreenImage
- (char BLANK)
- (add1 MaxPhysicalRow)
- (add1 MaxPhysicalColumn)))
- % Identical sort of thing for NewScreenImage.
- (setf NewScreenImage
- (CreateScreenImage
- (char BLANK)
- (add1 MaxPhysicalRow)
- (add1 MaxPhysicalColumn)))
- % Setup "changed" information (no changes between NewScreenImage and
- % PhysicalScreenImage initially).
- % Set to an "empty range", one where minimum is >= largest possible
- % range, while maximum is <= smallest possible value.
- (setf ChangedRowRange
- (make-range
- MinRange MaxPhysicalRow
- MaxRange 0))
- % One piece of "column change" information per row.
- (setf ChangedColumnRanges (MkVect MaxPhysicalRow))
- (for (from i 0 MaxPhysicalRow 1) % Set up each row entry.
- (do
- (setf
- (indexn ChangedColumnRanges i)
- (make-range
- MinRange MaxPhysicalColumn
- MaxRange 0))))
- % Set up the MaskInfo array, but fill with 0's (NULLS) instead of blanks.
- (setf MaskInfo
- (CreateScreenImage
- 0
- (add1 MaxPhysicalRow)
- (add1 MaxPhysicalColumn)))))
- % Create and return (but don't show) a new screen. Use "SelectScreen" to
- % actually display the screen.
- (DE CreateVirtualScreen (rws cols CornerRow CornerCol)
- % Allocate and return the screen.
- (prog (NewVS)
- (setf NewVS
- (make-VirtualScreen
- % Don't assign a real (positive) mask number until screen is
- % activated.
- MaskNumber -1
- VirtualImage (CreateScreenImage (char BLANK) rws cols)
- BlankRanges (MkVect (sub1 rws))
- ScreensCursorRow 0 % Initially, cursor is at upper left corner.
- ScreensCursorColumn 0
- ScreensRowLocation CornerRow
- ScreensColumnLocation CornerCol))
- (for (from i 0 (sub1 rws) 1)
- (do
- (setf
- (indexn (BlankRanges NewVS) i)
- (make-range
- MinRange 0
- MaxRange (sub1 cols)))))
- (return NewVS)))
- % Clear out (set to all blanks) a virtual screen.
- (de ClearVirtualScreen (scrn)
- (let ((right-col (VirtualScreenWidth scrn)))
- (for (from rw 0 (VirtualScreenHeight scrn))
- (do
- (WriteToScreenRange
- scrn (char BLANK) rw 0 right-col)))))
- % Return T iff the coordinates are within an "array". (Vector of
- % "vectors".)
- (DE WithinArrayP (ScrnArray rw col)
- (and
- (LeQ 0 rw)
- (LeQ rw (size ScrnArray))
- (LeQ 0 col)
- (LeQ col (size (igetv ScrnArray 0)))))
- % Write a character to "NewScreenImage" at some coordinate, or ignore it if
- % outside the screen. Don't check coordinates for validity, don't update
- % change information--let the caller do that. (For efficiency reasons,
- % dammit. A compiler that was smart about index calculation within loops
- % would make a lot of this hacking unnecessary?)
- (DS WriteToNewScreenImage (chr absrow abscol)
- % Store the character
- (setf (index_screen NewScreenImage absrow abscol) chr))
-
- % "Write" a character onto a virtual screen, at location (rw, col).
- % Let the character "trickle" to the "NewScreenImage" if the cell isn't
- % covered. Ignore characters that would be off the screen.
- (DE WriteToScreen (Scrn chr rw col)
- (prog (absrow abscol)
- % If the new character lies on the virtual screen ...
- (cond
- % OPTIMIZE this test!!!
- ((WithinArrayP (VirtualImage Scrn) rw col)
- % Then store the new character and let it "trickle"
- (progn
- (setf (index_screen (VirtualImage Scrn) rw col) chr)
- % Update our idea of the "all blank" region on the screen.
- (cond
- ((not (equal chr (char BLANK)))
- % Character is non-blank, so shrink the range.
- (prog (BlnkRange LeftSize RightSize)
- (setf BlnkRange (igetv (BlankRanges Scrn) rw))
- % If the non-blank character falls within the blank region.
- (cond
- ((WithinRangeP col BlnkRange)
- (progn
- % Find the larger of the two ranges on either side of
- % col.
- (setf LeftSize (difference col (MinRange BlnkRange)))
- (setf RightSize
- (difference (MaxRange BlnkRange) col))
- (cond
- ((LessP LeftSize RightSize)
- (setf (MinRange BlnkRange) (add1 col)))
- % Otherwise, the left range is larger.
- (T (setf (MaxRange BlnkRange) (sub1 col))))))))))
- % Find absolute location for character
- (setf absrow (plus rw (ScreensRowLocation Scrn)))
- (setf abscol (plus col (ScreensColumnLocation Scrn)))
- (cond
- % If the character falls on the screen, and this screen is the
- % one on the top, and the character differs from what's already
- % there ...
- ((and
- (WithinArrayP MaskInfo absrow abscol)
- (equal
- (MaskNumber Scrn)
- (index_screen MaskInfo absrow abscol))
- (not (equal chr (index_screen NewScreenImage absrow abscol))))
- % ... then do it
- (progn
- (WriteToNewScreenImage chr absrow abscol)
- % Update the changed "range" (region?) information. Note
- % that PutValueIntoRange is "destructive".
- (PutValueIntoRange absrow ChangedRowRange)
- (PutValueIntoRange abscol (igetv ChangedColumnRanges
- absrow)
- )))))))))
- % Write a character to a range of a row of a virtual screen--useful for
- % (and optimized for) clearing to the end of a line. (Not optimized for
- % characters other than blank--could use some more work.) Writes into the
- % range from LeftCol to RightCol inclusive, lets things "trickle out".
- (DE WriteToScreenRange (Scrn chr rw LeftCol RightCol)
- (progn
- % Ignore the call if the row is outside the screen range.
- (cond
- ((GreaterP rw (VirtualScreenHeight scrn))
- (return NIL)))
- % Clip the edges of the range to write to
- (setf LeftCol (max LeftCol 0))
- % We look at the 0'th line in (VirtualImage Scrn) to find its width.
- (setf RightCol (min RightCol (size (igetv (VirtualImage Scrn) 0))))
- (cond
- % Treat blanks specially
- ((equal chr (char BLANK))
- (prog (OldLeft OldRight BlnkRange)
- % Get the boundaries of the previous "blank range" for this line.
- (setf BlnkRange (igetv (BlankRanges Scrn) rw))
- (setf OldLeft (MinRange BlnkRange))
- (setf OldRight (MaxRange BlnkRange))
- % Write blanks out to the ranges that are not already blank (we
- % depend on "for" loops gracefully handling "empty" ranges).
- (WriteRange Scrn chr rw LeftCol (min RightCol (sub1 OldLeft)))
- (WriteRange Scrn chr rw (max LeftCol (add1 OldRight)) RightCol)
- % Update the "known blank" range. Be "pessimistic", there may be
- % more blank than this. (But it's to much work to make sure?)
- (setf (MinRange BlnkRange) LeftCol)
- (setf (MaxRange BlnkRange) RightCol)))
- % OTHERWISE (character isn't blank).
- (T
- (WriteRange Scrn chr rw LeftCol RightCol)))))
- % Support for WriteToScreenRange.
- (DE WriteRange (Scrn chr rw LeftCol RightCol)
- (for (from i LeftCol RightCol 1)
- (do
- (WriteToScreen Scrn chr rw i))))
- % Refresh the "new screen image" from the active screen list, regenerating
- % the mask information and "NewScreenImage".
- (DE DrawActiveList ()
- (progn
-
- % Draw from "back to front".
- (foreach Scrn in (reverse ActiveScreenList) do
- (DrawScreenOnTop Scrn))))
- % Draw a screen as the topmost "active" screen. If the screen wasn't
- % previously on the active list, put it there. Otherwise, just put it at
- % the front of the list. In either case, adjust the "mask" so that the
- % selected screen dominates anything else--and (re)draw the screen.
- (DE SelectScreen (Scrn)
- (cond
- ((or
- % If the list is empty or the new screen on top doesn't equal the
- % current one on top...
- (null ActiveScreenList)
- (not (eq Scrn (car ActiveScreenList))))
- % ... then actually do something. I.e. don't bother doing anything
- % if we're selecting the current topmost screen.
- (progn
- % If this screen hasn't yet been activated (assigned a mask number)
- (cond
- ((minusp (MaskNumber Scrn))
- % ... then give it one.
- (progn
- % Complain if we've run out of mask numbers.
- (cond ((null FreeMaskList)
- (ERROR "No masks left to allocate")))
- % otherwise, assign the first free number.
- (setf
- (MaskNumber Scrn)
- (prog1
- (car FreeMaskList)
- (setf FreeMaskList (cdr FreeMaskList))))))
- % If it's already there, then delete the screen from its current
- % location in the list.
- (T
- (setf ActiveScreenList (DelQIP Scrn ActiveScreenList))))
- % Put the screen onto the front of the list.
- (setf ActiveScreenList (cons Scrn ActiveScreenList))
- % (re)draw the screen itself, regenerating the mask too.
- (DrawScreenOnTop Scrn)))))
- % Remove a screen from the active list (and from the physical screen).
- % (Do nothing if the screen isn't on the list?)
- (DE DeSelectScreen (Scrn)
- (prog (AbsLeftCol AbsRightCol linewidth)
- (setf ActiveScreenList (DelQIP Scrn ActiveScreenList))
- % Make the mask number available for re-use.
- (setf FreeMaskList (cons (MaskNumber Scrn) FreeMaskList))
- % Give the screen an invalid mask number.
- (setf (MaskNumber Scrn) -1)
- (setf AbsLeftCol
- (max % Absolute location of left column
- 0
- (ScreensColumnLocation Scrn)))
- (setf AbsRightCol
- (min
- MaxPhysicalColumn
- (plus (VirtualScreenWidth Scrn) (ScreensColumnLocation Scrn))))
- % Line width--add one to compensate for zero indexing.
- (setf linewidth (add1 (difference AbsRightCol AbsLeftCol)))
- % Erase the virtual screen from NewScreenImage. Also, get rid of the
- % mask. (Being a bit sloppy and perhaps erasing stuff covering this
- % screen.)
- (for (from
- absrow
- (max 0 (ScreensRowLocation Scrn))
- (min MaxPhysicalRow
- (plus (ScreensRowLocation Scrn) (VirtualScreenHeight Scrn)))
- 1)
- (do
- (progn
- % First, clear up the NewScreenImage.
- (FillSubstring
- (indexn NewScreenImage absrow) % Line to write to
- AbsLeftCol % Lefthand column of range
- linewidth % Number of characters to write
- (char BLANK)) % Character to write
- % Next, clear up the mask
- (FillSubstring
- (indexn MaskInfo absrow)
- AbsLeftCol
- linewidth
- 0) % Zero for no mask present.
- % Finally, fix up the "changed" information
- (PutValueIntoRange absrow ChangedRowRange)
- % Put the left margin of change into the range.
- (PutValueIntoRange AbsLeftCol (indexn ChangedColumnRanges
- absrow))
- % Then put the right margin into the range.
- (PutValueIntoRange
- AbsRightCol
- (indexn ChangedColumnRanges absrow)))))
- % Redraw the active stuff.
- (DrawActiveList)))
- % "Draw" a virtual screen onto the top of the "new screen image",
- % regenerate mask information also.
- (DE DrawScreenOnTop (Scrn)
- (prog (MskNumber absrow abscol srccol lineimage linewidth)
- (setf MskNumber (MaskNumber Scrn))
- % For each row of the virtual screen ...
- (for (from i 0 (VirtualScreenHeight Scrn) 1)
- % update the screen from that row
- (do
- (progn
- (setf lineimage (indexn (VirtualImage Scrn) i))
- (setf absrow (plus i (ScreensRowLocation Scrn)))
- (cond
- % If this row is (possibly) on the physical screen ...
- ((and (LeQ 0 absrow) (LeQ absrow MaxPhysicalRow))
- % ... then update the mask, and NewScreenImage
- (progn
- % Add1 to compensate for zero indexing.
- (setf linewidth (add1 (VirtualScreenWidth Scrn)))
- (setf abscol (ScreensColumnLocation Scrn))
- % Typically source text comes starting with the leftmost part
- % of lineimage.
- (setf srccol 0)
- % Clip off anything to the left of the physical screen
- (cond
- ((LessP abscol 0)
- (progn
- (setf linewidth
- (max 0 (plus linewidth abscol)))
- (setf srccol (minus abscol))
- (setf abscol 0))))
- % Fill in the new mask information
- (FillSubstring
- % Destination string, namely MaskInfo indexed by absolute
- % row number of the screen line.
- (indexn MaskInfo absrow)
- abscol % Starting location within destination string.
- linewidth % Number of characters.
- MskNumber) % The character (mask number) to fill with.
- % Copy the row on the screen to NewScreenImage.
- (MoveSubstringToFrom
- (indexn NewScreenImage absrow) % Destination string
- lineimage % Source string
- abscol % Destination index
- srccol % Source index
- linewidth) % number of characters to transfer
- % Update the "change information".
- (PutValueIntoRange absrow ChangedRowRange)
- % Put the left margin of change into the range.
- (PutValueIntoRange abscol (indexn ChangedColumnRanges absrow))
- % Then put the right margin into the range.
- (PutValueIntoRange
- (min
- (plus abscol linewidth -1)
- MaxPhysicalColumn)
- (indexn ChangedColumnRanges absrow))))))))))
- % Redraw the physical screen so that it looks like NewScreenImage. This is
- % the routine that's responsible for minimizing the characters sent to the
- % physical terminal.
- % If the argument is non-NIL then it's OK to
- % quit refreshing if more input is pending from the terminal (checked on
- % each line). BUT, we don't "breakout" if we're on the "current" line?
- % BREAKOUT NOT IMPLEMENTED YET.
- (DE RefreshPhysicalScreen (BreakoutAllowed)
- (prog (rw)
- (setf rw (MinRange ChangedRowRange))
- % Write the changed characters out to the physical screen.
- (while (and
- (LeQ rw (MaxRange ChangedRowRange))
- % **** (ZeroP (CharsInInputBuffer)) %NEEDS MORE THOUGHT!
- )
- % DO ...
- (progn
- % Call special routine to hunt down the changed characters, and
- % call WritePhysicalCharacter for each such beast.
- (RewriteChangedCharacters
- % Old line.
- (igetv PhysicalScreenImage rw)
- % New line
- (igetv NewScreenImage rw)
- % The row number
- rw
- % Leftmost change
- (MinRange (igetv ChangedColumnRanges rw))
- % Rightmost change
- (MaxRange (igetv ChangedColumnRanges rw)))
- % Flush the output buffer after every line (even if no characters
- % sent out).
- (FlushStdOutputBuffer)
- % Reset the change information for this row--to indicate that there
- % is no difference between NewScreenImage and PhysicalScreenImage.
- (alter-range (igetv ChangedColumnRanges rw)
- MinRange MaxPhysicalColumn
- MaxRange 0)
- (incr rw) % Advance to next row.
- ))
- % Reinitialize the "change" information to indicate that NewScreenImage
- % and PhysicalScreenImage agree--up to whatever row we reached before
- % breakout.
- (alter-range ChangedRowRange
- MinRange rw)
- % Finally--move the cursor to the spot corresponding to the topmost
- % virtual screen's cursor.
- (cond
- % If there are any active screens at all ...
- (ActiveScreenList
- % ... then move to appropriate spot.
- (prog (Scrn)
- (setf Scrn (car ActiveScreenList))
- (MoveToPhysicalLocation
- (plus (ScreensCursorRow Scrn) (ScreensRowLocation Scrn))
- (plus (ScreensCursorColumn Scrn) (ScreensColumnLocation Scrn))
- )
- % Make sure the characters actually get sent.
- (FlushStdOutputBuffer))))))
- % Write a character onto the physical screen, recording the fact in
- % PhysicalScreenImage. (May want to hack "RewriteChangedCharacters" to do
- % the storing into PhysicalScreenImage?)
- (DE WritePhysicalCharacter (chr rw col)
- (progn
- % Move to the appropriate physical location (optimizing cursor motion).
- (MoveToPhysicalLocation rw col)
- (PBOUT chr) % Write out the character
- % Store the new character in the image.
- (setf (index_screen PhysicalScreenImage rw col) chr)
- % Need to update our idea of the physical cursor location.
- % CURRENT CODE IS TERMINAL SPECIFIC (Teleray, maybe others). Needs
- % to be made more modular.
- % Step our idea of where the cursor is--unless it's already
- % jammed against the right margin.
- (cond
- ((LessP PhysicalCursorColumn MaxPhysicalColumn)
- (incr PhysicalCursorColumn)))))
- % Move a screen's virtual cursor to a location. (The coordinates are
- % assumed to be OK--this needs more thought! )
- (DE MoveToScreenLocation (Scrn rw col)
- (progn
- (setf (ScreensCursorRow Scrn) rw)
- (setf (ScreensCursorColumn Scrn) col)))
- % Move the cursor to a location on the screen, while trying to minimize the
- % number of characters sent. (The coordinates are assumed to be OK.)
- (DE MoveToPhysicalLocation (rw col)
- (cond
- % Do nothing if we're already there.
- ((and (equal rw PhysicalCursorRow) (equal col PhysicalCursorColumn))
- NIL)
- % If we're on the same row and just past current position, just type
- % over what's already on the screen.
- ((and
- (equal rw PhysicalCursorRow)
- (LessP PhysicalCursorColumn col)
- (LessP col (plus PhysicalCursorColumn 4)))
- % ... then ...
- (progn
- % DOES THIS WORK when jammed against right margin?
- (for (from i PhysicalCursorColumn (sub1 col) 1)
- (do (PBOUT (index_screen PhysicalScreenImage rw i))))
- % Store our new location
- (setf PhysicalCursorColumn col)))
- % Finally, the most general case
- (T
- (progn
- (SetTerminalCursor col rw)
- (setf PhysicalCursorRow rw)
- (setf PhysicalCursorColumn col)))))
- (DE ClearPhysicalScreen ()
- (progn
- (EraseScreen) % Erase the real live terminal's screen.
- % That should move the cursor to the upper left hand corner, so reflect
- % that fact in our image of the cursor.
- (setf PhysicalCursorRow 0)
- (setf PhysicalCursorColumn 0)
- % Now clear our image of what's on the screen.
- (for (from rw 0 MaxPhysicalRow 1)
- % Fill each row with blanks.
- (do
- (FillSubstring
- (indexn PhysicalScreenImage rw)
- 0 % Starting point in destination string
- (add1 MaxPhysicalColumn) % Number of characters
- (char BLANK)))) % Character code to fill with
- % Set "change info" to show the PhysicalScreenImage and NewScreenImage
- % differ, assume that the worst case holds.
- (alter-range ChangedRowRange
- MinRange 0
- MaxRange MaxPhysicalRow)
- (for (from i 0 MaxPhysicalRow 1)
- (do
- (alter-range (indexn ChangedColumnRanges i)
- MinRange 0
- MaxRange MaxPhysicalColumn)))))
|