Hay muchos programas por ahí para hacer esta tarea de convertir los ficheros de pantalla de código fuente de Forth en ficheros de texto normales. Esta es mi propia versión.
Tiene una característica interesante: Convierte también los ficheros en formato TAP creados por Abersoft Forth (un Forth para la Sinclair ZX Spectrum) bajo un emulador de Spectrum.
Listado
\ --------------------------------------------------------
cr .( scr2txt )
\ Tool to convert a Forth screens file (*) into a normal text.
\ (*) Or an Abersofth Forth screens file saved in a TAP file under a ZX Spectrum emulator.
\ Copyright (C) 2005,2009,2010 Marcos Cruz (http://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.
\ --------------------------------------------------------
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)