program gem_demo;
 
const 
  {$I GEMCONST.PAS}
 
type 
  {$I GEMTYPE.PAS}

var mptr: menu_ptr;


  {$I GEMSUBS.PAS}

 
procedure mache_menue (var mptr: menu_ptr);
var mitem, mtitl1, mtitl2: integer;
begin
  mptr   := new_menu (10,' kleine Demo I ');
  mtitl1 := add_mtitle (mptr, ' Funktion ');
  mtitl2 := add_mtitle (mptr, ' Programmende ');
  mitem  := add_mitem (mptr, mtitl1,' Growbox    G ');
  mitem  := add_mitem (mptr, mtitl1,' Rubberbox  R ');
  mitem  := add_mitem (mptr, mtitl2,' Ende        E ');
end;

procedure info;
var was: integer;
begin
  was := do_alert (concat ('[0][Ich bin ein kleines Demo-|',
                           'Programm.| |Ich hoffe, daž Sie',
                           ' durch mich |einiges besser ver',
                           'stehen!][Na sch”n]'),1);
end; 


procedure do_rubberbox;
var was, x, y, b, h, dummy: integer;
    nachricht: message_buffer;
begin
  was := get_event (e_button,1,1,1,0,false,0,0,0,0,false,0,0,0,0,
                    nachricht,dummy,dummy,dummy,x,y,dummy);
  rubberbox (x, y, 8, 16, b, h); 
  paint_color (white);
  hide_mouse;
  paint_rect (x, y, b, h);
  show_mouse;
end;

procedure kontrolle;
var was, dummy, taste : integer;
    nachricht : message_buffer;
    ende      : boolean;
    y         : char;    
begin
  ende := false;
  repeat
    was := get_event (e_message | e_keyboard, 0,0,0,0,false,0,0,0,0,false,0,0,0,0,
                      nachricht, taste, dummy,dummy,dummy,dummy,dummy);
        if was = was&e_keyboard then begin
           y := chr(taste mod 256);
        case y of
          'I','i' : info;
          'G','g' : growbox (150,30,10,10,100,100,100,100); 
          'R','r' : do_rubberbox;
          'E','e' : ende := true;
       otherwise: writeln (taste, chr(taste mod 256));
       end;
    end
    else begin
      case nachricht[4] of
          8: info;
         18: growbox (150,30,10,10,100,100,100,100); 
         19: do_rubberbox;
         20: ende := true;
      otherwise : writeln (nachricht[4],'#');               
      end;
      menu_normal (mptr, nachricht[3]);   
    end; 
  until ende;
end;

begin
 if init_gem >= 0 then begin
    mache_menue (mptr);
    draw_menu (mptr);
    kontrolle;
    erase_menu (mptr);
    delete_menu (mptr);
    exit_gem;
  end;
end.
