{$B-,F-,I-,R+,S+,V+}

unit menu;

interface

uses
  crt,
  graph,
  screen,
  mouse;

type
  intptr = ^integer;
  realptr = ^real;
  buf_array = array[0..3000] of word;
  buf_array_ptr = ^buf_array;
  choicerecptr = ^choicerec;
  choicerec = record
      name: string[30];
      ans: integer;
      int_loc: intptr;
      real_loc: realptr;
      real_interval: integer;
      gauge_min,gauge_max: real;
      next: choicerecptr;
    end;
  menu_header = record
      menu_kind: (normal_menu,bar_menu,big_menu);
      num_items,page_start,x1,y1,x2,y2: integer;
      title: string[50];
      ScreenBuf: buf_array_ptr;
      choicelist: choicerecptr;
    end;

var
  entry,frame,select,in_box,normal: byte;
  AutoHelp: boolean;    { automatic selection of help screens }

const
  HelpFile: string = 'HELP.MSG';     { help message file }

procedure
 start_menu(x,y: integer; var menu: menu_header);
procedure start_menu_bar(y: integer; var menu: menu_header);
procedure menu_item(s: string; answer: integer; var menu: menu_header);
procedure int_gauge_item(s: string; answer: integer; var gauge: integer;
  min,max: integer; var menu: menu_header);
procedure real_gauge_item(s: string; answer: integer; var gauge: real;
  min,max: real; interval: integer; var menu: menu_header);
procedure change_menu_item(s: string; answer: integer; var menu: menu_header);
procedure change_gauge_item(answer: integer; var menu: menu_header);
procedure OnOff_menu_item(b: boolean; answer: integer; var menu: menu_header);
procedure menu_title(s: string; var menu: menu_header);
procedure hide_menu(var menu: menu_header);
procedure exec_menu(var cx,cy: integer; var answer: integer;
  var mmenu: menu_header);
procedure show_menu(var cx,cy: integer; c: integer; var menu: menu_header);
function string_box(cx,cy,len: integer; var ans: string; title: string):
  boolean;
function integer_box(cx,cy,len: integer; var ans: longint; title: string):
  boolean;
function real_box(cx,cy,len: integer; var ans: real; title: string):
  boolean;
function yes_or_no(cx,cy: integer; title,msg: string): char;
procedure message(cx,cy: integer; msg,title: string);
procedure draw_box(var cx,cy: integer; len,hgt: integer; title: string);
procedure make_box(var cx,cy: integer; len,hgt: integer; title: string;
  var buf: buf_array_ptr);
procedure delete_box(var buf: buf_array_ptr);
procedure Help_screen;
procedure push_Help_Page(h: integer);
procedure pop_Help_Page;

implementation

{======================================================================}
{ menu procedures
{======================================================================}

const
  alt_chars: array ['0'..'Z'] of char =
    (Alt_0,   {0}
     Alt_1,   {1}
     Alt_2,   {2}
     Alt_3,   {3}
     Alt_4,   {4}
     Alt_5,   {5}
     Alt_6,   {6}
     Alt_7,   {7}
     Alt_8,   {8}
     Alt_9,   {9}
     #255,
     #255,
     #255,
     #255,
     #255,
     #255,
     #255,
     Alt_A,    {a}
     Alt_B,    {b}
     Alt_C,    {c}
     Alt_D,    {d}
     Alt_E,    {e}
     Alt_F,    {f}
     Alt_G,    {g}
     Alt_H,    {h}
     Alt_I,    {i}
     Alt_J,    {j}
     Alt_K,    {k}
     Alt_L,    {l}
     Alt_M,    {m}
     Alt_N,    {n}
     Alt_O,    {o}
     Alt_P,    {p}
     Alt_Q,    {q}
     Alt_R,    {r}
     Alt_S,    {s}
     Alt_T,    {t}
     Alt_U,    {u}
     Alt_V,    {v}
     Alt_W,    {w}
     Alt_X,    {x}
     Alt_Y,    {y}
     Alt_Z);   {z}
  box_max_y = 15;
  big_width = 60;
  big_height = 15;
  mouse_select = #28;                { used by string_box routines }

var Help_Page: array[1..10] of integer;
    mouse_button: mouse_mode_type;
    mouse_x,mouse_y: word;

{--------------------------------------------------------------------------
{
{ procedure start_menu
{
{ Parameters x: integer; coord of top left of menu
{            y: integer; coord of top left of menu
{            var menu: menu_header;
{
{ Globals   Help_Page
{
{ Start a new box menu
{ if it is off the screen the cx,cy will be adjusted accordingly
{ menu.ScreenBuf:=nil
{
{--------------------------------------------------------------------------}
procedure start_menu(x,y: integer; var menu: menu_header);
begin
  with menu do
  begin
    menu_kind:=normal_menu;
    x1:=x; y1:=y;
    x2:=x; y2:=y+1;
    num_items:=0;
    title:='';
    ScreenBuf:=nil;
    choicelist:=nil;
  end;
  push_Help_Page(Help_Page[1]);
end;

{--------------------------------------------------------------------------
{
{ procedure start_menu_bar
{
{ Parameters y: integer; not used - retained for compatibility
{            var menu: menu_header;
{
{ Globals   Help_Page
{
{ Start a new bar menu
{ it will appear on the top line
{ menu.ScreenBuf:=nil
{
{--------------------------------------------------------------------------}
procedure start_menu_bar(y: integer; var menu: menu_header);
begin
  with menu do
  begin
    menu_kind:=bar_menu;
    y1:=y;
    num_items:=0;
    title:='';
    ScreenBuf:=nil;
    choicelist:=nil;
  end;
  push_Help_Page(Help_Page[1]);
end;

{--------------------------------------------------------------------------
{
{ function gauge_str
{
{ Parameters min: integer; min value of guage
{            max: integer; max value of guage
{            gauge: integer; gauge value
{
{ Return     string;
{
{ Globals    calculates a string representing a gauge value
{
{--------------------------------------------------------------------------}
function gauge_str(min,max,gauge: integer): string;
  var s: string;
begin
  s:='';
  while length(s) <= max-min do s:=s+'Ä';
  if min = 0 then                 s[1-min]:='Ú' else
  if max = 0 then                 s[1-min]:='¿' else
  if (min < 0) and (max > 0) then s[1-min]:='Â';
  if gauge < min then
    s[1]:='<' else
  if gauge > max then
    s[max+1-min]:='>' else
  if (gauge >= min) and (gauge <= max) then
    s[gauge+1-min]:='Å';
  gauge_str:=s;
end;

{--------------------------------------------------------------------------
{
{ procedure make_menu_item
{
{ Parameters s: string;           item name
{            answer: integer;     answer value
{            int_gauge: intptr;   pointer to integer dependent gauge
{            real_gauge: realptr; pointer to real dependent gauge
{            min: real            min gauge value
{            max: real;           max gauge value
{            interval: integer;   gauge interval
{            var menu: menu_header;
{
{ makes a new menu item of any type
{
{--------------------------------------------------------------------------}
procedure make_menu_item(s: string; answer: integer; int_gauge: intptr;
    real_gauge: realptr; min,max: real; interval: integer;
    var menu: menu_header);
  var choice: choicerecptr;
      x: integer;
  procedure add(var p: choicerecptr);
  begin
    if p = nil then p:=choice else add(p^.next);
  end;
begin
  new(choice);
  with menu do
  with choice^ do
  begin
    if screenbuf <> nil then halt; {runerror(0); {}
    inc(num_items);
    if int_gauge <> nil then s:=s+gauge_str(trunc(min),trunc(max),0);
    if real_gauge <> nil then s:=s+gauge_str(0,interval-1,0);
    if menu_kind <> bar_menu then
    begin
      inc(y2);
      if y2 > y1+box_max_y+1 then y2:=y1+box_max_y+1;
      x:=x1+length(s)+1; if x > x2 then x2:=x;
      if y2 > 25 then begin y1:=y1+25-y2; y2:=25; end;
      if x2 > 80 then begin x1:=x1+80-x2; x2:=80; end;
      if num_items > box_max_y then menu_kind:=big_menu;
    end;
    name:=s;
    ans:=answer;
    gauge_min:=min;
    gauge_max:=max;
    int_loc:=int_gauge;
    real_loc:=real_gauge;
    real_interval:=interval;
    add(choicelist);
    next:=nil;
  end;
end;

{--------------------------------------------------------------------------
{
{ procedure menu_item
{
{ Parameters s: string;
{            answer: integer;
{            var menu: menu_header;
{
{ makes a new simple menu item
{
{--------------------------------------------------------------------------}
procedure menu_item(s: string; answer: integer; var menu: menu_header);
begin
  make_menu_item(s,answer,nil,nil,0,-1,0,menu);
end;

{--------------------------------------------------------------------------
{
{ procedure int_gauge_item
{
{ Parameters s: string;           item name
{            answer: integer;     answer value
{            var gauge: integer;  dependent gauge variable
{            min: real            min gauge value
{            max: real;           max gauge value
{            var menu: menu_header;
{
{ makes a new menu item of integer gauge type
{
{--------------------------------------------------------------------------}
procedure int_gauge_item(s: string; answer: integer; var gauge: integer;
  min,max: integer; var menu: menu_header);
begin
  make_menu_item(s,answer,addr(gauge),nil,min,max,0,menu);
end;

{--------------------------------------------------------------------------
{
{ procedure real_gauge_item
{
{ Parameters s: string;           item name
{            answer: integer;     answer value
{            var gauge: real;     dependent gauge variable
{            min: real            min gauge value
{            max: real;           max gauge value
{            interval: integer;   interval of gauge value
{            var menu: menu_header;
{
{ makes a new menu item of real gauge type
{
{--------------------------------------------------------------------------}
procedure real_gauge_item(s: string; answer: integer; var gauge: real;
  min,max: real; interval: integer; var menu: menu_header);
begin
  make_menu_item(s,answer,nil,addr(gauge),min,max,interval,menu);
end;

{--------------------------------------------------------------------------
{
{ procedure change_menu_item
{
{ Parameters s: string;           new item name
{            answer: integer;     answer value
{            var menu: menu_header;
{
{ change an existing simple gauge item
{ the new name will be truncated or padded to the length of the
{ original name
{
{--------------------------------------------------------------------------}
procedure change_menu_item(s: string; answer: integer; var menu: menu_header);
  var choice: choicerecptr;
begin
  choice:=menu.choicelist;
  while choice <> nil do
  with menu,choice^ do
  begin
    if ans = answer then name:=copy(s,1,x2-x1);
    choice:=next;
  end;
end;

{--------------------------------------------------------------------------
{
{ procedure calc_real_gauge
{
{ Parameters choice: choicerecptr;
{            var g_v: integer;
{            var g_i_max: integer;
{            var g_i_min: integer;
{            var g_a: real;
{            var g_b: real;
{
{ used internally
{ calculates the gauge coefficients ready for calling gauge_str:
{
{      s:=gauge_str(trunc(g_i_min),trunc(g_i_max),g_v;
{
{ or for calculating the real value given an integer gauge value:
{
{      real_loc^:=g_a+(g_v+0.5)*g_b;
{
{--------------------------------------------------------------------------}
procedure calc_real_gauge(choice: choicerecptr;
      var g_v,g_i_max,g_i_min: integer;
      var g_a,g_b: real);
begin
  with choice^ do
  begin
    g_i_max:=trunc(gauge_max*(real_interval-1)/(gauge_max-gauge_min)+0.5);
    g_i_min:=g_i_max-real_interval+1;
    g_b:=(gauge_max-gauge_min)/(g_i_max-g_i_min);
    g_a:=gauge_min-(g_i_min+0.5)*g_b;
    if odd(g_i_max-g_i_min) then
      g_v:=trunc((abs(real_loc^)-g_a)/g_b-g_i_min -0.5)+g_i_min else
      g_v:=trunc((abs(real_loc^)-g_a)/g_b-g_i_min)+g_i_min;
    if real_loc^ < 0 then g_v:=-g_v;
  end;
end;

{--------------------------------------------------------------------------
{
{ procedure change_gauge_item
{
{ Parameters answer: integer;
{            var menu: menu_header;
{
{ changes the gauge string part of an existing gauge item
{
{--------------------------------------------------------------------------}
procedure change_gauge_item(answer: integer; var menu: menu_header);
  var choice: choicerecptr;
      s: string;
      g_v,g_i_max,g_i_min: integer;
      g_a,g_b: real;
begin
  choice:=menu.choicelist;
  while choice <> nil do
  with menu,choice^ do
  begin
    if (ans = answer) and (int_loc <> nil) then
    begin
      s:=gauge_str(trunc(gauge_min),trunc(gauge_max),int_loc^);
      name:=copy(name,1,length(name)-length(s))+s;
    end;
    if (ans = answer) and (real_loc <> nil) then
    begin
      calc_real_gauge(choice,g_v,g_i_max,g_i_min,g_a,g_b);
      s:=gauge_str(trunc(g_i_min),trunc(g_i_max),g_v);
      name:=copy(name,1,length(name)-length(s))+s;
    end;
    choice:=next;
  end;
end;

{--------------------------------------------------------------------------
{
{ procedure change_all_gauges
{
{ Parameters var menu: menu_header;
{
{ changes the gauge string part of all existing gauge items
{
{--------------------------------------------------------------------------}
procedure change_all_gauges(var menu: menu_header);
  var choice: choicerecptr;
begin
  choice:=menu.choicelist;
  while choice <> nil do
  with menu,choice^ do
  begin
    if (int_loc <> nil) or (real_loc <> nil) then
      change_gauge_item(ans,menu);
    choice:=next;
  end;
end;

{--------------------------------------------------------------------------
{
{ procedure OnOff_menu_item
{
{ Parameters b: boolean;
{            answer: integer;
{            var menu: menu_header;
{
{  changes an existing item
{
{ if b is true then
{    replaces the last three characters of the name with ' On'
{ else
{    replaces the last three characters of the name with 'Off'
{
{--------------------------------------------------------------------------}
procedure OnOff_menu_item(b: boolean; answer: integer; var menu: menu_header);
  var choice: choicerecptr;
begin
  choice:=menu.choicelist;
  while choice <> nil do
  with menu,choice^ do
  begin
    if ans = answer then
    begin
      while length(name) < x2-x1-4 do name:=name+' ';
      name:=copy(name,1,x2-x1-4);
      if b then name:=name+' On' else name:=name+'Off';
    end;
    choice:=next;
  end;
end;

{--------------------------------------------------------------------------
{
{ procedure menu_title
{
{ Parameters s: string;             the title
{            var menu: menu_header; the menu
{
{ sets the menu title
{
{ the menu title is only shown on big_box menus
{
{--------------------------------------------------------------------------}
procedure menu_title(s: string; var menu: menu_header);
begin
  menu.title:=s;
end;

{--------------------------------------------------------------------------
{
{ procedure get_box(
{
{ Parameters cx: integer;            topleft corner of box
{            cy: integer;            topleft corner of box
{            len: integer;           width of box
{            hgt: integer;           height of box
{            var buf: buf_array_ptr; buffer for saved area
{
{ saves an area of the screen into a buffer
{ the buffer remembers:
{    the size and location of the area
{    the old cursor position
{    the old window setting
{ space for the buffer is created on the heap
{
{--------------------------------------------------------------------------}
procedure get_box(cx,cy: integer; len,hgt: integer; var buf: buf_array_ptr);
  var x,y,i,s: integer;
      x1,y1,x2,y2: byte;
begin
  s:=(hgt*len+14)*2;
  getmem(buf,s);
  for i:=0 to hgt-1 do
    moveFromScreen(ScreenPtr^[cy+i,cx],Buf^[i*len+11],len*2);
  buf^[0]:=wherex;
  buf^[1]:=wherey;
  buf^[2]:=cx;
  buf^[3]:=cy;
  buf^[4]:=len;
  buf^[5]:=hgt;
  buf^[6]:=s;
  get_window(x1,y1,x2,y2);
  buf^[7] :=x1;
  buf^[8] :=y1;
  buf^[9] :=x2;
  buf^[10]:=y2;
end;

{--------------------------------------------------------------------------
{
{ procedure make_box
{
{ Parameters var cx: integer;
{            var cy: integer;
{            len: integer;
{            hgt: integer;
{            title: string;
{            var buf: buf_array_ptr;
{
{ stores the contents of the screen in buf
{ draws a double-walled box with a title
{ (the inside of the box measures len x height not the outside)
{ cx,cy is the topleft corner of the wall
{
{ sets the current window to the inside of the box
{
{--------------------------------------------------------------------------}
procedure make_box(var cx,cy: integer; len,hgt: integer; title: string;
    var buf: buf_array_ptr);
begin
  if cx > 78-len then cx:=78-len;
  if cy > 23-hgt then cy:=23-hgt;
  get_box(cx,cy,len+2,hgt+2,buf);
  draw_box(cx,cy,len,hgt,title);
  window(cx+1,cy+1,cx+len,cy+hgt);
end;

{--------------------------------------------------------------------------
{
{ procedure delete_box
{
{ Parameters var buf: buf_array_ptr; buffer for saved area
{
{ restores an area of the screen from a buffer
{ buffer must have been set up by get_box or make_box
{ the buffer has remembered:
{    the size and location of the area
{    the old cursor position
{    the old window setting
{ the space for the buffer on the heap is disposed
{
{--------------------------------------------------------------------------}
procedure delete_box(var buf: buf_array_ptr);
  var x,y,i,s: integer;
      cx,cy,len,hgt: integer;
begin
  if buf = nil then exit;
  window(buf^[7],buf^[8],buf^[9],buf^[10]);
  gotoxy(
       buf^[0],
       buf^[1]);
  cx:= buf^[2];
  cy:= buf^[3];
  len:=buf^[4];
  hgt:=buf^[5];
  s  :=buf^[6];
  for i:=0 to hgt-1 do
    moveToScreen(Buf^[i*len+11],ScreenPtr^[cy+i,cx],len*2);
  freemem(buf,s);
  buf:=nil;
end;

{--------------------------------------------------------------------------
{
{ procedure hide_menu
{
{ Parameters var menu: menu_header;
{
{ deletes the menu from the screen and restores what was underneath
{ disposes all the data structures of the menu
{ menu.ScreenBuf:=nil
{ can be called any number of times: ignores subsequent calls
{
{--------------------------------------------------------------------------}
procedure hide_menu(var menu: menu_header);
  var i: integer;
      choice,temp: choicerecptr;
begin
  with menu do
  begin
    if ScreenBuf <> nil then
    begin
      if mouse_exists then hide_mouse; {}
      delete_box(ScreenBuf);
      choice:=choicelist;
      while choice <> nil do
      begin
        temp:=choice^.next;
        dispose(choice);
        choice:=temp;
      end;
      pop_Help_Page;
    end;
    ScreenBuf:=nil
  end;
end;

{--------------------------------------------------------------------------
{
{ function mouseat
{
{ Parameters x: integer; coord of string
{            y: integer; coord of string
{            c: integer; colour of string
{            s: string;  string to be printed
{
{ Return     boolean;
{
{ Globals    mouse_button
{            mouse_x
{            mouse_y
{
{ same as writeat
{ writes a string on the screen
{ returns true if the mouse cursor is in the string
{
{--------------------------------------------------------------------------}
function mouseat(x,y,c: integer; s: string): boolean;
var  mmouseat: boolean;
begin
  writeat(x,y,c,s);
  if mouse_exists then
  begin
    mmouseat:=(mouse_button = clicked) and
      (y = mouse_y) and (mouse_x >= x) and (mouse_x < x+length(s));
  end else
    mmouseat:=false;
mouseat:=mmouseat;
if mmouseat then
begin
  mmouseat:=true;
end;
end;

{--------------------------------------------------------------------------
{
{ function show_bar
{
{ Parameters c: integer;      answer which should be illuminted
{            var cx: integer; coord of result
{            var cy: integer; coord of result
{            var menu: menu_header;
{
{ Return    boolean;
{
{ Globals   Help_Page
{           autohelp
{
{ draws a menu bar at the top of the screen
{ the answer = c item is shown selected
{ cx,cy returns the coords of the first char of the selected item
{
{ if the mouse has been clicked in one of the items then
{    c returns answer selected item
{    function returns true
{ else
{    function returns false
{
{--------------------------------------------------------------------------}
function show_bar(var c: integer; var cx,cy: integer; var menu: menu_header):
    boolean;
  var s: string[80];
      i,j,l: integer;
      choice,t: choicerecptr;
begin
  with menu do
  begin
    show_bar:=false;
    if ScreenBuf = nil then
      get_box(1,1,80,1,screenbuf);

    l:=screen_width;
    choice:=choicelist;
    while choice <> nil do
    with choice^ do
    begin
      l:=l-length(name);
      choice:=next;
    end;

    s:='';
    for i:=1 to l div (num_items+1) do begin s:=s+' '; dec(l); end;

    j:=num_items;
    choice:=choicelist;
    while choice <> nil do
    with choice^ do
    begin
      if mouse_exists and (mouse_button = clicked) and
          (mouse_y = 1) and (mouse_x > length(s)) and
          (mouse_x <= length(s)+length(name)) then
      begin
        show_bar:=true;
        c:=num_items-j+1;
      end;

      if c = num_items-j+1 then
      begin
        t:=choice;
        cx:=length(s)+1; cy:=y1;
        if AutoHelp then Help_Page[1]:=ans;
      end;
      s:=s+name;
      for i:=1 to l div j do begin s:=s+' '; dec(l); end;
      dec(j);
      choice:=next;
    end;

    writeat(1,1,in_box,s);
    if c <> 0 then
      with t^ do writeat(cx,cy,select,name);
  end;
end;

{--------------------------------------------------------------------------
{
{ function page_size
{
{ Parameters var mmenu: menu_header;
{
{ Return     integer;
{
{ used for big-box menus only
{ returns the number of items which will fit on one page
{
{--------------------------------------------------------------------------}
function page_size(var mmenu: menu_header): integer;
begin
  with mmenu do
  begin
    page_size:=big_height*(big_width div (x2-x1+1));
  end;
end;

{--------------------------------------------------------------------------
{
{ function show_big_box
{
{ Parameters var c: integer;  selected item
{            var cx: integer; coord of selected item
{            var cy: integer; coord of selected item
{            var mmenu: menu_header;
{
{ Return    boolean;
{
{ Globals   Help_Page
{
{ show a box menu as a big-box
{ prints the title of the menu
{ the answer = c item will be shown selected
{ cx,cy returns the coords of the first char of the selected item
{
{ if the mouse has been clicked in one of the items then
{    c returns answer selected item
{    function returns true
{ else
{    function returns false
{
{--------------------------------------------------------------------------}
function show_big_box(var c,cx,cy: integer; var mmenu: menu_header):
    boolean;
  var s: string[80];
      bx,by,xs,ys,i,j,l,n,k,cnt: integer;
      choice,t: choicerecptr;
      fin,shown: boolean;
      old_win_xmin,old_win_ymin,old_win_xmax,old_win_ymax: byte;
begin
  with mmenu do
  begin
    show_big_box:=false;
    get_window(old_win_xmin,old_win_ymin,old_win_xmax,old_win_ymax);
    bx:=(screen_width-big_width) div 2;
    by:=(screen_height-big_height) div 2;
    if ScreenBuf = nil then
      make_box(bx,by,big_width,big_height,title,ScreenBuf);

    repeat
      choice:=choicelist;
      for k:=2 to page_start do
        if choice <> nil then
          choice:=choice^.next;
      k:=page_start;
      xs:=1;
      ys:=1;
      shown:=false;

      repeat
        fin:=false;
        if choice = nil then
        begin
          s:='';
          while length(s) < x2-x1-1 do s:=s+' ';
          writeat(xs+bx,ys+by,in_box,s);
        end else
        with choice^ do
        begin
          s:=name;
          while length(s) < x2-x1-1 do s:=s+' ';
          if c = k then
          begin
            if mouseat(xs+bx,ys+by,select,s) then
              show_big_box:=true;
            if AutoHelp then Help_Page[1]:=ans;
            cx:=xs+bx; cy:=ys+by;
            shown:=true;
          end else
          if mouseat(xs+bx,ys+by,in_box,s) then
          begin
            show_big_box:=true;
            if AutoHelp then Help_Page[1]:=ans;
            cx:=xs+bx; cy:=ys+by;
            c:=k;
          end;
          inc(k); if k > num_items then k:=1;
          choice:=next;
        end;
        inc(ys);
        if ys > big_height then
        begin
          ys:=1;
          xs:=xs+x2-x1;
          if xs+x2-x1+1 > big_width then fin:=true;
        end;
      until fin;
      if not shown then
        if c < page_start then
        begin
          if (menu_kind = big_menu) and (page_start > page_size(mmenu)) then
          page_start:=page_start-page_size(mmenu);
        end else
        begin
          if (menu_kind = big_menu) and (page_start <= num_items-page_size(mmenu)) then
          page_start:=page_start+page_size(mmenu);
        end;
    until shown;
    window(old_win_xmin,old_win_ymin,old_win_xmax,old_win_ymax);
  end;
end;

{--------------------------------------------------------------------------
{
{ function show_small_box
{
{ Parameters var c: integer;  selected item
{            var cx: integer; coord of selected item
{            var cy: integer; coord of selected item
{            var mmenu: menu_header;
{
{ Return    boolean;
{
{ Globals   Help_Page
{
{ show a box menu as a small-box
{ the answer = c item will be shown selected
{ cx,cy returns the coords of the first char of the selected item
{
{ if the mouse has been clicked in one of the items then
{    c returns answer selected item
{    function returns true
{ else
{    function returns false
{
{--------------------------------------------------------------------------}
function show_small_box(var c,cx,cy: integer; var menu: menu_header):
    boolean;
  var s: string[80];
      i,j,l,k,cnt: integer;
      choice: choicerecptr;
begin
  with menu do
  begin
    show_small_box:=false;
    if ScreenBuf = nil then
      get_box(x1,y1,x2-x1+1,y2-y1+1,ScreenBuf);

    if cy > 22-num_items then cy:=22-num_items;
    writeat(x1,y1,frame,'Ú');
    for i:=x1+1 to x2-1 do writeat(i,y1,frame,'Ä');
    writeat(x2,y1,frame,'¿');
    choice:=choicelist;
    k:=1;
    for i:=1 to num_items do
    with choice^ do
    begin
      writeat(x1,y1+i,frame,'³');
      s:=name;
      while length(s) < x2-x1-1 do s:=s+' ';
      if c = k then
      begin
        if mouseat(x1+1,y1+i,select,s) then
          show_small_box:=true;
        if AutoHelp then Help_Page[1]:=ans;
        cx:=x1+1; cy:=y1+i;
      end else
      if mouseat(x1+1,y1+i,in_box,s) then
      begin
        show_small_box:=true;
        if AutoHelp then Help_Page[1]:=ans;
        cx:=x1+1; cy:=y1+i;
        c:=k;
      end;
      writeat(x2,y1+i,frame,'³');
      inc(k); if k > num_items then k:=1;
      choice:=next;
      if choice = nil then choice:=choicelist;
    end;
    writeat(x1,y2,frame,'À');
    for i:=x1+1 to x2-1 do writeat(i,y2,frame,'Ä');
    writeat(x2,y2,frame,'Ù');
  end;
end;

{--------------------------------------------------------------------------
{
{ function func_show_menu
{
{ Parameters var c: integer;  selected item
{            var cx: integer; coord of selected item
{            var cy: integer; coord of selected item
{            var mmenu: menu_header;
{
{ Return    boolean;
{
{ Globals   Help_Page
{
{ show a menu as a big-box, small-box or bar
{ the answer = c item will be shown selected
{ cx,cy returns the coords of the first char of the selected item
{
{ if the mouse has been clicked in one of the items then
{    c returns answer selected item
{    function returns true
{ else
{    function returns false
{
{--------------------------------------------------------------------------}
function func_show_menu(var cx,cy,c: integer; var menu: menu_header):
    boolean;
begin
  hide_mouse; {}
  func_show_menu:=false;
  change_all_gauges(menu);
  with menu do
  case menu_kind of
    bar_menu:    func_show_menu:=show_bar(c,cx,cy,menu);
    big_menu:    func_show_menu:=show_big_box(c,cx,cy,menu);
    normal_menu: func_show_menu:=show_small_box(c,cx,cy,menu);
  end;
end;

{--------------------------------------------------------------------------
{
{ procedure show_menu
{
{ Parameters var cx: integer; coord of selected item
{            var cy: integer; coord of selected item
{            c: integer;      selected item
{            var mmenu: menu_header;
{
{ Globals   Help_Page
{
{ show a menu as a big-box, small-box or bar
{ the answer = c item will be shown selected
{ cx,cy returns the coords of the first char of the selected item
{
{--------------------------------------------------------------------------}
procedure show_menu(var cx,cy: integer; c: integer; var menu: menu_header);
begin
  if func_show_menu(cx,cy,c,menu) then ;
end;

{--------------------------------------------------------------------------
{
{ procedure exec_menu
{
{ Parameters var cx: integer; coord of selected item
{            var cy: integer; coord of selected item
{            answer: integer; selected item
{
{ Globals    mouse_button
{            mouse_x
{            mouse_y
{
{ shows a menu in the appropriate format
{ if return pressed or mouse clicked on an item or Alt-item-initial pressed
{   then
{     answer = ans of selected item
{     cx,cy returns coord of first char if selected item
{ if escape pressed or mouse clicked off the menu then
{     answer = 0
{ else
{     move selection to a different item or adjust gauge item
{
{ can be called any number of times for the same menu; knows not to save
{  the screen again because menu.ScreenBuf <> nil
{
{--------------------------------------------------------------------------}
procedure exec_menu(var cx,cy: integer; var answer: integer;
    var mmenu: menu_header);

  var choice,old_choice: choicerecptr;

  function find_letter(cmd: char; var c: integer; advance: boolean): boolean;
    var found: boolean;
        old_c,i: integer;
        ch: char;
  begin
    if cmd > #127 then
      for ch:='0' to 'Z' do
        if cmd = alt_chars[ch] then cmd:=ch;

    with mmenu do
    begin
      old_choice:=choice;
      old_c:=c;
      i:=1;
      found:=(upcase(cmd) = upcase(choice^.name[1])) and not advance;
      while (i <= num_items) and not found do
      begin
        choice:=choice^.next;
        inc(c);
        if choice = nil then
        begin
          choice:=choicelist;
          c:=1;
        end;
        found:=upcase(cmd) = upcase(choice^.name[1]);
        inc(i);
      end;
      if not found then
      begin
        choice:=old_choice;
        c:=old_c;
      end;
      find_letter:=found;
    end;
  end;

  var c,i: integer;
      l: longint;
      r: real;
      buf: array [1..80] of word;
      cmd,ch: char;
      g_v,g_i_max,g_i_min: integer;
      g_a,g_b: real;
      mx,my: word;

  function show: boolean;
    var i: integer;
  begin
    with mmenu do
    begin
      show:=func_show_menu(cx,cy,c,mmenu);

      choice:=choicelist;
      for i:=2 to c do choice:=choice^.next;
      answer:=choice^.ans;
    end;
  end;

begin
  with mmenu do
  begin
    if num_items = 0 then begin answer:=0; exit; end;
    page_start:=1;
    c:=1;
    choice:=choicelist;
    for i:=1 to num_items do
    with choice^ do
    begin
      if ans=answer then c:=i;
      choice:=next;
    end;

    if mouse_exists then
    begin
      mouse_button:=mouse_mode(mouse_x,mouse_y,mx,my);
      if show then ;
    end;

    repeat
      c:=(c+num_items-1) mod num_items +1;

      if show then ;

      repeat
        if mouse_exists then
        begin
          show_mouse_moved;
          mouse_button:=mouse_mode(mouse_x,mouse_y,mx,my);
        end;
      until keyavail or (mouse_button = clicked);

      if keyavail then
        cmd:=getbigkey else
      if show then
        cmd:=CR else
        cmd:=Esc;

      case cmd of
        CR:  with choice^ do
             if int_loc <> nil then
             begin
{               repeat {}
                 l:=int_loc^;
                 if integer_box(cx,cy+1,12,l,'') then;
{               until (l >= gauge_min) and (l <= gauge_max); {}
               int_loc^:=l;
               change_gauge_item(answer,mmenu);
             end else
             if real_loc <> nil then
             begin
{               repeat {}
                 r:=real_loc^;
                 if real_box(cx,cy+1,13,r,'') then;
{               until (r >= gauge_min) and (r <= gauge_max); {}
               real_loc^:=r;
               change_gauge_item(answer,mmenu);
             end else
             begin if show then ; exit; end;
        Esc: begin
               c:=0;
               if menu_kind = bar_menu then if show then;
               answer:=0;
               exit;
             end;
        Up: if menu_kind <> bar_menu then c:=(c+num_items-2) mod num_items +1;
        Left:  if menu_kind = bar_menu then
                 c:=(c+num_items-2) mod num_items +1 else
               with choice^ do
               if int_loc <> nil then
               begin
                 if int_loc^ > gauge_min then
                 begin
                   dec(int_loc^);
                   change_gauge_item(answer,mmenu);
                 end;
               end else
               if real_loc <> nil then
               begin
                 calc_real_gauge(choice,g_v,g_i_max,g_i_min,g_a,g_b);
                 if g_v > g_i_min then
                 begin
                   dec(g_v);
                   real_loc^:=g_a+(g_v+0.5)*g_b;
                   if abs(real_loc^/(gauge_max-gauge_min)) < 1E-4 then
                     real_loc^:=0;
                   change_gauge_item(answer,mmenu);
                 end;
               end else
               if menu_kind = big_menu then
               begin
                 if c > big_height then c:=c-big_height;
               end;
        Right: if menu_kind = bar_menu then
                 c:=(c mod num_items +1) else
               with choice^ do
               if int_loc <> nil then
               begin
                 if int_loc^ < gauge_max then
                 begin
                   inc(int_loc^);
                   change_gauge_item(answer,mmenu);
                 end;
               end else
               if real_loc <> nil then
               begin
                 calc_real_gauge(choice,g_v,g_i_max,g_i_min,g_a,g_b);
                 if g_v < g_i_max then
                 begin
                   inc(g_v);
                   real_loc^:=g_a+(g_v+0.5)*g_b;
                   if abs(real_loc^/(gauge_max-gauge_min)) < 1E-4 then
                     real_loc^:=0;
                   change_gauge_item(answer,mmenu);
                 end;
               end else
               if menu_kind = big_menu then
               begin
                 if c <= num_items-big_height then c:=c+big_height;
               end;
        Down: if menu_kind = bar_menu then exit else c:=c mod num_items +1;
        Page_up: if (menu_kind = big_menu) and (c > page_size(mmenu)) then
                   c:=c-page_size(mmenu);
        Page_dn: if (menu_kind = big_menu) and (c <= num_items-page_size(mmenu)) then
                   c:=c+page_size(mmenu);

        F1: Help_screen;
        #128..#255: if find_letter(cmd,c,false) then stuffkey(CR);
        else        if find_letter(cmd,c,true) then;
      end;
    until false;
  end;
end;

{--------------------------------------------------------------------------
{
{ procedure draw_box
{
{ Parameters var cx: integer;        topleft corner of box
{            var cy: integer;        topleft corner of box
{            len: integer;           width of box
{            hgt: integer;           height of box
{            title: string;          title of box
{
{ draws a double-walled box with a title
{ (the inside of the box measures len x height not the outside)
{ cx,cy is the topleft corner of the wall
{
{--------------------------------------------------------------------------}
procedure draw_box(var cx,cy: integer; len,hgt: integer; title: string);
  var x,y,i: integer;
      s: string;
begin
  writeat(cx,cy,in_box,'ÉÍ');
  for i:=1 to len-1 do
    if i <= length(title) then
      writeat(cx+i+1,cy,in_box,title[i]) else
      writeat(cx+i+1,cy,in_box,'Í');
  writeat(cx+len+1,cy,in_box,'»');
  s:='º';
  while length(s) <= len do s:=s+' ';
  s:=s+'º';
  for i:=1 to hgt do
    writeat(cx,cy+i,in_box,s);
  writeat(cx,cy+hgt+1,in_box,'È');
  for i:=cx+1 to cx+len do writeat(i,cy+hgt+1,in_box,'Í');
  writeat(cx+len+1,cy+hgt+1,in_box,'¼');
end;

{--------------------------------------------------------------------------
{
{ function string_box_2
{
{ Parameters cx: integer;            topleft corner of box
{            cy: integer;            topleft corner of box
{            len: integer;           width of box
{            var ans: string;        answer typed by user
{            title: string;          title of box
{            one_char: boolean;      is a single char answer required
{
{ Return     boolean;
{
{ draws a box with a title
{ expects the user to type a string
{ initial value of string is ans
{
{ if one_char then
{     returns after the first character typed
{     if escape pressed or mouse clicked outside box then
{         returns original value of ans
{         returns false
{     else
{     if any char pressed or mouse clicked in box then
{         returns new (single char) value of ans
{         returns true
{ else
{     if return pressed or mouse clicked in box then
{         returns new value of ans
{         returns true
{     if escape pressed or mouse clicked outside box then
{         returns original value of ans
{         returns false
{     if any other char pressed than
{         edits the string
{
{--------------------------------------------------------------------------}
function string_box_2(cx,cy,len: integer; var ans: string; title: string;
    one_char: boolean): boolean;
  var buf: array [0..2,1..80] of word;
      x,y,i,f,p: integer;
      mouse_x,mouse_y,mx,my: word;
      c: char;
      s,t: string;
      first: boolean;
      old_win_xmin,old_win_ymin,old_win_xmax,old_win_ymax: byte;
begin
  get_window(old_win_xmin,old_win_ymin,old_win_xmax,old_win_ymax);

  if len > 78 then len:=78;
  if cx <= 0 then cx:=(80 - len) div 2 -1;
  if cy <= 0 then cy:=25 div 2;
  if cx > 78-len then cx:=78-len;
  if cy > 22-3 then cy:=22-3;

  for i:=0 to 2 do moveFromScreen(ScreenPtr^[cy+i,cx],Buf[i,1],(len+2)*2);
  writeat(cx,cy,in_box,'ÉÍ');
  for i:=1 to len-1 do
    if i <= length(title) then
      writeat(cx+i+1,cy,in_box,title[i]) else
      writeat(cx+i+1,cy,in_box,'Í');
  writeat(cx+len+1,cy,in_box,'»');
  writeat(cx,cy+1,in_box,'º');
  for i:=1 to len do writeat(cx+i,cy+1,entry,' ');
  writeat(cx+len+1,cy+1,in_box,'º');
  writeat(cx,cy+2,in_box,'È');
  for i:=cx+1 to cx+len do writeat(i,cy+2,in_box,'Í');
  writeat(cx+len+1,cy+2,in_box,'¼');

  s:=ans;
  x:=wherex; y:=wherey;
  first:=true;
  p:=length(s);
  f:=1;
  repeat
    if f < p-len+3 then f:=p-len+3;
    if f > p-3 then f:=p-3;
    if f < 1 then f:=1;
    if f = 1 then t:=s else t:='®'+copy(s,f+1,255);
    if length(t) > len-1 then t:=copy(t,1,len-1)+'¯';
    while length(t) < len do t:=t+' ';
    writeat(cx+1,cy+1,entry,t);
    window(1,1,80,25);
    gotoxy(cx+1+p-f+1,cy+1);

    c:=#0;
    repeat
      show_mouse_moved;
      if mouse_mode(mouse_x,mouse_y,mx,my) = clicked then
        if (mouse_y = cy+1) and (mouse_x > cx) and (mouse_x <= cx+len) then
          c:=mouse_select else c:=Esc else
      if keyavail then
      begin
        hide_mouse;
        c:=getbigkey;
      end;
    until c <> #0;

    if not one_char then
    case c of
      ' '..#127: if length(s) < 255 then
          begin
          if first then
          begin
            s:=c;
            p:=1;
          end else
          begin
            s:=copy(s,1,p)+c+copy(s,p+1,255);
            inc(p);
          end;
        end;
      BS: if p > 0 then
          begin
            s:=copy(s,1,p-1)+copy(s,p+1,255);
            dec(p);
          end;
      Del: if p < length(s) then
              s:=copy(s,1,p)+copy(s,p+2,255);
      Left: if p > 0 then dec(p);
      Right: if p < length(s) then inc(p);
      Home: p:=0;
      End_ch: p:=length(s);
      F1: Help_screen;
    end;
    first:=false;
  until (c = CR) or (c = Esc) or (c = mouse_select) or one_char;

  window(old_win_xmin,old_win_ymin,old_win_xmax,old_win_ymax);
  gotoxy(x,y);
  if c = Esc then
    string_box_2:=false else
  if one_char then
  begin
    ans:=c;
    string_box_2:=true;
  end else
  begin
    ans:=s;
    string_box_2:=true;
  end;
  hide_mouse;
  for i:=0 to 2 do moveToScreen(Buf[i,1],ScreenPtr^[cy+i,cx],(len+2)*2);
end;

{--------------------------------------------------------------------------
{
{ function string_box
{
{ Parameters cx: integer;            topleft corner of box
{            cy: integer;            topleft corner of box
{            len: integer;           width of box
{            var ans: string;        answer
{            title: string;          title of box
{
{ Return     boolean;
{
{ draws a box with a title
{ expects the user to type a string
{ initial value of string is ans
{
{ if return pressed or mouse clicked in box then
{     returns new value of ans
{     returns true
{ if escape pressed or mouse clicked outside box then
{     returns original value of ans
{     returns false
{ if any other char pressed than
{     edits the string:
{         BS: deletes the char before the cursor
{         Del: deletes the char at the cursor
{         Left: moves the cursor left
{         Right: moves the cursor right
{         Home: moves the cursor to the start of the string
{         End: moves the cursor to the end of the string
{         F1:  shows the current help screen
{         ' '..#127: if this is the first character to be typed then
{                      deletes the whole string
{                    inserts the character at the cursor
{
{
{--------------------------------------------------------------------------}
function string_box(cx,cy,len: integer; var ans: string; title: string):
    boolean;
begin
  string_box:=string_box_2(cx,cy,len,ans,title,false);
end;

{--------------------------------------------------------------------------
{
{ procedure message
{
{ Parameters cx: integer;            topleft corner of box
{            cy: integer;            topleft corner of box
{            msg: string;            message in box
{            title: string;          title of box
{
{ draws a box with a title and a message
{ returns when the user to types a single char
{
{ if either cx = 0 or cy = 0 then the box is centred in the screen
{
{--------------------------------------------------------------------------}
procedure message(cx,cy: integer; msg,title: string);
  var len: integer;
begin
  len:=length(msg)+2;
  if length(title)+2 > len then len:=length(title)+2;
  if string_box_2(cx,cy,len,msg,title,true) then;
end;

{--------------------------------------------------------------------------
{
{ function yes_or_no
{
{ Parameters cx: integer;            topleft corner of box
{            cy: integer;            topleft corner of box
{            len: integer;           width of box
{            title: string;          title of box
{            msg: string;            message in box
{
{ Return     char;
{
{ draws a box with a title and a message
{ expects the user to type a single char
{ if either cx = 0 or cy = 0 then the box is centred in the screen
{
{ if escape pressed or mouse clicked outside box then
{     returns escape
{ if 'Y' pressed or mouse clicked in box then
{     returns 'Y'
{ if 'N' then
{     returns 'N'
{ if any other char pressed than
{     ignores it
{
{--------------------------------------------------------------------------}
function yes_or_no(cx,cy: integer; title,msg: string): char;
  var s: string;
      len: integer;
begin
  yes_or_no:=Esc;
  len:=length(msg)+2;
  if length(title)+2 > len then len:=length(title)+2;

  repeat
    s:=msg;
    if not string_box_2(cx,cy,len,s,title,true) then exit;
    case upcase(s[1]) of
      'Y',mouse_select: begin yes_or_no:='Y'; exit end;
      'N': begin yes_or_no:='N'; exit end;
    end;
  until false;
end;

{--------------------------------------------------------------------------
{
{ function integer_box
{
{ Parameters cx: integer;            topleft corner of box
{            cy: integer;            topleft corner of box
{            len: integer;           width of box
{            var ans: longint;       answer
{            title: string;          title of box
{
{ Return     boolean;
{
{ draws a box with a title
{ expects the user to type a longint
{ initial value of longint is ans
{
{ if return pressed or mouse clicked in box then
{     returns new value of ans
{     returns true
{ if escape pressed or mouse clicked outside box then
{     returns original value of ans
{     returns false
{ if any other char pressed than
{     edits the longint
{
{--------------------------------------------------------------------------}
function integer_box(cx,cy,len: integer; var ans: longint; title: string):
    boolean;
  var s: string;
      i: longint;
      code: integer;
begin
  repeat
    str(ans,s);
    integer_box:=string_box(cx,cy,len,s,title);
    val(s,i,code);
  until code = 0;
  if code = 0 then ans:=i;
end;

{--------------------------------------------------------------------------
{
{ function real_str
{
{ Parameters r: real;      real
{            len: integer; length of string required
{
{ Return     string;
{
{ converts a real into a string
{
{--------------------------------------------------------------------------}
function real_str(r: real; len: integer): string;
  var s,t: string;
      i: integer;
begin
  if r < 0 then
  begin
    real_str:='-'+real_str(-r,len-1);
    exit;
  end;
  str(r:1:20,s);
  if pos('.',s) < len-2 then
  begin
    real_str:=copy(s,1,len);
    if s[1] = '-' then s:=copy(s,2,255);
    if s[1] <> '0' then exit;    s:=copy(s,2,255);
    if s[1] <> '.' then exit;    s:=copy(s,2,255);
    for i:=1 to len-7 do
    begin
      if s[1] <> '0' then exit;
      s:=copy(s,2,255);
    end;
  end;

  str(r:len+1,s);
  if s[1] = ' ' then s:=copy(s,2,255);
  real_str:=s;
end;

{--------------------------------------------------------------------------
{
{ function real_box
{
{ Parameters cx: integer;            topleft corner of box
{            cy: integer;            topleft corner of box
{            len: integer;           width of box
{            var ans: real;          answer
{            title: string;
{
{ Return     boolean;
{
{ draws a box with a title
{ expects the user to type a real
{ initial value of real is ans
{
{ if return pressed or mouse clicked in box then
{     returns new value of ans
{     returns true
{ if escape pressed or mouse clicked outside box then
{     returns original value of ans
{     returns false
{ if any other char pressed than
{     edits the real
{
{
{--------------------------------------------------------------------------}
function real_box(cx,cy,len: integer; var ans: real; title: string):
  boolean;
  var s: string;
      i: real;
      code: integer;
begin
  repeat
    s:=real_str(ans,len-4);
    real_box:=string_box(cx,cy,len,s,title);
    val(s,i,code);
  until code = 0;
  if code = 0 then ans:=i;
end;

{--------------------------------------------------------------------------
{
{ procedure push_Help_Page
{
{ Parameters h: integer;
{
{ Globals   Help_Page
{
{ pushes h onto the help-page stack
{ h becomes the current help page
{
{--------------------------------------------------------------------------}
procedure push_Help_Page(h: integer);
begin
  move(Help_Page[1],Help_Page[2],sizeof(Help_Page)-2);
  Help_Page[1]:=h;
end;

{--------------------------------------------------------------------------
{
{ procedure pop_Help_Page;
{
{ Parameters
{
{ Globals   Help_Page
{
{ pops the current help page
{
{--------------------------------------------------------------------------}
procedure pop_Help_Page;
begin
  move(Help_Page[2],Help_Page[1],sizeof(Help_Page)-2);
end;

{--------------------------------------------------------------------------
{
{ procedure Help_screen;
{
{ Parameters
{
{ Globals   Help_Page
{           HelpFile
{
{ shows the current help page from the HelpFile file
{
{--------------------------------------------------------------------------}
procedure Help_screen;
  const sx : integer = 9;
        sy : integer = 3;
        len = 55;
        hgt = 18;
        maxlink = 20;
  var cmd: char;
      f: text;
      thispage,findpage,helppage,i,j,k,h,nlink: integer;
      pad,s2: string[len];
      s: string;
      buf: buf_array_ptr;
      ok,lastpage: boolean;
      link: array [1..maxlink] of record x,y,l,p: integer; end;
  label error;
  function startpage(s: string): boolean;
  begin
    startpage:=copy(s,length(s)-7,255) = 'HELPPAGE';
  end;
begin
  HelpPage:=Help_Page[1];
  make_box(sx,sy,len+1,hgt,' Help ',buf);
  str(helppage,s); writeat(sx+3,sy+hgt+1,in_box,s);
  ok:=false;
  assign(f,HelpFile);  if IOresult <> 0 then goto error;
  reset(f);            if IOresult <> 0 then goto error;
  readln(f,s);
  thispage:=0;
  findpage:=1;
  fillchar(pad,sizeof(pad),' ');
  pad[0]:=char(len);

  if not startpage(s) then goto error;
  cmd:=' ';
  while (not eof(f)) and (cmd <> Esc) do
  begin
    while not startpage(s) and not eof(f) do
      readln(f,s);
    lastpage:=copy(s,1,4) = 'LAST';

    readln(f,h);
    if h = helppage then inc(thispage);
    nlink:=0;
    readln(f,s);
    if (h = helppage) and (thispage = findpage) then
    begin
      str(helppage,s2); writeat(sx+3,sy+hgt+1,in_box,s2+'ÍÍÍ');
      writeat(sx+len-27,sy,in_box,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
      writeat(sx+len+1-length(s)-4,sy,in_box,' '+s+' ');
      writeat(sx+len-27,sy+hgt+1,in_box,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
      if not lastpage then
        writeat(sx+len-8,sy+hgt+1,in_box,' PgDn ');
      if findpage > 1 then
        writeat(sx+len-13,sy+hgt+1,in_box,' PgUp ');
      ok:=true;
    end else
      writeat(sx+len-27,sy+hgt+1,in_box,' Reading File - please wait ');
    for i:=1 to hgt do
    begin
      if not (startpage(s) or eof(f)) then readln(f,s);

      if (h = helppage) and (thispage = findpage) then
      begin
        while pos('`',s) <> 0 do
        begin
          inc(nlink);
          with link[nlink] do
          begin
            x:=pos('`',s);
            y:=i;
            delete(s,x,1);
            k:=pos('`',s);
            val(copy(s,x,k-x),p,l);
            delete(s,x,k-x+1);
            k:=pos('`',s);
            l:=k-x;
            if l < 0 then l:=0;
            delete(s,k,1);
          end;
        end;
        s2:=s;
        if startpage(s2) then s2:='';
        s2:=s2+pad;
        writeat(sx+2,sy+i,in_box,s2);
      end;
    end;

    if (h = helppage) and (thispage = findpage) then
    begin
      k:=1;
      repeat
        for i:=1 to nlink do
        with link[i] do
        begin
          for j:=sx+x+1 to sx+x+l do
            if i = k then
              ScreenPtr^[y+3,j].st:=select else
              ScreenPtr^[y+3,j].st:=normal;
        end;
        cmd:=getbigkey;
        case cmd of
          CR:      if nlink > 0 then
                   begin
                     findpage:=1;
                     helppage:=link[k].p;
                     close(f);            if IOresult <> 0 then goto error;
                     assign(f,HelpFile);  if IOresult <> 0 then goto error;
                     reset(f);            if IOresult <> 0 then goto error;
                     readln(f,s);
                     thispage:=0;
                     cmd:=Page_up;
                   end;
          Down,Right: if nlink > 0 then k:=k mod nlink +1;
          Up,Left: if nlink > 0 then k:=(k+2*nlink-2) mod nlink +1;
          Page_dn: if lastpage then
                     cmd:=#0 else
                     inc(findpage);
          Page_up: if findpage = 1 then
                     cmd:=#0 else
                   begin
                     dec(findpage);
                     close(f);            if IOresult <> 0 then goto error;
                     assign(f,HelpFile);  if IOresult <> 0 then goto error;
                     reset(f);            if IOresult <> 0 then goto error;
                     readln(f,s);
                     thispage:=0;
                   end;
        end;
      until cmd in [Esc,Page_dn,Page_up];
    end;
  end;
  for i:=0 to 1 do
  if (cmd <> Esc) and (helppage = 0) then
  begin
    writeat(sx+39,sy,in_box,'ÍÍÍÍ ASCII Codes Í');
    writeat(sx+len-27,sy+hgt+1,in_box,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
    writeat(sx+1,sy+1,in_box,pad);
    for k:=0 to 15 do
      for j:=0 to 7 do
      begin
        str(i*128+j*16+k:4,s);
        writeat(sx+j*7+1,sy+k+2,in_box,s+' '+chr(i*128+j*16+k)+' ');
      end;
    cmd:=getbigkey;
  end;
  if not ok then
  begin
    writeat(sx+len-27,sy+hgt+1,in_box,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
    writeat(sx+2,sy+2,in_box,'No help found for this item');
    cmd:=getbigkey;
  end;
  delete_box(buf);
  close(f);            if IOresult <> 0 then ;
  exit;


  error:
    writeat(sx+2,sy+2,in_box,'Error while reading:');
    writeat(sx+4,sy+3,in_box,HelpFile);
    cmd:=getbigkey;
    delete_box(buf);

    close(f);            if IOresult <> 0 then ;
end;

{--------------------------------------------------------------------------
{
{ Initialisation
{
{ Globals   Help_Page
{           autohelp
{           mouse_button
{
{ initialises the menu package
{
{ selects screen colours depending on the type of screen
{ assumes the help file is in the current directory the directory can (then
{   be changed and the help file won't be lost)
{ initialises the mouse
{
{--------------------------------------------------------------------------}
var s: string;
    b: word;

begin
  if DisplayType = HercMono then
  begin        { Hercules screen }
    in_box:=112; { Black On White}
    entry := 10; { bright }
    select:=  2; { dim }
    frame :=112; { Black On White}
    normal:= 10; { bright }
{  10; { bright }
{   2; { dim }
{ 112; { Black On White}
{   1; { dim underlined }
  end else
  if videoMode in [0,2,6,7] then
  begin        { monochrome screen }
  end else
  begin            { color screen }
    in_box:=15+4*16; { white on red }
    entry := 3+4*16; { cyan on red }
    select:=2+1*16;  { green on blue }
    frame :=     15; { white on black }
    normal:=yellow;  { yellow on black }
  end;

  getdir(0,s);
  if s <> '\' then s:=s+'\';
  HelpFile:=s+HelpFile;
  AutoHelp:=true;
  fillchar(Help_Page,sizeof(Help_Page),#0);

  if screen_mouse(b) then hide_mouse;
  mouse_button:=idle;
end.


{--------------------------------------------------------------------------
{ enhancements
{
{ bar menu anywhere and any size
{ check that the mouse works properly with stringbox and yesorno
{ if you call menu_item (etc.) after exec_menu then it hides the menu, adds
{   the new item and re-displays it
{ make mouse work with help pages
{
{--------------------------------------------------------------------------}


žŸ ¡£¤¥¦§¨ª©G«¬­®¯°±²ÛÜ

Ä ³ ¿ À Ú Ù Â Á ´ Ã Å
Í º » È É ¼ Ë Ê ¹ Ì Î
µ ¶ · ¸ ½ ¾ Æ Ç Ï Ð Ñ Ò Ó Ô Õ Ö × Ø

function mouseat(x,y,c: integer; s: string): boolean;
      repeat
        if mouse_exists then
        begin
          show_mouse_moved;
          mouse_button:=mouse_mode(mouse_x,mouse_y,mx,my);
        end;
      until keyavail or (mouse_button = clicked);

