paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
f83799d4a3
lazarus-ccr/applications/fpbrowser/mod_braille.pas

543 lines
17 KiB
ObjectPascal
Raw Blame History

(*
The function to_braille from this unit translates a string from UTF8 chars to Braille chars.
The dictionaries were taken from http://www.ibc.gov.br/?catid=110&blogid=1&itemid=479
and from http://www.braillevirtual.fe.usp.br/pt/Portugues/braille.html
Copyright 2011
*)
unit mod_braille;
interface
{$mode objfpc}{$H+}
uses
browsermodules, lclproc;
type
{ TBrailleBrowserModule }
TBrailleBrowserModule = class(TBrowserModule)
public
constructor Create; override;
function HandleOnPageLoad(AInput: string; out AOutput: string): Boolean; override;
end;
function ConvertUTF8CharToBraille(Char: string; lCharSize: integer; OrdChar: integer): string;
function ConvertUTF8TextToBraille(Text: string): string;
function ConvertUTF8HtmlTextToBraille(AInput: string): string;
implementation
{type
dictionary = array[1..32] of string;
const
number_signal = chr($e2) + chr($a0) + chr($bc);
caps_signal = chr($e2) + chr($a0) + chr($a8);
d1: dictionary = ({!} chr($96), {"} chr($a6), {# TODO} chr($80), {(*$*)} chr($b0),
{%} chr($b8) + chr($e2) + chr($a0) + chr($b4), {&} chr($af), {'} chr($84),
{(} chr($a3) + chr($e2) + chr($a0) + chr($84), {)} chr($a0) + chr($e2) + chr($a0) + chr($9c),
{*} chr($94), {+} chr($96), {,} chr($82), {-} chr($a4), {.} chr($84),
{/} chr($90) + chr($e2) + chr($a0) + chr($b2), {0} chr($9a), {1} chr($81),
{2} chr($83), {3} chr($89), {4} chr($99), {5} chr($91), {6} chr($8b),
{7} chr($9b), {8} chr($93), {9} chr($8a), {:} chr($92), {;} chr($86),
{<} chr($aa), {=} chr($b6), {>} chr($95), {?} chr($a2), {@ TODO} chr($80));
d2: dictionary = ({a} chr($81), {b} chr($83), {c} chr($89), {d} chr($99),
{e} chr($91), {f} chr($8b), {g} chr($9b), {h} chr($93), {i} chr($8a),
{j} chr($9a), {k} chr($85), {l} chr($87), {m} chr($8d), {n} chr($9d),
{o} chr($95), {p} chr($8f), {q} chr($9f), {r} chr($97), {s} chr($8e),
{t} chr($9e), {u} chr($a5), {v} chr($a7), {w} chr($ba), {x} chr($ad),
{y} chr($bd), {z} chr($b5), '', '', '', '', '', '');
d3: dictionary = ({a + grave} chr($ab), {a + acute} chr($b7),
{a + circumflex} chr($a1), {a + tilde} chr($9c), {a + diaeresis TODO} chr($80),
{a + ring above TODO} chr($80), {ae TODO} chr($80), {c + cedilla} chr($af),
{e + grave} chr($ae), {e + acute} chr($bf), {e + circumflex} chr($a3),
{e + diaeresis TODO} chr($80), {i + grave} chr($a9), {i + acute} chr($8c),
{i + circumflex TODO} chr($80), {i + diaeresis} chr($bb), {eth TODO} chr($80),
{n + tilde TODO} chr($80), {o + grave} chr($ba), {o + acute} chr($ac),
{o + circumflex} chr($b9), {o + tilde} chr($aa), {o + diaeresis TODO} chr($80),
{division sign TODO} chr($80), {o + stroke TODO} chr($80), {u + grave} chr($b1),
{u + acute} chr($be), {u + circumflex TODO} chr($80), {u + diaeresis} chr($b3),
{y + acute TODO} chr($80), {thorn TODO} chr($80), {y + diaeresis TODO} chr($80)); }
{function ConvertUTF8TextToBraille(Line: string): string;
{var
lCharSize, count, n, next_n, len: integer;
Braille_string: string;
Pline: Pchar;
num, caps: boolean;
begin
Braille_string := '';
num := False;
caps := False;
count := 1;
if Line = '' then Result := '';
len := length(Line);
Pline := PChar(Line); }
while count <= len do
begin
lCharSize := LCLProc.UTF8CharacterLength(PLine);
if (lCharSize = 1) then
begin
n := Ord(Line[count]);
if (n = 9) then Braille_string := Braille_string + #9
else
if (n = 10) then Braille_string := Braille_string + #10
else
if (n = 32) then Braille_string := Braille_string + #32
else
begin
if ((n >= 97) and (n <= 122)) then {a lower case letter}
Braille_string := Braille_string + chr($e2) + chr($a0) + d2[n - 96]
else
begin
if ((n >= 65) and (n <= 90)) then {an upper case letter}
begin
if not caps then
begin
Braille_string := Braille_string + caps_signal;
if (count + 2 < length(Line)) then
begin
next_n := Ord(Line[count + 1]);
if ((next_n >= 65) and (next_n <= 90)) or ((next_n = 195) and ((Ord(Line[count + 2]) >= 128) and (Ord(Line[count + 2]) <= 159))) then {if the next char is also upper case, add another caps signal}
begin
Braille_string := Braille_string + caps_signal;
caps := True;
end;
end;
end;
Braille_string := Braille_string + chr($e2) + chr($a0) + d2[n - 64];
if (count + 1 <= length(Line)) then
begin
next_n := Ord(Line[count + 1]);
if not(((next_n >= 65) and (next_n <= 90)) or ((next_n = 195) and ((Ord(Line[count + 2]) >= 128) and (Ord(Line[count + 2]) <= 159)))) then caps := False; {if the next char is not upper case, unflag <caps>}
end;
end
else
begin
if (n >= 48) and (n <= 57) then {a number}
begin
if not num then Braille_string := Braille_string + number_signal; {first algarism of a number, add a number signal}
num := True;
Braille_string := Braille_string + chr($e2) + chr($a0) + d1[n - 31];
if (count + 1 <= length(Line)) then
begin
next_n := Ord(Line[count + 1]);
if not ((next_n >= 48) and (next_n <= 57) or (next_n = 44) or (next_n = 46)) then num := False; {the next char is not a number, nor ',', nor '.', then unflag <num>}
end;
end
else
begin
if (n >= 33) and (n <= 64) then {a char from the first dictionary}
begin
Braille_string := Braille_string + chr($e2) + chr($a0) + d1[n - 32];
if (count + 1 <= length(Line)) then
begin
next_n := Ord(Line[count + 1]);
if ((n = 44) or (n = 46)) and not ((next_n >= 48) and (next_n <= 57)) then num := False; {if the char is a ',' or a '.' but the next is not a number, unflag <num>}
end;
end;
end;
end;
end;
end;
end
else
begin
if (lCharSize = 2) then
begin
n := Ord(Line[count]);
if (n = 195) then
begin
n := Ord(Line[count + 1]);
if (n >= 128) and (n <= 159) then {upper case accented char}
begin
if not caps then
begin
Braille_string := Braille_string + caps_signal;
if (count + 2 <= length(Line)) then
begin
next_n := Ord(Line[count + 2]);
if ((next_n >= 65) and (next_n <= 90)) or ((next_n = 195) and ((Ord(Line[count + 2]) >= 128) and (Ord(Line[count + 2]) <= 159))) then {if the next char is also upper case, add another caps signal}
begin
Braille_string := Braille_string + caps_signal;
caps := True;
end;
end;
end;
Braille_string := Braille_string + chr($e2) + chr($a0) + d3[n - 127];
if (count + 3 <= length(Line)) then
begin
next_n := Ord(Line[count + 2]);
if not(((next_n >= 65) and (next_n <= 90)) or ((next_n = 195) and ((Ord(Line[count + 3]) >= 128) and (Ord(Line[count + 3]) <= 159)))) then {if the next char is not upper case, unflag <caps>}
caps := False;
end;
end
else
if (n >= 160) and (n <= 191) then Braille_string := Braille_string + chr($e2) + chr($a0) + d3[n - 159]; {lower case accented letter}
end;
end;
end;
count := count + lCharSize;
Inc(Pline, lCharSize);
end;
Result := Braille_string;
end; }
const
number_signal = chr($e2) + chr($a0) + chr($bc);
caps_signal = chr($e2) + chr($a0) + chr($a8);
function ConvertUTF8CharToBraille(Char: string; lCharSize: integer; OrdChar: integer): string;
const
aux = chr($e2) + chr($a0);
begin
{If the character can't be found in any of the cases, write a Braille space}
Result := aux + chr($80);
case lCharSize of
1:
begin
case OrdChar of
9: {\t}
Result := #9;
10: {\n}
Result := #10;
32: {<space>}
Result := #32;
33, 43: {!, +}
Result := aux + chr($96);
34: {"}
Result := aux + chr($a6);
36: {*$*}
Result := aux + chr($b0);
37: {%}
Result := aux + chr($b8) + chr($e2) + chr($a0) + chr($b4);
38: {&}
Result := aux + chr($af);
39, 46: {', .}
Result := aux + chr($84);
40: {(}
Result := aux + chr($a3) + chr($e2) + chr($a0) + chr($84);
41: {)}
Result := aux + chr($a0) + chr($e2) + chr($a0) + chr($9c);
42: {*}
Result := aux + chr($94);
44: {,}
Result := aux + chr($82);
45: {-}
Result := aux + chr($a4);
47: {/}
Result := aux + chr($90) + chr($e2) + chr($a0) + chr($b2);
48, 74, 106: {0, J, j}
Result := aux + chr($9a);
49, 65, 97: {1, A, a}
Result := aux + chr($81);
50, 66, 98: {2, B, b}
Result := aux + chr($83);
51, 67, 99: {3, C, c}
Result := aux + chr($89);
52, 68, 100: {4, D, d}
Result := aux + chr($99);
53, 69, 101: {5, E, e}
Result := aux + chr($91);
54, 70, 102: {6, F, f}
Result := aux + chr($8b);
55, 71, 103: {7, G, g}
Result := aux + chr($9b);
56, 72, 104: {8, H, h}
Result := aux + chr($93);
57, 73, 105: {9, I, i}
Result := aux + chr($8a);
58: {:}
Result := aux + chr($92);
59: {;}
Result := aux + chr($86);
60: {<}
Result := aux + chr($aa);
61: {=}
Result := aux + chr($b6);
63: {?}
Result := aux + chr($a2);
75, 107: {K, k}
Result := aux + chr($85);
76, 108: {L, l}
Result := aux + chr($87);
77, 109: {M, m}
Result := aux + chr($8d);
78, 110: {N, n}
Result := aux + chr($9d);
79, 111, 62: {O, o, >}
Result := aux + chr($95);
80, 112: {P, p}
Result := aux + chr($8f);
81, 113: {Q, q}
Result := aux + chr($9f);
82, 114: {R, r}
Result := aux + chr($97);
83, 115: {S, s}
Result := aux + chr($8e);
84, 116: {T, t}
Result := aux + chr($9e);
85, 117: {U, u}
Result := aux + chr($a5);
86, 118: {V, v}
Result := aux + chr($a7);
87, 119: {W, w}
Result := aux + chr($ba);
88, 120: {X, x}
Result := aux + chr($ad);
89, 121: {Y, y}
Result := aux + chr($bd);
90, 122: {Z, z}
Result := aux + chr($b5);
end;
end;
2:
begin
case OrdChar of
195: {accented letter}
begin
OrdChar := Ord(Char[2]);
case OrdChar of
128, 160: {A + grave, a + grave}
Result := aux + chr($ab);
129, 161: {A + acute, a + acute}
Result := aux + chr($b7);
130, 162: {A + circumflex, a + circumflex}
Result := aux + chr($a1);
131, 163: {A + tilde, a + tilde}
Result := aux + chr($9c);
135, 167: {C + cedilla, c + cedilla}
Result := aux + chr($af);
136, 168: {E + grave, e + grave}
Result := aux + chr($ae);
137, 169: {E + acute, e + acute}
Result := aux + chr($bf);
138, 170: {E + circumflex, e + circumflex}
Result := aux + chr($a3);
140, 172: {I + grave, i + grave}
Result := aux + chr($a9);
141, 173: {I + acute, i + acute}
Result := aux + chr($8c);
143, 175: {I + diaresis, i + diaresis}
Result := aux + chr($bb);
146, 178: {O + grave, o + grave}
Result := aux + chr($ba);
147, 179: {O + acute, o + acute}
Result := aux + chr($ac);
148, 180: {O + circumflex, o + circumflex}
Result := aux + chr($b9);
149, 181: {O + tilde, o + tilde}
Result := aux + chr($aa);
153, 185: {U + grave, u + grave}
Result := aux + chr($b1);
154, 186: {U + acute, u + acute}
Result := aux + chr($be);
156, 188: {U + diaeresis, u + diaeresis}
Result := aux + chr($b3);
end;
end;
end;
end;
end;
end;
function ConvertUTF8TextToBraille(Text:string): string;
var
lCharSize, TextSize, i, OrdChar, nextOrdChar: integer;
Braille_string: string;
PText: Pchar;
IsNum: boolean;
begin
Braille_string := '';
IsNum := False;
if Text = '' then Result := '';
TextSize := Length(Text);
PText := PChar(Text);
i := 1;
while i <= TextSize do
begin
lCharSize := LCLProc.UTF8CharacterLength(PText);
OrdChar := Ord(Text[i]);
case lCharSize of
1:
begin
case OrdChar of
48..57: {a number}
begin
if not IsNum then
begin
Braille_string := Braille_string + number_signal; {first algarism of a number, add a number signal}
IsNum := True
end;
if (i + 1 <= TextSize) then
begin
nextOrdChar := Ord(Text[i + 1]);
if not ((nextOrdChar >= 48) and (nextOrdChar <= 57) or (nextOrdChar = 44) or (nextOrdChar = 46)) then IsNum := False; {the next char is not a number, nor ',', nor '.', then unflag <IsNum>}
end;
end;
65..90: {Upper case letter, add a caps_signal}
Braille_string := Braille_string + caps_signal;
end;
Braille_string := Braille_string + ConvertUTF8CharToBraille(Text[i], 1, OrdChar);
i := i + 1;
end;
2:
begin
nextOrdChar := Ord(Text[i+1]);
case nextOrdChar of
{Accented upper case letter, add a caps_signal}
128..159:
Braille_string := Braille_string + caps_signal;
end;
Braille_string := Braille_string + ConvertUTF8CharToBraille(copy(Text,i,2), 2, OrdChar);
i := i + 2;
end;
end;
Inc(PText, lCharSize);
end;
Result := Braille_string;
end;
function ConvertUTF8HtmlTextToBraille(AInput: string): string;
var
i, lCharSize: integer;
output, aux_string, end_string: string;
is_text: boolean;
Pline : PChar;
begin
i := 1;
output := '';
aux_string := '';
is_text := False;
Pline := PChar(AInput);
while i <= length(AInput) do
begin
end_string := '';
while is_text and (i <= length(AInput)) do
begin
if (AInput[i] = '<') then { an instruction comes next }
begin
is_text := False;
i := i + 1;
Inc(Pline, 1);
end_string := '<';
if (copy(AInput, i, 6) = 'script') then { if it's a script, go through it and
keep reading the text}
begin
i := i + 6;
Inc(Pline, 6);
end_string := end_string + 'script';
while (copy(AInput, i, 9) <> '</script>') do
begin
end_string := end_string + AInput[i];
i := i + 1;
Inc(Pline, 1);
end;
is_text := True;
end;
break;
end;
{ Read the next UTF8 character add it to aux_string }
lCharSize := LCLProc.UTF8CharacterLength(Pline);
aux_string := aux_string + copy(AInput, i, lCharSize);
i := i + lCharSize;
Inc(Pline, lCharSize);
end;
{ Translate aux_string to Braille and add it to output }
output := output + ConvertUTF8TextToBraille(aux_string) + end_string;
aux_string := '';
while (not is_text) and (i <= length(AInput))do
begin
if (AInput[i] = '>') then { End of instruction }
begin
is_text := True;
i := i + 1;
Inc(Pline, 1);
output := output + '>';
break
end;
{ Add the next UTF8 character straight to output, without translating it }
lCharSize := LCLProc.UTF8CharacterLength(Pline);
output := output + copy(AInput, i, lCharSize);
i := i + lCharSize;
Inc(Pline, lCharSize);
end;
end;
ConvertUTF8HtmlTextToBraille := output;
end;
{ TBrailleBrowserModule }
constructor TBrailleBrowserModule.Create;
begin
inherited Create;
ShortDescription := 'Braille Module';
end;
function TBrailleBrowserModule.HandleOnPageLoad(AInput: string; out
AOutput: string): Boolean;
begin
AOutput := ConvertUTF8HtmlTextToBraille(AInput);
Result := True;
end;
initialization
RegisterBrowserModule(TBrailleBrowserModule.Create());
end.
Reference in New Issue View Git Blame Copy Permalink