namespace eval Printer {


##########################################
# Interface
##########################################

# interface fcns canvases should be using to print themselves
# and switches for specific formats
proc printStart {ch width height pgtot} {
global PgAcVar
	set PgAcVar(print,width) $width
	set PgAcVar(print,height) $height
	set PgAcVar(print,pgtot) $pgtot
	printStart$PgAcVar(print,output_format) $ch
}
proc printStop {ch} {
global PgAcVar
	printStop$PgAcVar(print,output_format) $ch
}
proc printStartPage {ch pgcnt} {
global PgAcVar
	printStartPage$PgAcVar(print,output_format) $ch $pgcnt
}
proc printStopPage {ch pgcnt} {
global PgAcVar
	printStopPage$PgAcVar(print,output_format) $ch $pgcnt
}
proc printPage {ch pgcnt canvase} {
global PgAcVar
	printPage$PgAcVar(print,output_format) $ch $pgcnt $canvase
}


# called by module wanting to print
# module must provide a callback function in order for printing to do anything
# that callback should take an open channel as a parameter,
# and stuff it with canvases
proc init {callback} {
global PgAcVar
	set PgAcVar(print,callback) $callback
	set PgAcVar(print,cmd_file) "cmd"
	set PgAcVar(print,output_format) "PS"
	Window show .pgaw:PrinterSettings
	tkwait visibility .pgaw:PrinterSettings
}


##########################################
# GUI actions
##########################################

# opens the channel and calls the callback to feed it with postscript
proc print {} {
global PgAcVar
	set print_channel ""
	if {[string match $PgAcVar(print,cmd_file) "cmd"]} {
		set print_channel $PgAcVar(pref,print_cmd)
	} else {
		set print_channel $PgAcVar(print,print_file)
	}
	if {[catch {::open $print_channel "w" } print_channel]} {
		return -code error "Error: Unable to open '$print_channel' for writing\n"
	}
	if {[string first "\{" $PgAcVar(print,callback)]!=-1} {
		foreach cbcmd $PgAcVar(print,callback) {
			eval [subst $cbcmd]
		}
	} elseif {$PgAcVar(print,callback)!=""} {
		$PgAcVar(print,callback) $print_channel
	}
	::close $print_channel
	Window destroy .pgaw:PrinterSettings
}


# simple file browser for files
proc browseFiles {} {
global PgAcVar
	set types {
		{{Postscript Files}	{.ps}}
		{{HTML Files}	{.html}}
		{{Text Files}	{.txt}}
		{{XML Files}	{.xml}}
		{{RTF Files}	{.rtf}}
		{{All Files}	*}
	}
	if {[catch {tk_getSaveFile -defaultextension .ps -filetypes $types \
		-title [intlmsg "Print to File"]} PgAcVar(print,print_file)] || [string match {} $PgAcVar(print,print_file)]} return
}


##########################################
# Internal Helpers
##########################################

# returns a list of the canvas widget ids in x,y order from nw to se
proc sortCanvas {canvase} {
	set scanvase {}
	foreach obj [$canvase find all] {
		set bb [$canvase bbox $obj]
		if {[$canvase itemcget $obj -anchor]=="nw"} then {set x [expr [lindex $bb 0]+1]} else {set x [expr [lindex $bb 2]-2]}
		set y [lindex $bb 1]
		set c 0
		foreach sobj $scanvase {
			set sbb [$canvase bbox $sobj]
			if {[$canvase itemcget $sobj -anchor]=="nw"} then {set sx [expr [lindex $sbb 0]+1]} else {set sx [expr [lindex $sbb 2]-2]}
			set sy [lindex $sbb 1]
			if { $sx>$x && $sy>$y } {
				break
			}
			incr c
		}
		set scanvase [linsert $scanvase $c $obj]
	}
	return $scanvase
}


##########################################
# HTML
##########################################

proc printPageHTML {ch pgcnt canvase} {
global PgAcVar
	printStartPageHTML $ch $pgcnt
	set scanvase [sortCanvas $canvase]
	set oldy 0
	foreach obj $scanvase {
		set bb [$canvase bbox $obj]
		set w [expr [lindex $bb 2]-[lindex $bb 0]]
		set y [lindex $bb 1]
		if {$oldy==0} {set oldy $y}
		set str ""
		if {[$canvase type $obj]=="text"} {
			set font [split [$canvase itemcget $obj -font] "-"]
			append str "<font face='" [lindex $font 2] "'"
			append str " point-size='" [expr round([lindex $font 8]/10)] "'" 	
			append str ">"
			if {[lindex $font 3]=="Bold"} {
				append str "<b>"
			}
			if {[lindex $font 4]=="O"} {
				append str "<i>"
			}
			append str [$canvase itemcget $obj -text]
			if {[lindex $font 4]=="O"} {
				append str "</i>"
			}
			if {[lindex $font 3]=="Bold"} {
				append str "</b>"
			}
			append str "</font>"
		}
		if {[$canvase type $obj]=="image"} {
			append str "<img src='"
			append str [[$canvase itemcget $obj -image] cget -file]
			append str "'>"
		}
		if {[expr abs($y-$oldy)]<10} {
			puts $ch "<td width=$w>$str</td>"
		} else {
			puts $ch "</tr>"
			puts $ch "<tr>"
			puts $ch "<td width=$w>$str</td>"
		}
		set oldy $y
	}
	printStopPageHTML $ch $pgcnt
}

proc printStartHTML {ch} {
global PgAcVar
	puts $ch "<html>"
	puts $ch "<head><title>PgAccess Report</title></head>"
	puts $ch "<body>"
}

proc printStopHTML {ch} {
	puts $ch "</body>"
	puts $ch "</html>"
}

proc printStartPageHTML {ch pgcnt} {
	puts $ch "<table border=1>"
	puts $ch "<tr>"
}

proc printStopPageHTML {ch pgcnt} {
	puts $ch "</tr>"
	puts $ch "</table>"
	puts $ch "<p>"
}


##########################################
# Text
##########################################

proc printPageTEXT {ch pgcnt canvase} {
global PgAcVar
	printStartPageTEXT $ch $pgcnt
	set scanvase [sortCanvas $canvase]
	set oldy 0
	foreach obj $scanvase {
		set bb [$canvase bbox $obj]
		if {[$canvase itemcget $obj -anchor]=="nw"} {
			set x [expr [lindex $bb 0]+1]
		} else {
			set x [expr [lindex $bb 2]-2]
		}
		set y [lindex $bb 1]
		if {$oldy==0} {set oldy $y}
		set x [expr round($x/10)]
		set str ""
		for {set i 0} {$i<$x} {incr i} {append str " "}
		if {[$canvase type $obj]=="text"} {
			append str [$canvase itemcget $obj -text]
		}
		if {[$canvase type $obj]=="image"} {
			append str "IMAGE"
		}
		if {[expr abs($y-$oldy)]<10} {
			puts -nonewline $ch $str
		} else {
			puts $ch ""
			puts -nonewline $ch $str
		}
		set oldy $y
	}
	printStopPageTEXT $ch $pgcnt
}

proc printStartTEXT {ch} {
global PgAcVar
	puts $ch "PgAccess Report"
	puts $ch "Pages: $PgAcVar(print,pgtot)"
	puts $ch ""
}

proc printStopTEXT {ch} {
	puts $ch ""
	puts $ch ""
	puts $ch "###"
}

proc printStartPageTEXT {ch pgcnt} {
	puts $ch ""
	puts $ch "Page: $pgcnt"
	puts $ch ""
}

proc printStopPageTEXT {ch pgcnt} {}


##########################################
# Postscript
##########################################

# takes care of starting and stopping a postscript page, plus cleaning
# so that encapsulated postscript may be put in one page of postscript
proc printPagePS {ch pgcnt canvase} {
global PgAcVar
	printStartPagePS $ch $pgcnt
	printCleanPS $ch [$canvase postscript -width $PgAcVar(print,width) -height $PgAcVar(print,height) -pagex 0 -pagey 0 -pageanchor sw]
	printStopPagePS $ch $pgcnt
}


# header for postscript output
proc printStartPS {ch} {
global PgAcVar
	puts $ch "%!PS-Adobe-3.0"
	puts $ch "%%Creator: PgAccess"
	puts $ch "%%LanguageLevel: 2"
	puts $ch "%%Title: Report"
	puts $ch "%%CreationDate: [clock format [clock seconds]]"
	puts $ch "%%Pages: $PgAcVar(print,pgtot)"
	puts $ch "%%PageOrder: Ascend"
	puts $ch "%%BoundingBox: 0 0 $PgAcVar(print,width) $PgAcVar(print,height)"
	puts $ch "%%EndComments"
	puts $ch "/EncapDict 200 dict def EncapDict begin"
    puts $ch "/showpage {} def /erasepage {} def /copypage {} def end"
	puts $ch "%%EndProlog"
}


# terminate the postscript
proc printStopPS {ch} {
	puts $ch "%%EOF"
}


# start a new page of postscript
proc printStartPagePS {ch pgcnt} {
	puts $ch "%%Page: $pgcnt $pgcnt"
	puts $ch "save EncapDict begin"
}


# finish a page of postscript
proc printStopPagePS {ch pgcnt} {
	puts $ch "restore end showpage"
}


# rip stuff out of encapsulated postscript
# so we can display regular old postscript
proc printCleanPS {ch ps} {
	set start [string first "%%BeginProlog\n" "$ps"]
	set stop [expr [string first "%%EOF\n" "$ps"] - 1]
	puts $ch "[stripCommentsPS [string range $ps $start $stop]]"
}


# adapted from Bridge.tcl StripPSComments procedure 
# by Robert Heller <Heller@deepsoft.com>
# borrowed with permission
proc stripCommentsPS {ps} {
  set result ""
  foreach l [split "$ps" "\n"] {
    set i [string first "%" "$l$"]
    if {$i == 0} {
      append result "\n"
    } elseif {$i > 0 && [regexp {(^.*[^\\])(%.*$)} "$l" whole prefix comment]} {
      append result "$prefix\n"
    } else {
      append result "$l\n"
    }
  }
  return $result
}


}


##########################################
# VisualTcl
##########################################

proc vTclWindow.pgaw:PrinterSettings {base} {
global PgAcVar

	if {$base == "" } {
		set base .pgaw:PrinterSettings
	}
	if {[winfo exists $base]} {
		wm deiconify $base; return
	}

    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 465x300+220+159
    wm maxsize $base 1265 994
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm title $base [intlmsg "Print"]

	frame $base.fp \
		-borderwidth 2 -height 100 -width 465 -relief groove
	frame $base.fp2 \
		-borderwidth 2 -height 50 -width 465
    radiobutton $base.rad_print2cmd \
        -text [intlmsg {Print Command:}] \
		-variable PgAcVar(print,cmd_file) \
		-value "cmd"
    entry $base.eprint_cmd \
        -background white -insertbackground black \
        -textvariable PgAcVar(pref,print_cmd) 
	frame $base.fp2f \
		-borderwidth 2 -height 50 -width 465
    radiobutton $base.rad_print2file \
        -text [intlmsg {Print to File}] \
		-variable PgAcVar(print,cmd_file) \
		-value "file" 
    entry $base.eprint_file \
        -background white -insertbackground black \
        -textvariable PgAcVar(print,print_file) 
    button $base.bbrowse \
        -text [intlmsg "Browse"] \
		-command Printer::browseFiles

	frame $base.fczr \
		-borderwidth 2 -height 50 -width 465 -relief groove
    label $base.lcopies \
        -text [intlmsg "Copies"]
    label $base.lzoom \
        -text [intlmsg "Zoom"] 
    label $base.lrot \
        -text [intlmsg "Rotation"]
    entry $base.ecopies \
        -background grey -state disabled -insertbackground black -width 10 \
        -textvariable PgAcVar(print,copies) 
    entry $base.ezoom \
        -background grey -state disabled -insertbackground black -width 10 \
        -textvariable PgAcVar(print,zoom) 
    entry $base.erot \
        -background grey -state disabled -insertbackground black -width 10 \
        -textvariable PgAcVar(print,rot) 

	frame $base.fout \
		-borderwidth 2 -height 50 -width 465 -relief groove
    radiobutton $base.rad_out_ps \
        -text [intlmsg {Postscript}] \
		-variable PgAcVar(print,output_format) \
		-value "PS"
    radiobutton $base.rad_out_html \
        -text [intlmsg {HTML}] \
		-variable PgAcVar(print,output_format) \
		-value "HTML"
    radiobutton $base.rad_out_text \
        -text [intlmsg {Text}] \
		-variable PgAcVar(print,output_format) \
		-value "TEXT"
    radiobutton $base.rad_out_xml -state disabled \
        -text [intlmsg {XML}] \
		-variable PgAcVar(print,output_format) \
		-value "XML"
    radiobutton $base.rad_out_rtf -state disabled \
        -text [intlmsg {RTF}] \
		-variable PgAcVar(print,output_format) \
		-value "RTF"

	frame $base.fbtn \
		-borderwidth 5 -height 50 -width 465 
    button $base.bprint \
        -text [intlmsg "Print"] \
		-command Printer::print
    button $base.bcancel \
        -text [intlmsg "Cancel"] \
		-command {Window destroy .pgaw:PrinterSettings}

	pack $base.fp \
		-in .pgaw:PrinterSettings -anchor center -expand 1 -fill both -side top
	pack $base.fp2 \
		-in .pgaw:PrinterSettings.fp -expand 1 -fill both -side top
	pack $base.rad_print2cmd \
		-in .pgaw:PrinterSettings.fp2 -anchor w -expand 0 -fill x -side left
    pack $base.eprint_cmd \
		-in .pgaw:PrinterSettings.fp2 -expand 1 -fill x -side left 
	pack $base.fp2f \
		-in .pgaw:PrinterSettings.fp -expand 1 -fill both -side top
    pack $base.rad_print2file \
		-in .pgaw:PrinterSettings.fp2f -anchor w -expand 0 -fill x -side left
    pack $base.eprint_file \
		-in .pgaw:PrinterSettings.fp2f -expand 1 -fill x -side left
    pack $base.bbrowse \
		-in .pgaw:PrinterSettings.fp2f -expand 0 -fill x -side left

	pack $base.fczr \
		-in .pgaw:PrinterSettings -anchor center -expand 1 -fill both -side top
    pack $base.lcopies \
		-in .pgaw:PrinterSettings.fczr -expand 1 -fill x -side left
    pack $base.ecopies \
		-in .pgaw:PrinterSettings.fczr -expand 1 -fill x -side left
    pack $base.lzoom \
		-in .pgaw:PrinterSettings.fczr -expand 1 -fill x -side left
    pack $base.ezoom \
		-in .pgaw:PrinterSettings.fczr -expand 1 -fill x -side left
    pack $base.lrot \
		-in .pgaw:PrinterSettings.fczr -expand 1 -fill x -side left
    pack $base.erot \
		-in .pgaw:PrinterSettings.fczr -expand 1 -fill x -side left

	pack $base.fout \
		-in .pgaw:PrinterSettings -anchor center -expand 1 -fill both -side top
    pack $base.rad_out_ps \
		-in .pgaw:PrinterSettings.fout -expand 1 -fill both -side left
    pack $base.rad_out_html \
		-in .pgaw:PrinterSettings.fout -expand 1 -fill both -side left
    pack $base.rad_out_text \
		-in .pgaw:PrinterSettings.fout -expand 1 -fill both -side left
    pack $base.rad_out_xml \
		-in .pgaw:PrinterSettings.fout -expand 1 -fill both -side left
    pack $base.rad_out_rtf \
		-in .pgaw:PrinterSettings.fout -expand 1 -fill both -side left

	pack $base.fbtn \
		-in .pgaw:PrinterSettings -anchor center -expand 0 -fill none -side bottom 
    pack $base.bprint \
		-in .pgaw:PrinterSettings.fbtn -expand 0 -fill none -side left
    pack $base.bcancel \
		-in .pgaw:PrinterSettings.fbtn -expand 0 -fill none -side left

}
