#!/usr/local/bin/tclsh
#
# Report Generator for TinyCobol
#

set tex(fontsdef) {
\font\RomanEight=cmr8 scaled\magstep0
\font\RomanNine=cmr9 scaled\magstep0
\font\RomanTen=cmr10 scaled\magstep0
\font\RomanEleven=cmr10 scaled\magstep1
\font\RomanTwelve=cmr12 scaled\magstep0
\font\RomanThirteen=cmr12 scaled\magstep1

\font\RomanEightBold=cmbx8 scaled\magstep0
\font\RomanNineBold=cmbx9 scaled\magstep0
\font\RomanTenBold=cmbx10 scaled\magstep0
\font\RomanTwelveBold=cmbx12 scaled\magstep0

\font\TypewriterEight=cmtt8 scaled\magstep0
\font\TypewriterNine=cmtt9 scaled\magstep0
\font\TypewriterTen=cmtt10 scaled\magstep0
\font\TypewriterTwelve=cmtt12 scaled\magstep0
\font\TypewriterXL=cmtt12 scaled\magstep2

\font\SansserifEight=cmss8 scaled\magstep0
\font\SansserifNine=cmss9 scaled\magstep0
\font\SansserifTen=cmss10 scaled\magstep0
\font\SansserifTwelve=cmss12 scaled\magstep0
\font\SansserifSeventeen=cmss12 scaled\magstep2

\font\SansserifTenBold=cmssbx10 scaled\magstep0

\font\UltraCondL=cmssu30 scaled\magstep0

\font\RomanFibEight=cmfib8 scaled\magstep0
}

set tex(plainoutput) {
\setbox0=\vbox{\makeheadline}
%%Debug info: ht0: \number\ht0  vsize: \number\vsize
\advance\vsize by -\ht0
\def\plainoutput{\shipout\vbox{\makeheadline\pagebody}\advancepageno
	\ifnum\outputpenalty >-20000\else\dosupereject\fi}
\def\pagebody{\vbox to\vsize{\boxmaxdepth=\maxdepth \pagecontents}}
}

set tex(prologue) {\
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Report generated by reportGen.tcl
% Date: [clock format [clock seconds]]
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\\nopagenumbers
\\raggedbottom
\\overfullrule=0pt
\\parindent=0pt

%% Paper: portrait A4  no margins
%\\hsize=210mm
%\\vsize=297mm
\\hoffset=-1in
\\voffset=-1in
\\hsize=$rep(-page_width)$rep(unit)
\\vsize=$rep(-page_height)$rep(unit)

\\input epsf
\\input colordvi
\\input trans.tex

%\\def\\jumpsetbox{\\aftergroup\\aftersetbox}
%\\def\\rotate#1\{
%  \\hbox\{
%  \\def\\aftersetbox\{
%    \\setbox\\boxtmp\\hbox\{\\box\\boxtmp\}
%    \\wd\\boxtmp 0pt \\ht\\boxtmp 0pt \\dp\\boxtmp 0pt
%    \\special\{ps: gsave currentpoint currentpoint 
%		translate #1 rotate neg exch neg exch translate\}
%    \\box\\boxtmp
%    \\special\{ps: grestore\}
%    \}\}
%  \\afterassignment\\jumpsetbox\\setbox\\boxtmp =
%\}

$tex(fontsdef)
\\def\\makeheadline{[dumphdr $rep(hdr,PAGE)]}
$tex(plainoutput)
}

# alternate comment (cobol-compatible)
proc * {args} { 
	uplevel #0 # $args
}

# read lines from layout file, separating copybook definitions
# and execute other statements as regular tcl commands
proc Copy {layout} {
	set fldre {^[ \t]*([0-9]+)[ \t]+([a-zA-Z0-9-]*)[ \t]+pic[ \t]+(.*)\.}
	set f [open $layout r]
	while {![eof $f]} {
		set line ""
		while {1} {
			gets $f ln
			if {[string index $ln end] == "\\"} {
				append line $ln\n
			} else {
				append line $ln
			}
			if {[info complete $line]} {
				break
			}
		}
		if {[regexp -nocase $fldre $line m level name pic]} {
			definefield $level $name $pic
		} else {
			uplevel #0 $line
		}
	}	
}

proc definefield {level name pic} {
	global rep 
	### compute size of field from picture given
	set n 0
	set pic [string trim $pic]
	while {$pic != ""} {
		if {[string index $pic 1] == "("} {
			set n1 [string first ")" $pic]
			incr n [string range $pic 2 [expr $n1-1]]
			set pic [string range $pic [expr $n1+1] end]
		} else {
			incr n
			set pic [string range $pic 1 end]
		}
	}
	lappend rep(fields) $name
	set rep(size,$name) $n
	set rep(offset,$name) $rep(offset)
	incr rep(offset) $n
}

proc Header {item args} {
	global rep 
	if {[lsearch $rep(break) $item] < 0} { 
		if {![regexp {PAGE[1-9]?} $item]} {
			lappend rep(break) $item
		}
	}
	array set hdr [list -line 0 -font SansserifTwelve -width $rep(-page_width) \
		-before 0 -after 0 -align center -color Black -offset 0 -eject 0 \
		-image {} -hrule 0 -rotate 0]
	array set hdr $args
	lappend rep(hdr,$item) [array get hdr]
	set rep(hdrinsert,$item) 1
	set rep(value,$item) ""
}

proc Footer {item args} {
	global rep
	if {[lsearch $rep(break) $item] < 0} { 
		if {![regexp {PAGE[1-9]?} $item]} {
			lappend rep(break) $item
		}
	}
	array set ftr [list -line 0 -font SansserifTwelve -width $rep(-page_width) \
		-before 0 -after 0 -align center -color Black -offset 0 -eject 0 \
		-image {} -hrule 0 -rotate 0]
	array set ftr $args
	lappend rep(ftr,$item) [array get ftr]
	set rep(value,$item) ""
}

proc Detail {args} {
	global rep
	array set v {-line 0 -font RomanTen -width 1.0 -align left \
		-height 0.2 -color Black -offset 0 -barcode {} -nextline 0}
	array set v $args
	lappend rep(detail) [array get v]
}

proc Unit {u} {
	global rep
	set rep(unit) $u
}

proc Config {args} {
	global rep
	array set rep {-test_only 0 -web 0 -page_height 11.2 -page_widht 8 } 
	array set rep $args
}

proc Initiate {output layout} {
	global rep tex nbreaks reclength
	array set rep {break {} offset 0 may_eject 0 
		-test_only 0 -web 0 -barcode_n 0} 
	set rep(output_file) $output
	set texfn [file rootname $output].tex
	set rep(outf) [open $texfn w]
	Copy $layout
	
	### Start with the TeX prologue
	puts $rep(outf) [subst $tex(prologue)]
	set nbreaks [llength $rep(break)]
	set reclength 0
	foreach name $rep(fields) {
		incr reclength $rep(size,$name)
	}

	#### output detail column definitions
	set coln 0
	set position 0
	foreach it $rep(detail) {
		array set v $it
		if {$v(-nextline)} {
			set position 0
		}
		puts $rep(outf) \
			"\\def\\Col[format %c [expr [incr coln]+0x40]]#1\{"
		puts $rep(outf) \
			"\\hskip[expr $v(-offset)-$position]$rep(unit)"
		set position [expr $v(-offset)+$v(-width)]
		#puts $rep(outf) "% position = $position"
		if {$v(-barcode) != {}} {
			puts $rep(outf) \
				"\\lower[expr $v(-height)*0.4]$rep(unit)"
		}
		puts -nonewline $rep(outf) \
			"\t\\vtop\{\\parindent=0pt\\hsize=$v(-width)$rep(unit)"
		puts -nonewline $rep(outf) \
			"\\tolerance=10000\\strut"
		set a $v(-align)
		if {$a == "right" || $a == "center"} {
			puts -nonewline $rep(outf) \
				{\hfill}
		}
		set sl ""
		set sr ""
		if {$v(-font) != "RomanTen"} {
			if {$v(-barcode) == {}} {
				append sl "\\$v(-font)\{"
				append sr \}
			}
		}
		if {$v(-color) != "Black"} {
			if {$v(-barcode) == {}} {
				append sl "\\$v(-color)\{"
				append sr \}
			}
		}
		set sm "#1" 
		puts -nonewline $rep(outf) \
			"$sl $sm $sr"
		if {$a == "left" || $a == "center"} {
			puts -nonewline $rep(outf) \
				{\hfill}
		}
		puts $rep(outf) \
			"\}\n\}"
	}
}

proc Generate {record args} {
	global rep
	# we substitute \x01 for backslashes while processing
	regsub {\\} $record \01 rep(record)
	
	### check break fields for header requested 
	for {set itn [expr [llength $rep(break)]-1]}  {$itn>=0} {incr itn -1} {
			set item [lindex $rep(break) $itn]
		if {[info exists rep(hdrinsert,$item)]} {
			if {$rep(hdrinsert,$item)} {
				set rep(hdrinsert,$item) 0
				puts -nonewline $rep(outf) [dumphdr $rep(hdr,$item)]
			}
		}
	}	
	incr rep(may_eject)
	### check break fields for content change 
	set brkfound 0
	foreach item $rep(break) {
		if {$item == "FINAL"} break
		if {$rep(value,$item) == ""} {
			set rep(value,$item) [getvar $item]
			continue
		}
		if {$rep(value,$item) != [getvar $item]} {
			puts -nonewline $rep(outf) [dumphdr $rep(ftr,$item)]
			set rep(value,$item) [getvar $item]
			set_register [lindex $args [lsearch $rep(break) $item]] 0
			if {[info exists rep(hdrinsert,$item)]} {
				incr rep(hdrinsert,$item) 
			}
			incr brkfound
		}
	}
	### check break fields for header requested (again!)
	for {set itn [expr [llength $rep(break)]-1]}  {$itn>=0} {incr itn -1} {
			set item [lindex $rep(break) $itn]
		if {[info exists rep(hdrinsert,$item)]} {
			if {$rep(hdrinsert,$item)} {
				set rep(hdrinsert,$item) 0
				puts -nonewline $rep(outf) [dumphdr $rep(hdr,$item)]
			}
		}
	}	
	puts $rep(outf) "[dumpdetail]"
}

proc Terminate {} {
	global rep tex run
	### check break fields for content change 
	foreach item $rep(break) {
		puts -nonewline $rep(outf) [dumphdr $rep(ftr,$item)]
	}
	#tkwait variable run
	puts $rep(outf) "\\bye"
	close $rep(outf)
	set fname [file rootname $rep(output_file)]
	set previousdir [pwd]
	cd [file dirname $fname]
	exec tex $fname
	catch {exec dvips -o $fname.ps $fname.dvi}
	catch {eval file delete [glob bar*.eps]}
	if {$rep(-test_only)} {
		return
	}
	# converte para pdf 
	exec ps2pdf ${fname}.ps
	#file delete ${fname}.dvi ${fname}.ps ${fname}.tex ${fname}.log
	if {$rep(-web)} {
		puts "Content-type: application/pdf\n"
		set f [open ${fname}.pdf r]
		fconfigure $f -encoding binary -translation binary
		fconfigure stdout -encoding binary -translation binary
		while {![eof $f]} {
			set data [read $f 500000]
			puts -nonewline $data 
		}
		close $f
		file delete ${fname}.pdf
	}
	cd $previousdir
}

proc encodeName {s} {
	global rep tex
	set s [string tolower $s]
	regsub -all -- {-} $s H s1
	return $s1
}

set texEncodeMatrix { 
	\\$ \\\$ # \\# % \\% \\^ \\char94\  
	á \\'a é \\'e í \\'\\i\{\}  ó \\'o ú \\'u
	Á \\'A É \\'E Í \\'I Ó \\'O Ú \\'U
	ã \\~a à \\~A à \\`a À \\`A â \\^a  \\^A
	ê \\^e Ê \\^E õ \\~o Õ \\~O ô \\^o Ô \\^Ô
	ç \\c\ c Ç \\c\ C
	< \$<\$\  > \$>\$\  
}

proc subs_registers {s} {
	global rep 
	# substitute page number counter
	regsub -all {@@pageno@@} $s {\\number\\pageno} s
	
	# substitute all variable for their contents before encoding
	#regsub -all {@@(.*)@@} $s \1 s
	while {[set n1 [string first @@ $s]] >= 0} {
		set s1 [string range $s 0 [expr $n1-1]]
		set n2 [string first @@ [string range $s [expr $n1+2] end]]
		set n2 [expr $n2+$n1+2]
		set s3 [string range $s [expr $n2+2] end]
		set v [string range $s [expr $n1+2] [expr $n2-1]]
		set s2 [getvar $v]
		set s "$s1$s2$s3"
	}
	return $s
}

proc texencode {s} {
	global texEncodeMatrix rep tex	
	
	set s [string trim [subs_registers $s]]
	#regsub {\\} $s \01 s <-- this was already done in Generate
	foreach {it sub} $texEncodeMatrix {
		regsub -all -- $it $s $sub s
	}
	regsub -all -- {&} $s {\\&} s
	regsub -all -- {"} $s {''} s
# " 
	regsub -all -- {\|} $s {$|$} s
	regsub -all -- {\-} $s {--} s
	regsub -all -- {\x01} $s {$\backslash$} s
	return $s
}

proc getvar {v} {
	global rep
	set n1 $rep(offset,$v)
	set n2 [expr $n1+$rep(size,$v)-1]
	return [string range $rep(record) $n1 $n2] 
}

proc dumpdetail {} {
	global rep
	set first 0
	set s ""
	set coln 0
	foreach it $rep(detail) {
		array set v $it
		if {$v(-nextline)} {
			append s "\\par"
		}
		append s "\\Col[format %c [expr [incr coln]+0x40]]\{"
		if {$v(-barcode) != {}} {
			set barcodefile [make_barcode [subs_registers $v(-barcode)] \
				$v(-width) $v(-height)]
			append s "\\epsffile\{$barcodefile\}"
		} else {
			append s [texencode $v(-text)]
		}
		append s "\}"
	}
	append s "\\par"
	return $s
}

proc dumphdr {f} {
	global rep tex 
	set s ""
	set position 0
	foreach it $f {
		array set v $it
		if {$v(-eject) && $rep(may_eject)} {
			if {$s != ""} {
				append s "\\hss\}\n"
			}
			append s "\\vfill\\eject\\vskip $v(-before)$rep(unit)\\line\{"
		} elseif {$v(-before)} {
			if {$s != ""} {
				append s "\\hss\}\n"
			}
			append s "\\vskip $v(-before)$rep(unit)\\line\{"
			set position 0
		}
		if {$s == ""} {
			append s "\\line\{"
		}
		if {$v(-offset)} {
			append s "\\hskip[expr $v(-offset)-$position]$rep(unit)"
			set position [expr $v(-offset)+$v(-width)]
		}
		if {$v(-rotate)} {
			append s "\\rotate\{$v(-rotate)\}"
		}
		append s "\\hbox to$v(-width)$rep(unit)\{"
		set a $v(-align)
		set sl ""
		set sr ""
		if {!$v(-hrule)} {
			if {$a == "right" || $a == "center"} {
				append s {\hfill{}}
			}
			if {$v(-font) != "RomanTen"} {
				append sl "\\$v(-font)\{"
				append sr \}
			}
		}
		if {$v(-color) != "Black"} {
			append sl "\\$v(-color)\{"
			append sr \}
		}
		if {$v(-hrule)} {
			set sm "\\xleaders\\hrule height$v(-hrule)$rep(unit)\\hss"
		} elseif {$v(-image) != {}} {
			set sm "\\hbox\{\\epsffile\{$v(-image)\}\}"
		} else {
			set sm [texencode $v(-text)]
		}
		append s $sl $sm $sr
		if {!$v(-hrule)} {
			if {$a == "left" || $a == "center"} {
				append s {\hfill}
			}
		}
		append s "\}\n"
		if {$v(-after)} {
			append s "\\hss\}\n\\vskip $v(-after)$rep(unit)\\line\{"
			set position 0
		}
	}
	append s "\\hss\}\n"
	return $s
}

proc make_barcode {s width height} {
	global rep
	set bfname barf[format %07d [incr rep(-barcode_n)]].eps
	set width [expr $width - 0.1]
	set height [expr $height - 0.1]
	if {[string length $s] == 13} {
		set s [string range $s 0 11]
	}
	exec barcode -o $bfname -b $s -E -u $rep(unit) \
		-m 0,0 -g ${width}x${height}+0+0 
	return $bfname
}

set run 0