hilo.p 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169
  1. (* $Source$
  2. * $State$
  3. * $Revision$
  4. *)
  5. (*$U+ --- enables underscores in identifiers *)
  6. program hilo(input, output);
  7. type
  8. string = array [0..255] of char;
  9. var
  10. playing : Boolean;
  11. seed : integer;
  12. { This version of Pascal seems to have no random number generator I can find,
  13. so we have to implement our own here. This is a hacked up and probably
  14. broken version of the C library generator. }
  15. procedure randomise(s : integer);
  16. begin
  17. seed := s;
  18. end;
  19. function random(range : integer) : integer;
  20. begin
  21. seed := (20077 * seed + 12345);
  22. random := seed mod range;
  23. end;
  24. { Pascal doesn't provide string input, so we interface to the read() syscall
  25. and do it manually. But... we can't interface to read() directly because
  26. that conflicts with a Pascal keyword. Luckily there's a private function
  27. uread() in the ACK Pascal library that we can use instead. }
  28. function uread(fd : integer; var buffer : char; count : integer) : integer;
  29. extern;
  30. function readchar : char;
  31. var
  32. c : char;
  33. dummy : integer;
  34. begin
  35. c := chr(0);
  36. dummy := uread(0, c, 1);
  37. readchar := c;
  38. end;
  39. procedure readstring(var buffer : string; var length : integer);
  40. var
  41. finished : Boolean;
  42. c : char;
  43. begin
  44. write('> ');
  45. length := 0;
  46. finished := FALSE;
  47. seed := 0;
  48. while not finished do
  49. begin
  50. c := readchar;
  51. if (ord(c) = 10) then
  52. finished := true
  53. else
  54. begin
  55. buffer[length] := c;
  56. length := length + 1;
  57. end
  58. end;
  59. end;
  60. procedure getname;
  61. var
  62. name : string;
  63. namelen : integer;
  64. i : integer;
  65. seed : integer;
  66. begin
  67. writeln;
  68. writeln('Hi there! I''m written in Pascal. Before we start, what is your name?');
  69. writeln;
  70. readstring(name, namelen);
  71. writeln;
  72. write('Hello, ');
  73. seed := 0;
  74. for i := 0 to (namelen-1) do
  75. begin
  76. write(name[i]);
  77. seed := seed + ord(name[i]);
  78. end;
  79. randomise(seed);
  80. write('! ');
  81. end;
  82. procedure game;
  83. var
  84. Number : integer;
  85. Attempts : integer;
  86. guess : integer;
  87. begin
  88. writeln('See if you can guess my number.');
  89. Number := random(100);
  90. Attempts := 0;
  91. guess := -1;
  92. while guess <> Number do
  93. begin
  94. Attempts := Attempts + 1;
  95. write('> ');
  96. readln(guess);
  97. if guess < Number then
  98. begin
  99. writeln;
  100. writeln('Try a bit higher.');
  101. end;
  102. if guess > Number then
  103. begin
  104. writeln;
  105. writeln('Try a bit lower.');
  106. end;
  107. end;
  108. writeln;
  109. write('You got it right in only ', Attempts:0, ' ');
  110. if Attempts = 1 then
  111. write('go')
  112. else
  113. write('goes');
  114. writeln('!');
  115. end;
  116. function question: Boolean;
  117. var
  118. response: char;
  119. begin
  120. write('> ');
  121. readln(response);
  122. question := not ((response = 'n') or (response = 'N'));
  123. end;
  124. begin
  125. getname;
  126. playing := TRUE;
  127. while playing do
  128. begin
  129. game;
  130. writeln;
  131. writeln('Would you like another go?');
  132. playing := question;
  133. writeln;
  134. if playing then
  135. write('Excellent! ')
  136. else
  137. writeln('Thanks for playing --- goodbye!');
  138. end;
  139. end.