TRANS.PAS

   1 { Find a Japanese word, and convert to an English word }
   2 function FindWord(var cur : integer; var cat : integer; var index : integer; var word : Str16) : boolean;
   3 var i, j, s, l, fs, fl : integer;
   4 begin
   5   cat := -1;
   6   index := -1;
   7   word := '';
   8   fs := 0;
   9   fl := 0;
  10   s := cur;
  11
  12   while s < Length(Line) do
  13   begin
  14     { Numbers or alphabets (as noun) }
  15     if Line[s] < Chr($80) then
  16     begin
  17       cur := s;
  18       cat := 1;
  19       while (Chr($0) < Line[cur]) and (Line[cur] < Chr($80)) do
  20       begin
  21         word := word + Line[cur];
  22         cur := cur + 1;
  23       end;
  24       FindWord := True;
  25       exit;
  26     end;
  27
  28     { Verb }
  29     for i := 0 to VMax do
  30     begin
  31       for j := 1 to 5 do
  32       begin
  33         l := Length(d[i, j]);
  34         if l > fl then
  35         begin
  36           if Copy(Line, s, l) = d[i, j] then
  37           begin
  38             cat := 0;
  39             index := i;
  40             word := v[i, 1];
  41             fs := s;
  42             fl := l;
  43           end;
  44         end;
  45       end;
  46     end;
  47
  48     { Noun }
  49     for i := 0 to NMax do
  50     begin
  51       for j := 1 to 5 do
  52       begin
  53         l := Length(m[i, j]);
  54         if l > fl then
  55         begin
  56           if Copy(Line, s, l) = m[i, j] then
  57           begin
  58             cat := 1;
  59             index := i;
  60             word := n[i, 1];
  61             fs := s;
  62             fl := l;
  63           end;
  64         end;
  65       end;
  66     end;
  67
  68     { Japanese 'NI' (TO, IN, etc.) }
  69     l := Length('\82É');
  70     if (l > fl) and (Copy(Line, s, l) = '\82É') then
  71     begin
  72       cat := 2;
  73       word := '';
  74       fs := s;
  75       fl := l;
  76     end;
  77
  78     { Janapese 'DE' (WITH) }
  79     l := Length('\82Å');
  80     if (l > fl) and (Copy(Line, s, l) = '\82Å') then
  81     begin
  82       cat := 2;
  83       word := 'with';
  84       fs := s;
  85       fl := l;
  86     end;
  87
  88     if fs > 0 then
  89     begin
  90       cur := fs + fl;
  91       FindWord := True;
  92       exit;
  93     end;
  94
  95     if Line[s] < Chr($80) then
  96       s := s + 1
  97     else
  98       s := s + 2;
  99   end;
 100
 101   FindWord := False;
 102   exit;
 103 end;
 104
 105 { Parse a Janapese sentence, and convert to English words }
 106 procedure ParseJ(var verb : Str16; var noun1 : Str16; var prepos : Str16; var noun2 : Str16);
 107 var cur, cat, index, v, n1, n2 : integer;
 108 var tmp : Str16;
 109 var word : Str16;
 110 begin
 111   verb := '';
 112   noun1 := '';
 113   prepos := '';
 114   noun2 := '';
 115   cur := 1;
 116
 117   { 1st word }
 118   if not FindWord(cur, cat, index, word) then
 119     exit
 120   else if cat = 0 then { verb }
 121   begin
 122     verb := word; v := index;
 123     exit;
 124   end
 125   else if cat = 1 then { noun }
 126   begin
 127     noun1 := word; n1 := index;
 128   end;
 129
 130   { 2nd word }
 131   if not FindWord(cur, cat, index, word) then
 132     exit
 133   else if cat = 0 then { verb }
 134   begin
 135     verb := word; v := index;
 136     exit;
 137   end
 138   else if cat = 1 then { noun }
 139   begin
 140     noun2 := word; n2 := index;
 141   end
 142   else if cat = 2 then { prep }
 143   begin
 144     prepos := word;
 145     noun2 := noun1; n2 := n1;
 146     noun1 := ''; n1 := 0;
 147   end;
 148
 149   { 3rd word }
 150   if not FindWord(cur, cat, index, word) then
 151     exit;
 152   if cat = 0 then {verb }
 153   begin
 154     if (noun2 <> '') and (prepos = '') then
 155     begin
 156       prepos := prep[index];
 157     end;
 158     verb := word; v := index;
 159     exit;
 160   end
 161   else if cat = 1 then { noun }
 162   begin
 163     noun1 := word; n1 := index;
 164   end
 165   else if cat = 2 then { prep }
 166   begin
 167     prepos := word;
 168   end;
 169
 170   { 4th word }
 171   if not FindWord(cur, cat, index, word) then
 172     exit
 173   else if cat = 0 then { verb }
 174   begin
 175     if prepos = '' then
 176       prepos := prep[index];
 177     verb := word; v := index;
 178     if (v = 37{TIE}) and (n2 = 57{ROPE}) then { If 'ROPE NI X WO MUSUBU' }
 179     begin
 180       { Convert to 'ROPE WO X NI MUSUBU' }
 181       tmp := noun1;
 182       noun1 := noun2;
 183       noun2 := tmp;
 184     end
 185   end;
 186 end;
 187
 188 { Parse 'X TO IU'(SAY X) }
 189 procedure ParseSayJ(var message : Str16);
 190 var i : integer;
 191 begin
 192   message := '';
 193   i := Pos(d[31, 1]{ TO IU }, Line);
 194   if i <= 0 then
 195     exit;
 196
 197   message := Copy(Line, 1, i - 1);
 198   if (message = '\83P\83\89\83q\83\88\83`\83~') or (message = '\83P\83\89\83q \83\88\83`\83~') or (message = '\82¯\82ç\82Ð\82æ\82¿\82Ý') or (message = '\82¯\82ç\82Ð \82æ\82¿\82Ý') then
 199     message := 'nepo egassap'
 200   else if message = '\82±\82ñ\82É\82¿\82Í' then
 201     message := 'hello'
 202   else if message = '\82³\82æ\82¤\82È\82ç' then
 203     message := 'bye';
 204 end;
 205
 206 { Convert full width numbers/alphabets to half width }
 207 procedure FullToHalf;
 208 var i, c : integer;
 209 begin
 210   i := 1;
 211   while i < Length(Line) do
 212   begin
 213     if Line[i] < Chr($80) then
 214       i := i + 1
 215     else
 216     begin
 217       c := Pos(Copy(Line, i, 2), '\82O\82P\82Q\82R\82S\82T\82U\82V\82W\82X\82`\82a\82b\82c\82d\82e\82f\82g\82h\82i\82j\82k\82l\82m\82n\82o\82p\82q\82r\82s\82t\82u\82v\82w\82x\82y\82\81\82\82\82\83\82\84\82\85\82\86\82\87\82\88\82\89\82\8a\82\8b\82\8c\82\8d\82\8e\82\8f\82\90\82\91\82\92\82\93\82\94\82\95\82\96\82\97\82\98\82\99\82\9a') - 1;
 218       if (c < 0) or (c mod 2 > 0) then
 219         i := i + 2
 220       else
 221       begin
 222         Delete(Line, i, 2);
 223         Insert('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'[Trunc(c / 2) + 1], Line, i);
 224         i := i + 1;
 225       end;
 226     end;
 227   end;
 228 end;
 229
 230 { Translate a Japanese sentence to English }
 231 procedure Translate;
 232 var message, verb, noun1, prepos, noun2 : Str16;
 233 begin
 234   if ('A' <= Line[1]) and (Line[1] <= 'z') then
 235     exit;
 236
 237   ParseSayJ(message);
 238   if message <> '' then
 239   begin
 240     Line := 'say ' + message;
 241     exit;
 242   end;
 243
 244   FullToHalf;
 245   ParseJ(verb, noun1, prepos, noun2);
 246
 247   if verb = '' then
 248   begin
 249     if noun1 <> '' then
 250       Line := noun1;
 251     exit;
 252   end;
 253
 254   if noun2 <> '' then
 255   begin
 256     Line := verb + ' ' + noun1 + ' ' + prepos + ' ' + noun2;
 257     exit;
 258   end;
 259
 260   if noun1 <> '' then
 261   begin
 262     Line := verb + ' ' + noun1;
 263     exit;
 264   end;
 265
 266   Line := verb;
 267 end;