tools/flexcat/src/sd/HSPascalUnit.sd

   1 ##rem $Id: HSPascalUnit.sd 253 2014-02-18 11:15:58Z damato $
   2 ##shortstrings
   3 ##stringtype E
   4 UNIT %bLocale;
   5 INTERFACE
   6
   7 {****************************************************
   8
   9    This file was created automatically by '%fv'
  10    from "%f0".
  11
  12    Do NOT edit by hand!
  13
  14 ****************************************************}
  15
  16 USES
  17   Exec , Locale , Utility ;
  18
  19 CONST
  20   %i = %d ;\n  %i_STR = %s%[#0;\n
  21
  22 PROCEDURE CloseCatalog;
  23
  24 PROCEDURE OpenCatalog(loc : pLocale ; language : STRPTR ) ;
  25
  26 FUNCTION GetString(num : LONGINT) : STRPTR ;
  27
  28 FUNCTION GetPasString(num : LONGINT) : STRING;
  29
  30 IMPLEMENTATION
  31
  32 CONST
  33   builtinlanguage = %l%[#0;
  34   version = %v ;
  35   catalog  : pCatalog = NIL ;
  36
  37 VAR
  38
  39   OldExitProc : Pointer;
  40
  41 TYPE
  42
  43   tAppString = RECORD
  44      id  : LONGINT ;
  45      str : STRPTR ;
  46   END ;
  47
  48   tAppStringArray = ARRAY [0..%n] OF tAppString ;
  49
  50 CONST
  51   AppStrings : tAppStringArray = (( id : 0 ; str : NIL ));
  52
  53 FUNCTION CPtr( s : string ):pointer;INLINE
  54   $201F, { move.l (a7)+,d0 ; get address string }
  55   $5280, { addq.l #1,d0    ; ignore counter }
  56   $2E80; { move.l d0,(a7)  ; return "C-string" address }
  57
  58 PROCEDURE CloseCatalog;
  59 BEGIN
  60   IF catalog <> NIL THEN
  61     BEGIN
  62       Locale.CloseCatalog(catalog) ;
  63       catalog := NIL
  64     END;
  65 END;
  66
  67 PROCEDURE InitAppStringsArray;
  68 BEGIN
  69   AppStrings[%d].id := %i;\n  AppStrings[%d].str := CPtr(%i_STR);\n
  70 END;
  71
  72 PROCEDURE OpenCatalog(loc : pLocale ; language : STRPTR );
  73 VAR
  74    tags   : ARRAY [0..7] OF LONGINT ;
  75 BEGIN
  76   CloseCatalog;
  77   IF (catalog = NIL) AND (LocaleBase <> NIL) THEN
  78     BEGIN
  79       IF language <> NIL THEN
  80         BEGIN
  81           tags[0] := OC_BuiltInLanguage; tags[1] := long(CPtr(builtinlanguage));
  82           tags[2] := OC_Language ;       tags[3] := long(language);
  83           tags[4] := OC_Version ;        tags[5] := version;
  84           tags[6] := TAG_END;
  85         END
  86       ELSE
  87         BEGIN
  88           tags[0] := OC_BuiltInLanguage; tags[1] := long(CPtr(builtinlanguage));
  89           tags[2] := OC_Version ;        tags[3] := version;
  90           tags[4] := TAG_END;
  91         END;
  92     catalog := Locale.OpenCatalogA(loc, CPtr('%b.catalog'#0), @tags) ;
  93     END
  94 END;
  95
  96 FUNCTION GetString(num : LONGINT) : STRPTR ;
  97
  98 VAR
  99   i       : LONGINT ;
 100   default : STRPTR ;
 101
 102 BEGIN
 103   i := 0 ;
 104
 105   WHILE (i < %n) AND (AppStrings[i].id <> num) DO
 106   BEGIN
 107     INC(i)
 108   END ;
 109
 110   IF i <> %n THEN
 111     default := AppStrings[i].str
 112    ELSE
 113     default := NIL ;
 114
 115   IF catalog <> NIL THEN
 116     GetString := Locale.GetCatalogStr(catalog, num, default)
 117    ELSE
 118     GetString := default
 119 END;
 120
 121 FUNCTION GetPasString(num : LONGINT) : STRING;
 122 TYPE
 123   pa = ^ta;
 124   ta = PACKED ARRAY [0..MAXINT] OF CHAR;
 125 VAR
 126   i    : INTEGER;
 127   sptr : pa;
 128   s    : STRING;
 129 BEGIN
 130   sptr := pa(GetString( num ));
 131   s := '';
 132   i := 0;
 133   WHILE sptr^[i] <> #0 DO
 134   BEGIN
 135     s := s + sptr^[i];
 136     INC(i)
 137   END;
 138   GetPasString := s
 139 END;
 140
 141 (***************************************************************************)
 142 (*                  << INIT AND EXIT PROCEDURE  >>                         *)
 143 (***************************************************************************)
 144
 145 PROCEDURE InitFunction;
 146 BEGIN
 147   LocaleBase := OpenLibrary( 'locale.library' , 38 );
 148   if LocaleBase = NIL then
 149     BEGIN
 150       WRITELN( '*** ERROR *** locale.library ' );
 151       HALT
 152     END;
 153   InitAppStringsArray;
 154   OpenCatalog( NIL , NIL );
 155 END;
 156
 157 PROCEDURE ExitFunction;
 158 BEGIN
 159   if LocaleBase <> NIL then CloseLibrary( LocaleBase );
 160   CloseCatalog;
 161 END;
 162
 163 PROCEDURE ExitHandler;
 164 BEGIN
 165   ExitProc := OldExitProc;
 166   ExitFunction;
 167 END;
 168
 169 PROCEDURE Initialize;
 170 BEGIN
 171   OldExitProc := ExitProc;
 172   ExitProc := @ExitHandler;
 173   InitFunction;
 174 END;
 175
 176 BEGIN
 177   Initialize;
 178 END.