(*------------------------------------------

  :Module.      OberonOutput.mod
  :Author.      Albert Weinert  [awn]
  :Address.     Krähenweg 21 , 50829 Köln
  :EMail.       Usenet_> aweinert@darkness.gun.de
  :EMail.       Z-Netz_> A.WEINERT@DARKNESS.ZER
  :Phone.       0221 / 580 29 84
  :Revision.    R.2
  :Date.        17-May-1993
  :Copyright.   Albert Weinert
  :Language.    Oberon-2
  :Translator.  Amiga Oberon 3.00d
  :Contents.    Erstellt ein Oberon Modul zu lokaliesrung von Programmen.
  :Imports.     Cd2OberonVersion.mod, C2OData.mod, Cd2OberonLocale.mod [awn]
  :Remarks.     <Was Du willst, evtl. Usage>
  :Bugs.        <Bekannte Fehler>
  :Usage.       <Angaben zur Anwendung>
  :History.     .0     [awn] 16-May-1993 : Erstellt
  :History.     .1     [awn] 17-May-1993 : Dicken Fehler in der OpenCatalog Procedure behoben.

--------------------------------------------*)
MODULE  OberonOutput;

IMPORT  c2ov := Cd2OberonVersion,
        Dos,
        str := Strings,
        SYSTEM,
        ll := LinkedLists,
        cl:=Cd2OberonLocale,
        cd:= C2OData;

VAR writeok * : BOOLEAN;

CONST
      begin = "MODULE %s;\n\n"
              "(****************************************************************\n"
              "   This file was created automatically by `%s'\n"
              "   Do NOT edit by hand!\n"
              "****************************************************************)\n\n"
              "IMPORT\n"
              "  lo := Locale, e := Exec, u := Utility, y := SYSTEM;\n\n"
              "CONST\n"
              "  builtinlanguage = \"%s\";\n"
              "  version = %ld;\n";

       desc = "\n  %s* = %ld;\n"
              "  %sSTR = \"%s\";\n";

    numstr =  "\n  NumStrings = %ld;\n\n"
              "TYPE\n"
              "  AppString = STRUCT\n"
              "     id  : LONGINT;\n"
              "     str : e.STRPTR;\n"
              "  END;\n"
              "  AppStringArray = ARRAY NumStrings OF AppString;\n\n"
              "CONST\n"
              "  AppStrings = AppStringArray (\n";

    inconst = "    %s, y.ADR (%sSTR)";

  procedure = "\nVAR\n"
              "  catalog : lo.CatalogPtr;\n\n"
              "  PROCEDURE OpenCatalog*(language:ARRAY OF CHAR);\n"
              "    VAR Tag : u.Tags4;\n"
              "    BEGIN\n"
              "      IF (catalog = NIL) & (lo.base # NIL) THEN\n"
              "        Tag:= u.Tags4(lo.BuiltInLanguage, y.ADR(builtinlanguage),\n"
              "                      u.skip, u.done, lo.Version, version, u.done, u.done);\n"
              "        IF language # \"\" THEN\n"
              "          Tag[2].tag:= lo.Language; Tag[2].data:= y.ADR(language);\n"
              "        END;\n"
              "        catalog := lo.OpenCatalogA (NIL, \"%s.catalog\", Tag);\n"
              "      END;\n"
              "    END OpenCatalog;\n\n"
              "  PROCEDURE GetString* (num: LONGINT): e.STRPTR;\n"
              "    VAR\n"
              "      i: LONGINT;\n"
              "      default: e.STRPTR;\n"
              "    BEGIN\n"
              "      i := 0; WHILE (i < NumStrings) AND (AppStrings[i].id # num) DO INC (i) END;\n\n"
              "      IF i # NumStrings THEN\n"
              "      default := AppStrings[i].str;\n"
              "      ELSE\n"
              "        default := NIL;\n"
              "      END;\n\n"
              "      IF catalog # NIL THEN\n"
              "        RETURN lo.GetCatalogStr (catalog, num, default^);\n"
              "      ELSE\n"
              "        RETURN default;\n"
              "      END;\n"
              "    END GetString;\n\n"
              "CLOSE\n"
              "  IF catalog # NIL THEN lo.CloseCatalog (catalog); catalog:=NIL END;\n"
              "END %s.\n";

  PROCEDURE CutName(VAR name:ARRAY OF CHAR);
  (*------------------------------------------
    :Input.     name = Filename inkl. Pfad und Postfix
    :Output.    name = Filename ohne Pfad und Postfix
    :Semantic.  Entfernt aus dem Filenamen den Pfad und den Postfix
    :Note.
    :Update.    16-May-1993 [awn] - erstellt.
  --------------------------------------------*)
    VAR pos : LONGINT;
    BEGIN
      REPEAT
        pos:=str.Occurs(name,"/");
        IF pos # -1 THEN
          str.Delete(name,0,pos+1);
        END;
      UNTIL pos = -1;
      pos:=str.Occurs(name,".");
      IF pos # -1 THEN
        str.Delete(name,pos,str.Length(name)-pos);
      END;
    END CutName;

  PROCEDURE Create*(name,cdname:ARRAY OF CHAR):BOOLEAN;
  (*------------------------------------------
    :Input.     name = Name des Moduls, cdname = Name des CatalogDescriptions
    :Output.    TRUE bei Erfolg;
    :Semantic.  erstellt ein Modul für die Lokalisierung eines Programms.
    :Note.
    :Update.    16-May-1993 [awn] - erstellt.
  --------------------------------------------*)
    VAR fh: Dos.FileHandlePtr;
        ok: BOOLEAN;
        node : ll.Node;
    BEGIN
      ok:=TRUE;
      CutName(cdname);
      fh:=Dos.Open(name,Dos.newFile);
      CutName(name);
      cd.error:=cl.errOpenModule;
      IF fh # NIL THEN
        ok:=Dos.FPrintf(fh,begin,SYSTEM.ADR(name),
                                  SYSTEM.ADR(c2ov.nameVer),
                                  SYSTEM.ADR(cd.SList.language),
                                  cd.SList.version)#-1;
        IF ok THEN
          node:=cd.SList.head;
          WHILE (node # NIL) AND ok DO
            ok:=Dos.FPrintf(fh,desc,SYSTEM.ADR(node(cd.Node).IDName^),
                                    node(cd.Node).IDNumber,
                                    SYSTEM.ADR(node(cd.Node).IDName^),
                                    SYSTEM.ADR(node(cd.Node).string^))#-1;
            node:=node.next;
          END;
        END;

        IF ok THEN
          ok:=Dos.FPrintf(fh,numstr,cd.SList.nbElements())#-1;
        END;
        IF ok THEN
          node:=cd.SList.head;
          WHILE (node # NIL) AND ok DO
            ok:=Dos.FPrintf(fh,inconst,SYSTEM.ADR(node(cd.Node).IDName^),
                                       SYSTEM.ADR(node(cd.Node).IDName^))#-1;
            node:=node.next;
            IF ok THEN
              IF node # NIL THEN
                ok:=Dos.FPrintf(fh,",\n")#-1;
              ELSE
                ok:=Dos.FPrintf(fh,");\n")#-1;
              END;
            END;
          END;
        END;
        IF ok THEN
          ok:=Dos.FPrintf(fh,procedure,SYSTEM.ADR(cdname),
                                       SYSTEM.ADR(name))#-1;
        END;
        IF ok THEN
          cd.error:=0;
        ELSE
          cd.error:=cl.errOberonOutput;
        END;
        Dos.OldClose(fh);
      END;
      RETURN ok;
    END Create;
END OberonOutput.