#                                                 #
#            viewer.tcl (EWIPE Viewer)            #       
#                                                 #
#   Copyright (C) 1997-2000  Hiromasa Sekishita   #
#                                                 #
#              This program conforms              #
#      GNU GENERAL PUBLIC LICENSE Version 2.      # 
#                                                 #

##### WIPE (WIPE2) ޥ #####

# title

proc EV_title {label title {subtitle ""}} {
    global coord
    global strwidth
    global view_cw
    global view_scrY
    global Option
    
    set fg yellow
    setfont font kfont {24 rm 24 mc}

    # title

    set title [view_cutcode $title]

    if {$view_scrY == 24} {
	if {$Option(titletype) == 1} {
	    set item [.view.c create text $coord(left) 21 \
		    -text $title -anchor nw -fill $fg \
		    -font $font -width $strwidth(title)]
            catch {
                .view.c itemconfigure $item -kanjifont $kfont
            }
	    
	    add_scrY $item
	    
	    set list [.view.c bbox $item]
	    set sy [expr [lindex $list 1] - 5]
	    set ey [expr [lindex $list 3] + 5]
	    .view.c create line [expr $coord(left) - 20] $ey \
		    [expr $coord(right) + 20] $ey -fill white -width 3
	    .view.c create line [expr $coord(left) - 18] [expr $ey + 3] \
		    [expr $coord(right) + 22] [expr $ey + 3] \
		    -fill black -width 3
	    
	    .view.c raise $item
	} else {
	    set item [.view.c create text $coord(center) 21 \
		    -text $title -anchor n -fill $fg \
		    -font $font -width $strwidth(title)]
            catch {
                .view.c itemconfigure $item -kanjifont $kfont
            }
	    
	    add_scrY $item

	    set list [.view.c bbox $item]
	    set sy [expr [lindex $list 1] - 5]
	    set ey [expr [lindex $list 3] + 5]
	    .view.c create rectangle $coord(left) $sy $coord(right) \
		    $ey -fill Black -outline white
	    
	    .view.c raise $item
	}
    } else {
	set item [.view.c create text $coord(center) $view_scrY -text $title \
		-anchor n -fill $fg \
		-font $font -width $strwidth(title)]
	catch {
	    .view.c itemconfigure $item -kanjifont $kfont
	}
	add_scrY $item
    }

    # subtitle

    set subtitle [view_cutcode $subtitle]
    if {$subtitle != ""} {
	if {$Option(titletype) == 1} {
	    set item [.view.c create text [expr $coord(left) + 48] \
		    $view_scrY -text $subtitle -anchor nw -fill $fg \
		    -font $font -width $strwidth(title)]
	    catch {
		.view.c itemconfigure $item -kanjifont $kfont
	    }
	    add_scrY $item
	} else {
	    set item [.view.c create text $coord(center) \
		    $view_scrY -text $subtitle -anchor n -fill $fg \
		    -font $font -width $strwidth(title)]
	    catch {
		.view.c itemconfigure $item -kanjifont $kfont
	    }
	    add_scrY $item
	}
    } else {
	set view_scrY [expr $view_scrY + 5]
    }
}

# left

proc EV_left {label text {color white} {fontlist {24 rm 24 mc}}} {
    global coord
    global strwidth
    global view_scrY

    set text [view_cutcode $text]
    setfont font kfont $fontlist

    set item [.view.c create text $coord(left) $view_scrY -text $text \
	    -anchor nw -fill $color -font $font \
	    -width $strwidth(pp)]
    catch {
	.view.c itemconfigure $item -kanjifont $kfont
    }
    add_scrY $item
    return $item
}

# right

proc EV_right {label text {color white} {fontlist {24 rm 24 mc}}} {
    global coord
    global strwidth
    global view_scrY

    set text [view_cutcode $text]
    setfont font kfont $fontlist

    set item [.view.c create text $coord(right) $view_scrY -text $text \
	    -anchor ne -fill $color -font $font \
	    -width $strwidth(rp)]
    catch {
	.view.c itemconfigure $item -kanjifont $kfont
    }
    add_scrY $item
    return $item
}

# item

proc EV_item {label text {color white} {fontlist {24 rm 24 mc}}} {
    global coord
    global strwidth
    global view_scrY
    global item_c sitem_c ssitem_c sssitem_c
    global Option

    set text [view_cutcode $text]
    setfont font kfont $fontlist

    set type [lindex $label 1]
    if {[llength $label] == 1} {
	if {$Option(LANG) == "jpn"} {
	    set type ""
	} else {
	    set type "*"
	}
    }
    
    if {$type == "n" || $item_c > 0} {
	if {$type == "n"} {
	    set item_c 1
	} else {
	    incr item_c
	}
	set sitem_c 0
	set ssitem_c 0
	set sssitem_c 0
	set type $item_c.
    } else {
	set item_c 0
	set sitem_c 0
	set ssitem_c 0
	set sssitem_c 0
    }

    
    set item1 [.view.c create text $coord(left) $view_scrY -text $type \
	    -anchor nw -fill $color -font $font]
    catch {
	.view.c itemconfigure $item1 -kanjifont $kfont
    }

    set x [add_x $item1]
    set item2 [.view.c create text $x $view_scrY \
	    -text $text -anchor nw -fill $color \
	    -font $font -width $strwidth(item)]
    catch {
	.view.c itemconfigure $item2 -kanjifont $kfont
    }
    add_scrY $item2
    return $item2
}

# subitem

proc EV_subitem {label text {color white} {fontlist {24 rm 24 mc}}} {
    global coord
    global strwidth
    global view_scrY
    global item_c sitem_c ssitem_c sssitem_c
    global Option

    set text [view_cutcode $text]
    setfont font kfont $fontlist

    set type [lindex $label 1]
    if {[llength $label] == 1} {
	if {$Option(LANG) == "jpn"} {
	    set type ""
	} else {
	    set type "#"
	}
    }

    if {$type == "n" || $item_c > 0 || $sitem_c > 0} {
	if {$type == "n"} {
	    set sitem_c 1
	    set item_c 0
	} else {
	    incr sitem_c
	}
	set ssitem_c 0
	set sssitem_c 0
	set type $sitem_c.
    } else {
	set item_c 0
	set sitem_c 0
	set ssitem_c 0
	set sssitem_c 0
    }
    
    set item1 [.view.c create text [expr $coord(left) + 24] $view_scrY \
	    -text $type -anchor nw -fill $color -font $font]
    catch {
	.view.c itemconfigure $item1 -kanjifont $kfont
    }
    set x [add_x $item1]
    set item2 [.view.c create text $x $view_scrY \
	    -text $text -anchor nw -fill $color \
	    -font $font -width $strwidth(subitem)]
    catch {
	.view.c itemconfigure $item2 -kanjifont $kfont
    }
    add_scrY $item2
    return $item2
}

# subsubitem

proc EV_subsubitem {label text {color white} {fontlist {24 rm 24 mc}}} {
    global coord
    global strwidth
    global view_scrY
    global item_c sitem_c ssitem_c sssitem_c
    global Option

    set text [view_cutcode $text]
    setfont font kfont $fontlist

    set type [lindex $label 1]
    if {[llength $label] == 1} {
	if {$Option(LANG) == "jpn"} {
	    set type ""
	} else {
	    set type "-"
	}
    }

    if {$type == "n" || $item_c > 0 || $sitem_c > 0 || $ssitem_c > 0} {
	if {$type == "n"} {
	    set ssitem_c 1
	    set item_c 0
	    set sitem_c 0
	} else {
	    incr ssitem_c
	}
	set sssitem_c 0
	set type $ssitem_c.
    } else {
	set item_c 0
	set sitem_c 0
	set ssitem_c 0
	set sssitem_c 0
    }

    set item1 [.view.c create text [expr $coord(left) + 48] $view_scrY \
	    -text $type -anchor nw -fill $color -font $font]
    catch {
	.view.c itemconfigure $item1 -kanjifont $kfont
    }
    set x [add_x $item1]
    set item2 [.view.c create text $x $view_scrY \
	    -text $text -anchor nw -fill $color \
	    -font $font -width $strwidth(subsubitem)]
    catch {
	.view.c itemconfigure $item2 -kanjifont $kfont
    }
    add_scrY $item2
    return $item2
}

# subsubsubitem

proc EV_subsubsubitem {label text {color white} {fontlist {24 rm 24 mc}}} {
    global coord
    global strwidth
    global view_scrY
    global item_c sitem_c ssitem_c sssitem_c
    global Option

    set text [view_cutcode $text]
    setfont font kfont $fontlist

    set type [lindex $label 1]
    if {[llength $label] == 1} {
	if {$Option(LANG) == "jpn"} {
	    set type ""
	} else {
	    set type "+"
	}
    }

    if {$type == "n" || $item_c > 0 || $sitem_c > 0 || $ssitem_c > 0} {
	if {$type == "n"} {
	    set sssitem_c 1
	    set item_c 0
	    set sitem_c 0
	    set ssitem_c 0
	} else {
	    incr sssitem_c
	}
	set type $sssitem_c.
    } else {
	set item_c 0
	set sitem_c 0
	set ssitem_c 0
	set sssitem_c 0
    }

    set item1 [.view.c create text [expr $coord(left) + 72] $view_scrY \
	    -text $type -anchor nw -fill $color -font $font]
    catch {
	.view.c itemconfigure $item1 -kanjifont $kfont
    }
    set x [add_x $item1]
    set item2 [.view.c create text $x $view_scrY \
	    -text $text -anchor nw -fill $color \
	    -font $font -width $strwidth(subsubsubitem)]
    catch {
	.view.c itemconfigure $item2 -kanjifont $kfont
    }
    add_scrY $item2
    return $item2
}

# center

proc EV_center {label text {color white} {fontlist {24 rm 24 mc}}} {
    global coord
    global strwidth
    global view_cw
    global view_scrY

    set text [view_cutcode $text]
    setfont font kfont $fontlist

    set item [.view.c create text $coord(center) $view_scrY -text $text \
	    -anchor n -fill $color \
	    -font $font -width $strwidth(center)]
    catch {
	.view.c itemconfigure $item -kanjifont $kfont
    }
    add_scrY $item
    return $item
}

# pict (WIPE2)

proc EV_pict {label imagefile} { 
    global coord
    global view_cw
    global view_scrY
    global filedir
    global pwd
    global imagelist
    global evfont
    
    set imagefile [view_cutcode $imagefile]

    cd $filedir
    if {[file exists $imagefile]} {    
	if {[lsearch [image names] image($imagefile)] == -1} {
	    set err [catch {image create photo image($imagefile) \
		    -file $imagefile}]
            if {$err == 0} {
                lappend imagelist image($imagefile)
            }
	}
    }
    cd $pwd

    if {[lsearch [image names] image($imagefile)] != -1} {
	.view.c create image $coord(center) $view_scrY \
		-image image($imagefile) -anchor n
	
	set imageheight [image height image($imagefile)]
    } else {
	.view.c create text $coord(center) $view_scrY -text $imagefile \
		-anchor n -fill white -font $evfont(C,default,16)
	set imageheight 16
    }
    
    set view_scrY [expr $view_scrY + $imageheight + 12]
}

# pp

proc EV_wipe_pp {command} {
    eval EV_left left [lreplace $command 0 0]
}

# rp (WIPE2)

proc EV_wipe_rp {command} {
    eval EV_right right [lreplace $command 0 0]
}

# label

proc EV_wipe_label {command} {
    global view_cw
    global view_scrY
    global evfont

    set text ""
    set color white
    set font $evfont(C,default,24)
    set kfont $evfont(ja,default,24)

    set s [lsearch $command "-text"]
    if {$s != -1} {
	set text [lindex $command [expr $s+1]]
	set text [view_cutcode $text]
    }
    set s [lsearch $command "-fg"]
    if {$s != -1} {
	set color [lindex $command [expr $s+1]]
    }
    set s [lsearch $command "-font"]
    if {$s != -1} {
	set font [lindex $command [expr $s+1]]
    }
    set s [lsearch $command "-kanjifont"]
    if {$s != -1} {
	set kfont [lindex $command [expr $s+1]]
    }
    set item [.view.c create text [expr $view_cw/2] $view_scrY -text $text \
	    -anchor n -fill $color -font $font]
    catch {
	.view.c itemconfigure $item -kanjifont $kfont
    }
    set view_scrY [expr $view_scrY + 36 + 2]
}

# message

proc EV_wipe_message {command} {
    global coord
    global strwidth
    global view_cw
    global view_scrY
    global evfont
    
    set text ""
    set font $evfont(C,default,16)
    set kfont $evfont(ja,default,16)

    set s [lsearch $command "-text"]
    if {$s != -1} {
	set text [lindex $command [expr $s+1]]
	set text [string trim $text "\n"]
    }
    set s [lsearch $command "-font"]
    if {$s != -1} {
	set font [lindex $command [expr $s+1]]
    }
    set s [lsearch $command "-kanjifont"]
    if {$s != -1} {
	set kfont [lindex $command [expr $s+1]]
    }
    
    set item [.view.c create text $coord(left) [expr $view_scrY + 16]\
            -text $text -anchor nw -fill black \
            -font $font -width $strwidth(text)]
    catch {
	.view.c itemconfigure $item -kanjifont $kfont
    }
    
    add_scrY $item
    
    set list [.view.c bbox $item]
    set sy [expr [lindex $list 1] - 8]
    set ey [expr [lindex $list 3] + 8]

    if {$text != {}} {
        .view.c create rectangle [expr $coord(left) - 8] $sy \
                [expr $coord(right) + 8] $ey -fill white -outline white
	.view.c raise $item
    }
}

##########

##### EWIPE ĥޥ #####

# table
#
# ޥɤϡ
#     table {ɽ}
# ȤǤ
# ɽΤϡǽʬ1 ܡˤܿȰ֤ǡ㤨 {l c r} 
# Ȥϡܤ 3 ĤǤ줾졤󤻡·󤻤Ȥʤޤ
#
# ʬʹߡ2 ܰʹߡˤϡºݤɽεҤǡܤδ֤ξü
# ķ̵ͭꤷޤ
# 1 ܤǾ嵭Τ褦˹ܤ 3 Ĥꤷϡ{| A | B | C |}
# Τ褦 7 ĤǤ򵭽ҤʤФޤ
# ķ̵ͭϡ|ͭ  _̵ Ǥ
# ɬפʾϡԤȹԤδ֤ | 򵭽Ҥޤפ
# ϡԤ³ƵҤ뤫_ 򵭽Ҥޤ
#

proc EV_table {label table {color white} {fontlist {16 rm 16 mc}}} {
    global view_cw
    global view_scrY
    global evfont

    setfont font kfont $fontlist
    set fsize [lindex $fontlist 0]
    if {$fsize < [lindex $fontlist 2]} {
	set fsize [lindex $fontlist 2]
    }

    set define [lindex $table 0]

    set define [view_cutcode $define]

    set col [expr [llength $define] * 2 + 1] 
    set line [llength $table]
    
    for {set i 0} {$i < $col} {incr i} {
	set strlen($i) 0
	set anchor($i) {}
	if {[expr $i % 2] == 1} {
	    set anchor($i) [lindex $define [expr $i / 2]]
	}
    }

    for {set i 1} {$i < $line} {incr i} {
	set textlist [lindex $table $i]
	if {$textlist != {}} { 
	    for {set j 0} {$j < $col} {incr j} {
		set text [lindex $textlist $j]
		if {[string length $text] > $strlen($j)} {
		    set strlen($j) [string length $text]
		}
	    }
	}
    }
    
    set strlensum 0
    for {set i 0} {$i < $col} {incr i} {
	if {$anchor($i) != "|" && $anchor($i) != {}} {
	    set strlensum [expr $strlensum + $strlen($i)]
	}
    }
    
    set lx [expr $strlensum * ($fsize/2) + ($col / 2) * $fsize - 7]
    set tablex [expr ($view_cw - $lx) / 2]

    set y $view_scrY
    for {set i 1} {$i < $line} {incr i} {
	set textlist [lindex $table $i]
	if {$textlist == "|"} {
	    set x $tablex
	    .view.c create line [expr $x - 8] [expr $y - 4] \
		    [expr $x + $lx] [expr $y - 4] -fill white
	} elseif {$textlist == "_"} {
	    
	    
	} else {
	    set x $tablex
	    for {set j 0} {$j < $col} {incr j} {
		set textlist [lindex $table $i]
		set text [lindex $textlist $j]
		
		if {$anchor($j) == "l"} {
		    set item [.view.c create text $x $y \
			    -text $text -anchor nw -fill $color \
			    -font $font]
		    catch {
			.view.c itemconfigure $item -kanjifont \
				$kfont
		    }
		    set x [expr $x + $strlen($j) * $fsize / 2 + $fsize]
		} elseif {$anchor($j) =="c"} {
		    set cx [expr $x + ($strlen($j) * $fsize / 2) / 2]
		    set item [.view.c create text $cx $y \
			    -text $text -anchor n -fill $color \
			    -font $font]
		    catch {
			.view.c itemconfigure $item -kanjifont \
				$kfont
		    }
		    set x [expr $x + $strlen($j) * $fsize / 2 + $fsize]
		} elseif {$anchor($j) =="r"} {
		    set rx [expr $x + $strlen($j) * $fsize / 2]
		    set item [.view.c create text $rx $y \
			    -text $text -anchor ne -fill $color \
			    -font $font]
		    catch {
			.view.c itemconfigure $item -kanjifont \
				$kfont
		    }
		    set x [expr $x + $strlen($j) * ($fsize / 2) + $fsize]
		} else {
		    if {$text == "|"} {
			.view.c create line [expr $x - 8] [expr $y - 4] \
				[expr $x - 8] [expr $y + 20 + 4] -fill white
		    } elseif {$text == "_"} {
			
		    }
		}
	    }
	    set y [expr $y + 20 + 8]
	}
    }
    set view_scrY [expr $y + 8]
}

# symbol

proc EV_symbol {label symbol {color white}} {
    global coord
    global view_cw
    global view_scrY
    
    switch $symbol {
	downarrow {
	    .view.c create line $coord(center) $view_scrY \
		    $coord(center) [expr $view_scrY + 24] \
		    -fill $color -width 5 -arrow last -arrowshape {7 10 5}
	    set view_scrY [expr $view_scrY + 36]
	}
	uparrow {
	    .view.c create line $coord(center) $view_scrY \
		    $coord(center) [expr $view_scrY + 24] \
		    -fill $color -width 5 -arrow first -arrowshape {7 10 5}
	    set view_scrY [expr $view_scrY + 36]
	}
	updownarrow {
	    .view.c create line $coord(center) [expr $view_scrY - 4] \
		    $coord(center) [expr $view_scrY + 28] \
		    -fill $color -width 5 -arrow both -arrowshape {7 10 5}
	    set view_scrY [expr $view_scrY + 36]
	}
	cdot {
	    .view.c create oval [expr $coord(center) - 3] \
		    [expr $view_scrY + 9] [expr $coord(center) + 3] \
		    [expr $view_scrY + 15] \
		    -fill $color -outline $color
	    set view_scrY [expr $view_scrY + 36]
	}
	vdots {
	    for {set i 0} {$i < 3} {incr i} {
		.view.c create oval [expr $coord(center) - 2] \
			[expr $view_scrY + $i * 10] \
			[expr $coord(center) + 2] \
			[expr $view_scrY + $i * 10 + 4] \
			-fill $color -outline $color
	    }
	    set view_scrY [expr $view_scrY + 36]
	}
	default {
	    set view_scrY [expr $view_scrY + 36]
	}
    }
}

# text

proc EV_text {label text {color white} {fontlist {16 rm 16 mc}}} {
    global coord
    global strwidth
    global view_cw
    global view_scrY

    set text [string trim $text "\n"]
    setfont font kfont $fontlist

    set item [.view.c create text $coord(left) $view_scrY \
	    -text $text -anchor nw -fill $color \
	    -font $font -width $strwidth(text)]
    catch {
	.view.c itemconfigure $item -kanjifont $kfont
    }
    add_scrY $item

}

# textbox

proc EV_textbox {label text {color white} {fontlist {16 rm 16 mc}}} {
    global coord
    global strwidth
    global view_cw
    global view_scrY

    set text [string trim $text "\n"]
    setfont font kfont $fontlist

    set item [.view.c create text $coord(center) [expr $view_scrY + 16] \
	    -text $text -anchor n -fill black \
	    -font $font -width $strwidth(textbox)]
    catch {
	.view.c itemconfigure $item -kanjifont $kfont
    }
    add_scrY $item
    set view_scrY [expr $view_scrY + 12] 
    
    set list [.view.c bbox $item]
    set sx [expr [lindex $list 0] - 8]
    set sy [expr [lindex $list 1] - 8]
    set ex [expr [lindex $list 2] + 8]
    set ey [expr [lindex $list 3] + 8]

    if {$text != {}} {
	.view.c create rectangle $sx $sy $ex $ey -fill $color -outline $color
	.view.c raise $item
    }
    
}

# animation

proc EV_animation {label animlist {wait 100}} {
    global coord
    global view_scrY
    global filedir
    global pwd
    global view_anim
    global view_animlist
    global view_wait
    global evfont

    lappend view_wait $wait
    set frame [llength $animlist]
    set view_anim {}
    cd $filedir
    for {set i 0} {$i < $frame} {incr i} {
	if {$i == 0} {
	    if {[file exists [lindex $animlist 0]]} {    
		set err 0
		if {[lsearch [image names] image([lindex $animlist 0])] \
			== -1} {
		    set err [catch {image create photo \
			    image([lindex $animlist $i]) \
			    -file [lindex $animlist $i]}]
		}
		if {$err == 0} {
		    set imagewidth [image width \
			    image([lindex $animlist 0])]
		    set imageheight [image height \
			    image([lindex $animlist 0])]
		}
	    } else {
		break
	    }
	} else {
	    if {[file exists [lindex $animlist $i]]} {    
		if {[lsearch [image names] image([lindex $animlist $i])] \
			== -1} {
		    image create photo image([lindex $animlist $i]) \
			    -width $imagewidth -height $imageheight
		    set err [catch {image create photo image(temp) \
			    -file [lindex $animlist $i] \
			    -width $imagewidth -height $imageheight}]
		    image([lindex $animlist $i]) copy image(temp) -to 0 0 \
			    $imagewidth $imageheight
		    image delete image(temp)
		}
	    }
	}
	if {[lsearch [image names] image([lindex $animlist $i])] != -1} {
	    set item [.view.c create image  $coord(center) \
		    $view_scrY -image image([lindex $animlist $i]) -anchor n]
	    lappend view_anim $item
	}
	.view.c raise [lindex $view_anim 0]
    }
    cd $pwd
    if {[lsearch [image names] image([lindex $animlist 0])] == -1} {
        .view.c create text $coord(center) $view_scrY \
		-text [lindex $animlist 0] -anchor n -fill white \
		-font  $evfont(C,default,16)
        set imageheight 16
    } else {
	lappend view_animlist $view_anim
    }
    set view_scrY [expr $view_scrY + $imageheight + 12]

    if {[lindex $view_wait 0] < 0} {
        animplay [lindex $view_animlist 0]
        set view_animlist [lreplace $view_animlist 0 0]
	set view_wait [lreplace $view_wait 0 0] 
    }
}

# ˥᡼

proc animplay {anim} {
    global view_wait
    
    view_setbind 0
    for {set j 0} {$j < [llength $anim]} {incr j} {
	.view.c raise [lindex $anim $j]
	if {[lindex $view_wait 0 ] < 0} {  
	    EV_pause pause {}
	} else {
	    after [lindex $view_wait 0]
	}
	update
    }
    if {[lindex $view_wait 0 ] >= 0} {
	set view_wait [lreplace $view_wait 0 0]
    }
    view_setbind 1
}

# move

proc EV_move {label command dir} {
    global view_cw
    global view_ch
    global view_movewait

    view_setbind 0
    
    focus .view
    grab .view
    bind .view <3> {
	set view_movewait 0
    }
    bind .view <Escape> {
	set view_movewait 0
    }	

    if {[lsearch {item subitem subsubitem subsubsubitem \
	    left center right} [lindex [lindex $command 0] 0]] == -1} return
    
    set str [lindex [lindex $command 0] 0]
    set item [eval EV_$str $command]

    set orgx [lindex [.view.c coords $item] 0]
    set orgy [lindex [.view.c coords $item] 1]
    set organchor [lindex [.view.c itemconfigure $item -anchor] 4]

    set ex [lindex [.view.c bbox $item] 0]
    set ey [lindex [.view.c bbox $item] 1]

    set sx $ex
    set sy $ey

    if {$dir == "nw" || $dir == "w" || $dir == "sw"} {
	set sx [expr $ex - [lindex [.view.c bbox $item] 2]]
    }
    if {$dir == "ne" || $dir == "e" || $dir == "se"} {
	set sx $view_cw
    }
    if {$dir == "nw" || $dir == "n" || $dir == "ne"} {
	set sy [expr $ey - [lindex [.view.c bbox $item] 3]]
    }
    if {$dir == "sw" || $dir == "s" || $dir == "se"} {
	set sy $view_ch
    }

    set dx [expr ($sx-$ex) / 10.0]
    set dy [expr ($sy-$ey) / 10.0]
    
    .view.c itemconfigure $item -anchor nw
    .view.c coords $item $sx $sy
    
    for {set i 1} {$i <= 10} {incr i} {
	set x [expr $sx - $dx * $i]
	set y [expr $sy - $dy * $i]

	.view.c coords $item $x $y
	if {$view_movewait != 0} {
	    after $view_movewait
	    update
	}
    }
    .view.c itemconfigure $item -anchor $organchor
    .view.c coords $item $orgx $orgy

    bind .view <1> ""
    bind .view <Escape> ""
    view_setbind 1
    grab release .view

}

# cleft ()

proc EV_cleft {label text {color white} {fontlist {24 rm 24 mc}} addtext} {
    global coord
    global strwidth
    global view_scrY
    
    # set text [view_cutcode $text]
    # setfont font kfont $fontlist

    lappend textlist "{$text} $color {$fontlist}"
    set textlist [concat $textlist $addtext] 

    set view_scrY [colortext $textlist $coord(left) $view_scrY]
}

# ʸñ̤

proc colortext {textlist x y} {
    global coord

    set orgx $x
    set orgy $y

    set dylist {}
    set dy 0

    set defcolor [lindex [lindex $textlist 0] 1]
    set deffontlist [lindex [lindex $textlist 0] 2]
    
    foreach text $textlist {
	set str [lindex $text 0]
	set color [lindex $text 1]
	set fontlist [lindex $text 2]
	if {$color == {}} {
	    set color $defcolor
	}
	if {$fontlist == {}} {
	    set fontlist $deffontlist
	}
	setfont font kfont $fontlist

	set err [catch {set len [kanji string length $str]}]
	if {$err == 1} {
	    set len [string length $str]
	}
	for {set i 0} {$i < $len} {incr i} {
	    set err [catch {set ch [kanji string index $str $i]}]
	    if {$err == 1} {
		set ch [string index $str $i]
	    }
	    set dummy [.view.c create text $x 0 -text $ch -anchor nw \
		    -font $font]
	    catch {
		.view.c itemconfigure $dummy -kanjifont $kfont
	    }
	    
	    set x [lindex [.view.c bbox $dummy] 2]
	    set cy [lindex [.view.c bbox $dummy] 3]
	    .view.c delete $dummy
	    if {$cy > $dy} {
		set dy $cy
	    }

	    if {$x > $coord(right)} {
		set x $orgx
		lappend dylist $dy
		set dy 0
	    }
	}
    }

    lappend dylist $dy

    set x $orgx
    set y [expr $y + [lindex $dylist 0]]
    set dylist [lreplace $dylist 0 0]

    foreach text $textlist {
	set str [lindex $text 0]
	set color [lindex $text 1]
	set fontlist [lindex $text 2]
	if {$color == {}} {
	    set color $defcolor
	}
	if {$fontlist == {}} {
	    set fontlist $deffontlist
	}
	setfont font kfont $fontlist

	set err [catch {set len [kanji string length $str]}]
	if {$err == 1} {
	    set len [string length $str]
	}
	for {set i 0} {$i < $len} {incr i} {
	    set err [catch {set ch [kanji string index $str $i]}]
	    if {$err == 1} {
		set ch [string index $str $i]
	    }
	    set item [.view.c create text $x $y -text $ch -fill $color \
		    -anchor sw -font $font]
	    catch {
		.view.c itemconfigure $item -kanjifont $kfont
	    }
	    
	    set x [expr [lindex [.view.c bbox $item] 2] - 2]

	    if {$x > $coord(right)} {
		set x $orgx
		set y [expr $y + [lindex $dylist 0]]
		set dylist [lreplace $dylist 0 0]
	    }
	}
    }
    return [expr $y + 12] 
}

# pause

proc EV_pause {label pause} {
    global view_pause
    global view_skip
    global view_scrY
    global view_cw

    if {$view_skip == 1} return

    view_setbind 0
    set view_pause 1

    set tmp [.view.c create line [expr $view_cw - 10] [expr $view_scrY - 15] \
	    [expr $view_cw - 10] [expr $view_scrY + 5] \
	    -arrow last -fill yellow -width 3]
    focus .view
    update
    bind .view <1> {
	set view_pause 0
    }
    bind .view <Right> {
	set view_pause 0
    }
     bind .view n {
	set view_pause 0
    }
     bind .view <space> {
	set view_pause 0
    }
    tkwait variable view_pause
    .view.c delete $tmp
    update
    view_setbind 1
}

# exec

proc EV_exec {label command} {
    global view_ps
    global tcl_platform

    if {$tcl_platform(platform) == "windows"} {return}
    set new_psid $view_ps(id)
    set new_psname $view_ps(name)
    for {set i 0} {$i < [llength $view_ps(id)]} {incr i} {
	if {[lsearch [exec ps] [lindex $view_ps(id) $i]] == -1} {
	    set new_psid [lreplace $view_ps(id) $i $i]
	    set new_psname [lreplace $view_ps(name) $i $i]
	}
    }
    set view_ps(id) $new_psid
    set view_ps(name) $new_psname
    if {[lsearch $view_ps(name) $command] == -1} {
	lappend view_ps(id) [exec $command &]
	lappend view_ps(name) $command
    }
}

# prog

proc EV_prog {label source} {
    set self .view.prog
    
    frame .view.prog
    source $source
    .view.c create window 120 60 -window $self -anchor nw
}

# figure

proc EV_figure {label imagefile {locate l} {textlist ""}} {
    global coord
    global view_cw
    global view_scrY
    global filedir
    global pwd
    global imagelist
    global evfont
    
    set text [lindex $textlist 0]
    set color [lindex $textlist 1]
    if {$color == {}} {
	set color white
    }
    set fontlist [lindex $textlist 2]
    if {$fontlist == {}} {
	set fontlist {16 rm 16 mc}
    }
    
    setfont font kfont $fontlist

    set ix $coord(right)
    set ian ne
    if {$locate == "r"} {
	set ix $coord(right)
	set ian ne
    } else {
	set ix $coord(left)
	set ian nw
    }

    set imagefile [view_cutcode $imagefile]

    cd $filedir
    if {[file exists $imagefile]} {    
	if {[lsearch [image names] image($imagefile)] == -1} {
	    set err [catch {image create photo image($imagefile) \
		    -file $imagefile}]
            if {$err == 0} {
                lappend imagelist image($imagefile)
            }
	}
    }
    cd $pwd

    if {[lsearch [image names] image($imagefile)] != -1} {
	.view.c create image $ix $view_scrY \
		-image image($imagefile) -anchor $ian
	
	set imageheight [image height image($imagefile)]

	set imagewidth [image width image($imagefile)]
	set iw [expr $coord(right) - $imagewidth - $coord(left) - 8]

	if {$locate == "r"} {
	    set tx $coord(left)
	} else {
	    set tx [expr $coord(left) + $imagewidth + 8]
	}

	set item [.view.c create text $tx $view_scrY -text $text \
		-anchor nw -fill $color -font $font \
		-width $iw]
	catch {
	    .view.c itemconfigure $item -kanjifont $kfont
	}
	set view_scrY [expr $view_scrY + $imageheight + 12]	
    } else {
	if {$locate == "r"} {
	    set tx $coord(left)
	} else {
	    set tx [expr $coord(left) + $imagewidth + 8]
	}
	set iw [expr $coord(right) - $coord(left)]
	set item [.view.c create text $tx $view_scrY -text $text \
		-anchor nw -fill $color -font $font \
		-width $iw]
	catch {
	    .view.c itemconfigure $item -kanjifont $kfont
	}
	add_scrY $item
    }
}

##########

# ʸɤν

proc view_cutcode {text} {
    regsub -all "\[\t\n\]" $text { } text
    regsub -all "\ +\ *" $text { } text
    set text [string trim $text { }]
    return $text
}

# x ɸûʥ٥롼ƥȴ֡

proc add_x {item} {
    global view_scrY

    set list [.view.c bbox $item ]
    return [expr [lindex $list 2] + 12]
}

# y ɸû

proc add_scrY {item} {
    global view_scrY

    set list [.view.c bbox $item ]
    set view_scrY [expr [lindex $list 3] + 12]
}

# Ƽѿ

proc setval {} {
    global view_cw
    global view_ch
    global coord
    global strwidth
    global strlen
    global Option
    global rakugaki_mode

    if {$Option(viewersize) == 1} {
	set view_cw 800
	set view_ch 600
	.view.c configure -width $view_cw -height $view_ch
	wm geometry .view {}
	wm minsize .view $view_cw $view_ch
	wm maxsize .view $view_cw $view_ch

	set coord(left) 40
	set coord(right) [expr $view_cw - 40]
	set coord(center) [expr $view_cw / 2]
	
	set strwidth(title) [expr 24 * 26]
	set strwidth(pp) [expr 24 * 28]
	set strwidth(center) [expr 24 * 28]
	set strwidth(rp) [expr 24 * 28]
	set strwidth(item) [expr 24 * 28]
	set strwidth(subitem) [expr 24 * 27]
	set strwidth(subsubitem) [expr 24 * 26]
	set strwidth(subsubsubitem) [expr 24 * 25]
	set strwidth(text) [expr 16 * 44]
	set strwidth(textbox) [expr 16 * 42]
    } else {
	set view_cw 640
	set view_ch 480
	.view.c configure -width $view_cw -height $view_ch
	wm geometry .view {}
	wm minsize .view $view_cw $view_ch
	wm maxsize .view $view_cw $view_ch

	set coord(left) 40
	set coord(right) [expr $view_cw - 40]
	set coord(center) [expr $view_cw / 2]
	
	set strwidth(title) [expr 24 * 20]
	set strwidth(pp) [expr 24 * 22]
	set strwidth(center) [expr 24 * 22]
	set strwidth(rp) [expr 24 * 22]
	set strwidth(item) [expr 24 * 22]
	set strwidth(subitem) [expr 24 * 21]
	set strwidth(subsubitem) [expr 24 * 20]
	set strwidth(subsubsubitem) [expr 24 * 19]
	set strwidth(text) [expr 16 * 34]
	set strwidth(textbox) [expr 16 * 32]
    }
    set rakugaki_mode 0
}

# ե

proc setfont {font kfont fontlist} {
    upvar $font lcfont
    upvar $kfont lckfont

    set lcfont [selectfont [lindex $fontlist 0] [lindex $fontlist 1]]
    set lckfont [selectkfont [lindex $fontlist 2] [lindex $fontlist 3]]
    if {[lindex $fontlist 0] == "u"} {
	catch {
	    set lcufont "[lindex $fontlist 1]:[lindex $fontlist 3]"
	    if {[lsearch [font names] "@evfont(C,user,$lcufont)"] == -1} {
		font create @evfont(C,user,$lcufont) \
		    -compound "$lcfont $lckfont"
	    }
	    set lcfont @evfont(C,user,$lcufont) 
	}
    }
}

# ե

# size  14,16,24 ǽʥե
#       u 桼Υե
# type  rm roman
#       bf bold
#       it italic
#       bi bold italic
#       ¾ size=u ΤȤľܥե̾
 
proc selectfont {size type} {
    global evfont
    
    switch -regexp $size {
	^[0-9][0-9]*$ {
	    switch $type {
		rm {
		    set font $evfont(C,default,$size)
		}
		default {
		    set font $evfont(C,default,$size)
		}
	    }
	}
	^u$ {
	    set err [catch {set tmp [.view.c create text 0 0 -font $type]}]
	    if {$err == 1} {
		    set font $evfont(C,default,24)
	    } else {
		set font $type
		.view.c delete $tmp
	    }
	}
	default {
	    set font $evfont(C,default,24)
	}
    }    
    return $font
}

# ե

# type  mc mincho
#       gt gothic

proc selectkfont {size type} {
    global evfont

    switch -regexp $size {
	^[0-9][0-9]*$ {
	    set font $evfont(ja,default,$size)
	}
	^u$ {
	    set err [catch {set tmp [.view.c create text 0 0 \
		    -font $type]}]
	    if {$err == 1} {
		set font $evfont(ja,default,24)
	    } else {
		set font $type
		.view.c delete $tmp
	    }
	}
	default {
	    set font $evfont(ja,default,24)
	}
    }
    return $font
}

# ȥɽ 

proc view_titlelist {} {
    global docpages
    global view_cw
    global view_ch
    global view_commandlist
    global view_cp
    global cp
    global Option
    global rakugaki_mode
    global view_skip
    global Viewmode

    if {[llength $docpages] == 0} {return}
    view_setbind 0
    set orgcp $view_cp

    frame .view.c.ft -relief raised -borderwidth 3
    frame .view.c.ft.fl
   
    listbox .view.c.ft.fl.list -height 10 -width 40 \
	    -yscrollcommand ".view.c.ft.fl.scroll set"
    scrollbar .view.c.ft.fl.scroll -command ".view.c.ft.fl.list yview"
    pack .view.c.ft.fl.list .view.c.ft.fl.scroll -side left -fill both

    set mode mouse
    if {$mode == "mouse"} {
	if {$Option(lang) == "jpn"} {
	    set lb(pen)    "ڥ  "
	    set lb(page)   "ڡ"
	    set lb(help)   "إ"
	    set lb(cancel) "󥻥"
	} elseif {$Option(lang) == "eng"} {
	    set lb(pen)    "pen   "
	    set lb(page)   "page  "
	    set lb(help)   "help  "
	    set lb(cancel) "  cancel  "
	}
	frame .view.c.ft.fb -relief raised -borderwidth 1
	button .view.c.ft.fb.bp -text $lb(pen) -command {
	    set view_cp $view_cp
	    toggle_rakugaki_mode
	}
	button .view.c.ft.fb.bn -text $lb(page) -command {
	    set view_cp $view_cp
	    show_pagen
	}
	button .view.c.ft.fb.bh -text $lb(help) -command {
	    set view_cp $view_cp
	    destroy .view.c.ft
	    view_showhelp
	}
	button .view.c.ft.fb.bc -text $lb(cancel) -command {
	    set view_cp $view_cp
	    destroy .view.c.ft
	}
	pack .view.c.ft.fb.bp .view.c.ft.fb.bn .view.c.ft.fb.bh \
		.view.c.ft.fb.bc -side left -padx 2 -pady 2
	pack .view.c.ft.fl .view.c.ft.fb -padx 2 -pady 5
    } else {
	pack .view.c.ft.fl
    }
    pack .view.c.ft
    for {set i 0} {$i < [llength $docpages]} {incr i} {
	set page [lindex $docpages $i]
	set title [lindex $page 0]
	set str0 [lindex $title 0]
	if {[lsearch $view_commandlist $str0] != -1} {
	    if {$str0 == "pict"} {
		set text "   "
	    } elseif {$str0 == "table"} {
		set text "   ɽ"
	    } elseif {$str0 == "symbol"} {
		set text {}
	    } else {
		set text [lindex $title 1]
	    }
	} else {
	    set text {}
	}
	.view.c.ft.fl.list insert end [format "%3d %s" [expr $i+1] $text]
    }
    
    set window [.view.c create window [expr $view_cw/2] [expr $view_ch/2] \
	    -window .view.c.ft -anchor center]
    
    .view.c.ft.fl.list activate $view_cp
    .view.c.ft.fl.list see $view_cp
    .view.c.ft.fl.list selection set $view_cp $view_cp
    
    bind .view.c.ft.fl.list <Double-Button-1> {
	set view_cp [.view.c.ft.fl.list curselection]
    }
    bind .view.c.ft.fl.list <Return> {
	set view_cp [.view.c.ft.fl.list curselection]
    }
    bind .view.c.ft.fl.list <3> {
	set view_cp $view_cp
    }
    bind .view.c.ft.fl.list <Escape> {
	set view_cp $view_cp
    }
    .view.c configure -cursor {}
    update
    focus .view.c.ft.fl.list
    grab .view.c.ft
    tkwait variable view_cp
    if {[winfo exists .view.c.ft] == 1} {
	destroy .view.c.ft
    }
    if {$view_cp != $orgcp} {
	set cp $view_cp
	set cursor {}
        if {$Viewmode == 1 || $Option(vredraw) == 0} {
	    view_showcanvas $view_cp
        } else {
	    ctrlbutton disabled
	    set view_skip 0
	    initpage
	    showpage
	    focus .view
	}
    }
    if {$rakugaki_mode == 0} {
	view_setbind 1
	changepointer
    }
}

# ڡɽ

proc view_showcanvas {cp} {
    global docpages
    global view_cp
    global view_cw
    global view_ch
    global view_commandlist
    global view_scrY
    global Option
    global view_movewait
    global view_animlist
    global view_skip
    global pagepush
    global timeitem
    global item_c sitem_c ssitem_c sssitem_c

    set curpointer [lindex [.view.c configure -cursor] 4]
    .view.c configure -cursor watch

    set pagepush 0
    set view_cp $cp
    .view.c delete all
    set view_animlist {}
    set view_wait {}
    if {[lsearch [image names] image(back)] != -1} {
	set item [.view.c create image [expr $view_cw / 2] \
		[expr $view_ch / 2] -image image(back) -anchor center]
    }

    if {[llength $docpages] == 0} {
	set text "0 / 0"
    } else {
	set text "[expr $view_cp + 1 ] / [llength $docpages]"
    }
    wm title .view "EWIPE Viewer   \[ $text \]"
    
    if {$Option(pagen) == 1} {
	set Option(pagen) 0
	show_pagen
    }
    set timeitem [.view.c create text 16 [expr $view_ch - 8] \
	    -text {} -fill yellow -anchor sw -width [expr 24 * 18] \
	    -font -*-times-bold-r-normal--*-180-*-*-*-*-*-*]
    if {$Option(time) == 1} {
	timer
    }
    
    if {$view_skip == 1} {
	set view_movewait 0
    } else {
	set view_movewait 50
    }

    set view_scrY 24
    
    set item_c 0
    set sitem_c 0
    set ssitem_c 0
    set sssitem_c 0
    
    set page [lindex $docpages $cp]    
    foreach i $page {
	set str [lindex [lindex $i 0] 0]
	switch $str {
	    label {
		EV_wipe_label $i
	    }
	    message {
		EV_wipe_message $i
	    }
	    pp {
		EV_wipe_pp $i
	    }
	    rp {
		EV_wipe_rp $i
	    }
	    pause {
		.view.c configure -cursor $curpointer
		eval EV_$str $i
		.view.c configure -cursor watch
	    }
	    default {
		if {[lsearch $view_commandlist $str] != -1} {
		    eval EV_$str $i
		}
	    }
	}
    }
    .view.c configure -cursor $curpointer

    global stick
    set Option(stick) 0
    if {$Option(stick) == 1} {
	bind .view <Motion> "movestick %x %y"
	set stick(1) [.view.c create line 0 0 0 0 -width 2 -fill black]
	set stick(2) [.view.c create line 0 0 0 0 -width 2]
	if {
	    [catch {.view.c itemconfigure $stick(2) -fill $Option(pointerfg)}]
	} {.view.c itemconfigure $stick(2) -fill white}
    }
}

# ڡ

proc view_nextpage {n} {
    global Option
    global Viewmode
    global cp
    global view_cp
    global docpages
    global view_animlist
    global view_skip

    if {[llength $view_animlist] > 0} {
	animplay [lindex $view_animlist 0]
	set view_animlist [lreplace $view_animlist 0 0]
    } else {
	set view_skip 0
	if {$Viewmode == 1 || $Option(vredraw) == 0} {
	    if {$n == 1} {
		if {$view_cp < [expr [llength $docpages]-1]} { 
		    incr view_cp
		    view_showcanvas $view_cp
		    view_setbind 1
		}
	    } elseif {$n == -1} {
		if {$view_cp > 0} { 
		    incr view_cp -1
		    view_showcanvas $view_cp
		    view_setbind 1
		}
	    }
	} else {
	    if {$n == 1} {
		nextpage 1
		focus .view
	    } elseif {$n == -1} {
		nextpage -1
		focus .view
	    }
	}
    }
}

# ڡ

proc pushpage {num} {
    global pagepush

    set pagepush [expr "$pagepush * 10 + $num"]
}

proc jump_pushed_page {} {
    global pagepush
    global cp
    global view_cp
    global Option
    global view_skip
    global docpages
    global Viewmode

    if {$pagepush < 1 || $pagepush > [llength $docpages]} {
	set pagepush 0
	return
    }
    set view_cp [expr $pagepush - 1]
    set cp $view_cp
    set cursor {}
    if {$Viewmode == 1 || $Option(vredraw) == 0} {
	view_showcanvas $view_cp
    } else {
	ctrlbutton disabled
	set view_skip 0
	initpage
	showpage
	focus .view
    }
}

# ̾⡼ <-> 񤭥⡼

proc toggle_rakugaki_mode {} {
    global rakugaki_mode
    global pointx
    global pointy
    global Option
    global view_cw
    global view_ch
    
    if {$rakugaki_mode == 0} {
        set rakugaki_mode 1
	set lcolor $Option(penleft)
	set rcolor $Option(penright)
        set pointer "pencil $lcolor $rcolor"
        set err [catch {.view.c configure -cursor $pointer}]
	if {$err == 1} {
	    catch {.view.c configure -cursor "pencil white red"}
	    set lcolor white
	    set rcolor red
	}
        view_setbind 0
	bind .view e        "hideeditor"
	bind .view q        "quitviewer"
	bind .view <Shift_L> "toggle_rakugaki_mode"
	bind .view <Shift_R> "toggle_rakugaki_mode"
	bind .view <B1-Motion> "movepointer %x %y %W $lcolor"
	bind .view <B3-Motion> "movepointer %x %y %W $rcolor"
	bind .view <1>      {
	    set pointx %x
	    set pointy %y
	}
	bind .view <3>      {
	    set pointx %x
	    set pointy %y
	}
	bind .view <2>      ".view.c delete penline"
        set pointx {}
        set pointy {}

	if {$Option(lang) == "jpn"} {
	    set lb(clear)  "õ"
	    set lb(return) ""
	} elseif {$Option(lang) == "eng"} {
	    set lb(clear)  "clear"
	    set lb(return) "Return"
	}
	frame .view.c.penwindow
	button .view.c.penwindow.bc -text $lb(clear) \
		-command ".view.c delete penline"
	button .view.c.penwindow.br -text $lb(return) \
		-command toggle_rakugaki_mode
	pack .view.c.penwindow.bc .view.c.penwindow.br -side left
	.view.c create window [expr $view_cw - 100] [expr $view_ch - 2] \
		-window .view.c.penwindow -anchor se
    } else {
	destroy .view.c.penwindow
        set rakugaki_mode 0
        set pointx {}
        set pointy {}
	view_setbind 1
        changepointer
    }
}

# ֥ץλ

proc killsubps {} {
    global view_ps
    global view_cw
    global view_ch
    global Option

    view_setbind 0

    frame .view.c.ft -relief raised -borderwidth 3
    frame .view.c.ft.fl
   
    listbox .view.c.ft.fl.list -height 5 -width 30 \
	    -yscrollcommand ".view.c.ft.fl.scroll set"
    scrollbar .view.c.ft.fl.scroll -command ".view.c.ft.fl.list yview"
    pack .view.c.ft.fl.list .view.c.ft.fl.scroll -side left -fill both

    set mode mouse
    if {$mode == "mouse"} {
	if {$Option(lang) == "jpn"} {
	    set lb(cancel) "󥻥"
	} elseif {$Option(lang) == "eng"} {
	    set lb(cancel) "  cancel  "
	}
	frame .view.c.ft.fb
	button .view.c.ft.fb.bc -text $lb(cancel) -command {
	    set tmp 0
	}
	pack .view.c.ft.fb.bc
	pack .view.c.ft.fl .view.c.ft.fb -padx 2 -pady 5
    } else {
	pack .view.c.ft.fl
    }
    pack .view.c.ft
    for {set i 0} {$i < [llength $view_ps(id)]} {incr i} {
	if {[lsearch [exec ps] [lindex $view_ps(id) $i]] != -1} {
	    set text [lindex $view_ps(name) $i]
	    .view.c.ft.fl.list insert end $text
	}
    }
    set window [.view.c create window [expr $view_cw/2] [expr $view_ch/2] \
	    -window .view.c.ft -anchor center]
    
    .view.c.ft.fl.list activate 0
    .view.c.ft.fl.list see 0
    .view.c.ft.fl.list selection set 0 0
    
    bind .view.c.ft.fl.list <Double-Button-1> {
	set kps [.view.c.ft.fl.list curselection]
	if {$kps != {}} {
	    exec kill [lindex $view_ps(id) $kps]
	    set view_ps(id) [lreplace $view_ps(id) $kps $kps]
	    set view_ps(name) [lreplace $view_ps(name) $kps $kps]
	}
	set tmp 0
    }
    bind .view.c.ft.fl.list <Return> {
	set kps [.view.c.ft.fl.list curselection]
	if {$kps != {}} {
	    exec kill [lindex $view_ps(id) $kps]
	    set view_ps(id) [lreplace $view_ps(id) $kps $kps]
	    set view_ps(name) [lreplace $view_ps(name) $kps $kps]
	}
	set tmp 0
    }
    bind .view.c.ft.fl.list <3> {
        set tmp 0
    }
    bind .view.c.ft.fl.list <Escape> {
        set tmp 0
    }
    update
    focus .view.c.ft.fl.list
    grab .view.c.ft
    tkwait variable tmp
    destroy .view.c.ft
    view_setbind 1
}

# ɽ

proc toggle_time {} {
    global Option
    global timeitem

    if {$Option(time) == 0} {
	set Option(time) 1
	timer
    } else {
	set Option(time) 0
	.view.c itemconfigure $timeitem -text {}
    }
} 

# ɽ

proc timer {} {
    global Option
    global timeitem
    global view_stime

    if {$Option(time) == 0} {return}
    if {[winfo exists .view] != 1} {return}

    set ctime [clock seconds]

    if {$Option(timemode) == 0} {
	set text [clock format $ctime -format %T]
    } else {
	set text [clock format [expr $ctime - $view_stime] -format %T -gmt 1]
    }
    .view.c itemconfigure $timeitem -text $text
    .view.c raise $timeitem
    after 1000 timer
}

# в֥ꥻå

proc reset_time {} {
    global view_stime
    
    set view_stime [clock seconds]
}

# ڡֹɽ

proc show_pagen {} {
    global Option
    global rakugaki_mode
    global pageitem
    global view_cw
    global view_ch
    global docpages
    global view_cp

    if {$Option(pagen) == 0} {
	if {[llength $docpages] == 0} {
	    set text "0 / 0"
	} else {
	    set text "[expr $view_cp + 1 ] / [llength $docpages]"
	}
	set pageitem [.view.c create text [expr $view_cw - 8] \
		[expr $view_ch - 8] -text $text -fill yellow -anchor se \
		-width [expr 24 * 18] \
		-font -*-times-bold-r-normal--*-180-*-*-*-*-*-*]
	
	set Option(pagen) 1
    } else {
	if {[info exists pageitem] == 1} {
	    .view.c delete $pageitem
	    set Option(pagen) 0
	}
    }
    if {$rakugaki_mode == 1} {
	toggle_rakugaki_mode
	changepointer
    }
}

# λ

proc quitviewer {} {
    global Viewmode
    global view_ps
    global tcl_platform
    
    if {$Viewmode == 1 || [wm state .] == "withdrawn"} {
	exitewipe
    } else {
	if {$tcl_platform(platform) != "windows"} {
	    foreach i $view_ps(id) {
		if {[lsearch [exec ps] [lindex $view_ps(id) $i]] == -1} {
		    exec kill $i
		}
	    }
	}
	destroy .view
    }
}

# إɽ

proc view_showhelp {} {
    global message
    global view_cw
    global view_ch
    global Option
    
    view_setbind 0
    
    if {$Option(lang) == "jpn"} {
        set help "\n\
                ڡɽ          : n, , ڡ, å\n\
                ڡɽ          : p, , Del, BS, å\n\
                ȥɽ    : ꥿, 楯å\n\
                ǥɽؤ    : e\n\
                ڡֹɽ        : s\n\
                ɽ              : t\n\
                в֥ꥻå      : r\n\
                EWIPE Viewer Ĥ : q\n\n\
                Υإפɽ      : h"
    } elseif {$Option(lang) == "eng"} {
         set help "\n\
                show next page        : n, ->, Space, click left\n\
                show previous page    : p, <-, Del, BS, click right\n\
                show title list       : Enter, click center\n\
                show/hide Editor      : e\n\
                show page number      : s\n\
                show time             : t\n\
                reset time            : r\n\
                close EWIPE Viewer    : q\n\n\
                show this help        : h"
    }
    
    frame .view.c.fh -relief raised -borderwidth 2
    label .view.c.fh.tt -width 54 -height 12 -relief raised \
	    -justify left -text $help
    button .view.c.fh.bo -text $message(ok) -command {
        destroy .view.c.fh
    }
    pack .view.c.fh.tt .view.c.fh.bo -padx 5 -pady 5
    set window [.view.c create window [expr $view_cw/2] [expr $view_ch/2] \
	    -window .view.c.fh -anchor center]

    bind .view.c.fh.bo <Escape> {
        destroy .view.c.fh
    }

    .view.c configure -cursor {}
    update
    focus .view.c.fh.bo
    grab .view.c.fh
    tkwait window .view.c.fh
    view_setbind 1
    changepointer
}

# Хɤ

proc view_setbind {n} {
    global Option
    global tcl_platform

    if {$n == 1} {
	bind .view <1>      "view_nextpage 1"
	bind .view <Right>  "view_nextpage 1"
	bind .view  n       "view_nextpage 1"
	bind .view <space>  "view_nextpage 1"
	
	bind .view <3>      "view_nextpage -1"
	bind .view <Left>   "view_nextpage -1"
	bind .view p        "view_nextpage -1"
	bind .view <Delete> "view_nextpage -1"
        
	bind .view <2>      "view_titlelist"
	bind .view <Return> "view_titlelist"
	
	bind .view e        "hideeditor"
	bind .view h        "view_showhelp"
	bind .view s        "show_pagen"
	bind .view t    "toggle_time"
	bind .view r    "reset_time"
	if {$tcl_platform(platform) != "windows"} {
	    bind .view k    "killsubps"
	} else {
	    bind .view k    ""
	}
	bind .view q        "quitviewer"

	bind .view <B1-Motion> ""
	bind .view <B3-Motion> ""
	bind .view <Shift_L> "toggle_rakugaki_mode"
	bind .view <Shift_R> "toggle_rakugaki_mode"

	for {set i 0} {$i <= 9} {incr i} {
	    bind .view $i "pushpage %A"
	}
	bind .view g        "jump_pushed_page"
    } else {
	bind .view <1>      ""
	bind .view <Right>  ""
	bind .view  n       ""
	bind .view <space>  ""
	
	bind .view <3>      ""
	bind .view <Left>   ""
	bind .view p        ""
	bind .view <Delete> ""
	
	bind .view <2>      ""
	bind .view <Return> ""
	
	bind .view e        ""
	bind .view h        ""
	bind .view s        ""
	bind .view t        ""
	bind .view k        ""
	bind .view r        ""
	bind .view q        ""

	bind .view <B1-Motion> ""
	bind .view <B3-Motion> ""
	bind .view <Shift_L> ""
	bind .view <Shift_R> ""

	for {set i 0} {$i <= 9} {incr i} {
	    bind .view $i ""
	}
	bind .view g        ""
    }
}

# ݥѹ

proc changepointer {} {
    global Option
    global rakugaki_mode
    global tcl_platform
    
    set type $Option(pointer)
    set fg $Option(pointerfg)
    set bg $Option(pointerbg)
    
    if {$type == {} || $type == "normal"} {
	.view.c configure -cursor {}
    } else {
	if {$tcl_platform(platform) == "windows"} {
	    set pointer $type
	    if {[catch {.view.c configure -cursor $pointer}]} {
		if {[catch {.view.c configure -cursor $type}]} {
		    .view.c configure -cursor {}
		}
	    }
	} else {
	    set pointer "$type $fg $bg"
	    if {[catch {.view.c configure -cursor $pointer}]} {
		if {[catch {.view.c configure -cursor "$type white black"}]} {
		    .view.c configure -cursor {}
		}
	    }
	}
    }
    if {$rakugaki_mode == 1} {
	toggle_rakugaki_mode
    }
}

# ݥ󥿰ư

proc movepointer {x y w color} {
    global pointx
    global pointy

    if {$pointx == {}} return
    if {$w != ".view.c"} return
    set item [.view.c create line $pointx $pointy $x $y -fill $color -width 2]
    .view.c addtag penline withtag $item
    set pointx $x
    set pointy $y
}

# stick

proc movestick {x y} {
    global stick
    global view_cw
    global view_ch
    .view.c coords $stick(1) $x [expr $y+1] [expr $view_cw-10] $view_ch
    .view.c coords $stick(2) $x $y $view_cw [expr $view_ch-10]
}

# ǥɽ

proc hideeditor {} {
    global Viewmode
    global cp
    global view_cp
    global view_skip

    if {[wm state .] == "normal"} {
	set Viewmode 1
	wm withdraw .
    } else {
	set Viewmode 0
	wm deiconify .
	set view_skip 1
	ctrlbutton disabled
	set cp $view_cp
	initpage
	showpage
	focus .view
    }
}

# ɽ

proc resetview {page} {
    global view_cp
    global view_cw
    global view_ch
    global filedir
    global pwd
    global Option
    global imagelist
    global view_stime
    global view_ps

    .view.c delete all
    if {[info exists imagelist] == 1} {
        foreach i $imagelist {
            image delete $i
            set s [lsearch $imagelist $i]
            if {$s != -1} {
                set imagelist [lreplace imagelist $s $s]
            }
        }
    }

    cd $filedir
    if {$Option(viewersize) == 1} {
	set wx 800
	set wy 600
    } else {
	set wx 640
	set wy 480
    }
    # set view_stime [clock format [clock seconds] -format %T]
    set view_stime [clock seconds]
    set view_ps(id) {}
    set view_ps(name) {}
    if {[file exists $Option(background)]} {    
	if {[lsearch [image names] image(back)] == -1} {
	    if {$Option(bgtype) == 0} {
		set err [catch {image create photo image(back) \
			-file $Option(background)}]
	    } else {
		set err [catch {image create photo image(temp) \
			-file $Option(background)}]
		image create photo image(back) -width $wx -height $wy
		
		if {$Option(bgtype) == 1} {
		    image(back) copy image(temp) -to 0 0 $wx $wy
		    image delete image(temp)
		} else {
		    # 2: zoom
		}
	    }
	    if {$err == 0} {
                lappend imagelist image(back)

            }
	}
    }
    cd $pwd
    
    set view_cp $page
    view_showcanvas $view_cp
    view_setbind 1
    changepointer    
}

# EWIPE Viewer main

proc viewer {page} {
    global view_cw
    global view_ch
    global view_commandlist

    toplevel .view
    set view_cw 640
    set view_ch 480

    set view_commandlist {title item subitem subsubitem subsubsubitem \
	    left center right pict symbol table textbox text \
	    animation move cleft pause exec figure}
    canvas .view.c -width $view_cw -height $view_ch -bg RoyalBlue4
    pack .view.c
    setval
    resetview $page
}