(*
  .name       EIcon
  .task       Icon creation
  .release    1.0
  .language   Oberon-2
  .translator Amiga Oberon 3.11
  .system     AmigaOS 2.04/2.1/3.0
  .author     Joachim Barheine
  .address    Hochgrevestraße 3, D-38640 Goslar
  .copyright  (c) 1994 by Joachim Barheine
*)

(* .info: 21/08/94, 13:25:21, version 21 *)

MODULE EIcon; (* $DataChip+ *)

IMPORT
  SYS:= SYSTEM,

  Dos,
  EArgs,
  Err:= ErrCodes,
  Exec,
  I:= Intuition,
  Icon,
  K:= Kernel,
  S:= Strings,
  Wb:= Workbench;

TYPE
  LinePtr* = UNTRACED POINTER TO ARRAY 128 OF CHAR;
  Tooltypes* = UNTRACED POINTER TO ARRAY 4096 OF LinePtr;

  ChipData= ARRAY 2 * 8 * 11 OF INTEGER;

CONST
  edtPrivTooltype* = "(EDT PRIVATE DATA: DO NOT MODIFY)";
  foldTooltype* = "FOLDER=";
  positionTooltype* = "POSITION=";

  imageData= ChipData(
  (* Plane 0 *)
    00000U,00000U,00000U,00400U,00000U,00000U,00000U,00C00U,
    00000U,00000U,00000U,00C00U,007FFU,0FFFFU,0FFE0U,00C00U,
    00400U,00000U,00030U,00C00U,004FEU,00000U,00028U,00C00U,
    00400U,00000U,00024U,00C00U,004FEU,00000U,00022U,00C00U,
    00400U,00000U,0003FU,00C00U,00400U,00000U,00000U,08C00U,
    00403U,0BFDFU,0BF80U,08C00U,00400U,00000U,00000U,08C00U,
    004FFU,077FBU,0FF80U,08C00U,00400U,00000U,00000U,08C00U,
    004FFU,0FFFEU,0FF80U,08C00U,00400U,00000U,00000U,08C00U,
    00400U,00000U,07F80U,08C00U,00400U,00000U,00000U,08C00U,
    007FFU,0FFFFU,0FFFFU,08C00U,00000U,00000U,00000U,00C00U,
    00000U,00000U,00000U,00C00U,07FFFU,0FFFFU,0FFFFU,0FC00U,

  (* Plane 1 *)
    0FFFFU,0FFFFU,0FFFFU,0F800U,0D555U,05555U,05555U,05000U,
    0D555U,05555U,05555U,05000U,0D000U,00000U,00015U,05000U,
    0D3FFU,0FFFFU,0FFC5U,05000U,0D301U,0FFFFU,0FFD5U,05000U,
    0D3FFU,0FFFFU,0FFD9U,05000U,0D301U,0FFFFU,0FFDDU,05000U,
    0D3FFU,0FFFFU,0FFC0U,05000U,0D3FFU,0FFFFU,0FFFFU,05000U,
    0D3FCU,04020U,0407FU,05000U,0D3FFU,0FFFFU,0FFFFU,05000U,
    0D300U,08804U,0007FU,05000U,0D3FFU,0FFFFU,0FFFFU,05000U,
    0D300U,00001U,0007FU,05000U,0D3FFU,0FFFFU,0FFFFU,05000U,
    0D3FFU,0FFFFU,0807FU,05000U,0D3FFU,0FFFFU,0FFFFU,05000U,
    0D000U,00000U,00000U,05000U,0D555U,05555U,05555U,05000U,
    0D555U,05555U,05555U,05000U,08000U,00000U,00000U,00000U
  );

  image= I.Image(
      0, 0,                       (* Upper left corner *)
      54, 22, 2,                  (* Width, Height, Depth *)
      SYS.ADR(imageData),         (* Image data *)
      SHORTSET{0, 1}, SHORTSET{}, (* PlanePick, PlaneOnOff *)
      NIL                         (* Next image *)
  );

  gadget= I.Gadget(
    NIL,                                (* Next Gadget Pointer *)
    0, 0, 54, 22,                       (* Left, Top, Width, Height *)
    {I.gadgImage} + Wb.gadgBackFill,    (* Flags *)
    {I.relVerify, I.gadgImmediate},     (* Activation Flags *)
    I.boolGadget,                       (* Gadget Type *)
    SYS.ADR(image),                     (* Render Image *)
    NIL,                                (* Select Image *)
    NIL,                                (* Gadget Text *)
    LONGSET{},                          (* Mutual Exclude *)
    NIL,                                (* Special Info *)
    0,                                  (* Gadget ID *)
    1                                   (* User Data (Revision) *)
  );

VAR
  icon: Wb.DiskObject;
  toolName: Exec.STRPTR;

PROCEDURE GetTooltypes* (name: ARRAY OF CHAR; VAR dobj: Wb.DiskObjectPtr): Tooltypes;

(* $CopyArrays- *)

BEGIN
  dobj:= Icon.GetDiskObject(name);
  IF dobj = NIL THEN
    RETURN NIL;
  ELSIF dobj.toolTypes = NIL THEN
    Icon.FreeDiskObject(dobj); dobj:= NIL;
    RETURN NIL;
  ELSE
    RETURN SYS.VAL(Tooltypes, dobj.toolTypes);
  END;
END GetTooltypes;

PROCEDURE FreeTooltypes* (dobj: Wb.DiskObjectPtr; VAR tt: Tooltypes);

VAR
  i: INTEGER;

BEGIN
  IF dobj = NIL THEN
    i:= 0;
    WHILE tt[i] # NIL DO
      DISPOSE(tt[i]);
      INC(i);
    END;
    DISPOSE(tt);
  ELSE
    Icon.FreeDiskObject(dobj);
  END;
END FreeTooltypes;

PROCEDURE InitTooltypes* (tt: Tooltypes; name: ARRAY OF CHAR);

VAR
  dobj: Wb.DiskObjectPtr;
  tt0: Tooltypes;
  i0, i: INTEGER;

  PROCEDURE IsTT(tooltype, str: ARRAY OF CHAR): BOOLEAN;

  VAR
    i: INTEGER;

  (* $CopyArrays- *)

  BEGIN
    FOR i:= 0 TO SHORT(LEN(tooltype))-2 DO
      IF tooltype[i] # str[i] THEN RETURN FALSE END;
    END;
    RETURN TRUE;
  END IsTT;

(* $CopyArrays- *)

BEGIN
  i0:= 0; i:= 0;
  tt0:= GetTooltypes(name, dobj);
  IF tt0 # NIL THEN
    WHILE tt0[i0] # NIL DO
      IF (tt0[i0]^ # edtPrivTooltype) & ~IsTT(foldTooltype, tt0[i0]^)
        & ~IsTT(positionTooltype, tt0[i0]^) THEN
        NEW(tt[i]);
        COPY(tt0[i0]^, tt[i]^);
        INC(i);
      END;
      INC(i0);
    END;
    FreeTooltypes(dobj, tt0);
  END;
  tt[i]:= NIL;
END InitTooltypes;

PROCEDURE EqTT(a, b: Tooltypes): BOOLEAN;

VAR
  i: INTEGER;

BEGIN
  IF (a # NIL) & (b # NIL) THEN
    i:= 0;
    WHILE (a[i] # NIL) & (b[i] # NIL) & (a[i]^ = b[i]^) DO INC(i) END;
    RETURN a[i]=b[i];   (* both NIL? *)
  ELSE
    RETURN a=b;
  END;
END EqTT;

(* $IF M2Amiga THEN *)

PROCEDURE PutIcon* (name: ARRAY OF CHAR; tt: Tooltypes);

VAR
  dobj: Wb.DiskObjectPtr;
  old: Exec.APTR;

(* $CopyArrays- *)

BEGIN
  dobj:= Icon.GetDiskObject(name);
  IF dobj = NIL THEN
    dobj:= Icon.GetDiskObject("M2:Icons/txt");
    IF dobj = NIL THEN
      icon.toolTypes:= tt;
      K.Assert(Icon.PutDiskObject(name, SYS.ADR(icon)), Err.eIconNoIcon);
      RETURN;
    END;
  END;
  old:= dobj.toolTypes;
  IF ~EqTT(tt, SYS.VAL(Tooltypes, old)) THEN
    dobj.toolTypes:= tt;
    K.Assert(Icon.PutDiskObject(name, dobj), Err.eIconNoIcon);
  END;
  dobj.toolTypes:= old;
  Icon.FreeDiskObject(dobj);
END PutIcon;

(* $ELSE *)

PROCEDURE PutIcon* (name: ARRAY OF CHAR; tt: Tooltypes);

VAR
  dobj: Wb.DiskObjectPtr;
  old: Exec.APTR;

(* $CopyArrays- *)

BEGIN
  dobj:= Icon.GetDiskObject(name);
  IF dobj = NIL THEN
    icon.toolTypes:= tt;
    K.Assert(Icon.PutDiskObject(name, SYS.ADR(icon)), Err.eIconNoIcon);
    RETURN;
  ELSIF ~EqTT(tt, SYS.VAL(Tooltypes, dobj.toolTypes)) THEN
    old:= dobj.toolTypes;
    dobj.toolTypes:= tt;
    K.Assert(Icon.PutDiskObject(name, dobj), Err.eIconNoIcon);
    dobj.toolTypes:= old;
  END;
  Icon.FreeDiskObject(dobj);
END PutIcon;

(* $END *)

BEGIN
  NEW(toolName);
  COPY(EArgs.edt, toolName^);
  icon.magic:= Wb.diskMagic;
  icon.version:= Wb.diskVersion;
  icon.gadget:= gadget;
  icon.type:= Wb.project;
  icon.defaultTool:= SYS.ADR(toolName^);
  icon.toolTypes:= NIL;
  icon.currentX:= Wb.noIconPosition;
  icon.currentY:= Wb.noIconPosition;
  icon.drawerData:= NIL;
  icon.toolWindow:= NIL;
  icon.stackSize:= 8192;
END EIcon.