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
 10 ]
 11 
 12 container screen-cell [
 13   contents:char
 14   color:num
 15 ]
 16 
 17 def new-fake-screen w:num, h:num -> result:&:screen [
 18   local-scope
 19   load-ingredients
 20   result <- new screen:type
 21   bufsize:num <- multiply w, h
 22   data:&:@:screen-cell <- new screen-cell:type, bufsize
 23   *result <- merge h/num-rows, w/num-columns, 0/cursor-row, 0/cursor-column, data
 24   result <- clear-screen result
 25 ]
 26 
 27 def clear-screen screen:&:screen -> screen:&:screen [
 28   local-scope
 29   load-ingredients
 30   {
 31   ¦ break-if screen
 32   ¦ # real screen
 33   ¦ clear-display
 34   ¦ return
 35   }
 36   # fake screen
 37   buf:&:@:screen-cell <- get *screen, data:offset
 38   max:num <- length *buf
 39   i:num <- copy 0
 40   {
 41   ¦ done?:bool <- greater-or-equal i, max
 42   ¦ break-if done?
 43   ¦ curr:screen-cell <- merge 0/empty, 7/white
 44   ¦ *buf <- put-index *buf, i, curr
 45   ¦ i <- add i, 1
 46   ¦ loop
 47   }
 48   # reset cursor
 49   *screen <- put *screen, cursor-row:offset, 0
 50   *screen <- put *screen, cursor-column:offset, 0
 51 ]
 52 
 53 def fake-screen-is-empty? screen:&:screen -> result:bool [
 54   local-scope
 55   load-ingredients
 56   return-unless screen, 1/true  # do nothing for real screens
 57   buf:&:@:screen-cell <- get *screen, data:offset
 58   i:num <- copy 0
 59   len:num <- length *buf
 60   {
 61   ¦ done?:bool <- greater-or-equal i, len
 62   ¦ break-if done?
 63   ¦ curr:screen-cell <- index *buf, i
 64   ¦ curr-contents:char <- get curr, contents:offset
 65   ¦ i <- add i, 1
 66   ¦ loop-unless curr-contents
 67   ¦ # not 0
 68   ¦ return 0/false
 69   }
 70   return 1/true
 71 ]
 72 
 73 def print screen:&:screen, c:char -> screen:&:screen [
 74   local-scope
 75   load-ingredients
 76   color:num, color-found?:bool <- next-ingredient
 77   {
 78   ¦ # default color to white
 79   ¦ break-if color-found?
 80   ¦ color <- copy 7/white
 81   }
 82   bg-color:num, bg-color-found?:bool <- next-ingredient
 83   {
 84   ¦ # default bg-color to black
 85   ¦ break-if bg-color-found?
 86   ¦ bg-color <- copy 0/black
 87   }
 88   c2:num <- character-to-code c
 89   trace 90, [print-character], c2
 90   {
 91   ¦ # real screen
 92   ¦ break-if screen
 93   ¦ print-character-to-display c, color, bg-color
 94   ¦ return
 95   }
 96   # fake screen
 97   # (handle special cases exactly like in the real screen)
 98   width:num <- get *screen, num-columns:offset
 99   height:num <- get *screen, num-rows:offset
100   # if cursor is out of bounds, silently exit
101   row:num <- get *screen, cursor-row:offset
102   row <- round row
103   legal?:bool <- greater-or-equal row, 0
104   return-unless legal?
105   legal? <- lesser-than row, height
106   return-unless legal?
107   column:num <- get *screen, cursor-column:offset
108   column <- round column
109   legal? <- greater-or-equal column, 0
110   return-unless legal?
111   legal? <- lesser-than column, width
112   return-unless legal?
113 #?     $print [print-character (], row, [, ], column, [): ], c, 10/newline
114   # special-case: newline
115   {
116   ¦ newline?:bool <- equal c, 10/newline
117   ¦ break-unless newline?
118   ¦ {
119   ¦ ¦ # unless cursor is already at bottom
120   ¦ ¦ bottom:num <- subtract height, 1
121   ¦ ¦ at-bottom?:bool <- greater-or-equal row, bottom
122   ¦ ¦ break-if at-bottom?
123   ¦ ¦ # move it to the next row
124   ¦ ¦ column <- copy 0
125   ¦ ¦ *screen <- put *screen, cursor-column:offset, column
126   ¦ ¦ row <- add row, 1
127   ¦ ¦ *screen <- put *screen, cursor-row:offset, row
128   ¦ }
129   ¦ return
130   }
131   # save character in fake screen
132   index:num <- multiply row, width
133   index <- add index, column
134   buf:&:@:screen-cell <- get *screen, data:offset
135   len:num <- length *buf
136   # special-case: backspace
137   {
138   ¦ backspace?:bool <- equal c, 8
139   ¦ break-unless backspace?
140   ¦ {
141   ¦ ¦ # unless cursor is already at left margin
142   ¦ ¦ at-left?:bool <- lesser-or-equal column, 0
143   ¦ ¦ break-if at-left?
144   ¦ ¦ # clear previous location
145   ¦ ¦ column <- subtract column, 1
146   ¦ ¦ *screen <- put *screen, cursor-column:offset, column
147   ¦ ¦ index <- subtract index, 1
148   ¦ ¦ cursor:screen-cell <- merge 32/space, 7/white
149   ¦ ¦ *buf <- put-index *buf, index, cursor
150   ¦ }
151   ¦ return
152   }
153   cursor:screen-cell <- merge c, color
154   *buf <- put-index *buf, index, cursor
155   # increment column unless it's already all the way to the right
156   {
157   ¦ right:num <- subtract width, 1
158   ¦ at-right?:bool <- greater-or-equal column, right
159   ¦ break-if at-right?
160   ¦ column <- add column, 1
161   ¦ *screen <- put *screen, cursor-column:offset, column
162   }
163 ]
164 
165 scenario print-character-at-top-left [
166   local-scope
167   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
168   run [
169   ¦ a:char <- copy 97/a
170   ¦ fake-screen <- print fake-screen, a:char
171   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
172   ¦ 1:@:screen-cell/raw <- copy *cell
173   ]
174   memory-should-contain [
175   ¦ 1 <- 6  # width*height
176   ¦ 2 <- 97  # 'a'
177   ¦ 3 <- 7  # white
178   ¦ # rest of screen is empty
179   ¦ 4 <- 0
180   ]
181 ]
182 
183 scenario print-character-at-fractional-coordinate [
184   local-scope
185   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
186   a:char <- copy 97/a
187   run [
188   ¦ move-cursor fake-screen, 0.5, 0
189   ¦ fake-screen <- print fake-screen, a:char
190   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
191   ¦ 1:@:screen-cell/raw <- copy *cell
192   ]
193   memory-should-contain [
194   ¦ 1 <- 6  # width*height
195   ¦ 2 <- 97  # 'a'
196   ¦ 3 <- 7  # white
197   ¦ # rest of screen is empty
198   ¦ 4 <- 0
199   ]
200 ]
201 
202 scenario print-character-in-color [
203   local-scope
204   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
205   run [
206   ¦ a:char <- copy 97/a
207   ¦ fake-screen <- print fake-screen, a:char, 1/red
208   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
209   ¦ 1:@:screen-cell/raw <- copy *cell
210   ]
211   memory-should-contain [
212   ¦ 1 <- 6  # width*height
213   ¦ 2 <- 97  # 'a'
214   ¦ 3 <- 1  # red
215   ¦ # rest of screen is empty
216   ¦ 4 <- 0
217   ]
218 ]
219 
220 scenario print-backspace-character [
221   local-scope
222   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
223   a:char <- copy 97/a
224   fake-screen <- print fake-screen, a
225   run [
226   ¦ backspace:char <- copy 8/backspace
227   ¦ fake-screen <- print fake-screen, backspace
228   ¦ 10:num/raw <- get *fake-screen, cursor-column:offset
229   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
230   ¦ 11:@:screen-cell/raw <- copy *cell
231   ]
232   memory-should-contain [
233   ¦ 10 <- 0  # cursor column
234   ¦ 11 <- 6  # width*height
235   ¦ 12 <- 32  # space, not 'a'
236   ¦ 13 <- 7  # white
237   ¦ # rest of screen is empty
238   ¦ 14 <- 0
239   ]
240 ]
241 
242 scenario print-extra-backspace-character [
243   local-scope
244   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
245   a:char <- copy 97/a
246   fake-screen <- print fake-screen, a
247   run [
248   ¦ backspace:char <- copy 8/backspace
249   ¦ fake-screen <- print fake-screen, backspace
250   ¦ fake-screen <- print fake-screen, backspace  # cursor already at left margin
251   ¦ 1:num/raw <- get *fake-screen, cursor-column:offset
252   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
253   ¦ 3:@:screen-cell/raw <- copy *cell
254   ]
255   memory-should-contain [
256   ¦ 1 <- 0  # cursor column
257   ¦ 3 <- 6  # width*height
258   ¦ 4 <- 32  # space, not 'a'
259   ¦ 5 <- 7  # white
260   ¦ # rest of screen is empty
261   ¦ 6 <- 0
262   ]
263 ]
264 
265 scenario print-character-at-right-margin [
266   # fill top row of screen with text
267   local-scope
268   fake-screen:&:screen <- new-fake-screen 2/width, 2/height
269   a:char <- copy 97/a
270   fake-screen <- print fake-screen, a
271   b:char <- copy 98/b
272   fake-screen <- print fake-screen, b
273   run [
274   ¦ # cursor now at right margin
275   ¦ c:char <- copy 99/c
276   ¦ fake-screen <- print fake-screen, c
277   ¦ 10:num/raw <- get *fake-screen, cursor-column:offset
278   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
279   ¦ 11:@:screen-cell/raw <- copy *cell
280   ]
281   memory-should-contain [
282   ¦ 10 <- 1  # cursor column
283   ¦ 11 <- 4  # width*height
284   ¦ 12 <- 97  # 'a'
285   ¦ 13 <- 7  # white
286   ¦ 14 <- 99  # 'c' over 'b'
287   ¦ 15 <- 7  # white
288   ¦ # rest of screen is empty
289   ¦ 16 <- 0
290   ]
291 ]
292 
293 scenario print-newline-character [
294   local-scope
295   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
296   a:char <- copy 97/a
297   fake-screen <- print fake-screen, a
298   run [
299   ¦ newline:char <- copy 10/newline
300   ¦ fake-screen <- print fake-screen, newline
301   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
302   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
303   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
304   ¦ 12:@:screen-cell/raw <- copy *cell
305   ]
306   memory-should-contain [
307   ¦ 10 <- 1  # cursor row
308   ¦ 11 <- 0  # cursor column
309   ¦ 12 <- 6  # width*height
310   ¦ 13 <- 97  # 'a'
311   ¦ 14 <- 7  # white
312   ¦ # rest of screen is empty
313   ¦ 15 <- 0
314   ]
315 ]
316 
317 scenario print-newline-at-bottom-line [
318   local-scope
319   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
320   newline:char <- copy 10/newline
321   fake-screen <- print fake-screen, newline
322   fake-screen <- print fake-screen, newline
323   run [
324   ¦ # cursor now at bottom of screen
325   ¦ fake-screen <- print fake-screen, newline
326   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
327   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
328   ]
329   # doesn't move further down
330   memory-should-contain [
331   ¦ 10 <- 1  # cursor row
332   ¦ 11 <- 0  # cursor column
333   ]
334 ]
335 
336 scenario print-character-at-bottom-right [
337   local-scope
338   fake-screen:&:screen <- new-fake-screen 2/width, 2/height
339   newline:char <- copy 10/newline
340   fake-screen <- print fake-screen, newline
341   a:char <- copy 97/a
342   fake-screen <- print fake-screen, a
343   b:char <- copy 98/b
344   fake-screen <- print fake-screen, b
345   c:char <- copy 99/c
346   fake-screen <- print fake-screen, c
347   fake-screen <- print fake-screen, newline
348   run [
349   ¦ # cursor now at bottom right
350   ¦ d:char <- copy 100/d
351   ¦ fake-screen <- print fake-screen, d
352   ¦ 10:num/raw <- get *fake-screen, cursor-row:offset
353   ¦ 11:num/raw <- get *fake-screen, cursor-column:offset
354   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
355   ¦ 20:@:screen-cell/raw <- copy *cell
356   ]
357   memory-should-contain [
358   ¦ 10 <- 1  # cursor row
359   ¦ 11 <- 1  # cursor column
360   ¦ 20 <- 4  # width*height
361   ¦ 21 <- 0  # unused
362   ¦ 22 <- 7  # white
363   ¦ 23 <- 0  # unused
364   ¦ 24 <- 7  # white
365   ¦ 25 <- 97 # 'a'
366   ¦ 26 <- 7  # white
367   ¦ 27 <- 100  # 'd' over 'b' and 'c' and newline
368   ¦ 28 <- 7  # white
369   ¦ # rest of screen is empty
370   ¦ 29 <- 0
371   ]
372 ]
373 
374 def clear-line screen:&:screen -> screen:&:screen [
375   local-scope
376   load-ingredients
377   space:char <- copy 0/nul
378   {
379   ¦ break-if screen
380   ¦ # real screen
381   ¦ clear-line-on-display
382   ¦ return
383   }
384   # fake screen
385   width:num <- get *screen, num-columns:offset
386   column:num <- get *screen, cursor-column:offset
387   original-column:num <- copy column
388   # space over the entire line
389   {
390   ¦ right:num <- subtract width, 1
391   ¦ done?:bool <- greater-or-equal column, right
392   ¦ break-if done?
393   ¦ print screen, space
394   ¦ column <- add column, 1
395   ¦ loop
396   }
397   # now back to where the cursor was
398   *screen <- put *screen, cursor-column:offset, original-column
399 ]
400 
401 def clear-line-until screen:&:screen, right:num/inclusive -> screen:&:screen [
402   local-scope
403   load-ingredients
404   _, column:num <- cursor-position screen
405   space:char <- copy 32/space
406   bg-color:num, bg-color-found?:bool <- next-ingredient
407   {
408   ¦ # default bg-color to black
409   ¦ break-if bg-color-found?
410   ¦ bg-color <- copy 0/black
411   }
412   {
413   ¦ done?:bool <- greater-than column, right
414   ¦ break-if done?
415   ¦ screen <- print screen, space, 7/white, bg-color  # foreground color is mostly unused except if the cursor shows up at this cell
416   ¦ column <- add column, 1
417   ¦ loop
418   }
419 ]
420 
421 def cursor-position screen:&:screen -> row:num, column:num [
422   local-scope
423   load-ingredients
424   {
425   ¦ break-if screen
426   ¦ # real screen
427   ¦ row, column <- cursor-position-on-display
428   ¦ return
429   }
430   # fake screen
431   row:num <- get *screen, cursor-row:offset
432   column:num <- get *screen, cursor-column:offset
433 ]
434 
435 def move-cursor screen:&:screen, new-row:num, new-column:num -> screen:&:screen [
436   local-scope
437   load-ingredients
438   {
439   ¦ break-if screen
440   ¦ # real screen
441   ¦ move-cursor-on-display new-row, new-column
442   ¦ return
443   }
444   # fake screen
445   *screen <- put *screen, cursor-row:offset, new-row
446   *screen <- put *screen, cursor-column:offset, new-column
447 ]
448 
449 scenario clear-line-erases-printed-characters [
450   local-scope
451   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
452   # print a character
453   a:char <- copy 97/a
454   fake-screen <- print fake-screen, a
455   # move cursor to start of line
456   fake-screen <- move-cursor fake-screen, 0/row, 0/column
457   run [
458   ¦ fake-screen <- clear-line fake-screen
459   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
460   ¦ 10:@:screen-cell/raw <- copy *cell
461   ]
462   # screen should be blank
463   memory-should-contain [
464   ¦ 10 <- 6  # width*height
465   ¦ 11 <- 0
466   ¦ 12 <- 7
467   ¦ 13 <- 0
468   ¦ 14 <- 7
469   ¦ 15 <- 0
470   ¦ 16 <- 7
471   ¦ 17 <- 0
472   ¦ 18 <- 7
473   ¦ 19 <- 0
474   ¦ 20 <- 7
475   ¦ 21 <- 0
476   ¦ 22 <- 7
477   ]
478 ]
479 
480 def cursor-down screen:&:screen -> screen:&:screen [
481   local-scope
482   load-ingredients
483   {
484   ¦ break-if screen
485   ¦ # real screen
486   ¦ move-cursor-down-on-display
487   ¦ return
488   }
489   # fake screen
490   height:num <- get *screen, num-rows:offset
491   row:num <- get *screen, cursor-row:offset
492   max:num <- subtract height, 1
493   at-bottom?:bool <- greater-or-equal row, max
494   return-if at-bottom?
495   row <- add row, 1
496   *screen <- put *screen, cursor-row:offset, row
497 ]
498 
499 def cursor-up screen:&:screen -> screen:&:screen [
500   local-scope
501   load-ingredients
502   {
503   ¦ break-if screen
504   ¦ # real screen
505   ¦ move-cursor-up-on-display
506   ¦ return
507   }
508   # fake screen
509   row:num <- get *screen, cursor-row:offset
510   at-top?:bool <- lesser-or-equal row, 0
511   return-if at-top?
512   row <- subtract row, 1
513   *screen <- put *screen, cursor-row:offset, row
514 ]
515 
516 def cursor-right screen:&:screen -> screen:&:screen [
517   local-scope
518   load-ingredients
519   {
520   ¦ break-if screen
521   ¦ # real screen
522   ¦ move-cursor-right-on-display
523   ¦ return
524   }
525   # fake screen
526   width:num <- get *screen, num-columns:offset
527   column:num <- get *screen, cursor-column:offset
528   max:num <- subtract width, 1
529   at-bottom?:bool <- greater-or-equal column, max
530   return-if at-bottom?
531   column <- add column, 1
532   *screen <- put *screen, cursor-column:offset, column
533 ]
534 
535 def cursor-left screen:&:screen -> screen:&:screen [
536   local-scope
537   load-ingredients
538   {
539   ¦ break-if screen
540   ¦ # real screen
541   ¦ move-cursor-left-on-display
542   ¦ return
543   }
544   # fake screen
545   column:num <- get *screen, cursor-column:offset
546   at-top?:bool <- lesser-or-equal column, 0
547   return-if at-top?
548   column <- subtract column, 1
549   *screen <- put *screen, cursor-column:offset, column
550 ]
551 
552 def cursor-to-start-of-line screen:&:screen -> screen:&:screen [
553   local-scope
554   load-ingredients
555   row:num <- cursor-position screen
556   column:num <- copy 0
557   screen <- move-cursor screen, row, column
558 ]
559 
560 def cursor-to-next-line screen:&:screen -> screen:&:screen [
561   local-scope
562   load-ingredients
563   screen <- cursor-down screen
564   screen <- cursor-to-start-of-line screen
565 ]
566 
567 def move-cursor-to-column screen:&:screen, column:num -> screen:&:screen [
568   local-scope
569   load-ingredients
570   row:num, _ <- cursor-position screen
571   move-cursor screen, row, column
572 ]
573 
574 def screen-width screen:&:screen -> width:num [
575   local-scope
576   load-ingredients
577   {
578   ¦ break-unless screen
579   ¦ # fake screen
580   ¦ width <- get *screen, num-columns:offset
581   ¦ return
582   }
583   # real screen
584   width <- display-width
585 ]
586 
587 def screen-height screen:&:screen -> height:num [
588   local-scope
589   load-ingredients
590   {
591   ¦ break-unless screen
592   ¦ # fake screen
593   ¦ height <- get *screen, num-rows:offset
594   ¦ return
595   }
596   # real screen
597   height <- display-height
598 ]
599 
600 def print screen:&:screen, s:text -> screen:&:screen [
601   local-scope
602   load-ingredients
603   color:num, color-found?:bool <- next-ingredient
604   {
605   ¦ # default color to white
606   ¦ break-if color-found?
607   ¦ color <- copy 7/white
608   }
609   bg-color:num, bg-color-found?:bool <- next-ingredient
610   {
611   ¦ # default bg-color to black
612   ¦ break-if bg-color-found?
613   ¦ bg-color <- copy 0/black
614   }
615   len:num <- length *s
616   i:num <- copy 0
617   {
618   ¦ done?:bool <- greater-or-equal i, len
619   ¦ break-if done?
620   ¦ c:char <- index *s, i
621   ¦ print screen, c, color, bg-color
622   ¦ i <- add i, 1
623   ¦ loop
624   }
625 ]
626 
627 scenario print-text-stops-at-right-margin [
628   local-scope
629   fake-screen:&:screen <- new-fake-screen 3/width, 2/height
630   run [
631   ¦ fake-screen <- print fake-screen, [abcd]
632   ¦ cell:&:@:screen-cell <- get *fake-screen, data:offset
633   ¦ 10:@:screen-cell/raw <- copy *cell
634   ]
635   memory-should-contain [
636   ¦ 10 <- 6  # width*height
637   ¦ 11 <- 97  # 'a'
638   ¦ 12 <- 7  # white
639   ¦ 13 <- 98  # 'b'
640   ¦ 14 <- 7  # white
641   ¦ 15 <- 100  # 'd' overwrites 'c'
642   ¦ 16 <- 7  # white
643   ¦ # rest of screen is empty
644   ¦ 17 <- 0
645   ]
646 ]
647 
648 def print screen:&:screen, n:num -> screen:&:screen [
649   local-scope
650   load-ingredients
651   color:num, color-found?:bool <- next-ingredient
652   {
653   ¦ # default color to white
654   ¦ break-if color-found?
655   ¦ color <- copy 7/white
656   }
657   bg-color:num, bg-color-found?:bool <- next-ingredient
658   {
659   ¦ # default bg-color to black
660   ¦ break-if bg-color-found?
661   ¦ bg-color <- copy 0/black
662   }
663   # todo: other bases besides decimal
664   s:text <- to-text n
665   screen <- print screen, s, color, bg-color
666 ]
667 
668 def print screen:&:screen, n:bool -> screen:&:screen [
669   local-scope
670   load-ingredients
671   color:num, color-found?:bool <- next-ingredient
672   {
673   ¦ # default color to white
674   ¦ break-if color-found?
675   ¦ color <- copy 7/white
676   }
677   bg-color:num, bg-color-found?:bool <- next-ingredient
678   {
679   ¦ # default bg-color to black
680   ¦ break-if bg-color-found?
681   ¦ bg-color <- copy 0/black
682   }
683   n2:num <- copy n
684   screen <- print screen, n2, color, bg-color
685 ]
686 
687 def print screen:&:screen, n:&:_elem -> screen:&:screen [
688   local-scope
689   load-ingredients
690   color:num, color-found?:bool <- next-ingredient
691   {
692   ¦ # default color to white
693   ¦ break-if color-found?
694   ¦ color <- copy 7/white
695   }
696   bg-color:num, bg-color-found?:bool <- next-ingredient
697   {
698   ¦ # default bg-color to black
699   ¦ break-if bg-color-found?
700   ¦ bg-color <- copy 0/black
701   }
702   n2:num <- copy n
703   screen <- print screen, n2, color, bg-color
704 ]