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/empty, 7/white
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 <- 7  # white
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   cursor-down-on-fake-screen screen
629 ]
630 
631 scenario cursor-down-scrolls [
632   local-scope
633   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
634   # print something to screen and scroll
635   run [
636   ¦ print fake-screen, [abc]
637   ¦ cursor-to-next-line fake-screen
638   ¦ cursor-to-next-line fake-screen
639   ¦ data:&:@:screen-cell <- get *fake-screen, data:offset
640   ¦ 10:@:screen-cell/raw <- copy *data
641   ]
642   # screen is now blank
643   memory-should-contain [
644   ¦ 10 <- 6  # width*height
645   ¦ 11 <- 0
646   ¦ 12 <- 7  # white
647   ¦ 13 <- 0
648   ¦ 14 <- 7  # white
649   ¦ 15 <- 0
650   ¦ 16 <- 7  # white
651   ¦ 17 <- 0
652   ¦ 18 <- 7  # white
653   ¦ 19 <- 0
654   ¦ 20 <- 7  # white
655   ¦ 21 <- 0
656   ¦ 22 <- 7  # white
657   ]
658 ]
659 
660 def cursor-up screen:&:screen -> screen:&:screen [
661   local-scope
662   load-ingredients
663   {
664   ¦ break-if screen
665   ¦ # real screen
666   ¦ move-cursor-up-on-display
667   ¦ return
668   }
669   # fake screen
670   row:num <- get *screen, cursor-row:offset
671   at-top?:bool <- lesser-or-equal row, 0
672   return-if at-top?
673   row <- subtract row, 1
674   *screen <- put *screen, cursor-row:offset, row
675 ]
676 
677 def cursor-right screen:&:screen -> screen:&:screen [
678   local-scope
679   load-ingredients
680   {
681   ¦ break-if screen
682   ¦ # real screen
683   ¦ move-cursor-right-on-display
684   ¦ return
685   }
686   # fake screen
687   width:num <- get *screen, num-columns:offset
688   column:num <- get *screen, cursor-column:offset
689   max:num <- subtract width, 1
690   at-bottom?:bool <- greater-or-equal column, max
691   return-if at-bottom?
692   column <- add column, 1
693   *screen <- put *screen, cursor-column:offset, column
694 ]
695 
696 def cursor-left screen:&:screen -> screen:&:screen [
697   local-scope
698   load-ingredients
699   {
700   ¦ break-if screen
701   ¦ # real screen
702   ¦ move-cursor-left-on-display
703   ¦ return
704   }
705   # fake screen
706   column:num <- get *screen, cursor-column:offset
707   at-top?:bool <- lesser-or-equal column, 0
708   return-if at-top?
709   column <- subtract column, 1
710   *screen <- put *screen, cursor-column:offset, column
711 ]
712 
713 def cursor-to-start-of-line screen:&:screen -> screen:&:screen [
714   local-scope
715   load-ingredients
716   row:num <- cursor-position screen
717   column:num <- copy 0
718   screen <- move-cursor screen, row, column
719 ]
720 
721 def cursor-to-next-line screen:&:screen -> screen:&:screen [
722   local-scope
723   load-ingredients
724   screen <- cursor-down screen
725   screen <- cursor-to-start-of-line screen
726 ]
727 
728 def move-cursor-to-column screen:&:screen, column:num -> screen:&:screen [
729   local-scope
730   load-ingredients
731   row:num, _ <- cursor-position screen
732   move-cursor screen, row, column
733 ]
734 
735 def screen-width screen:&:screen -> width:num [
736   local-scope
737   load-ingredients
738   {
739   ¦ break-unless screen
740   ¦ # fake screen
741   ¦ width <- get *screen, num-columns:offset
742   ¦ return
743   }
744   # real screen
745   width <- display-width
746 ]
747 
748 def screen-height screen:&:screen -> height:num [
749   local-scope
750   load-ingredients
751   {
752   ¦ break-unless screen
753   ¦ # fake screen
754   ¦ height <- get *screen, num-rows:offset
755   ¦ return
756   }
757   # real screen
758   height <- display-height
759 ]
760 
761 def print screen:&:screen, s:text -> screen:&:screen [
762   local-scope
763   load-ingredients
764   color:num, color-found?:bool <- next-ingredient
765   {
766   ¦ # default color to white
767   ¦ break-if color-found?
768   ¦ color <- copy 7/white
769   }
770   bg-color:num, bg-color-found?:bool <- next-ingredient
771   {
772   ¦ # default bg-color to black
773   ¦ break-if bg-color-found?
774   ¦ bg-color <- copy 0/black
775   }
776   len:num <- length *s
777   i:num <- copy 0
778   {
779   ¦ done?:bool <- greater-or-equal i, len
780   ¦ break-if done?
781   ¦ c:char <- index *s, i
782   ¦ print screen, c, color, bg-color
783   ¦ i <- add i, 1
784   ¦ loop
785   }
786 ]
787 
788 scenario print-text-wraps-past-right-margin [
789   local-scope
790   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
791   run [
792   ¦ fake-screen <- print fake-screen, [abcd]
793   ¦ 5:num/raw <- get *fake-screen, cursor-row:offset
794   ¦ 6:num/raw <- get *fake-screen, cursor-column:offset
795   ¦ 7:num/raw <- get *fake-screen, top-idx:offset
796   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
797   ¦ 10:@:screen-cell/raw <- copy *cell
798   ]
799   memory-should-contain [
800   ¦ 5 <- 1  # cursor-row
801   ¦ 6 <- 1  # cursor-column
802   ¦ 7 <- 0  # top-idx
803   ¦ 10 <- 6  # width*height
804   ¦ 11 <- 97  # 'a'
805   ¦ 12 <- 7  # white
806   ¦ 13 <- 98  # 'b'
807   ¦ 14 <- 7  # white
808   ¦ 15 <- 99  # 'c'
809   ¦ 16 <- 7  # white
810   ¦ 17 <- 100  # 'd'
811   ¦ 18 <- 7  # white
812   ¦ # rest of screen is empty
813   ¦ 19 <- 0
814   ]
815 ]
816 
817 def print screen:&:screen, n:num -> screen:&:screen [
818   local-scope
819   load-ingredients
820   color:num, color-found?:bool <- next-ingredient
821   {
822   ¦ # default color to white
823   ¦ break-if color-found?
824   ¦ color <- copy 7/white
825   }
826   bg-color:num, bg-color-found?:bool <- next-ingredient
827   {
828   ¦ # default bg-color to black
829   ¦ break-if bg-color-found?
830   ¦ bg-color <- copy 0/black
831   }
832   # todo: other bases besides decimal
833   s:text <- to-text n
834   screen <- print screen, s, color, bg-color
835 ]
836 
837 def print screen:&:screen, n:bool -> screen:&:screen [
838   local-scope
839   load-ingredients
840   color:num, color-found?:bool <- next-ingredient
841   {
842   ¦ # default color to white
843   ¦ break-if color-found?
844   ¦ color <- copy 7/white
845   }
846   bg-color:num, bg-color-found?:bool <- next-ingredient
847   {
848   ¦ # default bg-color to black
849   ¦ break-if bg-color-found?
850   ¦ bg-color <- copy 0/black
851   }
852   n2:num <- copy n
853   screen <- print screen, n2, color, bg-color
854 ]
855 
856 def print screen:&:screen, n:&:_elem -> screen:&:screen [
857   local-scope
858   load-ingredients
859   color:num, color-found?:bool <- next-ingredient
860   {
861   ¦ # default color to white
862   ¦ break-if color-found?
863   ¦ color <- copy 7/white
864   }
865   bg-color:num, bg-color-found?:bool <- next-ingredient
866   {
867   ¦ # default bg-color to black
868   ¦ break-if bg-color-found?
869   ¦ bg-color <- copy 0/black
870   }
871   n2:num <- copy n
872   screen <- print screen, n2, color, bg-color
873 ]