[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[tyndur-devel] [PATCH 1/3] Pascal-RTL: Unterstuetzung fuer mehrsprachige Programme
+ Pascal-RTL: Unit multilang
Signed-off-by: Kevin Wolf <kevin@xxxxxxxxxx>
---
src/modules/pas/include/tms.h | 48 +++++++++
src/modules/pas/lib/tyndur/Makefile.all | 1 +
src/modules/pas/lib/tyndur/multilang.pas | 166 ++++++++++++++++++++++++++++++
3 files changed, 215 insertions(+), 0 deletions(-)
create mode 100644 src/modules/pas/include/tms.h
create mode 100644 src/modules/pas/lib/tyndur/multilang.pas
diff --git a/src/modules/pas/include/tms.h b/src/modules/pas/include/tms.h
new file mode 100644
index 0000000..c7a6823
--- /dev/null
+++ b/src/modules/pas/include/tms.h
@@ -0,0 +1,48 @@
+/*
+ * Copyright (c) 2009 The tyndur Project. All rights reserved.
+ *
+ * This code is derived from software contributed to the tyndur Project
+ * by Kevin Wolf.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#ifndef _TMS_H_
+#define _TMS_H_
+
+struct tms_strings {
+ void* resstr;
+ char* translation;
+} __attribute__((packed));
+
+struct tms_lang {
+ char* lang;
+ int numbers;
+ int (*get_number)(int);
+
+ const struct tms_strings* strings;
+};
+
+#define LANGUAGE(x) \
+ static const void* __attribute__((section("tmslang"), used)) __lang = (x);
+
+#endif
diff --git a/src/modules/pas/lib/tyndur/Makefile.all b/src/modules/pas/lib/tyndur/Makefile.all
index aacb99c..9ca455a 100644
--- a/src/modules/pas/lib/tyndur/Makefile.all
+++ b/src/modules/pas/lib/tyndur/Makefile.all
@@ -1 +1,2 @@
cp libptyndur.a tyndur.ppu ../units
+cp libpmultilang.a multilang.ppu ../units
diff --git a/src/modules/pas/lib/tyndur/multilang.pas b/src/modules/pas/lib/tyndur/multilang.pas
new file mode 100644
index 0000000..112e2ba
--- /dev/null
+++ b/src/modules/pas/lib/tyndur/multilang.pas
@@ -0,0 +1,166 @@
+unit multilang;
+{$MODE ObjFPC}
+{$H+}
+
+interface
+
+ type
+ TLanguage = Pointer;
+
+ function NumLanguages: integer;
+ function GetLanguage(name: String): TLanguage;
+ function GetLanguageById(id: integer): TLanguage;
+ function GetLanguageName(lang: TLanguage): String;
+ procedure SetLanguage(lang: TLanguage);
+
+ function FormatNum(const fmt: String; const args: array of const): String;
+
+implementation
+
+ uses sysutils;
+
+ type
+ tres = packed record
+ name: AnsiString;
+ value: AnsiString;
+ end;
+
+ tms_dict = packed record
+ resstr: ^tres;
+ translation: PChar;
+ end;
+ ptms_dict = ^tms_dict;
+
+ type
+ TGetNumber = function(n: integer): integer; cdecl;
+ TLanguageData = record
+ lang: PChar;
+ numbers: integer;
+ get_number: TGetNumber;
+ strings: ptms_dict;
+ end;
+ PLanguage = ^TLanguageData;
+ PPLanguage = ^PLanguage;
+
+ var
+ lang: PPLanguage;
+ num_lang: integer;
+ cur_lang: PLanguage;
+
+
+ function LoadTranslation(name, value: AnsiString; Hash: Longint; arg: Pointer): AnsiString;
+ var
+ dict: ptms_dict;
+ i: integer;
+ begin
+ dict := arg;
+ i := 0;
+ while dict[i].resstr <> nil do begin
+ if Pointer(name) = Pointer(dict[i].resstr^.name) then begin
+ exit(dict[i].translation);
+ end;
+ Inc(i);
+ end;
+
+ exit(value);
+ end;
+
+ function NumLanguages: integer;
+ begin
+ exit(num_lang);
+ end;
+
+ function GetLanguage(name: String): TLanguage;
+ var
+ i: integer;
+ begin
+ for i := 0 to num_lang - 1 do begin
+ if lang[i]^.lang = name then begin
+ exit(lang[i]);
+ end;
+ end;
+
+ exit(nil);
+ end;
+
+ function GetLanguageById(id: integer): TLanguage;
+ begin
+ exit(lang[id]);
+ end;
+
+ function GetLanguageName(lang: TLanguage): String;
+ var
+ ldata: PLanguage;
+ begin
+ ldata := lang;
+ exit(ldata^.lang);
+ end;
+
+ procedure SetLanguage(lang: TLanguage);
+ begin
+ cur_lang := lang;
+ SetResourceStrings(@LoadTranslation, cur_lang^.strings);
+ end;
+
+ function FormatNum(const fmt: String; const args: array of const): String;
+ var
+ s: String;
+ i, j, outi: integer;
+ num, value, number: integer;
+ colon: integer;
+ begin
+ s := '';
+ SetLength(s, Length(fmt));
+
+ outi := 1;
+ i := 1;
+ while i <= Length(fmt) do begin
+ if (fmt[i] = '%') and (fmt[i + 1] = '[') then begin
+
+ // Nummer des Arguments bestimmen
+ colon := Pos(':', PChar(@fmt[i + 2]));
+ num := StrToInt(Copy(fmt, i + 2, colon - 1));
+ value := args[num].VInteger;
+ number := cur_lang^.get_number(value);
+
+ // Start-Doppelpunkt finden
+ Inc(i, 2 + colon);
+ for j := 1 to cur_lang^.get_number(value) do begin
+ colon := Pos(':', PChar(@fmt[i]));
+ Inc(i, colon);
+ end;
+
+ // Wort kopieren
+ if number = cur_lang^.numbers - 1 then begin
+ colon := Pos(']', PChar(@fmt[i]));
+ end else begin
+ colon := Pos(':', PChar(@fmt[i]));
+ end;
+ Move(fmt[i], s[outi], colon - 1);
+ Inc(outi, colon - 1);
+
+ // Ende des Ausdrucks suchen
+ Inc(i, Pos(']', PChar(@fmt[i])));
+ end else begin
+ s[outi] := fmt[i];
+ Inc(outi);
+ Inc(i);
+ end;
+ end;
+
+ SetLength(s, outi - 1);
+ exit(Format(s, args));
+ end;
+
+
+var
+ tmslang_start: PLanguage; external name '__start_tmslang';
+ tmslang_end: PLanguage; external name '__stop_tmslang';
+
+initialization
+
+ lang := @tmslang_start;
+ num_lang := PPLanguage(@tmslang_end) - PPLanguage(@tmslang_start);
+
+end.
+
--
1.6.0.2