Fresh Fish 9/FreshFishVol9-CD1.bin/useful/dev/obero/oberon-a/source/projectoberon/amigasupport.mod

Text File | 1995-02-07 | 5.4 KB | 203 lines

(*************************************************************************

     $RCSfile: AmigaSupport.mod $
  Description: Amiga-specific support for Project Oberon modules.

   Created by: fjc (Frank Copeland)
    $Revision: 1.1 $
      $Author: fjc $
        $Date: 1995/02/07 20:22:47 $

  Copyright © 1995, Frank Copeland.
  This file is part of the Oberon-A Library.
  See Oberon-A.doc for conditions of use and distribution.

*************************************************************************)

<*STANDARD-*> <* MAIN-*>

MODULE AmigaSupport;

IMPORT
  SYS := SYSTEM, Kernel, Errors, s := Sets, e := Exec, es := ExecSupport,
  u := Utility, gfx := Graphics, i := Intuition, gt := GadTools,
  ASL, rt := ReqTools, iu := IntuiUtil;

(*------------------------------------*)
VAR
  scr -: i.ScreenPtr;
  win -: i.WindowPtr;
  W -, H -: INTEGER;

  KeyProc*,
  MouseProc*,
  TickProc*
    : PROCEDURE (msg : i.IntuiMessagePtr);

  oldRegion : gfx.RegionPtr; (* for clipping *)


(*------------------------------------*)
CONST
  pubScreenName = "";
  scrTitle = "Display inactive";
  winTitle = "Display for Project Oberon modules";
  idcmp = {i.vanillaKey, i.mouseButtons, i.intuiTicks};


(*------------------------------------*)
PROCEDURE OpenScreen ();

  VAR
    screenModeID : LONGINT;
    pubScreen : i.ScreenPtr;
    screenDrawInfo : i.DrawInfoPtr;

BEGIN (* OpenScreen *)
  pubScreen := i.LockPubScreen (pubScreenName);
  IF pubScreen # NIL THEN
    (*
    ** Get the DrawInfo structure from the locked screen
    ** This returns pen, depth and font info.
    *)
    screenDrawInfo := i.GetScreenDrawInfo (pubScreen);
    IF screenDrawInfo # NIL THEN
      screenModeID := gfx.GetVPModeID (SYS.ADR (pubScreen.viewPort));
      IF screenModeID # gfx.invalidID THEN
        (*
        ** screenModeID may now be used in a call to
        ** OpenScreenTags () with the tag saDisplayID
        *)
        scr := i.OpenScreenTagsA ( NIL,
            i.saWidth,       pubScreen.width,
            i.saHeight,      pubScreen.height,
            i.saDepth,       screenDrawInfo.depth,
            i.saOverscan,    i.oScanText,
            i.saAutoScroll,  i.LTRUE,
            i.saFullPalette, i.LTRUE,
            i.saPens,        screenDrawInfo.pens,
            i.saSysFont,     1,
            i.saDisplayID,   screenModeID,
            i.saTitle,       SYS.ADR (scrTitle),
            u.end );
        IF scr # NIL THEN (*
                          ** Free the drawinfo an public screen as we don't
                          ** need them any more. We now have our own screen.
                          *)
          i.FreeScreenDrawInfo (pubScreen, screenDrawInfo);
          screenDrawInfo := NIL;
          i.UnlockPubScreen (pubScreenName, pubScreen);
          pubScreen := NIL;
        END
      END
    END
  END;
  ASSERT (scr # NIL, Errors.postCondition)
END OpenScreen;


(*------------------------------------*)
PROCEDURE CloseScreen ();
BEGIN (* CloseScreen *)
  IF scr # NIL THEN i.OldCloseScreen (scr); scr := NIL END;
END CloseScreen;


(*------------------------------------*)
PROCEDURE OpenWindow ();
BEGIN (* OpenWindow *)
  win := i.OpenWindowTagsA ( NIL,
      i.waCustomScreen, scr,
      i.waTop,          scr.barHeight + scr.barVBorder,
      i.waHeight,       scr.height - scr.barHeight - scr.barVBorder,
      i.waActivate,     i.LTRUE,
      i.waBorderless,   i.LTRUE,
      i.waBackdrop,     i.LTRUE,
      i.waRMBTrap,      i.LTRUE,
      i.waScreenTitle,  SYS.ADR (winTitle),
      i.waIDCMP,        idcmp,
      u.end );
  ASSERT (win # NIL, Errors.postCondition);
  ASSERT (iu.ClipWindowToBorders (win, oldRegion), Errors.postCondition)
END OpenWindow;


(*------------------------------------*)
PROCEDURE CloseWindow ();
BEGIN (* CloseWindow *)
  IF win # NIL THEN
    iu.UnclipWindow (win, oldRegion); oldRegion := NIL;
    i.CloseWindow (win); win := NIL
  END;
END CloseWindow;


(*------------------------------------*)
PROCEDURE OpenDisplay *;
BEGIN (* OpenDisplay *)
  IF scr = NIL THEN
    OpenScreen();
    OpenWindow();
    W := win.width - win.borderLeft - win.borderRight;
    H := win.height - win.borderTop - win.borderBottom;
  END
END OpenDisplay;


(*------------------------------------*)
PROCEDURE GetNextEvent*;

  VAR
    msg : i.IntuiMessagePtr;
    signals : s.SET32;
    sigBit : SHORTINT;

BEGIN (* GetNextEvent *)
  (* We only have one signal bit, so we do not have to check which
  ** bit broke the Wait().
  *)
  signals := e.Wait ({win.userPort.sigBit});
  LOOP
    msg := SYS.VAL (i.IntuiMessagePtr, e.GetMsg (win.userPort));
    IF msg = NIL THEN EXIT END;
    IF (msg.class = {i.vanillaKey})
       OR (msg.class = {i.rawKey})
    THEN
      IF KeyProc # NIL THEN KeyProc (msg) END;
    ELSIF msg.class = {i.mouseButtons} THEN
      IF MouseProc # NIL THEN MouseProc (msg) END;
    ELSIF msg.class = {i.intuiTicks} THEN
      IF TickProc # NIL THEN TickProc (msg) END;
    END;
    e.ReplyMsg (msg)
  END;
END GetNextEvent;


(*------------------------------------*)
PROCEDURE BeginUpdate*;
BEGIN (* BeginUpdate *)
END BeginUpdate;


(*------------------------------------*)
PROCEDURE EndUpdate*;
BEGIN (* EndUpdate *)
END EndUpdate;


(*------------------------------------*)
PROCEDURE* Close ( VAR rc : LONGINT );
BEGIN (* Close *)
  CloseWindow();
  CloseScreen();
END Close;

(*------------------------------------*)
<*$ClearVars+*>
BEGIN
  Errors.Init;
  ASSERT (gt.base # NIL, 100);
  Kernel.SetCleanup (Close)
END AmigaSupport.