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

  :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.4
  :Date.        06-Jul-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.
  :History.     .3     [awn] 28-May-1993 : V39 Interfaces Switch eingebaut
  :History.     .4     [awn] 06-Jul-1993 : An den Filenamen wird jetzt ein ".mod" angehangen
  :History.            und der Basename wird beachtet.

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

IMPORT  c2ov := KitCatVersion,
        Dos,
        ms:=MoreStrings,
        str := Strings,
        SYSTEM,
        BT:=BasicTypes,
        ll := LinkedLists,
        cl:=KitCatLocale,
        sc:=StringConvert,
        pf:=Printf,
         cd:= C2OData;

VAR writeok * : BOOLEAN;
TYPE strptr = UNTRACED POINTER TO ARRAY 128 OF CHAR;
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";

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

    numstr =  "\n  numStrings * = %ld;"
              "\n  minId *      = %ld;"
              "\n  maxId *      = %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 CloseCatalog*();\n"
              "    BEGIN\n"
              "      IF catalog # NIL THEN lo.CloseCatalog (catalog); catalog:=NIL END;\n"
              "   END CloseCatalog;\n\n"
              "  PROCEDURE OpenCatalog*(loc:lo.LocalePtr; language:ARRAY OF CHAR);\n"
              "    VAR Tag : u.Tags4;\n"
              "    BEGIN\n"
              "      CloseCatalog();\n"
              "      IF (catalog = NIL) & (lo.base # NIL) THEN\n";

  proc1V38 =  "        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[1].tag:= lo.Language; Tag[1].data:= y.ADR(language);\n";

  proc1V39 =  "        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[1].tag:= lo.language; Tag[1].data:= y.ADR(language);\n";

  proc2V38=   "        END;\n"
              "        catalog := lo.OpenCatalogA (loc, \"%s%s.catalog\", Tag);\n"
              "      END;\n"
              "    END OpenCatalog;\n\n"
              "  PROCEDURE %s* (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 %s;\n\n"
              "CLOSE\n"
              "  CloseCatalog();\n"
              "END %s.\n";


  PROCEDURE Create*(name,catname:ARRAY OF CHAR;V39,short:BOOLEAN):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.
    :Update.    28-May-1993 [awn] - V39 Switch eingebaut
    :Update.    06-Jul-1993 [awn] - .mod wird an den Namen angehangen und der
    :Update.                basename wird auch beachtet.
  --------------------------------------------*)
    VAR fh: Dos.FileHandlePtr;
        ok: BOOLEAN;
        node : ll.Node;
        string, rstr : BT.DynString;
        sn : ll.Node;
        base, cdname, function : strptr;

    BEGIN
      NEW(cdname); NEW(function);
      IF (cdname = NIL) OR (function = NIL) THEN
        cd.error:=cl.errNoMemory;
        RETURN FALSE;
      END;
      string:=NIL;
      ok:=TRUE;
      sc.CutName(catname,FALSE);
      IF str.Occurs(name,".mod")=-1 THEN
        IF str.Occurs(name,".")= -1 THEN
          str.Append(name,".mod");
        END;
      END;
      fh:=Dos.Open(name,Dos.newFile);
      sc.CutName(name,FALSE);
      pf.SPrintf1(cdname^,cd.CDList.cdname,SYSTEM.ADR(catname));
      pf.SPrintf1(function^,cd.CDList.function,cdname);
      IF cd.CDList.basename # "" THEN
        str.Append(cd.CDList.basename,"/");
        base:=SYSTEM.ADR(cd.CDList.basename);
      ELSE
        base:=NIL;
      END;
      cd.error:=cl.errOpenModule;
      IF fh # NIL THEN
        ok:=Dos.FPrintf(fh,begin,SYSTEM.ADR(name),
                                  SYSTEM.ADR(c2ov.nameVer),
                                  SYSTEM.ADR(cd.CDList.language),
                                  cd.CDList.version)#-1;
        IF ok THEN
          node:=cd.CDList.head;
          WHILE (node # NIL) AND ok DO
            IF string # NIL THEN
              string^:="";
            END;
            IF short AND (node(cd.Node).strings.nbElements() > 1) THEN
              sn:=node(cd.Node).strings.head;
              IF sn # NIL THEN
                ok:=sc.Convert(sn(cd.SNode).string^,TRUE,FALSE,rstr);
                IF ok THEN
                  ok:=sc.SetLengthBytes(rstr^,sn(cd.Node),node(cd.CDNode).lengthbytes,TRUE);
                END;
                IF ok THEN
                  ok:=Dos.FPrintf(fh,desc2,SYSTEM.ADR(node(cd.Node).idName^),
                                           node(cd.Node).idNumber,
                                           SYSTEM.ADR(node(cd.Node).idName^),
                                           SYSTEM.ADR(rstr^))#-1;
                END;
                sn:=sn.next;
              ELSE ok:=FALSE END;
              IF ok THEN
                WHILE (sn # NIL) AND ok DO
                  ok:=sc.Convert(sn(cd.SNode).string^,TRUE,FALSE,rstr);
                  IF ok THEN
                    ok:=Dos.FPrintf(fh,"  \"%s\"",SYSTEM.ADR(rstr^))#-1;
                  END;
                  sn:=sn.next;
                  IF ok THEN
                    IF sn # NIL THEN
                      ok:=Dos.FPrintf(fh,"\n")#-1;
                    ELSE
                      ok:=Dos.FPrintf(fh,";\n")#-1;
                    END;
                  END;
                END;
              END;
            ELSE
              ok:=sc.Convert(node(cd.Node).fullstr^,TRUE,FALSE,rstr);
              IF ok THEN
                ok:=sc.SetLengthBytes(rstr^,node(cd.Node),node(cd.CDNode).lengthbytes,TRUE);
              END;
              IF ok THEN
                ok:=Dos.FPrintf(fh,desc,SYSTEM.ADR(node(cd.Node).idName^),
                                        node(cd.Node).idNumber,
                                        SYSTEM.ADR(node(cd.Node).idName^),
                                        SYSTEM.ADR(rstr^))#-1;
              ELSE;
                cd.para1:=SYSTEM.ADR(string^);
              END;
            END; (* IF short THEN *)
            node:=node.next;
          END;
        END;

        IF ok THEN
          ok:=Dos.FPrintf(fh,numstr,cd.CDList.nbElements(),
                                    cd.CDList.minId,
                                    cd.CDList.maxId)#-1;
        END;
        IF ok THEN
          node:=cd.CDList.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,cdname,
                                       SYSTEM.ADR(name))#-1;
          IF V39 THEN
            ok:=Dos.FPrintf(fh,proc1V39)#-1;
          ELSE
            ok:=Dos.FPrintf(fh,proc1V38)#-1;
          END;
          ok:=Dos.FPrintf(fh,proc2V38,base,
                                      cdname,
                                      function,
                                      function,
                                      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.