lojbo valsi
Descripción del contenido de la página
Herramienta escrita en Forth para crear un diccionario de Lojban en CSV.
lojbo valsi es una herramienta que escribí en 2004 para extraer, de dos ficheros de texto en diferentes formatos, datos sobre palabras de la lengua Lojban para crear con ellos un fichero nuevo en formato CSV que pudiera importarse en una base de datos que sirviera de diccionario...
Fue un ejercicio interesante para practicar en Forth el manejo de cadenas y la creación de estructuras de datos sencillas.
El propio código fuente es una curiosa combinación de lenguas: Las palabras propias de Forth están en inglés; las creadas para la aplicación, así como los comentarios, están en esperanto; pero algunas, relacionadas con el contenido de los ficheros de datos, tienen nombres en Lojban...
Código fuente
\ ***********************************************************************
\ lojbo_valsi.fs
\ ***********************************************************************
(
Programo lojbo_valsi.fs
por konstrui signo-disigitajn datumarojn el lojhban-vortolistoj
verkita en programlingvo Forth
http://www.forth.org
per Forth-sistemo gforth
http://www.jwdt.com/~paysan/gforth.html
sub mastruma sistemo Debian GNU/Linux
http://debian.org
http://gnu.org
far Marcos Cruz (programandala.net)
Historio:
2004 03 19
Komenco per el la jama programo mia "eeo".
2004 04 07
Funkcianta versio por gismu.txt kaj cmavo.txt.
La rezulto lojbo_valsi.csv estis sukcese importita en la datumprogramon de
la poshkomputilo Psion 5mx.
2004 09 11
La vortojn gismu-dosiero kaj cmavo-dosiero mi diserigis por plifaciligo.
Modifita la vorto $chenero_inter por solvi la problemon, ke la lasta kampo,
"selckini", konservis la lastan signon de la antawa kampo kiam ne estis
"(cf." en ghi por disigo.
Modifita la vorto gismu_selckini por solvi la problemon, ke chiu "valsi",
kiel "nenri", havanta krampojn inter la krampoj de "(cf.", ne apartigis
bone la enhavon de la kampo "selckini".
Verkita la vorto $chenero_maldekstra kvankam poste neuzita.
Verkita la vorto kamponomoj .
Verkita la vorto montru por montri la vortojn elprenatajn.
2004 09 12
Kreita sistemo por kalkuli kaj montri la maksimumajn longojn de chiu kampo.
Solvenda:
Post la laboro, restas du -1 en la stako
)
\ ***********************************************************************
\ Klarigoj
\ ***********************************************************************
\ Stakmallongigoj:
\ mallongigo : cheloj : priskribo
\ a : 1 : adreso
\ $a : 1 : adreso de signochena variablo (propra sistemo)
\ c : 1 : signo
\ n : 1 : signa nombro
\ u : 1 : sensigna nombro
\ fid : 1 : dosier-identigilo
\ fam : 1 : dosiera malferm-metodo
\ f : 1 : flago
\ ***********************************************************************
\ Sistemo por erarserchado
\ ***********************************************************************
: halto ( n -- )
\ Montras numeron, la stakon kaj haltas ghis klavo premitas.
CR . ." *** " .S
( 10 = DEPTH 1 > AND ) TRUE
IF
KEY
CASE
[CHAR] . OF DUP CR . ENDOF
[CHAR] $ OF 2DUP CR ." >>" TYPE ." <<" ENDOF
[CHAR] H OF BYE ENDOF
ENDCASE
THEN
;
\ ***********************************************************************
\ Bazaj nombraj iloj
\ ***********************************************************************
: inter ( a a1 a2 -- f )
\ verkita je 2002 08 07
\ Redonas, chu numero estas inter du limoj (ekde la unua ghis la dua)
\ a = numero kontrolenda
\ a1 = komenca limo
\ a2 = fina limo
2 pick swap <= \ chu ne pli granda ol la fina limo?
rot rot >= \ chu ne pli malgranda ol la komenca limo?
and \ ambaj kondichoj necesas
;
\ ***********************************************************************
\ Propra sistemo por tekstaj variabloj
\ ***********************************************************************
: $variablo ( u -- )
\ Kreas novan tekstan variablon.
\ u = maksimuma longo
CREATE
DUP , 0 , 2 + ALLOT
;
: $'maksimuma_longo ( $a -- a )
\ Redonas la adreson kie estas la maksimuma longo de teksta variablo.
0 CELLS +
;
: $maksimuma_longo ( $a -- u )
\ Redonas la maksimuman longon de teksta variablo.
$'maksimuma_longo @
;
: $'longo ( $a -- a )
\ Redonas la adreson kie estas la longo de teksta variablo.
1 CELLS +
;
: $longo ( $a -- u )
\ Redonas longon de teksta variablo.
$'longo @
;
: $'enhavo ( $a -- a )
\ Redonas la adreson kie estas enhavo de teksta variablo.
2 CELLS +
;
: $nuligu ( $a -- )
\ Igas tekstan variablon longa je nulo.
0 SWAP $'longo ! \ nuligi nombron da signoj
;
: $purigu ( $a -- )
\ Purigas tekstan variablon per spacoj, kaj igas ghin longa je nulo.
DUP $nuligu \ nuligi nombron da signoj
DUP $'enhavo SWAP $maksimuma_longo BLANK \ purigi la ujon
;
: $! ( a u $a -- )
\ Konservas tekston en tekstan variablon.
\ a u = adreso kaj longo de la teksto
\ $a = adreso de la teksta variablo
\ u' = longo ne plia ol la maksimuma longo de la teksta variablo
DUP $purigu
DUP $maksimuma_longo ROT MIN ( a $a u' ) \ limigi la longon
2DUP SWAP $'longo ! \ konservi la novan nombron
SWAP $'enhavo SWAP CMOVE
;
: $@ ( $a -- a u )
\ Redonas la enhavon de teksta variablo.
DUP $'enhavo SWAP $longo
;
: $. ( $a -- )
\ Printas la enhavon de teksta variablo.
$@ TYPE
;
: $@+ ( $a -- a u )
\ Redonas la maksimuman enhavon de teksta variablo.
DUP $'enhavo SWAP $maksimuma_longo
;
\ ***********************************************************************
\ Bufro por provizoraj tekstoj kaj tradukoj inter numero kaj teksto
\ ***********************************************************************
\ Iuj el jenaj vortoj estas prenitaj, kun adapto, el:
\ strings.4th
\ String utility words for kForth
\ 3-24-1999 created KM
\ 3-25-1999 added number to string conversions KM
16384 CONSTANT bufrolongo
CREATE bufro bufrolongo ALLOT
VARIABLE bufrero \ por chiufoje celumi al libera spaco de la bufro
bufro bufrero !
: bufrero@ ( -- a )
\ Redonas la adreson de bufrero.
bufrero @
;
: bufrero! ( u -- )
\ Celumigas la bufreron al libera bufra spaco por u bitokoj
bufrero@ + bufro bufrolongo + >=
IF bufro bufrero ! THEN
;
: bufren ( a1 u1 -- a2 u2 )
\ Kopias tekston bufren por protekti ghin.
DUP bufrero! DUP >R
bufrero@ SWAP CMOVE
bufrero@ R>
DUP bufrero +!
;
32 CONSTANT numerlongo
: n>$ ( n -- a1 u1 )
\ Kreas chenon el numero.
\ n = numero
\ a1 u1 = teksta cheno
\ +n = numero ekzaminata, pozitiva kaj restanta el dividoj
\ a = adreso de la cifero kalkulata
\ b = cifero kalkulita
numerlongo bufrero!
0 bufrero@ numerlongo 1- + C!
bufrero@ numerlongo 2 - + SWAP
DUP >R ABS ( a +n ) ( R: n )
BEGIN
10 /MOD SWAP [CHAR] 0 + \ kalkuli ciferon ( a +n b )
>R OVER R> SWAP C! \ konservi ciferon ( a +n )
SWAP 1- SWAP \ celumi al adreso por venonta cifero
DUP 0=
UNTIL
DROP
R> 0<
IF
[CHAR] - OVER C! 1- \ meti minusan signon
THEN
bufrero@ numerlongo 2 - + OVER - \ kalkuli longon de la cheno
numerlongo bufrero +! \ protekti la rezulton
SWAP 1+ SWAP
;
VARIABLE numersigno
VARIABLE numervaloro
: $>n ( a u -- n )
\ Kreas numeron el cheno.
numervaloro OFF
FALSE numersigno !
0
DO
DUP C@
DUP [CHAR] - =
IF
TRUE numersigno !
ELSE
DUP [CHAR] + =
IF
FALSE numersigno !
ELSE
DUP DUP [CHAR] / > SWAP [CHAR] : < AND
IF
DUP [CHAR] 0 - numervaloro @ 10 * + numervaloro !
THEN
THEN
THEN
DROP
1+
LOOP
DROP numervaloro @
numersigno @
IF NEGATE THEN
;
\ ***********************************************************************
\ Gheneralaj tekstaj iloj
\ ***********************************************************************
: $1 ( c -- a 1 )
\ Kreas en la bufro kaj redonas tekston el unu signo.
1 bufrero! bufrero@ C! bufrero@ 1 DUP bufrero +!
;
: spaco ( -- a 1 )
\ Redonas tekston el unu spaco.
BL $1
;
: tabulatoro ( -- a 1 )
\ Verkita je 2004 03 19
\ Redonas tekston el unu tabulatoro.
9 $1
;
: citiloj ( -- a 1 )
\ Redonas tekston el citiloj.
[CHAR] "
\ " chi komento nur por ghusta kolorigo far Vim
$1
;
: $+ ( a1 u1 a2 u2 -- a3 u3 )
\ Redonas unuigon de du tekstoj.
DUP 3 PICK + DUP >R \ kalkuli kaj savi finan longon
bufrero! \ rezervi spacon por la rezulto
2SWAP DUP >R bufrero@ SWAP CMOVE \ movi unuan tekston
R> bufrero@ + SWAP CMOVE \ movi duan tekston
bufrero@ R> \ adreso kaj fina longo
DUP bufrero +! \ reghustigi bufreron por protekti la rezulton
;
: $= ( a1 u1 a2 u2 -- f )
\ Kontrolas, chu du chenoj estas identaj.
\ a1 u1 = unua cheno
\ a2 u2 dua cheno
\ f = jes?
COMPARE 0=
;
: $anstatawigu? ( a1 u1 a2 u2 a3 u3 -- a4 u4 f )
\ Anstatawigas subchenon en cheno.
\ a1 u1 = cheno
\ a2 u2 = subcheno serchata por anstatawigo
\ a3 a3 = cheno anstatawa
\ a4 u4 = nova cheno
\ a5 u5 = restanta parto el la cheno ekde la trovita subcheno
\ a6 u6 = restanta parto el la cheno post la trovita subcheno
\ u1' = longo de la cheno ghis la trovita subcheno
\ f = chu anstatawo farita?
\ f' = chu subcheno trovita?
2>R DUP >R ( a1 u1 a2 u2 ) ( R: a3 u3 u2 )
2OVER 2SWAP SEARCH ( a1 u1 a5 u5 f' ) ( R: a3 u3 u2 )
IF \ trovita
SWAP >R ( a1 u1 u5 ) ( R: a3 u3 u2 a5 )
DUP >R - ( a1 u1' ) ( R: a3 u3 u2 a5 u5 )
2R> R> ( a1 u1' a5 u5 u2 ) ( R: a3 u3 )
DUP >R - ( a1 u1' a5 u6 ) ( R: a3 u3 u2 )
SWAP R> + SWAP ( a1 u1' a6 u6 ) ( R: a3 u3 )
2R> 2SWAP 2>R $+ 2R> $+ TRUE
ELSE
2DROP R> DROP 2R> 2DROP FALSE
THEN
;
: $anstatawigu ( a1 u1 a2 u2 a3 u3 -- a4 u4 )
\ Anstatawigas subchenon en cheno.
\ a1 u1 = cheno
\ a2 u2 = subcheno serchata por anstatawigo
\ a3 a3 = cheno anstatawa
\ a4 u4 = nova cheno
$anstatawigu? DROP
;
: $anstatawigu_chiujn ( a1 u1 a2 u2 a3 u3 -- a4 u4 )
\ Anstatawigas chiujn aperon de subcheno en cheno.
\ a1 u1 = cheno
\ a2 u2 = cheno serchata por anstatawigo
\ a3 u3 = cheno anstatawa
\ a4 u4 = nova cheno
5 ROLL 5 ROLL ( a2 u2 a3 u3 a1 u1 )
BEGIN
5 PICK 5 PICK 5 PICK 5 PICK ( a2 u2 a3 u3 a1 u1 a2 u2 a3 u3 )
$anstatawigu? 0= ( a2 u2 a3 u3 a4 u4 f )
UNTIL
2>R 2DROP 2DROP 2R>
;
: $forvishu ( a1 u1 a2 u2 -- a3 u3 )
\ Forvishas chenon el alia.
\ a1 u1 = cheno en kiu serchi
\ a2 u2 = cheno serchota kaj forvishota
\ a3 u3 = cheno sen la unua apero de la forvishenda cheno
S" " $anstatawigu
;
: $forvishu_chiujn ( a1 u1 a2 u2 -- a3 u3 )
\ Forvishas chiujn aperojn de cheno el alia.
\ a1 u1 = cheno en kiu serchi
\ a2 u2 = cheno serchota kaj forvishota
\ a3 u3 = cheno sen chiuj aperoj de la forvishenda cheno
2SWAP
BEGIN
2OVER S" " $anstatawigu? 0=
UNTIL
2SWAP 2DROP
;
: $sen_komencaj_spacoj ( a1 u1 -- a2 u2 )
\ Forigas komencajn spacojn el cheno.
DUP
IF
2DUP 0
DO
DUP I + C@ BL <>
IF I + SWAP I - ROT LEAVE THEN
LOOP
DROP
THEN
;
: $sen_flankaj_spacoj ( a1 u1 -- a2 u2 )
\ Forigas komencajn kaj finajn spacojn el cheno.
-TRAILING $sen_komencaj_spacoj
;
: $ghis_antaw? ( a1 u1 a2 u2 -- a1 u4 f )
\ Redonas enhavon de cheno ghis antaw la unua apero de subcheno.
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a1 u4 = nova aw sama cheno
\ f = sukcese?
2 PICK >R 3 PICK >R \ konservi chenon por poste
SEARCH
IF
SWAP DROP R> SWAP ( a1 u3 )
R> SWAP - ( a1 u4 )
TRUE
ELSE
2R> 2DROP FALSE
THEN
;
: $ghis_antaw ( a1 u1 a2 u2 -- a1 u4 )
\ Redonas enhavon de cheno ghis antaw la unua apero de subcheno.
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a1 u4 = nova aw sama cheno
$ghis_antaw? DROP
;
: $ghis_antaw_lasta ( a1 u1 a2 u2 -- a1 u4 )
\ Redonas enhavon de cheno ghis antaw la lasta apero de subcheno.
\ VERKATA !!!
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a1 u4 = nova aw sama cheno
2 PICK >R
FALSE
BEGIN
$ghis_antaw?
DUP
UNTIL
\ alia sistemo VERKATA !!!
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a1 u4 = nova aw sama cheno
2 PICK >R 3 PICK >R \ konservi chenon por poste
SEARCH
IF
SWAP DROP R> SWAP ( a1 u3 )
R> SWAP - ( a1 u4 )
TRUE
ELSE
2R> 2DROP FALSE
THEN
\ alia sistemo VERKATA !!! bazita sur $de_post_lasta
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a3 u3 = cheno en kiu eble trovighas komence la subcheno
\ a4 u4 = cheno sen la komenca subcheno
\ a5 u5 = fina nova cheno
2SWAP
BEGIN
2OVER ( a2 u2 a1 u1 a2 u2 )
SEARCH ( a2 u2 a3 u3 f )
WHILE
\ subcheno trovita
( a2 u2 a3 u3 )
2OVER \ $de_post ( a2 u2 a4 u4 )
REPEAT
2SWAP 2DROP
;
: $ghis_post? ( a1 u1 a2 u2 -- a1 u4 f )
\ Redonas enhavon de cheno ghis post la unua apero de subcheno.
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a1 u4 = nova aw sama cheno
\ f = sukcese?
DUP >R \ konservi longon de subcheno
$ghis_antaw?
R> SWAP
IF
+ TRUE
ELSE
DROP FALSE
THEN
;
: $de_post? ( a1 u1 a2 u2 -- a4 u4 f )
\ Redonas enhavon de cheno de post la unua apero de subcheno.
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a4 u4 = nova aw sama cheno
\ f = sukcese?
DUP >R SEARCH R> SWAP
IF
\ subcheno trovita en la cheno
\ necesas adapti la rezulton por forigi el ghi la subchenon
SWAP OVER - \ kalkuli longon
>R + R> TRUE \ kalkuli adreson
ELSE
DROP FALSE
THEN
;
: $de_post ( a1 u1 a2 u2 -- a4 u4 )
\ Redonas enhavon de cheno de post la unua apero de subcheno.
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a4 u4 = nova aw sama cheno
$de_post? DROP
;
: $de_post_lasta ( a1 u1 a2 u2 -- a5 u5 )
\ Redonas enhavon de cheno de post la lasta apero de subcheno
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a3 u3 = cheno en kiu eble trovighas komence la subcheno
\ a4 u4 = cheno sen la komenca subcheno
\ a5 u5 = fina nova cheno
2SWAP
BEGIN
2OVER ( a2 u2 a1 u1 a2 u2 )
SEARCH ( a2 u2 a3 u3 f )
WHILE
\ subcheno trovita
( a2 u2 a3 u3 )
2OVER $de_post ( a2 u2 a4 u4 )
REPEAT
2SWAP 2DROP
;
: $kiomaj_signoj ( c a1 u1 -- u2 )
\ Kalkulas, kiom da fojoj estas signo en cheno.
\ a1 u1 = cheno
\ c = signo
\ u2 = kiomo
DUP
IF
ROT 0 SWAP 2SWAP ( u2 c a1 u1 )
OVER + SWAP
DO
( u2 c )
DUP I C@ = NEGATE ROT + SWAP
LOOP
DROP
ELSE
\ malplena cheno
2DROP DROP 0
THEN
;
: $inter ( a1 u1 a2 u2 a3 u3 -- a4 u4 )
\ Redonas enhavon de cheno ekde post subcheno ghis antaw alia subcheno.
\ a1 u1 = cheno
\ a2 u2 = unua subcheno, ekde post kiu preni tekston
\ a3 u3 = dua subcheno, ghis antaw kiu preni tekston
\ a4 u4 = rezulto, ech se nula
\ Malnova versio, kiu almenaw redonis la saman chenon:
(
2>R $de_post
2R> $ghis_antaw? DROP
)
\ Nova versio por redoni nulan chenon se nesuksece:
2>R $de_post?
ABS * \ nuligi longon se nesukcese
2R> $ghis_antaw?
ABS * \ nuligi longon se nesukcese
;
: $inter? ( a1 u1 a2 u2 a3 u3 -- a4 u4 TRUE | FALSE )
\ Redonas enhavon de cheno ekde post subcheno ghis antaw alia subcheno.
\ a1 u1 = cheno
\ a2 u2 = unua subcheno, ekde post kiu preni tekston
\ a3 u3 = dua subcheno, ghis antaw kiu preni tekston
\ a4 u4 = chena rezulto, se sukcese
$inter DUP
IF TRUE ELSE 2DROP FALSE THEN
;
: $dividu_je? ( a1 u1 a2 u2 -- a4 u4 a1 u3 TRUE | a1 u1 FALSE )
\ Dividas chenon che forigenda subcheno, kaj redonas ambajn partojn.
\ a1 u1 = cheno dividenda
\ a2 u2 = subcheno forigenda
\ a1 a3 = dekstra parto
\ a4 u4 = maldekstra parto
2OVER 2OVER
$ghis_antaw?
IF
2>R $de_post 2R> TRUE
ELSE
2DROP 2DROP FALSE
THEN
;
: $en? ( a1 u1 a2 a2 -- f )
\ Respondas, chu cheno estas en alia.
\ a1 u1 = cheno en kiu serchi
\ a2 u2 = cheno serchata
\ f = chu jes?
SEARCH >R 2DROP R>
;
: ($flanke?) ( a1 u1 a2 u2 a3 -- f )
\ Verkita je 2002 08 21
\ Redonas, chu subcheno estas en certa adreso de cheno
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ f = sukcese?
\ a3 = adreso en kiu estu la subcheno por sukceso
>R
SEARCH ( a3 u3 f )
SWAP DROP
SWAP R> = AND \ chu trovita kaj adreso estas sama ol a1
;
: $maldekstre? ( a1 u1 a2 u2 -- f )
\ Modifita je 2002 08 21
\ Redonas, chu subcheno estas la maldekstra parto de cheno
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ f = sukcese?
3 PICK \ preni endan adreson de la subcheno
($flanke?)
;
: $dekstre? ( a1 u1 a2 u2 -- f )
\ Verkita je 2002 08 21
\ Redonas, chu subcheno estas la dekstra parto de cheno
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ f = sukcese?
2 PICK OVER - 4 PICK + \ kalkuli endan adreson de la subcheno
($flanke?)
;
: $krom_maldekstra? ( a1 u1 a2 u2 -- a4 u4 TRUE | FALSE )
\ Se subcheno estas la maldekstra parto de cheno,
\ redonas la chenon krom la subcheno.
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a4 u4 = rezulto
DUP >R 2OVER 2>R ( R: u2 a1 u1 )
$maldekstre?
2R> ROT ( a1 u1 f ) ( R: u2 )
IF
R> ROT OVER + ( u3 u2 a4 )
ROT ROT - TRUE ( a4 u4 TRUE )
ELSE
2DROP R> DROP FALSE
THEN
;
: $krom_maldekstra ( a1 u1 a2 u2 -- a4 u4 )
\ Se subcheno estas la maldekstra parto de cheno,
\ redonas la chenon krom la subcheno.
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a4 u4 = rezulto, nova aw sama cheno
2OVER 2SWAP $krom_maldekstra?
IF
2SWAP 2DROP
THEN
;
: $krom_dekstra ( a1 u1 a2 u2 -- a4 u4 )
\ Verkita je 2002 08 21
\ Se subcheno estas la dekstra parto de cheno,
\ redonas la chenon krom la subcheno.
\ a1 u1 = cheno
\ a2 u2 = subcheno
\ a4 u4 = rezulto, nova aw sama cheno
2OVER 2>R \ konservi la chenon por poste
DUP >R \ konservi longon de subcheno por poste
$dekstre? \ kontroli, chu subcheno estas dekstre de la cheno
R> * \ repreni longon subchenan k oblige per la flago, nuligi aw minusigi
2R> ROT + \ repreni la unuan chenon kaj kalkuli la novan longon
;
: minuskligu ( a1 u1 -- a2 u2 )
\ verkita je 2002 06 05
\ Minuskligas literojn de teksto
\ a1 u1 = originala teksto
\ a2 u2 = rezulta teksto
2DUP
OVER + SWAP
DO
I C@ DUP \ preni du kopiojn de la signo
[CHAR] A [CHAR] Z inter SWAP \ chu majuskla angla litero?
[CHAR] À [CHAR] Ö inter OR \ aw chu majuskla neangla litero?
IF
\ necesas minuskligi
I C@ 32 OR I C! \ repreni, minuskligi kaj remeti
THEN
LOOP
;
: >dosiernome ( a1 u1 -- a2 u2 )
\ Modifita je 2002 08 21
\ Shanghas tekston en tawgan dosiernomon
\ a1 u1 = originala teksto
\ a2 u2 = rezulta teksto
minuskligu
S" " S" _" $anstatawigu_chiujn \ spacoj
;
: ($+_dosiere) ( a1 u1 a2 u2 -- a u )
\ Laste modifita je 2002 06 29
\ Kunigas du tekstojn per "/", tekovojon kaj dosiernomon.
\ a1 u1 = unua cheno, tekovojo
\ a2 u2 = dua cheno, tekovojo aw dosiernomo
\ a u = rezulto
DUP 3 PICK + 0=
IF
\ ambaj chenoj nullongas
2DROP \ do eblas lasi nur unu el ili
ELSE
\ almenaw unu cheno ne nullongas
OVER C@ [CHAR] / = \ se la unua signo de la cheno estas "/"...
IF
S" /" $de_post \ ...forigi ghin por posta simpligo
THEN
2OVER + 1- C@ [CHAR] / <> \ chu la lasta signo de la unua cheno ne estas "/" ?
>R \ apartigi la rezulton
OVER C@ [CHAR] / <> \ chu la unua signo de la dua cheno ne estas "/" ?
>R \ apartigi la rezulton
2 PICK \ chu ne la unua cheno malplenas?
2R> AND AND \ repreni la du antawajn rezultojn kaj kunigi la tri kondichojn
IF
\ mankas stangoj al ambaw, do endas intermeti unu
S" /" 2SWAP $+ \ aldoni la stangon al la komenco de la dua cheno
THEN
$+
THEN
>dosiernome
;
: $+_dosiere ( a1 u1 a2 u2 -- a u )
\ Verkita je 2002 06 29 por prekontroli la parametrojn
\ Kunigas du tekstojn per "/", tekovojon kaj dosiernomon.
\ Kontrolas pri tekstolongoj kaj lawe vokas ($+_dosiere)
\ a1 u1 = unua cheno, tekovojo
\ a2 u2 = dua cheno, tekovojo aw dosiernomo
\ a u = rezulto
DUP 0=
IF
\ dua cheno nullongas
2DROP
ELSE
2 PICK 0=
IF
\ unua cheno nullongas
2SWAP 2DROP
ELSE
\ neniu cheno nullongas
($+_dosiere)
THEN
THEN
;
: ($ghusta_pozicio) ( $a u1 -- $a u1' )
\ Verkita je 2004 03 28
\ Ghustigas celumitan pozicion al cheno.
\ $a = cheno
\ u1 = pozicio celumita
\ u1' = pozicio celumita ghustigita ghis maksimume la lasta chensigno
OVER $longo 1- MIN
;
: ($chenero) ( $a u2 u1 -- a u )
\ Verkita je 2004 03 28
\ Redonas cheneron el cheno, inter du pozicioj
\ $a = cheno
\ u2 = lasta pozicio
\ u1 = unua pozicio
\ a u = chenero
2DUP - 1+ >R \ (s $a u2 u1 ) (r u )
SWAP DROP
SWAP $'enhavo + R> \ (s a u )
;
: $chenero ( $a u1 u2 -- a3 u3 )
\ Verkita je 2004 03 28
\ Redonas cheneron el cheno.
\ $a = cheno
\ u1 = unua pozicio
\ u2 = longo de la chenero
\ u1' = unua pozicio, ghustigita ghis maksimume la lasta pozicio de la cheno
\ u2' = dua pozicio, ghustigita ghis maksimume la lasta pozicio de la cheno
\ a3 u3 = chenero
>R ($ghusta_pozicio) \ (s $a u1' ) (r u2 )
R> OVER >R + 1- ($ghusta_pozicio) R> \ (s $a u2' u1' )
($chenero)
;
: $chenero_inter ( $a u1 u2 -- a3 u3 )
\ Verkita je 2004 03 28
\ Modifita je 2004 09 11 por kontroli, chu la unua pozicio pli grandas ol la dua
\ Redonas cheneron el cheno.
\ $a = cheno
\ u1 = unua pozicio
\ u2 = dua pozicio
\ u1' = unua pozicio, ghustigita ghis maksimume la lasta pozicio de la cheno
\ u2' = dua pozicio, ghustigita ghis maksimume la lasta pozicio de la cheno
\ a3 u3 = chenero
2DUP >
IF \ la unua pozicio estas pli granda ol la unua
2DROP $'enhavo 0 \ redoni nulan cheneron
ELSE
>R ($ghusta_pozicio) \ (s $a u1' ) (r u2 )
R> SWAP >R ($ghusta_pozicio) R> \ (s $a u2' u1' )
($chenero)
ENDIF
;
: $chenero_maldekstra ( $a u -- a3 u3 )
\ Verkita je 2004 09 11
\ Redonas cheneron el la indikitaj signoj maldekstraj el cheno
\ $a = cheno
\ u = signoj
\ a3 u3 = chenero
SWAP $'enhavo SWAP
;
: $chenero_ghis_fino ( $a u -- a3 u3 )
\ Verkita je 2004 09 11
\ Redonas cheneron el cheno, de la indikita unua pozicio ghis la fino
\ $a = cheno
\ u = unua pozicio
\ a3 u3 = chenero
OVER $longo 1- $chenero_inter
;
\ ***********************************************************************
\ Printi kaj legi dosierojn
\ ***********************************************************************
VARIABLE >dosiero \ por identigilo de la elira dosiero
VARIABLE <dosiero \ por identigilo de la enira dosiero
256 $variablo >dosiero$ \ por kompleta nomo, kun vojo, de la elira dosiero
: >teksto ( a u -- )
\ Printas tekston en nunan eldosieron.
\ a u = teksto skribenda
>dosiero @ WRITE-FILE
ABORT" Eraro dum skribado de teksto en dosieron."
;
: "> ( -- )
\ Printas citilojn en eldosieron
citiloj >teksto
;
: >"teksto" ( a u -- )
\ Printas tekston inter citiloj en nunan eldosieron.
\ a u = teksto skribenda
"> >teksto ">
;
: >linio ( a u -- )
\ Printas tekston en dosieron kaj finas per linifino.
\ a u = linio skribenda
>dosiero @ WRITE-LINE
ABORT" Eraro dum skribado de linio en dosieron."
;
: $<linio ( $a -- f )
\ Legas linion el dosiero kaj konservas ghin en teksta variablo.
\ $a = adreso de teksta variablo en kiun konservi la linion
\ f = flago, nula se ne eblis legi linion
DUP >R
$@+ <dosiero @ READ-LINE
ABORT" Eraro dum legado de linio."
SWAP R> $'longo !
;
\ ***********************************************************************
\ Gheneralaj variabloj kaj konstantoj
\ ***********************************************************************
1024 $variablo linio$ \ ghenerala por legidosierojn polinie
255 $variablo dosierujo$ \ kie krei la dosieron
S" ./" dosierujo$ $!
\ ***********************************************************************
\ Pri malfermo kaj fermo de dosieroj
\ ***********************************************************************
: dosiercelumilo ( fid -- ud )
\ Laste modifita je 2002 03 18
\ Redonas nunan celumilon por la koncerna dosiero.
\ fid = dosieridentigilo
\ ud = nuna pozicio
FILE-POSITION
ABORT" Eraro dum preno de dosiercelumilo."
;
: celumu_dosieron ( ud fid -- )
\ Laste modifita je 2002 03 18
\ Celumas dosieron
\ ud = nova pozicio
\ fid = dosieridentigilo
REPOSITION-FILE
ABORT" Eraro dum preno de dosiercelumilo."
;
: aldonu_tekojn ( a u fam -- )
\ Aldonas nunajn tekojn al dosiernomo por konstrui kompletan dosiervojon.
\ Konservas la rezulton (sen dosierujo) por posta uzo.
\ a u = dosiernomo
>R
2DUP >dosiero$ $! \ por postaj kalkuloj en vortoj retrovojo kaj gvidilo
dosierujo$ $@ 2SWAP $+_dosiere \ aldoni dosierujon
R>
;
: malfermu ( a u fam -- fid )
\ Laste modifita je 2002 03 18
\ Malfermas dosieron kaj redonas ghian identigilon.
\ a u = dosiernomo
\ fam = maniero malfermi la dosieron
DUP W/O = \ chu eldosiero?
IF
aldonu_tekojn
THEN
OPEN-FILE
ABORT" Eraro dum malfermo de dosiero."
;
: kreu_dosieron ( a u fam -- fid )
\ Laste modifita je 2002 03 18
\ Kreas kaj malfermas dosieron kaj redonas ghian identigilon.
\ a u = dosiernomo
DUP W/O = \ chu eldosiero?
IF
aldonu_tekojn
THEN
CREATE-FILE
ABORT" Eraro dum kreo de dosiero."
;
: fermu ( fid -- )
\ Laste modifita je 2002 03 18
\ Fermas dosieron.
CLOSE-FILE
ABORT" Eraro dum fermo de dosiero."
;
\ ***********************************************************************
\ Chefbuklo
\ ***********************************************************************
: kampofino ( -- )
\ Metas signon por dividi kampojn de eksportata rikordo.
( tabulatoro ) S" ," >teksto
;
: (>kampo) ( a u -- )
\ Printas eldosiere kaj ekrane kampon el eksportata rikordo.
\ a u = teksto de la kampo
\ 2DUP
citiloj S" '" $anstatawigu_chiujn >"teksto"
\ ." <" TYPE ." >" CR
;
: >kampo ( a u -- )
\ Printas eldosiere kaj ekrane kampon el eksportata rikordo
\ kaj markas kampofinon
\ a u = teksto de la kampo
(>kampo) kampofino
;
: >fina_kampo ( a u -- )
\ Printas eldosiere kaj ekrane finan kampon el eksportata rikordo
\ a u = teksto de la kampo
(>kampo) S" " >linio
\ ." --------" CR
;
: >linio$
\ Verkita je 2004 04 07
\ legas linion de endosiero en la variablon $linio-n
linio$ $<linio
;
: montru ( a u -- a u )
\ Verkita je 2004 09 11
\ Montras chenon kaj konservas ghin
2DUP TYPE ." "
;
\ variabloj por konservi la maksimuman longon de chiu kampo
\ kreitaj je 2004 09 12
variable valsi-longo
variable klesi-longo
variable rafsi-longo
variable selma'o-longo
variable xelfanva-longo
variable velciksi-longo
variable selckini-longo
: longojn_nuligu ( -- )
\ Kreita je 2004 09 12
\ Nuligas la variablojn kiuj konservos la maksimumajn longojn de la kampoj
0 valsi-longo !
0 klesi-longo !
0 rafsi-longo !
0 selma'o-longo !
0 xelfanva-longo !
0 velciksi-longo !
0 selckini-longo !
;
: longojn_montru ( -- )
\ Kreita je 2004 09 12
\ Montras la maksimumajn longojn de la kampoj
CR ." Maksimumaj longoj de chiu kampo, en bajtoj:"
CR ." valsi " valsi-longo ?
CR ." klesi " klesi-longo ?
CR ." rafsi " rafsi-longo ?
CR ." selma'o " selma'o-longo ?
CR ." xelfanva " xelfanva-longo ?
CR ." velciksi " velciksi-longo ?
CR ." selckini " selckini-longo ?
CR CR
;
: maksimuma! ( a u a2 -- a u )
\ Kreita je 2004 09 12
\ Aktualigas variablon per la maksimumo el inter ghia nuna enhavo kaj la longo de cheno.
\ a u = cheno
\ variablo
DUP >R @ OVER MAX R> !
;
: gismu_valsi ( $linio -- a u )
\ Elmetita el gismu-dosiero kaj modifita je 2004 09 11
\ Elprenas el la enstaka teksta variablo,
\ enhavanta linion de la gismu-dosiero, la kampon valsi (=vorto)
1 5 $chenero_inter -TRAILING
;
: gismu_rafsi ( $linio -- a u )
\ Elmetita el gismu-dosiero kaj modifita je 2004 09 11
\ Elprenas el la enstaka teksta variablo,
\ enhavanta linion de la gismu-dosiero, la kampon rafsi
7 18 $chenero_inter -TRAILING
;
: gismu_xelfanva ( $linio -- a u )
\ Elmetita el gismu-dosiero kaj modifita je 2004 09 11
\ Elprenas el la enstaka teksta variablo,
\ enhavanta linion de la gismu-dosiero, la kampon xelfanva (=traduko)
DUP >R
20 39 $chenero_inter $sen_flankaj_spacoj
R>
41 60 $chenero_inter $sen_flankaj_spacoj
DUP
IF \ la lasta cheno ne nulas
2>R S" , " $+ 2R> \ kunigi al la unua mezan komon
THEN
$+
;
: gismu_velciksi ( $linio -- a u )
\ Elmetita el gismu-dosiero kaj modifita je 2004 09 11
\ Elprenas el la enstaka teksta variablo,
\ enhavanta linion de la gismu-dosiero, la kampon velciksi (=ekspliko)
DUP >R
62 157 $chenero_inter $sen_flankaj_spacoj S" " $+
R>
169 $chenero_ghis_fino
S" (cf." $ghis_antaw $sen_flankaj_spacoj $+ -TRAILING
;
: gismu_selckini ( $linio -- a u )
\ Elmetita el gismu-dosiero kaj modifita je 2004 09 11
\ Elprenas el la enstaka teksta variablo,
\ enhavanta linion de la gismu-dosiero, la kampon selckini (=rilataj)
169 $chenero_ghis_fino
DUP IF \ enda kontrolo, char iuj "valsi"-oj ne havas "selckini"-n
S" (cf." $de_post 1- \ funkcias char la lasta signo chiam estas la ferma krampo
\ pli bonus uzi $ghis_antaw_lasta , sed ghi estas ankore neverkita
ENDIF
$sen_flankaj_spacoj
;
: gismu-dosiero ( -- )
\ Ekverkita je 2004 03 19, finita je 2004 04 07
\ Reformita je 2004 09 11
\ Modifita je 2004 09 12 por kalkulo de maksmimumaj longoj
\ Legas polinie la endosieron gismu.txt
\ kaj aldonas ghian enhavon en la eldosieron.
S" gismu.txt" R/O malfermu <dosiero !
>linio$ \ preterlegi la titolan linion
BEGIN
>linio$
WHILE
linio$ gismu_valsi montru valsi-longo maksimuma! >kampo
S" gismu" klesi-longo maksimuma! >kampo
linio$ gismu_rafsi rafsi-longo maksimuma! >kampo
S" " >kampo \ selma'o
linio$ gismu_xelfanva xelfanva-longo maksimuma! >kampo
linio$ gismu_velciksi velciksi-longo maksimuma! >kampo
linio$ gismu_selckini selckini-longo maksimuma! >fina_kampo
REPEAT
<dosiero @ fermu
;
: cmavo_valsi ( $linio -- a u )
\ Elmetita el gismu-dosiero kaj modifita je 2004 09 11
\ Elprenas el la enstaka teksta variablo,
\ enhavanta linion de la gismu-dosiero, la kampon valsi (=vorto)
0 9 $chenero_inter $sen_flankaj_spacoj
;
: cmavo_selma'o ( $linio -- a u )
\ Elmetita el gismu-dosiero kaj modifita je 2004 09 11
\ Elprenas el la enstaka teksta variablo,
\ enhavanta linion de la gismu-dosiero, la kampon selma'o
11 18 $chenero_inter -TRAILING
;
: cmavo_xelfanva ( $linio -- a u )
\ Elmetita el gismu-dosiero kaj modifita je 2004 09 11
\ Elprenas el la enstaka teksta variablo,
\ enhavanta linion de la gismu-dosiero, la kampon xelfanva (=traduko)
20 60 $chenero_inter -TRAILING
;
: cmavo_velciksi ( $linio -- a u )
\ Elmetita el gismu-dosiero kaj modifita je 2004 09 11
\ Elprenas el la enstaka teksta variablo,
\ enhavanta linion de la gismu-dosiero, la kampon velciksi (=ekspliko)
62 166 $chenero_inter -TRAILING
;
: cmavo_selckini ( $linio -- a u )
\ Elmetita el gismu-dosiero kaj modifita je 2004 09 11
\ Elprenas el la enstaka teksta variablo,
\ enhavanta linion de la gismu-dosiero, la kampon selckini (=rilataj)
168 $chenero_ghis_fino
S" (cf." $de_post S" )" $ghis_antaw $sen_flankaj_spacoj
;
: cmavo-dosiero ( -- )
\ Ekverkita je 2004 04 07
\ Reformita je 2004 09 11
\ Modifita je 2004 09 12 por kalkulo de maksmimumaj longoj
\ Legas polinie la endosieron cmavo.txt
\ kaj aldonas ghian enhavon en la eldosieron.
S" cmavo.txt" R/O malfermu <dosiero !
>linio$ \ preterlegi la titolan linion
BEGIN
>linio$
WHILE
linio$ cmavo_valsi montru valsi-longo maksimuma! >kampo
S" cmavo" klesi-longo maksimuma! >kampo
S" " >kampo \ "rafsi"
linio$ cmavo_selma'o selma'o-longo maksimuma! >kampo
linio$ cmavo_xelfanva xelfanva-longo maksimuma! >kampo
linio$ cmavo_velciksi velciksi-longo maksimuma! >kampo
linio$ cmavo_selckini selckini-longo maksimuma! >fina_kampo
REPEAT
<dosiero @ fermu
;
: kamponomoj ( -- )
\ Verkita je 2004 09 11
\ Kreas linion kun kamponomoj en la eldosieron.
S" _valsi" >kampo
S" _klesi" >kampo
S" _rafsi" >kampo
S" _selma'o" >kampo
S" _xelfanva" >kampo
S" _velciksi" >kampo
S" _selckini" >fina_kampo
;
: ek ( -- )
S" ./" dosierujo$ $!
S" lojbo_valsi.csv" W/O malfermu >dosiero ! \ eldosiero
kamponomoj
longojn_nuligu
CR CR
gismu-dosiero
cmavo-dosiero
CR CR
longojn_montru
>dosiero @ fermu \ eldosiero
;
\ ***********************************************************************
\ Pri GPL
\ ***********************************************************************
: gpl ( -- )
\ verkita je 2002 04 14
S" Español: Licencia General Pública GNU" CR TYPE
S" http://www.garaitia.com/new/gpl-spanish.php" CR TYPE
S" Esperanto: GNUa Ghenerala Publika Permesilo" CR TYPE
S" http://www.esperanto.mv.ru/Cetero/gpl.htm" CR TYPE
S" English: GNU General Public Licence" CR TYPE
S" http://www.gnu.org/licences/gpl.html" CR TYPE
;
: programa-libre ( -- )
gpl
;
: libera-programo ( -- )
gpl
;
: free-software ( -- )
gpl
;
\ ***********************************************************************
\ Prezento
\ ***********************************************************************
\ verkita je 2004 03
CR
.( lojban) CR
.( Programo por konstrui tekstan datumaron ) CR
.( el diversaj lojhbanaj vortolistoj. ) CR
S" (c) 2004 Marcos Cruz" TYPE CR
.( Este programa es un programa libre.) CR
.( Escribe 'programa-libre' para detalles en español.) CR
.( Chi programo estas libera programo.) CR
.( Tajpu 'libera-programo' por detaloj en Esperanto.) CR
.( This program is free software.) CR
.( Type 'free-software' for details in English.) CR
CR
.S CR
CR
Descargas
- lojbo_valsi.tar.gz (428.12 KiB) El código fuente del programa, los ficheros de datos y el resultado en formato CSV.