(* tab p; *)
(*$I_*)
program help(input,output);

$include h-decl

var     top_of_tree              : item_ptr;
        textfile                 : text;
                                   
procedure crunch_text(var top_of_tree : item_ptr);

var log_unit    : integer;
    curr_item   : item_ptr;
    curr_level  : integer;
    index       : integer;
    file_name   : f_string;
    file_type   : t_string;
    status      : integer;
    line_image  : line;
    count       : integer;

$include h-extern
$include h-linerut
$include h-itemisc


procedure get_name(var curr_item : item_ptr);

var index : integer;
    ch    : char;

begin
    for index := 1 to item_name_length do
        curr_item^.name(.index.) := ' ';
    index := 1;
    repeat
        ch := nextch(line_image,count);
        ch := chr(ord(ch) mod 200b);
        if ch <> chr(cr) then
        begin
            curr_item^.name(.index.) := ch;
            index := index +1;
        end;
   until (ch = chr(cr)) or(index > item_name_length);
end;

procedure get_number(var out_number : integer);

var ch : char;

begin
    ch := nextch(line_image,count);
$iftrue debug
    writeln(ch);
$endif debug
    out_number := 0;
    while ch in (.'0'..'9'.) do
    begin
        out_number := 10*out_number + ord(ch)-ord('0');
        ch := nextch(line_image,count);
    end;
    back_wind(line_image,count);
$iftrue debug
    writeln('Ord ch is',ord(ch));
$endif debug
end;

procedure  make_new_item(var curr_item : item_ptr;
                    var curr_level: integer;log_unit : integer);

var new_item   : item_ptr;
    new_level  : integer;
    return_ptr : item_ptr;
    index      : integer;
                
begin
    get_number(new_level);
    if (new_level = last_level ) then
        curr_level := bottom_level
    else
    begin
    new(new_item);
    get_name(new_item);
    reabt(log_unit,new_item^.text_address);
$iftrue debug
    writeln('Curr_level :',curr_level,' New_level : ',new_level);
$endif debug
    if (new_level > curr_level+1) then
        halt('ERROR : Leveling error');
    nil_sub_trees(new_item);
    new_item^.level := new_level;
    if new_level = curr_level then
        curr_item := curr_item^.prev_item;
    if new_level < curr_level then
        for index := 1 to (curr_level - new_level+1) do
            curr_item := curr_item^.prev_item;
    find_empty_sub_item(curr_item,return_ptr);
    if return_ptr = nil then
        curr_item^.sub_items := new_item
    else
        return_ptr^.adj_item := new_item;
    new_item^.adj_item := nil;
    new_item^.prev_item := curr_item;
    curr_level :=new_level;
    curr_item := new_item;
    skip_until_number(line_image,count);
    end;
end;

begin
    (* Crunch_text *)
    writeln('Program to CRUNCH a help file');
    write('Starting.....',chr(cr));
    file_name := 'KERMIT''';
    file_type := 'HELP';
    status := 0;
    log_unit := xopen(file_name,file_type,1,status);
    if status <> 0 then
        halt('Error opening Help-file.');
    new(top_of_tree);
    top_of_tree^.level := bottom_level;;
    top_of_tree^.name := '    ';
    nil_sub_trees(top_of_tree);
    reabt(log_unit,top_of_tree^.text_address);
    skip_until_number(line_image,count);
    curr_item := top_of_tree;
    curr_level := bottom_level;
    repeat
        make_new_item(curr_item,curr_level,log_unit);
    until curr_level = bottom_level;
    writeln('End of CRUNCH');
end;

procedure print_tree(top_of_tree : item_ptr);

var index : integer;
    ptr   : item_ptr;

begin
    if top_of_tree <> nil then
    with top_of_tree^ do
    begin
        writeln('Name: ',name,' Byte adr :',text_address);
        ptr := top_of_tree^.sub_items;
        while ptr <> nil do
        begin
            print_tree(ptr);
            ptr := ptr^.adj_item;
        end;
    end;
end;

procedure write_tree(top_of_tree : item_ptr);

type itemfile = file of item_info;

var contfile : itemfile;
    index    : integer;
    status   : integer;


procedure write_sub_tree(top_of_tree : item_ptr;
                     var infile : itemfile);

var xindex : integer;
    ptr    : item_ptr;
begin
    infile^ := top_of_tree^;
    put(infile);
    ptr := top_of_tree^.sub_items;
    while ptr <> nil do
    begin
        write_sub_tree(ptr,infile);
        ptr := ptr^.adj_item;
    end;
end;

begin
    connect(contfile,'KERMIT','HLIB','W',status);
    if status <> 0 then
        halt('ERROR : Can''t open library file.');
    rewrite(contfile);
    write_sub_tree(top_of_tree,contfile)
end;


begin   (* Main program *)
    crunch_text(top_of_tree);
    print_tree(top_of_tree);
    write_tree(top_of_tree);
end.