v-screen.sl 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756
  1. %
  2. % V-SCREEN.SL - Utilities to handle "virtual screens" (alias "windows").
  3. %
  4. % Author: William F. Galway
  5. % Symbolic Computation Group
  6. % Computer Science Dept.
  7. % University of Utah
  8. % Date: 8 June 1982
  9. % Copyright (c) 1982 University of Utah
  10. %
  11. % These utilities implement "virtual screens" , and do screen refresh.
  12. % (Primarily designed to serve as a support package for EMODE, but may be
  13. % more generally useful.)
  14. % Some support routines for this package reside in the file
  15. % "V-SCREEN-SUPPORT.RED".
  16. % The current implementation is tentative--needs more thought, more
  17. % formalization of how refresh should work, better handling of terminals
  18. % with line insert/delete, better handling of scrolling, more consideration
  19. % of methods used for the Lisp Machine, etc. (Should there be fewer levels
  20. % of storage?)
  21. % Virtual screens are represented as vectors of strings, one string for
  22. % each row of the "screen". (Other information, such as virtual cursor
  23. % location, is also stored in the structure.)
  24. % Virtual screens are created with the function "CreateVirtualScreen". They
  25. % aren't actually displayed until you call "SelectScreen"--which assigns a
  26. % "screen number" for the screen (for masking) if it doesn't already have
  27. % one, and "draws" the new screen "on top" of all the others. (I.e. it
  28. % "activates" the screen.) Screens can be made to disappear by covering
  29. % them with other screens, or by calling "DeSelectScreen". It IS legal to
  30. % operate on inactive screens (i.e. write to them, move the virtual cursor,
  31. % etc). To completely get rid of a screen, get rid of all references to
  32. % it, and it will go away at the next garbage collection.
  33. % The philosophy is that these arrays will serve as caches for stuff that
  34. % can't actually make it to the "true screen" because of being covered by
  35. % other "virtual screens". The routines are optimized for writing
  36. % characters onto a virtual screen--moving screens, putting a new screen on
  37. % the top, etc., are much less efficiently handled.
  38. % (Talk about fact that the two "screen images" don't really work the same
  39. % way as virtual screens?)
  40. % Maximum number of "masks" allowed. (Corresponds to the largest number we
  41. % can fit into a byte.)
  42. (DefConst MaxMaskNumber 127)
  43. % Macro for indexing into a "virtual screen" (vector of strings).
  44. (DS index_screen (Scrn rw col)
  45. (igets (igetv Scrn rw) col)) % Fast string and vector accessors
  46. % "Left associative" version of "Expand". (Expand is right associative.)
  47. % Useful for expanding macros for N-ary versions of left associative
  48. % operators. (We should really have a "robust" version of this
  49. % utility--see "RobustExpand".)
  50. (BothTimes % CompileTime?
  51. (DE LeftAssociativeExpand (args Fn)
  52. (LeftAssociativeExpand1 Fn (car args) (cdr args)))
  53. )
  54. % Utility for implementing LeftAssociativeExpand.
  55. % Similar to tail recursive definition of "(reverse x)" as "(rev1 x nil)".
  56. (BothTimes % CompileTime?
  57. (DE LeftAssociativeExpand1 (Fn ProcessedArgs args)
  58. (cond
  59. % No arguments left to process
  60. ((null args) ProcessedArgs)
  61. (T (LeftAssociativeExpand1
  62. Fn
  63. (list Fn ProcessedArgs (car args))
  64. (cdr args)))))
  65. )
  66. % N-ary version of indx. (indexn X I J) is same as (indx (indx X I) J).
  67. (BothTimes % CompileTime?
  68. (DM indexn (U)
  69. (LeftAssociativeExpand (cdr U) 'Indx))
  70. )
  71. % Define components for a "range".
  72. (DefStruct (range fast-vector) % Make vector accesses "fast".
  73. MinRange % Minimum of a range.
  74. MaxRange % Maximum of a range.
  75. )
  76. % Return T if number "x" is within range "rnge".
  77. (DS WithinRangeP (x rnge)
  78. (and
  79. (LeQ (MinRange rnge) x)
  80. (LeQ x (MaxRange rnge))))
  81. % Update a "range" so that it "brackets" a new value.
  82. (DE PutValueIntoRange (x rnge)
  83. (progn
  84. % New minimum if x < old minimum
  85. (cond
  86. ((LessP x (MinRange rnge))
  87. (setf (MinRange rnge) x)))
  88. % New maximum if x > old maximum.
  89. (cond
  90. ((GreaterP x (MaxRange rnge))
  91. (setf (MaxRange rnge) x)))
  92. % Return the new (destructively modified) range.
  93. rnge))
  94. % Define components for a VirtualScreen
  95. (DefStruct (VirtualScreen fast-vector)
  96. MaskNumber % A number taken from FreeMaskList when "active",
  97. % negative when "inactive".
  98. VirtualImage % Vector of strings giving the "screen image".
  99. BlankRanges % Vector of ranges--indicating an "all blank" section of
  100. % each line of the virtual screen.
  101. % Position of virtual cursor. Not used for much except to position the
  102. % physical cursor at the topmost screen's virtual cursor. (In
  103. % particular, the virtual cursor doesn't have anything to do with where
  104. % the last character was written.)
  105. ScreensCursorRow
  106. ScreensCursorColumn
  107. % Perhaps the location of a screen shouldn't be stored with the
  108. % screen? These values may be NIL, when we don't really care?
  109. % Absolute coordinates (or, perhaps relative to "parent" screen) of upper
  110. % left hand corner.
  111. ScreensRowLocation
  112. ScreensColumnLocation
  113. )
  114. % Return the "height" of a virtual screen.
  115. % Actually returns the maximum row number (height - 1, due to 0 indexing).
  116. (DS VirtualScreenHeight (Scrn)
  117. (size (VirtualImage Scrn)))
  118. % Return the "width" of a virtual screen. (See above note about 0
  119. % indexing.)
  120. (DS VirtualScreenWidth (Scrn)
  121. % Return the "width" of a representative string.
  122. (size (igetv (VirtualImage Scrn) 0)))
  123. (FLUID
  124. '(
  125. MaxPhysicalRow % Dimensions of the "PhysicalScreenImage" (actual
  126. % number of rows is one plus this--due to 0
  127. % indexing.)
  128. MaxPhysicalColumn % (That was for rows, here's for columns.)
  129. PhysicalScreenImage % Our idea of what's currently on the screen.
  130. PhysicalCursorRow % Current location of the physical cursor.
  131. PhysicalCursorColumn
  132. NewScreenImage % What should go there next.
  133. MaskInfo % Used to handle overlapping windows.
  134. ChangedRowRange % Rows on NewScreenImage will differ from those on
  135. % PhysicalScreenImage only within this range.
  136. ChangedColumnRanges % Similar information for columns on each row.
  137. FreeMaskList % Used to allocate "mask numbers".
  138. ActiveScreenList % The allocated screens go onto this list.
  139. )
  140. )
  141. % Create a "screen image" (a vector of strings), filled with character
  142. % "chr".
  143. (DE CreateScreenImage (chr rws cols)
  144. (prog (result)
  145. (setf result (MkVect (sub1 rws)))
  146. (for (from i 0 (sub1 rws) 1)
  147. (do (setf (indexn result i) (MkString (sub1 cols) chr))))
  148. (return result)))
  149. % Write a "screen image" to a channel. (Not a "virtual screen", but the
  150. % actual vector of strings component of a virtual screen.)
  151. (DE WriteScreenImage (ScrnImage chn)
  152. (progn
  153. (WRS chn) % Select the channel for output.
  154. (for (from i 0 (size ScrnImage) 1)
  155. % Write out the line, followed by a "newline".
  156. (do (Prin2T (indexn ScrnImage i))))
  157. (WRS NIL) % Switch back to standard output.
  158. ))
  159. % Initialize the screen package--allocate space for "screen image", build
  160. % "free" and "active" list, clear the screen, etc. Must be using "raw" I/O
  161. % when this routine is called.
  162. (DE InitializeScreenPackage ()
  163. (progn
  164. % Numbers for "active" virtual screens are allocated from a free screen
  165. % list, which gets initialized here.
  166. (setf FreeMaskList NIL)
  167. (for (from i 1 (const MaxMaskNumber) 1)
  168. (do (setf FreeMaskList (cons i FreeMaskList))))
  169. % List of active screens is initially NIL.
  170. (setf ActiveScreenList NIL)
  171. % Maximum row number for the physical screen.
  172. (setf MaxPhysicalRow (Row ScreenDelta))
  173. % System's idea of width is assumed to always be good.
  174. (setf MaxPhysicalColumn (Column ScreenDelta))
  175. (EraseScreen) % Clear the screen.
  176. % Create PhysicalScreenImage--gets a blank screen array.
  177. (setf PhysicalScreenImage
  178. (CreateScreenImage
  179. (char BLANK)
  180. (add1 MaxPhysicalRow)
  181. (add1 MaxPhysicalColumn)))
  182. % Identical sort of thing for NewScreenImage.
  183. (setf NewScreenImage
  184. (CreateScreenImage
  185. (char BLANK)
  186. (add1 MaxPhysicalRow)
  187. (add1 MaxPhysicalColumn)))
  188. % Setup "changed" information (no changes between NewScreenImage and
  189. % PhysicalScreenImage initially).
  190. % Set to an "empty range", one where minimum is >= largest possible
  191. % range, while maximum is <= smallest possible value.
  192. (setf ChangedRowRange
  193. (make-range
  194. MinRange MaxPhysicalRow
  195. MaxRange 0))
  196. % One piece of "column change" information per row.
  197. (setf ChangedColumnRanges (MkVect MaxPhysicalRow))
  198. (for (from i 0 MaxPhysicalRow 1) % Set up each row entry.
  199. (do
  200. (setf
  201. (indexn ChangedColumnRanges i)
  202. (make-range
  203. MinRange MaxPhysicalColumn
  204. MaxRange 0))))
  205. % Set up the MaskInfo array, but fill with 0's (NULLS) instead of blanks.
  206. (setf MaskInfo
  207. (CreateScreenImage
  208. 0
  209. (add1 MaxPhysicalRow)
  210. (add1 MaxPhysicalColumn)))))
  211. % Create and return (but don't show) a new screen. Use "SelectScreen" to
  212. % actually display the screen.
  213. (DE CreateVirtualScreen (rws cols CornerRow CornerCol)
  214. % Allocate and return the screen.
  215. (prog (NewVS)
  216. (setf NewVS
  217. (make-VirtualScreen
  218. % Don't assign a real (positive) mask number until screen is
  219. % activated.
  220. MaskNumber -1
  221. VirtualImage (CreateScreenImage (char BLANK) rws cols)
  222. BlankRanges (MkVect (sub1 rws))
  223. ScreensCursorRow 0 % Initially, cursor is at upper left corner.
  224. ScreensCursorColumn 0
  225. ScreensRowLocation CornerRow
  226. ScreensColumnLocation CornerCol))
  227. (for (from i 0 (sub1 rws) 1)
  228. (do
  229. (setf
  230. (indexn (BlankRanges NewVS) i)
  231. (make-range
  232. MinRange 0
  233. MaxRange (sub1 cols)))))
  234. (return NewVS)))
  235. % Clear out (set to all blanks) a virtual screen.
  236. (de ClearVirtualScreen (scrn)
  237. (let ((right-col (VirtualScreenWidth scrn)))
  238. (for (from rw 0 (VirtualScreenHeight scrn))
  239. (do
  240. (WriteToScreenRange
  241. scrn (char BLANK) rw 0 right-col)))))
  242. % Return T iff the coordinates are within an "array". (Vector of
  243. % "vectors".)
  244. (DE WithinArrayP (ScrnArray rw col)
  245. (and
  246. (LeQ 0 rw)
  247. (LeQ rw (size ScrnArray))
  248. (LeQ 0 col)
  249. (LeQ col (size (igetv ScrnArray 0)))))
  250. % Write a character to "NewScreenImage" at some coordinate, or ignore it if
  251. % outside the screen. Don't check coordinates for validity, don't update
  252. % change information--let the caller do that. (For efficiency reasons,
  253. % dammit. A compiler that was smart about index calculation within loops
  254. % would make a lot of this hacking unnecessary?)
  255. (DS WriteToNewScreenImage (chr absrow abscol)
  256. % Store the character
  257. (setf (index_screen NewScreenImage absrow abscol) chr))
  258. % "Write" a character onto a virtual screen, at location (rw, col).
  259. % Let the character "trickle" to the "NewScreenImage" if the cell isn't
  260. % covered. Ignore characters that would be off the screen.
  261. (DE WriteToScreen (Scrn chr rw col)
  262. (prog (absrow abscol)
  263. % If the new character lies on the virtual screen ...
  264. (cond
  265. % OPTIMIZE this test!!!
  266. ((WithinArrayP (VirtualImage Scrn) rw col)
  267. % Then store the new character and let it "trickle"
  268. (progn
  269. (setf (index_screen (VirtualImage Scrn) rw col) chr)
  270. % Update our idea of the "all blank" region on the screen.
  271. (cond
  272. ((not (equal chr (char BLANK)))
  273. % Character is non-blank, so shrink the range.
  274. (prog (BlnkRange LeftSize RightSize)
  275. (setf BlnkRange (igetv (BlankRanges Scrn) rw))
  276. % If the non-blank character falls within the blank region.
  277. (cond
  278. ((WithinRangeP col BlnkRange)
  279. (progn
  280. % Find the larger of the two ranges on either side of
  281. % col.
  282. (setf LeftSize (difference col (MinRange BlnkRange)))
  283. (setf RightSize
  284. (difference (MaxRange BlnkRange) col))
  285. (cond
  286. ((LessP LeftSize RightSize)
  287. (setf (MinRange BlnkRange) (add1 col)))
  288. % Otherwise, the left range is larger.
  289. (T (setf (MaxRange BlnkRange) (sub1 col))))))))))
  290. % Find absolute location for character
  291. (setf absrow (plus rw (ScreensRowLocation Scrn)))
  292. (setf abscol (plus col (ScreensColumnLocation Scrn)))
  293. (cond
  294. % If the character falls on the screen, and this screen is the
  295. % one on the top, and the character differs from what's already
  296. % there ...
  297. ((and
  298. (WithinArrayP MaskInfo absrow abscol)
  299. (equal
  300. (MaskNumber Scrn)
  301. (index_screen MaskInfo absrow abscol))
  302. (not (equal chr (index_screen NewScreenImage absrow abscol))))
  303. % ... then do it
  304. (progn
  305. (WriteToNewScreenImage chr absrow abscol)
  306. % Update the changed "range" (region?) information. Note
  307. % that PutValueIntoRange is "destructive".
  308. (PutValueIntoRange absrow ChangedRowRange)
  309. (PutValueIntoRange abscol (igetv ChangedColumnRanges
  310. absrow)
  311. )))))))))
  312. % Write a character to a range of a row of a virtual screen--useful for
  313. % (and optimized for) clearing to the end of a line. (Not optimized for
  314. % characters other than blank--could use some more work.) Writes into the
  315. % range from LeftCol to RightCol inclusive, lets things "trickle out".
  316. (DE WriteToScreenRange (Scrn chr rw LeftCol RightCol)
  317. (progn
  318. % Ignore the call if the row is outside the screen range.
  319. (cond
  320. ((GreaterP rw (VirtualScreenHeight scrn))
  321. (return NIL)))
  322. % Clip the edges of the range to write to
  323. (setf LeftCol (max LeftCol 0))
  324. % We look at the 0'th line in (VirtualImage Scrn) to find its width.
  325. (setf RightCol (min RightCol (size (igetv (VirtualImage Scrn) 0))))
  326. (cond
  327. % Treat blanks specially
  328. ((equal chr (char BLANK))
  329. (prog (OldLeft OldRight BlnkRange)
  330. % Get the boundaries of the previous "blank range" for this line.
  331. (setf BlnkRange (igetv (BlankRanges Scrn) rw))
  332. (setf OldLeft (MinRange BlnkRange))
  333. (setf OldRight (MaxRange BlnkRange))
  334. % Write blanks out to the ranges that are not already blank (we
  335. % depend on "for" loops gracefully handling "empty" ranges).
  336. (WriteRange Scrn chr rw LeftCol (min RightCol (sub1 OldLeft)))
  337. (WriteRange Scrn chr rw (max LeftCol (add1 OldRight)) RightCol)
  338. % Update the "known blank" range. Be "pessimistic", there may be
  339. % more blank than this. (But it's to much work to make sure?)
  340. (setf (MinRange BlnkRange) LeftCol)
  341. (setf (MaxRange BlnkRange) RightCol)))
  342. % OTHERWISE (character isn't blank).
  343. (T
  344. (WriteRange Scrn chr rw LeftCol RightCol)))))
  345. % Support for WriteToScreenRange.
  346. (DE WriteRange (Scrn chr rw LeftCol RightCol)
  347. (for (from i LeftCol RightCol 1)
  348. (do
  349. (WriteToScreen Scrn chr rw i))))
  350. % Refresh the "new screen image" from the active screen list, regenerating
  351. % the mask information and "NewScreenImage".
  352. (DE DrawActiveList ()
  353. (progn
  354. % Draw from "back to front".
  355. (foreach Scrn in (reverse ActiveScreenList) do
  356. (DrawScreenOnTop Scrn))))
  357. % Draw a screen as the topmost "active" screen. If the screen wasn't
  358. % previously on the active list, put it there. Otherwise, just put it at
  359. % the front of the list. In either case, adjust the "mask" so that the
  360. % selected screen dominates anything else--and (re)draw the screen.
  361. (DE SelectScreen (Scrn)
  362. (cond
  363. ((or
  364. % If the list is empty or the new screen on top doesn't equal the
  365. % current one on top...
  366. (null ActiveScreenList)
  367. (not (eq Scrn (car ActiveScreenList))))
  368. % ... then actually do something. I.e. don't bother doing anything
  369. % if we're selecting the current topmost screen.
  370. (progn
  371. % If this screen hasn't yet been activated (assigned a mask number)
  372. (cond
  373. ((minusp (MaskNumber Scrn))
  374. % ... then give it one.
  375. (progn
  376. % Complain if we've run out of mask numbers.
  377. (cond ((null FreeMaskList)
  378. (ERROR "No masks left to allocate")))
  379. % otherwise, assign the first free number.
  380. (setf
  381. (MaskNumber Scrn)
  382. (prog1
  383. (car FreeMaskList)
  384. (setf FreeMaskList (cdr FreeMaskList))))))
  385. % If it's already there, then delete the screen from its current
  386. % location in the list.
  387. (T
  388. (setf ActiveScreenList (DelQIP Scrn ActiveScreenList))))
  389. % Put the screen onto the front of the list.
  390. (setf ActiveScreenList (cons Scrn ActiveScreenList))
  391. % (re)draw the screen itself, regenerating the mask too.
  392. (DrawScreenOnTop Scrn)))))
  393. % Remove a screen from the active list (and from the physical screen).
  394. % (Do nothing if the screen isn't on the list?)
  395. (DE DeSelectScreen (Scrn)
  396. (prog (AbsLeftCol AbsRightCol linewidth)
  397. (setf ActiveScreenList (DelQIP Scrn ActiveScreenList))
  398. % Make the mask number available for re-use.
  399. (setf FreeMaskList (cons (MaskNumber Scrn) FreeMaskList))
  400. % Give the screen an invalid mask number.
  401. (setf (MaskNumber Scrn) -1)
  402. (setf AbsLeftCol
  403. (max % Absolute location of left column
  404. 0
  405. (ScreensColumnLocation Scrn)))
  406. (setf AbsRightCol
  407. (min
  408. MaxPhysicalColumn
  409. (plus (VirtualScreenWidth Scrn) (ScreensColumnLocation Scrn))))
  410. % Line width--add one to compensate for zero indexing.
  411. (setf linewidth (add1 (difference AbsRightCol AbsLeftCol)))
  412. % Erase the virtual screen from NewScreenImage. Also, get rid of the
  413. % mask. (Being a bit sloppy and perhaps erasing stuff covering this
  414. % screen.)
  415. (for (from
  416. absrow
  417. (max 0 (ScreensRowLocation Scrn))
  418. (min MaxPhysicalRow
  419. (plus (ScreensRowLocation Scrn) (VirtualScreenHeight Scrn)))
  420. 1)
  421. (do
  422. (progn
  423. % First, clear up the NewScreenImage.
  424. (FillSubstring
  425. (indexn NewScreenImage absrow) % Line to write to
  426. AbsLeftCol % Lefthand column of range
  427. linewidth % Number of characters to write
  428. (char BLANK)) % Character to write
  429. % Next, clear up the mask
  430. (FillSubstring
  431. (indexn MaskInfo absrow)
  432. AbsLeftCol
  433. linewidth
  434. 0) % Zero for no mask present.
  435. % Finally, fix up the "changed" information
  436. (PutValueIntoRange absrow ChangedRowRange)
  437. % Put the left margin of change into the range.
  438. (PutValueIntoRange AbsLeftCol (indexn ChangedColumnRanges
  439. absrow))
  440. % Then put the right margin into the range.
  441. (PutValueIntoRange
  442. AbsRightCol
  443. (indexn ChangedColumnRanges absrow)))))
  444. % Redraw the active stuff.
  445. (DrawActiveList)))
  446. % "Draw" a virtual screen onto the top of the "new screen image",
  447. % regenerate mask information also.
  448. (DE DrawScreenOnTop (Scrn)
  449. (prog (MskNumber absrow abscol srccol lineimage linewidth)
  450. (setf MskNumber (MaskNumber Scrn))
  451. % For each row of the virtual screen ...
  452. (for (from i 0 (VirtualScreenHeight Scrn) 1)
  453. % update the screen from that row
  454. (do
  455. (progn
  456. (setf lineimage (indexn (VirtualImage Scrn) i))
  457. (setf absrow (plus i (ScreensRowLocation Scrn)))
  458. (cond
  459. % If this row is (possibly) on the physical screen ...
  460. ((and (LeQ 0 absrow) (LeQ absrow MaxPhysicalRow))
  461. % ... then update the mask, and NewScreenImage
  462. (progn
  463. % Add1 to compensate for zero indexing.
  464. (setf linewidth (add1 (VirtualScreenWidth Scrn)))
  465. (setf abscol (ScreensColumnLocation Scrn))
  466. % Typically source text comes starting with the leftmost part
  467. % of lineimage.
  468. (setf srccol 0)
  469. % Clip off anything to the left of the physical screen
  470. (cond
  471. ((LessP abscol 0)
  472. (progn
  473. (setf linewidth
  474. (max 0 (plus linewidth abscol)))
  475. (setf srccol (minus abscol))
  476. (setf abscol 0))))
  477. % Fill in the new mask information
  478. (FillSubstring
  479. % Destination string, namely MaskInfo indexed by absolute
  480. % row number of the screen line.
  481. (indexn MaskInfo absrow)
  482. abscol % Starting location within destination string.
  483. linewidth % Number of characters.
  484. MskNumber) % The character (mask number) to fill with.
  485. % Copy the row on the screen to NewScreenImage.
  486. (MoveSubstringToFrom
  487. (indexn NewScreenImage absrow) % Destination string
  488. lineimage % Source string
  489. abscol % Destination index
  490. srccol % Source index
  491. linewidth) % number of characters to transfer
  492. % Update the "change information".
  493. (PutValueIntoRange absrow ChangedRowRange)
  494. % Put the left margin of change into the range.
  495. (PutValueIntoRange abscol (indexn ChangedColumnRanges absrow))
  496. % Then put the right margin into the range.
  497. (PutValueIntoRange
  498. (min
  499. (plus abscol linewidth -1)
  500. MaxPhysicalColumn)
  501. (indexn ChangedColumnRanges absrow))))))))))
  502. % Redraw the physical screen so that it looks like NewScreenImage. This is
  503. % the routine that's responsible for minimizing the characters sent to the
  504. % physical terminal.
  505. % If the argument is non-NIL then it's OK to
  506. % quit refreshing if more input is pending from the terminal (checked on
  507. % each line). BUT, we don't "breakout" if we're on the "current" line?
  508. % BREAKOUT NOT IMPLEMENTED YET.
  509. (DE RefreshPhysicalScreen (BreakoutAllowed)
  510. (prog (rw)
  511. (setf rw (MinRange ChangedRowRange))
  512. % Write the changed characters out to the physical screen.
  513. (while (and
  514. (LeQ rw (MaxRange ChangedRowRange))
  515. % **** (ZeroP (CharsInInputBuffer)) %NEEDS MORE THOUGHT!
  516. )
  517. % DO ...
  518. (progn
  519. % Call special routine to hunt down the changed characters, and
  520. % call WritePhysicalCharacter for each such beast.
  521. (RewriteChangedCharacters
  522. % Old line.
  523. (igetv PhysicalScreenImage rw)
  524. % New line
  525. (igetv NewScreenImage rw)
  526. % The row number
  527. rw
  528. % Leftmost change
  529. (MinRange (igetv ChangedColumnRanges rw))
  530. % Rightmost change
  531. (MaxRange (igetv ChangedColumnRanges rw)))
  532. % Flush the output buffer after every line (even if no characters
  533. % sent out).
  534. (FlushStdOutputBuffer)
  535. % Reset the change information for this row--to indicate that there
  536. % is no difference between NewScreenImage and PhysicalScreenImage.
  537. (alter-range (igetv ChangedColumnRanges rw)
  538. MinRange MaxPhysicalColumn
  539. MaxRange 0)
  540. (incr rw) % Advance to next row.
  541. ))
  542. % Reinitialize the "change" information to indicate that NewScreenImage
  543. % and PhysicalScreenImage agree--up to whatever row we reached before
  544. % breakout.
  545. (alter-range ChangedRowRange
  546. MinRange rw)
  547. % Finally--move the cursor to the spot corresponding to the topmost
  548. % virtual screen's cursor.
  549. (cond
  550. % If there are any active screens at all ...
  551. (ActiveScreenList
  552. % ... then move to appropriate spot.
  553. (prog (Scrn)
  554. (setf Scrn (car ActiveScreenList))
  555. (MoveToPhysicalLocation
  556. (plus (ScreensCursorRow Scrn) (ScreensRowLocation Scrn))
  557. (plus (ScreensCursorColumn Scrn) (ScreensColumnLocation Scrn))
  558. )
  559. % Make sure the characters actually get sent.
  560. (FlushStdOutputBuffer))))))
  561. % Write a character onto the physical screen, recording the fact in
  562. % PhysicalScreenImage. (May want to hack "RewriteChangedCharacters" to do
  563. % the storing into PhysicalScreenImage?)
  564. (DE WritePhysicalCharacter (chr rw col)
  565. (progn
  566. % Move to the appropriate physical location (optimizing cursor motion).
  567. (MoveToPhysicalLocation rw col)
  568. (PBOUT chr) % Write out the character
  569. % Store the new character in the image.
  570. (setf (index_screen PhysicalScreenImage rw col) chr)
  571. % Need to update our idea of the physical cursor location.
  572. % CURRENT CODE IS TERMINAL SPECIFIC (Teleray, maybe others). Needs
  573. % to be made more modular.
  574. % Step our idea of where the cursor is--unless it's already
  575. % jammed against the right margin.
  576. (cond
  577. ((LessP PhysicalCursorColumn MaxPhysicalColumn)
  578. (incr PhysicalCursorColumn)))))
  579. % Move a screen's virtual cursor to a location. (The coordinates are
  580. % assumed to be OK--this needs more thought! )
  581. (DE MoveToScreenLocation (Scrn rw col)
  582. (progn
  583. (setf (ScreensCursorRow Scrn) rw)
  584. (setf (ScreensCursorColumn Scrn) col)))
  585. % Move the cursor to a location on the screen, while trying to minimize the
  586. % number of characters sent. (The coordinates are assumed to be OK.)
  587. (DE MoveToPhysicalLocation (rw col)
  588. (cond
  589. % Do nothing if we're already there.
  590. ((and (equal rw PhysicalCursorRow) (equal col PhysicalCursorColumn))
  591. NIL)
  592. % If we're on the same row and just past current position, just type
  593. % over what's already on the screen.
  594. ((and
  595. (equal rw PhysicalCursorRow)
  596. (LessP PhysicalCursorColumn col)
  597. (LessP col (plus PhysicalCursorColumn 4)))
  598. % ... then ...
  599. (progn
  600. % DOES THIS WORK when jammed against right margin?
  601. (for (from i PhysicalCursorColumn (sub1 col) 1)
  602. (do (PBOUT (index_screen PhysicalScreenImage rw i))))
  603. % Store our new location
  604. (setf PhysicalCursorColumn col)))
  605. % Finally, the most general case
  606. (T
  607. (progn
  608. (SetTerminalCursor col rw)
  609. (setf PhysicalCursorRow rw)
  610. (setf PhysicalCursorColumn col)))))
  611. (DE ClearPhysicalScreen ()
  612. (progn
  613. (EraseScreen) % Erase the real live terminal's screen.
  614. % That should move the cursor to the upper left hand corner, so reflect
  615. % that fact in our image of the cursor.
  616. (setf PhysicalCursorRow 0)
  617. (setf PhysicalCursorColumn 0)
  618. % Now clear our image of what's on the screen.
  619. (for (from rw 0 MaxPhysicalRow 1)
  620. % Fill each row with blanks.
  621. (do
  622. (FillSubstring
  623. (indexn PhysicalScreenImage rw)
  624. 0 % Starting point in destination string
  625. (add1 MaxPhysicalColumn) % Number of characters
  626. (char BLANK)))) % Character code to fill with
  627. % Set "change info" to show the PhysicalScreenImage and NewScreenImage
  628. % differ, assume that the worst case holds.
  629. (alter-range ChangedRowRange
  630. MinRange 0
  631. MaxRange MaxPhysicalRow)
  632. (for (from i 0 MaxPhysicalRow 1)
  633. (do
  634. (alter-range (indexn ChangedColumnRanges i)
  635. MinRange 0
  636. MaxRange MaxPhysicalColumn)))))