home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / misc / mouse.lbr / COCONUT.MZE / COCONUT.MSE
Encoding:
Text File  |  1988-07-12  |  9.8 KB  |  291 lines
  1.  
  2.  
  3. "!COCONUT.MSE, 5/25/86, Lee R. Bradley"
  4.  
  5. 3 B :             ~ To speed Pause up under Pascal interpreter 
  6. 1 I : 0 A : 0 R : ~ Initialize loop, abort and display counter variables.
  7. 0 Y :             ~ Assume program trace not desired.
  8.  
  9. "!!What's your name, my friend? " #N,1;     ~ Get the user's name
  10. "!!Welcome, " #N,2; '!!'                    ~ Greet him/her.
  11.  
  12. "!!Want to trace this program's code itself? " #A,1; [
  13.  
  14. ~ Teach the user how to use the Mouse trace, if they want a trace.
  15.  
  16. "!!Hit <SPACE BAR> or <RETURN> repeatedly.  Press any other key to stop 
  17. the trace.  When the marker is under a ?' instruction (read character)
  18. hit the <SPACE BAR> one more time (so it recognizes the ') and enter a 
  19. character.  When the marker is under a ? instruction (read number)
  20. enter a number.  A bit confusing, I know.  And when you see the code, 
  21. it gets worse... Everything is stack-oriented.
  22.  
  23. Ok.  Enough instructions.  It's all yours, "#N,2; ".!!" 
  24.  
  25. { 1 Y : ]  ~ Turn on trace and remember trace is desired (see Pause macro).
  26.  
  27. ~ Machine configuration code follows
  28.  
  29. ~ Question #1
  30.  
  31. K. 'k = [ ~ In the (unlikely) event a KayPro user is re-running this
  32. "!!Want a scrolling display this time?  " #A,1; [ 'm K : ]]
  33.  
  34. ~ Question #2
  35.  
  36. K. 'l = [ ~ In the (very unlikely) event a KayPro user is re-re-running this
  37. "!!Want a true clear screen this time? "  #A,1; [ 'k K : ]]
  38.  
  39. K. 'm = [ 'l K : ] ~ Fix up K's value.  Needed to do this to prevent Question 
  40.                    ~ #2 above from being re-asked.  Kludgy, I know.
  41. ~ Question #0
  42.  
  43. 'l K. > 'l K. < +
  44. 'k K. > 'k K. < + *  [ ~ If first run
  45. "!!Running a KayPro, by any chance? " #A,4; [ 'k K : ]]
  46.  
  47. "!!Want some background? " #A,2; [ ~ Ask Y/N.  Pause and clear if Y.
  48.  
  49. "!Hold on a bit, while I find my notes ..." #P,1000; 
  50. "!Thanks for waiting" '!!' " " #P,1000; #Z;                        
  51.  
  52. "!                   Coconuts and Missionaries
  53.  
  54. Five missionaries came upon a pile of coconuts one evening on 
  55. their way home from work.  !!In fact, missionary #4's name was "
  56. #N,2;" too.  !What a coincidence" '!!' " " 
  57.  
  58. #P,1000;"  Anyway, on with the story... " #P,1000;
  59.  
  60. "!!They  decided to split up the pile the next morning and turned in 
  61. for the night. " #P,1000; " 
  62.  
  63. At 1 in the morning, one of the missionaries got up, went out and 
  64. took  a look at the pile of coconuts.  He split it into  5  equal 
  65. piles,  chucked the single extra coconut which was left over to a 
  66. monkey  he saw in a tree close by and put his fifth in the  trunk 
  67. of his car.  He figured the others would never miss what he took. 
  68. One  by one,  the other four missionaries got up,  split the pile 
  69. left  by his predecessor into 5 equal piles,  took his fifth  and 
  70. chucked the single coconut left over to the monkey.!!"
  71.  
  72. ~ Give the fellow a reasonable amount of time to read the
  73. ~ story, then query if [s]he needs more time.  Give different
  74. ~ feedback on 1st and 2nd query.  Backspace over prompts, with
  75. ~ sufficient pauses in between. 
  76.  
  77. 1 V : 0  T : 2000 U :
  78. (
  79. T. U. + T :   ~ Give 'em more time each time
  80. #P,T.; 
  81. V. 1 = [ "Need more time to read this? " ]
  82. V. 2 = [ "Still need more time?        " ]
  83. #A,3; ^
  84. V. 2 =        [ " No problem.    " ]
  85. V. 1 = [ 2 V :  " Take your time." ]
  86. #P,600; 53 W : ( W. ^ " " 8 8 !'!' W. 1 - W : )
  87. )
  88.  
  89. #Z;
  90. "In the morning, the remaining pile was split up into exactly five 
  91. equal piles.  The  monkey didn't  get anything  (he was  stuffed,
  92. anyway). " #P,1000; "
  93.  
  94. How many coconuts were there in the beginning for all this to  be 
  95. possible?
  96.  
  97. Hint:  We know it has to be a number ending in either a 1 or a 6, 
  98. because  only such numbers have the property that if you subtract 
  99. 1 from them, they  can be  divided exactly by 5, a requirement of
  100. our story. " #P,2000;" 
  101.  
  102. Let's face it,  unless you're a genius,  no way are you going  to 
  103. guess this thing without a computer. So, when asked, enter a 1 or 
  104. some  number that ends in 1 (like 1001).  The code which  follows 
  105. will try your number,  then add 5 to it,  try again, and continue 
  106. to add 5 until it comes up with the answer. On my 5 MHz KayPro it 
  107. takes 41 seconds, if it starts with 1, and there's no trace. 
  108. (It used  to  take 22 seconds, but  I've added  so many bells and
  109. whistles to this thing, it  now takes a little longer ... ) "
  110. #P,3000;
  111. ]
  112.  
  113. 0 D :     ~ Assume progress trace not desired. 
  114. 1000 Q :  ~ Just to pause a bit before calculation starts.
  115.  
  116.  
  117. "!!Want me to trace my progress? " #A,1; [ ~ Ask Y/N
  118. 1 D : 
  119. "!!Enter  a number between 1 and 1000 to control my trace display 
  120. speed, and then press <RETURN>.  A 1 will give you a very fast 
  121. trace, a 1000 a very slow trace.  Try 50 for starters. " ? P :
  122. ]
  123.  
  124. "!!Enter  your  first  guess and then press  <RETURN>.  Your  guess 
  125. should end in a 1 (or 6) or we might be here for a while.
  126. Press good ol' CTRL-C during the calculation to abort it. 
  127. Your guess please? "? C : "!!Thanks" '!!' 
  128.  
  129. "!!Hmmm....  Let's see, 5 missionaries, monkey gets 1 
  130. after removing 1 and dividing by five... Hmmmm...!!"
  131.  
  132. #P,Q.;    ~ Pause a bit, so user can see you're thinkin' about it.
  133.  
  134. ~ Main (outer) loop 
  135.  
  136. (
  137.  
  138. I. ^       ~ While there's still interest...
  139. #C,C;      ~ Compute coconut count.
  140. A. 0 = [   ~ In the likely event we have not aborted, ask if still interested.
  141. "!Want to know the next answer? " #A,3; [ ~ Ask Y/N
  142. "!" 1 I :  ~ Reset interest variable back to "interested". 
  143. "!This may take a while.
  144. !Why don't you grab a" C. 4000 > [ "nother" ] " burger while I work
  145. on this? !!"
  146. 0 R :
  147. #P,Q.;     ~ and pause again so user can see message.
  148. ]]
  149.  
  150. )
  151.  
  152. ~ Sign off
  153.  
  154. "!!If you enjoyed this, " #N,2; ", and want to learn more about 
  155. programming in Mouse (which is what this is written in), send a note 
  156. to me.  Who knows, Mouse may become famous yet" '!'!'! !'!'!'
  157.  
  158. "!!Lee R. Bradley
  159. Mouse House Software
  160. 24 East Cedar Street
  161. Newington, CT  06111
  162. "
  163.  
  164. ~ Macros follow
  165.  
  166. $A  ~ Ask Y/N, return 1 if "Y" or "y" entered, 0 otherwise
  167.     ~ Complete answer based on value passed.
  168.  
  169. ?' w : w. 'y - w. 'Y - * 0 = v : 8 !' v. [
  170. 1% 1 = [ "Yup." ]  1% 2 = [ "You bet." ] 1% 3 = [ "Uh huh." ] 
  171. 1% 4 = [ "Sure am.  Dynamite machine" '!!' ] 1 @ ]
  172.  
  173. w. 13 = [ 10 !' ]  ~ If just carriage return entered, emit line feed.
  174.  
  175. 1% 1 = [ "Nope." ] 1% 2 = [ "Nah." ]  1% 3 = [ "Uh uh." ]
  176. 1% 4 = [ "KayPro ?  Never heard of it." ] 0 @
  177.  
  178. $C  ~ Do the calculation
  179.  
  180. D. 0 = [ "!Calculating " ]  ~ Say sumthin', just to tell 'em yur there
  181.  
  182. ~ Main (inner) loop.
  183.  
  184. (
  185.  
  186. I. A. 0 = * ^   ~ While answer not found and problem not aborted ...
  187. 1%. 5 + 1% :    ~ Bump guess
  188. 1%. 32765 >     ~ Check to make sure guess still in single precision range
  189.  
  190. [ "!!Sorry, but I can only do single precision integer arithmetic
  191. and I'm about to blow my accumulator... Try using a Cray 1. "
  192. 1 0 I : A :     ~ Abort if not.
  193. ]
  194.  
  195. A. 0 = [        ~ Only do this if not aborted
  196. 1%. w :         ~ Load work variable with guess
  197.  
  198. ~ If tracing, show count and success depth.  Print new line for each count.
  199. ~ If we get to missionary #4, feed user his name
  200. ~ If we get to missionary #5, but fail, ring bell, etc.
  201. ~ Pause macro will take care of screen clearing based on lines printed.
  202.  
  203. D. [ R. 1 + R : #P,P.; "!" w. ! ]     ~ If tracing, pause and, when 
  204.                                       ~ appropriate, clear screen.
  205.  
  206. #F,w; [ D. [ 'I 64 - !' w. ! ]        ~ Test each missionary and
  207. #F,w; [ D. [ 'I 64 - !' w. ! ]        ~ and show progress
  208. #F,w; [ D. [ 'I 64 - !' w. ! ]        ~ if user asked for a trace.
  209.  
  210. D. 0 = [ "." ] ~ If not tracing, continue to emit dots to show that 
  211.                ~ you're working on it.
  212.  
  213. #F,w; [ D. [ 'I 64 - !'  #N,2; ", you left " w. ! '!!' ] 
  214. #F,w; [ D. [ 'I 64 - !' w. ! ]          
  215.  
  216. w. 5 \ [
  217. D. [ 7 !' #P,Q.; 7 !' #P,Q.; " Close" '!!' #P,Q.; ]] 
  218. w. 5 \  0 = [
  219. 0 I : ]           ~ If final count is exactly divisible by 5, 
  220.                   ~ set I to 0 to stop the loop. 
  221. ]]]]]
  222. ]
  223.  
  224. )
  225.  
  226. A. 0 = [  ~ Announce result, provided you got here without aborting.
  227. "!!The original pile had " 1%. ! " juicy coconuts in it."
  228. ]
  229. @
  230.  
  231. $F  ~ If passed variable's value less 1 is divisible by 5, update 
  232.     ~ the variable to hold 4/5 of 1 less than its current value and 
  233.     ~ return a 1, else return a 0.  This is the real workhorse of this
  234.     ~ program.
  235.  
  236. 1%. 1 - w : w. 5 \ [ 0 @ ] 
  237. w. 5 / 4 * 1% : 1 @ 
  238.  
  239. $N  ~ Read (if a 1 passed) / display (if a 2 passed) user's name
  240.  
  241. 0 w :            ~ Initialize subscript into name array
  242. 26 3 * a :        ~ Hard code origin of array.  This is plenty deep.
  243.  
  244. 1% 1 = [ ?' z :         ~ If reading name
  245.  
  246. ( z. a. w . + :         ~ Store letter in array
  247. w. 1 + w :        ~ Bump index
  248. ?' z :            ~ Get another letter
  249. z. 13 < z. 13 > + ^ )    ~ Loop, if not carriage return
  250.  
  251. 0 a. w. + :          ~ Mark end with a null
  252. @ ]
  253.  
  254. 1% 2 = [        ~ If displaying name
  255.  
  256. ( a. w. + .  v : v. ^   ~ While null not detected
  257. v. !' w. 1 + w : )      ~ Print letter, bump index
  258.  
  259. @ ] 
  260.  
  261. $P ~ Pause a bit.  Value passed controls how long the pause lasts.
  262.    ~ Do clear screen when appropriate
  263.  
  264. R. 22 = [                   ~ If line count is just right
  265. x. 'c < x. 'c > + [         ~ If they haven't asked for a continuous display
  266.  
  267. "!!Press <RETURN> to continue, <SPACE BAR> for continuous display. "
  268.  
  269. ?' w : w. 32 = [ 'c x : ]   ~ Check for <SPACE BAR> and record if detected
  270. ] #Z; 1 R : ]               ~ Clear the screen, reset line count
  271.  
  272. }  ~ Make sure trace is off.  Would take too long to trace this.
  273.  
  274. 1% B. / w : ( w. ^ w. 1 - w : )    ~ Pause, in any case.
  275.  
  276. Y. [ 0 Y : "!Restart or continue tracing? " #A,1; [
  277. 1 Y : { ]] ~ Turn trace back on, if it was on, and still desired.
  278. @
  279.  
  280. $Z ~ Clear screen.  Treat KayPro users that want it differently.
  281.  
  282. 'k K. = [ 'Z 64 - !' @ ]  ~ KayPro clear screen
  283.  
  284. 24 w : ~ Scrolling clear screen via 24 line feeds
  285.  
  286. ( w. ^ 'J 64 - !' w. 1 - w : ) @
  287.  
  288. ~ Ok, I'm done.
  289. yPro clear screen
  290.  
  291. 24 w : ~ Scro