51 lines
1.2 KiB
C
51 lines
1.2 KiB
C
char cobtools[] =
|
|
"set argc 0\n"
|
|
"set argv {}\n"
|
|
"proc split_fields {} {\n"
|
|
" global cobol_fields data_block\n"
|
|
" set ix 0\n"
|
|
" foreach {varname size} $cobol_fields {\n"
|
|
" global $varname\n"
|
|
" set $varname [string range $data_block $ix [expr $ix+$size-1]]\n"
|
|
" incr ix $size\n"
|
|
" }\n"
|
|
"}\n"
|
|
"proc ::returnCobol {} {\n"
|
|
" global cobol_fields result ready\n"
|
|
" set result \"\"\n"
|
|
" catch {\n"
|
|
" foreach {varname size} $cobol_fields {\n"
|
|
" global $varname\n"
|
|
" append result [format \"%-$size.${size}s\" [set $varname]]\n"
|
|
" }\n"
|
|
" }\n"
|
|
" set ready 1\n"
|
|
"}\n"
|
|
"proc ::do_exit {} {\n"
|
|
" label .labDoExit\n"
|
|
" bind .labDoExit <Destroy> returnCobol\n"
|
|
" destroy .labDoExit\n"
|
|
"}\n"
|
|
"proc ::cobol_preprocess {} { }\n"
|
|
"proc ::cobol_update {} { }\n";
|
|
|
|
char compute_block_size[] =
|
|
"set block_size 0\n"
|
|
"foreach {varname size} $cobol_fields {\n"
|
|
" incr block_size $size\n"
|
|
"}\n";
|
|
|
|
char wait_ready[] =
|
|
"split_fields\n"
|
|
"set ready 0\n"
|
|
"cobol_preprocess\n"
|
|
"if {!$ready} {\n"
|
|
" tkwait variable ready\n"
|
|
"}\n";
|
|
|
|
char newgui[] =
|
|
"foreach child [winfo children .] {\n"
|
|
" destroy $child\n"
|
|
"}\n";
|
|
|