scr2txt

Priskribo de la ĉi-paĝa enhavo

Programo en Fortho por krei normalan teksto-dosieron el fortha tekst-ekrana dosiero.

Etikedoj:

Ekzistas ie tie multaj programoj por fari ĉi taskon, nome krei normalan teksto-dosieron el fortha tekst-ekrana dosiero. Jen la mia.

Ĝi havas tre interesan econ, ĝi prilaboras ankaŭ la TAP-dosierojn kreitajn de Abersoft Forth (Fortho-sistemo por la komputilo Sinclair ZX Spectrum) sub Spectrum -emulilo.

Fontkodo

\ --------------------------------------------------------
cr .( scr2txt )

\ Tool for converting a Forth screens file (or an Abersofth
\ Forth screens file saved in a TAP file with a ZX Spectrum
\ emulator) into a normal text.

\ Copyright (C) 2005,2009,2010,2012 Marcos Cruz (programandala.net)
\ License: http://programandala.net/license

\ Program written in ANS Forth.
\ Tested with Gforth.

\ --------------------------------------------------------

\ History

\ 2005-05-28 First working version.
\ 2005-10-24 The words are renamed into Engligh.
\ 2009-05-23 All words renamed. Some factoring. New word tap>txt .
\ 2010-01-30 Two bugs fixed. One little change.
\ 2012-05-03 Typos fixed.

\ --------------------------------------------------------

64 constant lenght  \ screen file line lenght
variable line  lenght chars allot  \ screen file line buffer
variable screen_file  \ file id
variable text_file  \ file id

: is_screen_file ( a u -- )

  \ a u = screen file name

  r/o open-file abort" open screen file error"
  screen_file !

  ;

: is_text_file  ( a u -- )

  \ a u = text file name

  w/o create-file abort" create text file error"
  text_file !
  
  ;

: close_files  ( -- )

  screen_file @ close-file abort" close screen file error"
  text_file @ close-file abort" close text file error"

  ;

: open_files ( a1 u1 a2 u2 -- )

  \ a1 u1 = screen file name
  \ a2 u2 = tetx file name

  \ 2009-05-23 Factored from scr>txt .

  is_text_file  is_screen_file

  ;

: (scr>txt)  ( -- )

  \ 2009-05-23 Factored from scr>txt .
  \ 2010-01-30 cr moved before type .

  begin
    line lenght screen_file @ read-file
    0= over 0<> and  \ No I/O error and some bytes read?
  while
    line swap -trailing 2dup cr type
    text_file @ write-line abort" line write error"
  repeat
  
  ;

: scr>txt ( a1 u1 a2 u2 -- )

  \ a1 u1 = screen file name
  \ a2 u2 = text file name

  \ 2009-05-23 Factored out with (scr>txt) .

  open_files (scr>txt) close_files
  
  ;

: skip_tap_header  ( -- )

  \ 2009-05-23 First version.
  \ 2010-01-30 Bug fixed: The bytes count has to be a double number!
  \ 2010-01-30 Bug fixed: The error code returned
  \            by 'repositon-file' was left on the stack!

  24 s>d screen_file @ reposition-file abort" reposition-file error"

  ;

: tap>txt ( a1 u1 a2 u2 -- )

  \ a1 u1 = TAP file name from Abersoft Forth (Sinclair ZX Spectrum)
  \ a2 u2 = text file name

  \ 2009-05-23 First version.

  open_files skip_tap_header (scr>txt) close_files

  ;

.(  scr2txt ok!) cr

cr .( Usage: )
cr .( s" program.fb" s" program.fs" scr>txt)
cr .( s" program.tap" s" program.fs" tap>txt)

Deŝutoj