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