(* tab p; *)
(*$I_*)
procedure   DoHelp;

$include h-decl

var     top_of_tree              : item_ptr;
        textfile                 : text;
        contfile                 : itemfile;
        lv : integer;
        log_unit                 : integer;
        file_name                : f_string;
        file_type                : t_string;
        status                   : integer;

$include h-extern
$include h-linerut                 
$include h-item

procedure crunch_text(var top_of_tree : item_ptr;var contfile : itemfile);

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


procedure change_parity(new_item : item_ptr);

var index : integer;

begin
    with new_item^ do
        for index := 1 to item_name_length do
            name(.index.) := chr(ord(name(.index.)) mod 200b);
end;


procedure  make_new_item(var curr_item : item_ptr;
                    var curr_level: integer; var contfile : itemfile);

var new_item : item_ptr;
    new_level: integer;
    return_ptr : item_ptr;
    index      : integer;

begin
    new_level := contfile^.level;
    if (new_level = bottom_level) then
        curr_level := bottom_level
    else
    begin
        new(new_item);
        new_item^ := contfile^;
        nil_sub_trees(new_item);
$IFTRUE DEBUG
        WRITELN('CURR_LEVEL :',CURR_LEVEL,' NEW_LEVEL : ',NEW_LEVEL);
        WRITELN(NEW_ITEM^.NAME);
$ENDIF DEBUG
        if (new_level > curr_level+1) then
            halt('ERROR : Leveling error');
        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;
        change_parity(new_item);
        curr_level :=new_level;
        curr_item := new_item;
    end;
end;

begin
    (* Crunch_text *)
    connect(contfile,'(SYSTEM)KERMIT','HLIB','R',status);
    if status <> 0 then
    begin
        connect(contfile,'(HELP)KERMIT','HLIB','R',status);
        if status <> 0 then
        begin
            connect(contfile,'KERMIT','HLIB','R',status);
            if status <> 0 then
                writeln('ERROR : Can''t open library file.');
        end;
    end;
    reset(contfile);
    new(top_of_tree);
    top_of_tree^ := contfile^;
    top_of_tree^.prev_item := nil;
    top_of_tree^.adj_item := nil;
    nil_sub_trees(top_of_tree);
    curr_level := top_of_tree^.level;
    if curr_level <> bottom_level then
        halt('ERROR : First level must be minus one');
    curr_item := top_of_tree;
    repeat
        get(contfile);
        if not(eof(contfile)) then
        make_new_item(curr_item,curr_level,contfile);
$IFTRUE DEBUG
    WRITELN('NAME OF ITEM ',CURR_ITEM^.NAME);
$ENDIF DEBUG
    until (curr_level = bottom_level) or eof(contfile);
    disconnect(contfile);
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
        lv := lv+2;
        for index := 1 to lv do write(' ');
        writeln('Name: ',name,' Byte adr :',text_address,' Level',level);
        ptr := top_of_tree^.sub_items;
        while ptr <> nil do
        begin
            print_tree(ptr);
            ptr := ptr^.adj_item;
        end;
        lv := lv - 2;
    end;
end;

procedure walk_tree(top_of_tree : item_ptr);

const top = 1;

var test_name  : name_item;
    print_anew : boolean;
    exit       : boolean;
    index      : integer;
    found      : boolean;
    line_image : line;
    count      : integer;
    ptr        : item_ptr;
    item_c     : integer;
    save_ptr   : item_ptr;
    ambig_ref  : boolean;
    back_ptr   : item_ptr;

function upper(ch : char) : char;

begin
    if ch in (.'a'..'}'.) then
        upper := chr(ord(ch) - 40b)
    else
        upper := ch;
end;

procedure out_name(name : name_item);

var index : integer;

begin
    index := 1;
    while (index <= item_name_length) and (name(.index.) <> ' ') do
    begin
        outbt(1,upper(name(.index.)));
        index := index + 1;
    end
end;


procedure out_text(top_of_tree : item_ptr;
                   log_unit    : integer);

var ch : char;
    lc : integer;

begin
    writeln;
    setbt(log_unit,top_of_tree^.text_address);
    out_name(top_of_tree^.name);
    writeln;
    lc := 0;
    repeat
        get_line(line_image,count);
        if not(line_image(.1.) in (.'0'..'9'.)) then
            print_line(line_image);
        lc := lc +1;
        if lc = 21 then
        begin
            write('Type <CR> to continue >');
            ch := inbt(1);
            write(chr(13),' ':25,chr(13));
            lc := 0;
        end;
    until line_image(.1.) in (.'0'..'9'.);
end;


procedure get_name(var in_name : name_item);

var index : integer;
    ch    : char;

procedure space_fill(var in_name : name_item);

var index : integer;

begin
    for index := 1 to item_name_length do
        in_name(.index.) := ' ';
end;

begin (* get_name *)
    index := 1;
    space_fill(in_name);
    repeat
        ch := inbt(1);
        if printable(ch) then
            begin
                in_name(.index.) := ch;
                index := index +1;
            end 
        else
            if (ch = chr(del)) and (index > 1) then
            begin
                outbt(1,chr(bs));outbt(1,' ');outbt(1,chr(bs));
                index := index - 1
            end;
        if (index = 1) and (ch = chr(cr)) then
            in_name(.top.) := chr(cr);
    until (ch = chr(cr)) or (index > item_name_length);
end;

function match(a_string,b_string : name_item) : boolean;

var index : integer;

function upper(ch : char) : char;

begin
    if ch in (.'a'..'}'.) then
        upper := chr(ord(ch) - 40b)
    else
        upper := ch;
end;

begin
    index := 1;
    while (index <= item_name_length) and 
          (upper(a_string(.index.)) = upper(b_string(.index.))) do
        index := index + 1;
    while (index <= item_name_length) and (a_string(.index.) = ' ') do
        index := index + 1;
    if index > item_name_length then
        match := true
    else
        match := false;
end;


begin   (* WalkTree *)
    print_anew := true;
    brkm(0);    (* Break on all *)
    echom(1);   (* Echo all but control-characters *)
    out_text(top_of_tree,log_unit);
    repeat
        exit := false;
        if print_anew then
        begin
            writeln;
            writeln(' ':4,'Additional information available :');
            writeln;
            ptr := top_of_tree^.sub_items;
            item_c := 0;
            write(' ':4);
            while ptr <> nil do
            begin
                write(ptr^.name);
                ptr := ptr^.adj_item;
                item_c := item_c +1;
                if item_c = 5 then
                begin
                    writeln;
                    write(' ':4);
                    item_c := 0;
                end;
            end;
            writeln;
            writeln;
        end;
        if top_of_tree^.prev_item <> nil then
        begin
            if top_of_tree^.prev_item^.prev_item = nil then
            begin
                out_name(top_of_tree^.name);
                write(' subtopic ?>');
            end  
            else
            begin
                back_ptr := top_of_tree;
                while back_ptr^.prev_item^.prev_item <> nil do
                    back_ptr := back_ptr^.prev_item;
                out_name(back_ptr^.name);
                write(' ');
                out_name(top_of_tree^.name);
                write(' subtopic ?>');
            end;
        end 
        else
            write('Item ? >');
        get_name(test_name);
        writeln;
        print_anew := false;
        if test_name(.top.) = chr(cr) then
            begin
                top_of_tree := top_of_tree^.prev_item;
                if top_of_tree = nil then
                    exit := true;
            end
        else
            if test_name(.top.) = '?' then
                print_anew := true
            else
            begin
                ptr := top_of_tree^.sub_items;
                found := false;
                save_ptr := nil;
                ambig_ref := false;
                while ptr <> nil do
                begin
                    If match(test_name,ptr^.name) then
                    begin
                        if save_ptr <> nil then
                            ambig_ref := true
                        else
                            save_ptr := ptr;
                        out_text(ptr,log_unit);
                    end;
                    ptr := ptr^.adj_item;
                end;
                if save_ptr = nil then
                    writeln('Sorry, no information on ',test_name)
                else
                    if not(ambig_ref) then
                    begin
                        print_anew := false;
                        if save_ptr^.sub_items <> nil then
                        begin
                            top_of_tree := save_ptr;
                            print_anew := true;
                        end;
                    end;
            end 
    until   exit;
end;

begin   (* Main routine *)
    file_name := '(SYSTEM)KERMIT''';
    file_type := 'HELP';
    log_unit := xopen(file_name,file_type,1,status);
    if status <> 0 then
    begin
        file_name := '(HELP)KERMIT''';
        log_unit := xopen(file_name,file_type,1,status);
        if status <> 0 then
        begin
            file_name := 'KERMIT''';
            log_unit := xopen(file_name,file_type,1,status);
            if status <> 0 then
                writeln('ERROR : Can''t open help file.');
        end;
    end;
    crunch_text(top_of_tree,contfile);
    lv := 0;
(*  print_tree(top_of_tree); *)
    walk_tree(top_of_tree);
    close(log_unit);
end;.