1#
2# Copyright (C) 2007 WIDE Project.  All rights reserved.
3#
4# Redistribution and use in source and binary forms, with or without
5# modification, are permitted provided that the following conditions
6# are met:
7# 1. Redistributions of source code must retain the above copyright
8#    notice, this list of conditions and the following disclaimer.
9# 2. Redistributions in binary form must reproduce the above copyright
10#    notice, this list of conditions and the following disclaimer in the
11#    documentation and/or other materials provided with the distribution.
12# 3. Neither the name of the project nor the names of its contributors
13#    may be used to endorse or promote products derived from this software
14#    without specific prior written permission.
15#
16# THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
17# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
18# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19# ARE DISCLAIMED.  IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
20# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
21# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
22# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
23# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
24# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
25# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
26# SUCH DAMAGE.
27#
28# $Id: tcpillust.tcl,v 1.4 2007/11/10 17:51:08 nishida Exp $
29
30proc make_world {} {
31	global tcldir
32	global appl_x
33	global appl_y
34	global canvas_width
35	global canvas_height
36	global subcanvas_width
37	global subcanvas_height
38
39	frame .top -relief raised -bd 2
40	wm title . "tcpillust"
41	if {$appl_x >= 0} { wm geometry . +$appl_x+$appl_y }
42	label .top.label -text "Tcpillust"
43	menubutton .top.file -text "File" -bd 2 -underline 0\
44		-menu .top.file.menu
45	menu .top.file.menu
46	.top.file.menu add command -label "Open file" -underline 0\
47		-command openfile
48	.top.file.menu add command -label "Print EPS" -underline 0\
49		-command printfile
50	.top.file.menu add command -label "Quit" -underline 0\
51		-command {exit}
52
53	# config btnframe
54	frame .btnframe -width 1c -height 1m
55	frame .dummy1 -width 10c -height 1m
56	button .btnframe.zoomin \
57		-bitmap @[file join $tcldir zoomin.xbm] \
58		-command zoomin_clib
59	button .btnframe.zoomout \
60		-bitmap @[file join $tcldir zoomout.xbm] \
61		-command zoomout_clib
62	button .btnframe.forward \
63		-bitmap @[file join $tcldir forward.xbm] \
64		-command forward_clib
65	button .btnframe.back \
66		-bitmap @[file join $tcldir back.xbm] \
67		-command back_clib
68	scrollbar .btnframe.scrlbar1 -width 4m -command scrlbar1_clib
69	checkbutton .btnframe.time -text "time" -variable timeon -command time_clib
70	checkbutton .btnframe.text -text "text" -variable texton -command text_clib
71	button .btnframe.subzoomout \
72		-bitmap @[file join $tcldir zoomout.xbm] \
73		-command subzoomout_clib
74	button .btnframe.subzoomin \
75		-bitmap @[file join $tcldir zoomin.xbm] \
76		-command subzoomin_clib
77	frame .btnframe.dummy -width 1.5c -height 1m
78	scrollbar .btnframe.scrlbar2 -width 4m -command scrlbar2_clib
79
80	pack .top .btnframe .dummy1 -side top -fill x
81	pack .top.file -side left
82	pack .top.label -side top
83	pack .btnframe.zoomin -side left
84	pack .btnframe.zoomout -side left
85	pack .btnframe.forward -side left
86	pack .btnframe.back -side left
87	pack .btnframe.scrlbar1 -side left
88	pack .btnframe.time -side left
89	pack .btnframe.text -side left
90	pack .btnframe.dummy -side right
91	pack .btnframe.scrlbar2 -side right
92	pack .btnframe.subzoomout -side right
93	pack .btnframe.subzoomin -side right
94
95	# config subframe1
96	frame .subframe1
97	canvas .subframe1.canvas -width $canvas_width -height $canvas_height \
98		-borderwidth 1 -yscrollcommand ".subframe1.scrlbar set"
99	scrollbar .subframe1.scrlbar -width 5m -command \
100		scrlbar_move_clib
101	pack .subframe1 -side left
102	pack .subframe1.canvas .subframe1.scrlbar -side left -fill y
103	.subframe1.canvas config -background white \
104		-scrollregion "0 0 $canvas_width [expr $canvas_height * 2]"
105	bind .subframe1.canvas <Button> {sub1press_clib %x %y}
106
107	# config subframe2
108	frame .subframe2
109	canvas .subframe2.canvas -width $subcanvas_width \
110		-height $subcanvas_height\
111		-borderwidth 0c -yscrollcommand ".subframe2.scrlbar set"
112	scrollbar .subframe2.scrlbar -width 5m -command "movebar_clib"
113	pack .subframe2 -side right
114	pack .subframe2.canvas .subframe2.scrlbar -side left -fill y
115	.subframe2.canvas config -background white -scrollregion \
116		"0 0 $subcanvas_width [expr $subcanvas_height * 4]"
117	bind .subframe2.canvas <Button> {sub2press_clib %x %y}
118}
119
120proc createpi {} {
121	global message
122
123	if {![winfo exists .pi]} {
124		option add *font {fixed 12}
125		toplevel .pi -width 500 -height 200 -background white
126		wm title .pi "packet information"
127		message .pi.msg1 \
128					-width 500\
129					-background white\
130					-foreground black\
131		            -text "Packet Information"
132		message .pi.msg2 \
133					-width 500\
134					-background white\
135					-foreground brown\
136		            -textvariable message
137   		pack .pi.msg1
138	    pack .pi.msg2
139	    bind .pi <Button> "destroy .pi"
140		wm geometry .pi 500x200+300+200
141		raise .pi
142	} else {
143		raise .pi
144	}
145}
146
147proc openfile {} {
148	set filename [tk_getOpenFile]
149	openfile_clib $filename
150}
151
152proc printfile {} {
153	set output [tk_getSaveFile -filetypes {{EPS {.eps}}}]
154	.subframe1.canvas postscript -file $output
155}
156
157proc drawframe {} {
158	global fx1 fx2 fy1 fy2 frame
159
160	set i 0
161	while {$i < 2} {
162		set frame($i) [.subframe1.canvas create line \
163			$fx1($i) $fy1($i) $fx2($i) $fy2($i) -fill black]
164		incr i;
165	}
166}
167
168proc eraseframe {} {
169	global frame
170	foreach i [array names frame] {
171		.subframe1.canvas delete $frame($i)
172	}
173}
174
175proc drawsubframe {} {
176	global subfx1 subfx2 subfy1 subfy2 subframe
177
178	set i 0
179	while {$i < 2} {
180		set subframe($i) [.subframe2.canvas create line \
181			$subfx1($i) $subfy1($i) $subfx2($i) $subfy2($i) -fill black]
182		incr i;
183	}
184}
185
186proc erasesubframe {} {
187	global subframe
188	foreach i [array names subframe] {
189		.subframe2.canvas delete $subframe($i)
190	}
191}
192
193proc drawlines {} {
194	global x1 x2 y1 y2 arrow color lines linecnt
195
196	for {set i 0} {$i < $linecnt} {incr i} {
197		set lines($i) [.subframe1.canvas create line \
198			$x1($i) $y1($i) $x2($i) $y2($i) -fill $color($i) -arrow $arrow($i)]
199	}
200}
201
202proc eraselines {} {
203	global lines
204	foreach i [array names lines] {
205		.subframe1.canvas delete $lines($i)
206	}
207}
208
209proc drawsublines {} {
210	global subx1 subx2 suby1 suby2 sublines sublinecnt subcolor
211	for {set i 0} {$i < $sublinecnt} {incr i} {
212		set sublines($i) [.subframe2.canvas create line \
213			$subx1($i) $suby1($i) $subx2($i) $suby2($i) -fill $subcolor($i)]
214	}
215}
216
217proc erasesublines {} {
218	global sublines
219	foreach i [array names sublines] {
220		.subframe2.canvas delete $sublines($i)
221	}
222}
223
224proc drawtexts {} {
225	global tx ty text txcolor texts textcnt
226	for {set i 0} {$i < $textcnt} {incr i} {
227		set texts($i) [.subframe1.canvas create text $tx($i) $ty($i) \
228			-text $text($i) -fill $txcolor($i)]
229	}
230}
231
232proc erasetexts {} {
233	global texts textcnt
234	foreach i [array names texts] {
235		.subframe1.canvas delete $texts($i)
236	}
237}
238
239proc drawtimes {} {
240	global tmx tmy time tmcolor times timecnt
241	for {set i 0} {$i < $timecnt} {incr i} {
242		set times($i) [.subframe1.canvas create text $tmx($i) $tmy($i) \
243			-text $time($i) -fill $tmcolor($i)]
244	}
245}
246
247proc erasetimes {} {
248	global times
249	foreach i [array names times] {
250		.subframe1.canvas delete $times($i)
251	}
252}
253
254proc drawbox {} {
255	global rx1 rx2 ry1 ry2 box
256	set box [.subframe2.canvas create rectangle \
257		$rx1 $ry1 $rx2 $ry2 -outline black ]
258}
259
260proc erasebox {} {
261	global box
262	.subframe2.canvas delete $box
263}
264
265make_world
266init_clib
267