about summary refs log tree commit diff stats
path: root/081print.mu
blob: 487696c5ea34c88decc6481b57d0370b0e5da1af (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
pre { line-height: 125%; }
td.linenos .normal { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
span.linenos { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
td.linenos .special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
span.linenos.special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
.highlight .hll { background-color: #ffffcc }
.highlight .c { color: #888888 } /* Comment */
.highlight .err { color: #a61717; background-color: #e3d2d2 } /* Error */
.highlight .k { color: #008800; font-weight: bold } /* Keyword */
.highlight .ch { color: #888888 } /* Comment.Hashbang */
.highlight .cm { color: #888888 } /* Comment.Multiline */
.highlight .cp { color: #cc0000; font-weight: bold } /* Comment.Preproc */
.highlight .cpf { color: #888888 } /* Comment.PreprocFile */
.highlight .c1 { color: #888888 } /* Comment.Single */
.highlight .cs { color: #cc0000; font-weight: bold; background-color: #fff0f0 } /* Comment.Special */
.highlight .gd { color: #000000; background-color: #ffdddd } /* Generic.Deleted */
.highlight .ge { font-style: italic } /* Generic.Emph */
.highlight .ges { font-weight: bold; font-style: italic } /* Generic.EmphStrong */
.highlight .gr { color: #aa0000 } /* Generic.Error */
.highlight .gh { color: #333333 } /* Generic.Heading */
.highlight .gi { color: #000000; background-color: #ddffdd } /* Generic.Inserted */
.highlight .go { color: #888888 } /* Generic.Output */
.highlight .gp { color: #555555 } /* Generic.Prompt */
.highlight .gs { font-weight: bold } /* Generic.Strong */
.highlight .gu { color: #666666 } /* Generic.Subheading */
.highlight .gt { color: #aa0000 } /* Generic.Traceback */
.highlight .kc { color: #008800; font-weight: bold } /* Keyword.Constant */
.highlight .kd { color: #008800; font-weight: bold } /* Keyword.Declaration */
.highlight .kn { color: #008800; font-weight: bold } /* Keyword.Namespace */
.highlight .kp { color: #008800 } /* Keyword.Pseudo */
.highlight .kr { color: #008800; font-weight: bold } /* Keyword.Reserved */
.highlight .kt { color: #888888; font-weight: bold } /* Keyword.Type */
.highlight .m { color: #0000DD; font-weight: bold } /* Literal.Number */
.highlight .s { color: #dd2200; background-color: #fff0f0 } /* Literal.String */
.highlight .na { color: #336699 } /* Name.Attribute */
.highlight .nb { color: #003388 } /* Name.Builtin */
.highlight .nc { color: #bb0066; font-weight: bold } /* Name.Class */
.highlight .no { color: #003366; font-weight: bold } /* Name.Constant */
.highlight .nd { color: #555555 } /* Name.Decorator */
.highlight .ne { color: #bb0066; font-weight: bold } /* Name.Exception */
.highlight .nf { color: #0066bb; font-weight: bold } /* Name.Function */
.highlight .nl { color: #336699; font-style: italic } /* Name.Label */
.highlight .nn { color: #bb0066; font-weight: bold } /* Name.Namespace */
.highlight .py { color: #336699; font-weight: bold } /* Name.Property */
.highlight .nt { color: #bb0066; font-weight: bold } /* Name.Tag */
.highlight .nv { color: #336699 } /* Name.Variable */
.highlight .ow { color: #008800 } /* Operator.Word */
.highlight .w { color: #bbbbbb } /* Text.Whitespace */
.highlight .mb { color: #0000DD; font-weight: bold } /* Literal.Number.Bin */
.highlight .mf { color: #0000DD; font-weight: bold } /* Literal.Number.Float */
.highlight .mh { color: #0000DD; font-weight: bold } /* Literal.Number.Hex */
.highlight .mi { color: #0000DD; font-weight: bold } /* Literal.Number.Integer */
.highlight .mo { color: #0000DD; font-weight: bold } /* Literal.Number.Oct */
.highlight .sa { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Affix */
.highlight .sb { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Backtick */
.highlight .sc { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Char */
.highlight .dl { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Delimiter */
.highlight .sd { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Doc */
.highlight .s2 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Double */
.highlight .se { color: #0044dd; background-color: #fff0f0 } /* Literal.String.Escape */
.highlight .sh { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Heredoc */
.highlight .si { color: #3333bb; background-color: #fff0f0 } /* Literal.String.Interpol */
.highlight .sx { color: #22bb22; background-color: #f0fff0 } /* Literal.String.Other */
.highlight .sr { color: #008800; background-color: #fff0ff } /* Literal.String.Regex */
.highlight .s1 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Single */
.highlight .ss { color: #aa6600; background-color: #fff0f0 } /* Literal.String.Symbol */
.highlight .bp { color: #003388 } /* Name.Builtin.Pseudo */
.highlight .fm { color: #0066bb; font-weight: bold } /* Name.Function.Magic */
.highlight .vc { color: #336699 } /* Name.Variable.Class */
.highlight .vg { color: #dd7700 } /* Name.Variable.Global */
.highlight .vi { color: #3333bb } /* Name.Variable.Instance */
.highlight .vm { color: #336699 } /* Name.Variable.Magic */
.highlight .il { color: #0000DD; font-weight: bold } /* Literal.Number.Integer.Long */
#include <glib.h>
#include <stdarg.h>
#include <stddef.h>
#include <setjmp.h>
#include <cmocka.h>
#include <stdlib.h>
#include <string.h>

#include <stabber.h>
#include <expect.h>

#include "proftest.h"

void
send_software_version_request(void **state)
{
    prof_connect();
    stbbr_send(
        "<presence to='stabber@localhost' from='buddy1@localhost/mobile'>"
            "<priority>10</priority>"
            "<status>I'm here</status>"
        "</presence>"
    );
    assert_true(prof_output_exact("Buddy1 (mobile) is online, \"I'm here\""));
    prof_input("/software buddy1@localhost/mobile");

    assert_true(stbbr_received(
        "<iq id='*' to='buddy1@localhost/mobile' type='get'>"
            "<query xmlns='jabber:iq:version'/>"
        "</iq>"
    ));
}

void
display_software_version_result(void **state)
{
    prof_connect();
    stbbr_send(
        "<presence to='stabber@localhost' from='buddy1@localhost/mobile'>"
            "<priority>10</priority>"
            "<status>I'm here</status>"
        "</presence>"
    );
    assert_true(prof_output_exact("Buddy1 (mobile) is online, \"I'm here\""));

    stbbr_for_query("jabber:iq:version",
        "<iq id='*' type='result' lang='en' to='stabber@localhost/profanity' from='buddy1@localhost/mobile'>"
            "<query xmlns='jabber:iq:version'>"
                "<name>Profanity</name>"
                "<version>0.4.7dev.master.2cb2f83</version>"
            "</query>"
        "</iq>"
    );
    prof_input("/software buddy1@localhost/mobile");

//    assert_true(prof_output_exact("buddy1@localhost/mobile:"));
//    assert_true(prof_output_exact("Name    : Profanity"));
    assert_true(prof_output_exact("Version : 0.4.7dev.master.2cb2f83"));
}

void
shows_message_when_software_version_error(void **state)
{
    prof_connect();
    stbbr_send(
        "<presence to='stabber@localhost' from='buddy1@localhost/mobile'>"
            "<priority>10</priority>"
            "<status>I'm here</status>"
        "</presence>"
    );
    assert_true(prof_output_exact("Buddy1 (mobile) is online, \"I'm here\""));

    stbbr_for_query("jabber:iq:version",
        "<iq id='*' lang='en' type='error' to='stabber@localhost/profanity' from='buddy1@localhost/laptop'>"
            "<query xmlns='jabber:iq:version'/>"
            "<error code='503' type='cancel'>"
                "<service-unavailable xmlns='urn:ietf:params:xml:ns:xmpp-stanzas'/>"
            "</error>"
        "</iq>"
    );
    prof_input("/software buddy1@localhost/laptop");

    assert_true(prof_output_exact("Could not get software version: service-unavailable"));
}

// Typical use case for gateways that don't support resources
void
display_software_version_result_when_from_domainpart(void **state)
{
    prof_connect();
    stbbr_send(
        "<presence to='stabber@localhost' from='buddy1@localhost'>"
            "<priority>10</priority>"
            "<status>I'm here</status>"
        "</presence>"
    );
    assert_true(prof_output_exact("Buddy1 is online, \"I'm here\""));

    stbbr_for_query("jabber:iq:version",
        "<iq id='*' type='result' lang='en' to='stabber@localhost/profanity' from='localhost'>"
            "<query xmlns='jabber:iq:version'>"
                "<name>Some Gateway</name>"
                "<version>1.0</version>"
            "</query>"
        "</iq>"
    );
    prof_input("/software buddy1@localhost/__prof_default");

//    assert_true(prof_output_exact("buddy1@localhost/__prof_default:"));
//    assert_true(prof_output_exact("Name    : Some Gateway"));
    assert_true(prof_output_exact("Version : 1.0"));
}

void
show_message_in_chat_window_when_no_resource(void **state)
{
    prof_connect();
    stbbr_send(
        "<presence to='stabber@localhost' from='buddy1@localhost/mobile'>"
            "<priority>10</priority>"
            "<status>I'm here</status>"
        "</presence>"
    );
    assert_true(prof_output_exact("Buddy1 (mobile) is online, \"I'm here\""));

    prof_input("/msg Buddy1");
    prof_input("/software");

    assert_true(prof_output_exact("Unknown resource for /software command."));
}

void
display_software_version_result_in_chat(void **state)
{
    prof_c
# Wrappers around print primitives that take a 'screen' object and are thus
# easier to test.

container screen [
  num-rows:num
  num-columns:num
  cursor-row:num
  cursor-column:num
  data:&:@:screen-cell
]

container screen-cell [
  contents:char
  color:num
]

def new-fake-screen w:num, h:num -> result:&:screen [
  local-scope
  load-ingredients
  result <- new screen:type
  bufsize:num <- multiply w, h
  data:&:@:screen-cell <- new screen-cell:type, bufsize
  *result <- merge h/num-rows, w/num-columns, 0/cursor-row, 0/cursor-column, data
  result <- clear-screen result
]

def clear-screen screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  {
    break-if screen
    # real screen
    clear-display
    return
  }
  # fake screen
  buf:&:@:screen-cell <- get *screen, data:offset
  max:num <- length *buf
  i:num <- copy 0
  {
    done?:bool <- greater-or-equal i, max
    break-if done?
    curr:screen-cell <- merge 0/empty, 7/white
    *buf <- put-index *buf, i, curr
    i <- add i, 1
    loop
  }
  # reset cursor
  *screen <- put *screen, cursor-row:offset, 0
  *screen <- put *screen, cursor-column:offset, 0
]

def sync-screen screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  return-if screen  # do nothing for fake screens
  sync-display
]

def fake-screen-is-empty? screen:&:screen -> result:bool [
  local-scope
  load-ingredients
  return-unless screen, 1/true  # do nothing for real screens
  buf:&:@:screen-cell <- get *screen, data:offset
  i:num <- copy 0
  len:num <- length *buf
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    curr:screen-cell <- index *buf, i
    curr-contents:char <- get curr, contents:offset
    i <- add i, 1
    loop-unless curr-contents
    # not 0
    return 0/false
  }
  return 1/true
]

def print screen:&:screen, c:char -> screen:&:screen [
  local-scope
  load-ingredients
  color:num, color-found?:bool <- next-ingredient
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:num, bg-color-found?:bool <- next-ingredient
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  c2:num <- character-to-code c
  trace 90, [print-character], c2
  {
    # real screen
    break-if screen
    print-character-to-display c, color, bg-color
    return
  }
  # fake screen
  # (handle special cases exactly like in the real screen)
  width:num <- get *screen, num-columns:offset
  height:num <- get *screen, num-rows:offset
  # if cursor is out of bounds, silently exit
  row:num <- get *screen, cursor-row:offset
  row <- round row
  legal?:bool <- greater-or-equal row, 0
  return-unless legal?
  legal? <- lesser-than row, height
  return-unless legal?
  column:num <- get *screen, cursor-column:offset
  column <- round column
  legal? <- greater-or-equal column, 0
  return-unless legal?
  legal? <- lesser-than column, width
  return-unless legal?
#?     $print [print-character (], row, [, ], column, [): ], c, 10/newline
  # special-case: newline
  {
    newline?:bool <- equal c, 10/newline
    break-unless newline?
    {
      # unless cursor is already at bottom
      bottom:num <- subtract height, 1
      at-bottom?:bool <- greater-or-equal row, bottom
      break-if at-bottom?
      # move it to the next row
      column <- copy 0
      *screen <- put *screen, cursor-column:offset, column
      row <- add row, 1
      *screen <- put *screen, cursor-row:offset, row
    }
    return
  }
  # save character in fake screen
  index:num <- multiply row, width
  index <- add index, column
  buf:&:@:screen-cell <- get *screen, data:offset
  len:num <- length *buf
  # special-case: backspace
  {
    backspace?:bool <- equal c, 8
    break-unless backspace?
    {
      # unless cursor is already at left margin
      at-left?:bool <- lesser-or-equal column, 0
      break-if at-left?
      # clear previous location
      column <- subtract column, 1
      *screen <- put *screen, cursor-column:offset, column
      index <- subtract index, 1
      cursor:screen-cell <- merge 32/space, 7/white
      *buf <- put-index *buf, index, cursor
    }
    return
  }
  cursor:screen-cell <- merge c, color
  *buf <- put-index *buf, index, cursor
  # increment column unless it's already all the way to the right
  {
    right:num <- subtract width, 1
    at-right?:bool <- greater-or-equal column, right
    break-if at-right?
    column <- add column, 1
    *screen <- put *screen, cursor-column:offset, column
  }
]

scenario print-character-at-top-left [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  run [
    a:char <- copy 97/a
    fake-screen <- print fake-screen, a:char
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    1:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    1 <- 6  # width*height
    2 <- 97  # 'a'
    3 <- 7  # white
    # rest of screen is empty
    4 <- 0
  ]
]

scenario print-character-at-fractional-coordinate [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  a:char <- copy 97/a
  run [
    move-cursor fake-screen, 0.5, 0
    fake-screen <- print fake-screen, a:char
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    1:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    1 <- 6  # width*height
    2 <- 97  # 'a'
    3 <- 7  # white
    # rest of screen is empty
    4 <- 0
  ]
]

scenario print-character-in-color [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  run [
    a:char <- copy 97/a
    fake-screen <- print fake-screen, a:char, 1/red
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    1:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    1 <- 6  # width*height
    2 <- 97  # 'a'
    3 <- 1  # red
    # rest of screen is empty
    4 <- 0
  ]
]

scenario print-backspace-character [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  run [
    backspace:char <- copy 8/backspace
    fake-screen <- print fake-screen, backspace
    10:num/raw <- get *fake-screen, cursor-column:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    11:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    10 <- 0  # cursor column
    11 <- 6  # width*height
    12 <- 32  # space, not 'a'
    13 <- 7  # white
    # rest of screen is empty
    14 <- 0
  ]
]

scenario print-extra-backspace-character [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  run [
    backspace:char <- copy 8/backspace
    fake-screen <- print fake-screen, backspace
    fake-screen <- print fake-screen, backspace  # cursor already at left margin
    1:num/raw <- get *fake-screen, cursor-column:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    3:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    1 <- 0  # cursor column
    3 <- 6  # width*height
    4 <- 32  # space, not 'a'
    5 <- 7  # white
    # rest of screen is empty
    6 <- 0
  ]
]

scenario print-character-at-right-margin [
  # fill top row of screen with text
  local-scope
  fake-screen:&:screen <- new-fake-screen 2/width, 2/height
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  b:char <- copy 98/b
  fake-screen <- print fake-screen, b
  run [
    # cursor now at right margin
    c:char <- copy 99/c
    fake-screen <- print fake-screen, c
    10:num/raw <- get *fake-screen, cursor-column:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    11:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    10 <- 1  # cursor column
    11 <- 4  # width*height
    12 <- 97  # 'a'
    13 <- 7  # white
    14 <- 99  # 'c' over 'b'
    15 <- 7  # white
    # rest of screen is empty
    16 <- 0
  ]
]

scenario print-newline-character [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  run [
    newline:char <- copy 10/newline
    fake-screen <- print fake-screen, newline
    10:num/raw <- get *fake-screen, cursor-row:offset
    11:num/raw <- get *fake-screen, cursor-column:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    12:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    10 <- 1  # cursor row
    11 <- 0  # cursor column
    12 <- 6  # width*height
    13 <- 97  # 'a'
    14 <- 7  # white
    # rest of screen is empty
    15 <- 0
  ]
]

scenario print-newline-at-bottom-line [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  newline:char <- copy 10/newline
  fake-screen <- print fake-screen, newline
  fake-screen <- print fake-screen, newline
  run [
    # cursor now at bottom of screen
    fake-screen <- print fake-screen, newline
    10:num/raw <- get *fake-screen, cursor-row:offset
    11:num/raw <- get *fake-screen, cursor-column:offset
  ]
  # doesn't move further down
  memory-should-contain [
    10 <- 1  # cursor row
    11 <- 0  # cursor column
  ]
]

scenario print-character-at-bottom-right [
  local-scope
  fake-screen:&:screen <- new-fake-screen 2/width, 2/height
  newline:char <- copy 10/newline
  fake-screen <- print fake-screen, newline
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  b:char <- copy 98/b
  fake-screen <- print fake-screen, b
  c:char <- copy 99/c
  fake-screen <- print fake-screen, c
  fake-screen <- print fake-screen, newline
  run [
    # cursor now at bottom right
    d:char <- copy 100/d
    fake-screen <- print fake-screen, d
    10:num/raw <- get *fake-screen, cursor-row:offset
    11:num/raw <- get *fake-screen, cursor-column:offset
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    20:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    10 <- 1  # cursor row
    11 <- 1  # cursor column
    20 <- 4  # width*height
    21 <- 0  # unused
    22 <- 7  # white
    23 <- 0  # unused
    24 <- 7  # white
    25 <- 97 # 'a'
    26 <- 7  # white
    27 <- 100  # 'd' over 'b' and 'c' and newline
    28 <- 7  # white
    # rest of screen is empty
    29 <- 0
  ]
]

def clear-line screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  space:char <- copy 0/nul
  {
    break-if screen
    # real screen
    clear-line-on-display
    return
  }
  # fake screen
  width:num <- get *screen, num-columns:offset
  column:num <- get *screen, cursor-column:offset
  original-column:num <- copy column
  # space over the entire line
  {
    right:num <- subtract width, 1
    done?:bool <- greater-or-equal column, right
    break-if done?
    print screen, space
    column <- add column, 1
    loop
  }
  # now back to where the cursor was
  *screen <- put *screen, cursor-column:offset, original-column
]

def clear-line-until screen:&:screen, right:num/inclusive -> screen:&:screen [
  local-scope
  load-ingredients
  _, column:num <- cursor-position screen
  space:char <- copy 32/space
  bg-color:num, bg-color-found?:bool <- next-ingredient
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  {
    done?:bool <- greater-than column, right
    break-if done?
    screen <- print screen, space, 7/white, bg-color  # foreground color is mostly unused except if the cursor shows up at this cell
    column <- add column, 1
    loop
  }
]

def cursor-position screen:&:screen -> row:num, column:num [
  local-scope
  load-ingredients
  {
    break-if screen
    # real screen
    row, column <- cursor-position-on-display
    return
  }
  # fake screen
  row:num <- get *screen, cursor-row:offset
  column:num <- get *screen, cursor-column:offset
]

def move-cursor screen:&:screen, new-row:num, new-column:num -> screen:&:screen [
  local-scope
  load-ingredients
  {
    break-if screen
    # real screen
    move-cursor-on-display new-row, new-column
    return
  }
  # fake screen
  *screen <- put *screen, cursor-row:offset, new-row
  *screen <- put *screen, cursor-column:offset, new-column
]

scenario clear-line-erases-printed-characters [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  # print a character
  a:char <- copy 97/a
  fake-screen <- print fake-screen, a
  # move cursor to start of line
  fake-screen <- move-cursor fake-screen, 0/row, 0/column
  run [
    fake-screen <- clear-line fake-screen
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    10:@:screen-cell/raw <- copy *cell
  ]
  # screen should be blank
  memory-should-contain [
    10 <- 6  # width*height
    11 <- 0
    12 <- 7
    13 <- 0
    14 <- 7
    15 <- 0
    16 <- 7
    17 <- 0
    18 <- 7
    19 <- 0
    20 <- 7
    21 <- 0
    22 <- 7
  ]
]

def cursor-down screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  {
    break-if screen
    # real screen
    move-cursor-down-on-display
    return
  }
  # fake screen
  height:num <- get *screen, num-rows:offset
  row:num <- get *screen, cursor-row:offset
  max:num <- subtract height, 1
  at-bottom?:bool <- greater-or-equal row, max
  return-if at-bottom?
  row <- add row, 1
  *screen <- put *screen, cursor-row:offset, row
]

def cursor-up screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  {
    break-if screen
    # real screen
    move-cursor-up-on-display
    return
  }
  # fake screen
  row:num <- get *screen, cursor-row:offset
  at-top?:bool <- lesser-or-equal row, 0
  return-if at-top?
  row <- subtract row, 1
  *screen <- put *screen, cursor-row:offset, row
]

def cursor-right screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  {
    break-if screen
    # real screen
    move-cursor-right-on-display
    return
  }
  # fake screen
  width:num <- get *screen, num-columns:offset
  column:num <- get *screen, cursor-column:offset
  max:num <- subtract width, 1
  at-bottom?:bool <- greater-or-equal column, max
  return-if at-bottom?
  column <- add column, 1
  *screen <- put *screen, cursor-column:offset, column
]

def cursor-left screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  {
    break-if screen
    # real screen
    move-cursor-left-on-display
    return
  }
  # fake screen
  column:num <- get *screen, cursor-column:offset
  at-top?:bool <- lesser-or-equal column, 0
  return-if at-top?
  column <- subtract column, 1
  *screen <- put *screen, cursor-column:offset, column
]

def cursor-to-start-of-line screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  row:num <- cursor-position screen
  column:num <- copy 0
  screen <- move-cursor screen, row, column
]

def cursor-to-next-line screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  screen <- cursor-down screen
  screen <- cursor-to-start-of-line screen
]

def move-cursor-to-column screen:&:screen, column:num -> screen:&:screen [
  local-scope
  load-ingredients
  row:num, _ <- cursor-position screen
  move-cursor screen, row, column
]

def screen-width screen:&:screen -> width:num [
  local-scope
  load-ingredients
  {
    break-unless screen
    # fake screen
    width <- get *screen, num-columns:offset
    return
  }
  # real screen
  width <- display-width
]

def screen-height screen:&:screen -> height:num [
  local-scope
  load-ingredients
  {
    break-unless screen
    # fake screen
    height <- get *screen, num-rows:offset
    return
  }
  # real screen
  height <- display-height
]

def hide-cursor screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  return-if screen  # fake screen; do nothing
  # real screen
  hide-cursor-on-display
]

def show-cursor screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  return-if screen  # fake screen; do nothing
  # real screen
  show-cursor-on-display
]

def hide-screen screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  return-if screen  # fake screen; do nothing
  # real screen
  hide-display
]

def show-screen screen:&:screen -> screen:&:screen [
  local-scope
  load-ingredients
  return-if screen  # fake screen; do nothing
  # real screen
  show-display
]

def print screen:&:screen, s:text -> screen:&:screen [
  local-scope
  load-ingredients
  color:num, color-found?:bool <- next-ingredient
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:num, bg-color-found?:bool <- next-ingredient
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  len:num <- length *s
  i:num <- copy 0
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    c:char <- index *s, i
    print screen, c, color, bg-color
    i <- add i, 1
    loop
  }
]

scenario print-text-stops-at-right-margin [
  local-scope
  fake-screen:&:screen <- new-fake-screen 3/width, 2/height
  run [
    fake-screen <- print fake-screen, [abcd]
    cell:&:@:screen-cell <- get *fake-screen, data:offset
    10:@:screen-cell/raw <- copy *cell
  ]
  memory-should-contain [
    10 <- 6  # width*height
    11 <- 97  # 'a'
    12 <- 7  # white
    13 <- 98  # 'b'
    14 <- 7  # white
    15 <- 100  # 'd' overwrites 'c'
    16 <- 7  # white
    # rest of screen is empty
    17 <- 0
  ]
]

def print screen:&:screen, n:num -> screen:&:screen [
  local-scope
  load-ingredients
  color:num, color-found?:bool <- next-ingredient
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:num, bg-color-found?:bool <- next-ingredient
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  # todo: other bases besides decimal
  s:text <- to-text n
  screen <- print screen, s, color, bg-color
]

def print screen:&:screen, n:bool -> screen:&:screen [
  local-scope
  load-ingredients
  color:num, color-found?:bool <- next-ingredient
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:num, bg-color-found?:bool <- next-ingredient
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  n2:num <- copy n
  screen <- print screen, n2, color, bg-color
]

def print screen:&:screen, n:&:_elem -> screen:&:screen [
  local-scope
  load-ingredients
  color:num, color-found?:bool <- next-ingredient
  {
    # default color to white
    break-if color-found?
    color <- copy 7/white
  }
  bg-color:num, bg-color-found?:bool <- next-ingredient
  {
    # default bg-color to black
    break-if bg-color-found?
    bg-color <- copy 0/black
  }
  n2:num <- copy n
  screen <- print screen, n2, color, bg-color
]