tinycobol/test.code/00_FernandoWuthstrack/tcl/cobtools.tclc

58 lines
998 B
Plaintext

cobtools {
set argc 0
set argv {}
if {![info exists env(LD_LIBRARY_PATH)] ||
[lsearch [split $env(LD_LIBRARY_PATH) :] .] < 0} {
set lplst [split $env(LD_LIBRARY_PATH) :]
lappend lplst .
set env(LD_LIBRARY_PATH) [join $lplst :]
}
proc split_fields {} {
global cobol_fields data_block
set ix 0
foreach {varname size} $cobol_fields {
global $varname
set $varname [string range $data_block $ix [expr $ix+$size-1]]
incr ix $size
}
}
proc ::do_exit {} {
global cobol_fields result ready
set result ""
catch {
foreach {varname size} $cobol_fields {
global $varname
append result [format "%-$size.${size}s" [set $varname]]
}
}
set ready 1
}
proc ::cobol_preprocess {} { }
proc ::cobol_update {} { }
}
compute_block_size {
set block_size 0
foreach {varname size} $cobol_fields {
incr block_size $size
}
}
wait_ready {
split_fields
set ready 0
cobol_preprocess
if {!$ready} {
tkwait variable ready
}
}
newgui {
foreach child [winfo children .] {
destroy $child
}
}