(*
 * --------------------------------------------------------------------------
 * 	:Program.	IntuitionObjekte.mod
 * 	:Contents.	komplexe Intuition-Gadgets mit Unterstützung.
 * 	:Author.	Reiner Nix
 * 	:Adress.	Geranienhof 2, 5000 Köln 71 Seeberg
 * 	:Language.	Modula-2
 * 	:Translator.	M2Amiga AMSoft, Version 3.3d
 * 	:History.	V1.1  (privat)		;nur für ein Fenster
 * 	:History.	V1.2  19.Februar.90	;für mehrere Fenster
 * --------------------------------------------------------------------------
 *)
IMPLEMENTATION MODULE IntuitionObjekte;

FROM	SYSTEM		IMPORT	ADR, ADDRESS, LONGSET, FFP;
FROM	Arts		IMPORT	Assert, TermProcedure;
FROM	Heap		IMPORT	Allocate, Deallocate;
FROM	Conversions	IMPORT	ValToStr, StrToVal;
IMPORT	RealConversions;
IMPORT	LongRealConversions;
IMPORT	FFPConversions;
FROM	Str		IMPORT	Length, Copy, Compare;
IMPORT	Strings;
FROM	Exec		IMPORT	WaitPort, GetMsg, ReplyMsg;
FROM	Dos		IMPORT	Delay;
FROM	InputEvent	IMPORT	Qualifiers, QualifierSet;
FROM	Graphics	IMPORT	jam2,
				DrawModes, DrawModeSet,
				FontStyleSet,
				FontFlags, FontFlagSet,
				TextFontPtr, TextAttrPtr,
				TextAttr;
FROM	Intuition	IMPORT	boolGadget, propGadget, maxBody,
				GadgetFlags, GadgetFlagSet,
				ActivationFlags, ActivationFlagSet,
				IDCMPFlags, IDCMPFlagSet,
				PropInfoFlags, PropInfoFlagSet,
				WindowPtr, IntuiMessagePtr, GadgetPtr,
				IntuiMessage, IntuiText, Gadget,
				Border, PropInfo,
				ModifyIDCMP, AddGadget, RemoveGadget,
				RefreshGList, PrintIText,
				DisplayBeep, NewModifyProp, IntuiTextLength;
FROM	IntuitionTools	IMPORT	initGadget, initIntuiText, initBorder,
				makeBorder, initPropInfo, initTextAttr,
				refreshOneGadget, RawToVanilla;
FROM	AmigaGraphik	IMPORT	OpenFont, CloseFont;


CONST	PfeilOben	= 114C;		(* RawKey  bei  SonderEingabe!	*)
	PfeilUnten	= 115C;
	PfeilRechts	= 116C;
	PfeilLinks	= 117C;
	Loesche		= 177C;
	Zurueck		=  10C;

	maxZSName	=  30;		(* Maximallänge nur zur Vereinfachung *)

	CursorAus	="Cursor nicht eingeschaltet";
	verbindenFehler ="verbindeObjekte NUR bei eingeben";
	NummerDoppelt	="ObjektNummer schon vergeben";
	keinSpeicher	="Speicher kann nicht alloziert werden!";
	ObjektFehlt	="Kein Objekt im Fenster!";
	FensterBenutzt	="Fenster^.userData schon benutzt!";
	keinZeichensatz ="Zeichensatz nicht zu öffnen!";
	nichtLoeschen	="loescheObjekt (NIL) ?";
	keineInfo	="FensterInfo nicht da!";
	keinPropObjekt	="angewähltes Objekt kein PropObjekt!";
	ZSNameZuLang	="Zeichensatzname zu lang!";
	keinProportional="ZS darf nicht proportional sein!";
	keineZSInfo	="ZSInfo nicht da!";
	zaehlFehler	="ZSInfo: Fehler beim zählen!";


TYPE	ObjektPtr	=POINTER TO Objekt;

(*
 * --------------------------------------------------------------------------
 * ZeichensatzInfo	je angemeldeten Zeichensatz wird in einer linearen
 *			Liste eine Info gespeichert. Insbesondere mit
 *			"Zaehler", der Anzahl der Nutzungen.
 * --------------------------------------------------------------------------
 *)
	ZSInfoPtr	=POINTER TO ZSInfo;
	ZSInfo		=RECORD NaechsteZSInfo	:ZSInfoPtr;
			        Name		:ARRAY [0..maxZSName] OF CHAR;
			        Attribute	:TextAttr;
			        Zeichensatz	:TextFontPtr;
			        Zaehler		:CARDINAL
			        END;
(*
 * --------------------------------------------------------------------------
 * EingabeObjekt	für jedes Eingabeobjekt werden in der EingabeInfo
 *			Zusände und zusätzliche Variablen verwaltet.
 * --------------------------------------------------------------------------
 *)
	EingabeTyp	=(string, card, lcard, int, lint,
			  real, lreal, ffp);

	NachbarRichtung	=(oben, unten, rechts, links);

	Satz		=ARRAY [1..1000] OF CHAR;
	SatzPtr		=POINTER TO Satz;

	CardPtr		=POINTER TO CARDINAL;
	LCardPtr	=POINTER TO LONGCARD;
	IntPtr		=POINTER TO INTEGER;
	LIntPtr		=POINTER TO LONGINT;
	RealPtr		=POINTER TO REAL;
	LRealPtr	=POINTER TO LONGREAL;
	FFPPtr		=POINTER TO FFP;

	EingabeInfo	=RECORD	DisplayText		:IntuiText;
				DisplaySatz		:SatzPtr;
				DisplayZSInfo		:ZSInfoPtr;
				Cursor,
				Offset,
				Laenge,
				DisplayLaenge,
				NachkommaStellen	:CARDINAL;
				Exponent		:BOOLEAN;
				EingabeSatz		:SatzPtr;
				obererNachbar,
				untererNachbar,
				rechterNachbar,
				linkerNachbar		:ObjektPtr;
				CASE Typ :EingabeTyp OF
				    card:     cardPtr	  :CardPtr;
				  | lcard:    lcardPtr	  :LCardPtr;;
				  | int:      intPtr	  :IntPtr;
				  | lint:     lintPtr	  :LIntPtr;
				  | real:     realPtr	  :RealPtr;
				  | lreal:    lrealPtr	  :LRealPtr;
				  | ffp:      ffpPtr	  :FFPPtr
				  END;
				EingabeZulaessig	:PruefeEingabe
				END;
(*
 * --------------------------------------------------------------------------
 * Objekte	In der Datenstruktur Objekt werden für jedes Objekt die
 *		benutzten System- und Zusatzstrukturen gespeichert.
 * --------------------------------------------------------------------------
 *)

	FensterInfoPtr	=POINTER TO FensterInfo;

	Objekt	=RECORD NaechstesObjekt	:ObjektPtr;
			Fenster		:WindowPtr;
			Info		:FensterInfoPtr;
			gadget		:Gadget;
			Typ		:ObjektTyp;
			Aktion		:ObjektAktion;
			InfoText	:IntuiText;
			InfoSatz	:SatzPtr;
			InfoZSInfo	:ZSInfoPtr;
			Rand		:Border;
			RandXY		:ARRAY [1..10] OF INTEGER;
			CASE :CARDINAL OF
			    1: Prop:PropInfo
			  | 2: Satz:EingabeInfo
			  END
			END;

(*
 * --------------------------------------------------------------------------
 * FensterInfo	für jedes Fenster werden die Objekte (in einer linearen Liste),
 *		der Cursor und für das Fenster globale Daten gespeichert.
 * --------------------------------------------------------------------------
 *)
	CursorTyp	=RECORD cObjekt		:ObjektPtr;
				pos		:CARDINAL;
				text		:IntuiText;
				textZSInfo	:ZSInfoPtr;
				satz		:ARRAY [0..1] OF CHAR
				END;

	FensterInfo	=RECORD NaechsteInfo	:FensterInfoPtr;
				Fenster		:WindowPtr;
				ObjektListe	:ObjektPtr;
				Cursor		:CursorTyp;
				ObjektIDCMP,
				BenutzerIDCMP	:IDCMPFlagSet;
				letztesObjekt,
				EingabeObjekt	:ObjektPtr
				END;


VAR	EingabeEnde		:BOOLEAN;
	Zeichen			:CHAR;
	TextEnde		:ObjektEnde;
	Nachfolger		:ObjektPtr;
	NachrichtPtr		:IntuiMessagePtr;

	ZSInfoListe,
	TextZSInfo,
	EingabeZSInfo		:ZSInfoPtr;
	FensterInfoListe	:FensterInfoPtr;

	TextFarbeVorne,
	TextFarbeHinten,
	RandFarbeVorne,
	RandFarbeHinten,
	EingabeFarbeVorne,
	EingabeFarbeHinten,
	LinienFarbeVorne,
	LinienFarbeHinten	:INTEGER;
	AusrichtungsFlags	:GadgetFlagSet;
	GadgetTyp		:CARDINAL;
	Rand			:RandTyp;


(*
 * --------------------------------------------------------------------------
 * setzeTextFarbe	stellt für die nächsten zu erzeugenden Objekte die
 *			Farben ein. Bei -1 bleibt der alte Wert erhalten.
 * --------------------------------------------------------------------------
 *)
PROCEDURE setzeTextFarbe	(    Vorne, Hinten	:INTEGER);

BEGIN
IF Vorne # -1  THEN
  TextFarbeVorne := Vorne
  END;
IF Hinten # -1 THEN
  TextFarbeHinten := Hinten
  END
END setzeTextFarbe;


(*
 * --------------------------------------------------------------------------
 * setzeRandFarbe	wie setzeTextFarbe.
 * --------------------------------------------------------------------------
 *)
PROCEDURE setzeRandFarbe	(    Vorne, Hinten	:INTEGER);

BEGIN
IF Vorne # -1  THEN
  RandFarbeVorne := Vorne
  END;
IF Hinten # -1 THEN
  RandFarbeHinten := Hinten
  END
END setzeRandFarbe;


(*
 * --------------------------------------------------------------------------
 * setzeEingabeFarbe	wie setzeTextFarbe.
 * --------------------------------------------------------------------------
 *)
PROCEDURE setzeEingabeFarbe	(    Vorne, Hinten	:INTEGER);

BEGIN
IF Vorne # -1 THEN
  EingabeFarbeVorne := Vorne
  END;
IF Hinten # -1 THEN
  EingabeFarbeHinten := Hinten
  END
END setzeEingabeFarbe;


(*
 * --------------------------------------------------------------------------
 * setzeLinienFarbe	wie setzeTextFarbe
 * --------------------------------------------------------------------------
 *)
PROCEDURE setzeLinienFarbe	(    Vorne, Hinten	:INTEGER);

BEGIN
IF Vorne # -1 THEN
  LinienFarbeVorne := Vorne
  END;
IF Hinten # -1 THEN
  LinienFarbeHinten := Hinten
  END
END setzeLinienFarbe;


PROCEDURE setzeAusrichtung	(    neueAusrichtung	:GadgetFlagSet);


BEGIN
AusrichtungsFlags := neueAusrichtung
END setzeAusrichtung;


PROCEDURE setzeGadgetTyp	(neuerTyp		:CARDINAL);

(*
 *	setzeGadgetTyp:		insbesondere für GimmeZeroZero-Gadget!
 *)

BEGIN
GadgetTyp := neuerTyp
END setzeGadgetTyp;


PROCEDURE setzeRand		(neuerRand		:RandTyp);

BEGIN
Rand := neuerRand
END setzeRand;


(*
 * --------------------------------------------------------------------------
 * oeffneZSInfo	stellt fest, ob ein Zeichensatz schon geladen ist, falls nein,
 *		so wird er geladen und in die Zeichensatzliste eingefügt.
 * --------------------------------------------------------------------------
 *)
PROCEDURE oeffneZSInfo		(VAR Name	:ARRAY OF CHAR;
				     Groesse	:CARDINAL;
				     Stil	:FontStyleSet) :ZSInfoPtr;

VAR	neueZSInfo	:ZSInfoPtr;

BEGIN
Assert (Length (Name) <= maxZSName, ADR (ZSNameZuLang));
neueZSInfo := ZSInfoListe;
WHILE (neueZSInfo # NIL) AND
      ((Compare (Name, neueZSInfo^.Name) # 0) OR
       (neueZSInfo^.Attribute.ySize # Groesse) OR
       (neueZSInfo^.Attribute.style # Stil)) DO
  neueZSInfo := neueZSInfo^.NaechsteZSInfo
  END;
IF neueZSInfo = NIL THEN			(* noch nicht geladen *)
  Allocate (neueZSInfo, SIZE (ZSInfo));
  Assert (neueZSInfo # NIL, ADR (keinSpeicher));
  Copy (neueZSInfo^.Name, Name);
  neueZSInfo^.Name[ Length (Name)] := 0C;
  WITH neueZSInfo^ DO
    NaechsteZSInfo := ZSInfoListe;
    ZSInfoListe := neueZSInfo;
    initTextAttr (Attribute,
                  ADR (Name), Groesse, Stil, FontFlagSet {});
    Zaehler := 0;
    Zeichensatz := OpenFont (Attribute);
    Assert (Zeichensatz # NIL, ADR (keinZeichensatz));
    END
  END;
RETURN neueZSInfo
END oeffneZSInfo;


(*
 * --------------------------------------------------------------------------
 * schliesseZSInfo	schließt Zeichensatz, wenn er nicht mehr benötigt ist
 *			und löscht die ZSInfo aus der Liste.
 * --------------------------------------------------------------------------
 *)
PROCEDURE schliesseZSInfo	(    zsInfo	:ZSInfoPtr);

VAR	Vorgaenger	:ZSInfoPtr;

BEGIN
Assert (zsInfo^.Zaehler <= 1, ADR (zaehlFehler));
IF zsInfo = ZSInfoListe THEN
  ZSInfoListe := zsInfo^.NaechsteZSInfo
ELSE
  Vorgaenger := ZSInfoListe;
  WHILE (Vorgaenger # NIL) AND (Vorgaenger^.NaechsteZSInfo # zsInfo) DO
    Vorgaenger := Vorgaenger^.NaechsteZSInfo
    END;
  Assert (Vorgaenger # NIL, ADR (keineZSInfo));
  Assert (Vorgaenger^.NaechsteZSInfo = zsInfo, ADR (keineZSInfo));
  Vorgaenger^.NaechsteZSInfo := zsInfo^.NaechsteZSInfo
  END;
CloseFont (zsInfo^.Zeichensatz);
Deallocate (zsInfo)
END schliesseZSInfo;


(*
 * --------------------------------------------------------------------------
 * benutzeZeichensatz	setzt Zähler höher.
 * --------------------------------------------------------------------------
 *)
PROCEDURE benutzeZeichensatz	(    zsInfo		:ZSInfoPtr) :ZSInfoPtr;

BEGIN
INC (zsInfo^.Zaehler);
RETURN zsInfo
END benutzeZeichensatz;


(*
 * --------------------------------------------------------------------------
 * freigebenZeichensatz	erniedrigt Zähler, falls der Zeichensatz jetzt
 *			unbenutzt ist, wird er entfernt.
 * --------------------------------------------------------------------------
 *)
PROCEDURE freigebenZeichensatz	(    zsInfo		:ZSInfoPtr);

BEGIN
WITH zsInfo^ DO
  Assert (Zaehler # 0, ADR (zaehlFehler));
  DEC (Zaehler);
  IF (Zaehler = 0) AND (zsInfo # TextZSInfo) AND (zsInfo # EingabeZSInfo) THEN
    schliesseZSInfo (zsInfo)
    END
  END
END freigebenZeichensatz;


(*
 * --------------------------------------------------------------------------
 * freigebenObjekt	gibt alle für dieses Objekt benutzten ZSInfos frei.
 * --------------------------------------------------------------------------
 *)
PROCEDURE freigebenObjekt	(    objekt	:ObjektPtr);

BEGIN
WITH objekt^ DO
  freigebenZeichensatz (InfoZSInfo);
  IF Typ = eingeben THEN
    freigebenZeichensatz (Satz.DisplayZSInfo)
    END
  END
END freigebenObjekt;


PROCEDURE frageAttribute	(    zsInfo	:ZSInfoPtr) :TextAttrPtr;

BEGIN
RETURN ADR (zsInfo^.Attribute)
END frageAttribute;


PROCEDURE frageZeichenHoehe	(    zsInfo	:ZSInfoPtr) :INTEGER;

BEGIN
RETURN INTEGER (zsInfo^.Zeichensatz^.ySize)
END frageZeichenHoehe;


PROCEDURE frageZeichenBreite	(    zsInfo	:ZSInfoPtr) :INTEGER;

BEGIN
RETURN INTEGER (zsInfo^.Zeichensatz^.xSize)
END frageZeichenBreite;


PROCEDURE frageTextBreite	(VAR text	:IntuiText) :INTEGER;

BEGIN
RETURN IntuiTextLength (ADR (text))
END frageTextBreite;


(*
 * --------------------------------------------------------------------------
 * PropZeichensatz	stellt fest, ob ein Zeichensatz propotional ist.
 * --------------------------------------------------------------------------
 *)
PROCEDURE PropZeichensatz	(    zsInfo		:ZSInfoPtr) :BOOLEAN;

BEGIN
RETURN (proportional IN zsInfo^.Zeichensatz^.flags)
END PropZeichensatz;


PROCEDURE setzeTextZeichensatz	(    Name	:ARRAY OF CHAR;
				     Groesse	:CARDINAL;
				     Stil	:FontStyleSet);

BEGIN
TextZSInfo := oeffneZSInfo (Name, Groesse, Stil)
END setzeTextZeichensatz;


PROCEDURE setzeEingabeZeichensatz (  Name		:ARRAY OF CHAR;
				     Groesse		:CARDINAL;
				     Stil		:FontStyleSet);

BEGIN
EingabeZSInfo := oeffneZSInfo (Name, Groesse, Stil);
Assert (NOT (PropZeichensatz (EingabeZSInfo)), ADR (keinProportional))
END setzeEingabeZeichensatz;


(* -------------------------------------------------------------------------- *)
PROCEDURE fuelleDisplay		(VAR EingabeSatz	:ARRAY OF CHAR;
				     Offset,
				     Laenge		:CARDINAL;
				 VAR Display		:ARRAY OF CHAR);

(* Aufgabe:	EingabeSatz von Position Offset an auf Display kopieren,
 *		dabei Laenge einhalten.
 * Eingang:	EingabeSatz, Offset, Laenge.
 * Ausgang:	Display.
 *)

VAR	Max, i	:CARDINAL;

BEGIN
Max := Length (EingabeSatz);
IF Max-Offset > Laenge THEN				(* mehr abschneiden *)
  Max := Laenge+Offset
  END;
Strings.Copy (Display, EingabeSatz, Offset, Max-Offset);
FOR i := Max-Offset TO Laenge-1 DO			(* weniger füllen *)
  Display[i] := " "
  END;
Display[Laenge] := 0C
END fuelleDisplay;


(* -------------------------------------------------------------------------- *)
PROCEDURE setzeBenutzerIDCMP		(    Fenster		:WindowPtr;
					     BenutzerFlags	:IDCMPFlagSet);

VAR	Info	:FensterInfoPtr;

BEGIN
Info := Fenster^.userData;
WITH Info^ DO
  BenutzerIDCMP := BenutzerFlags;
  ModifyIDCMP (Fenster, BenutzerIDCMP+ObjektIDCMP)
  END
END setzeBenutzerIDCMP;


PROCEDURE erneuerIDCMP			(    Fenster		:WindowPtr);

(*
 * Aufgabe: stellt IDCMP auf Benutzter- und Objekt-Flags ein.
 *)

VAR Info	:FensterInfoPtr;

BEGIN
Info := Fenster^.userData;
WITH Info^ DO
  ModifyIDCMP (Fenster, BenutzerIDCMP+ObjektIDCMP)
  END
END erneuerIDCMP;


(* -------------------------------------------------------------------------- *)
PROCEDURE entferneCursor	(    Info		:FensterInfoPtr);

(* Aufgabe:	Cursorstruktur aus Objekt entfernen, Zeichensatz freigeben.
 *)

BEGIN
WITH Info^.Cursor DO
  IF cObjekt # NIL THEN
    cObjekt^.Satz.DisplayText.nextText := text.nextText;
    freigebenZeichensatz (textZSInfo);
    cObjekt := NIL
    END
  END
END entferneCursor;


PROCEDURE schalteCursorAus	(    objekt		:ObjektPtr);

(* Aufgabe:	Cursor ausschalten.
 * Funktion:	schreibt Zeichen wieder normal,
 *		entfernt cursor.text aus Liste,
 *		markiert Cursor als nicht sichtbar.
 * Eingang:	Cursor, Objekt.
 * Ausgang:	Cursor, Objekt (ohne Cursor.text).
 *)

BEGIN
WITH objekt^.Info^.Cursor DO
  IF cObjekt # NIL THEN					(* Cursor sichtbar? *)
    EXCL (text.drawMode, complement);
    satz[0] := cObjekt^.Satz.DisplaySatz^[pos];
    PrintIText (cObjekt^.Fenster^.rPort, ADR (text),
                cObjekt^.gadget.leftEdge,cObjekt^.gadget.topEdge);
    entferneCursor (objekt^.Info)
    END
  END
END schalteCursorAus;


PROCEDURE schalteCursorEin	(    objekt		:ObjektPtr;
				     Position		:CARDINAL);

(* Aufgabe:	schaltet den Cursor ein.
 * Funktion:	belegt Struktur Cursor,
 *		fügt Cursor.text in Objekt^.Satz.gadgetText ein,
 *		schreibt Cursor.
 * Spezielles:	schaltet alten Cursor vorher aus.
 * Eingang:	Cursor, Objekt.
 * Ausgang:	Cursor, Objekt.
 *)

BEGIN
WITH objekt^.Info^.Cursor DO
  IF cObjekt # NIL THEN					(* Cursor sichtbar? *)
    schalteCursorAus (objekt)
    END;
  cObjekt := objekt;
  pos := Position;
  text := objekt^.Satz.DisplayText;
  textZSInfo := benutzeZeichensatz (objekt^.Satz.DisplayZSInfo);
  text.drawMode := DrawModeSet {dm0, complement};
  text.leftEdge := INTEGER (pos-1) * frageZeichenBreite (textZSInfo);
  text.iText := ADR (satz);
  objekt^.Satz.DisplayText.nextText := ADR (text);
  satz[0] := objekt^.Satz.DisplaySatz^[pos];
  satz[1] := 0C;
  PrintIText (cObjekt^.Fenster^.rPort, ADR (text),
              cObjekt^.gadget.leftEdge,cObjekt^.gadget.topEdge)
  END
END schalteCursorEin;


PROCEDURE setzeCursor		(    Fenster		:WindowPtr;
				     Position		:CARDINAL);

(* Aufgabe:	schreibt Cursor an neuer Position.
 * Funktion:	alter Cursor wird normal geschrieben,
 *		Zeichen wird aus Objekt kopiert, komplementär geschrieben.
 * Spezielles:	prüft vorher, ob Cursor sichtbar = eingeschaltet.
 * Eingang:	Cursor, Objekt.
 * Ausgang:	Cursor.
 *)

VAR	Info		:FensterInfoPtr;

BEGIN
Info := Fenster^.userData;
WITH Info^.Cursor DO
  Assert (cObjekt # NIL, ADR (CursorAus));
  EXCL (text.drawMode, complement);
  satz[0] := cObjekt^.Satz.DisplaySatz^[pos];
  PrintIText (cObjekt^.Fenster^.rPort, ADR (text),
              cObjekt^.gadget.leftEdge,cObjekt^.gadget.topEdge);
  pos := Position;
  text.leftEdge := INTEGER (pos-1) * frageZeichenBreite (textZSInfo);
  INCL (text.drawMode, complement);
  satz[0] := cObjekt^.Satz.DisplaySatz^[pos];
  PrintIText (cObjekt^.Fenster^.rPort, ADR (text),
              cObjekt^.gadget.leftEdge,cObjekt^.gadget.topEdge)
  END
END setzeCursor;


(* -------------------------------------------------------------------------- *)
PROCEDURE frageFensterInfo	(    objekt	:ObjektPtr) :FensterInfoPtr;

BEGIN
RETURN objekt^.Info
END frageFensterInfo;


PROCEDURE erzeugeFensterInfo	(VAR Fenster	:WindowPtr);

VAR	Info			:FensterInfoPtr;

BEGIN
Allocate (Info, SIZE (FensterInfo));
Assert (Info # NIL, ADR (keinSpeicher));
Fenster^.userData := Info;
Info^.Fenster := Fenster;
WITH Info^ DO
  ObjektListe := NIL;
  Cursor.cObjekt := NIL;
  ObjektIDCMP := IDCMPFlagSet {gadgetDown, gadgetUp};
  BenutzerIDCMP := Fenster^.idcmpFlags * IDCMPFlagSet {sizeVerify..intuiTicks};
  letztesObjekt := NIL;
  EingabeObjekt := NIL;
  NaechsteInfo := FensterInfoListe
  END;
FensterInfoListe := Info;
erneuerIDCMP (Fenster)
END erzeugeFensterInfo;


PROCEDURE entferneFensterInfo	(VAR Info	:FensterInfoPtr);

BEGIN
Deallocate (Info);
Info := NIL
END entferneFensterInfo;


PROCEDURE loescheFensterInfo	(VAR Info	:FensterInfoPtr);

VAR	Vorgaenger	:FensterInfoPtr;

BEGIN
entferneCursor (Info);
IF FensterInfoListe = Info THEN
  FensterInfoListe := Info^.NaechsteInfo
ELSE
  Vorgaenger := FensterInfoListe;
  WHILE (Vorgaenger # NIL) AND (Vorgaenger^.NaechsteInfo # Info) DO
    Vorgaenger := Vorgaenger^.NaechsteInfo
    END;
  Assert (Vorgaenger # NIL, ADR (keineInfo));
  Assert (Vorgaenger^.NaechsteInfo = Info, ADR (keineInfo));
  Vorgaenger^.NaechsteInfo := Info^.NaechsteInfo
  END;
entferneFensterInfo (Info)
END loescheFensterInfo;


(* -------------------------------------------------------------------------- *)
PROCEDURE entferneObjekt	(    objekt		:ObjektPtr);

(* Aufgabe:	dealloziert den Speicher eines Objektes über Heap.Deallocate.
 * Funktion:	dealloziert gegebenfalls zusätzlich Objekt^.InfoSatz^,
 *		Objekt^.Satz.DisplayText^, Objekt^.Satz.EingabeSatz^.
 * Eingang:	objekt.
 * Ausgang:	NIL
 *)

BEGIN
freigebenObjekt (objekt);
IF (objekt^.Typ = eingeben) THEN
  Deallocate (objekt^.Satz.DisplaySatz);
  IF objekt^.Satz.Typ # string THEN
    Deallocate (objekt^.Satz.EingabeSatz)
    END
  END;
IF objekt^.InfoSatz # NIL THEN
  Deallocate (objekt^.InfoSatz)
  END;
Deallocate (objekt);
objekt := NIL
END entferneObjekt;


PROCEDURE loescheObjekt		(    objekt		:ObjektPtr);

(* Aufgabe:  	löscht ein Objekt aus der Objektliste zum Fenster,
 *		falls das letzte Objekt gelöscht wird, wird die FensterInfo
 *		auch gelöscht.
 * Eingang:	objekt, FensterInfoListe, ObjektListe
 * Ausgang:	FensterInfoListe, ObjektListe
 *)

VAR	Fenster		:WindowPtr;
	Info		:FensterInfoPtr;
	vorgaenger	:ObjektPtr;
	i		:INTEGER;

BEGIN
Assert (objekt # NIL, ADR (nichtLoeschen));
Info := frageFensterInfo (objekt);
IF Info^.Cursor.cObjekt = objekt THEN
  schalteCursorAus (objekt)
  END;
i := RemoveGadget (objekt^.Fenster, ADR (objekt^.gadget));
vorgaenger := Info^.ObjektListe;
IF vorgaenger = objekt THEN			(* erstes Objekt? *)
  Info^.ObjektListe := objekt^.NaechstesObjekt;
  entferneObjekt (objekt);
ELSE  						(* nicht erstes Objekt *)
  WHILE (vorgaenger # NIL) AND (vorgaenger^.NaechstesObjekt # objekt) DO
    vorgaenger := vorgaenger^.NaechstesObjekt
    END;
  Assert (vorgaenger # NIL, ADR (ObjektFehlt));
  Assert (vorgaenger^.NaechstesObjekt = objekt, ADR (ObjektFehlt));
  vorgaenger := objekt^.NaechstesObjekt;
  entferneObjekt (objekt)
  END;
IF Info^.ObjektListe = NIL THEN
  loescheFensterInfo (Info)
  END
END loescheObjekt;


PROCEDURE loescheAlleObjekte	(    Fenster		:WindowPtr);

(* Aufgabe:	Alle Objekte zu einem Fenster löschen.
 * Funktion:	jedes Objekt entfernen, FensterInfo entfernen.
 * Eingang:	Fenster, FensterInfo, Objekte
 * Ausgang:	Fenster, NIL
 *)

VAR	naechstes,objekt	:ObjektPtr;
	Info			:FensterInfoPtr;
	i			:INTEGER;

BEGIN
IF Fenster = NIL THEN
  RETURN
  END;
Info := Fenster^.userData;
IF Info^.Cursor.cObjekt # NIL THEN
  schalteCursorAus (Info^.Cursor.cObjekt)
  END;
naechstes := Info^.ObjektListe;
WHILE naechstes # NIL DO
  objekt := naechstes;
  naechstes := naechstes^.NaechstesObjekt;
  i := RemoveGadget (objekt^.Fenster, ADR (objekt^.gadget));
  entferneObjekt (objekt)
  END;
loescheFensterInfo (Info)
END loescheAlleObjekte;


(* -------------------------------------------------------------------------- *)
PROCEDURE findeObjekt		(    Fenster		:WindowPtr;
				     Nummer		:INTEGER) :ObjektPtr;

VAR	objekt	:ObjektPtr;
	Info	:FensterInfoPtr;

BEGIN
Info := Fenster^.userData;
objekt := Info^.ObjektListe;
WHILE (objekt # NIL) AND (objekt^.gadget.gadgetID # Nummer) DO
  objekt := objekt^.NaechstesObjekt
  END;
RETURN objekt
END findeObjekt;


PROCEDURE verbindeObjekte	(    Fenster		:WindowPtr;
				     ObjektNr,
				     obererNachbar,
				     untererNachbar,
				     rechterNachbar,
				     linkerNachbar	:INTEGER);

VAR	objekt		:ObjektPtr;

BEGIN
objekt := findeObjekt (Fenster, ObjektNr);
IF objekt = NIL THEN
  RETURN
  END;
Assert (objekt^.Typ = eingeben, ADR (verbindenFehler));
WITH objekt^ DO
  Satz.obererNachbar := findeObjekt (Fenster, obererNachbar);
  Satz.untererNachbar := findeObjekt (Fenster, untererNachbar);
  Satz.rechterNachbar := findeObjekt (Fenster, rechterNachbar);
  Satz.linkerNachbar := findeObjekt (Fenster, linkerNachbar);
  Assert ((Satz.obererNachbar = NIL) OR (Satz.obererNachbar^.Typ = eingeben),
          ADR (verbindenFehler));
  Assert ((Satz.untererNachbar = NIL) OR (Satz.untererNachbar^.Typ = eingeben),
	  ADR (verbindenFehler));
  Assert ((Satz.rechterNachbar = NIL) OR (Satz.rechterNachbar^.Typ = eingeben),
          ADR (verbindenFehler));
  Assert ((Satz.linkerNachbar = NIL) OR (Satz.linkerNachbar^.Typ = eingeben),
          ADR (verbindenFehler))
  END
END verbindeObjekte;


(* -------------------------------------------------------------------------- *)
PROCEDURE erzeugeStandardEingabe(    objekt		:ObjektPtr);

VAR	Fehler	:BOOLEAN;

BEGIN
  WITH objekt^.Satz DO
  CASE Typ OF
    card  :ValToStr (cardPtr^,  FALSE, EingabeSatz^, 10, Laenge, " ", Fehler);
  | lcard :ValToStr (lcardPtr^, FALSE, EingabeSatz^, 10, Laenge, " ", Fehler);
  | int   :ValToStr (intPtr^,   TRUE,  EingabeSatz^, 10, Laenge, " ", Fehler);
  | lint  :ValToStr (lintPtr^,  TRUE,  EingabeSatz^, 10, Laenge, " ", Fehler);
  | real  :RealConversions.RealToStr (realPtr^, EingabeSatz^, Laenge,
                                      NachkommaStellen, Exponent, Fehler);
  | lreal :LongRealConversions.RealToStr (lrealPtr^, EingabeSatz^, Laenge,
                                          NachkommaStellen, Exponent, Fehler);
  | ffp   :FFPConversions.RealToStr (ffpPtr^, EingabeSatz^, Laenge,
                                     NachkommaStellen, Exponent, Fehler)
  ELSE
    END
  END
END erzeugeStandardEingabe;


PROCEDURE erzeugeStandardWert	(    objekt		:ObjektPtr) :BOOLEAN;

VAR	Fehler, Negativ	:BOOLEAN;
	longint		:LONGINT;

BEGIN
  WITH objekt^.Satz DO
    CASE Typ OF
      string:Fehler := FALSE
    | card  :StrToVal (EingabeSatz^, longint,  Negativ, 10, Fehler);
	     IF NOT (Fehler)
	        AND (longint >= 0) AND (longint <= MAX (CARDINAL)) THEN
	       cardPtr^ := CARDINAL (longint)
	     ELSE
	       Fehler := TRUE
	       END;
    | lcard :StrToVal (EingabeSatz^, lintPtr^, Negativ, 10, Fehler);
	     IF NOT (Fehler) THEN
	       lcardPtr^ := LONGCARD (lintPtr^)
	       END;
    | int   :StrToVal (EingabeSatz^, longint,   Negativ, 10, Fehler);
             IF NOT (Fehler) AND
                (longint >= MIN (INTEGER)) AND (longint <= MAX (INTEGER)) THEN
	       intPtr^ := INTEGER (longint)
	       END;
    | lint  :StrToVal (EingabeSatz^, lintPtr^,  Negativ, 10, Fehler);
    | real  :RealConversions.StrToReal     (EingabeSatz^, realPtr^,  Fehler);
    | lreal :LongRealConversions.StrToReal (EingabeSatz^, lrealPtr^, Fehler);
    | ffp   :FFPConversions.StrToReal      (EingabeSatz^, ffpPtr^,   Fehler)
    END;
  IF NOT Fehler THEN
    RETURN EingabeZulaessig (objekt)
  ELSE
    RETURN FALSE
    END
  END;
END erzeugeStandardWert;


(* -------------------------------------------------------------------------- *)
PROCEDURE aenderInfoSatz	(    objekt		:ObjektPtr;
				     Text		:ARRAY OF CHAR);

VAR	i	:CARDINAL;

BEGIN
WITH objekt^ DO
  i := RemoveGadget (Fenster, ADR (gadget));
  fuelleDisplay (Text, 0, Length (InfoSatz^), InfoSatz^);
  i := AddGadget (Fenster, ADR (gadget), -1);
  IF Typ # eingeben THEN
    RefreshGList (ADR (gadget), Fenster, NIL, 1)
  ELSE
    PrintIText (Fenster^.rPort, ADR (InfoText),
                gadget.leftEdge, gadget.topEdge);
    END
  END
END aenderInfoSatz;


PROCEDURE erneuerObjekt		(    objekt		:ObjektPtr);

(* Annahme:	Cursor ist NICHT auf objekt gesetzt! *)

BEGIN
WITH objekt^ DO
  IF Typ = eingeben THEN
    erzeugeStandardEingabe (objekt);
    WITH Satz DO
      Cursor := 1;
      Offset := 0;
      fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^)
      END;
    IF gadgDisabled IN gadget.flags THEN
      refreshOneGadget (Fenster, ADR (gadget))
    ELSE
      PrintIText (Fenster^.rPort, ADR (Satz.DisplayText),
                  gadget.leftEdge, gadget.topEdge)
      END
    END
  END
END erneuerObjekt;


PROCEDURE erneuerObjekte	(    Fenster		:WindowPtr;
				     Objekte		:LONGSET);

VAR	Liste		:ObjektPtr;
	Info		:FensterInfoPtr;
BEGIN
Info := Fenster^.userData;
Liste := Info^.ObjektListe;
WHILE Liste # NIL DO
  IF (Liste^.gadget.gadgetID <=31) AND (Liste^.gadget.gadgetID IN Objekte) THEN
    erneuerObjekt (Liste)
    END;
  Liste := Liste^.NaechstesObjekt
  END
END erneuerObjekte;


(* -------------------------------------------------------------------------- *)
PROCEDURE verarbeiteNachricht	(    Fenster		:WindowPtr;
				 VAR Nachricht		:IntuiMessage);

VAR	Info		:FensterInfoPtr;
	i		:CARDINAL;
	VanillaSatz	:ARRAY [1..80] OF CHAR;
	gadget		:GadgetPtr;
	objekt		:ObjektPtr;


(* verarbeiteNachricht *)
BEGIN
NachrichtPtr := ADR (Nachricht);
Info := Fenster^.userData;
WITH Info^ DO
  WITH Nachricht DO
    IF    (intuiTicks IN class) AND (letztesObjekt # NIL) THEN
      letztesObjekt^.Aktion (Wiederholung, letztesObjekt);
    ELSIF (rawKey IN class) AND
          (EingabeObjekt # NIL) AND (code MOD 0FFH <= 127) THEN
      Zeichen := CHAR (code MOD 0FFH);
      EingabeEnde := FALSE;
      Nachfolger := NIL;
      CASE Zeichen OF
        PfeilOben..PfeilLinks:
          EingabeObjekt^.Aktion (SonderEingabe, EingabeObjekt)
      ELSE
        RawToVanilla (Nachricht, VanillaSatz);
        i := 1;
        WHILE NOT (EingabeEnde) AND (i <= Length (VanillaSatz)) DO
          Zeichen := VanillaSatz[i];
          EingabeObjekt^.Aktion (Eingabe, EingabeObjekt);
          INC (i)
          END
        END;
      IF EingabeEnde THEN
        IF Nachfolger = NIL THEN
          EXCL (ObjektIDCMP, rawKey);
          erneuerIDCMP (Fenster);
          EingabeObjekt := NIL
        ELSE
          EingabeObjekt := Nachfolger;
          Nachricht.mouseX := 1;
          EingabeObjekt^.Aktion (Start, EingabeObjekt)
          END
        END;

    ELSIF gadgetDown IN class THEN
      gadget := iAddress;
      objekt := gadget^.userData;
      IF objekt = EingabeObjekt THEN
        INC (mouseX, 1-EingabeObjekt^.gadget.leftEdge);
        EingabeObjekt^.Aktion (Wiederholung, EingabeObjekt)
      ELSE
        IF EingabeObjekt # NIL THEN
          EingabeEnde := FALSE;
          Nachfolger := NIL;
          EingabeObjekt^.Aktion (Ende, EingabeObjekt);
          IF EingabeEnde THEN
            EXCL (ObjektIDCMP, rawKey);
            erneuerIDCMP (Fenster);
            EingabeObjekt := NIL
            END
          END;
        IF EingabeObjekt = NIL THEN
          IF eingeben = objekt^.Typ THEN
            INC (mouseX, 1-objekt^.gadget.leftEdge)
            END;
          IF objekt = NIL THEN				(* Objekt-Gadget? *)
            RETURN
            END;
          objekt^.Aktion (Start, objekt);
          IF eingeben = objekt^.Typ THEN
            EingabeObjekt := objekt;
            INCL (ObjektIDCMP, rawKey);
            erneuerIDCMP (Fenster);
          ELSE
            letztesObjekt := objekt;
            INCL (ObjektIDCMP, intuiTicks);
            erneuerIDCMP (Fenster)
            END
          END
        END

    ELSIF gadgetUp IN class THEN
      gadget := iAddress;
      objekt := gadget^.userData;
      IF objekt = NIL THEN				(* Objekt-Gadget? *)
        RETURN
        END;
      IF wiederholen = objekt^.Typ THEN
        EXCL (ObjektIDCMP, intuiTicks);
        erneuerIDCMP (Fenster);
        objekt^.Aktion (Ende, objekt);
        letztesObjekt := NIL
      ELSE
        IF EingabeObjekt # NIL THEN
          EingabeEnde := FALSE;
          Nachfolger := NIL;
          EingabeObjekt^.Aktion (Ende, EingabeObjekt);
          IF EingabeEnde THEN
            EXCL (ObjektIDCMP, rawKey);
            erneuerIDCMP (Fenster);
            EingabeObjekt := NIL
            END
          END;
        IF EingabeObjekt = NIL THEN
          IF wechseln = objekt^.Typ THEN
            IF selected IN gadget^.flags THEN
              objekt^.Aktion (An, objekt)
            ELSE
              objekt^.Aktion (Aus, objekt)
              END
          ELSE
            objekt^.Aktion (Treffer, objekt)
            END
          END
        END
      END
    END
  END
END verarbeiteNachricht;


(* -------------------------------------------------------------------------- *)
PROCEDURE setzeEingabeEnde;

BEGIN
EingabeEnde := TRUE
END setzeEingabeEnde;


PROCEDURE setzeNachfolger	(    folgeObjekt	:ObjektPtr);

BEGIN
Nachfolger := folgeObjekt
END setzeNachfolger;


PROCEDURE frageObjektNr		(    objekt		:ObjektPtr) :INTEGER;

BEGIN
RETURN objekt^.gadget.gadgetID
END frageObjektNr;


PROCEDURE frageGadget		(    objekt		:ObjektPtr) :GadgetPtr;

BEGIN
RETURN ADR (objekt^.gadget)
END frageGadget;


PROCEDURE frageXPosition	() :INTEGER;

BEGIN
RETURN NachrichtPtr^.mouseX
END frageXPosition;


PROCEDURE frageZeichen		() :CHAR;

BEGIN
RETURN Zeichen
END frageZeichen;


PROCEDURE frageQualifier	() :QualifierSet;

BEGIN
RETURN NachrichtPtr^.qualifier
END frageQualifier;


PROCEDURE EingabeOk		(    objekt		:ObjektPtr) :BOOLEAN;

BEGIN
RETURN TRUE
END EingabeOk;


(* -------------------------------------------------------------------------- *)
PROCEDURE frageHPosition	(    objekt		:ObjektPtr) :CARDINAL;

BEGIN
WITH objekt^.Prop DO
  RETURN horizPot
  END
END frageHPosition;


PROCEDURE frageVPosition	(    objekt		:ObjektPtr) :CARDINAL;

BEGIN
WITH objekt^.Prop DO
  RETURN vertPot
  END
END frageVPosition;


PROCEDURE frageEnde		() :ObjektEnde;

BEGIN
RETURN TextEnde
END frageEnde;


PROCEDURE setzeEnde		(    Ende		:ObjektEnde);

BEGIN
TextEnde := Ende
END setzeEnde;


PROCEDURE setzeHPosition	(    objekt		:ObjektPtr;
				     Position,
				     MaxPosition	:CARDINAL);
BEGIN
WITH objekt^ DO
  NewModifyProp (ADR (gadget), Fenster, NIL, Prop.flags,
                 Position, 0, MaxPosition, maxBody, 1)

  END
END setzeHPosition;


PROCEDURE setzeVPosition	(    objekt		:ObjektPtr;
				     Position,
				     MaxPosition	:CARDINAL);

BEGIN
WITH objekt^ DO
  NewModifyProp (ADR (gadget), Fenster, NIL, Prop.flags,
                 0, Position, maxBody, MaxPosition, 1)

  END
END setzeVPosition;


PROCEDURE setzeHVPosition	(    objekt		:ObjektPtr;
				     HPosition,
				     VPosition,
				     HMaxPosition,
				     VMaxPosition	:CARDINAL);

BEGIN
WITH objekt^ DO
  NewModifyProp (ADR (gadget), Fenster, NIL, Prop.flags,
                 HPosition, VPosition, HMaxPosition, VMaxPosition, 1)
  END
END setzeHVPosition;


(* -------------------------------------------------------------------------- *)
PROCEDURE findeNachbar		(    Richtung		:NachbarRichtung;
				     objekt		:ObjektPtr) :ObjektPtr;

BEGIN
IF objekt # NIL THEN
  REPEAT
  CASE Richtung OF
    oben	:objekt := objekt^.Satz.obererNachbar;
  | unten	:objekt := objekt^.Satz.untererNachbar;
  | rechts	:objekt := objekt^.Satz.rechterNachbar;
  | links	:objekt := objekt^.Satz.linkerNachbar
    END
  UNTIL (objekt = NIL) OR NOT (gadgDisabled IN objekt^.gadget.flags)
  END;
RETURN objekt
END findeNachbar;


PROCEDURE findeLetztenNachbar	(    Richtung		:NachbarRichtung;
				     objekt		:ObjektPtr) :ObjektPtr;

VAR	Vorletzter	:ObjektPtr;

BEGIN
Vorletzter := findeNachbar (Richtung, objekt);
objekt := Vorletzter;
WHILE objekt # NIL DO
  objekt := findeNachbar (Richtung, objekt);
  IF objekt # NIL THEN
    Vorletzter := objekt
    END
  END;
RETURN Vorletzter
END findeLetztenNachbar;


(* -------------------------------------------------------------------------- *)
PROCEDURE standardTextAktion	(    Ereignis		:ObjektEreignis;
				     objekt		:ObjektPtr);

VAR	Steuerzeichen,
	einzelTaste		:BOOLEAN;
	Tasten			:QualifierSet;
	Nachfolger, Marke	:ObjektPtr;


  PROCEDURE schreibeDisplay	(    objekt		:ObjektPtr);

  BEGIN
  WITH objekt^ DO
    PrintIText (Fenster^.rPort, ADR (Satz.DisplayText),
                gadget.leftEdge, gadget.topEdge)
    END
  END schreibeDisplay;


  PROCEDURE beendeEingabe	(    Ende		:ObjektEnde) :BOOLEAN;

  VAR	Ergebnis	:BOOLEAN;

  BEGIN
  setzeEnde (Ende);
  WITH objekt^.Satz DO
    EingabeSatz^[Length (EingabeSatz^)] := 0C;
    DEC (Laenge);
    Ergebnis := erzeugeStandardWert (objekt);
    IF Ergebnis THEN
      schalteCursorAus (objekt);
      IF Typ # string THEN
        erzeugeStandardEingabe (objekt)
        END
    ELSE
      EingabeSatz^[Length (EingabeSatz^)+2] := 0C;
      EingabeSatz^[Length (EingabeSatz^)+1] := " ";
      INC (Laenge)
      END;
    Cursor := 1;
    Offset := 0;
    fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
    schreibeDisplay (objekt);
    IF NOT Ergebnis THEN
      schalteCursorEin (objekt, Cursor-Offset)
      END;
    RETURN Ergebnis
    END
  END beendeEingabe;


(* standardTextAktion *)
BEGIN
WITH objekt^.Satz DO
  Nachfolger := NIL;
  einzelTaste := NOT (repeat IN Tasten);
  Tasten := frageQualifier () - QualifierSet {repeat, relativeMouse, numericPad};
  CASE Ereignis OF
    Start:
      Strings.Insert (EingabeSatz^, -1, " ");		(* zusätzl.Leerzeichen*)
      INC (Laenge);
      Cursor := (frageXPosition ()+frageZeichenBreite (DisplayZSInfo)-1) DIV
                 frageZeichenBreite (DisplayZSInfo);
      INC (Cursor, Offset);
      IF Cursor > Length (EingabeSatz^) THEN
        Cursor := Length (EingabeSatz^)
      ELSIF Cursor < 1 THEN
        Cursor := 1
        END;
      schalteCursorEin (objekt, Cursor-Offset);
      IF Typ # string THEN
        WHILE (EingabeSatz^[1] # 0C) AND (EingabeSatz^[1] = " ") DO
          Strings.Delete (EingabeSatz^, 0, 1);
          IF Cursor > 1 THEN
            DEC (Cursor);
            IF Cursor - Offset < 1 THEN
              DEC (Offset)
              END
            END
          END;
        fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
        schreibeDisplay (objekt);
        setzeCursor (objekt^.Fenster, Cursor-Offset)
        END
  | Wiederholung:
      Cursor := (frageXPosition ()+frageZeichenBreite (DisplayZSInfo)-1) DIV
                 frageZeichenBreite (DisplayZSInfo);
      INC (Cursor, Offset);
      IF Cursor > Length (EingabeSatz^) THEN
        Cursor := Length (EingabeSatz^)
      ELSIF Cursor < 1 THEN
        Cursor := 1
        END;
      setzeCursor (objekt^.Fenster, Cursor-Offset);
  | Ende:
      IF beendeEingabe (externEnde) THEN
        setzeEingabeEnde
        END
  | Eingabe:
    Steuerzeichen := TRUE;
    IF Tasten = QualifierSet {} THEN
      CASE frageZeichen () OF
        15C:  (* RETURN *)
          IF beendeEingabe (returnEnde) THEN
            setzeEingabeEnde;
            Nachfolger := findeNachbar (rechts, objekt);
            IF Nachfolger = NIL THEN
              Marke := objekt^.Satz.untererNachbar;
              WHILE (Nachfolger = NIL) AND (Marke # NIL) DO
                Nachfolger := findeLetztenNachbar (links, Marke);
	        IF Nachfolger = NIL THEN
	          IF gadgDisabled IN Marke^.gadget.flags THEN
	            Nachfolger := findeNachbar (rechts, Marke);
	            IF Nachfolger = NIL THEN
	              Marke := Marke^.Satz.untererNachbar
	              END
	          ELSE
	            Nachfolger := Marke
	            END
	          END
	        END;
              END
            END
      | Loesche:
          IF Cursor < Length (EingabeSatz^) THEN
            Strings.Delete (EingabeSatz^, Cursor-1, 1);
            IF Offset > 0 THEN
              DEC (Offset)
              END;
            fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
            schreibeDisplay (objekt);
            setzeCursor (objekt^.Fenster, Cursor-Offset)
            END
      | Zurueck:
          IF Cursor > 1 THEN
            DEC (Cursor);
            Strings.Delete (EingabeSatz^, Cursor-1, 1);
            IF Offset > 0 THEN
              DEC (Offset)
              END;
            fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
            schreibeDisplay (objekt);
            setzeCursor (objekt^.Fenster, Cursor-Offset)
            END
      ELSE
        Steuerzeichen := FALSE
        END
    ELSIF (Tasten = QualifierSet {lShift}) OR
          (Tasten = QualifierSet {rShift}) THEN
      CASE frageZeichen () OF
        Loesche:
          IF Cursor < Length (EingabeSatz^) THEN
            Strings.Delete (EingabeSatz^, Cursor-1,Length(EingabeSatz^)-Cursor);
            IF Offset > 0 THEN
              IF Length (EingabeSatz^) > DisplayLaenge THEN
                Offset := Length (EingabeSatz^)-DisplayLaenge
              ELSE
                Offset := 0
                END
              END;
            fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
            schreibeDisplay (objekt);
            setzeCursor (objekt^.Fenster, Cursor-Offset)
            END
      | Zurueck:
          IF Cursor > 1 THEN
            Strings.Delete (EingabeSatz^, 0, Cursor-1);
            Cursor := 1;
            IF Offset > 0 THEN
              IF Length (EingabeSatz^) > DisplayLaenge THEN
                Offset := Length (EingabeSatz^)-DisplayLaenge
              ELSE
                Offset := 0
                END
              END;
            fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
            schreibeDisplay (objekt);
            setzeCursor (objekt^.Fenster, Cursor-Offset)
            END
      ELSE
        Steuerzeichen := FALSE
        END
    ELSIF Tasten = QualifierSet {control} THEN
      CASE frageZeichen () OF
        Loesche:
          IF EingabeSatz^[1] # 0C THEN
            EingabeSatz^ := " ";
            Cursor := 1;
            Offset := 0;
            fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
            schreibeDisplay (objekt);
            setzeCursor (objekt^.Fenster, Cursor-Offset)
            END
      ELSE
        Steuerzeichen := FALSE
        END
    ELSE
      Steuerzeichen := FALSE
      END;
    IF NOT (Steuerzeichen) THEN
      IF Length (EingabeSatz^) < Laenge THEN
        Strings.Insert (EingabeSatz^, Cursor-1, " ");
        EingabeSatz^[Cursor] := frageZeichen ();
        INC (Cursor);
        IF Cursor - Offset > DisplayLaenge THEN
          INC (Offset)
          END;
        fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
        schreibeDisplay (objekt);
        setzeCursor (objekt^.Fenster, Cursor-Offset)
      ELSIF einzelTaste THEN
        DisplayBeep (NIL);
        Delay (5)				(* wegen Intuition Aufruf *)
      ELSE
        END
      END
  | SonderEingabe:
    IF Tasten = QualifierSet{} THEN
      CASE frageZeichen () OF
        PfeilOben:
          IF beendeEingabe (pfeilEnde) THEN
            setzeEingabeEnde;
            Nachfolger := findeNachbar (oben, objekt)
            END
      | PfeilUnten:
          IF beendeEingabe (pfeilEnde) THEN
            setzeEingabeEnde;
            Nachfolger := findeNachbar (unten, objekt)
            END
      | PfeilRechts:
          IF Cursor < Length (EingabeSatz^) THEN
            INC (Cursor);
            IF Cursor-Offset > DisplayLaenge THEN
              INC (Offset);
              fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
              schreibeDisplay (objekt)
              END;
            setzeCursor (objekt^.Fenster, Cursor-Offset)
            END
      | PfeilLinks:
          IF Cursor > 1 THEN
            DEC (Cursor);
            IF Cursor-Offset < 1 THEN
              DEC (Offset);
              fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
              schreibeDisplay (objekt)
              END;
            setzeCursor (objekt^.Fenster, Cursor-Offset)
            END
      ELSE
        END
    ELSIF (Tasten = QualifierSet {lShift}) OR
          (Tasten = QualifierSet {rShift}) THEN
      CASE frageZeichen () OF
        PfeilRechts:
          IF Cursor < Length (EingabeSatz^) THEN
            Cursor := Length (EingabeSatz^);
            IF Cursor-Offset > DisplayLaenge THEN
              Offset := Cursor-DisplayLaenge-1;
              INC (Offset);
              fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
              schreibeDisplay (objekt)
              END;
            setzeCursor (objekt^.Fenster, Cursor-Offset)
            END
      | PfeilLinks:
          IF Cursor > 1 THEN
            Cursor := 1;
            IF Offset > 0 THEN
              Offset := 0;
              fuelleDisplay (EingabeSatz^, Offset, DisplayLaenge, DisplaySatz^);
              schreibeDisplay (objekt)
              END;
            setzeCursor (objekt^.Fenster, Cursor-Offset)
            END
      ELSE
        END
    ELSIF Tasten = QualifierSet {control} THEN
      IF beendeEingabe (pfeilEnde) THEN
        setzeEingabeEnde;
        CASE frageZeichen () OF
            PfeilOben	:Nachfolger := findeNachbar (oben, objekt)
          | PfeilUnten	:Nachfolger := findeNachbar (unten, objekt)
          | PfeilRechts	:Nachfolger := findeNachbar (rechts, objekt)
          | PfeilLinks	:Nachfolger := findeNachbar (links, objekt)
        END
      END
    ELSIF (Tasten = QualifierSet {control,lAlt}) OR
          (Tasten = QualifierSet {control,rAlt}) THEN
      IF beendeEingabe (pfeilEnde) THEN
        setzeEingabeEnde ();
        CASE frageZeichen () OF
            PfeilOben	:Nachfolger := findeLetztenNachbar (oben, objekt)
          | PfeilUnten	:Nachfolger := findeLetztenNachbar (unten, objekt)
          | PfeilRechts	:Nachfolger := findeLetztenNachbar (rechts, objekt)
          | PfeilLinks	:Nachfolger := findeLetztenNachbar (links, objekt)
        END
      END
    ELSE
      END
    END
  END;
IF Nachfolger = NIL THEN
  Nachfolger := objekt
  END;
setzeNachfolger (Nachfolger)
END standardTextAktion;


(* -------------------------------------------------------------------------- *)
PROCEDURE erzeugeEinfachesObjekt (Fenster	 :WindowPtr;
				  X,Y		 :INTEGER;
				  Text		 :ARRAY OF CHAR;
				  Nummer	 :INTEGER;
				  EreignisAktion :ObjektAktion) :ObjektPtr;

(* Aufgabe:	als einfachstes Objekt wird ein Boolean, melden Objekt erzeugt.
 * Funktion:	alloziert Speicher für Objekt & Infosatz,
 *		fügt Objekt in die Objektliste ein,
 *		initialisiert Objekt.
 * Spezielles:	Infosatz wird nur alloziert, wenn nicht Leerstring.
 * Eingang:	ObjektListe.
 * Ausgang:	ObjektListe erweitert um ein Objekt.
 *)

VAR	objekt	:ObjektPtr;
	i	:CARDINAL;
	Info	:FensterInfoPtr;

BEGIN
IF Fenster^.userData = NIL THEN
  erzeugeFensterInfo (Fenster)
  END;
Info := Fenster^.userData;
Assert ( findeObjekt (Fenster, Nummer)= NIL , ADR (NummerDoppelt));
Allocate (objekt, SIZE (Objekt));
Assert (objekt # NIL, ADR (keinSpeicher));
objekt^.Fenster := Fenster;
objekt^.Info := Info;
WITH objekt^ DO
  IF Length (Text) # 0 THEN
    Allocate (InfoSatz, Length (Text)+1);
    Assert (InfoSatz # NIL, ADR (keinSpeicher))
    END;
  NaechstesObjekt := Info^.ObjektListe;
  Info^.ObjektListe := objekt;
  initGadget (gadget,
	      NIL,					(* nextGadget *)
	      X,Y,
	      0, frageZeichenHoehe (TextZSInfo),
	      AusrichtungsFlags,			(* GagdetFlags *)
	      ActivationFlagSet {relVerify},
	      boolGadget + GadgetTyp,
	      ADR (Rand),
	      NIL,					(* SelectRender *)
	      ADR (InfoText),
	      LONGSET {},
	      NIL,					(* SpecialInfo *)
	      Nummer,
	      objekt);
  Typ := melden;
  Aktion := EreignisAktion;
  InfoZSInfo := benutzeZeichensatz (TextZSInfo);
  initIntuiText (InfoText,
                 TextFarbeHinten, TextFarbeVorne,
		 jam2,
		 0,0,					(* Left, Top *)
		 frageAttribute (TextZSInfo),
		 NIL,					(* iText *)
		 NIL);					(* nextText *)
  IF Length (Text) # 0 THEN
    InfoText.iText := InfoSatz;
    Copy (InfoSatz^, Text);
    InfoSatz^[Length (Text)+1] := 0C
  ELSE
    gadget.gadgetText := NIL
    END;
  gadget.width := frageTextBreite (InfoText);
  initBorder (Rand,
	      -1,-1,					(* Left, Top *)
	      RandFarbeVorne, RandFarbeHinten,
	      jam2,
	      5,					(* Count *)
	      ADR (RandXY),
	      NIL);					(* nextBorder *)
  makeBorder (RandXY,
  	      gadget.width+2, gadget.height+2)
  END; (* WITH Objekt^ *)
RETURN objekt
END erzeugeEinfachesObjekt;


(* -------------------------------------------------------------------------- *)
PROCEDURE erzeugeBooleanObjekt (   Fenster		:WindowPtr;
				   X,Y			:INTEGER;
				   Text			:ARRAY OF CHAR;
				   Nummer		:INTEGER;
				   Typ			:BooleanTyp;
				   EreignisAktion	:ObjektAktion);

VAR	objekt	:ObjektPtr;
	i	:INTEGER;

BEGIN
objekt := erzeugeEinfachesObjekt (Fenster, X,Y, Text, Nummer, EreignisAktion);
CASE Typ OF
  wechseln:
    INCL (objekt^.gadget.activation, toggleSelect);
    objekt^.Typ := wechseln
| melden:
    (* weiter nichts nötig! *)
| wiederholen:
    INCL (objekt^.gadget.activation, gadgImmediate);
    objekt^.Typ := wiederholen
  END;
i := AddGadget (Fenster, ADR (objekt^.gadget), -1);
RefreshGList (ADR (objekt^.gadget), Fenster, NIL, 1)
END erzeugeBooleanObjekt;


(* -------------------------------------------------------------------------- *)
PROCEDURE erzeugePropObjekt     (    Fenster		:WindowPtr;
				     X,Y,
				     Breite,Hoehe,
				     Nummer		:INTEGER;
				     Typ		:ProportionalTyp;
				     EreignisAktion :ObjektAktion) :ObjektPtr;

VAR	objekt	:ObjektPtr;

BEGIN
objekt := erzeugeEinfachesObjekt (Fenster, X,Y, "", Nummer, EreignisAktion);
objekt^.Typ := Typ;
WITH objekt^ DO
  WITH gadget DO
    width := Breite;
    height := Hoehe;
    IF Typ = wiederholen THEN
      INCL (activation, gadgImmediate);
      END;
    gadgetType := propGadget + GadgetTyp;
    gadgetText := NIL;
    specialInfo := ADR (Prop)
    END;
  makeBorder (RandXY, Breite+2, Hoehe+2);
  initPropInfo (Prop,
  		PropInfoFlagSet {autoKnob},
  		0, 0, maxBody, maxBody);
  RETURN objekt
  END
END erzeugePropObjekt;


PROCEDURE erzeugeHPropObjekt    (    Fenster		:WindowPtr;
				     X,Y,
				     Breite,Hoehe	:INTEGER;
				     Position,
				     MaxPosition	:CARDINAL;
				     Nummer		:INTEGER;
				     Typ		:ProportionalTyp;
				     EreignisAktion 	:ObjektAktion);

VAR	objekt		:ObjektPtr;
	i		:INTEGER;

BEGIN
objekt := erzeugePropObjekt (Fenster, X,Y, Breite,Hoehe, Nummer, Typ,
                             EreignisAktion);
WITH objekt^ DO
  WITH Prop DO
    horizPot := Position;
    horizBody := MaxPosition;
    vertPot := 0;
    vertBody := maxBody;
    INCL (flags, freeHoriz)
    END;
  i := AddGadget (Fenster, ADR (gadget), -1);
  RefreshGList (ADR (gadget), Fenster, NIL, 1)
  END
END erzeugeHPropObjekt;


PROCEDURE erzeugeVPropObjekt    (    Fenster		:WindowPtr;
				     X,Y,
				     Breite,Hoehe	:INTEGER;
				     Position,
				     MaxPosition	:CARDINAL;
				     Nummer		:INTEGER;
				     Typ		:ProportionalTyp;
				     EreignisAktion 	:ObjektAktion);

VAR	objekt		:ObjektPtr;
	i		:INTEGER;

BEGIN
objekt := erzeugePropObjekt (Fenster, X,Y, Breite,Hoehe, Nummer, Typ,
                             EreignisAktion);
WITH objekt^ DO
  WITH Prop DO
    horizPot := 0;
    horizBody := maxBody;
    vertPot := Position;
    vertBody := MaxPosition;
    INCL (flags, freeVert)
    END;
  i := AddGadget (Fenster, ADR (gadget), -1);
  RefreshGList (ADR (gadget), Fenster, NIL, 1)
  END
END erzeugeVPropObjekt;


PROCEDURE erzeugeHVPropObjekt   (    Fenster		:WindowPtr;
				     X,Y,
				     Breite,Hoehe	:INTEGER;
				     HPosition,
				     VPosition,
				     HMaxPosition,
				     VMaxPosition	:CARDINAL;
				     Nummer		:INTEGER;
				     Typ		:ProportionalTyp;
				     EreignisAktion 	:ObjektAktion);

VAR	objekt		:ObjektPtr;
	i		:INTEGER;

BEGIN
objekt := erzeugePropObjekt (Fenster, X,Y, Breite,Hoehe, Nummer, Typ,
                             EreignisAktion);
WITH objekt^ DO
  WITH Prop DO
    horizPot := HPosition;
    horizBody := HMaxPosition;
    vertPot := VPosition;
    vertBody := VMaxPosition;
    flags := flags + PropInfoFlagSet {freeHoriz, freeVert}
    END;
  i := AddGadget (Fenster, ADR (gadget), -1);
  RefreshGList (ADR (gadget), Fenster, NIL, 1)
  END
END erzeugeHVPropObjekt;


(* -------------------------------------------------------------------------- *)
PROCEDURE erzeugeEingabeObjekt	(    Fenster		:WindowPtr;
				     X,Y		:INTEGER;
				     Text		:ARRAY OF CHAR;
				     Nummer		:INTEGER;
				     xText,yText	:INTEGER;
				     DisplayLaenge,
				     EingabeLaenge	:CARDINAL;
				     EingabeOK		:PruefeEingabe;
				 VAR EingabeSatz     :ARRAY OF CHAR) :ObjektPtr;

VAR	objekt	:ObjektPtr;

BEGIN
objekt := erzeugeEinfachesObjekt (Fenster, X,Y, Text,Nummer,standardTextAktion);
Allocate (objekt^.Satz.DisplaySatz, DisplayLaenge+1);
Assert (objekt^.Satz.DisplaySatz # NIL,
	ADR (keinSpeicher));
WITH objekt^ DO
  Satz.DisplayZSInfo := benutzeZeichensatz (EingabeZSInfo);
  WITH gadget DO
    activation := ActivationFlagSet {gadgImmediate};
    width := INTEGER (DisplayLaenge) * frageZeichenBreite (Satz.DisplayZSInfo);
    height := frageZeichenHoehe (Satz.DisplayZSInfo);
    END;
  Typ := eingeben;
  WITH InfoText DO
    leftEdge := xText;
    topEdge := yText;
    frontPen := TextFarbeVorne;
    backPen := TextFarbeHinten;
    nextText := ADR (Satz.DisplayText)
    END;
  WITH Rand DO
    leftEdge := 0;
    topEdge := frageZeichenHoehe (Satz.DisplayZSInfo); (* +1 *)
    frontPen := LinienFarbeVorne;
    backPen := LinienFarbeHinten;
    count := 2
    END;
  RandXY[3] := INTEGER (DisplayLaenge) *frageZeichenBreite (Satz.DisplayZSInfo);
  WITH Satz DO
    initIntuiText (DisplayText,
		   EingabeFarbeVorne, EingabeFarbeHinten,
		   jam2,
		   0,0,					(* Left, Top *)
		   frageAttribute (DisplayZSInfo),
		   ADR (DisplaySatz^),
		   NIL);
    Cursor := 1;
    Offset := 0;
    Laenge := EingabeLaenge;
    NachkommaStellen := 0;
    linkerNachbar := NIL;
    rechterNachbar := NIL;
    untererNachbar := NIL;
    obererNachbar := NIL;
    EingabeZulaessig := EingabeOK;
    cardPtr := NIL
    END;
  Satz.DisplayLaenge := DisplayLaenge;
  Satz.EingabeSatz := ADR (EingabeSatz);
  fuelleDisplay (EingabeSatz, 0, DisplayLaenge, Satz.DisplaySatz^)
  END;
RETURN objekt
END erzeugeEingabeObjekt;


(* -------------------------------------------------------------------------- *)
PROCEDURE erzeugeTextObjekt	(    Fenster		:WindowPtr;
				     X,Y		:INTEGER;
				     Text		:ARRAY OF CHAR;
				     Nummer		:INTEGER;
				     xText,yText	:INTEGER;
				     DisplayLaenge,
				     EingabeLaenge	:CARDINAL;
				     EingabeOK		:PruefeEingabe;
				 VAR EingabeSatz	:ARRAY OF CHAR);

VAR	objekt		:ObjektPtr;
	i		:INTEGER;

BEGIN
objekt := erzeugeEingabeObjekt (Fenster, X,Y, Text, Nummer, xText,yText,
                                DisplayLaenge, EingabeLaenge, EingabeOK,
                                EingabeSatz);
i := AddGadget (Fenster, ADR (objekt^.gadget), -1);
RefreshGList (ADR (objekt^.gadget), Fenster, NIL, 1)
END erzeugeTextObjekt;


(* -------------------------------------------------------------------------- *)
PROCEDURE erzeugeZahlObjekt	(    Fenster		:WindowPtr;
				     X,Y		:INTEGER;
				     Text		:ARRAY OF CHAR;
				     Nummer,
				     xText,yText	:INTEGER;
				     EingabeLaenge,
				     NachkommaStellen	:CARDINAL;
				     ZahlTyp		:EingabeTyp;
				     EingabeOK		:PruefeEingabe;
				     ZahlPtr		:ADDRESS) :ObjektPtr;

VAR	EingabeSatz	:SatzPtr;
	objekt		:ObjektPtr;

BEGIN
Allocate (EingabeSatz, EingabeLaenge+2);
Assert (EingabeSatz # NIL, ADR (keinSpeicher));
EingabeSatz^ := " ";
objekt := erzeugeEingabeObjekt (Fenster, X,Y, Text, Nummer, xText,yText,
                                EingabeLaenge, EingabeLaenge, EingabeOK,
                                EingabeSatz^);
objekt^.Satz.NachkommaStellen := NachkommaStellen;
WITH objekt^.Satz DO
  Typ := ZahlTyp;
  cardPtr := ZahlPtr
  END;
RETURN objekt
END erzeugeZahlObjekt;


PROCEDURE zeigeZahlObjekt	(    objekt		:ObjektPtr);

VAR	i	:INTEGER;

BEGIN
erzeugeStandardEingabe (objekt);
WITH objekt^ DO
  WITH Satz DO
    fuelleDisplay (EingabeSatz^, Offset, Laenge, DisplaySatz^)
    END;
  i := AddGadget (Fenster, ADR (gadget), -1);
  RefreshGList (ADR (gadget), Fenster, NIL, 1)
  END
END zeigeZahlObjekt;


PROCEDURE erzeugeCardObjekt	(    Fenster		:WindowPtr;
				     X,Y		:INTEGER;
				     Text		:ARRAY OF CHAR;
				     Nummer,
				     xText,yText	:INTEGER;
				     EingabeLaenge	:CARDINAL;
				     EingabeOK		:PruefeEingabe;
				 VAR EingabeZahl	:CARDINAL);

VAR	objekt		:ObjektPtr;

BEGIN
objekt := erzeugeZahlObjekt (Fenster, X,Y, Text, Nummer, xText,yText,
                             EingabeLaenge, 0, card, EingabeOK,
                             ADR (EingabeZahl));
zeigeZahlObjekt (objekt)
END erzeugeCardObjekt;


PROCEDURE erzeugeLongCardObjekt	(    Fenster		:WindowPtr;
				     X,Y		:INTEGER;
				     Text		:ARRAY OF CHAR;
				     Nummer,
				     xText,yText	:INTEGER;
				     EingabeLaenge	:CARDINAL;
				     EingabeOK		:PruefeEingabe;
				 VAR EingabeZahl	:LONGCARD);

VAR	objekt		:ObjektPtr;

BEGIN
objekt := erzeugeZahlObjekt (Fenster, X,Y, Text, Nummer, xText,yText,
                             EingabeLaenge, 0, lcard, EingabeOK,
                             ADR (EingabeZahl));
zeigeZahlObjekt (objekt)
END erzeugeLongCardObjekt;


PROCEDURE erzeugeIntObjekt	(    Fenster		:WindowPtr;
				     X,Y		:INTEGER;
				     Text		:ARRAY OF CHAR;
				     Nummer,
				     xText,yText	:INTEGER;
				     EingabeLaenge	:CARDINAL;
				     EingabeOK		:PruefeEingabe;
				 VAR EingabeZahl	:INTEGER);

VAR	objekt		:ObjektPtr;

BEGIN
objekt := erzeugeZahlObjekt (Fenster, X,Y, Text, Nummer, xText,yText,
                             EingabeLaenge, 0, int, EingabeOK,
                             ADR (EingabeZahl));
zeigeZahlObjekt (objekt)
END erzeugeIntObjekt;


PROCEDURE erzeugeLongIntObjekt	(    Fenster		:WindowPtr;
				     X,Y		:INTEGER;
				     Text		:ARRAY OF CHAR;
				     Nummer,
				     xText,yText	:INTEGER;
				     EingabeLaenge	:CARDINAL;
				     EingabeOK		:PruefeEingabe;
				 VAR EingabeZahl	:LONGINT);

VAR	objekt		:ObjektPtr;

BEGIN
objekt := erzeugeZahlObjekt (Fenster, X,Y, Text, Nummer, xText,yText,
                             EingabeLaenge, 0, lint, EingabeOK,
                             ADR (EingabeZahl));
zeigeZahlObjekt (objekt)
END erzeugeLongIntObjekt;


PROCEDURE erzeugeRealObjekt	(    Fenster		:WindowPtr;
				     X,Y		:INTEGER;
				     Text		:ARRAY OF CHAR;
				     Nummer,
				     xText,yText	:INTEGER;
				     EingabeLaenge,
				     NachkommaStellen	:CARDINAL;
				     Exponent		:BOOLEAN;
				     EingabeOK		:PruefeEingabe;
				 VAR EingabeZahl	:REAL);

VAR	objekt		:ObjektPtr;

BEGIN
objekt := erzeugeZahlObjekt (Fenster, X,Y, Text, Nummer, xText,yText,
                             EingabeLaenge, NachkommaStellen, real,
                             EingabeOK, ADR (EingabeZahl));
objekt^.Satz.Exponent := Exponent;
zeigeZahlObjekt (objekt)
END erzeugeRealObjekt;


PROCEDURE erzeugeLongRealObjekt	(    Fenster		:WindowPtr;
				     X,Y		:INTEGER;
				     Text		:ARRAY OF CHAR;
				     Nummer,
				     xText,yText	:INTEGER;
				     EingabeLaenge,
				     NachkommaStellen	:CARDINAL;
				     Exponent		:BOOLEAN;
				     EingabeOK		:PruefeEingabe;
				 VAR EingabeZahl	:LONGREAL);

VAR	objekt		:ObjektPtr;

BEGIN
objekt := erzeugeZahlObjekt (Fenster, X,Y, Text, Nummer, xText,yText,
                             EingabeLaenge, NachkommaStellen, lreal,
                             EingabeOK, ADR (EingabeZahl));
objekt^.Satz.Exponent := Exponent;
zeigeZahlObjekt (objekt)
END erzeugeLongRealObjekt;


PROCEDURE erzeugeFFPObjekt	(    Fenster		:WindowPtr;
				     X,Y		:INTEGER;
				     Text		:ARRAY OF CHAR;
				     Nummer,
				     xText,yText	:INTEGER;
				     EingabeLaenge,
				     NachkommaStellen	:CARDINAL;
				     Exponent		:BOOLEAN;
				     EingabeOK		:PruefeEingabe;
				 VAR EingabeZahl	:FFP);

VAR	objekt		:ObjektPtr;

BEGIN
objekt := erzeugeZahlObjekt (Fenster, X,Y, Text, Nummer, xText,yText,
                             EingabeLaenge, NachkommaStellen, ffp,
                             EingabeOK, ADR (EingabeZahl));
objekt^.Satz.Exponent := Exponent;
zeigeZahlObjekt (objekt)
END erzeugeFFPObjekt;


(* -------------------------------------------------------------------------- *)
PROCEDURE stopModul;

VAR	Info		:FensterInfoPtr;
	objekt		:ObjektPtr;

BEGIN
WHILE FensterInfoListe # NIL DO
  Info := FensterInfoListe;
  FensterInfoListe := Info^.NaechsteInfo;
  entferneCursor (Info);
  WHILE Info^.ObjektListe # NIL DO
    objekt := Info^.ObjektListe;
    Info^.ObjektListe := objekt^.NaechstesObjekt;
    entferneObjekt (objekt)
    END;
  entferneFensterInfo (Info)
  END;
WHILE ZSInfoListe # NIL DO
  schliesseZSInfo (ZSInfoListe)
  END
END stopModul;


(* -------------------------------------------------------------------------- *)
BEGIN
FensterInfoListe := NIL;
ZSInfoListe := NIL;
NachrichtPtr := NIL;
TermProcedure (stopModul);

setzeTextFarbe (1, 0);
setzeRandFarbe (2, 0);
setzeEingabeFarbe (1, 0);
setzeLinienFarbe (3, 0);
setzeTextZeichensatz ("topaz.font", 8, FontStyleSet {});
setzeEingabeZeichensatz ("topaz.font", 8, FontStyleSet {});
setzeRand (einfach)
END IntuitionObjekte.
