# specExample.tcl -- Tcl stuff embedded in DVI files
# Copyright © 2001 Anselm Lingnau <anselm@strathspey.org>
# See file COPYING for conditions on use and distribution.
# $Id: specExample.tcl,v 1.1 2001/08/02 13:27:47 anselm Exp $

proc ::tkdvi::browser::special::example {name key x y cookie s} {
    variable ::tkdvi::browser::State
    variable ::tkdvi::browser::Configure

    if {[scan $s {example %s %f %f} prog wd ht] != 3} {
	error "malformed example special"
    }
    if {[$State($name-$key,i) cget -shrink] > $Configure($name-shrink)} {
	return
    }

    if {![info exists State($name-tags,$cookie)]} {
	set State($name-tags,$cookie) t$cookie
	set wpx [expr \
		{[dvi::pixels [$State($name-$key,i) cget -xresolution] \
		${wd}pt] / $State($name-$key,s)}]
	set wpy [expr \
		{[dvi::pixels [$State($name-$key,i) cget -yresolution] \
		${ht}pt] / $State($name-$key,s)}]
	set file [file join [file dirname \
		[$State($name-code) info filename]] $prog]
	if {[catch {uplevel \#0 [list source $file]} msg]} {
	    puts stderr $msg
	}
	set f [frame $State($name-canvas).$State($name-tags,$cookie) \
		-width $wpx -height $wpy \
		-background [$State($name-canvas) cget -background]]
	pack propagate $f false
	set fn [file rootname $prog]_init
	if {[catch {uplevel \#0 $fn $f $wpx $wpy} msg]} {
	    puts stderr $msg
	}
	$State($name-canvas) create window $x $y -anchor nw -window $f \
		-tags [list $State($name-tags,$cookie) \
		p=[$State($name-$key,i) page]]
	$State($name-canvas) raise $State($name-tags,$cookie)
	set State($name-frames,$cookie) $f
    }
}
