#
# Copyright (C) 2000 WIDE Project.  All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. Neither the name of the project nor the names of its contributors
#    may be used to endorse or promote products derived from this software
#    without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# $Id: tcpillust.tcl,v 1.2 2000/04/20 07:14:00 nishida Exp $

proc make_world {} {
	global tcldir
	global appl_x
	global appl_y
	global canvas_width
	global canvas_height
	global subcanvas_width
	global subcanvas_height

	frame .top -relief raised -bd 2
	wm title . "tcpillust"
	if {$appl_x >= 0} { wm geometry . +$appl_x+$appl_y }
	label .top.label -text "Tcpillust"
	menubutton .top.file -text "File" -bd 2 -underline 0\
		-menu .top.file.menu
	menu .top.file.menu
	.top.file.menu add command -label "Open file" -underline 0\
		-command openfile
	.top.file.menu add command -label "Print EPS" -underline 0\
		-command printfile
	.top.file.menu add command -label "Quit" -underline 0\
		-command {exit}

	# config btnframe
	frame .btnframe -width 1c -height 1m
	frame .dummy1 -width 10c -height 1m
	button .btnframe.zoomin \
		-bitmap @[file join $tcldir zoomin.xbm] \
		-command zoomin_clib
	button .btnframe.zoomout \
		-bitmap @[file join $tcldir zoomout.xbm] \
		-command zoomout_clib
	button .btnframe.forward \
		-bitmap @[file join $tcldir forward.xbm] \
		-command forward_clib
	button .btnframe.back \
		-bitmap @[file join $tcldir back.xbm] \
		-command back_clib
	scrollbar .btnframe.scrlbar1 -width 4m -command scrlbar1_clib
	checkbutton .btnframe.time -text "time" -variable timeon -command time_clib
	checkbutton .btnframe.text -text "text" -variable texton -command text_clib
	button .btnframe.subzoomout \
		-bitmap @[file join $tcldir zoomin.xbm] \
		-command subzoomout_clib
	button .btnframe.subzoomin \
		-bitmap @[file join $tcldir zoomout.xbm] \
		-command subzoomin_clib
	scrollbar .btnframe.scrlbar2 -width 4m -command scrlbar2_clib
	
	pack .top .btnframe .dummy1 -side top -fill x
	pack .top.file -side left
	pack .top.label -side top
	pack .btnframe.zoomin -side left
	pack .btnframe.zoomout -side left
	pack .btnframe.forward -side left
	pack .btnframe.back -side left
	pack .btnframe.scrlbar1 -side left 
	pack .btnframe.time -side left
	pack .btnframe.text -side left
	pack .btnframe.subzoomin -side right
	pack .btnframe.subzoomout -side right
	pack .btnframe.scrlbar2 -side right

	# config subframe1
	frame .subframe1
	canvas .subframe1.canvas -width $canvas_width -height $canvas_height \
		-borderwidth 0 -yscrollcommand ".subframe1.scrlbar set"
	scrollbar .subframe1.scrlbar -width 5m -command \
		".subframe1.canvas yview"
	pack .subframe1 -side left
	pack .subframe1.canvas .subframe1.scrlbar -side left -fill y
	.subframe1.canvas config -background white \
		-scrollregion "0 0 $canvas_width [expr $canvas_height * 2]"

	# config subframe2
	frame .subframe2
	canvas .subframe2.canvas -width $subcanvas_width \
		-height $subcanvas_height\
		-borderwidth 0c -yscrollcommand ".subframe2.scrlbar set"
	scrollbar .subframe2.scrlbar -width 5m -command "movebar_clib"
	pack .subframe2 -side right
	pack .subframe2.canvas .subframe2.scrlbar -side left -fill y
	.subframe2.canvas config -background white -scrollregion \
		"0 0 $subcanvas_width [expr $subcanvas_height * 4]"
	bind .subframe2.canvas <Button> {bpress_clib %x %y}
}

proc openfile {} {
	set filename [tk_getOpenFile]
	openfile_clib $filename
}

proc printfile {} {
	set output [tk_getSaveFile -filetypes {{EPS {.eps}}}]
	.subframe1.canvas postscript -file $output
}   

proc drawframe {} {
	global fx1 fx2 fy1 fy2 frame

	set i 0 
	while {$i < 2} {
		set frame($i) [.subframe1.canvas create line \
			$fx1($i) $fy1($i) $fx2($i) $fy2($i) -fill black]
		incr i;
	}
}

proc eraseframe {} {
	global frame
	foreach i [array names frame] {
		.subframe1.canvas delete $frame($i)
	}
}

proc drawsubframe {} {
	global subfx1 subfx2 subfy1 subfy2 subframe

	set i 0 
	while {$i < 2} {
		set subframe($i) [.subframe2.canvas create line \
			$subfx1($i) $subfy1($i) $subfx2($i) $subfy2($i) -fill black]
		incr i;
	}
}

proc erasesubframe {} {
	global subframe
	foreach i [array names subframe] {
		.subframe2.canvas delete $subframe($i)
	}
}

proc drawlines {} {
	global x1 x2 y1 y2 arrow color lines linecnt

	for {set i 0} {$i < $linecnt} {incr i} {
		set lines($i) [.subframe1.canvas create line \
			$x1($i) $y1($i) $x2($i) $y2($i) -fill $color($i) -arrow $arrow($i)]
	}
}

proc eraselines {} {
	global lines
	foreach i [array names lines] {
		.subframe1.canvas delete $lines($i)
	}
}

proc drawsublines {} {
	global subx1 subx2 suby1 suby2 sublines sublinecnt subcolor
	for {set i 0} {$i < $sublinecnt} {incr i} {
		set sublines($i) [.subframe2.canvas create line \
			$subx1($i) $suby1($i) $subx2($i) $suby2($i) -fill $subcolor($i)]
	}
}

proc erasesublines {} {
	global sublines
	foreach i [array names sublines] {
		.subframe2.canvas delete $sublines($i)
	}
}

proc drawtexts {} {
	global tx ty text txcolor texts textcnt
	for {set i 0} {$i < $textcnt} {incr i} {
		set texts($i) [.subframe1.canvas create text $tx($i) $ty($i) \
			-text $text($i) -fill $txcolor($i)]
	}
}

proc erasetexts {} {
	global texts
	foreach i [array names texts] {
		.subframe1.canvas delete $texts($i)
	}
}

proc drawtimes {} {
	global tmx tmy time tmcolor times timecnt
	for {set i 0} {$i < $timecnt} {incr i} {
		set times($i) [.subframe1.canvas create text $tmx($i) $tmy($i) \
			-text $time($i) -fill $tmcolor($i)]
	}
}

proc erasetimes {} {
	global times
	foreach i [array names times] {
		.subframe1.canvas delete $times($i)
	}
}

proc drawbox {} {
	global rx1 rx2 ry1 ry2 box
	set box [.subframe2.canvas create rectangle \
		$rx1 $ry1 $rx2 $ry2 -outline black ]
}

proc erasebox {} {
	global box
	.subframe2.canvas delete $box
}

make_world
init_clib
