1
2
3
4
5 def! main text:text [
6 local-scope
7 load-ingredients
8 open-console
9 hide-screen 0/screen
10 e:&:editor <- new-editor text, 0/left, 5/right
11 render 0/screen, e
12 show-screen 0/screen
13 wait-for-event 0/console
14 close-console
15 ]
16
17 scenario editor-renders-text-to-screen [
18 local-scope
19 assume-screen 10/width, 5/height
20 e:&:editor <- new-editor [abc], 0/left, 10/right
21 run [
22 render screen, e
23 ]
24 screen-should-contain [
25
26 . .
27 .abc .
28 . .
29 ]
30 ]
31
32 container editor [
33
34 data:&:duplex-list:char
35 top-of-screen:&:duplex-list:char
36 bottom-of-screen:&:duplex-list:char
37
38 before-cursor:&:duplex-list:char
39
40
41
42 left:num
43 right:num
44 bottom:num
45
46 cursor-row:num
47 cursor-column:num
48 ]
49
50
51
52 def new-editor s:text, left:num, right:num -> result:&:editor [
53 local-scope
54 load-ingredients
55
56 right <- subtract right, 1
57 result <- new editor:type
58
59 *result <- put *result, left:offset, left
60 *result <- put *result, right:offset, right
61
62 *result <- put *result, cursor-row:offset, 1/top
63 *result <- put *result, cursor-column:offset, left
64
65 init:&:duplex-list:char <- push 167/§, 0/tail
66 *result <- put *result, data:offset, init
67 *result <- put *result, top-of-screen:offset, init
68 *result <- put *result, before-cursor:offset, init
69 result <- insert-text result, s
70 <editor-initialization>
71 ]
72
73 def insert-text editor:&:editor, text:text -> editor:&:editor [
74 local-scope
75 load-ingredients
76
77 return-unless text
78 len:num <- length *text
79 return-unless len
80 idx:num <- copy 0
81
82 curr:&:duplex-list:char <- get *editor, data:offset
83 {
84 done?:bool <- greater-or-equal idx, len
85 break-if done?
86 c:char <- index *text, idx
87 insert c, curr
88
89 curr <- next curr
90 idx <- add idx, 1
91 loop
92 }
93 ]
94
95 scenario editor-initializes-without-data [
96 local-scope
97 assume-screen 5/width, 3/height
98 run [
99 e:&:editor <- new-editor 0/data, 2/left, 5/right
100 2:editor/raw <- copy *e
101 ]
102 memory-should-contain [
103
104
105 4 <- 0
106
107 6 <- 2
108 7 <- 4
109 8 <- 0
110 9 <- 1
111 10 <- 2
112 ]
113 screen-should-contain [
114 . .
115 . .
116 . .
117 ]
118 ]
119
120
121
122
123 def render screen:&:screen, editor:&:editor -> last-row:num, last-column:num, screen:&:screen, editor:&:editor [
124 local-scope
125 load-ingredients
126 return-unless editor, 1/top, 0/left
127 left:num <- get *editor, left:offset
128 screen-height:num <- screen-height screen
129 right:num <- get *editor, right:offset
130
131 curr:&:duplex-list:char <- get *editor, top-of-screen:offset
132 prev:&:duplex-list:char <- copy curr
133 curr <- next curr
134
135 +render-loop-initialization
136 color:num <- copy 7/white
137 row:num <- copy 1/top
138 column:num <- copy left
139 cursor-row:num <- get *editor, cursor-row:offset
140 cursor-column:num <- get *editor, cursor-column:offset
141 before-cursor:&:duplex-list:char <- get *editor, before-cursor:offset
142 screen <- move-cursor screen, row, column
143 {
144 +next-character
145 break-unless curr
146 off-screen?:bool <- greater-or-equal row, screen-height
147 break-if off-screen?
148
149
150
151 {
152 at-cursor-row?:bool <- equal row, cursor-row
153 break-unless at-cursor-row?
154 at-cursor?:bool <- equal column, cursor-column
155 break-unless at-cursor?
156 before-cursor <- copy prev
157 }
158 c:char <- get *curr, value:offset
159 <character-c-received>
160 {
161
162 newline?:bool <- equal c, 10/newline
163 break-unless newline?
164
165 {
166 at-cursor-row?:bool <- equal row, cursor-row
167 break-unless at-cursor-row?
168 left-of-cursor?:bool <- lesser-than column, cursor-column
169 break-unless left-of-cursor?
170 cursor-column <- copy column
171 before-cursor <- prev curr
172 }
173
174 clear-line-until screen, right
175
176 row <- add row, 1
177 column <- copy left
178 screen <- move-cursor screen, row, column
179 curr <- next curr
180 prev <- next prev
181 loop +next-character
182 }
183 {
184
185
186 at-right?:bool <- equal column, right
187 break-unless at-right?
188
189 wrap-icon:char <- copy 8617/loop-back-to-left
190 print screen, wrap-icon, 245/grey
191 column <- copy left
192 row <- add row, 1
193 screen <- move-cursor screen, row, column
194
195 loop +next-character
196 }
197 print screen, c, color
198 curr <- next curr
199 prev <- next prev
200 column <- add column, 1
201 loop
202 }
203
204 *editor <- put *editor, bottom-of-screen:offset, curr
205
206 {
207 at-cursor-row?:bool <- equal row, cursor-row
208 cursor-outside-line?:bool <- lesser-or-equal column, cursor-column
209 before-cursor-on-same-line?:bool <- and at-cursor-row?, cursor-outside-line?
210 above-cursor-row?:bool <- lesser-than row, cursor-row
211 before-cursor?:bool <- or before-cursor-on-same-line?, above-cursor-row?
212 break-unless before-cursor?
213 cursor-row <- copy row
214 cursor-column <- copy column
215 before-cursor <- copy prev
216 }
217 *editor <- put *editor, bottom:offset, row
218 *editor <- put *editor, cursor-row:offset, cursor-row
219 *editor <- put *editor, cursor-column:offset, cursor-column
220 *editor <- put *editor, before-cursor:offset, before-cursor
221 return row, column
222 ]
223
224 def clear-screen-from screen:&:screen, row:num, column:num, left:num, right:num -> screen:&:screen [
225 local-scope
226 load-ingredients
227
228 {
229 break-if screen
230 clear-display-from row, column, left, right
231 return
232 }
233
234 screen <- move-cursor screen, row, column
235 clear-line-until screen, right
236 clear-rest-of-screen screen, row, left, right
237 ]
238
239 def clear-rest-of-screen screen:&:screen, row:num, left:num, right:num -> screen:&:screen [
240 local-scope
241 load-ingredients
242 row <- add row, 1
243 screen <- move-cursor screen, row, left
244 screen-height:num <- screen-height screen
245 {
246 at-bottom-of-screen?:bool <- greater-or-equal row, screen-height
247 break-if at-bottom-of-screen?
248 screen <- move-cursor screen, row, left
249 clear-line-until screen, right
250 row <- add row, 1
251 loop
252 }
253 ]
254
255 scenario editor-prints-multiple-lines [
256 local-scope
257 assume-screen 5/width, 5/height
258 s:text <- new [abc
259 def]
260 e:&:editor <- new-editor s, 0/left, 5/right
261 run [
262 render screen, e
263 ]
264 screen-should-contain [
265 . .
266 .abc .
267 .def .
268 . .
269 ]
270 ]
271
272 scenario editor-handles-offsets [
273 local-scope
274 assume-screen 5/width, 5/height
275 e:&:editor <- new-editor [abc], 1/left, 5/right
276 run [
277 render screen, e
278 ]
279 screen-should-contain [
280 . .
281 . abc .
282 . .
283 ]
284 ]
285
286 scenario editor-prints-multiple-lines-at-offset [
287 local-scope
288 assume-screen 5/width, 5/height
289 s:text <- new [abc
290 def]
291 e:&:editor <- new-editor s, 1/left, 5/right
292 run [
293 render screen, e
294 ]
295 screen-should-contain [
296 . .
297 . abc .
298 . def .
299 . .
300 ]
301 ]
302
303 scenario editor-wraps-long-lines [
304 local-scope
305 assume-screen 5/width, 5/height
306 e:&:editor <- new-editor [abc def], 0/left, 5/right
307 run [
308 render screen, e
309 ]
310 screen-should-contain [
311 . .
312 .abc ↩.
313 .def .
314 . .
315 ]
316 screen-should-contain-in-color 245/grey [
317 . .
318 . ↩.
319 . .
320 . .
321 ]
322 ]
323
324 scenario editor-wraps-barely-long-lines [
325 local-scope
326 assume-screen 5/width, 5/height
327 e:&:editor <- new-editor [abcde], 0/left, 5/right
328 run [
329 render screen, e
330 ]
331
332
333 screen-should-contain [
334 . .
335 .abcd↩.
336 .e .
337 . .
338 ]
339 screen-should-contain-in-color 245/grey [
340 . .
341 . ↩.
342 . .
343 . .
344 ]
345 ]
346
347 scenario editor-with-empty-text [
348 local-scope
349 assume-screen 5/width, 5/height
350 e:&:editor <- new-editor [], 0/left, 5/right
351 run [
352 render screen, e
353 3:num/raw <- get *e, cursor-row:offset
354 4:num/raw <- get *e, cursor-column:offset
355 ]
356 screen-should-contain [
357 . .
358 . .
359 . .
360 ]
361 memory-should-contain [
362 3 <- 1
363 4 <- 0
364 ]
365 ]
366
367
368
369 scenario render-colors-comments [
370 local-scope
371 assume-screen 5/width, 5/height
372 s:text <- new [abc
373 # de
374 f]
375 e:&:editor <- new-editor s, 0/left, 5/right
376 run [
377 render screen, e
378 ]
379 screen-should-contain [
380 . .
381 .abc .
382 .# de .
383 .f .
384 . .
385 ]
386 screen-should-contain-in-color 12/lightblue, [
387 . .
388 . .
389 .# de .
390 . .
391 . .
392 ]
393 screen-should-contain-in-color 7/white, [
394 . .
395 .abc .
396 . .
397 .f .
398 . .
399 ]
400 ]
401
402 after <character-c-received> [
403 color <- get-color color, c
404 ]
405
406
407 def get-color color:num, c:char -> color:num [
408 local-scope
409 load-ingredients
410 color-is-white?:bool <- equal color, 7/white
411
412 {
413 break-unless color-is-white?
414 starting-comment?:bool <- equal c, 35/#
415 break-unless starting-comment?
416 trace 90, [app], [switch color back to blue]
417 color <- copy 12/lightblue
418 jump +exit
419 }
420
421 {
422 color-is-blue?:bool <- equal color, 12/lightblue
423 break-unless color-is-blue?
424 ending-comment?:bool <- equal c, 10/newline
425 break-unless ending-comment?
426 trace 90, [app], [switch color back to white]
427 color <- copy 7/white
428 jump +exit
429 }
430
431 {
432 break-unless color-is-white?
433 starting-assignment?:bool <- equal c, 60/<
434 break-unless starting-assignment?
435 color <- copy 1/red
436 jump +exit
437 }
438
439 {
440 color-is-red?:bool <- equal color, 1/red
441 break-unless color-is-red?
442 ending-assignment?:bool <- equal c, 32/space
443 break-unless ending-assignment?
444 color <- copy 7/white
445 jump +exit
446 }
447
448 +exit
449 return color
450 ]
451
452 scenario render-colors-assignment [
453 local-scope
454 assume-screen 8/width, 5/height
455 s:text <- new [abc
456 d <- e
457 f]
458 e:&:editor <- new-editor s, 0/left, 8/right
459 run [
460 render screen, e
461 ]
462 screen-should-contain [
463 . .
464 .abc .
465 .d <- e .
466 .f .
467 . .
468 ]
469 screen-should-contain-in-color 1/red, [
470 . .
471 . .
472 . <- .
473 . .
474 . .
475 ]
476 ]