1 # Wrappers around print primitives that take a 'screen' object and are thus
  2 # easier to test.
  3 
  4 container screen [
  5   num-rows:num
  6   num-columns:num
  7   cursor-row:num
  8   cursor-column:num
  9   data:&:@:screen-cell  # capacity num-rows*num-columns
 10   top-idx:num  # index inside data that corresponds to top-left of screen
 11   ¦ ¦ ¦ ¦ ¦ ¦ ¦# modified on scroll, wrapping around to the top of data
 12 ]
 13 
 14 container screen-cell [
 15   contents:char
 16   color:num
 17 ]
 18 
 19 def new-fake-screen w:num, h:num -> result:&:screen [
 20   local-scope
 21   load-ingredients
 22   result <- new screen:type
 23   non-zero-width?:bool <- greater-than w, 0
 24   assert non-zero-width?, [screen can't have zero width]
 25   non-zero-height?:bool <- greater-than h, 0
 26   assert non-zero-height?, [screen can't have zero height]
 27   bufsize:num <- multiply w, h
 28   data:&:@:screen-cell <- new screen-cell:type, bufsize
 29   *result <- merge h/num-rows, w/num-columns, 0/cursor-row, 0/cursor-column, data, 0/top-idx
 30   result <- clear-screen result
 31 ]
 32 
 33 def clear-screen screen:&:screen -> screen:&:screen [
 34   local-scope
 35   load-ingredients
 36   {
 37   ¦ break-if screen
 38   ¦ # real screen
 39   ¦ clear-display
 40   ¦ return
 41   }
 42   # fake screen
 43   buf:&:@:screen-cell <- get *screen, data:offset
 44   max:num <- length *buf
 45   i:num <- copy 0
 46   {
 47   ¦ done?:bool <- greater-or-equal i, max
 48   ¦ break-if done?
 49   ¦ curr:screen-cell <- merge 0/empty, 7/white
 50   ¦ *buf <- put-index *buf, i, curr
 51   ¦ i <- add i, 1
 52   ¦ loop
 53   }
 54   # reset cursor
 55   *screen <- put *screen, cursor-row:offset, 0
 56   *screen <- put *screen, cursor-column:offset, 0
 57   *screen <- put *screen, top-idx:offset, 0
 58 ]
 59 
 60 def fake-screen-is-empty? screen:&:screen -> result:bool [
 61   local-scope
 62   load-ingredients
 63   return-unless screen, 1/true  # do nothing for real screens
 64   buf:&:@:screen-cell <- get *screen, data:offset
 65   i:num <- copy 0
 66   len:num <- length *buf
 67   {
 68   ¦ done?:bool <- greater-or-equal i, len
 69   ¦ break-if done?
 70   ¦ curr:screen-cell <- index *buf, i
 71   ¦ curr-contents:char <- get curr, contents:offset
 72   ¦ i <- add i, 1
 73   ¦ loop-unless curr-contents
 74   ¦ # not 0
 75   ¦ return 0/false
 76   }
 77   return 1/true
 78 ]
 79 
 80 def print screen:&:screen, c:char -> screen:&:screen [
 81   local-scope
 82   load-ingredients
 83   color:num, color-found?:bool <- next-ingredient
 84   {
 85   ¦ # default color to white
 86   ¦ break-if color-found?
 87   ¦ color <- copy 7/white
 88   }
 89   bg-color:num, bg-color-found?:bool <- next-ingredient
 90   {
 91   ¦ # default bg-color to black
 92   ¦ break-if bg-color-found?
 93   ¦ bg-color <- copy 0/black
 94   }
 95   c2:num <- character-to-code c
 96   trace 90, [print-character], c2
 97   {
 98   ¦ # real screen
 99   ¦ break-if screen
100   ¦ print-character-to-display c, color, bg-color
101   ¦ return
102   }
103   # fake screen
104   # (handle special cases exactly like in the real screen)
105   width:num <- get *screen, num-columns:offset
106   height:num <- get *screen, num-rows:offset
107   capacity:num <- multiply width, height
108   row:num <- get *screen, cursor-row:offset
109   column:num <- get *screen, cursor-column:offset
110   buf:&:@:screen-cell <- get *screen, data:offset
111   # some potentially slow sanity checks for preconditions {
112   # eliminate fractions from column and row
113   row <- round row
114   column <- round column
115   # if cursor is past left margin (error), reset to left margin
116   {
117   ¦ too-far-left?:bool <- lesser-than column, 0
118   ¦ break-unless too-far-left?
119   ¦ column <- copy 0
120   ¦ *screen <- put *screen, cursor-column:offset, column
121   }
122   # if cursor is at right margin, wrap
123   {
124   ¦ at-right?:bool <- equal column, width
125   ¦ break-unless at-right?
126   ¦ column <- copy 0
127   ¦ *screen <- put *screen, cursor-column:offset, column
128   ¦ row <- add row, 1
129   ¦ *screen <- put *screen, cursor-row:offset, row
130   }
131   # if cursor is past right margin (error), reset to right margin
132   {
133   ¦ too-far-right?:bool <- greater-than column, width
134   ¦ break-unless too-far-right?
135   ¦ column <- subtract width, 1
136   ¦ *screen <- put *screen, cursor-row:offset, row
137   }
138   # if row is above top margin (error), reset to top margin
139   {
140   ¦ too-far-up?:bool <- lesser-than row, 0
141   ¦ break-unless too-far-up?
142   ¦ row <- copy 0
143   ¦ *screen <- put *screen, cursor-row:offset, row
144   }
145   # if row is at bottom margin, scroll
146   {
147   ¦ at-bottom?:bool <- equal row, height
148   ¦ break-unless at-bottom?
149   ¦ scroll-fake-screen screen
150   ¦ row <- subtract height, 1
151   ¦ *screen <- put *screen, cursor-row:offset, row
152   }
153   # if row is below bottom margin (error), reset to bottom margin
154   {
155   ¦ too-far-down?:bool <- greater-than row, height
156   ¦ break-unless too-far-down?
157   ¦ row <- subtract height, 1
158   ¦ *screen <- put *screen, cursor-row:offset, row
159   }
160   # }
161 #?     $print [print-character (], row, [, ], column, [): ], c, 10/newline
162   # special-case: newline
163   {
164   ¦ newline?:bool <- equal c, 10/newline
165   ¦ break-unless newline?
166   ¦ cursor-down-on-fake-screen screen  # doesn't modify column
167   ¦ return
168   }
169   # special-case: linefeed
170   {
171   ¦ linefeed?:bool <- equal c, 13/linefeed
172   ¦ break-unless linefeed?
173   ¦ *screen <- put *screen, cursor-column:offset, 0
174   ¦ return
175   }
176   # special-case: backspace
177   # moves cursor left but does not erase
178   {
179   ¦ backspace?:bool <- equal c, 8/backspace
180   ¦ break-unless backspace?
181   ¦ {
182   ¦ ¦ break-unless column
183   ¦ ¦ column <- subtract column, 1
184   ¦ ¦ *screen <- put *screen, cursor-column:offset, column
185   ¦ }
186   ¦ return
187   }
188   # save character in fake screen
189   top-idx:num <- get *screen, top-idx:offset
190   index:num <- data-index row, column, width, height, top-idx
191   cursor:screen-cell <- merge c, color
192   *buf <- put-index *buf, index, cursor
193   # move cursor to next character
194   # (but don't bother making it valid; we'll do that before the next print)
195   column <- add column, 1
196   *screen <- put *screen, cursor-column:offset, column
197 ]
198 
199 def cursor-down-on-fake-screen screen:&:screen -> screen:&:screen [
200   local-scope
201   load-ingredients
202   row:num <- get *screen, cursor-row:offset
203   height:num <- get *screen, num-rows:offset
204   bottom:num <- subtract height, 1
205   at-bottom?:bool <- greater-or-equal row, bottom
206   {
207   ¦ break-if at-bottom?
208   ¦ row <- add row, 1
209   ¦ *screen <- put *screen, cursor-row:offset, row
210   }
211   {
212   ¦ break-unless at-bottom?
213   ¦ scroll-fake-screen screen  # does not modify row
214   }
215 ]
216 
217 def scroll-fake-screen screen:&:screen -> screen:&:screen [
218   local-scope
219   load-ingredients
220   width:num <- get *screen, num-columns:offset
221   height:num <- get *screen, num-rows:offset
222   buf:&:@:screen-cell <- get *screen, data:offset
223   # clear top line and 'rotate' it to the bottom
224   top-idx:num <- get *screen, top-idx:offset  # 0 <= top-idx < len(buf)
225   next-top-idx:num <- add top-idx, width  # 0 <= next-top-idx <= len(buf)
226   empty-cell:screen-cell <- merge 0, 0
227   {
228   ¦ done?:bool <- greater-or-equal top-idx, next-top-idx
229   ¦ break-if done?
230   ¦ put-index *buf, top-idx, empty-cell
231   ¦ top-idx <- add top-idx, 1
232   ¦ # no modulo; top-idx is always a multiple of width,
233   ¦ # so it can never wrap around inside this loop
234   ¦ loop
235   }
236   # top-idx now same as next-top-idx; wrap around if necessary
237   capacity:num <- multiply width, height
238   _, top-idx <- divide-with-remainder, top-idx, capacity
239   *screen <- put *screen, top-idx:offset, top-idx
240 ]
241 
242 # translate from screen (row, column) coordinates to an index into data
243 # while accounting for scrolling (sliding top-idx)
244 def data-index row:num, column:num, width:num, height:num, top-idx:num -> result:num [
245   local-scope
246   load-ingredients
247   result <- multiply width, row
248   result <- add result, column, top-idx
249   capacity:num <- multiply width, height
250   _, result <- divide-with-remainder result, capacity
251 ]
252 
253 scenario print-character-at-top-left [
254   local-scope
255   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
256   run [
257   ¦ a:char <- copy 97/a
258   ¦ fake-screen <- print fake-screen, a:char
259   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
260   ¦ 1:@:screen-cell/raw <- copy *cell
261   ]
262   memory-should-contain [
263   ¦ 1 <- 6  # width*height
264   ¦ 2 <- 97  # 'a'
265   ¦ 3 <- 7  # white
266   ¦ # rest of screen is empty
267   ¦ 4 <- 0
268   ]
269 ]
270 
271 scenario print-character-at-fractional-coordinate [
272   local-scope
273   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
274   a:char <- copy 97/a
275   run [
276   ¦ move-cursor fake-screen, 0.5, 0
277   ¦ fake-screen <- print fake-screen, a:char
278   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
279   ¦ 1:@:screen-cell/raw <- copy *cell
280   ]
281   memory-should-contain [
282   ¦ 1 <- 6  # width*height
283   ¦ 2 <- 97  # 'a'
284   ¦ 3 <- 7  # white
285   ¦ # rest of screen is empty
286   ¦ 4 <- 0
287   ]
288 ]
289 
290 scenario print-character-in-color [
291   local-scope
292   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
293   run [
294   ¦ a:char <- copy 97/a
295   ¦ fake-screen <- print fake-screen, a:char, 1/red
296   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
297   ¦ 1:@:screen-cell/raw <- copy *cell
298   ]
299   memory-should-contain [
300   ¦ 1 <- 6  # width*height
301   ¦ 2 <- 97  # 'a'
302   ¦ 3 <- 1  # red
303   ¦ # rest of screen is empty
304   ¦ 4 <- 0
305   ]
306 ]
307 
308 scenario print-backspace-character [
309   local-scope
310   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
311   a:char <- copy 97/a
312   fake-screen <- print fake-screen, a
313   run [
314   ¦ backspace:char <- copy 8/backspace
315   ¦ fake-screen <- print fake-screen, backspace
316   ¦ 10:num/raw <- get *fake-screen, cursor-column:offset
317   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
318   ¦ 11:@:screen-cell/raw <- copy *cell
319   ]
320   memory-should-contain [
321   ¦ 10 <- 0  # cursor column
322   ¦ 11 <- 6  # width*height
323   ¦ 12 <- 97  # still 'a'
324   ¦ 13 <- 7  # white
325   ¦ # rest of screen is empty
326   ¦ 14 <- 0
327   ]
328 ]
329 
330 scenario print-extra-backspace-character [
331   local-scope
332   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
333   a:char <- copy 97/a
334   fake-screen <- print fake-screen, a
335   run [
336   ¦ backspace:char <- copy 8/backspace
337   ¦ fake-screen <- print fake-screen, backspace
338   ¦ fake-screen <- print fake-screen, backspace  # cursor already at left margin
339   ¦ 1:num/raw <- get *fake-screen, cursor-column:offset
340   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
341   ¦ 3:@:screen-cell/raw <- copy *cell
342   ]
343   memory-should-contain [
344   ¦ 1 <- 0  # cursor column
345   ¦ 3 <- 6  # width*height
346   ¦ 4 <- 97  # still 'a'
347   ¦ 5 <- 7  # white
348   ¦ # rest of screen is empty
349   ¦ 6 <- 0
350   ]
351 ]
352 
353 scenario print-character-at-right-margin [
354   # fill top row of screen with text
355   local-scope
356   fake-screen:&:screen <- new-fake-screen 2/width, 2/height
357   a:char <- copy 97/a
358   fake-screen <- print fake-screen, a
359   b:char <- copy 98/b
360   fake-screen <- print fake-screen, b
361   run [
362   ¦ # cursor now at next row
363   ¦ c:char <- copy 99/c
364   ¦ fake-screen <- print fake-screen, c
365   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
366   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
367   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
368   ¦ 12:@:screen-cell/raw <- copy *cell
369   ]
370   memory-should-contain [
371   ¦ 10 <- 1  # cursor row
372   ¦ 11 <- 1  # cursor column
373   ¦ 12 <- 4  # width*height
374   ¦ 13 <- 97  # 'a'
375   ¦ 14 <- 7  # white
376   ¦ 15 <- 98  # 'b'
377   ¦ 16 <- 7  # white
378   ¦ 17 <- 99  # 'c'
379   ¦ 18 <- 7  # white
380   ¦ 19 <- 0  # ' '
381   ¦ 20 <- 7  # white
382   ]
383 ]
384 
385 scenario print-newline-character [
386   local-scope
387   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
388   a:char <- copy 97/a
389   fake-screen <- print fake-screen, a
390   run [
391   ¦ newline:char <- copy 10/newline
392   ¦ fake-screen <- print fake-screen, newline
393   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
394   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
395   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
396   ¦ 12:@:screen-cell/raw <- copy *cell
397   ]
398   memory-should-contain [
399   ¦ 10 <- 1  # cursor row
400   ¦ 11 <- 1  # cursor column
401   ¦ 12 <- 6  # width*height
402   ¦ 13 <- 97  # 'a'
403   ¦ 14 <- 7  # white
404   ¦ # rest of screen is empty
405   ¦ 15 <- 0
406   ]
407 ]
408 
409 scenario print-newline-at-bottom-line [
410   local-scope
411   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
412   newline:char <- copy 10/newline
413   fake-screen <- print fake-screen, newline
414   fake-screen <- print fake-screen, newline
415   run [
416   ¦ # cursor now at bottom of screen
417   ¦ fake-screen <- print fake-screen, newline
418   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
419   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
420   ]
421   # doesn't move further down
422   memory-should-contain [
423   ¦ 10 <- 1  # cursor row
424   ¦ 11 <- 0  # cursor column
425   ]
426 ]
427 
428 scenario print-character-at-bottom-right [
429   local-scope
430   fake-screen:&:screen <- new-fake-screen 2/width, 2/height
431   a:char <- copy 97/a
432   fake-screen <- print fake-screen, a
433   b:char <- copy 98/b
434   fake-screen <- print fake-screen, b
435   c:char <- copy 99/c
436   fake-screen <- print fake-screen, c
437   run [
438   ¦ # cursor now at bottom right
439   ¦ d:char <- copy 100/d
440   ¦ fake-screen <- print fake-screen, d
441   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
442   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
443   ¦ 12:num/raw <- get *fake-screen, top-idx:offset
444   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
445   ¦ 20:@:screen-cell/raw <- copy *cell
446   ]
447   # cursor column overflows the screen but is not wrapped yet
448   memory-should-contain [
449   ¦ 10 <- 1  # cursor row
450   ¦ 11 <- 2  # cursor column -- outside screen
451   ¦ 12 <- 0  # top-idx -- not yet scrolled
452   ¦ 20 <- 4  # screen size (width*height)
453   ¦ 21 <- 97  # 'a'
454   ¦ 22 <- 7  # white
455   ¦ 23 <- 98  # 'b'
456   ¦ 24 <- 7  # white
457   ¦ 25 <- 99 # 'c'
458   ¦ 26 <- 7  # white
459   ¦ 27 <- 100  # 'd'
460   ¦ 28 <- 7  # white
461   ]
462   run [
463   ¦ e:char <- copy 101/e
464   ¦ print fake-screen, e
465   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
466   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
467   ¦ 12:num/raw <- get *fake-screen, top-idx:offset
468   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
469   ¦ 20:@:screen-cell/raw <- copy *cell
470   ]
471   memory-should-contain [
472   ¦ # text scrolls by 1, we lose the top line
473   ¦ 10 <- 1  # cursor row
474   ¦ 11 <- 1  # cursor column -- wrapped
475   ¦ 12 <- 2  # top-idx -- scrolled
476   ¦ 20 <- 4  # screen size (width*height)
477   ¦ # screen now checked in rotated order
478   ¦ 25 <- 99 # 'c'
479   ¦ 26 <- 7  # white
480   ¦ 27 <- 100  # 'd'
481   ¦ 28 <- 7  # white
482   ¦ # screen wraps; bottom line is cleared of old contents
483   ¦ 21 <- 101  # 'e'
484   ¦ 22 <- 7  # white
485   ¦ 23 <- 0  # unused
486   ¦ 24 <- 0  # no color
487   ]
488 ]
489 
490 # even though our screen supports scrolling, some apps may want to avoid
491 # scrolling
492 # these helpers help check for scrolling at development time
493 def save-top-idx screen:&:screen -> result:num [
494   local-scope
495   load-ingredients
496   return-unless screen, 0  # check is only for fake screens
497   result <- get *screen, top-idx:offset
498 ]
499 def assert-no-scroll screen:&:screen, old-top-idx:num [
500   local-scope
501   load-ingredients
502   return-unless screen
503   new-top-idx:num <- get *screen, top-idx:offset
504   no-scroll?:bool <- equal old-top-idx, new-top-idx
505   assert no-scroll?, [render should never use screen's scrolling capabilities]
506 ]
507 
508 def clear-line screen:&:screen -> screen:&:screen [
509   local-scope
510   load-ingredients
511   space:char <- copy 0/nul
512   {
513   ¦ break-if screen
514   ¦ # real screen
515   ¦ clear-line-on-display
516   ¦ return
517   }
518   # fake screen
519   width:num <- get *screen, num-columns:offset
520   column:num <- get *screen, cursor-column:offset
521   original-column:num <- copy column
522   # space over the entire line
523   {
524   ¦ right:num <- subtract width, 1
525   ¦ done?:bool <- greater-or-equal column, right
526   ¦ break-if done?
527   ¦ print screen, space
528   ¦ column <- add column, 1
529   ¦ loop
530   }
531   # now back to where the cursor was
532   *screen <- put *screen, cursor-column:offset, original-column
533 ]
534 
535 # only for non-scrolling apps
536 def clear-line-until screen:&:screen, right:num/inclusive -> screen:&:screen [
537   local-scope
538   load-ingredients
539   row:num, column:num <- cursor-position screen
540   height:num <- screen-height screen
541   past-bottom?:bool <- greater-or-equal row, height
542   return-if past-bottom?
543   space:char <- copy 32/space
544   bg-color:num, bg-color-found?:bool <- next-ingredient
545   {
546   ¦ # default bg-color to black
547   ¦ break-if bg-color-found?
548   ¦ bg-color <- copy 0/black
549   }
550   {
551   ¦ done?:bool <- greater-than column, right
552   ¦ break-if done?
553   ¦ screen <- print screen, space, 7/white, bg-color  # foreground color is mostly unused except if the cursor shows up at this cell
554   ¦ column <- add column, 1
555   ¦ loop
556   }
557 ]
558 
559 def cursor-position screen:&:screen -> row:num, column:num [
560   local-scope
561   load-ingredients
562   {
563   ¦ break-if screen
564   ¦ # real screen
565   ¦ row, column <- cursor-position-on-display
566   ¦ return
567   }
568   # fake screen
569   row:num <- get *screen, cursor-row:offset
570   column:num <- get *screen, cursor-column:offset
571 ]
572 
573 def move-cursor screen:&:screen, new-row:num, new-column:num -> screen:&:screen [
574   local-scope
575   load-ingredients
576   {
577   ¦ break-if screen
578   ¦ # real screen
579   ¦ move-cursor-on-display new-row, new-column
580   ¦ return
581   }
582   # fake screen
583   *screen <- put *screen, cursor-row:offset, new-row
584   *screen <- put *screen, cursor-column:offset, new-column
585 ]
586 
587 scenario clear-line-erases-printed-characters [
588   local-scope
589   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
590   # print a character
591   a:char <- copy 97/a
592   fake-screen <- print fake-screen, a
593   # move cursor to start of line
594   fake-screen <- move-cursor fake-screen, 0/row, 0/column
595   run [
596   ¦ fake-screen <- clear-line fake-screen
597   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
598   ¦ 10:@:screen-cell/raw <- copy *cell
599   ]
600   # screen should be blank
601   memory-should-contain [
602   ¦ 10 <- 6  # width*height
603   ¦ 11 <- 0
604   ¦ 12 <- 7
605   ¦ 13 <- 0
606   ¦ 14 <- 7
607   ¦ 15 <- 0
608   ¦ 16 <- 7
609   ¦ 17 <- 0
610   ¦ 18 <- 7
611   ¦ 19 <- 0
612   ¦ 20 <- 7
613   ¦ 21 <- 0
614   ¦ 22 <- 7
615   ]
616 ]
617 
618 def cursor-down screen:&:screen -> screen:&:screen [
619   local-scope
620   load-ingredients
621   {
622   ¦ break-if screen
623   ¦ # real screen
624   ¦ move-cursor-down-on-display
625   ¦ return
626   }
627   # fake screen
628   height:num <- get *screen, num-rows:offset
629   row:num <- get *screen, cursor-row:offset
630   max:num <- subtract height, 1
631   at-bottom?:bool <- greater-or-equal row, max
632   return-if at-bottom?
633   row <- add row, 1
634   *screen <- put *screen, cursor-row:offset, row
635 ]
636 
637 def cursor-up screen:&:screen -> screen:&:screen [
638   local-scope
639   load-ingredients
640   {
641   ¦ break-if screen
642   ¦ # real screen
643   ¦ move-cursor-up-on-display
644   ¦ return
645   }
646   # fake screen
647   row:num <- get *screen, cursor-row:offset
648   at-top?:bool <- lesser-or-equal row, 0
649   return-if at-top?
650   row <- subtract row, 1
651   *screen <- put *screen, cursor-row:offset, row
652 ]
653 
654 def cursor-right screen:&:screen -> screen:&:screen [
655   local-scope
656   load-ingredients
657   {
658   ¦ break-if screen
659   ¦ # real screen
660   ¦ move-cursor-right-on-display
661   ¦ return
662   }
663   # fake screen
664   width:num <- get *screen, num-columns:offset
665   column:num <- get *screen, cursor-column:offset
666   max:num <- subtract width, 1
667   at-bottom?:bool <- greater-or-equal column, max
668   return-if at-bottom?
669   column <- add column, 1
670   *screen <- put *screen, cursor-column:offset, column
671 ]
672 
673 def cursor-left screen:&:screen -> screen:&:screen [
674   local-scope
675   load-ingredients
676   {
677   ¦ break-if screen
678   ¦ # real screen
679   ¦ move-cursor-left-on-display
680   ¦ return
681   }
682   # fake screen
683   column:num <- get *screen, cursor-column:offset
684   at-top?:bool <- lesser-or-equal column, 0
685   return-if at-top?
686   column <- subtract column, 1
687   *screen <- put *screen, cursor-column:offset, column
688 ]
689 
690 def cursor-to-start-of-line screen:&:screen -> screen:&:screen [
691   local-scope
692   load-ingredients
693   row:num <- cursor-position screen
694   column:num <- copy 0
695   screen <- move-cursor screen, row, column
696 ]
697 
698 def cursor-to-next-line screen:&:screen -> screen:&:screen [
699   local-scope
700   load-ingredients
701   screen <- cursor-down screen
702   screen <- cursor-to-start-of-line screen
703 ]
704 
705 def move-cursor-to-column screen:&:screen, column:num -> screen:&:screen [
706   local-scope
707   load-ingredients
708   row:num, _ <- cursor-position screen
709   move-cursor screen, row, column
710 ]
711 
712 def screen-width screen:&:screen -> width:num [
713   local-scope
714   load-ingredients
715   {
716   ¦ break-unless screen
717   ¦ # fake screen
718   ¦ width <- get *screen, num-columns:offset
719   ¦ return
720   }
721   # real screen
722   width <- display-width
723 ]
724 
725 def screen-height screen:&:screen -> height:num [
726   local-scope
727   load-ingredients
728   {
729   ¦ break-unless screen
730   ¦ # fake screen
731   ¦ height <- get *screen, num-rows:offset
732   ¦ return
733   }
734   # real screen
735   height <- display-height
736 ]
737 
738 def print screen:&:screen, s:text -> screen:&:screen [
739   local-scope
740   load-ingredients
741   color:num, color-found?:bool <- next-ingredient
742   {
743   ¦ # default color to white
744   ¦ break-if color-found?
745   ¦ color <- copy 7/white
746   }
747   bg-color:num, bg-color-found?:bool <- next-ingredient
748   {
749   ¦ # default bg-color to black
750   ¦ break-if bg-color-found?
751   ¦ bg-color <- copy 0/black
752   }
753   len:num <- length *s
754   i:num <- copy 0
755   {
756   ¦ done?:bool <- greater-or-equal i, len
757   ¦ break-if done?
758   ¦ c:char <- index *s, i
759   ¦ print screen, c, color, bg-color
760   ¦ i <- add i, 1
761   ¦ loop
762   }
763 ]
764 
765 scenario print-text-wraps-past-right-margin [
766   local-scope
767   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
768   run [
769   ¦ fake-screen <- print fake-screen, [abcd]
770   ¦ 5:num/raw <- get *fake-screen, cursor-row:offset
771   ¦ 6:num/raw <- get *fake-screen, cursor-column:offset
772   ¦ 7:num/raw <- get *fake-screen, top-idx:offset
773   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
774   ¦ 10:@:screen-cell/raw <- copy *cell
775   ]
776   memory-should-contain [
777   ¦ 5 <- 1  # cursor-row
778   ¦ 6 <- 1  # cursor-column
779   ¦ 7 <- 0  # top-idx
780   ¦ 10 <- 6  # width*height
781   ¦ 11 <- 97  # 'a'
782   ¦ 12 <- 7  # white
783   ¦ 13 <- 98  # 'b'
784   ¦ 14 <- 7  # white
785   ¦ 15 <- 99  # 'c'
786   ¦ 16 <- 7  # white
787   ¦ 17 <- 100  # 'd'
788   ¦ 18 <- 7  # white
789   ¦ # rest of screen is empty
790   ¦ 19 <- 0
791   ]
792 ]
793 
794 def print screen:&:screen, n:num -> screen:&:screen [
795   local-scope
796   load-ingredients
797   color:num, color-found?:bool <- next-ingredient
798   {
799   ¦ # default color to white
800   ¦ break-if color-found?
801   ¦ color <- copy 7/white
802   }
803   bg-color:num, bg-color-found?:bool <- next-ingredient
804   {
805   ¦ # default bg-color to black
806   ¦ break-if bg-color-found?
807   ¦ bg-color <- copy 0/black
808   }
809   # todo: other bases besides decimal
810   s:text <- to-text n
811   screen <- print screen, s, color, bg-color
812 ]
813 
814 def print screen:&:screen, n:bool -> screen:&:screen [
815   local-scope
816   load-ingredients
817   color:num, color-found?:bool <- next-ingredient
818   {
819   ¦ # default color to white
820   ¦ break-if color-found?
821   ¦ color <- copy 7/white
822   }
823   bg-color:num, bg-color-found?:bool <- next-ingredient
824   {
825   ¦ # default bg-color to black
826   ¦ break-if bg-color-found?
827   ¦ bg-color <- copy 0/black
828   }
829   n2:num <- copy n
830   screen <- print screen, n2, color, bg-color
831 ]
832 
833 def print screen:&:screen, n:&:_elem -> screen:&:screen [
834   local-scope
835   load-ingredients
836   color:num, color-found?:bool <- next-ingredient
837   {
838   ¦ # default color to white
839   ¦ break-if color-found?
840   ¦ color <- copy 7/white
841   }
842   bg-color:num, bg-color-found?:bool <- next-ingredient
843   {
844   ¦ # default bg-color to black
845   ¦ break-if bg-color-found?
846   ¦ bg-color <- copy 0/black
847   }
848   n2:num <- copy n
849   screen <- print screen, n2, color, bg-color
850 ]