lojbo valsi

Descripción del contenido de la página

Herramienta escrita en Forth para crear un diccionario de Lojban en CSV.

Etiquetas:

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