1 # Some primitives for checking the state of fake screen objects.
  2 
  3 # validate data on screen regardless of attributes (color, bold, etc.)
  4 # Mu doesn't have multi-line strings, so we provide functions for rows or portions of rows.
  5 # Tab characters (that translate into multiple screen cells) not supported.
  6 
  7 fn check-screen-row screen: (addr screen), y: int, expected: (addr array byte), msg: (addr array byte) {
  8   check-screen-row-from screen, 0/x, y, expected, msg
  9 }
 10 
 11 fn check-screen-row-from screen-on-stack: (addr screen), x: int, y: int, expected: (addr array byte), msg: (addr array byte) {
 12   var screen/esi: (addr screen) <- copy screen-on-stack
 13   var failure-count/edi: int <- copy 0
 14   var idx/ecx: int <- screen-cell-index screen, x, y
 15   # compare 'expected' with the screen contents starting at 'idx', grapheme by grapheme
 16   var e: (stream byte 0x100)
 17   var e-addr/edx: (addr stream byte) <- address e
 18   write e-addr, expected
 19   {
 20     var done?/eax: boolean <- stream-empty? e-addr
 21     compare done?, 0
 22     break-if-!=
 23     var _g/eax: grapheme <- screen-grapheme-at-idx screen, idx
 24     var g/ebx: grapheme <- copy _g
 25     var expected-grapheme/eax: grapheme <- read-grapheme e-addr
 26     # compare graphemes
 27     $check-screen-row-from:compare-graphemes: {
 28       # if expected-grapheme is space, null grapheme is also ok
 29       {
 30         compare expected-grapheme, 0x20
 31         break-if-!=
 32         compare g, 0
 33         break-if-= $check-screen-row-from:compare-graphemes
 34       }
 35       # if (g == expected-grapheme) print "."
 36       compare g, expected-grapheme
 37       break-if-=
 38       # otherwise print an error
 39       failure-count <- increment
 40       draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg
 41       draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg
 42       draw-grapheme-at-cursor 0/screen, expected-grapheme, 3/cyan, 0/bg
 43       move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width
 44       draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg
 45       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg
 46       draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg
 47       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg
 48       draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") but observed '", 3/fg/cyan, 0/bg
 49       draw-grapheme-at-cursor 0/screen, g, 3/cyan, 0/bg
 50       move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width
 51       draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "'", 3/fg/cyan, 0/bg
 52       move-cursor-to-left-margin-of-next-line 0/screen
 53     }
 54     idx <- increment
 55     increment x
 56     loop
 57   }
 58   # if any assertions failed, count the test as failed
 59   compare failure-count, 0
 60   {
 61     break-if-=
 62     count-test-failure
 63     return
 64   }
 65   # otherwise print a "."
 66   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg
 67 }
 68 
 69 # various variants by screen-cell attribute; spaces in the 'expected' data should not match the attribute
 70 
 71 fn check-screen-row-in-color screen: (addr screen), fg: int, y: int, expected: (addr array byte), msg: (addr array byte) {
 72   check-screen-row-in-color-from screen, fg, y, 0/x, expected, msg
 73 }
 74 
 75 fn check-screen-row-in-color-from screen-on-stack: (addr screen), fg: int, y: int, x: int, expected: (addr array byte), msg: (addr array byte) {
 76   var screen/esi: (addr screen) <- copy screen-on-stack
 77   var idx/ecx: int <- screen-cell-index screen, x, y
 78   # compare 'expected' with the screen contents starting at 'idx', grapheme by grapheme
 79   var e: (stream byte 0x100)
 80   var e-addr/edx: (addr stream byte) <- address e
 81   write e-addr, expected
 82   {
 83     var done?/eax: boolean <- stream-empty? e-addr
 84     compare done?, 0
 85     break-if-!=
 86     var _g/eax: grapheme <- screen-grapheme-at-idx screen, idx
 87     var g/ebx: grapheme <- copy _g
 88     var _expected-grapheme/eax: grapheme <- read-grapheme e-addr
 89     var expected-grapheme/edi: grapheme <- copy _expected-grapheme
 90     $check-screen-row-in-color-from:compare-cells: {
 91       # if expected-grapheme is space, null grapheme is also ok
 92       {
 93         compare expected-grapheme, 0x20
 94         break-if-!=
 95         compare g, 0
 96         break-if-= $check-screen-row-in-color-from:compare-cells
 97       }
 98       # if expected-grapheme is space, a different color is ok
 99       {
100         compare expected-grapheme, 0x20
101         break-if-!=
102         var color/eax: int <- screen-color-at-idx screen, idx
103         compare color, fg
104         break-if-!= $check-screen-row-in-color-from:compare-cells
105       }
106       # compare graphemes
107       $check-screen-row-in-color-from:compare-graphemes: {
108         # if (g == expected-grapheme) print "."
109         compare g, expected-grapheme
110         {
111           break-if-!=
112           draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg
113           break $check-screen-row-in-color-from:compare-graphemes
114         }
115         # otherwise print an error
116         count-test-failure
117         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg
118         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg
119         draw-grapheme-at-cursor 0/screen, expected-grapheme, 3/cyan, 0/bg
120         move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width
121         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg
122         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg
123         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg
124         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg
125         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") but observed '", 3/fg/cyan, 0/bg
126         draw-grapheme-at-cursor 0/screen, g, 3/cyan, 0/bg
127         move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width
128         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "'", 3/fg/cyan, 0/bg
129         move-cursor-to-left-margin-of-next-line 0/screen
130       }
131       $check-screen-row-in-color-from:compare-colors: {
132         var color/eax: int <- screen-color-at-idx screen, idx
133         compare fg, color
134         {
135           break-if-!=
136           draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg
137           break $check-screen-row-in-color-from:compare-colors
138         }
139         # otherwise print an error
140         count-test-failure
141         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg
142         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg
143         draw-grapheme-at-cursor 0/screen, expected-grapheme, 3/cyan, 0/bg
144         move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width
145         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg
146         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg
147         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg
148         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg
149         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") in color ", 3/fg/cyan, 0/bg
150         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, fg, 3/fg/cyan, 0/bg
151         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " but observed color ", 3/fg/cyan, 0/bg
152         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, color, 3/fg/cyan, 0/bg
153         move-cursor-to-left-margin-of-next-line 0/screen
154       }
155     }
156     idx <- increment
157     increment x
158     loop
159   }
160 }
161 
162 fn check-screen-row-in-background-color screen: (addr screen), bg: int, y: int, expected: (addr array byte), msg: (addr array byte) {
163   check-screen-row-in-background-color-from screen, bg, y, 0/x, expected, msg
164 }
165 
166 fn check-screen-row-in-background-color-from screen-on-stack: (addr screen), bg: int, y: int, x: int, expected: (addr array byte), msg: (addr array byte) {
167   var screen/esi: (addr screen) <- copy screen-on-stack
168   var idx/ecx: int <- screen-cell-index screen, x, y
169   # compare 'expected' with the screen contents starting at 'idx', grapheme by grapheme
170   var e: (stream byte 0x100)
171   var e-addr/edx: (addr stream byte) <- address e
172   write e-addr, expected
173   {
174     var done?/eax: boolean <- stream-empty? e-addr
175     compare done?, 0
176     break-if-!=
177     var _g/eax: grapheme <- screen-grapheme-at-idx screen, idx
178     var g/ebx: grapheme <- copy _g
179     var _expected-grapheme/eax: grapheme <- read-grapheme e-addr
180     var expected-grapheme/edi: grapheme <- copy _expected-grapheme
181     $check-screen-row-in-background-color-from:compare-cells: {
182       # if expected-grapheme is space, null grapheme is also ok
183       {
184         compare expected-grapheme, 0x20
185         break-if-!=
186         compare g, 0
187         break-if-= $check-screen-row-in-background-color-from:compare-cells
188       }
189       # if expected-grapheme is space, a different background-color is ok
190       {
191         compare expected-grapheme, 0x20
192         break-if-!=
193         var background-color/eax: int <- screen-background-color-at-idx screen, idx
194         compare background-color, bg
195         break-if-!= $check-screen-row-in-background-color-from:compare-cells
196       }
197       # compare graphemes
198       $check-screen-row-in-background-color-from:compare-graphemes: {
199         # if (g == expected-grapheme) print "."
200         compare g, expected-grapheme
201         {
202           break-if-!=
203           draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg
204           break $check-screen-row-in-background-color-from:compare-graphemes
205         }
206         # otherwise print an error
207         count-test-failure
208         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg
209         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg
210         draw-grapheme-at-cursor 0/screen, expected-grapheme, 3/cyan, 0/bg
211         move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width
212         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg
213         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg
214         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg
215         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg
216         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") but observed '", 3/fg/cyan, 0/bg
217         draw-grapheme-at-cursor 0/screen, g, 3/cyan, 0/bg
218         move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width
219         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "'", 3/fg/cyan, 0/bg
220         move-cursor-to-left-margin-of-next-line 0/screen
221         break $check-screen-row-in-background-color-from:compare-graphemes
222       }
223       $check-screen-row-in-background-color-from:compare-background-colors: {
224         var background-color/eax: int <- screen-background-color-at-idx screen, idx
225         compare bg, background-color
226         {
227           break-if-!=
228           draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg
229           break $check-screen-row-in-background-color-from:compare-background-colors
230         }
231         # otherwise print an error
232         count-test-failure
233         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg
234         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg
235         draw-grapheme-at-cursor 0/screen, expected-grapheme, 3/cyan, 0/bg
236         move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width
237         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg
238         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg
239         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg
240         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg
241         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") in background-color ", 3/fg/cyan, 0/bg
242         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, bg, 3/fg/cyan, 0/bg
243         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " but observed background-color ", 3/fg/cyan, 0/bg
244         draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, background-color, 3/fg/cyan, 0/bg
245         move-cursor-to-left-margin-of-next-line 0/screen
246       }
247     }
248     idx <- increment
249     increment x
250     loop
251   }
252 }
253 
254 # helpers for checking just background color, not screen contents
255 # these can validate bg for spaces
256 
257 fn check-background-color-in-screen-row screen: (addr screen), bg: int, y: int, expected-bitmap: (addr array byte), msg: (addr array byte) {
258   check-background-color-in-screen-row-from screen, bg, y, 0/x, expected-bitmap, msg
259 }
260 
261 fn check-background-color-in-screen-row-from screen-on-stack: (addr screen), bg: int, y: int, x: int, expected-bitmap: (addr array byte), msg: (addr array byte) {
262   var screen/esi: (addr screen) <- copy screen-on-stack
263   var failure-count: int
264   var idx/ecx: int <- screen-cell-index screen, x, y
265   # compare background color where 'expected-bitmap' is a non-space
266   var e: (stream byte 0x100)
267   var e-addr/edx: (addr stream byte) <- address e
268   write e-addr, expected-bitmap
269   {
270     var done?/eax: boolean <- stream-empty? e-addr
271     compare done?, 0
272     break-if-!=
273     var _expected-bit/eax: grapheme <- read-grapheme e-addr
274     var expected-bit/edi: grapheme <- copy _expected-bit
275     $check-background-color-in-screen-row-from:compare-cells: {
276       var background-color/eax: int <- screen-background-use a
variable in place of the specific word <CODE>hello</CODE>.  We also have to
figure out the general relationship that is exemplified by the
transformation from <CODE>hello</CODE> into <CODE>hell</CODE>.  This relationship
is, of course, simply <CODE>butlast</CODE>.  Here is the procedure that
results from this process of generalization:
<PRE>to downup :word
print :word
downup butlast :word
print :word
end
</PRE>

<P>As you already know, this procedure won't quite work.  It lacks a stop
rule.  But once we have come this far, it's a relatively simple matter
to add the stop rule.  All we have to do is ask ourselves, &quot;What's
the smallest case we want the program to handle?&quot;  The answer is that
for a single-letter word the <CODE>downup</CODE> should just print the word
once.  In other words, for a single-letter word, <CODE>downup</CODE> should
carry out its first instruction and then stop.  So the stop rule goes
after that first instruction, and it stops if the input has only one
letter:
<PRE>to downup :word
print :word
if equalp count :word 1 [stop]
downup butlast :word
print :word
end
</PRE>

<P>Voil&agrave;!

<P>The trick is <EM>not</EM> to think about the stop rule at first.  Just
accept, on faith, that the procedure will somehow manage to work for
inputs that are smaller than the one you're interested in.  Most
people find it hard to do that.  Since you haven't written the program
yet, after all, the faith I'm asking you to show is really
unjustified.  Nevertheless you have to pretend that someone has
already written a version of the desired procedure that works for
smaller inputs.

<P>Let's take another example from Chapter 7.
<PRE>? <U>one.per.line &quot;hello</U>
h
e
l
l
o
</PRE>

<P>There are two different ways in which we can find a smaller pattern
within this one.  First we might notice this one:
<P><CENTER><IMG SRC="https://people.eecs.berkeley.edu/~bh/v1ch8/recur2-2.gif" ALT="one.per.line results"></CENTER>
<P>This pattern would lead to the following procedure, for
which I haven't yet invented a stop rule.

<P><PRE>to one.per.line :word
print first :word
one.per.line butfirst :word
end
</PRE>

<P>Alternatively we might notice this pattern:
<P><CENTER><IMG SRC="recur2-3.gif" ALT="alternate one.per.line view"></CENTER>
<P>In that case we'd have a different version of the
procedure.  This one, also, doesn't yet have a stop rule.

<P><PRE>to one.per.line :word
one.per.line butlast :word
print last :word
end
</PRE>

<P>Either of these procedures can be made to work by adding the
appropriate stop rule:
<PRE>if emptyp :word [stop]
</PRE>

<P>This instruction should be the first in either procedure.
Since both versions work, is there any reason to choose one over the
other?  Well, there's no theoretical reason but there is a practical
one.  It turns out that <CODE>first</CODE> and <CODE>butfirst</CODE> work faster
than <CODE>last</CODE> and <CODE>butlast</CODE>.  It also turns out that procedures
that are tail recursive (that is, with the recursion step at the end)
can survive more levels of invocation, without running out of memory,
than those that are recursive in other ways.  For both of
these reasons the first version of <CODE>one.per.line</CODE> is a better
choice than the second.  (Try timing both versions with a very long
list as input.)

<P>&raquo;Rewrite <A HREF="../v1ch5/hof.html#say">the <CODE>say</CODE> procedure</A>
from Chapter 5 recursively.


<P><H2>The Leap of Faith</H2>

<P>If we think of

<P><PRE>to one.per.line :word
print first :word
one.per.line butfirst :word
end
</PRE>

<P>merely as a statement of a true fact
about the &quot;shape&quot; of the result printed by
<CODE>one.per.line</CODE>, it's not very remarkable.  The amazing part is that
this fragment is <EM>runnable!</EM><SUP>*</SUP> It doesn't <EM>look</EM> runnable because it invokes itself as a
helper procedure, and--if you haven't already been through the combining
method--that looks as if it can't work.  &quot;How can you use <CODE>one.per.line</CODE>
when you haven't written it yet?&quot;

<P><SMALL><BLOCKQUOTE><SMALL><SUP>*</SUP>Well, almost.  It needs a base
case.</SMALL></BLOCKQUOTE></SMALL><P>The leap of faith method is the assumption that the procedure we're in the
middle of writing already works.  That is, if we're thinking about writing a
<CODE>one.per.line</CODE> procedure that can compute <CODE>one.per.line &quot;hello</CODE>, we
assume that <CODE>one.per.line &quot;ello</CODE> will work.

<P>Of course it's not <EM>really</EM> a leap of faith, in the sense of something
accepted as miraculous but not understood.  The assumption is justified
by our understanding of the combining method.  For example, we understand
that the five-letter <CODE>one.per.line</CODE> is relying on the four-letter version of
the problem, not really on itself, so there's no circular reasoning involved.
And we know that if we had to, we could write <CODE>one.per.line1</CODE> through <CODE>
one.per.line4