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


:Program.       IMPLEMENTATION MODULE OpenClose

:Contents.      intelligente Open-Funktionen und Close-Prozeduren

:Usage.         einfach importieren und benutzen...


:Copyright.     Public Domain.

:Author.        Thomas Ansorge

:Address.       Dinkelackerring 55, W-6730 Neustadt, Deutschland


:Language.      Modula-2

:Translator.    M2Amiga V4.0 (deutsch)


:Version.       1.4 vom 17.05.1992

:History.       0.9 vom 06.12.1991: erste Tipparbeiten...

:History.       1.0 vom 08.12.1991: Es läuft.

:History.       1.1 vom 21.12.1991:
:History.          - verbesserte Fehlerbehandlung
:History.          - OFont integriert
:History.          - OpenWindow überprüft ggf. Existenz d. Custom-Screens

:History.       1.2 vom 01.01.1992:
:History.          - Verbesserung in CreatePort
:History.          - Verbesserung in CloseWindow

:History.       1.3 vom 07.04.1992:
:History.          - neue Variablen: AFPuffer, DebugMode

:History.       1.4 vom 17.05.1992:
:History.          - neue Funktion OpenScreenTagList
:History.          - neue Variable kick20


:Remark.        Die Dokumentation ist im Definitions-Modul zu finden.


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


IMPLEMENTATION MODULE OpenClose;

(*$ NameChk := FALSE  LargeVars := FALSE  LongAlign := FALSE *)

FROM Arts IMPORT Assert, BreakPoint, kickVersion, Requester;

IMPORT DD: DosD;

IMPORT DL: DosL;

FROM DiskFontD IMPORT AvailFont, AvailFontHeader, AvailFontHeaderPtr,
                      AvailFontTypes, AvailFontsSet;

FROM DiskFontL IMPORT AvailFonts, OpenDiskFont;

IMPORT ED: ExecD;

IMPORT ES: ExecSupport;

FROM ExecL IMPORT FindPort, Forbid, Permit;

IMPORT GD: GraphicsD;

IMPORT GL: GraphicsL;

FROM Heap IMPORT Allocate, Deallocate, Largest;

IMPORT ID: IntuitionD;

IMPORT IL: IntuitionL;

FROM String IMPORT Compare;

FROM SYSTEM IMPORT ADDRESS, ADR, BPTR, CAST;

IMPORT UD: UtilityD;

(* --------------------------------------------------------------------- *)

TYPE ResourcenTyp = (file, font, port, screen, window);

     ResourcenListePtr = POINTER TO ResourcenListe;
     ResourcenListe    = RECORD
                            Knoten : ED.MinNode;
                            Adresse: ADDRESS;
                            Typ    : ResourcenTyp;
                         END (* RECORD ResourcenListe *);

VAR ResListePtr: ResourcenListePtr; (* im folgenden global *)
    HilfePtr   : ResourcenListePtr; (* wird nur im CLOSE-Teil gebraucht *)

    AFPufferPtrMem,
    AFPufferPtrDisk : AvailFontHeaderPtr; (* global für OpenFont *)

(* --------------------------------------------------------------------- *)

(* Die Funktionen und Prozeduren dieses Moduls sind der besseren         *)
(* Lesbarkeit desselben wegen alphabetisch geordnet. Da einige           *)
(* Funktionen/Prozeduren andere aufrufen, seien diese, falls nötig, hier *)
(* dem Compiler bekanntgemacht:                                          *)

PROCEDURE ExistiertEintrag (Eintrag: ADDRESS): BOOLEAN; FORWARD;

PROCEDURE HandleError (Text: ARRAY OF CHAR); FORWARD;

PROCEDURE NeuesListenElement (Typ    : ResourcenTyp;
                              Adresse: ADDRESS): BOOLEAN; FORWARD;

(* --------------------------------------------------------------------- *)

PROCEDURE Close (VAR File: DD.FileHandlePtr);

   (* DosSupport kümmert sich zwar bereits um alles, ich möchte aber auf *)
   (* Nummer sicher gehen.                                               *)

   CONST ErrorFile = "Listeneintrag für File nicht gefunden!";

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur Close *);

   IF ExistiertEintrag (File) THEN
      LoescheListenEintrag (File);

      DL.Close (File);

      IF NOT DebugMode THEN
         File := NIL;
      END (* IF NOT DebugMode *);

   ELSE (* IF ExistiertEintrag *)
      IF DebugMode THEN
         BreakPoint (ADR (ErrorFile));
      END (* IF DebugMode *);
   END (* IF ExistiertEintrag *);
END Close (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE CloseFont (VAR Font: GD.TextFontPtr);

   CONST ErrorFont = "Listeneintrag für Font nicht gefunden!";

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur CloseFont *)

   IF ExistiertEintrag (Font) THEN
      LoescheListenEintrag (Font);

      Forbid ();
      GL.CloseFont (Font);
      Permit ();

      IF NOT DebugMode THEN
         Font := NIL;
      END (* IF NOT DebugMode *);

   ELSE (* IF ExistiertEintrag *)
      IF DebugMode THEN
         BreakPoint (ADR (ErrorFont));
      END (* IF DebugMode *);
   END (* IF ExistiertEintrag *);
END CloseFont (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE CloseScreen (VAR Screen: ID.ScreenPtr);

   CONST ErrorScreen1 = "Listeneintrag für Screen nicht gefunden!";
         ErrorScreen2 = "Systemeintrag für Screen nicht gefunden!";

   VAR IBasePtr : ID.IntuitionBasePtr;
       ScreenPtr: ID.ScreenPtr;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur CloseScreen *)

   IF ExistiertEintrag (Screen) THEN
      Forbid ();

      IBasePtr := IL.OpenIntuition ();
      ScreenPtr := IBasePtr^.firstScreen;

      WHILE (ScreenPtr # NIL) AND (ScreenPtr # Screen) DO
         ScreenPtr := ScreenPtr^.nextScreen;
      END (* WHILE *);

      IF ScreenPtr = NIL THEN
         (* der Screen existiert gar nicht mehr! *)

         IF DebugMode THEN
            BreakPoint (ADR (ErrorScreen2));
         END (* IF DebugMode *);

         LoescheListenEintrag (Screen);

      ELSE (* der Screen existiert in beiden Listen *)
         IF Screen^.firstWindow = NIL THEN
            LoescheListenEintrag (Screen);

            IL.CloseScreen (Screen);

            IF NOT DebugMode THEN
               Screen := NIL;
            END (* IF NOT DebugMode *);
         END (* IF Screen^.firstWindow *);
      END (* IF ScreenPtr *);

      Permit ();

   ELSE (* IF ExistiertEintrag *)
      IF DebugMode THEN
         BreakPoint (ADR (ErrorScreen1));
      END (* IF DebugMode *);
   END (* IF ExistiertEintrag *);
END CloseScreen (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE CloseWindow (VAR Window: ID.WindowPtr);

   CONST ErrorWindow1 = "Listeneintrag für Window nicht gefunden!";
         ErrorWindow2 = "Systemeintrag für Window nicht gefunden!";

   VAR IBasePtr: ID.IntuitionBasePtr;
       Screen  : ID.ScreenPtr;
       Fenster : ID.WindowPtr;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur CloseWindow *)

   IBasePtr := NIL;
   Screen := NIL;
   Fenster := NIL;

   IF ExistiertEintrag (Window) THEN
      (* ist das Fenster tatsächlich offen? *)

      Forbid ();
      IBasePtr := IL.OpenIntuition ();

      IF IBasePtr # NIL THEN
         Screen := IBasePtr^.firstScreen;

         REPEAT
            Fenster := Screen^.firstWindow;

            WHILE (Fenster # Window) AND (Fenster # NIL) DO
               Fenster := Fenster^.nextWindow;
            END (* WHILE *);

            IF Fenster # Window THEN
               Screen := Screen^.nextScreen;
            END (* IF Fenster *);
         UNTIL (Fenster = Window) OR (Screen = NIL);
      END (* IF IBasePtr *);

      (* Der Eintrag existiert, muß also gelöscht werden. *)

      LoescheListenEintrag (Window);

      (* Wenn auch das Fenster existiert, muß es geschlossen werden. *)

      IF Fenster = Window THEN
         IL.CloseWindow (Window);

         IF NOT DebugMode THEN
            Window := NIL;
         END (* IF NOT DebugMode *);

      ELSE (* IF Fenster = Window *)
         IF DebugMode THEN
            Permit ();
            BreakPoint (ADR (ErrorWindow2));
            Forbid (); (* für das folgende Permit *)
         END (* IF DebugMode *);
      END (* IF Fenster *);

      Permit ();

   ELSE (* IF ExistiertEintrag *);
      IF DebugMode THEN
         BreakPoint (ADR (ErrorWindow1));
      END (* IF DebugMode *);
   END (* IF ExistiertEintrag *);
END CloseWindow (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE CreatePort (portName: ADDRESS;
                      priority: SHORTINT): ED.MsgPortPtr;

   CONST KeinPort = "Error in OpenClose.CreatePort!";

   VAR PortPtr: ED.MsgPortPtr;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Funktion CreatePort *)

   PortPtr := NIL;

   IF portName # NIL THEN
      Forbid ();
      PortPtr := FindPort (portName);

      IF PortPtr = NIL THEN
         PortPtr := ES.CreatePort (portName, priority);

      ELSE (* Fehler: der Port ist schon da! *)
         PortPtr := NIL;
      END (* IF PortPtr *);

      Permit ();
   END (* IF PortName *);

   IF PortPtr = NIL THEN
      HandleError (KeinPort);
   ELSE (* Port offen *)

      (*$ NilChk := FALSE *)

      IF NOT NeuesListenElement (port, PortPtr) THEN
         Forbid ();
         ES.DeletePort (PortPtr);
         PortPtr := NIL;
         Permit ();

         HandleError (KeinPort);
      END (* IF NOT *);

      (*$ POP NilChk *)

   END (* IF Port *);

   RETURN PortPtr;
END CreatePort (* Funktion *);

(* --------------------------------------------------------------------- *)

PROCEDURE DeallocateAFDiskPuffer;

   (* löscht AFPufferPtrDisk falls vorhanden *)

   BEGIN (* Prozedur DeallocateAFDiskPuffer *)

   IF AFPufferPtrDisk # NIL THEN
      Deallocate (AFPufferPtrDisk);
   END (* IF AFPufferPrtDisk *);
END DeallocateAFDiskPuffer (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE DeallocateAFMemPuffer;

   (* löscht AFPufferPtrMem falls vorhanden *)

   BEGIN (* Prozedur DeallocateAFPuffer *)

   IF AFPufferPtrMem # NIL THEN
      Deallocate (AFPufferPtrMem);
   END (* IF AFPufferPrtMem *);
END DeallocateAFMemPuffer (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE DeletePort (VAR Port: ED.MsgPortPtr);

   CONST ErrorPort = "Listeneintrag für Port nicht gefunden!";

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur DeletePort *)

   IF ExistiertEintrag (Port) THEN
      LoescheListenEintrag (Port);

      Forbid ();
      ES.DeletePort (Port);
      Permit ();

      IF NOT DebugMode THEN
         Port := NIL;
      END (* IF NOT DebugMode *);

   ELSE (* IF ExistiertEintrag *)
      IF DebugMode THEN
         BreakPoint (ADR (ErrorPort));
      END (* IF DebugMode *);
   END (* IF ExistiertEintrag *);
END DeletePort (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE ExistiertEintrag (Eintrag: ADDRESS): BOOLEAN;

   VAR ListenEintrag: ResourcenListePtr;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Funktion ExistiertEintrag *)

   ListenEintrag := ResListePtr;
   
   LOOP
      IF ListenEintrag # NIL THEN
         IF Eintrag = ListenEintrag^.Adresse THEN
            EXIT; (* LOOP *)
         
         ELSE (* IF Eintrag *)
            ListenEintrag := CAST (ResourcenListePtr,
               ListenEintrag^.Knoten.succ);
         END (* IF Eintrag *);
      
      ELSE (* IF ListenEintrag *)
         EXIT; (* LOOP *)
      END (* IF ListenEintrag *);
   END (* LOOP *);

   RETURN (ListenEintrag # NIL);
END ExistiertEintrag (* Funktion *);

(* --------------------------------------------------------------------- *)

PROCEDURE HandleError (Text: ARRAY OF CHAR);

   (* wird im Fehlerfall aufgerufen und veranlaßt eine Fehlerbehandlung  *)
   (* gemäß der Variablen ErrorHandling                                  *)

   BEGIN (* Prozedur ErrorHandling *)

   CASE ErrorHandling OF
      |ErrorAssert    : Assert (FALSE, ADR (Text));

      |ErrorBreakPoint: BreakPoint (ADR (Text));

   ELSE (* ErrorNothing - nichts tun *)
   END (* CASE ErrorHandling OF *);
END HandleError (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE LoescheListenEintrag (Eintrag: ADDRESS);

   VAR ListenEintrag: ResourcenListePtr;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur LoescheListenEintrag *)

   ListenEintrag := ResListePtr;
   
   LOOP
      IF ListenEintrag # NIL THEN
         IF Eintrag # ListenEintrag^.Adresse THEN
            ListenEintrag := CAST (ResourcenListePtr,
               ListenEintrag^.Knoten.succ);
         
         ELSE (* IF Eintrag *)
            EXIT (* LOOP *);
         END (* IF Eintrag *);
      
      ELSE (* IF ListenEintrag *)
         EXIT (* LOOP *);
      END (* IF ListenEintrag *);
   END (* LOOP *);

   IF ListenEintrag # NIL THEN (* sollte so sein *)
      IF (ListenEintrag^.Knoten.succ # NIL) OR
         (ListenEintrag^.Knoten.pred # NIL) THEN
         (* nicht der einzige Eintrag *)

         IF ListenEintrag^.Knoten.succ # NIL THEN
            ListenEintrag^.Knoten.succ^.pred := ListenEintrag^.Knoten.pred;
         END (* IF *);

         IF ListenEintrag^.Knoten.pred # NIL THEN
            ListenEintrag^.Knoten.pred^.succ := ListenEintrag^.Knoten.succ;

         ELSE (* kein Vorgänger - ResListePtr ändern! *)
            ResListePtr := CAST (ResourcenListePtr,
                           ListenEintrag^.Knoten.succ);
         END (* IF *);

      ELSE (* letzter Eintrag! *)
         ResListePtr := NIL;
      END (* IF (ListenEintrag *);

      Deallocate (ListenEintrag);
   END (* IF ListenEintrag *);
END LoescheListenEintrag (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE LoescheResourceEintrag (VAR Eintrag: ResourcenListePtr);

   CONST ErrorText1 = "OpenClose.CloseScreen:";
         ErrorText2 = "Bitte schließen Sie alle Fenster!";
         ErrorOk    = "Ok";

         ErrorFile   = "Sie haben ein File vergessen!";
         ErrorFont   = "Sie haben einen Font vergessen!";
         ErrorPort   = "Sie haben einen Port vergessen!";
         ErrorScreen = "Sie haben einen Screen vergessen!";
         ErrorWindow = "Sie haben ein Window vergessen!";

   VAR Dummy   : BOOLEAN;
       FilePtr : DD.FileHandlePtr;
       Screen  : ID.ScreenPtr;
       Window1,
       Window2 : ID.WindowPtr;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur LoescheResourceEintrag *)

   CASE Eintrag^.Typ OF
      |file  : IF DebugMode THEN
                  BreakPoint (ADR (ErrorFile));
               END (* IF DebugMode *);
               
               FilePtr := BPTR (Eintrag^.Adresse);
               
               Close (FilePtr); (* BPOINTER...GRRRR.... *)

      |font  : IF DebugMode THEN
                  BreakPoint (ADR (ErrorFont));
               END (* IF DebugMode *);

               CloseFont (CAST (GD.TextFontPtr, Eintrag^.Adresse));

      |port  : IF DebugMode THEN
                  BreakPoint (ADR (ErrorPort));
               END (* IF DebugMode *);

               DeletePort (CAST (ED.MsgPortPtr, Eintrag^.Adresse));

      |screen: Screen := CAST (ID.ScreenPtr, Eintrag^.Adresse);

               IF DebugMode THEN
                  BreakPoint (ADR (ErrorScreen));
               END (* IF DebugMode *);

               IF Screen^.firstWindow # NIL THEN
                  Window1 := Screen^.firstWindow;

                  WHILE Window1 # NIL DO
                     Window2 := Window1;
                     Window1 := Window1^.nextWindow;

                     CloseWindow (Window2);
                  END (* WHILE Window1 *);
               END (* IF Screen^. *);

               WHILE Screen^.firstWindow # NIL DO
                  Dummy := Requester (ADR (ErrorText1), ADR (ErrorText2),
                              ADR (ErrorOk), ADR (ErrorOk));
               END (* WHILE Screen^ *);

               CloseScreen (CAST (ID.ScreenPtr, Eintrag^.Adresse));

      |window: IF DebugMode THEN
                  BreakPoint (ADR (ErrorWindow));
               END (* IF DebugMode *);

               CloseWindow (CAST (ID.WindowPtr, Eintrag^.Adresse));
   END (* CASE Eintrag^.Typ *);
END LoescheResourceEintrag (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE NeuesListenElement (Typ    : ResourcenTyp;
                              Adresse: ADDRESS      ): BOOLEAN;

   (* erstellt einen neuen Listeneintrag. Tritt dabei ein Fehler auf, so *)
   (* gibt es FALSE zurück, andernfalls TRUE. Die aufrufende Funktion    *)
   (* hat das zu überprüfen und die Resource ggf. selber wieder zu       *)
   (* schließen!                                                         *)

   VAR Eintrag: ResourcenListePtr;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur NeuesListenElement *)

   Eintrag := NIL;

   IF Adresse # NIL THEN

      (*$ NilChk := FALSE *)

      Allocate (Eintrag, SIZE (Eintrag^));

      (*$ POP NilChk *)

      IF Eintrag # NIL THEN
         WITH Eintrag^.Knoten DO
            succ := CAST (ED.MinNodePtr, ResListePtr);
            pred := NIL;
         END (* WITH Eintrag^.Knoten *);

         Eintrag^.Typ := Typ;
         Eintrag^.Adresse := Adresse;

         ResListePtr := Eintrag;

         IF ResListePtr^.Knoten.succ # NIL THEN
            ResListePtr^.Knoten.succ^.pred := CAST (ED.MinNodePtr,
               ResListePtr);
         END (* IF ResListePtr^ *);

      ELSE (* kein Speicher für Eintrag! *)
         RETURN FALSE;
      END (* IF Eintrag # NIL *);

   ELSE (* Resource nicht geöffnet *)
      RETURN FALSE;
   END (* IF Adresse # NIL *);

   RETURN TRUE;
END NeuesListenElement (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE Open (name      : ADDRESS;
                accessMode: LONGINT): DD.FileHandlePtr;

   CONST KeinFile = "Error in OpenClose.Open!";

   VAR FilePtr: DD.FileHandlePtr; (* Achtung! BPOINTER! *)

   (* ------------------------------------------------------------------ *)

   BEGIN (* Funktion Open *)

   FilePtr := NIL;

   FilePtr := DL.Open (name, accessMode);

   IF FilePtr # NIL THEN

      (*$ NilChk := FALSE *)

      IF NOT NeuesListenElement (file, FilePtr) THEN
         DL.Close (FilePtr);
         FilePtr := NIL;

         HandleError (KeinFile);
      END (* IF NOT *);

      (*$ POP NilChk *)

   ELSE (* kein File geöffnet *)
      HandleError (KeinFile);
   END (* IF FilePtr *);

   RETURN FilePtr;
END Open (* Funktion *);

(* --------------------------------------------------------------------- *)

PROCEDURE OpenFont (textAttr: GD.TextAttrPtr): GD.TextFontPtr;

   CONST KeinFont = "Error in OpenClose.OpenFont!";

   TYPE String    = ARRAY [0..80] OF CHAR;
        StringPtr = POINTER TO String;

   VAR AFont   : POINTER TO AvailFont;
       FontPtr : GD.TextFontPtr; (* der Font *)
       i       : CARDINAL;
       PToStr1,
       PToStr2 : POINTER TO ARRAY [0..30] OF CHAR; (* Fontnamen *)
       Ok      : LONGINT;

   (* globale Variablen: AFPuffer, AFPufferPtrMem, AFPufferPtrDisk *)

   (* ------------------------------------------------------------------ *)

   BEGIN (* Funktion OpenFont *)

   FontPtr := NIL;

   IF AFPufferPtrMem = NIL THEN
      REPEAT
         IF Largest (FALSE) >= AFPuffer THEN
            Allocate (AFPufferPtrMem, AFPuffer);
         ELSE (* IF Largest *)
            HandleError (KeinFont);
         END (* IF Largest *);

         Ok := AvailFonts (AFPufferPtrMem, AFPuffer, AvailFontsSet {memory});

         IF Ok # 0 THEN
            Deallocate (AFPufferPtrMem);

            AFPuffer := AFPuffer + Ok;
         END (* IF Ok *);
      UNTIL Ok = 0;
   END (* IF AFPufferPtrMem *);

   AFont := ADR (AFPufferPtrMem^);
   INC (AFont, SIZE (AFPufferPtrMem^.numEntries));

   i := 0;
   PToStr1 := AFont^.attr.name;
   PToStr2 := textAttr^.name;

   WHILE (i < AFPufferPtrMem^.numEntries)
         AND NOT ((Compare (PToStr1^, PToStr2^) = 0)
                  AND (AFont^.attr.ySize = textAttr^.ySize)) DO
      INC (i);

      IF i < AFPufferPtrMem^.numEntries THEN
         INC (AFont, SIZE (AFont^));
         PToStr1 := AFont^.attr.name;
      END (* IF i *);
   END (* WHILE (i *);

   IF i = AFPufferPtrMem^.numEntries THEN
      (* Font nicht im Speicher *)
      IF AFPufferPtrDisk = NIL THEN
         REPEAT
            IF Largest (FALSE) >= AFPuffer THEN
               Allocate (AFPufferPtrDisk, AFPuffer);
            ELSE (* IF Largest *)
               HandleError (KeinFont);
            END (* IF Largest *);

            Ok := AvailFonts (AFPufferPtrDisk, AFPuffer, AvailFontsSet {disk});

            IF Ok # 0 THEN
               Deallocate (AFPufferPtrDisk);

               AFPuffer := AFPuffer + Ok;
            END (* IF Ok *);
         UNTIL Ok = 0;
      END (* IF AFPufferPtrDisk *);

      AFont := ADR (AFPufferPtrDisk^);
      INC (AFont, SIZE (AFPufferPtrDisk^.numEntries));

      i := 0;
      PToStr1 := AFont^.attr.name;

      WHILE (i < AFPufferPtrDisk^.numEntries)
            AND NOT ((Compare (PToStr1^, PToStr2^) = 0)
                     AND (AFont^.attr.ySize = textAttr^.ySize)) DO
         INC (i);

         IF i < AFPufferPtrDisk^.numEntries THEN
            INC (AFont, SIZE (AFont^));
            PToStr1 := AFont^.attr.name;
         END (* IF i *);
      END (* WHILE (i *);

      IF i >= AFPufferPtrDisk^.numEntries THEN
         HandleError (KeinFont);

      ELSE (* IF i >= *)
         IF NOT RememberAFPuffer THEN
            DeallocateAFDiskPuffer;
         END (* IF NOT *);

         FontPtr := OpenDiskFont (textAttr);

         DeallocateAFMemPuffer;
      END (* IF i *);
   ELSE (* doch ROM-Font *)
      IF NOT RememberAFPuffer THEN
         DeallocateAFMemPuffer;
      END (* IF NOT *);

      FontPtr := GL.OpenFont (textAttr);
   END (* IF i = *);

   IF FontPtr = NIL THEN
      HandleError (KeinFont);

   ELSE (* Font offen *)

      (*$ NilChk := FALSE *)

      IF NOT NeuesListenElement (font, FontPtr) THEN
         Forbid ();
         GL.CloseFont (FontPtr);
         FontPtr := NIL;
         Permit ();

         HandleError (KeinFont);
      END (* IF NOT *);

      (*$ POP NilChk *)

   END (* IF FontPtr *);

   RETURN FontPtr;
END OpenFont (* Funktion *);

(* --------------------------------------------------------------------- *)

PROCEDURE OpenScreen (VAR newScreen: ID.NewScreen): ID.ScreenPtr;

   CONST KeinScreen = "Error in OpenClose.OpenScreen!";

   VAR ScreenPtr: ID.ScreenPtr;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Funktion OpenScreen *)

   ScreenPtr := NIL;

   Forbid ();
   ScreenPtr := IL.OpenScreen (newScreen);
   Permit ();

   IF ScreenPtr # NIL THEN

      (*$ NilChk := FALSE *)

      IF NOT NeuesListenElement (screen, ScreenPtr) THEN
         Forbid ();
         IL.CloseScreen (ScreenPtr);
         ScreenPtr := NIL;
         Permit ();

         HandleError (KeinScreen);
      END (* IF NOT *);

      (*$ POP NilChk *)

   ELSE (* kein Screen geöffnet *)
      HandleError (KeinScreen);
   END (* IF ScreenPtr *);

   RETURN ScreenPtr;
END OpenScreen (* Funktion *);

(* --------------------------------------------------------------------- *)

PROCEDURE OpenScreenTagList (newScreen: ID.NewScreenPtr;
                             tagList  : UD.TagItemPtr
                            ): ID.ScreenPtr;

   CONST KeinScreen = "Error in OpenClose.OpenScreenTagList!";

   VAR ScreenPtr: ID.ScreenPtr;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Funktion OpenScreen *)

   ScreenPtr := NIL;
   
   IF Kick20 THEN
      Forbid ();
      ScreenPtr := IL.OpenScreenTagList (newScreen, tagList);
      Permit ();
   END (* IF Kick20 *);

   IF ScreenPtr # NIL THEN

      (*$ NilChk := FALSE *)

      IF NOT NeuesListenElement (screen, ScreenPtr) THEN
         Forbid ();
         IL.CloseScreen (ScreenPtr);
         ScreenPtr := NIL;
         Permit ();

         HandleError (KeinScreen);
      END (* IF NOT *);

      (*$ POP NilChk *)

   ELSE (* kein Screen geöffnet *)
      HandleError (KeinScreen);
   END (* IF ScreenPtr *);

   RETURN ScreenPtr;
END OpenScreenTagList (* Funktion *);

(* --------------------------------------------------------------------- *)

PROCEDURE OpenWindow (VAR newWindow: ID.NewWindow): ID.WindowPtr;

   CONST KeinFenster = "Error in OpenClose.OpenWindow!";

   VAR IBasePtr : ID.IntuitionBasePtr;
       ScreenPtr: ID.ScreenPtr;
       WindowPtr: ID.WindowPtr;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Funktion OpenWindow *)

   ScreenPtr := NIL;
   WindowPtr := NIL;

   Forbid ();

   IF newWindow.type = ID.customScreen THEN
      IBasePtr := IL.OpenIntuition ();

      IF IBasePtr # NIL THEN
         ScreenPtr := IBasePtr^.firstScreen;

         WHILE (ScreenPtr # NIL) AND (ScreenPtr # newWindow.screen) DO
            ScreenPtr := ScreenPtr^.nextScreen;
         END (* WHILE (ScreenPtr *);
      END (* IF IBasePtr *);

      IF ScreenPtr # NIL THEN
         WindowPtr := IL.OpenWindow (newWindow);
      END (* IF ScreenPtr *);

   ELSE (* workbenchScreen *)
      WindowPtr := IL.OpenWindow (newWindow);
   END (* IF newWindow.type *);

   Permit ();

   IF WindowPtr # NIL THEN

      (*$ NilChk := FALSE *)

      IF NOT NeuesListenElement (window, WindowPtr) THEN
         Forbid ();
         IL.CloseWindow (WindowPtr);
         WindowPtr := NIL;
         Permit ();

         HandleError (KeinFenster);
      END (* IF NOT *);

      (*$ POP NilChk *)

   ELSE (* Fehler beim Öffnen! *)
      HandleError (KeinFenster);
   END (* IF WindowPtr # NIL *);

   RETURN WindowPtr;
END OpenWindow (* Funktion *);

(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)

BEGIN (* IMPLEMENTATION MODULE OpenClose - initialisieren *)

AFPuffer := DefAFPuffer;
AFPufferPtrMem := NIL;
AFPufferPtrDisk := NIL;
DebugMode := DefDebugMode;
Kick20 := (kickVersion >= 37);
RememberAFPuffer := DefRememberAFPuffer;
ResListePtr := NIL;
ErrorHandling := ErrorAssert;

(* --------------------------------------------------------------------- *)

CLOSE; (* IMPLEMENTATION MODULE OpenClose - am Schluß aufräumen *)

WHILE ResListePtr # NIL DO (* ganz schön vergesslich! *)
    HilfePtr := CAST (ResourcenListePtr, ResListePtr^.Knoten.succ);

    LoescheResourceEintrag (ResListePtr);

    ResListePtr := HilfePtr;
END (* WHILE ResListePtr *);

DeallocateAFMemPuffer;
DeallocateAFDiskPuffer;

END OpenClose (* IMPLEMENTATION MODULE *).