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

    :Program.    ToolTypeArgs.mod
    :Contents.   Procedures to get/set ToolType arguments of icons
    :Author.     Nicolas Benezan [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      711/333679
    :Copyright.  Public Domain
    :Language.   Oberon
    :Translator. Amiga Oberon Compler V1.16 [fbs]
    :Imports.    StringOps
    :History.    V1.0 [bne] 11.Jan.1990 (Modula-2 version)
    :History.    V2.0 [bne] 02.Sep.1990 (ported to Oberon)

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

MODULE ToolTypeArgs;

IMPORT d: Dos, e: Exec, ic: Icon, ol: OberonLib, s: SYSTEM, w: Workbench,
       So: StringOps;

TYPE
  CharPtr = POINTER TO CHAR;

VAR
  Icon: w.DiskObjectPtr;
  IconName: ARRAY 80 OF CHAR;
  AdrArray: POINTER TO ARRAY MAX (INTEGER) OF LONGINT;
  NumToolTypes: INTEGER;
  MaxToolTypes: INTEGER;

PROCEDURE MakeNewArg (StringPtr: CharPtr;
                      Len: INTEGER): BOOLEAN;
  VAR
    NewEntry: CharPtr;
  BEGIN
    IF NumToolTypes < MaxToolTypes THEN
      ol.New (NewEntry, Len + 1);
      IF NewEntry # NIL THEN
        AdrArray[NumToolTypes]:= NewEntry;
        INC (NumToolTypes);
        AdrArray[NumToolTypes]:= NIL;
        e.CopyMem (StringPtr^, NewEntry^, Len);
        INC (NewEntry, Len);
        NewEntry^:= CHR (0);
        RETURN TRUE
      END;
    END;
    RETURN FALSE
  END MakeNewArg;

PROCEDURE Len (Char: CharPtr): INTEGER;
  VAR
    Count: INTEGER;
  BEGIN
    Count:= 0;
    WHILE Char^ # CHR (0) DO
      INC (Count);
      INC (Char);
    END;
    RETURN Count;
  END Len;

PROCEDURE FreeIcon*;
  VAR
    Index: INTEGER;
  BEGIN
    Index:= 0;
    WHILE AdrArray[Index] # NIL DO
      DISPOSE (AdrArray[Index]);
      INC (Index);
    END;
    DISPOSE (AdrArray);
    ic.FreeDiskObject (Icon);
  END FreeIcon;

PROCEDURE GetIcon* (Name: ARRAY OF CHAR): BOOLEAN;
  VAR
    CharPtrPtr: POINTER TO CharPtr;
  BEGIN
    ol.New (AdrArray, (MaxToolTypes + 1) * s.SIZE (LONGINT));
    IF AdrArray # NIL THEN
      AdrArray[0]:= NIL;
      So.Assign (Name, IconName);
      Icon:= ic.GetDiskObject (IconName);
      IF Icon # NIL THEN
        CharPtrPtr:= Icon.toolTypes;
        Icon.toolTypes:= AdrArray;
        NumToolTypes:= 0;
        IF CharPtrPtr = NIL THEN
          RETURN TRUE
        END;
        LOOP
          IF CharPtrPtr^ = NIL THEN
            RETURN TRUE
          END;
          IF NOT MakeNewArg (CharPtrPtr^, Len (CharPtrPtr^)) THEN
            EXIT
          END;
          INC (CharPtrPtr, 4);
        END;
        FreeIcon;
      ELSE
        DISPOSE (AdrArray);
      END;
    END;
    RETURN FALSE
  END GetIcon;

PROCEDURE PutIcon* (): BOOLEAN;
  BEGIN
    RETURN ic.PutDiskObject (IconName, Icon)
  END PutIcon;

PROCEDURE GetArg* (    ArgName: ARRAY OF CHAR;
                   VAR Arg: ARRAY OF CHAR): BOOLEAN;
  VAR
    StringPtr: CharPtr;
  BEGIN
    StringPtr:= ic.FindToolType (Icon.toolTypes, ArgName);
    IF StringPtr # NIL THEN
      e.CopyMem (StringPtr^, Arg, LEN (Arg));
      RETURN TRUE
    END;
    RETURN FALSE
  END GetArg;

PROCEDURE GetStringArg* (    ArgName: ARRAY OF CHAR;
                         VAR Arg: ARRAY OF CHAR);
  BEGIN
    IF GetArg (ArgName, Arg) THEN
    END;
  END GetStringArg;

PROCEDURE GetNumArg* (ArgName: ARRAY OF CHAR;
                      Default: LONGINT): LONGINT;
  VAR
    String: ARRAY 12 OF CHAR;
    Test: LONGINT;
  BEGIN
    IF GetArg (ArgName, String) THEN
      IF So.StrToIntOk (String, Test) THEN
        RETURN Test
      END;
    END;
    RETURN Default
  END GetNumArg;

PROCEDURE GetFlagArg* (    ArgName: ARRAY OF CHAR;
                           FlagArray: ARRAY OF CHAR;
                       VAR FlagSet: ARRAY OF BYTE);
  VAR
    Set: LONGSET;
    SetPtr: POINTER TO LONGSET;
    Flag, Pos: INTEGER;
    String: ARRAY 32 OF CHAR;
    Ok: BOOLEAN;
  BEGIN
    IF GetArg (ArgName, String) THEN
      Pos:= 0;
      Ok:= TRUE;
      LOOP
        IF (Pos > 31) OR (String[Pos] = CHR (0)) THEN
          EXIT
        END;
        Flag:= So.FindChar (FlagArray, String[Pos], 0);
        IF Flag >= 0 THEN
          INCL (Set, Flag);
        ELSE
          Ok:= FALSE;
          EXIT
        END;
        INC (Pos);
      END;
      IF Ok THEN
        SetPtr:= s.ADR (Set);
        INC (SetPtr, 3 - LEN (FlagSet) - 1);
        e.CopyMem (SetPtr^, FlagSet, LEN (FlagSet));
      END;
    END;
  END GetFlagArg;

PROCEDURE DeleteArg* (ArgName: ARRAY OF CHAR);
  VAR
    Adr: LONGINT;
    Num: INTEGER;
  BEGIN
    Adr:= ic.FindToolType (AdrArray, ArgName);
    IF Adr # NIL THEN
      Num:= 0;
      WHILE (Adr <  AdrArray[Num]) OR
            (Adr >= AdrArray[Num] + LONG (Len (AdrArray[Num]))) DO
        INC (Num);
      END;
      DISPOSE (AdrArray[Num]);
      REPEAT
        Adr:= AdrArray[Num + 1];
        AdrArray[Num]:= Adr;
        INC (Num);
      UNTIL Adr = NIL;
      DEC (NumToolTypes);
    END;
  END DeleteArg;

PROCEDURE NewStringArg* (ArgName: ARRAY OF CHAR;
                         Arg: ARRAY OF CHAR);
  VAR
    String: ARRAY 256 OF CHAR;
  BEGIN
    DeleteArg (ArgName);
    So.Assign (ArgName, String);
    So.AppendChar (String, "=");
    So.Append (String, Arg);
    IF MakeNewArg (s.ADR (String), So.Length (String)) THEN
    END;
  END NewStringArg;

PROCEDURE NewNumArg* (ArgName: ARRAY OF CHAR;
                      Num: LONGINT);
  VAR
    String: ARRAY 12 OF CHAR;
  BEGIN
    So.IntToStr (Num, String);
    NewStringArg (ArgName, String);
  END NewNumArg;

PROCEDURE NewFlagArg* (ArgName: ARRAY OF CHAR;
                       FlagArray: ARRAY OF CHAR;
                       FlagSet: ARRAY OF BYTE);
  VAR
    String: ARRAY 32 OF CHAR;
    Byte, Bit, Len, Pos: INTEGER;
  BEGIN
    Len:= So.Length (FlagArray);
    String:= "";
    Pos:= 0;
    Byte:= LEN (FlagSet) - 1;
    REPEAT
      Bit:= 0;
      REPEAT
        IF (Bit IN s.VAL (SHORTSET, FlagSet[Byte])) AND (Pos < Len) THEN
          So.AppendChar (String, FlagArray[Pos]);
        END;
        INC (Pos);
        INC (Bit);
      UNTIL Bit > 7;
      DEC (Byte);
    UNTIL Byte < 0;
    NewStringArg (ArgName, String);
  END NewFlagArg;

BEGIN
  MaxToolTypes:= 16;
END ToolTypeArgs.