Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Gioco del 100 - GIOCO100.PAS

GIOCO100.PAS

Caricato da: Poggi Marco
Scarica il programma completo

  1. program GiocoDelCento;
  2. uses crt;
  3. type tstr=string[200];
  4.      numero=object
  5.  n,f,dn:word;
  6.  t:byte;
  7.  constructor inizio(a,b:word);
  8.  procedure gioca;
  9.  function test(x:byte):boolean;
  10.  procedure domanda;
  11.  procedure genera;
  12.  procedure stampa;
  13.  destructor distruggi;
  14. end;
  15.  
  16. var g:numero;
  17.  
  18. procedure pausa(fr:tstr; x,y:word); forward;
  19. procedure linea(t:char; c:word); forward;
  20. procedure frase(fr:tstr; fine,col:word); forward;
  21.  
  22. constructor numero.inizio(a,b:word);
  23. begin
  24.  f:=a;
  25.  dn:=b;
  26.  n:=0;
  27. end;
  28.  
  29. procedure numero.gioca;
  30. var giocate:byte;
  31. begin
  32.  writeln('Gioco del 100');
  33.  giocate:=0;
  34.  while test(giocate) do
  35.  begin
  36.   t:=giocate and 1;
  37.   case t of
  38.    0: begin
  39.        domanda;
  40.       end;
  41.    1: begin
  42.        genera;
  43.        stampa
  44.       end;
  45.    else
  46.    begin
  47.     textcolor(red);
  48.     pausa('Bug! ', 1, wherey+2);
  49.     halt(0);
  50.    end;
  51.   end; { fine case of }
  52.   inc(giocate);
  53.   linea('-', cyan);
  54.  end;
  55. end;
  56.  
  57. procedure numero.genera;
  58. var d,x:word;
  59. begin
  60.  d:=f-n;
  61.  if d<=dn then x:=d
  62.  else x:=1+random(dn);
  63.  inc(n, x);
  64. end;
  65.  
  66. procedure numero.stampa;
  67. begin
  68.  frase('Il computer gioca ', 30, green);
  69.  textcolor(yellow);
  70.  write(n);
  71. end;
  72.  
  73. procedure numero.domanda;
  74. var domn,diff:word;
  75.     ch:boolean;
  76. begin
  77.  repeat
  78.   frase('Numero ', 30, green);
  79.   textcolor(yellow);
  80.   readln(domn);
  81.   GotoXY(60, WhereY-1);
  82.   diff:=domn-n;
  83.   ch:=(diff>0) and (diff<=dn);
  84.   if not ch then
  85.   begin
  86.    textcolor(red);
  87.    writeln;
  88.    writeln('Numero non accettato! ');
  89.    writeln('I limiti ammissibili sono tra ',n+1,' e ',n+dn);
  90.   end;
  91.  until ch;
  92.  n:=domn;
  93. end;
  94.  
  95. function numero.test(x:byte):boolean;
  96. var ch:boolean;
  97. begin
  98.  ch:=n<100;
  99.  if x>50 then
  100.  begin
  101.   pausa('Superato il limite massimo di giocate! ',1, wherey+2);
  102.   ch:=false;
  103.  end;
  104.  test:=ch;
  105. end;
  106.  
  107. destructor numero.distruggi;
  108. begin
  109.  { distruttore }
  110. end;
  111.  
  112. procedure linea(t:char; c:word);
  113. var i:byte;
  114. begin
  115.  writeln;
  116.  textcolor(c);
  117.  for i:=1 to 80 do write(t);
  118. end;
  119.  
  120. procedure pausa(fr:tstr; x,y:word);
  121. begin
  122.  GotoXY(x, y);
  123.  textcolor(7);
  124.  write(fr);
  125.  while not keypressed do; writeln(readkey);
  126. end;
  127.  
  128. procedure frase(fr:tstr; fine,col:word);
  129. var i:word;
  130. begin
  131.  textcolor(col);
  132.  write(fr);
  133.  for i:=length(fr) to fine do write('.');
  134.  write(' ');
  135. end;
  136.  
  137. begin
  138.  clrscr;
  139.  randomize;
  140.  g.inizio(100, 10);
  141.  g.gioca;
  142.  pausa('Fine del programma. ', 1, wherey+2);
  143.  g.distruggi;
  144. end.