Intuition window goes OOP(ish)

A long while ago, someone on the aros-exec forums suggested to use some (more) OOP to create f.i. native Intuition Windows.

Although i already knew it is possible to do, i never managed to create a example for those wanting to have a look. So here we go :-)

Do note however, that the code showed herein is not complete, nor does it show good programing practice (even far from that). It is merely shown as a possible solution to the problem. Much more abstraction is required in order to be able to make practical use of these examples.

The beginning

Let's start out with a simple intuition window example, this example was taken from Thomas Rapp.

program SimpleWindow;

{$MODE OBJFPC}{$H+}

Uses
  Exec, AGraphics, Intuition, InputEvent, Utility;


Function AsTag(tag: LongWord): LongInt; inline;
begin
  Result := LongInt(tag);
end;

  
//*-------------------------------------------------------------------------*/
//*                                                                         */
//*-------------------------------------------------------------------------*/

procedure print_text(rp: PRastPort; x: LongInt; y: LongInt; txt: PChar);
begin
  GfxMove(rp, x, y);
  SetABPenDrMd(rp, 1, 0, JAM2);
  GfxText(rp, txt, strlen(txt));
  ClearEOL(rp);
end;


//*-------------------------------------------------------------------------*/
//* Main routine                                                            */
//*-------------------------------------------------------------------------*/

function  main: integer;
var
  win       : PWindow;
  cont      : Boolean;
  msg       : PIntuiMessage;
  buffer    : String[80];
begin
  win := OpenWindowTags( nil,
  [
    AsTag(WA_Left)         , 100,
    AsTag(WA_Top)          , 100,
    AsTag(WA_Width)        , 250,
    AsTag(WA_Height)       , 150,
    AsTag(WA_Flags)        , AsTag(WFLG_CLOSEGADGET or WFLG_DRAGBAR or WFLG_DEPTHGADGET or WFLG_ACTIVATE or WFLG_GIMMEZEROZERO or WFLG_NOCAREREFRESH or WFLG_RMBTRAP or WFLG_REPORTMOUSE),
    AsTag(WA_IDCMP)        , AsTag(IDCMP_CLOSEWINDOW or IDCMP_MOUSEMOVE or IDCMP_MOUSEBUTTONS),
    TAG_END
  ]);
  
  if Assigned(win) then
  begin
    cont := TRUE;

    while (cont) do
    begin
      WaitPort(win^.UserPort);
      while true do
      begin
        msg := PIntuiMessage(GetMsg(win^.UserPort));
        if not Assigned(msg) then break;
      
        case (msg^.IClass) of
          IDCMP_CLOSEWINDOW:
            cont := FALSE;
          IDCMP_MOUSEMOVE:
          begin
            WriteStr(buffer, 'Mouseposition: x=', msg^.MouseX, ' y=', msg^.MouseY, #0);
            print_text(win^.RPort, 10, 30, @buffer[1]);
          end;
          IDCMP_MOUSEBUTTONS:
          case (msg^.Code) of
            IECODE_LBUTTON                      : print_text(win^.RPort, 10, 60, 'Left mousebutton pressed');
            IECODE_LBUTTON or IECODE_UP_PREFIX  : print_text(win^.RPort, 10, 60, 'Left mousebutton released');
            IECODE_RBUTTON                      : print_text(win^.RPort, 10, 90, 'Right mousebutton pressed');
            IECODE_RBUTTON or IECODE_UP_PREFIX  : print_text(win^.RPort, 10, 90, 'Right mousebutton released');
          end;
        end; // case
        ReplyMsg(pMessage(msg));
      end;
    end; // while
    CloseWindow(win);
  end;

  result := (0);
end;

begin
  ExitCode := Main;
end.

The code itself doesn't do anything difficult to understand. It opens a Intuition Window and reacts to some IDCMP messages and based on those messages give some feedback to the user.

We need a class

Now that we have seen what properties are part of the window we can create a class based on that. We put the class in a separate unit.

unit IntWinClass;

{$MODE OBJFPC}{$H+}

interface

uses
  Intuition;

type
  TIntuitionWindowClass = class
   private
    FHandle : PWindow;
    FLeft   : LongInt;
    FTop    : LongInt;
    FWidth  : LongInt;
    FHeight : LongInt;
    FTitle  : String;
   protected
   public
    Constructor Create;  
    Destructor  Destroy; override;
   public
    procedure Open;
    procedure Close;
   public
    property Left  : LongInt read FLeft   write FLeft;
    property Top   : LongInt read FTop    write FTop;
    property Width : LongInt read FWidth  write FWidth;
    property Height: LongInt read FHeight write FHeight;
    property Title : String  read FTitle  write FTitle;
    property Handle : PWindow read FHandle;
  end;


implementation

uses
  SysUtils;


Function AsTag(tag: LongWord): LongInt; inline;
begin
  Result := LongInt(tag);
end;


procedure error(Const msg : string);  
begin  
  raise exception.create(Msg) at  
    get_caller_addr(get_frame),  
    get_caller_frame(get_frame);  
end;  


Constructor TIntuitionWindowClass.Create;
begin
  Inherited;

  FHandle := nil;
  FLeft   := 10;
  FTop    := 10;
  FHeight := 30;
  FWidth  := 30;
  FTitle  := '';
end;


Destructor TIntuitionWindowClass.Destroy;
begin
  inherited;
end;


procedure TIntuitionWindowClass.Open;
begin
  FHandle := OpenWindowTags( nil,
  [
    AsTag(WA_Left)        , FLeft,
    AsTag(WA_Top)         , FTop,
    AsTag(WA_Width)       , FWidth,
    AsTag(WA_Height)      , FHeight,
    AsTag(WA_Title)       , PChar(FTitle),
    // Non use settable flags (for now)
    AsTag(WA_Flags)       , AsTag(WFLG_CLOSEGADGET or WFLG_DRAGBAR or WFLG_DEPTHGADGET or WFLG_ACTIVATE or WFLG_GIMMEZEROZERO or WFLG_NOCAREREFRESH or WFLG_RMBTRAP or WFLG_REPORTMOUSE),
    AsTag(WA_IDCMP)       , AsTag(IDCMP_CLOSEWINDOW or IDCMP_MOUSEMOVE or IDCMP_MOUSEBUTTONS),
    TAG_END
  ]);
  if not Assigned(FHandle) then Error('Unable to Open Window');
end;


procedure TIntuitionWindowClass.Close;
begin
  if Assigned(FHandle) 
  then CloseWindow(FHandle)
  else Error('Unable to Close Window because the handle is invalid');
end;

end.

We've added a constructor (Create) which initializes some default values for the FHandle and private window dimension variables as well as clear the private title variable.

Other then that we've added two methods, one to Open the Intuition Window and one to Close the Intuition Window and added code that actually perform these actions.

Now, we're going to make use of this new class and create a new program:

program ClassWindow;

{$MODE OBJFPC}{$H+}

uses
  IntWinClass, Exec, AGraphics, Intuition, InputEvent;


//*-------------------------------------------------------------------------*/
//*                                                                         */
//*-------------------------------------------------------------------------*/

procedure print_text(rp: PRastPort; x: LongInt; y: LongInt; txt: PChar);
begin
  GfxMove(rp, x, y);
  SetABPenDrMd(rp, 1, 0, JAM2);
  GfxText(rp, txt, strlen(txt));
  ClearEOL(rp);
end;


//*-------------------------------------------------------------------------*/
//* Main routine                                                            */
//*-------------------------------------------------------------------------*/

function  main: integer;
var
  Window1   : TIntuitionWindowClass;
  cont      : Boolean;
  msg       : PIntuiMessage;
  buffer    : String[80];
begin
  Window1 := TIntuitionWindowClass.Create;
  Window1.Left   := 10;
  Window1.Top    := 20;
  Window1.Height := 200;
  Window1.Width  := 320;
  Window1.Title  := 'This is window 1';
  Window1.Open;

  WaitPort(Window1.Handle^.UserPort);

  cont := TRUE;

  while (cont) do
  begin
    while true do
    begin
      msg := PIntuiMessage(GetMsg(Window1.Handle^.UserPort));
      if not Assigned(msg) then break;
      
      case (msg^.IClass) of
        IDCMP_CLOSEWINDOW:
          cont := FALSE;
        IDCMP_MOUSEMOVE:
        begin
          WriteStr(buffer, 'Mouseposition: x=', msg^.MouseX, ' y=', msg^.MouseY, #0);
          print_text(Window1.Handle^.RPort, 10, 30, @buffer[1]);
        end;
        IDCMP_MOUSEBUTTONS:
        case (msg^.Code) of
          IECODE_LBUTTON                      : print_text(Window1.Handle^.RPort, 10, 60, 'Left mousebutton pressed');
          IECODE_LBUTTON or IECODE_UP_PREFIX  : print_text(Window1.Handle^.RPort, 10, 60, 'Left mousebutton released');
          IECODE_RBUTTON                      : print_text(Window1.Handle^.RPort, 10, 90, 'Right mousebutton pressed');
          IECODE_RBUTTON or IECODE_UP_PREFIX  : print_text(Window1.Handle^.RPort, 10, 90, 'Right mousebutton released');
        end;
      end; // case
      ReplyMsg(pMessage(msg));
    end;
  end;
  Window1.Close;
  Window1.Free;

  result := (0);
end;


begin
  ExitCode := Main;
end.

Also here, no real rocket science. We have to take care of Creating and Destroying our class and we've replaced the 'normal' code that opened and closed the intuition Window by calling the Methods that we've just implemented. The message handling itself is still part of our main program.