pascalx.lang.locale.rtlang.pas

{
    pascalx.lang.locale.rtlang — модуль поддержки текущей локали приложения.

    Copyright © 2021, 2026 Малик Разработчик

    Это свободная программа: вы можете перераспространять её и/или
    изменять её на условиях Меньшей Стандартной общественной лицензии GNU в том виде,
    в каком она была опубликована Фондом свободного программного обеспечения;
    либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.

    Эта программа распространяется в надежде, что она может быть полезна,
    но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
    или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Меньшей Стандартной
    общественной лицензии GNU.

    Вы должны были получить копию Меньшей Стандартной общественной лицензии GNU
    вместе с этой программой. Если это не так, см.
    <http://www.gnu.org/licenses/>.
}

unit pascalx.lang.locale.rtlang;

    {$MODE DELPHI}

interface

    {%region} uses
        pascalx.lang,
        pascalx.lang.locale;
    {%endregion}

    {$TYPEINFO ON}
    {$CALLING REGISTER}

    {%region} type
        CyrillicLocale = class;

        CyrillicLocale = class(Locale)
        public
            constructor create();
            function isLowerCase(character: uchar): boolean; override;
            function isUpperCase(character: uchar): boolean; override;
            function toLowerCase(character: uchar): uchar; override;
            function toUpperCase(character: uchar): uchar; override;
            function orderOf(character: uchar): int; override;
        end;
    {%endregion}

implementation

    {$CALLING REGISTER}

    {%region  CyrillicLocale }
        constructor CyrillicLocale.create();
        begin
            inherited create('ru-RU', nil);
        end;

        function CyrillicLocale.isLowerCase(character: uchar): boolean;
        begin
            result := (character >= #$0430) and (character <= #$045f);
        end;

        function CyrillicLocale.isUpperCase(character: uchar): boolean;
        begin
            result := (character >= #$0400) and (character <= #$042f);
        end;

        function CyrillicLocale.toLowerCase(character: uchar): uchar;
        begin
            if (character >= #$0400) and (character <= #$040f) then begin
                result := uchar(int(character) + $0050);
                exit;
            end;
            if (character >= #$0410) and (character <= #$042f) then begin
                result := uchar(int(character) + $0020);
                exit;
            end;
            result := character;
        end;

        function CyrillicLocale.toUpperCase(character: uchar): uchar;
        begin
            if (character >= #$0430) and (character <= #$044f) then begin
                result := uchar(int(character) - $0020);
                exit;
            end;
            if (character >= #$0450) and (character <= #$045f) then begin
                result := uchar(int(character) - $0050);
                exit;
            end;
            result := character;
        end;

        function CyrillicLocale.orderOf(character: uchar): int;
        begin
            if (character >= #$0430) and (character <= #$044f) then dec(character, $0020);
            if (character >= #$0450) and (character <= #$045f) then dec(character, $0050);
            if character = #$0401 then begin
                result := 6;
                exit;
            end;
            if (character >= #$0410) and (character <= #$0415) then begin
                result := int(character) - $0410;
                exit;
            end;
            if (character >= #$0416) and (character <= #$042f) then begin
                result := int(character) - ($0410 - 1);
                exit;
            end;
            result := inherited orderOf(character) + 33;
        end;
    {%endregion}

    {%region} initialization
        Locale.register(CyrillicLocale.create());
    {%endregion}

end.