Poniżej przedstawiamy program w języku Pascal, który posłużył do generacji plików HTML dla projektu słownika. Program ten może również tworzyć słowniki w innych językach - po niewielkiej modyfikacji. Być może będzie on przydatny dla was. Sube ni prezentas komputilan programon en Paskalo, kiun ni uzis por krei la vortarajn TTT-paĝojn. Per jena programo oni ankaŭ povas krei la alijajn vortarojn, tial do ni donas al vi ĝian fontotekston. We present the Pascal source of our program that was used for dictionary generation. Since the program can be used to generate HTML files for other languages, we give you its code for free. Perhaps you will find some use to it. Program wykorzystuje plik tekstowy o nazwie dict.txt kodowany w Unicode i zawierający w każdym wierszu definicję haseł słownika wg schematu: La programo uzas dosieron koditan Unikode kaj nomiĝantan dict.txt. Ĉiu linio de la dosiero definas vortojn por la vortaro laŭmaniere: The program handles Unicode dict.txt file which contains definitions for our dictionary. Each line of this file is in the form of: terminy angielskie (terminy esperanckie) terminy polskie
anglaj vortoj (esperantaj vortoj) polaj vortoj
English terms (Esperanto terms) Polish terms
Plik dict.txt można przygotować w notatniku Windows. Dla terminów esperanckich niezbędna może okazać się klawiatura Unicode, której instalację dokładnie opisujemy w artykule Esperanta Klavaro. Oni povas prepari la dict.txt dosieron per Vindoza Noticilo. Esperantaj vortoj bezonas Unikodan klavaron, kiun oni povas instali laŭ maniero precize priskribata en artikolo pri Esperanta Klavaro. dict.txt file can be prepared using Windows Notebook. To insert Esperanto terms one must have installed a Unicode keyboard. The procedure is precisely described in the article entitled Esperanta Klavaro. { Generator słownika polsko-esperancko-angielskiego ------------------------------------------------- Autor : mgr Jerzy Wałaszek Firma : I Liceum Ogólnokształcące Start : 14-09-2004 16:30 Modyfikacja : 23-04-2006 23:25 Wersja : 1.01 Środowisko : Dev-Pascal 1.9.2 -------------------------------------------------} program DictBuilder; //***************** //*** Definicje *** //***************** var count : integer; // zlicza wczytane wiersze const MAXLINE = 1024; type UChar = Word; // Znak Unicode PUChar = ^Word; // Wiersz znaków Unicode //************************************** //*** Procedury i funkcje pomocnicze *** //************************************** //------------------------------------------------------ // Funkcja zamienia podany znak Unicode na odpowiadającą // mu sekwencję HTML w systemie ISO 8859-2. //------------------------------------------------------ function UCharToHTML(c : UChar) : string; var s : string; begin if c < 256 then s := char(c) else case c of $104 : s := #$A1; // ISO 8859-2 Ą $105 : s := #$B1; // ISO 8859-2 ą $106 : s := #$C6; // ISO 8859-2 Ć $107 : s := #$E6; // ISO 8859-2 ć $108 : s := 'Ĉ'; // Unicode Esperanto C $109 : s := 'ĉ'; // Unicode Esperanto c $118 : s := #$CA; // ISO 8859-2 Ę $119 : s := #$EA; // ISO 8859-2 ę $11C : s := 'Ĝ'; // Unicode Esperanto G $11D : s := 'ĝ'; // Unicode Esperanto g $124 : s := 'Ĥ'; // Unicode Esperanto H $125 : s := 'ĥ'; // Unicode Esperanto h $134 : s := 'Ĵ'; // Unicode Esperanto J $135 : s := 'ĵ'; // Unicode Esperanto j $141 : s := #$A3; // ISO 8859-2 Ł $142 : s := #$B3; // ISO 8859-2 ł $143 : s := #$D1; // ISO 8859-2 Ń $144 : s := #$F1; // ISO 8859-2 ń $15A : s := #$A6; // ISO 8859-2 Ś $15B : s := #$B6; // ISO 8859-2 ś $15C : s := 'Ŝ'; // Unicode Esperanto S $15D : s := 'ŝ'; // Unicode Esperanto s $16C : s := 'Ŭ'; // Unicode Esperanto U $16D : s := 'ŭ'; // Unicode Esperanto u $179 : s := #$AC; // ISO 8859-2 Ź $17A : s := #$BC; // ISO 8859-2 ź $17B : s := #$AF; // ISO 8859-2 Ż $17C : s := #$BF; // ISO 8859-2 ż else s := char(c and $FF); end; UCharToHTML := s; end; //------------------------------------------------------ // Funkcja zamienia małą literę Unicode na dużą i zwraca // wynik w postaci ciągu HTML //------------------------------------------------------ function UpperUChar(c : UChar) : string; begin case c of $61..$7A,$f3 : c := c - 32; $105,$107,$109,$119,$11D,$125,$135, $142,$144,$15B,$15D,$16D,$17A,$17C : dec(c); end; UpperUChar := UCharToHTML(c); end; //-------------------------------------------------- // Funkcja zamienia łańcuch Unicode na odpowiadający // mu tekst dla strony HTML w ISO 8859-2 //-------------------------------------------------- function PUCharToHTML(s : PUChar) : string; var t : string; i : integer; begin t := ''; i := 0; if s <> nil then while s[i] <> 0 do begin t := t + UCharToHTML(s[i]); Inc(i); end; PUCharToHTML := t; end; //------------------------------------------------- // Funkcja oblicza ilość znaków w podanym łańcuchu // Unicode. Znak terminalny nie jest wliczany. //------------------------------------------------- function PUCharLength(s : PUChar) : integer; var i : integer; begin i := 0; while s[i] <> 0 do Inc(i); PUCharLength := i; end; //--------------------------------------------------- // Funkcja zwraca sygnaturę wiersza Unicode, // którą wykorzystują funkcje poszukujące i sortujące //--------------------------------------------------- function USignature(s : PUChar) : string; var t : string; c : UChar; i : integer; begin t := ''; i := 0; while s[i] <> 0 do begin c := s[i]; if c < 256 then begin if char(c) in ['a'..'z'] then dec(c,32); case char(c) of 'A'..'Z' : t := t + char(64 + (c - 64) * 3); char($D3),char($F3) : // Ó i ó w ISO 8859-2 t := t + char(64 + (Ord('O') - 64) * 3 + 1); ' '..'@' : t := t + char(c); else t := t + char(1); end; end else case c of $104, $105 : t := t + char(64 + (Ord('A') - 64) * 3 + 1); $106, $107 : t := t + char(64 + (Ord('C') - 64) * 3 + 1); $108, $109 : t := t + char(64 + (Ord('C') - 64) * 3 + 2); $118, $119 : t := t + char(64 + (Ord('E') - 64) * 3 + 1); $11C, $11D : t := t + char(64 + (Ord('G') - 64) * 3 + 1); $134, $135 : t := t + char(64 + (Ord('J') - 64) * 3 + 1); $124, $125 : t := t + char(64 + (Ord('H') - 64) * 3 + 1); $141, $142 : t := t + char(64 + (Ord('L') - 64) * 3 + 1); $143, $144 : t := t + char(64 + (Ord('N') - 64) * 3 + 1); $15A, $15B : t := t + char(64 + (Ord('S') - 64) * 3 + 1); $15C, $15D : t := t + char(64 + (Ord('S') - 64) * 3 + 2); $16C, $16D : t := t + char(64 + (Ord('U') - 64) * 3 + 1); $179, $17A : t := t + char(64 + (Ord('Z') - 64) * 3 + 1); $17B, $17C : t := t + char(64 + (Ord('Z') - 64) * 3 + 2); else t := t + char(1); end; inc(i); end; USignature := t; end; //*************** //*** Obiekty *** //*************** //---------------------------------------------------------- // Obiekt TUInput odpowiedzialny jest za odczyt kolejnych // wierszy Unicode z pliku słownika. Odczyt jest buforowany. //---------------------------------------------------------- const MAXB = 16384; // Maksymalny rozmiar bufora type TUInput = object private f : file; b : array[0..MAXB-1] of UChar; cp,lb : integer; procedure ReadBuffer; function ReadUChar : UChar; public procedure Init; procedure ReadPUChar(s : PUChar); end; //----------------------------------- // Otwarcie pliku słownika do odczytu //----------------------------------- procedure TUInput.Init; begin AssignFile(f,'dict.txt'); Reset(f,1); lb := 0; cp := 0; ReadUChar; end; //-------------------------------------------------------- // Procedura odczytuje dane z pliku do wewnętrznego bufora //-------------------------------------------------------- procedure TUInput.ReadBuffer; begin cp := 0; if not Eof(f) then begin BlockRead(f,b,sizeof(b),lb); lb := lb div 2; end else begin lb := 0; CloseFile(f); end; end; //---------------------------------------------- // Funkcja odczytuje jeden znak Unicode. Jeśli // napotkany został koniec pliku, zwraca 0 //---------------------------------------------- function TUInput.ReadUChar : UChar; begin if cp = lb then ReadBuffer; if cp < lb then begin ReadUChar := b[cp]; inc(cp); end else ReadUChar := 0; end; //----------------------------------------------- // Procedura odczytuje wiersz znaków Unicode. // Kończy znakiem o kodzie 0. Znaki o kodach // mniejszych od 32 nie są umieszczane w wierszu. //----------------------------------------------- procedure TUInput.ReadPUChar(s : PUChar); var i : integer; c : UChar; begin i := 0; repeat c := ReadUChar; if c >= 32 then begin s[i] := c; Inc(i); end until (c = 0) or (c = $0a); s[i] := 0; end; // Obiekt słownika tworzy dwukierunkową listę: // next - następne hasło // trans1 - lista tłumaczeń języka 1 // trans2 - lista tłumaczeń języka 2 // item - hasło w Unicode // sign - sygnatura w Ansistring // hasło1 hasło2 hasło3 // -->[ next ]-->[ next ]-->[ next ]--> // Do każdego hasła dopiete są dwie listy z tłumaczeniami // w dwóch różnych językach. Listy te mają identyczną // strukturę jak hasło, jednakże nie wykorzystują one już // pól trans1 i trans2, które zawsze zawierają nil. type TDict = class next,trans1,trans2 : TDict; item : PUChar; sign : AnsiString; constructor Create(it : PUChar; n,t1,t2 : TDict); destructor Destroy; override; procedure Insert(line : PUChar; pass : integer); procedure InsertEntry(e,t1,t2 : TDict); procedure InsertTrans(var head : TDict; t : TDict); procedure InsertWord(s : PUChar; t1,t2 : TDict); procedure Save(pass : integer); end; //------------------------------------------------- // Metoda tworzy obiekt i inicjuje jego pola danych //------------------------------------------------- constructor TDict.Create(it : PUChar; n,t1,t2 : TDict); var i : integer; begin if it <> nil then begin if it[0] <> 0 then begin GetMem(item, 2 * PUCharLength(it) + 2); i := 0; repeat item[i] := it[i]; inc(i); until it[i-1] = 0; sign := USignature(item); next := n; trans1 := t1; trans2 := t2; end else begin writeln; writeln('W wierszu ',count + 1,' jest pusty wyraz.'); writeln; writeln('Program wstrzymany. Nacisnij ENTER...'); readln; halt; end; end; end; //-------------------------------------------- // Metoda zwalnia pamięć przydzieloną ze stosu //-------------------------------------------- destructor TDict.Destroy; begin if item <> nil then FreeMem(item, 2 * PUCharLength(item) + 2); sign := ''; trans2.Free; trans1.Free; next.Free; inherited Destroy; end; //----------------------------------------------------- // Metoda wprowadza do słownika hasło e wraz z jego // tłumaczeniami t1 i t2. Wszystkie hasła mogą tworzyć // listę liniową. Wyrazy powtarzające się nie są // umieszczane w słowniku //----------------------------------------------------- procedure TDict.InsertEntry(e,t1,t2 : TDict); begin while e <> nil do begin InsertWord(e.item,t1,t2); e := e.next; end; end; //--------------------------------------------------------- // Metoda umieszcza w słowniku konkretne słowo wraz z jego // tłumaczeniami. Jeśli w słowniku już jest dane słowo, to // zostaną do niego dołączone tylko tłumaczenia t1 i t2. // Elementy powtarzające się nie są wstawiane do słownika. //--------------------------------------------------------- procedure TDict.InsertWord(s : PUChar; t1,t2 : TDict); var p : TDict; sgn : AnsiString; begin p := self; sgn := USignature(s); while (p.next <> nil) and (sgn > p.next.sign) do p := p.next; if p.next = nil then p.next := TDict.Create(s,nil,nil,nil) else if sgn < p.next.sign then p.next := TDict.Create(s,p.next,nil,nil); InsertTrans(p.next.trans1,t1); InsertTrans(p.next.trans2,t2); end; //------------------------------------------------------- // Procedura używana jest do wprowadzenia listy tłumaczeń //------------------------------------------------------- procedure TDict.InsertTrans(var head : TDict; t : TDict); var ph : TDict; begin while t <> nil do begin if head = nil then head := TDict.Create(t.item,nil,nil,nil) else begin ph := head; while (ph.sign <> t.sign) and (ph.next <> nil) do ph := ph.next; if ph.sign <> t.sign then ph.next := TDict.Create(t.item,nil,nil,nil); end; t := t.next; end; end; //------------------------------------------------------------- // Metoda analizuje podany wiersz, rozdziela go na słowa // w poszczególnych językach i wstawia odpowiednio do // słownika w zależności od parametru pass. Wiersz wejściowy // powinien posiadać strukturę haseł rozdzielonych przecinkami: // angielskie (esperanckie) polskie // Dla pass = 1 -> słownik polsko (angielsko) esperancki // Dla pass = 2 -> słownik esperancko (angielsko) polski // Dla pass = 3 -> słownik angielsko (esperancko) polski //------------------------------------------------------------- procedure TDict.Insert(line : PUChar; pass : integer); var entry : array[1..3] of TDict; p : TDict; s : PUChar; c : UChar; i,j,k : integer; begin GetMem(s,MAXLINE); for i := 1 to 3 do entry[i] := nil; i := 0; k := 1; repeat j := 0; while line[i] = 32 do inc(i); repeat c := line[i]; inc(i); s[j] := c; inc(j); until (c = 0) or (c = $2C) or (c = $28) or (c = $29); repeat dec(j); s[j] := 0 until (j = 0) or (s[j-1] <> $20); if entry[k] = nil then entry[k] := TDict.Create(s,nil,nil,nil) else begin p := entry[k]; while p.next <> nil do p := p.next; p.next := TDict.Create(s,nil,nil,nil); end; if c = $28 then k := 2; if c = $29 then k := 3; until c = 0; case pass of 1 : InsertEntry(entry[3],entry[1],entry[2]); 2 : InsertEntry(entry[2],entry[1],entry[3]); 3 : InsertEntry(entry[1],entry[2],entry[3]); end; for i := 1 to 3 do entry[i].Free; FreeMem(s,MAXLINE); end; //-------------------------------------------------------------------------- // Procedura zapisuje treść słownika w odpowiednich plikach w formacie HTML. //-------------------------------------------------------------------------- procedure TDict.Save(pass : integer); var p : TDict; f : Text; wc : integer; fn : string; procedure WriteList(l : TDict); begin while l <> nil do begin write(f,PUCharToHTML(l.item)); l := l.next; if l <> nil then write(f,', '); end; end; procedure CloseHTMLFile; begin str(wc,s); write(f,'</p><p>Liczba słów | word count | la vortnombro : ' + s + '</p></blockquote><hr color="#C0C0C0"><div align="left">' + '<table border="0" style="border-collapse: collapse; ' + 'float: right" cellpadding="4"><tr>'); write(f,'<td valign="top"><span class="big">I Liceum Ogólnokształc±ce' + '</span><br>im. Kazimierza Brodzińskiego<br>w Tarnowie<br>'+ '<span class="small"><a title="Sendu leteron al la autoro" '+ 'href="mailto:edu@vp.pl?subject=La komputilaj fakvortoj">'); write(f,'(C)2004 mgr Jerzy Wałaszek</a></span></td><td valign="top">' + '<span class="big">La Edukada Servo</span><br>Esperanto<br>' + 'Użytki<br></td></tr></table><p style="margin-top: 0">'); write(f,'<a href="../index.html" target="_top">Do strony głównej<br>' + 'Al la ĉefpaĝo<br>Dictionary home page</a>' + '</div></body></html>'); CloseFile(f); end; procedure CheckHTMLFile; var nfn : string; begin Str(ord(p.sign[1]),nfn); while length(nfn) < 3 do nfn := '0' + nfn; case pass of 1 : nfn := 'pol_' + nfn + '.html'; 2 : nfn := 'esp_' + nfn + '.html'; 3 : nfn := 'ang_' + nfn + '.html'; end; if nfn <> fn then begin if fn <> '' then CloseHTMLFile; wc := 0; fn := nfn; AssignFile(f,fn); Rewrite(f); write(f,'<html><head><meta http-equiv="Content-Type" content="text/html; ' + 'charset=iso-8859-2"><meta http-equiv="Content-Language" ' + 'content="pl"><title>Słownik Komputerowy</title>'); write(f,'<link rel="stylesheet" type="text/css" href="../../../../inf.css">' + '<base target="_self"></head><body class="main"><blockquote>'); write(f,'<p align="left" style="margin-bottom: 0px">' + '<font color="#8000ff" size="6"><b>', UpperUChar(p.item[0]), ': </b></font>'); case pass of 1 : write(f,'Słownik: <b>polsko</b> (<i>angielsko</i>) esperancki'); 2 : write(f,'Słownik: <b>esperancko</b> (<i>angielsko</i>) polski'); 3 : write(f,'Słownik: <b>angielsko</b> (<i>esperancko</i>) polski'); end; write(f,'</p><hr><p align="left" style="margin-top: 0px">'); end; end; begin fn := ''; p := next; while p <> nil do begin CheckHTMLFile; write(f,'<b>',PUCharToHTML(p.item),'</b> <i>'); WriteList(p.trans1); write(f,'</i>) '); WriteList(p.trans2); writeln(f,'<br>'); p := p.next; end; CloseHTMLFile;; end; //********************** //*** Program główny *** //********************** var pass : integer; dictionary : array[1..3] of TDict; input : TUInput; line : PUChar; begin writeln('Generator Slownika'); writeln('------------------'); writeln(' (C)2004 mgr J.W. '); writeln(' I LO w Tarnowie '); writeln; writeln('Przetwarzanie danych...'); writeln; for pass := 1 to 3 do dictionary[pass] := TDict.Create(nil,nil,nil,nil); input.Init; GetMem(line,MAXLINE); count := 0; repeat input.ReadPUChar(line); if line[0] <> 0 then begin for pass := 1 to 3 do dictionary[pass].Insert(line,pass); inc(count); end; until line[0] = 0; FreeMem(line,MAXLINE); for pass := 1 to 3 do with dictionary[pass] do begin Save(pass); Free; end; writeln('Wprowadzono ',count,' pozycji'); writeln; writeln('Zadanie wykonane - koniec po klawiszu ENTER.'); readln; end.
| I Liceum Ogólnokształcące im. Kazimierza Brodzińskiego w Tarnowie (C)2004 mgr Jerzy Wałaszek |
La Edukada Servo Esperanto Utilaĵoj Ĝisdatigo je 26-01-2008 |