DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »tmmp3«

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦this⟧ »tmmp3« 

TextFile

(r=algol
r
finis)
begin
integer termno,activeterminals,firstchar;
zone zin,zout(26,1,stderror);

integer procedure createpool(z);
zone z;
begin
  integer i;
  integer array zia(1:20),sia(1:12);
  zone ztem(1,1,stderror);
  open(ztem,0,<:tem:>,0);
  getzone6(z,zia);
  getshare6(ztem,sia,1);
  sia(4):= 90 shift 12;
  for i:= 0,1,2,3 do sia(8+i):= zia(2+i);
  setshare6(ztem,sia,1);
  monitor(16,ztem,1,sia);
  createpool:= if monitor(18,ztem,1,sia)<>1 then -1 else sia(1);
  close(ztem,true)
end createpool;

activeterminals:= 0;
open(zin,8,<:tem:>,0);
open(zout,8,<:tem:>,0);
createpool(zin);

centralwait:
setposition(zin,0,0);
read(zin,termno);
readchar(zin,firstchar);
if firstchar=2 then
begin  <* logout *>
  activeterminals:= activeterminals-1;
  if activeterminals>0 then goto centralwait else goto stopprogram
end else
if firstchar=1 then
begin  <* login *>
  activeterminals:= activeterminals+1
end else repeatchar(zin);
write(zout,<<dd>,termno,<:,:>);

begin context(termno,10,3);
  integer array solution,guess(1:4);
  integer i,j,x,n,m,class,character,digitok,digitincluded;
  real r;
  continue;
  systime(1,0,r);
  x:= r shift(-12)extract 22;

setcombination:
  for i:= 1 step 1 until 4 do
  begin
    random(x);
    solution(i):= x mod 10;
    for j:= 1 step 1 until i do
    if solution(i)=solution(j) and i<>j then i:= i-1
  end;
  write(zout,<:master mind program ready<10>:>);

next:
  setposition(zout,0,0);
  exit(centralwait);
  i:= 0;
  for class:= readchar(zin,character) while class<>8 and i<4 do
  begin    <* analyze all characters up to <nl> *>
    if class=2 <* digit *> then
    begin
      i:= i+1;
      guess(i):= character-48
    end else
    if character<>32 <* space *> then
    begin
      write(zout,<:***syntax error<10>try again<10>:>);
      goto next
    end
  end;
  if i=0 then goto next;
  if i<4 then
  begin
    write(zout,<:***guess not complete<10>try again<10>:>);
    goto next
  end;
  for n:= 2,3,4 do
  for m:= 1 step 1 until n-1 do
  if guess(n)=guess(m) then
  begin
    write(zout,<:***digit duplicated<10>try again<10>:>);
    goto next
  end;
    write(zout,<:                     :>);
  digitok:= digitincluded:= 0;
  for i:= 1,2,3,4 do
  begin
    for j:= 1,2,3,4 do
    if guess(i)=solution(j) then
    begin
      if i=j then digitok:= digitok+1
             else digitincluded:= digitincluded+1
    end;
    write(zout,<<dd>,guess(i))
  end;
  write(zout,<:  =>  :>,
            false add 43,digitok,
            false add 32,4-digitok,
            false add 45,digitincluded,
            false add 10,1);

  if digitok<4 then goto next else
  begin
    write(zout,<:you got it !!<10>:>);
    goto setcombination
  end
end;
stopprogram:
end
▶EOF◀