(*---------------------------------------------------------------------------
 :Program.      WBFarben
 :Author.       Thomas Ansorge
 :Address.      Dinkelackerring 55, D-6730 Neustadt
 :Copyright.    FD
 :Language.     Modula-II
 :Translator.   M2Amiga 3.3d
 :History.      V2.0  13-Jun-90 von Thomas Ansorge
 :Contents.     Program to set Preferences
 :Usage.        WBFarben
---------------------------------------------------------------------------*)

(* $F- $R- $S- $V- was soll der Blödsinn??? [fbs] *)

MODULE WBFarben;

(*********************************************************************)
(*                                                                   *)
(* © 1990 by Thomas Ansorge, Dinkelackerring 55, D-6730 Neustadt     *)
(*                                                                   *)
(* Version : 2.0 vom 13.06.1990                                      *)
(*                                                                   *)
(* Sprache : MODULA-2 (M2Amiga V3.3d)                                *)
(*                                                                   *)
(* Funktion: Dieses Programm gestattet das schnelle Hin- und         *)
(*           Herschalten zwischen den original Commodore-Workbench-  *)
(*           farben und vom Anwender definierten Farben über zwei    *)
(*           Gadgets. Die Maus ist davon nicht betroffen.            *)
(*                                                                   *)
(* Danke   : an Fridtjof, der mich auf einen Fehler in der Version   *)
(*           1.0 aufmerksam machte.                                  *)
(*                                                                   *)
(*********************************************************************)

FROM Arts IMPORT TermProcedure, RemoveTermProc, Assert;

FROM Intuition IMPORT ScreenFlags, ScreenFlagSet,
                      NewWindow, Window, WindowPtr, OpenWindow,
                      CloseWindow, IDCMPFlags, IDCMPFlagSet,
                      WindowFlags, WindowFlagSet,
                      Border,
                      Gadget, GadgetPtr, GadgetFlags, GadgetFlagSet,
                      ActivationFlags, ActivationFlagSet, boolGadget,
                      IntuiText,
                      IntuiMessage, IntuiMessagePtr,
                      Preferences, GetDefPrefs, GetPrefs, SetPrefs;

FROM Exec IMPORT WaitPort, GetMsg, ReplyMsg;

FROM Graphics IMPORT ViewPort, ViewModes, ViewModeSet,
                     jam2;

FROM SYSTEM IMPORT ADR,
                   LONGSET;

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

VAR (* das Fenster mit den Gadgets *)
    NeuesFenster : NewWindow;
    Fenster      : WindowPtr;

    (* der Nachrichtenport *)
    Nachricht    : IntuiMessagePtr;
    Flags        : IDCMPFlagSet;
    Adresse      : GadgetPtr;
    Nummer       : INTEGER;

    (* die Gadgets *)
    Original,
    Anwender     : Gadget;
    OriginalText,
    AnwenderText : IntuiText;
    Rahmen       : Border;
    Ecken        : ARRAY [0..9] OF INTEGER;

    (* die Farben *)
    Farben       : ARRAY [0..1], [0..3] OF CARDINAL;

    (* der Preferences-Record *)
    Prefs        : Preferences;

    (* diverses *)
    i            : LONGINT;

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

PROCEDURE Ende;

   (* räumt nach einem gewaltsamen Programmabbruch auf               *)

   BEGIN (* Prozedur Ende *)

   IF Fenster # NIL THEN
      CloseWindow (Fenster);
   END (* If Fenster *);
END Ende (* Prozedur *);

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

BEGIN (* Modul WBFarben *)

Fenster := NIL;

TermProcedure (Ende);

(* Farben merken *)
GetDefPrefs (ADR (Prefs), SIZE (Prefs));

WITH Prefs DO
   Farben [0, 0] := color0;
   Farben [0, 1] := color1;
   Farben [0, 2] := color2;
   Farben [0, 3] := color3;
END (* With Prefs *);

(* aktuelle Farben aus dem Preferences-Record *)
GetPrefs (ADR (Prefs), SIZE (Prefs));

WITH Prefs DO
   Farben [1, 0] :=  color0;
   Farben [1, 1] :=  color1;
   Farben [1, 2] :=  color2;
   Farben [1, 3] :=  color3;
END (* With Prefs *);

(* Fenster mit Gadgets initialisieren und öffnen *)

Ecken [0] :=  0;   Ecken [1] := 0;
Ecken [2] := 81;   Ecken [3] := 0;
Ecken [4] := 81;   Ecken [5] := 9;
Ecken [6] :=  0;   Ecken [7] := 9;
Ecken [8] :=  0;   Ecken [9] := 0;

WITH Rahmen DO
   leftEdge := -1;
   topEdge := -1;
   frontPen := 3;
   backPen := 0;
   drawMode := jam2;
   count := 5;
   xy := ADR (Ecken);
   nextBorder := NIL;
END (* With Rahmen *);

WITH AnwenderText DO
   frontPen := 1;
   backPen := 0;
   drawMode := jam2;
   leftEdge := 0;
   topEdge := 0;
   iTextFont := NIL;
   iText := ADR (" Anwender ");
   nextText := NIL;
END (* With AnwenderText *);

OriginalText := AnwenderText;
OriginalText.iText := ADR (" Original ");

WITH Anwender DO
   nextGadget := NIL;
   leftEdge := 93;
   topEdge := 12;
   width := 80;
   height := 8;
   flags := GadgetFlagSet {gadgHBox};
   activation := ActivationFlagSet {relVerify};
   gadgetType := boolGadget;
   gadgetRender := ADR (Rahmen);
   selectRender := NIL;
   gadgetText := ADR (AnwenderText);
   mutualExclude := LONGSET {};
   specialInfo := NIL;
   gadgetID := 1;
   userData := NIL;
END (* With Anwender *);

Original := Anwender;

WITH Original DO
   nextGadget := ADR (Anwender);
   leftEdge := 5;
   gadgetText := ADR (OriginalText);
   gadgetID := 0;
END (* With Original *);

WITH NeuesFenster DO
   leftEdge := 0;
   topEdge := 11;
   width := 178;
   height := 23;
   detailPen := 0;
   blockPen := 1;
   idcmpFlags := IDCMPFlagSet {gadgetUp, closeWindow, newPrefs};
   flags := WindowFlagSet {windowDrag, windowDepth, windowClose};
   firstGadget := ADR (Original);
   checkMark := NIL;
   title := ADR ("WBFarben");
   screen := NIL;
   bitMap := NIL;
   minWidth := width;
   minHeight := height;
   maxWidth := width;
   maxHeight := height;
   type := ScreenFlagSet {wbenchScreen};
END (* With NeuesFenster *);

Fenster := OpenWindow (NeuesFenster);

Assert (Fenster # NIL, ADR ("konnte Fenster nicht öffnen!"));

(* auf Nachricht warten und reagieren *)

REPEAT
   WaitPort (Fenster^.userPort);
   Nachricht := GetMsg (Fenster^.userPort);

   IF Nachricht # NIL THEN
      Flags := Nachricht^.class;
      Adresse := Nachricht^.iAddress;
      ReplyMsg (Nachricht);

      IF newPrefs IN Flags THEN
         (* neue WB-Farben eingestellt *)
         GetPrefs (ADR (Prefs), SIZE (Prefs));

         WITH Prefs DO
            IF NOT ((color0 = Farben [0, 0]) AND
                    (color1 = Farben [0, 1]) AND
                    (color2 = Farben [0, 2]) AND
                    (color3 = Farben [0, 3])    ) THEN
               (* Programm hat sich nicht selbst benachrichtigt *)
               Farben [1, 0] :=  color0;
               Farben [1, 1] :=  color1;
               Farben [1, 2] :=  color2;
               Farben [1, 3] :=  color3;
            END (* IF NOT *);
         END (* With Prefs *);
      END (* If newPrefs *);

      IF gadgetUp IN Flags THEN
         (* neue Farben über Preferences-Record einstellen *)
         IF Adresse # NIL THEN
            Nummer := Adresse^.gadgetID;

            GetPrefs (ADR (Prefs), SIZE (Prefs));

            WITH Prefs DO
               color0 := Farben [Nummer, 0];
               color1 := Farben [Nummer, 1];
               color2 := Farben [Nummer, 2];
               color3 := Farben [Nummer, 3];
            END (* With Prefs *);

            SetPrefs (ADR (Prefs), SIZE (Prefs), TRUE);
         END (* If Adresse *);
      END (* If gadgetUp *)
   END (* If Nachricht *);
UNTIL closeWindow IN Flags;

CloseWindow (Fenster);
Fenster := NIL;

RemoveTermProc (Ende);

END WBFarben (* Modul *).