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