DataMuseum.dk

top - metrics - download

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

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦this⟧ »kketikt« 

TextFile

etik=set 20
etik=algol list.no connect.no

begin
  integer i,j,k,etik,char,x,tegn,jj,kk;
  integer array ia1,ia2(1:40,1:6);
  boolean I,M,gruppe,nl;
  zone ind,pr(128,1,stderror);
  long array IN,PR(1:3);
  array field raf;

  raf:=0;
  nl:=false add 10;
  gruppe:=false;
M:=true; I:=false;
  kk:=jj:=0;
  etik:=1;
  readlsfp(PR.raf);
  readsfp(<:i:>,IN.raf,<:datamedlreg:>);
  open(pr,4,<:kklp2:>,0);
  open(ind,4,<:datamedlreg:>,0);
comment
  readifp(<:antal:>,x,1)-sem-
  readbfp(<:medlem:>,M,true)-sem-
  readbfp(<:ikkemedlem:>,I,true)-sem-
  write(out,<:gruppe bogstav/er=:>)-sem-
;
  setposition(out,0,0);
  for i:=1 step 1 until 6 do
  for j:=1 step 1 until 40 do
  ia1(j,i):=ia2(j,i):=32;
om2:
  if false then readchar(in,tegn) else tegn:=10;
  setposition(ind,0,0);
  gruppe:=gruppe or tegn<>10;
  if -,gruppe or (gruppe and tegn<>10) then
  begin
om1:
    for k:=readchar(ind,char) while char<>44 do;
om: 
    for k:=readchar(ind,char) while char<>10 do;
    readchar(ind,char);
    if char=25 or char=59 then 
    goto if gruppe then om2 else stop;
    if gruppe and char<>tegn then goto om1;
    if char>96 and char<126 then
    begin
      if etik=1 then ia1(1,1):=char else
      ia2(1,1):=char;
      readchar(ind,char);
      i:=1;
    end else i:=0;
    if (M and char=42) or (I and char<>42) then else goto om1;
    repeatchar(ind);
    j:=1;
    for k:=readchar(ind,char) while char<>44 do
    begin
      if char=10 then
      begin
        j:=j+1;
        i:=0;
      end else
      begin
        i:=i+1;
        if etik=1 then
        begin
          ia1(i,j):=char;
          if kk<i then kk:=i;
        end else
        begin
          ia2(i,j):=char;
          if jj<i then jj:=i;
        end;
      end;
    end;
    if etik=2 then
    begin
      for k:=1 step 1 until x do
      for j:=1 step 1 until 6 do
      begin
        for i:=1 step 1 until 40 do
        write(pr,false add ia1(i,j),1);
        for i:=1 step 1 until jj do
        write(pr,false add ia2(i,j),1);
        write(pr,nl,1);
      end;
      for j:=1 step 1 until 6 do
      begin
        for i:=1 step 1 until kk do
        ia1(i,j):=32;
        for i:=1 step 1 until jj do
        ia2(i,j):=32;
      end;
      etik:=1;
    end else etik:=2;
    goto om;
stop:
  end;
  if etik=2 then
  begin
    for k:=1 step 1 until x do
    for j:=1 step 1 until 6 do
    begin
      for i:=1 step 1 until 40 do
      write(pr,false add ia1(i,j),1);
      if k<>x then
      begin
        if j=6 then k:=k+1;
        for i:=1 step 1 until kk do
        write(pr,false add ia1(i,j),1);
      end;
      write(pr,nl,1);
    end;
  end;
  write(pr,false add 25,3);
  close(ind,true); close(pr,true);
end;
▶EOF◀