lojbo valsi

Priskribo de la ĉi-paĝa enhavo

Ilo verkita en Fortho por krei CSV -formatan loĵbano-vortaron.

Etikedoj:

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