scr2txt

Priskribo de la ĉi-paĝa enhavo

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

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.

Printaĵo


\ --------------------------------------------------------
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)

Deŝuto