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)