On Sat, Sep 26 16:35, Kevin Wolf wrote:
> + 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));
Hm ich glaube wenn da der Formatstring kaputt ist dürfte das rot geben,
oder? Also ohne Doppelpunkt. Ich glaube an Fehlerbehandlung fehlt da
weiter unten auch noch ein Bisschen was.
> + 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.
> +
Das ist zwar wirres Zeug, aber ich glaube so irgendwie mit etwas Glück
könnte das schon funktionieren. ;-)
--
Antoine Kaufmann
<toni@xxxxxxxxxxxxxxxx>
Attachment:
pgpxdcrIxheQY.pgp
Description: PGP signature