pascalx.io.charset.eightbit.pas

{
    pascalx.io.charset.eightbit — модуль для разработки восьмибитных кодировок
    текста.

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

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

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

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

unit pascalx.io.charset.eightbit;

    {$MODE DELPHI}

interface

    {%region} uses
        pascalx.lang,
        pascalx.io,
        pascalx.io.charset;
    {%endregion}

    {$WARN 3018 OFF} { позволить конструкторы с любой видимостью }

    {$TYPEINFO ON}
    {$CALLING REGISTER}

    const UNIT_NAME = 'pascalx.io.charset.eightbit';

    {%region} type
        EightBitCharset                           = class;
        EightBitCharsetCharacterDecodingException = class;
        EightBitCharsetCharacterEncodingException = class;

        EightBitCharset = class abstract(Charset)
        private
            fldCharacters: uchar_Array1d;
            function getCharacters(): UnicodeString;
        protected
            constructor create(const name: AnsiString; const aliases: AnsiString_Array1d; const characters: UnicodeString);
        public
            function newDecoder(): CharDecoder; override; final;
            function newEncoder(): CharEncoder; override; final;
        published
            property characters: UnicodeString read getCharacters;
        end;

        EightBitCharsetCharacterDecodingException = class(CharacterDecodingException)
        public
            constructor create(const charsetName: AnsiString; byteData: int; helpContext: int = 0);
        end;

        EightBitCharsetCharacterEncodingException = class(CharacterEncodingException)
        public
            constructor create(const charsetName: AnsiString; ucharData: int; helpContext: int = 0);
        end;
    {%endregion}

implementation

    {$R *.res}

    {$TYPEINFO OFF}
    {$CALLING REGISTER}

    {%region} type
        EightBitCharDecoder = class;
        EightBitCharEncoder = class;

        EightBitCharDecoder = class sealed(CharDecoder)
        private
            fldCharset: EightBitCharset;
            function decode(src: int): int; overload;
        protected
            procedure decode(src: ByteReader; length: int; dst: UCharWriter); override; overload;
        public
            constructor create(charset: EightBitCharset);
        end;

        EightBitCharEncoder = class sealed(CharEncoder)
        private
            fldCharset: EightBitCharset;
            function encode(src: int): int; overload;
        protected
            procedure encode(src: UCharReader; length: int; dst: ByteWriter); override; overload;
        public
            constructor create(charset: EightBitCharset);
            function canEncode(src: uchar): boolean; override;
        end;
    {%endregion}

    {%region  EightBitCharset }
        function EightBitCharset.getCharacters(): UnicodeString;
        begin
            result := UnicodeString.create(fldCharacters);
        end;

        constructor EightBitCharset.create(const name: AnsiString; const aliases: AnsiString_Array1d; const characters: UnicodeString);
        begin
            inherited create(name, aliases);
            fldCharacters := characters.toUCharArray();
        end;

        function EightBitCharset.newDecoder(): CharDecoder;
        begin
            result := EightBitCharDecoder.create(self);
        end;

        function EightBitCharset.newEncoder(): CharEncoder;
        begin
            result := EightBitCharEncoder.create(self);
        end;
    {%endregion}

    {%region  EightBitCharsetCharacterDecodingException }
        constructor EightBitCharsetCharacterDecodingException.create(const charsetName: AnsiString; byteData, helpContext: int);
        begin
            inherited create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.io.charset.eightbit.UNIT_NAME, 'character-decoding.eight-bit-charset'), [
                CoAnsiString.create(CoInt.toLeadZeroString(byteData and $ff, 2, 16)), CoAnsiString.create(charsetName)
            ]), helpContext);
        end;
    {%endregion}

    {%region  EightBitCharsetCharacterEncodingException }
        constructor EightBitCharsetCharacterEncodingException.create(const charsetName: AnsiString; ucharData, helpContext: int);
        begin
            inherited create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.io.charset.eightbit.UNIT_NAME, 'character-encoding.eight-bit-charset'), [
                CoAnsiString.create(CoInt.toLeadZeroString(ucharData and $ffff, 4, 16)), CoAnsiString.create(charsetName)
            ]), helpContext);
        end;
    {%endregion}

    {%region  EightBitCharDecoder }
        function EightBitCharDecoder.decode(src: int): int;
        var
            code: int;
            charset: EightBitCharset;
        begin
            if src < $80 then begin
                result := src;
                exit;
            end;
            charset := fldCharset;
            code := int(charset.fldCharacters[src - $80]);
            if code > 0 then begin
                result := code;
                exit;
            end;
            case errorAction of
            eaException: begin
                raise EightBitCharsetCharacterDecodingException.create(charset.name, src);
            end;
            eaReport: begin
                report();
                result := -1;
            end;
            eaIgnore: begin
                result := -2;
            end;
            else
                result := $003f;
            end;
        end;

        procedure EightBitCharDecoder.decode(src: ByteReader; length: int; dst: UCharWriter);
        var
            byteData: int;
            ucharData: int;
        begin
            while length > 0 do begin
                dec(length);
                byteData := src.read();
                if (byteData < $00) or (byteData > $ff) then break;
                ucharData := decode(byteData);
                if ucharData = -1 then break;
                if ucharData >= 0 then dst.write(ucharData);
            end;
        end;

        constructor EightBitCharDecoder.create(charset: EightBitCharset);
        begin
            inherited create(charset);
            fldCharset := charset;
        end;
    {%endregion}

    {%region  EightBitCharEncoder }
        function EightBitCharEncoder.encode(src: int): int;
        var
            code: int;
            charset: EightBitCharset;
        begin
            if src < $0080 then begin
                result := src;
                exit;
            end;
            charset := fldCharset;
            code := &Array.indexOf(uchar(src), charset.fldCharacters, 0, $80);
            if code >= 0 then begin
                result := code + $80;
                exit;
            end;
            case errorAction of
            eaException: begin
                raise EightBitCharsetCharacterEncodingException.create(charset.name, src);
            end;
            eaReport: begin
                report();
                result := -1;
            end;
            eaIgnore: begin
                result := -2;
            end;
            else
                result := $3f;
            end;
        end;

        procedure EightBitCharEncoder.encode(src: UCharReader; length: int; dst: ByteWriter);
        var
            byteData: int;
            ucharData: int;
        begin
            while length > 0 do begin
                dec(length);
                ucharData := src.read();
                if (ucharData < $0000) or (ucharData > $ffff) then break;
                byteData := encode(ucharData);
                if byteData = -1 then break;
                if byteData >= 0 then dst.write(byteData);
            end;
        end;

        constructor EightBitCharEncoder.create(charset: EightBitCharset);
        begin
            inherited create(charset);
            fldCharset := charset;
        end;

        function EightBitCharEncoder.canEncode(src: uchar): boolean;
        begin
            result := (src < #$0080) or (&Array.indexOf(src, fldCharset.fldCharacters, 0, $80) >= 0);
        end;
    {%endregion}

end.