tclzforth/tclzforth.tcl at master · kmatze/tclzforth · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
######################################################################
#
# BEGINN namespace
#
namespace eval ::tclzforth:: {
#---------------------------------------------------------------------
#
# zf
#
proc zf { zfWords } {
	set zfResult [split [zforthCmd $zfWords] "\n"]
	set res {}
	set linecounter 0
	set newline ""
	foreach line $zfResult {
		incr linecounter
		if { [regexp "zf> error:" $line] > 0 } {
			puts stderr $line
		} else {
			append res $newline $line
			if { $linecounter == 1 } { set newline "\n" }
		}
	}
	return $res
 }
#---------------------------------------------------------------------
#
# zfLoad
#
proc zfLoad { FileName } {
	set fileid [open $FileName r]
	set file_data [read $fileid]
	set data [split $file_data "\n"]
	close $fileid
	set counter 0
    foreach line $data {
    	incr counter
        set res [zf $line]
        if { $res != "" } { puts $res }
	}
    return "    $counter lines read from [file tail $FileName]"
}
#---------------------------------------------------------------------
#
# zfFsave
#
proc zfFsave { FileName FileImage {Type "repl"} } {
	global zfExe
    set FileZforth "$zfExe/zforth.exe"
    if { $Type ne "repl" } { set FileZforth "$zfExe/zftiny.exe" }

	set fOut [open $FileName w]
	fconfigure $fOut -translation binary

	set fIn [open $FileZforth r]
	fconfigure $fIn -translation binary
	puts -nonewline $fOut [read $fIn]
	close $fIn

	puts -nonewline $fOut {ZFIMG}

	set fIn [open "$FileImage" r]
	fconfigure $fIn -translation binary
	puts -nonewline $fOut [read $fIn]
	close $fIn

	close $fOut
}

######################################################################
#
# END namespace
#
namespace export zf zfLoad zfFsave
}