lojbo valsi
Priskribo de la ĉi-paĝa enhavo
Ilo verkita en Fortho por krei CSV -formatan loĵbano-vortaron.
lojbo valsi estas ilo kiun mi verkis en 2004 por eligi loĵbanajn vortojn el du divers-formataj tekstoj dosieroj kaj el ili krei novan CSV -formatan dosieron kiu per datenilo utilu kiel vortaro...
Ĝi estis interesa ekzerco praktiki per Fortho umon de teksto-ĉenoj kaj kreon de simplaj daten-strukturoj.
La programa kodo mem estas kurioza lingvo-kombinaĵo: la propraj vortoj de Fortho anglalingvas; tiuj kreitaj por la programo Esperant-lingvas, samkiel la komentoj kaj notoj; sed iuj, rilatantaj la enhavon de la datendosieroj, havas nomojn en Loĵbano...
Fontkodo
\ ***********************************************************************
\ 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
Deŝutoj
- lojbo_valsi.tar.gz (428.12 KiB) La program-fontkodo, la daten-dosieroj kaj la fina CSV -dosiero.