hilo.p 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167
  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. }
  26. function _read(fd : integer; var buffer : char; count : integer) : integer;
  27. extern;
  28. function readchar : char;
  29. var
  30. c : char;
  31. dummy : integer;
  32. begin
  33. c := chr(0);
  34. dummy := _read(0, c, 1);
  35. readchar := c;
  36. end;
  37. procedure readstring(var buffer : string; var length : integer);
  38. var
  39. finished : Boolean;
  40. c : char;
  41. begin
  42. write('> ');
  43. length := 0;
  44. finished := FALSE;
  45. seed := 0;
  46. while not finished do
  47. begin
  48. c := readchar;
  49. if (ord(c) = 10) then
  50. finished := true
  51. else
  52. begin
  53. buffer[length] := c;
  54. length := length + 1;
  55. end
  56. end;
  57. end;
  58. procedure getname;
  59. var
  60. name : string;
  61. namelen : integer;
  62. i : integer;
  63. seed : integer;
  64. begin
  65. writeln;
  66. writeln('Hi there! Before we start, what is your name?');
  67. writeln;
  68. readstring(name, namelen);
  69. writeln;
  70. write('Hello, ');
  71. seed := 0;
  72. for i := 0 to (namelen-1) do
  73. begin
  74. write(name[i]);
  75. seed := seed + ord(name[i]);
  76. end;
  77. randomise(seed);
  78. write('! ');
  79. end;
  80. procedure game;
  81. var
  82. Number : integer;
  83. Attempts : integer;
  84. guess : integer;
  85. begin
  86. writeln('See if you can guess my number.');
  87. Number := random(100);
  88. Attempts := 0;
  89. guess := -1;
  90. while guess <> Number do
  91. begin
  92. Attempts := Attempts + 1;
  93. write('> ');
  94. readln(guess);
  95. if guess < Number then
  96. begin
  97. writeln;
  98. writeln('Try a bit higher.');
  99. end;
  100. if guess > Number then
  101. begin
  102. writeln;
  103. writeln('Try a bit lower.');
  104. end;
  105. end;
  106. writeln;
  107. write('You got it right in only ', Attempts:0, ' ');
  108. if Attempts = 1 then
  109. write('go')
  110. else
  111. write('goes');
  112. writeln('!');
  113. end;
  114. function question: Boolean;
  115. var
  116. response: char;
  117. begin
  118. write('> ');
  119. readln(response);
  120. question := not ((response = 'n') or (response = 'N'));
  121. end;
  122. begin
  123. getname;
  124. playing := TRUE;
  125. while playing do
  126. begin
  127. game;
  128. writeln;
  129. writeln('Would you like another go?');
  130. playing := question;
  131. writeln;
  132. if playing then
  133. write('Excellent! ')
  134. else
  135. writeln('Thanks for playing --- goodbye!');
  136. end;
  137. end.