Re: wp34s Version 1.18 Rev 875 Backup and Restore Message #9 Posted by Gerson W. Barbosa on 15 May 2011, 8:25 p.m., in response to message #8 by Jeff O.
Thanks for posting it!
I liked to play this game on my TI-59, in '82 (there was a listing in the manual). Unfortunately it was stolen two months after I had purchased it. The first thing I did when I replaced it with an HP-15C was writing an RPN version, or to what I thought an RPN version was:
http://www.hpmuseum.org/cgi-sys/cgiwrap/hpmuseum/archv014.cgi?read=68346
As I was not acquainted to the HP-15C, it was a slow and long program but it ran fast on the HP-32SII. Even faster on the PC :-)
----------------------------------------------
Program Guessing_Game;
var c,e,i,j,nt,tmp: byte;
ad,adv: integer;
op: char;
a,n: array [1..4] of byte;
begin
repeat
nt:=0;
ClrScr;
Write(' ':9,'G U E S S I N G G A M E');
GoToXY(14,5); Write('Guess C I');
repeat
for i:=1 to 4 do
n[i]:=Random(9)+1
until (n[1]<>n[2]) and (n[1]<>n[3]) and (n[1]<>n[4]) and
(n[2]<>n[3]) and (n[2]<>n[4]) and (n[3]<>n[4]);
repeat
c:=0; e:=0; nt:=nt+1;
GoToXY(10,3); Write('Enter your guess: ');
repeat
repeat
GoToXY(30,3); Read (adv);
GoToXY(30,3); ClrEol
until (adv>1233) and (adv<9877) and (IOresult=0);
ad:=adv;
for i:=4 downto 1 do begin
a[i]:=adv mod 10;
adv:=adv div 10
end
until (a[1]<>a[2]) and (a[1]<>a[3]) and (a[1]<>a[4]) and (a[2]<>a[3]) and
(a[2]<>a[4]) and (a[3]<>a[4]) and (a[1]*a[2]*a[3]*a[4]<>0);
for i:=1 to 4 do
if a[i]=n[i] then c:=c+1;
for i:=1 to 3 do begin
tmp:=a[1];
for j:=1 to 3 do
a[j]:=a[j+1];
a[4]:=tmp;
for j:=1 to 4 do
if a[j]=n[j] then e:=e+1
end;
GoToXY(10,nt+6); WriteLn(nt:2,': ',ad:4,' ',c:1,' ',e:1)
until (c=4) or (nt=10);
GoToXY(15,20);
if c=4 then
case nt of
1: Write('That',#39,'s witchcraft!');
2,3: Write('Excellent!');
4: Write('Good!');
5,6: Write('Fair.');
7,8: Write('Poor.');
9: Write('Bad.');
10: Write('Better luck next time!')
end
else
Write('Secret number: ',n[1]:1,n[2]:1,n[3]:1,n[4]:1);
GoToXY(10,3); ClrEol;
GoToXY(15,22); Write('New game? <Y,N> ');
repeat
Read(kbd,op); op:=UpCase(op)
until (op='Y') or (op='N')
until op='N'
end.
----------------------------------------------
G U E S S I N G G A M E
Guess C I
1: 1234 1 0
2: 5678 0 2
3: 9287 0 3
4: 2986 0 2
5: 7893 3 0
6: 7894 4 0
Fair.
New game? <Y,N>
----------------------------------------------
|