(*---------------------------------------------------------------------
    :Program.    ChIconType
    :Author.     Philippe Gressly
    :Address.    Näfenhaus, CH-8926 Kappel a/Albis
    :History.    V1.0, Jul-1990, Philippe Gressly
    :Copyright.  PD
    :Language.   Modula-II
    :Translator. M2Amiga 3.3
    :Contents.   Das Programm ändert an einem Icon den Typ
    :Contents.   z.B. Project --> Tool
    :Contents.   Eigentlich wird nur das Gadget beim Icon vom richtigen
    :Contents.   Typ angehängt.
    :Remark.
---------------------------------------------------------------------*)

MODULE ChIconType; (* $V- $S- $F- *)


FROM Workbench IMPORT DiskObjectPtr;
FROM Intuition IMPORT Gadget;
FROM Icon      IMPORT GetDiskObject, PutDiskObject, FreeDiskObject;
FROM InOut     IMPORT WriteString, WriteLn, ReadString, Read;
FROM Arts      IMPORT TermProcedure, Terminate, CurrentLevel, Assert;
FROM SYSTEM    IMPORT ADR;


VAR Icon1, Icon2: DiskObjectPtr;
    (* Icon1 bezeichnet dasjenige Icon mit dem richtigen Gadget.
     * Icon2 bezeichnet dasjenige Icon mit dem richtigen Typ.
     *)



PROCEDURE Clean;
(* Beim verlassen des Programmes den Speicher zurückgeben! *)
BEGIN
   IF Icon1 # NIL THEN FreeDiskObject(Icon1) END;
   IF Icon2 # NIL THEN FreeDiskObject(Icon2) END;
END Clean;



PROCEDURE Correct(): BOOLEAN;
(* Die Procedur fragt den Anwender, ob seine Daten korrekt waren.*)
(* Waren die Daten korrekt, so kommt TRUE zurück. *)
(* Der Anwender hat hier noch die Möglichkeit das Programm zu verlassen. *)
VAR ch, ret: CHAR;
BEGIN
   WriteString("Sind die Angaben OK ???"); WriteLn; WriteLn;
   WriteString("(E) für ENDE"); WriteLn;
   WriteString("(N) für NICHT OK (will Angaben ändern)"); WriteLn;
   WriteString("(O) für OK : ");
   Read(ch);
   Read(ret);
   IF CAP(ch) = "E" THEN Terminate(CurrentLevel()) END;
   RETURN CAP(ch) # "N"
END Correct;



VAR res         : BOOLEAN;(* Rückgabewerte von PutDiskIcon *)
    TempGad     : Gadget; (* Um den Speicher korrekt zurückzugeben *)
    Icon1Name,
    Icon2Name   : ARRAY [0..255] OF CHAR;
                          (* Die Namen der Icons *)

BEGIN (* ChIconType: Hauptprogramm *)

   Icon1 := NIL;
   Icon2 := NIL;
   TermProcedure(Clean);

   REPEAT
      WriteString("Name des Icons, dessen Typ zu ändern ist: ");
      ReadString(Icon1Name);
      WriteString("Irgend   ein   Icon  mit  richtigem  Typ: ");
      ReadString(Icon2Name);
   UNTIL Correct();

   Icon1 := GetDiskObject(ADR(Icon1Name));
   Icon2 := GetDiskObject(ADR(Icon2Name));
   Assert((Icon1 # NIL) AND (Icon2 # NIL),
          ADR("Konnte ein Icon nicht finden!!"));

  (* Hier alle Icon OK *)

   TempGad := Icon2^.gadget;
   Icon2^.gadget := Icon1^.gadget;
   res := PutDiskObject(ADR(Icon1Name), Icon2);
   Icon2^.gadget := TempGad;

   IF res THEN
      WriteString('Operation "ICON" gelungen')
   ELSE
      WriteString("ERROR beim zurückschreiben des Icons!")
   END;
   WriteLn

END ChIconType.