[net.micro.amiga] TDI Modula-2: Examples of Intuition

OC.TREI@CU20B.COLUMBIA.EDU (04/13/86)

From: R Bielak <R-BIELAK@CUTC20>

(Peter, please post this on the info-amiga and/or info-modula-2 board. Thanks)

Below is an example of using Intuition frlom Modula-2. The program opens
a window, waits for a user to click on close gadget, and then closes
the window. Contrary to rumors Window.CloseWindow does work!!!!

On the other hand Task.Wait and Ports.GetMsg didn't. Along with
the Window program this message includes the module Fixes which
contains correct code for Wait and GetMsg. Make sure you compile that
first, before trying to use WIndows.

That's it for now, more examples forthcoming in the future....Richie Bielak.


----------WINDOWS.MOD-----------------
MODULE Window;

(* This module is an attempt at using Intuition from Modula-2.
   
   Note: "Wait" function must be imported frlom Fixes, instead of
   Tasks. The one in Tasks does not work.

   Created: 4/3/86 by Richard Bielak
   
   Modified:

*)
FROM SYSTEM    IMPORT ADR, BYTE, ADDRESS, SETREG;
FROM Intuition IMPORT
     IntuitionName, IntuitionBase, Window, WindowFlags, NewWindow,
     IDCMPFlags, IDCMPFlagsSet, WindowFlagsSet, WindowPtr;
FROM Libraries IMPORT OpenLibrary;
FROM Windows   IMPORT OpenWindow, SmartRefresh;
FROM Screens   IMPORT WBenchScreen;
FROM Terminal  IMPORT WriteString, WriteLn;
FROM Tasks     IMPORT SignalSet;
FROM Fixes     IMPORT Wait;

(* Note this IMPORT statement is necessary, so that we can use 
   "Windows.CloseWindow" in the last line of the program.
   Otherwise we have name conflict, as one of the IDCMPFlags is
   also called "CloseWindow"
*)
IMPORT Windows;

CONST
  IntuitionZvv = 29;

VAR
  NULL : ADDRESS;
  MyWindow : NewWindow;
  MyWindowName : ARRAY [0..20] OF CHAR;
  wp : WindowPtr;
  Signal : SignalSet;
    
PROCEDURE InitWindow (VAR w : NewWindow);
  BEGIN
    MyWindowName := "Simple Window";
    WITH w DO
      LeftEdge := 20; TopEdge := 20; Width := 300; Height := 100;
      DetailPen := BYTE (0);
      BlockPen := BYTE (1);
      Title := ADR (MyWindowName);
      Flags := WindowFlagsSet {Activate, WindowClose, WindowDrag,
               WindowDepth, WindowSizing, NoCareRefresh} + SmartRefresh;
      IDCMPFlags := IDCMPFlagsSet{CloseWindow};
      Type := CARDINAL(WBenchScreen);
      CheckMark := NULL;
      FirstGadget := NULL;;
      Screen := NULL;
      BitMap := NULL;
      MinWidth := 10; MinHeight := 10;
      MaxWidth := 640; MaxHeight := 200;
    END
  END InitWindow;

BEGIN
  (* Note "NIL" is not equal to ADDRESS (0) !!!! *)
  NULL := ADDRESS (0);
  (* Open intuition library *)
  IntuitionBase := OpenLibrary (IntuitionName,IntuitionRev);
  IF IntuitionBase = 0 THEN
    WriteString ("Open intuition failed"); WriteLn;
  END;
  
  (* Initialize the New window structure *)
  InitWindow (MyWindow);

  (* Now open the window *)
  wp := OpenWindow (MyWindow);

  (* Initialize the signal Mask *)
  Signal := SignalSet {};
  (* Convert signal number to a mask *)
  INCL (Signal, CARDINAL (wp^.UserPort^.mpSigBit));
  (* Wait for the signal *)
  Signal := Wait (Signal);

  (* Close the window *)
  Windows.CloseWindow (wp^);

END Window.
----------FIXES.DEF------------
(* This module implements fixes to some of TDI's interfaces 
   to intuition routines:

   Created: 4/9/86 by TDI

   Modified:
   
*)

DEFINITION MODULE Fixes;

 FROM Ports IMPORT MsgPortPtr, MessagePtr;
 FROM Tasks IMPORT SignalSet;

 PROCEDURE GetMsg (port: MsgPortPtr): MessagePtr;
 PROCEDURE Wait (sig: SignalSet): SignalSet;
END Fixes.
----------FIXES.MOD----------
(*
	This module implements fixes to some of TDI's
	interface routines to ROM Kernel.

	Created: 4/9/86 by TDI

	Modified:

*)
IMPLEMENTATION MODULE Fixes;
 FROM SYSTEM IMPORT CODE, SETREG, REGISTER, ADDRESS;
 FROM Tasks IMPORT SignalSet;
 FROM Ports IMPORT MsgPortPtr, MessagePtr;

 CONST
   AbsExecBase = 4;
 VAR
   ExecBase [AbsExecBase]: ADDRESS;

 PROCEDURE GetMsg (port: MsgPortPtr): MessagePtr;
 BEGIN
   CODE (2F0EH);
   SETREG (8, port); SETREG (14, ExecBase);
   CODE (4EAEH, (-30-342), 2C5FH);
   RETURN MessagePtr (REGISTER (0));
 END GetMsg;

 PROCEDURE Wait (sig: SignalSet): SignalSet;
 BEGIN
   CODE (2F0EH);
   SETREG (0, sig); SETREG (14, ExecBase);
   CODE (4EAEH, (-30-288),2C5FH);
   RETURN SignalSet (REGISTER (0));
 END Wait;

END Fixes.
---------that's it----------

Richie Bielak r-bielak@cutc20, CIS 75716,352.
-------