(*
 * -------------------------------------------------------------------------
 *
 *	:Program.	ObjektDemo
 *	:Contents.	Demonstration der IntuitionObjekte
 *	:Author.	Reiner Nix
 *	:Address.	Geranienhof 2, 5000 Köln 71 Seeberg
 *	:Copyright.	Public Domain
 *	:Language.	Modula-2
 *	:Translator.	M2Amiga A-L V3.3d
 *	:History.	V1.0	21.11.90
 *	:Imports.	IntuitionTools		siehe diese Diskette
 *	:Imports.	Amigagraphik		siehe diese Diskette
 *	:Imports.	IntuitionObjekte	siehe diese Diskette
 *
 * -------------------------------------------------------------------------
 *)
MODULE ObjektDemo;

FROM	SYSTEM			IMPORT	ADR;
FROM	Arts			IMPORT	Assert, TermProcedure;
FROM	Exec			IMPORT	WaitPort, GetMsg, ReplyMsg;
FROM	Intuition		IMPORT	NewWindow,
					IntuiMessage, IntuiMessagePtr,
					IDCMPFlags, IDCMPFlagSet,
					WindowFlags, WindowFlagSet,
					ScreenFlags, ScreenFlagSet,
					WindowPtr;
FROM	IntuitionTools		IMPORT	initNewWindow;
FROM	AmigaGraphik		IMPORT	OpenWindow, CloseWindow, UseWindow,
					NewWindowSize, Move,
					WriteString, WriteCard;
FROM	IntuitionObjekte	IMPORT	ObjektEreignis, ObjektTyp,
					ObjektPtr,
					verarbeiteNachricht, aenderInfoSatz,
					frageHPosition, frageVPosition,
					setzeHPosition, setzeVPosition,
					frageObjektNr, findeObjekt,
					EingabeOk, erzeugeBooleanObjekt,
					erzeugeHPropObjekt, erzeugeVPropObjekt,
					erzeugeTextObjekt, erzeugeRealObjekt,
					verbindeObjekte, loescheAlleObjekte;


CONST	keinFenster		="AusgabeFenster ist nicht zu öffnen!";
	Programmname		="ObjektDemo";

	BoolWechselID		=1;
	BoolMeldenID		=2;
	BoolWiederholenID	=3;
	HorizontalID		=4;
	VertikalID		=5;
	TextID			=6;
	ZahlID			=7;

	maxX			=MAX (CARDINAL) DIV 70;
	maxY			=MAX (CARDINAL) DIV 30;

VAR	Programmende	:BOOLEAN;
	Fenster		:WindowPtr;
	NachrichtPtr	:IntuiMessagePtr;
	Nachricht	:IntuiMessage;

	Text		:ARRAY [0..51] OF CHAR;
	Zahl		:REAL;
	X, Y		:CARDINAL;


PROCEDURE oeffneFenster		(VAR Fenster		:WindowPtr);

VAR	neuFenster	:NewWindow;

BEGIN
initNewWindow (neuFenster,
	       0,12, 640,244,
	       0,1,
	       IDCMPFlagSet {closeWindow, newSize, sizeVerify},
	       WindowFlagSet {windowSizing, windowDrag, windowDepth,
	                      noCareRefresh, windowClose},
	       NIL,				(* firstGadget *)
	       NIL,				(* Checkmark *)
	       ADR (Programmname),
	       NIL,				(* Screen *)
	       NIL,				(* Bitmap *)
	       50, 25, -1,-1,
	       ScreenFlagSet {wbenchScreen});
Fenster := OpenWindow (neuFenster);
Assert (Fenster # NIL, ADR (keinFenster))
END oeffneFenster;


PROCEDURE schreibeAusgabe;

BEGIN
UseWindow (Fenster);
Move (20, 200); WriteString ("Horizontalwert  ="); WriteCard (X,5);
Move (20, 210); WriteString ("Vertikalwert    ="); WriteCard (Y,5)
END schreibeAusgabe;


PROCEDURE WechselAktion		(    Ereignis		:ObjektEreignis;
				     objekt		:ObjektPtr);

BEGIN
IF Ereignis = An THEN
  aenderInfoSatz (objekt,"     Aua!    ")
ELSE
  aenderInfoSatz (objekt," So ist gut. ")
  END
END WechselAktion;


PROCEDURE MeldeAktion		(    Ereignis		:ObjektEreignis;
				     objekt		:ObjektPtr);

BEGIN
IF X <= MAX (CARDINAL)-500 THEN
  INC (X, 500);
  setzeHPosition (findeObjekt (Fenster, HorizontalID), X, maxX);
  schreibeAusgabe
  END
END MeldeAktion;


PROCEDURE WiederholungsAktion	(    Ereignis		:ObjektEreignis;
				     objekt		:ObjektPtr);

BEGIN
IF Y >= MIN (CARDINAL)+500 THEN
  DEC (Y, 500);
  setzeVPosition (findeObjekt (Fenster, VertikalID), Y, maxY);
  schreibeAusgabe
  END;
END WiederholungsAktion;


PROCEDURE PropAktion		(    Ereignis		:ObjektEreignis;
				     objekt		:ObjektPtr);

BEGIN
CASE frageObjektNr (objekt) OF
| HorizontalID	:X := frageHPosition (objekt)
| VertikalID	:Y := frageVPosition (objekt)
ELSE
  END;
schreibeAusgabe
END PropAktion;


PROCEDURE pruefeZahl		(    objekt		:ObjektPtr) :BOOLEAN;

BEGIN
UseWindow (Fenster);
Move (20, 225);
IF (7.0 < Zahl) AND (Zahl < 7.77E2) THEN
  WriteString ("                                                 ");
  RETURN TRUE
ELSE
  WriteString ("Bitte geben Sie eine Zahl zwischen 7 und 777 ein.");
  RETURN FALSE
  END
END pruefeZahl;


PROCEDURE erstelleObjekte;

BEGIN
Text := "Hallo";
Zahl := 3.1415926;
X := 0;
Y := 20000;
erzeugeBooleanObjekt (Fenster, 100, 50, " Drück mich  ", BoolWechselID,
                      wechseln, WechselAktion);
erzeugeBooleanObjekt (Fenster, 100, 70, " Melden      ", BoolMeldenID,
                      melden, MeldeAktion);
erzeugeBooleanObjekt (Fenster, 100, 90, " Wiederholen ", BoolWiederholenID,
                      wiederholen, WiederholungsAktion);

erzeugeHPropObjekt (Fenster, 100,100, 104,8, X,maxX, HorizontalID, wiederholen,
		    PropAktion);
erzeugeVPropObjekt (Fenster, 80, 50, 16,50, Y,maxY, VertikalID, wiederholen,
		    PropAktion);

erzeugeTextObjekt (Fenster, 400, 50, "Textobjekt :", TextID, -150,0,
                   20, 50, EingabeOk, Text);
erzeugeRealObjekt (Fenster, 400, 70, "Zahlobjekt :", ZahlID, -150,0,
                   12,2, TRUE, pruefeZahl, Zahl);
verbindeObjekte (Fenster, TextID, -1, ZahlID, -1, -1);
verbindeObjekte (Fenster, ZahlID, TextID, -1, -1, -1)
END erstelleObjekte;


PROCEDURE stopObjektDemo;

BEGIN
loescheAlleObjekte (Fenster);
CloseWindow (Fenster)
END stopObjektDemo;


(* MODULE ObjektDemo *)
BEGIN
Fenster := NIL;
TermProcedure (stopObjektDemo);

Programmende := FALSE;
oeffneFenster (Fenster);
erstelleObjekte;

WHILE NOT Programmende DO
  WaitPort (Fenster^.userPort);
    REPEAT
    NachrichtPtr := GetMsg (Fenster^.userPort);
    IF NachrichtPtr # NIL THEN
      Nachricht := NachrichtPtr^;
      ReplyMsg (NachrichtPtr);
      verarbeiteNachricht (Fenster, Nachricht);
      IF    closeWindow IN Nachricht.class THEN
        Programmende := TRUE
      ELSIF newSize IN Nachricht.class THEN
        NewWindowSize;
        schreibeAusgabe;
      ELSIF sizeVerify IN Nachricht.class THEN
        (* keine Aktion, Intuition wartet bis die Nachricht zurückgegeben ist *)
        (* ändert erst dann die Fenstergröße und gibt die Nachricht newSize,  *)
        (* so bleiben während einer Programmausgabe die Fenstermaße konstant. *)
        END
      END
    UNTIL (NachrichtPtr = NIL) OR Programmende
  END
END ObjektDemo.