DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦5f5639e4b⟧ TextFile

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »etiktxt«, »kketiktxt«

Derivation

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦this⟧ »etiktxt« 
        └─⟦this⟧ »kketiktxt« 
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »etiktxt« 

TextFile


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);
  nl:=false add 10;
  gruppe:=false;
  kk:=jj:=0;
  etik:=1;
  open(pr,4,<:etikprint:>,0);
  open(ind,4,<:etik:>,0);
  x:=readi(<:antal af hver etiket:>);
  M:=readb(<:medlemmer ud:>);
  I:=readb(<:ikke-medlemmer ud:>);
  write(out,<:gruppe bogstav/er=:>);
  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:
  readchar(in,tegn);
  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◀