DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »tmicform«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »tmicform« 

TextFile

begin
  integer kommentar_fundet,label_fundet,prim_kommentar_fundet;
  integer kommentar_margin,prim_kommentar_margin,højre_margin;

  integer index,tegn,tegn_klasse,read_index,print_index;
  integer printed,sidste_før_kommentar,instr_margin;
  integer prim_kommentar_limit;
  integer array line(1:133);

integer procedure se_fremad(index);
value index; integer index;
begin
integer se_fremad_index;
se_fremad_index := index;
for se_frem_ad_index := se_frem_ad_index + 1 
                    while line(se_fremad_index) <> 32 and
                          line(se_fremad_index) <> 10 do;
se_fremad:= se_fremad_index - index  -1;
end se_fremad;
  procedure print_kommentar_line;
  <******************************>
  begin
    if prim_kommentar_fundet <> 0 
      and printed < prim_kommentar_margin then
    print_blanke(prim_kommentar_margin - printed)
   else
    if kommentar_fundet <> 0 and printed < kommentar_margin then
      print_blanke(kommentar_margin - printed);

    print_index := skip_blanke(print_index);


    print_index := print_index - 1 ;
    for print_index := print_index + 1  
    while line(print_index) <> 10 do
    begin
      tryk_tegn(line(print_index));
      if printed >= højre_margin or
          printed + se_fremad(print_index) > højre_margin then
      begin
        index := skip_blanke(print_index +1);
        if line(index) <> 10 then
          begin
        outchar(out,10);
        if prim_kommentar_fundet <> 0 then
            print_blanke(prim_kommentar_margin)
           else print_blanke(kommentar_margin);
        outchar(out,59);
        printed := if prim_kommentar_fundet <> 0  then
                      prim_kommentar_margin +1
                      else kommentar_margin +1;
      end;
    end ;
    end;
    outchar(out,10);
  end print_kommentar_line;



  integer procedure reset_line;
  begin
    kommentar_fundet := 0;
    label_fundet := 0;
    prim_kommentar_fundet := 0;
    sidste_før_kommentar := 0;
    for index :=1 step 1 until 133 do line(index):=0;
    read_index := 0;
    print_index :=0;
    printed := 0;
  end reset_line;



  procedure pak_tegn;
  begin
    read_index := read_index + 1;

    if kommentar_fundet = 0 then
    begin
      if tegn = 59 then
      begin
        kommentar_fundet := read_index;
        if read_index < prim_kommentar_limit then
        prim_kommentar_fundet := read_index;
      end
      else
      begin
        if tegn <> 32 and tegn <> 10 then
             sidste_før_kommentar := read_index;
        if tegn = 58 then label_fundet := read_index;
      end;
    end
  else
  if tegn = 59 then tegn := 46;

    line(read_index) := tegn;
  end pak_tegn;



  procedure tryk_tegn(tegn);
  value tegn; integer tegn;
  begin
    outchar(out,tegn);
    if tegn = 10 then printed := 0 else printed := printed + 1;
  end tryk_tegn;


  procedure print_blanke(index);
  value index; integer index;
  begin
integer index1;
for index1:= 1 step 1 until index do
    tryk_tegn(32);
  end print_blanke;






  integer procedure skip_blanke(index);
  value index; integer index;
  begin
    for index := index while line(index) = 32 do index := index + 1;
    skip_blanke := index;
  end skip_blank;


  procedure tryk;
  begin
    print_index := skip_blanke(1);
      if label_fundet <> 0 then
      begin
        print_index := print_index -1;
        for print_index := print_index  + 1 
        while line(print_index) <> 58 do
        begin
          tryk_tegn(line(print_index));

        end;
        tryk_tegn(line(print_index));
        print_index:=print_index + 1;
      end;
      print_index := skip_blanke(print_index);
      if sidste_før_kommentar <> 0 then
      print_blanke(instr_margin-printed);
      print_index := print_index - 1;
      for print_index := print_index + 1 while
      print_index <= sidste_før_kommentar do tryk_tegn(line(print_index));
      print_kommentar_line;
  end tryk;

  procedure tryk_linie;
  begin
    tryk;
    reset_line;
  end;
algol copy.tcgproclib;


long array doc_name(1:2);
boolean connected;
integer result,create_mask;
create_mask := 1 shift 1 <* create area of length 1 *> 
               + 1 <* pref. on disc *>;

if get_left_side(doc_name) = 0 then
  begin
  result := stack_and_connect_out(doc_name,create_mask);
  if result = 0 then
    connected := true
  else
    begin
    write(out,"nl",1,"*",4,<: connect out error :>);
    fp_proc(7,0,0,result);
    end
  end else connected := false ;
if get_int_string(<:comment:>,kommentar_margin) <> 0 then
  kommentar_margin := 30;
if get_int_string(<:margin:>,instr_margin) <> 0 then
instr_margin := 8;
if get_int_string(<:right:>,højre_margin) <> 0 then
  højre_margin := 132;
if get_int_string(<:section:>,prim_kommentar_margin) <> 0 then
  prim_kommentar_margin := 8;
if get_int_string(<:seclimit:>,prim_kommentar_limit) <> 0 then
  prim_kommentar_limit := 17;
  reset_line;




  for tegn_klasse := readchar(in,tegn) while tegn <> 25 do
  begin

    if read_index = 132 then
       begin
       tegn := 10;


       repeatchar(in);
       end;
    pak_tegn;
    if tegn = 10 then tryk_linie;
  end;
  outchar(out,tegn);
fp_proc(34) close up:(0,out,25);
fp_proc(79) terminate zone :(0,out,0);
doc_name(1) := 0;
if connected then stack_and_connect_out(doc_name,create_mask);
 <* fp_proc(7) terminate program:(0,0,0);   *>
end;

▶EOF◀