#!/bin/sh # the next line restarts using wish \ exec wish "$0" "--" "$@" # # # EWIPE : Extended WIPE (Editor for WIPE) # # # # Copyright (C) 1997-2000 Hiromasa Sekishita # # # # This program conforms # # GNU GENERAL PUBLIC LICENSE Version 2. # # # # EWIPE Version 1.2.0 # # # # If you want to use this program in the # # other directory, please change the path as # # follows. # # ex. # # set PATH /usr/local/lib/ewipe # # # # (Japanese) # # ewipe のあるディレクトリ以外から使う場合 # # には、次の部分を設定を変更して下さい。 # # 例: # # set PATH /usr/local/lib/ewipe # # # set PATH . ################################################### # setting ewipe path if {[info exists env(EWIPEPATH)]} { set PATH $env(EWIPEPATH) } lappend auto_path $PATH # Tcl/Tk version check if {[info tclversion] < 7.6} { puts stderr "EWIPE requires Tcl7.6/Tk4.2" exit } # check arguments for ewipe proc argvcheck {} { global version global filename global filedir global argc argv global pwd global Viewmode global Option for {set i 0} {$i < $argc} {incr i} { set argi [lindex $argv $i] switch -regexp -- $argi { {^-(V|[Vv]ersion)$} { puts stderr "EWIPE Version $version" exit } {^-(h|help)$} { puts stderr "Usage: ewipe \[option\] \[filename\]" puts stderr "" puts stderr " -v, -view View Mode" puts stderr " -V, -Version, -version show version\ infomation" puts stderr " -e for English" puts stderr " -h, -help show this help" exit } {^-(v|view)$} { incr i if {$argc <= $i} { puts stderr "ewipe: option \`$argi\' requires a filename" exit } set filename [lindex $argv $i] if {[file exists $filename] != 1} { puts stderr "ewipe: Can't find \`$filename\'" exit } else { set Viewmode 1 set filedir [file dirname $filename] if {[catch {cd $filedir}] == 1} { puts stderr "ewipe: no such directory \`$filedir\'" exit } set filedir [pwd] cd $pwd break } } {^-e$} { set Option(LANG) eng } {^-} { puts stderr "ewipe: unknown option \`$argi\'" puts stderr "Try \`ewipe -h\' or \`ewipe -help\` for more\ information." exit } default { set filename $argi if {[file isdirectory $filename] == 1} { puts stderr "ewipe: \`$filename\' is a directory" exit } set filedir [file dirname $filename] if {[catch {cd $filedir}] == 1} { puts stderr "ewipe: no such directory \`$filedir\'" exit } set filedir [pwd] cd $pwd break } } } readfile } # ファイル読込み proc readfile {} { global filename global docpages global docpagesorg global tcl_platform global Option set docpages {} set docpagesorg {} wm title . "EWIPE - $filename" if {[file exists $filename] != 1} {return} set file [open $filename r] while {![eof $file]} { set line [gets $file] if {$line == "option:"} { set err 1 while {![eof $file]} { set line "[gets $file]" if {$line == ":end"} {set err 0; break} setoption $line } } else { append docpages "$line\n" } } close $file if {$Option(LANG) == "eng"} { set Option(lang) eng } if {[catch {llength $docpages}] == 1} { puts stderr "unmatched error \`\{\' or \`\}\'" set docpages {} } set docpagesorg $docpages if {$tcl_platform(platform) == "windows"} { set kcode {} catch {set kcode [kanji code $docpages]} if {$kcode == "EUC"} { set docpages [kanji conversion EUC SJIS $docpages] } } } # 設定ファイル読み込み proc readdotfile {} { global Option global env # デフォルト設定 set Option(lang) eng ;# 表示言語 (jpn:日本語 eng:英語) set Option(pagen) 0 ;# ページ番号表示 (for Viewer) (0:off 1:on) set Option(time) 0 ;# 時間表示 (0:off 1:on) set Option(timemode) 1 ;# 時間の表示方法 (0: 時刻 1:経過時間) set Option(pathtype) 1 ;# パスの形式 (0:絶対パス 1:相対パス) set Option(htmlcolor) 0 ;# HTML 出力時の文字色 (0:モノクロ 1:カラー) set Option(htmlfont) 0 ;# HTML 出力時の文字の大きさ (0:普通 1:大) set Option(viewersize) 0 ;# Viewer サイズ (0:640x480 1:800x600) set Option(vredraw) 0 ;# Viewer の自動再描画 (0:off 1:on) set Option(saveoptions) 1 ;# オプションの保存 (0:off 1:on) set Option(background) {} ;# 背景 set Option(bgtype) 0 ;# 背景の表示方法 (0:通常 1:背景を埋める) set Option(titletype) 0 ;# タイトルの形式 (0 - 1) set Option(pointer) normal ;# ポインタの名前 set Option(pointerfg) white ;# ポインタの前景色 set Option(pointerbg) black ;# ポインタの背景色 set Option(penleft) white ;# 左のペンの色 set Option(penright) red ;# 右のペンの色 set Option(backup) 1 ;# バックアップファイル作成 (0:しない 1:する) set Option(startpage) {} set Option(LANG) jpn ;# set filename "$env(HOME)/.ewipe" if {[file exists $filename] != 1} {return} set file [open $filename r] while {![eof $file]} { set str "[gets $file]" if {$str == "startpage:"} { set err 1 while {![eof $file]} { set str "[gets $file]" if {$str == ":end"} {set err 0; break} append Option(startpage) "$str\n" } if {$err == 1} { set Option(startpage) {} } } elseif {$str == "option:"} { set err 1 while {![eof $file]} { set str "[gets $file]" if {$str == ":end"} {set err 0; break} setoption $str } } } close $file } # オプション設定 proc setoption {str} { global Option set str0 [lindex $str 0] set str1 [lindex $str 1] switch $str0 { lang { if {$str1 == "jpn" || $str1 == "eng"} { set Option(lang) $str1 } } pagen { if {$str1 == 0 || $str1 == 1} { set Option(pagen) $str1 } } time { if {$str1 == 0 || $str1 == 1} { set Option(time) $str1 } } timemode { if {$str1 == 0 || $str1 == 1} { set Option(timemode) $str1 } } pathtype { if {$str1 == 0 || $str1 == 1} { set Option(pathtype) $str1 } } htmlcolor { if {$str1 == 0 || $str1 == 1} { set Option(htmlcolor) $str1 } } htmlfont { if {$str1 == 0 || $str1 == 1} { set Option(htmlfont) $str1 } } viewersize { if {$str1 == 0 || $str1 == 1} { set Option(viewersize) $str1 } } vredraw { if {$str1 == 0 || $str1 == 1} { set Option(vredraw) $str1 } } vredraw { if {$str1 == 0 || $str1 == 1} { set Option(saveoptions) $str1 } } background { set Option(background) $str1 } bgtype { if {$str1 == 0 || $str1 == 1} { set Option(bgtype) $str1 } } titletype { if {$str1 == 0 || $str1 == 1} { set Option(titletype) $str1 } } pointer { set Option(pointer) $str1 } pointerfg { set Option(pointerfg) $str1 } pointerbg { set Option(pointerbg) $str1 } penleft { set Option(penleft) $str1 } penright { set Option(penright) $str1 } backup { if {$str1 == 0 || $str1 == 1} { set Option(backup) $str1 } } } } # ビューウィンドウ表示 proc call_viewer {mode} { global Option global Viewmode global cp if {$mode == "view"} { wm withdraw . if {[winfo exists .view] == 0} { viewer $cp } else { view_showcanvas $cp } } elseif {$mode == "normal"} { if {$Viewmode == 0} { if {[winfo exists .view] == 0} { viewer $cp } else { view_showcanvas $cp } } } elseif {$mode == "pagen"} { if {[winfo exists .view] == 1} { if {$Option(pagen) == 1} { set Option(pagen) 0 } else { set Option(pagen) 1 } show_pagen } } elseif {$mode == "time"} { if {[winfo exists .view] == 1} { if {$Option(time) == 1} { set Option(time) 0 } else { set Option(time) 1 } toggle_time } } } # 新規作成 proc new {} { global filename global docpages global docpagesorg global message global Option if {$docpages != $docpagesorg} { set result [tk_dialog .d New $message(load) warning \ 0 $message(ok) $message(no)] if {$result == 1} {return} } set filename {} wm title . "EWIPE" init changelang $Option(lang) changesize if {[winfo exists .view] == 1} { resetview 0 } } # 読込み proc load {} { global filename global filedir global docpages global docpagesorg global maxp global cursor global mode global message global pwd global Option if {$docpages != $docpagesorg} { set result [tk_dialog .d Load $message(load) warning \ 0 $message(ok) $message(no)] if {$result == 1} {return} } set oldname $filename set filename [fileDialog . Load open wipe $pwd {}] if {$filename == {}} { set filename $oldname return } set filedir [file dirname $filename] init readfile set maxp [llength $docpages] changelang $Option(lang) changesize if {[winfo exists .view] == 1} { resetview 0 } } # 保存 proc save {} { global docpages global docpagesorg global filename global message global pwd global Option set oldname $filename if {$filename == {}} {set filename $pwd} set filename [fileDialog . Save save wipe $filename *.ewp] if {$filename == {}} { set filename $oldname return 0 } if {[file exists $filename] && $Option(backup) == 1} { exec cp $filename $filename~ } set file [open $filename w] output $file close $file wm title . "EWIPE - $filename" set docpagesorg $docpages return 1 } # 初期化 proc init {} { global docpages global docpagesorg global cp global maxp global cursor global mode global clip global Option set cp 0 set cursor {} set clip(line) {} set clip(page) {} ctrlbutton disabled readdotfile if {$Option(startpage) == {}} { set docpages {} } else { set docpages $Option(startpage) } set docpagesorg $docpages set maxp [llength $docpages] set mode page } # 出力 proc output {fd} { global commandlist global docpages global Option if {$Option(saveoptions) == 1} { puts $fd "option:" puts $fd " lang $Option(lang)" puts $fd " pagen $Option(pagen)" puts $fd " time $Option(time)" puts $fd " timemode $Option(timemode)" puts $fd " pathtype $Option(pathtype)" puts $fd " htmlcolor $Option(htmlcolor)" puts $fd " htmlfont $Option(htmlfont)" puts $fd " viewersize $Option(viewersize)" puts $fd " vredraw $Option(vredraw)" puts $fd " saveoptions $Option(saveoptions)" puts $fd " background $Option(background)" puts $fd " bgtype $Option(bgtype)" puts $fd " titletype $Option(titletype)" puts $fd " pointer $Option(pointer)" puts $fd " pointerfg $Option(pointerfg)" puts $fd " pointerbg $Option(pointerbg)" puts $fd " penleft $Option(penleft)" puts $fd " penright $Option(penright)" puts $fd ":end\n" } foreach i $docpages { puts $fd "{" foreach j $i { set str0 [lindex $j 0] if {[lsearch $commandlist $str0] != -1} { set str1 [lindex $j 1] set str2 [lindex $j 2] set str3 [lindex $j 3] if {$str3 != {}} { set str $str0 lappend str $str1 lappend str $str2 lappend str $str3 puts $fd " \{$str\}" } elseif {$str2 != {}} { set str $str0 lappend str $str1 lappend str $str2 puts $fd " \{$str\}" } else { set str $str0 lappend str $str1 puts $fd " \{$str\}" } } else { puts $fd " {$j}" } } puts $fd "}\n" } } # HTML 出力 proc outputHTML {} { global commandlist global docpages global message global Option global pwd set htmlfile [fileDialog . "Save as HTML" save html $pwd *.html] if {$htmlfile == {}} { return 0 } if {$Option(lang) == "jpn"} { set contents "目次" set next "次ページ" set prev "前ページ" } elseif {$Option(lang) == "eng"} { set contents "Table of Contents" set next "next" set prev "prev" } set list [split [string trim $htmlfile "/"] "/"] set s [expr [llength $list] - 1] set file [split [lindex $list $s] "."] set htmlname [lindex $file 0] set fd [open $htmlfile w] puts $fd "\n" puts $fd " $htmlname" puts $fd "" puts $fd "" } else { puts $fd ">" } puts $fd "" puts $fd "

$contents

" puts $fd "
    " set page 1 foreach i $docpages { set label [lindex [lindex $i 0] 0] if {[lsearch $commandlist $label] != -1} { if {$label != "text" && $label != "textbox"} { set title [lindex [lindex $i 0] 1] } else { set title {} } } else { set title {} } puts $fd "
  1. $title" incr page } puts $fd "
" puts $fd "
\n

" puts $fd "

" puts $fd " \[$next\]" puts $fd "
\n

" set maxpage [llength $docpages] set page 1 foreach i $docpages { puts $fd "" puts $fd "


\n

" if {$Option(htmlcolor) == 1} { puts $fd "" } else { puts $fd "" } puts $fd "

page $page / $maxpage
" puts $fd "\n

" if {$Option(htmlfont) == 1} { puts $fd "\n

" } foreach j $i { if {[lindex $j 0] == "move"} { set j [lindex $j 1] } set str0 [lindex [lindex $j 0] 0] set str1 [lindex $j 1] set str2 [lindex $j 2] set colormode 0 if {$Option(htmlcolor) == 1} { set color [name2rgb $str2 r] if {$color != -1} { set colormode 1 puts $fd "" } } switch $str0 { title { puts $fd "

" if {$Option(htmlcolor) == 1} { puts $fd "" } puts $fd "

$str1

" if {$str2 != {}} { if {$Option(htmlfont) == 1} { puts $fd "

$str2

" } else { puts $fd "

$str2

" } } if {$Option(htmlcolor) == 1} { puts $fd "
" } puts $fd "
" } item { puts $fd "
    " puts $fd "
  • $str1" puts $fd "
" } subitem { puts $fd "
    " puts $fd "
      " puts $fd "
    • $str1" puts $fd "
    " puts $fd "
" } subsubitem { puts $fd "
    " puts $fd "
      " puts $fd "
        " puts $fd "
      • $str1" puts $fd "
      " puts $fd "
    " puts $fd "
" } subsubsubitem { puts $fd "
    " puts $fd "
      " puts $fd "
        " puts $fd "
          " puts $fd "
        • $str1" puts $fd "
        " puts $fd "
      " puts $fd "
    " puts $fd "
" } left { puts $fd "$str1

" } center { puts $fd "

" puts $fd " $str1

" puts $fd "

" } right { puts $fd "
" puts $fd " $str1" puts $fd "
" } pict { puts $fd "
" puts $fd " \"$str1\"

" puts $fd "
" } animation { set str1 [lindex $str1 0] puts $fd "
" puts $fd " \"$str1\"

" puts $fd "
" } pp { puts $fd "$str1

" } rp { puts $fd "

" puts $fd " $str1" puts $fd "
" } symbol { if {$str1 == "uparrow"} { puts $fd "

" } elseif {$str1 == "downarrow"} { puts $fd "

" } elseif {$str1 == "updownarrow"} { puts $fd "

↑↓

" } elseif {$str1 == "cdot"} { puts $fd "

" } elseif {$str1 == "vdots"} { puts $fd "

" } } text { puts $fd "

"
		    set str1 [string trim $str1 "\n"]
		    set strlist [split $str1 "\n"]
		    foreach i $strlist {
			puts $fd "$i
" } puts $fd "
" puts $fd "

" } textbox { puts $fd "

"
		    set str1 [string trim $str1 "\n"]
		    set strlist [split $str1 "\n"]
		    foreach i $strlist {
			puts $fd "  $i
" } puts $fd "
" puts $fd "

" } message { set str1 [string trim $str1 "\n"] set strlist [split $str1 "\n"] foreach i $strlist { puts $fd " $i
" } puts $fd "

" } label { puts $fd "

" puts $fd " $str2

" puts $fd "

" } table { puts $fd "
" set define [lindex $str1 0] set define [view_cutcode $define] set col [expr [llength $define] * 2 + 1] set line [llength $str1] for {set i 0} {$i < [llength $define]} {incr i} { switch -exact [lindex $define $i] { l {set align($i) "left"} c {set align($i) "center"} r {set align($i) "right"} } } for {set i 2} {$i < $line} {incr i 2} { puts $fd " " set textlist [lindex $str1 $i] if {$textlist != {}} { for {set j 1} {$j < $col} {incr j 2} { set column 1 set nextj $j if {[lindex $textlist [expr $j + 1]] == "_"} { for {set k [expr $j + 1]} \ {[lindex $textlist $k] == "_" && $k < $col} \ {incr k 2} { incr column } set nextj [expr $k + 1] } set data [lindex $textlist $j] set pos [expr $j / 2] puts $fd " " set j $nextj } } puts $fd " " } puts $fd "
$data
" } } if {$colormode == 1} { puts $fd "
" } } if {$Option(htmlfont) == 1} { puts $fd "
\n

" } puts $fd "

\n


\n

" puts $fd "

" puts $fd " \[ $prev \]" puts $fd " \[ $contents \]" if {$page < $maxpage} { puts $fd " \[ $next \]" } puts $fd "
" incr page puts $fd "

" } puts $fd "\n" close $fd } # mgp 形式データ出力 proc outputMGP {} { global commandlist global docpages global message global Option global pwd set mgpfile [fileDialog . "Save as MGP" save mgp $pwd *.mgp] if {$mgpfile == {}} { return 0 } set list [split [string trim $mgpfile "/"] "/"] set s [expr [llength $list] - 1] set file [split [lindex $list $s] "."] set mgpname [lindex $file 0] set fd [open $mgpfile w] kanji outputCode $fd JIS puts $fd "%% This file is generated by EWIPE" puts $fd "%%" puts $fd {%include "default.mgp"} set maxpage [llength $docpages] set page 1 foreach i $docpages { puts $fd "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" puts $fd "%page" puts $fd {} set str [lindex $i 0] if {[lindex [lindex $str 0] 0] == "title"} { puts $fd [lindex $str 1] puts $fd {} if {[lindex $str 2] != {}} { puts $fd {} puts $fd [lindex $str 2] } } else { puts $fd {} puts $fd {} } set i [lreplace $i 0 0] foreach j $i { set str0 [lindex [lindex $j 0] 0] set str1 [lindex $j 1] set str2 [lindex $j 2] set str3 [lindex $j 3] switch $str0 { title { puts $fd "%center" puts $fd $str1 if {$str2 != {}} { puts $fd $str2 } puts $fd "%left" } item { e2m_colorsize $str2 $str3 $fd puts $fd "\t$str1" e2m_endcolorsize $fd } subitem { e2m_colorsize $str2 $str3 $fd puts $fd "\t\t$str1" e2m_endcolorsize $fd } subsubitem { e2m_colorsize $str2 $str3 $fd puts $fd "\t\t\t$str1" e2m_endcolorsize $fd } subsubsubitem { e2m_colorsize $str2 $str3 $fd puts $fd " - $str1" e2m_endcolorsize $fd } left { e2m_colorsize $str2 $str3 $fd puts $fd "%left" puts $fd $str1 e2m_endcolorsize $fd } center { e2m_colorsize $str2 $str3 $fd puts $fd "%center" puts $fd $str1 puts $fd "%left" e2m_endcolorsize $fd } right { e2m_colorsize $str2 $str3 $fd puts $fd "%right" puts $fd $str1 puts $fd "%left" e2m_endcolorsize $fd } pict { puts $fd "%center" puts $fd "%IMAGE \"$str1\"" puts $fd "%left" } pp { e2m_colorsize $str2 $str3 $fd puts $fd "%left" puts $fd $str1 e2m_endcolorsize $fd } rp { e2m_colorsize $str2 $str3 $fd puts $fd "%right" puts $fd $str1 puts $fd "%left" e2m_endcolorsize $fd } symbol { if {$str1 == "uparrow"} { puts $fd "%center" puts $fd "↑" puts $fd "%left" } elseif {$str1 == "downarrow"} { puts $fd "%center" puts $fd "↓" puts $fd "%left" } elseif {$str1 == "updownarrow"} { puts $fd "%center" puts $fd "↑↓" puts $fd "%left" } elseif {$str1 == "cdot"} { puts $fd "%center" puts $fd "・" puts $fd "%left" } elseif {$str1 == "vdots"} { puts $fd "%center" puts $fd ":" puts $fd "%left" } } text { puts $fd "%left" puts $fd $str1 } textbox { puts $fd "%left" puts $fd $str1 } table { } animation { puts $fd "%center" set count 0 foreach k $str1 { if {$count == 0} { puts $fd "%mark, image \"$k\"" puts $fd {} incr count } elseif {$count == 1} { puts $fd "%pause, again, mark, image \"$k\"" puts $fd {} incr count } else { if {$str2 == "-1"} { puts $fd "%pause, again, mark, image \"$k\"" } else { puts $fd "%again, mark, image \"$k\"" } puts $fd {} incr count } } puts $fd "%left" } move { e2m_colorsize [lindex $str1 2] [lindex $str1 3] $fd if {$str2 == "nw" || $str2 == "w" || $str2 == "sw" || \ $str2 == "n" || $str2 == "s"} { puts $fd "%lcutin" } else { puts $fd "%rcutin" } puts $fd [lindex $str1 1] e2m_endcolorsize $fd } pause { puts $fd "%pause" } exec { puts $fd "%xsystem \"$str1\"" } figure { } label { } message { } cleft { } prog { } } } } close $fd } # フォントサイズ、色設定 proc e2m_colorsize {color size fd} { if {$size != ""} { set fsize [expr [lindex $size 0] / 3] } else { set fsize 7 } if {$color == ""} { set color white } puts $fd "%SIZE $fsize,FORE \"$color\"" } # デフォルト色設定 proc e2m_endcolorsize {fd} { puts $fd "%SIZE 7,FORE \"white\"" } # 終了 proc exitewipe {} { global docpages global docpagesorg global message global view_ps global tcl_platform set s 1 if {$docpages != {} && $docpages != $docpagesorg} { set result [tk_dialog .d Exit $message(exit) warning \ 0 $message(save) $message(no) $message(cancel)] if {$result == 0} {set s [save]} if {$result == 1} {set s 1} if {$result == 2} {return} } if {$s == 1} { if {$tcl_platform(platform) != "windows"} { if {[info exists view_ps] == 1} { foreach i $view_ps(id) { if {[lsearch [exec ps] [lindex $view_ps(id) $i]] == -1} { exec kill $i } } } } exit } } # ラベル作成 proc makelabel {label} { global docpages global cp global maxp global cursor global newcursor set cursor $newcursor set curpage [lindex $docpages $cp] set curpage [linsert $curpage $cursor "$label {}"] if {[lindex $docpages $cp] != {}} { set docpages [lreplace $docpages $cp $cp $curpage] } else { lappend docpages $curpage incr maxp } if {$label != "pause"} { resetpage edittext } else { insertpause } } # テキスト入力 proc inputtext {x y m} { global docpages global cp global maxp global lnum global cursor global newcursor global scrY global Option global tcl_platform if {[winfo exists .fe] == 1} {return} if {$y != {}} { set x [.fc.c canvasx $x] set y [.fc.c canvasy $y] set wy $lnum for {set i 0} {$i < $lnum} {incr i} { if {$y < $scrY($i)} { set wy $i break } } set newcursor $wy } else { if {$cursor == {}} { set newcursor 0 } else { if {$m == 1} { set newcursor [expr $cursor + 1] } else { set newcursor $cursor } } } if {$newcursor == 0} { makelabel title } else { set x [winfo pointerx .] set y [winfo pointery .] .pmml post [expr $x - 5] [expr $y - 5] focus .pmml if {$tcl_platform(platform) == "windows"} { update tkwait visibility .pmml } bind .pmml { .pmml unpost } } } # edit ボタン処理 proc edittext {} { global cursor if {[lindex [.fc.c.lb1($cursor) configure -text] 4] == " "} { return } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "title"} { changetitle } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "pict"} { changefile } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "symbol"} { update popupmenu symbol } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "table"} { changetable } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "animation"} { changeanimation } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "pause"} { insertpause } else { changetext } } # テキスト変更 proc changetext {} { global docpages global cp global cursor global message global str2 str3 global deffonts global work set curpage [lindex $docpages $cp] set line [lindex $curpage $cursor] if {[lindex $line 0] == "move"} { set text [lindex [lindex $line 1] 1] } else { set text [lindex $line 1] } toplevel .fe wm title .fe edit text .fe.tt -width 56 -height 5 frame .fe.fb1 set str2 [lindex $line 2] if {$str2 == {}} { set str2 default } set str3 [lindex [lindex $line 3] 0] if {$str3 == {}} { set str3 default } tk_optionMenu .fe.fb1.mc str2 default white yellow green orange red \ skyblue gray eval [concat {tk_optionMenu .fe.fb1.mf str3 default} $deffonts] frame .fe.fb2 button .fe.fb2.bo -text $message(ok) -command { set str1 [.fe.tt get 1.0 "end - 1 chars"] set str1 [string trim $str1 "\n"] destroy .fe set curpage [lindex $docpages $cp] set line [lindex $curpage $cursor] if {[lindex $line 0] == "move"} { set str0 [lindex [lindex $line 1] 0] set strd {} lappend strd $str0 lappend strd $str1 set str2 [lindex [lindex $line 1] 2] if {$str2 != {}} { lappend strd $str2 } set str3 [lindex [lindex $line 1] 3] if {$str3 != {}} { lappend strd $str3 } set str [lindex $line 0] lappend str $strd lappend str [lindex $line 2] set curpage [lreplace $curpage $cursor $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] } else { set str0 [lindex $line 0] set str {} lappend str $str0 lappend str $str1 # set str2 [lindex $line 2] if {$str2 != "default"} { lappend str $str2 } else { if {$str3 != "default"} { lappend str {} } } # set str3 [lindex $line 3] if {$str3 != "default"} { lappend str $str3 } set curpage [lreplace $curpage $cursor $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] if {$str3 != "default"} { set work(fonts) $str3 changefont {} } } ctrlbutton normal ctrlcobutton $cursor resetpage } button .fe.fb2.bc -text $message(cancel) -command { destroy .fe ctrlbutton normal ctrlcobutton $cursor resetpage } pack .fe.fb1.mc .fe.fb1.mf -side left pack .fe.fb2.bo .fe.fb2.bc -side left if {[lindex $line 0] == "move"} { pack .fe.tt .fe.fb2 } else { pack .fe.fb1 .fe.tt .fe.fb2 } .fe.tt insert 1.0 $text wm withdraw .fe update idletasks set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2] set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2] wm geometry .fe +$x+$y wm deiconify .fe focus .fe.tt update grab .fe tkwait window .fe } # タイトル変更 proc changetitle {} { global docpages global cp global cursor global message set curpage [lindex $docpages $cp] set text1 [lindex [lindex $curpage $cursor] 1] set text2 [lindex [lindex $curpage $cursor] 2] toplevel .fe wm title .fe title frame .fe.tt frame .fe.ts label .fe.tt.lb -text " title " label .fe.ts.lb -text "sub title" text .fe.tt.en -width 48 -height 2 text .fe.ts.en -width 48 -height 2 frame .fe.fb button .fe.fb.bo -text $message(ok) -command { set str1 [.fe.tt.en get 1.0 "end - 1 chars"] set str2 [.fe.ts.en get 1.0 "end - 1 chars"] set str1 [string trim $str1 "\n"] set str2 [string trim $str2 "\n"] destroy .fe set curpage [lindex $docpages $cp] if {$str2 == {}} { set str title lappend str $str1 set curpage [lreplace $curpage $cursor $cursor $str] } else { set str title lappend str $str1 lappend str $str2 set curpage [lreplace $curpage $cursor $cursor $str] } set docpages [lreplace $docpages $cp $cp $curpage] ctrlbutton normal ctrlcobutton $cursor resetpage } button .fe.fb.bc -text $message(cancel) -command { destroy .fe ctrlbutton normal ctrlcobutton $cursor resetpage } pack .fe.tt.lb .fe.tt.en -side left pack .fe.ts.lb .fe.ts.en -side left pack .fe.fb.bo .fe.fb.bc -side left pack .fe.tt .fe.ts .fe.fb .fe.tt.en insert 1.0 $text1 .fe.ts.en insert 1.0 $text2 wm withdraw .fe update idletasks set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2] set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2] wm geometry .fe +$x+$y wm deiconify .fe focus .fe.tt.en update grab .fe tkwait window .fe } # ファイル変更 proc changefile {} { global filedir global docpages global cp global cursor global message global filedir global Option global pwd set curpage [lindex $docpages $cp] toplevel .fe wm title .fe pict entry .fe.en -width 60 frame .fe.fb button .fe.fb.bo -text $message(ok) -command { set str1 [.fe.en get] destroy .fe if {$str1 == {}} {return} set curpage [lindex $docpages $cp] set str0 [lindex [lindex $curpage $cursor] 0] set str $str0 lappend str $str1 set curpage [lreplace $curpage $cursor $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] resetpage ctrlbutton normal ctrlcobutton $cursor } button .fe.fb.bb -text $message(browse) -command { set initfile [.fe.en get] if {[file exists $initfile] == 0} { set initfile {} } else { set afile [file tail $initfile] cd [file dirname $initfile] set adir [pwd] cd $pwd set initfile $adir/$afile } set fname [fileDialog .fe "Select GIF File" open image $initfile {}] if {$fname != ""} { if {$Option(pathtype) == 1} { set fname [relativepath $filedir $fname] } .fe.en delete 0 end .fe.en insert 0 $fname } } button .fe.fb.bc -text $message(cancel) -command { destroy .fe } pack .fe.fb.bo .fe.fb.bb .fe.fb.bc -side left pack .fe.en .fe.fb set text [lindex [lindex $curpage $cursor] 1] .fe.en insert 0 $text wm withdraw .fe update idletasks set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2] set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2] wm geometry .fe +$x+$y wm deiconify .fe focus .fe.en update grab .fe tkwait window .fe } # animation 設定 proc changeanimation {} { global filedir global docpages global cp global cursor global message global filedir global Option global pwd set curpage [lindex $docpages $cp] toplevel .fe wm title .fe animation entry .fe.en -width 60 frame .fe.fb button .fe.fb.bo -text $message(ok) -command { set str1 [.fe.en get] destroy .fe if {$str1 == {}} {return} set curpage [lindex $docpages $cp] set str0 [lindex [lindex $curpage $cursor] 0] set str $str0 lappend str $str1 set str2 [lindex [lindex $curpage $cursor] 2] if {$str2 != {}} { lappend str $str2 } set curpage [lreplace $curpage $cursor $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] resetpage ctrlbutton normal ctrlcobutton $cursor } button .fe.fb.bb -text $message(browse) -command { set initfile [lindex [.fe.en get] 0] if {[file exists $initfile] == 0} { set initfile {} } else { set afile [file tail $initfile] cd [file dirname $initfile] set adir [pwd] cd $pwd set initfile $adir/$afile } set fname [fileDialog .fe "Select GIF File" open image $initfile {}] if {$fname != ""} { if {$Option(pathtype) == 1} { set fname [relativepath $filedir $fname] } .fe.en insert end "$fname " } } button .fe.fb.bc -text $message(cancel) -command { destroy .fe } pack .fe.fb.bo .fe.fb.bb .fe.fb.bc -side left pack .fe.en .fe.fb set text [lindex [lindex $curpage $cursor] 1] .fe.en insert 0 $text wm withdraw .fe update idletasks set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2] set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2] wm geometry .fe +$x+$y wm deiconify .fe focus .fe.en update grab .fe tkwait window .fe } # pause 挿入 proc insertpause {} { global docpages global cp global cursor set curpage [lindex $docpages $cp] set str pause set curpage [lreplace $curpage $cursor $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] resetpage ctrlbutton normal ctrlcobutton $cursor } # 選択メニュー表示 proc popupmenu {select} { global tcl_platform set x [winfo pointerx .] set y [winfo pointery .] switch $select { label { .pml post $x $y focus .pml if {$tcl_platform(platform) == "windows"} { update tkwait visibility .pml } bind .pml { .pml unpost } } color { .pmc post $x $y focus .pmc if {$tcl_platform(platform) == "windows"} { update tkwait visibility .pmc } bind .pmc { .pmc unpost } } font { .pmf post $x $y focus .pmf if {$tcl_platform(platform) == "windows"} { update tkwait visibility .pmf } bind .pmf { .pmf unpost } } symbol { .pms post $x $y focus .pms if {$tcl_platform(platform) == "windows"} { update tkwait visibility .pms } bind .pms { .pms unpost } } attr { .pma post $x $y focus .pma if {$tcl_platform(platform) == "windows"} { update tkwait visibility .pma } bind .pma { .pma unpost } } } } # 表作成 proc changetable {} { global docpages global cp global cursor set curpage [lindex $docpages $cp] set str1 [edittable [lindex [lindex $curpage $cursor] 1]] if {$str1 == {}} {return} set str table lappend str $str1 set curpage [lreplace $curpage $cursor $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] resetpage ctrlbutton normal ctrlcobutton $cursor } # ファイルダイアログ proc fileDialog {w title operation type initfile ext} { set file "" if {$type == "image"} { set types { {"Image Files" {.gif} } {"All Files" * } } } elseif {$type == "html"} { set types { {"HTML Files" {.html .htm} } {"All Files" * } } } elseif {$type == "mgp"} { set types { {"MGP Files" {.mgp} } {"All Files" * } } } elseif {$type == "wipe"} { set types { {"EWIPE Files" {.ewp .wipe} } {"All Files" * } } } elseif {$type == {}} { set types { {"All Files" * } } } if {[file exists $initfile] == 1} { if {[file isfile $initfile]} { set initd [file dirname $initfile] if {$initd == "."} {set initd {}} set initf [file tail $initfile] } else { set initd $initfile set initf $ext } } else { set initd [file dirname $initfile] if {$initd == "."} {set initd {}} set initf [file tail $initfile] } if {$operation == "open"} { set file [tk_getOpenFile -title $title -filetypes $types -parent $w \ -initialdir $initd] } elseif {$operation == "save" } { set file [tk_getSaveFile -title $title -filetypes $types -parent $w \ -initialdir $initd -initialfile $initf] } if {$file != ""} { return $file } } # ラベル変更 proc changelabel {x} { global commandlist global docpages global cp global cursor .fc.c.lb1($cursor) configure -text $x set curpage [lindex $docpages $cp] set str [lindex [lindex $curpage $cursor] 0] if {[lsearch $commandlist $str] != -1} { if {$str != $x} { set pattern [checklabel $str $x] } else { set pattern 2 } set str1 [lindex [lindex $curpage $cursor] 1] set str2 [lindex [lindex $curpage $cursor] 2] set str3 [lindex [lindex $curpage $cursor] 3] if {$pattern == 0} { set str $x lappend str {} } elseif {$pattern == 1} { set str $x lappend str $str1 } elseif {$pattern == 2} { set str $x lappend str $str1 if {$str2 != {}} { lappend str $str2 } if {$str3 != {}} { lappend str $str3 } } } else { set str $x lappend str {} } set curpage [lreplace $curpage $cursor $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] resetpage ctrlbutton normal ctrlcobutton $cursor } # ラベルチェック proc checklabel {old new} { if {$old == "title" || $old == "textbox"} { if {$new == "table" || $new == "pict" || $new == "symbol" \ || $new == "animation"} { return 0 } else { return 1 } } elseif {$old == "table" || $old == "pict"|| $old == "symbol" \ || $old == "animation"} { return 0 } else { if {$new == "table" || $new == "pict" || $new == "symbol" \ || $new == "animation"} { return 0 } elseif {$new == "title" || $new == "textbox"} { return 1 } else { return 2 } } } # ラベル詳細設定 proc setlabelopt {} { global docpages global cp global cursor global message set curpage [lindex $docpages $cp] set line [lindex $curpage $cursor] set text [lindex [lindex $line 0] 1] toplevel .fe wm title .fe label text .fe.tt -width 40 -height 1 frame .fe.fb button .fe.fb.bo -text $message(ok) -command { set str1 [.fe.tt get 1.0 "end - 1 chars"] set str1 [string trim $str1 "\n"] destroy .fe set curpage [lindex $docpages $cp] set line [lindex $curpage $cursor] set str0 [lindex [lindex $line 0] 0] set str $str0 lappend str $str1 set line [lreplace $line 0 0 $str] set curpage [lreplace $curpage $cursor $cursor $line] set docpages [lreplace $docpages $cp $cp $curpage] ctrlbutton normal ctrlcobutton $cursor resetpage } button .fe.fb.bd -text $message(default) -command { destroy .fe set curpage [lindex $docpages $cp] set line [lindex $curpage $cursor] set str [lindex [lindex $line 0] 0] set line [lreplace $line 0 0 $str] set curpage [lreplace $curpage $cursor $cursor $line] set docpages [lreplace $docpages $cp $cp $curpage] ctrlbutton normal ctrlcobutton $cursor resetpage } button .fe.fb.bc -text $message(cancel) -command { destroy .fe ctrlbutton normal ctrlcobutton $cursor resetpage } pack .fe.fb.bo .fe.fb.bd .fe.fb.bc -side left pack .fe.tt .fe.fb .fe.tt insert 1.0 $text wm withdraw .fe update idletasks set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2] set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2] wm geometry .fe +$x+$y wm deiconify .fe focus .fe.tt update grab .fe tkwait window .fe } # アイテム変更 proc changeitem {x} { global docpages global cp global cursor set curpage [lindex $docpages $cp] set str [lindex [lindex $curpage $cursor] 0] set str0 [lindex [lindex $curpage $cursor] 0] set str1 [lindex [lindex $curpage $cursor] 2] set str $str0 lappend str $x if {$str1 != {}} { lappend str $str1 } set curpage [lreplace $curpage $cursor $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] resetpage ctrlbutton normal ctrlcobutton $cursor } # 文字色変更 proc changecolor {x} { global docpages global cp global cursor set curpage [lindex $docpages $cp] set color [lindex [lindex $curpage $cursor] 2] if {$color == {}} { set color white } if {$x == "etc"} { set x [tk_chooseColor -initialcolor $color] } if {$x == {}} return set str0 [lindex [lindex $curpage $cursor] 0] set str1 [lindex [lindex $curpage $cursor] 1] set str3 [lindex [lindex $curpage $cursor] 3] if {$x == "white" && $str3 == {}} { set str {} lappend str $str0 lappend str $str1 set curpage [lreplace $curpage $cursor $cursor $str] } else { set str {} lappend str $str0 lappend str $str1 lappend str $x if {$str3 != {}} { lappend str $str3 } set curpage [lreplace $curpage $cursor $cursor $str] } set docpages [lreplace $docpages $cp $cp $curpage] resetpage ctrlbutton normal ctrlcobutton $cursor } # フォントチェック proc checkfont {} { global docpages global cp global cursor global work set curpage [lindex $docpages $cp] set str0 [lindex [lindex $curpage $cursor] 0] set str3 [lindex [lindex $curpage $cursor] 3] if {$str3 == {}} { if {$str0 == "text" || $str0 == "textbox"} { set work(fonts) 16 set work(fontt) rm set work(kfonts) 16 set work(kfontt) mc } else { set work(fonts) 24 set work(fontt) rm set work(kfonts) 24 set work(kfontt) mc } } else { set work(fonts) [lindex $str3 0] set work(fontt) [lindex $str3 1] set work(kfonts) [lindex $str3 2] set work(kfontt) [lindex $str3 3] } } # フォント変更 proc changefont {x} { global docpages global cp global cursor global work global Str global Str2 global message set curpage [lindex $docpages $cp] set fontlist [lindex [lindex $curpage $cursor] 3] set work(fontt) [lindex $fontlist 1] set work(kfontt) [lindex $fontlist 3] set work(fontsold) [lindex $fontlist 0] set work(kfontsold) [lindex $fontlist 2] if {$x == "etc"} { toplevel .fe wm title .fe font frame .fe.en1 frame .fe.en2 label .fe.en1.lb -text "ascii font " label .fe.en2.lb -text "kanji font " entry .fe.en1.en -width 40 entry .fe.en2.en -width 40 frame .fe.fb button .fe.fb.bo -text $message(ok) -command { set Str [.fe.en1.en get] set Str2 [.fe.en2.en get] if {$Str == {} && $Str2 == {}} {return} destroy .fe } button .fe.fb.bc -text $message(cancel) -command { set Str {} set Str2 {} destroy .fe } pack .fe.en1.lb .fe.en1.en -side left pack .fe.en2.lb .fe.en2.en -side left pack .fe.fb.bo .fe.fb.bc -side left pack .fe.en1 .fe.en2 .fe.fb .fe.en1.en delete 0 end if {$work(fontsold) == "u"} { .fe.en1.en insert 0 $work(fontt) } .fe.en2.en delete 0 end if {$work(kfontsold) == "u"} { .fe.en2.en insert 0 $work(kfontt) } wm withdraw .fe update idletasks set wx [expr [winfo x .] + ([winfo width .] - \ [winfo reqwidth .fe]) / 2] set wy [expr [winfo y .] + ([winfo height .] - \ [winfo reqheight .fe])/2] wm geometry .fe +$wx+$wy wm deiconify .fe update focus .fe.en1.en grab .fe tkwait window .fe } else { set Str def } if {$Str == {} && $Str2 == {}} { return } else { if {$x == "etc"} { set work(fonts) u set work(fontt) $Str set work(kfonts) u set work(kfontt) $Str2 } else { set work(fontt) rm set work(kfonts) $work(fonts) set work(kfontt) mc } } set str0 [lindex [lindex $curpage $cursor] 0] set str1 [lindex [lindex $curpage $cursor] 1] set str2 [lindex [lindex $curpage $cursor] 2] set changed 0 if {$str0 == "text" || $str0 == "textbox"} { if {$work(fonts) != 16} { set changed 1 } } else { if {$work(fonts) != 24} { set changed 1 } } if {$changed == 1} { set str3 "$work(fonts) $work(fontt) $work(kfonts) $work(kfontt)" set str {} lappend str $str0 lappend str $str1 if {$str2 == {}} {set str2 "white"} lappend str $str2 lappend str $str3 } else { set str {} lappend str $str0 lappend str $str1 if {$str2 != {} && $str2 != "white"} { lappend str $str2 } } set curpage [lreplace $curpage $cursor $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] resetpage ctrlbutton normal ctrlcobutton $cursor } # 属性変更 proc changeattr {x} { global docpages global cp global cursor set curpage [lindex $docpages $cp] set line [lindex $curpage $cursor] set str0 [lindex $line 0] if {$str0 == "move"} { set line [lindex $line 1] } if {$x != "none"} { set str0 [lindex $x 0] set str1 $line set str2 [lindex $x 1] set str $str0 lappend str $str1 lappend str $str2 } else { set str $line } set curpage [lreplace $curpage $cursor $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] resetpage ctrlbutton normal ctrlcobutton $cursor } # 背景選択 proc selectbg {} { global message global filedir global Option global pwd toplevel .fe wm title .fe background entry .fe.en -width 60 frame .fe.fb button .fe.fb.bo -text $message(ok) -command { set Option(background) [.fe.en get] destroy .fe changebg } button .fe.fb.bb -text $message(browse) -command { set initfile [.fe.en get] if {[file exists $initfile] == 0} { set initfile $pwd } else { set afile [file tail $initfile] cd [file dirname $initfile] set adir [pwd] cd $pwd set initfile $adir/$afile } set fname [fileDialog . "Select Background" open image $initfile {}] if {$fname != ""} { if {$Option(pathtype) == 1} { set fname [relativepath $filedir $fname] } .fe.en delete 0 end .fe.en insert 0 $fname } } button .fe.fb.bc -text $message(cancel) -command { destroy .fe } pack .fe.fb.bo .fe.fb.bb .fe.fb.bc -side left pack .fe.en .fe.fb .fe.en insert 0 $Option(background) wm withdraw .fe update idletasks set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2] set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2] wm geometry .fe +$x+$y wm deiconify .fe focus .fe.en update grab .fe tkwait window .fe } # 背景変更 proc changebg {} { global cp if {[winfo exists .view] == 1} { resetview $cp } } # 行削除・ページ削除 proc deleteline {} { global docpages global cp global maxp global cursor global mode global clip if {$mode == "page"} { set x $cursor set curpage [lindex $docpages $cp] set clip(line) [lindex $curpage $x] set curpage [lreplace $curpage $x $x] set docpages [lreplace $docpages $cp $cp $curpage] if {[lindex $docpages $cp] == {}} { set docpages [lreplace $docpages $cp $cp] incr maxp -1 if {$maxp == 0} { set cp 0 } elseif {$cp >= $maxp} { set cp [expr $maxp - 1] } } resetpage } elseif {$mode == "contents"} { set clip(page) [lindex $docpages $cursor] set docpages [lreplace $docpages $cursor $cursor] incr maxp -1 showtitle } } # 行ペースト proc pasteline {} { global docpages global lnum global cp global maxp global cursor global mode global clip if {$mode == "page"} { set curpage [lindex $docpages $cp] if {$clip(line) == {}} {return} set str $clip(line) set curpage [linsert $curpage $cursor $str] set docpages [lreplace $docpages $cp $cp $curpage] resetpage ctrlbutton normal ctrlcobutton $cursor } elseif {$mode == "contents"} { if {$clip(page) == {}} {return} set str $clip(page) set docpages [linsert $docpages $cursor $str] incr maxp showtitle } } # 行交換 proc exchangeline {s e} { global docpages global cp set curpage [lindex $docpages $cp] set sline [lindex $curpage $s] set eline [lindex $curpage $e] set curpage [lreplace $curpage $s $s] set curpage [linsert $curpage $s $eline] set curpage [lreplace $curpage $e $e] set curpage [linsert $curpage $e $sline] set docpages [lreplace $docpages $cp $cp $curpage] resetpage } # 移動 proc move {n} { global lnum global cursor global mode if {$mode == "page"} { if {$n == "up"} { if {$cursor == 0} {return} incr cursor -1 exchangeline [expr $cursor+1] $cursor } elseif {$n == "down"} { if {$cursor == [expr $lnum-1]} {return} incr cursor exchangeline [expr $cursor-1] $cursor } } elseif {$mode == "contents"} { if {$n == "up"} { if {$cursor == 0} {return} incr cursor -1 exchangepage [expr $cursor+1] $cursor } elseif {$n == "down"} { if {$cursor == [expr $lnum-1]} {return} incr cursor exchangepage [expr $cursor-1] $cursor } } } # ページ交換 proc exchangepage {s e} { global docpages global cp global cursor set spage [lindex $docpages $s] set epage [lindex $docpages $e] set docpages [lreplace $docpages $s $s] set docpages [linsert $docpages $s $epage] set docpages [lreplace $docpages $e $e] set docpages [linsert $docpages $e $spage] set cursor $e set cp $e showtitle } # ページ移動 proc movepage {s e} { global docpages global cp global cursor set spage [lindex $docpages $s] if {$s < $e} { set docpages [linsert $docpages $e $spage] set docpages [lreplace $docpages $s $s] set cursor [expr $e-1] set cp $cursor } else { set docpages [lreplace $docpages $s $s] set docpages [linsert $docpages $e $spage] set cursor $e set cp $cursor } showtitle } # ページ作成 proc createpage {m} { global docpages global cp global maxp global cursor if {[winfo exists .fe] == 1} {return} if {$maxp != 0} { if {$m == 1} { incr cp } lappend curpage "title {}" set docpages [linsert $docpages $cp $curpage] incr maxp } else { set curpage {} set curpage [linsert $curpage 0 "title {}"] lappend docpages $curpage incr maxp } ctrlbutton normal set cursor 0 resetpage ctrlbutton normal ctrlcobutton $cursor changetitle } # ページジャンプ proc jumppage {} { global cp global maxp global cursor global mode set err 0 set jp [.fb2.ep get] set jp [lindex [split $jp "/"] 0] if {[regexp {[a-z]+} $jp]} { set err 1 } set jp [string trimleft $jp 0] if {$jp == {}} {set jp 0} if {[llength $jp] > 3} { set err 1 } if {$err == 0} { set jp [expr $jp-1] } if {$jp >= 0 && $jp < $maxp && $err == 0} { set cp $jp if {$mode == "contents"} { .fb2.bi configure -state normal .fb2.ba configure -state normal .fb2.bn configure -state normal .fb2.bp configure -state normal .fb2.bt configure -text index -command showtitle set cursor {} set mode page ctrlbutton disabled } resetpage } else { resetpage } } # 次・前ページ表示 proc nextpage {n} { global cp global maxp global cursor if {$n == 1} { if {$cp < [expr $maxp-1]} { incr cp set cursor {} ctrlbutton disabled initpage showpage } } elseif {$n == -1} { if {$cp > 0} { incr cp -1 set cursor {} ctrlbutton disabled initpage showpage } } } # ページ再表示 proc resetpage {} { global view_skip set view_skip 1 initpage showpage } # ページ初期化 proc initpage {} { global lnum global cp global maxp .fb2.ep delete 0 end if {$maxp == 0} { .fb2.ep insert 0 "0/0" } else { .fb2.ep insert 0 "[expr $cp+1]/[expr $maxp]" } for {set i 0} {$i < $lnum} {incr i} { if {[winfo exists .fc.c.lb1($i)]} {destroy .fc.c.lb1($i)} if {[winfo exists .fc.c.lb2($i)]} {destroy .fc.c.lb2($i)} if {[winfo exists .fc.c.titletext]} {destroy .fc.c.titletext} } .fc.c delete all set lnum 0 focus . } # ウィンドウサイズ変更 proc changesize {} { global Option if {$Option(viewersize) == 1} { .fc.c configure -height 500 wm geometry . {} wm minsize . 590 580 wm maxsize . 640 620 } else { .fc.c configure -height 400 wm geometry . {} wm minsize . 590 480 wm maxsize . 640 520 } if {[winfo exists .view] == 1} { setval call_viewer normal } ctrlbutton disabled resetpage } # ページ表示 proc showpage {} { global commandlist global docpages global lnum global cp global maxp global cursor global mode global scrY global Id1 Id2 global message global Option .fb2.bt configure -text $message(contents) -command showtitle set page [lindex $docpages $cp] set scrY(0) 20 set width 56 set wlen 392 foreach i $page { set line $i set str0 [lindex [lindex $line 0] 0] if {[lsearch $commandlist $str0] != -1} { if {$str0 == "move"} { set text "move [lindex $line 2]" set line [lindex $line 1] set str0 [lindex $line 0] .fc.c create text 510 $scrY($lnum) -text $text \ -anchor nw -fill yellow } if {$str0 == "text" || $str0 == "textbox" || $str0 == "table" \ || $str0 == "animation"} { set str1 [string range [lindex $line 1] 0 [expr $width - 1]] } else { set str1 [lindex $line 1] } set color [lindex $line 2] if {$str0 == "title"} { set color yellow set str2 [lindex $line 2] if {$str2 != {}} { set str1 "$str1 - $str2" } } if {$str0 == "animation"} {set color white} if {$color == {}} {set color white} regsub -all "\[\t\n\]" $str1 { } str1 regsub -all "\ +\ *" $str1 { } str1 set str1 [string trim $str1 { }] set n [string length $str1] set l [expr $n / ($width + 1) + 1] label .fc.c.lb1($lnum) -width 10 -text $str0 \ -anchor w -bg RoyalBlue4 -fg white label .fc.c.lb2($lnum) -relief raised -width $width -heigh $l \ -wraplength $wlen -text $str1 -justify left -anchor w \ -bg RoyalBlue4 -fg $color .fc.c create window 10 $scrY($lnum) -window .fc.c.lb1($lnum) \ -anchor nw .fc.c create window 100 $scrY($lnum) -window .fc.c.lb2($lnum) \ -anchor nw set dy [expr 30 + ($l-1) * 15] } else { set str [string range $line 0 [expr $width - 1]] label .fc.c.lb1($lnum) -width 10 -text " " \ -anchor w -bg RoyalBlue4 -fg white label .fc.c.lb2($lnum) -relief raised -width $width -height 1 \ -text $str -anchor nw -justify left -bg RoyalBlue4 \ -fg white .fc.c create window 10 $scrY($lnum) -window .fc.c.lb1($lnum) \ -anchor nw .fc.c create window 100 $scrY($lnum) -window .fc.c.lb2($lnum) \ -anchor nw set dy 30 } set Id1(.fc.c.lb1($lnum)) $lnum set Id2(.fc.c.lb2($lnum)) $lnum setbind $lnum $str0 incr lnum set scrY($lnum) [expr $scrY([expr $lnum-1]) + $dy] } .fc.c configure -scrollregion "0 0 560 [expr $scrY($lnum) + 10]" if {$cursor != {} && $cursor >= $lnum && $lnum != 0} { set cursor [expr $lnum -1] set mw .fc.c.lb2($cursor) } if {$lnum == 0} { set cursor {} ctrlbutton disabled } if {$cursor != {}} { .fc.c.lb2($cursor) configure -bg #A9A9A9 .fc.c.lb1($cursor) configure -bg #A9A9A9 } bind .fc.c { inputtext %x %y 0 } if {$Option(vredraw) == 1} { call_viewer normal } ctrlpabutton } # バインド設定 proc setbind {n label} { global docpages global cp global Id1 global Id2 global lnum bind .fc.c.lb1($n) <1> { set mw %W focus $mw if {$cursor == {}} { $mw configure -bg #A9A9A9 .fc.c.lb2($Id1($mw)) configure -bg #A9A9A9 set cursor $Id1($mw) ctrlbutton normal ctrlcobutton $Id1($mw) } elseif {$cursor != $Id1($mw)} { $mw configure -bg #A9A9A9 .fc.c.lb2($Id1($mw)) configure -bg #A9A9A9 .fc.c.lb2($cursor) configure -bg RoyalBlue4 .fc.c.lb1($cursor) configure -bg RoyalBlue4 set cursor $Id1($mw) ctrlbutton normal ctrlcobutton $Id1($mw) } } bind .fc.c.lb1($n) <3> { set mw %W focus $mw if {$cursor == $Id1($mw)} { set str [lindex [$mw configure -text] 4] if {$str == "item" || $str == "subitem" || $str == "subsubitem" \ || $str == "subsubsubitem"} { if {[lindex [lindex [lindex $docpages $cp] $Id1($mw)] 0] \ != "move"} { setlabelopt return } } $mw configure -bg RoyalBlue4 .fc.c.lb2($Id1($mw)) configure -bg RoyalBlue4 set cursor {} ctrlbutton disabled } } bind .fc.c.lb2($n) <1> { set mw %W focus $mw if {$cursor == {}} { $mw configure -bg #A9A9A9 .fc.c.lb1($Id2($mw)) configure -bg #A9A9A9 set cursor $Id2($mw) ctrlbutton normal ctrlcobutton $Id2($mw) } elseif {$cursor != $Id2($mw)} { $mw configure -bg #A9A9A9 .fc.c.lb1($Id2($mw)) configure -bg #A9A9A9 .fc.c.lb2($cursor) configure -bg RoyalBlue4 .fc.c.lb1($cursor) configure -bg RoyalBlue4 set cursor $Id2($mw) ctrlbutton normal ctrlcobutton $Id2($mw) } } bind .fc.c.lb2($n) <3> { set mw %W focus $mw if {$cursor == $Id2($mw)} { $mw configure -bg RoyalBlue4 .fc.c.lb1($Id2($mw)) configure -bg RoyalBlue4 set cursor {} ctrlbutton disabled } } bind .fc.c.lb2($n) { edittext } if {[lindex [lindex [lindex $docpages $cp] $n] 0] != "move"} { bind .fc.c.lb1($n) { popupmenu label } } } # タイトル表示 proc showtitle {} { global docpages global lnum global cp global maxp global cursor global mode global Id global message if {$maxp == 0} { .fb2.bp configure -state normal .fb2.bn configure -state normal .fb2.bi configure -state normal .fb2.ba configure -state normal .fb2.bt configure -text $message(contents) -command showtitle set cp 0 set mode page ctrlbutton disabled resetpage return } if {$cp == $maxp} {set cp [expr $maxp - 1]} set mode contents set cursor $cp ctrlbutton normal .fb2.bp configure -state disabled .fb2.bn configure -state disabled .fb2.bi configure -state disabled .fb2.ba configure -state disabled .fb2.bt configure -text $message(page) -command { .fb2.bp configure -state normal .fb2.bn configure -state normal .fb2.bi configure -state normal .fb2.ba configure -state normal .fb2.bt configure -text $message(contents) -command showtitle set cp $cursor set cursor {} set mode page ctrlbutton disabled resetpage return } bind .fc.c < "" initpage .fb2.ep delete 0 end .fb2.ep insert 0 [expr $cursor + 1] set p [llength $docpages] set col [expr ($p-1) / 10 + 1] set tw [expr 530 / $col] label .fc.c.titletext -width 54 -anchor w -bg black -fg white .fc.c create window 60 20 -window .fc.c.titletext -anchor w foreach page $docpages { set str [lindex [lindex $page 0] 1] regsub -all "\[\t\n\]" $str { } str regsub -all "\ +\ *" $str { } str set str [string trim $str { }] label .fc.c.lb1($lnum) -relief raised -width [expr 68/$col-2] \ -text $str -anchor w -bg white if {$p <= 50} { .fc.c create text [expr $lnum/10 * $tw + 10] \ [expr 60+($lnum%10)*30] -text [expr $lnum+1] \ -anchor nw -fill white } else { if {[expr $lnum % 10] == 0} { .fc.c create text [expr $lnum/10 * $tw + 30] 40 \ -text [expr $lnum+1] -anchor nw -fill white } } .fc.c create window [expr $lnum/10 * $tw + 30] \ [expr 60+($lnum%10)*30] -window .fc.c.lb1($lnum) -anchor nw set Id(.fc.c.lb1($lnum)) $lnum bind .fc.c.lb1($lnum) <1> { set mw %W if {$Id($mw) != $cursor} { $mw configure -bg #A9A9A9 .fc.c.lb1($cursor) configure -bg white set cursor $Id($mw) set cp $cursor .fb2.ep delete 0 end .fb2.ep insert 0 [expr $cp + 1] set str [lindex [lindex [lindex $docpages $cp] 0] 1] regsub -all "\[\t\n\]" $str { } str regsub -all "\ +\ *" $str { } str set str [string trim $str { }] .fc.c.titletext configure -text $str } } bind .fc.c.lb1($lnum) <2> { set mw %W movepage $cursor $Id($mw) } bind .fc.c.lb1($lnum) { set mw %W .fb2.bp configure -state normal .fb2.bn configure -state normal .fb2.ba configure -state normal .fb2.bi configure -state normal .fb2.bt configure -text index -command showtitle set cp $cursor set cursor {} set mode page ctrlbutton disabled resetpage } incr lnum } if {$cursor >= $lnum && $lnum != 0} { set cursor [expr $lnum -1] set mw .fc.c.lb1($cursor) } if {$lnum == 0} { set cursor {} ctrlbutton disabled } if {$cursor != {}} { .fc.c.lb1($cursor) configure -bg #A9A9A9 set str [lindex [lindex [lindex $docpages $cp] 0] 1] regsub -all "\[\t\n\]" $str { } str regsub -all "\ +\ *" $str { } str set str [string trim $str { }] .fc.c.titletext configure -text $str } } # ボタン状態制御 proc ctrlbutton {state} { global cursor global mode if {$mode == "page"} { .fb1.bl configure -state $state .fb1.bi configure -state normal .fb1.ba configure -state normal .fb1.be configure -state $state .fb1.bo configure -state $state .fb1.bf configure -state $state .fb1.bt configure -state $state } elseif {$mode == "contents"} { .fb1.bl configure -state disabled .fb1.bi configure -state disabled .fb1.ba configure -state disabled .fb1.be configure -state disabled .fb1.bo configure -state disabled .fb1.bf configure -state disabled .fb1.bt configure -state disabled } .fb1.bc configure -state $state .fb1.bp configure -state $state .fb1.bu configure -state $state .fb1.bd configure -state $state } # カラー変更ボタン & フォント変更ボタン制御 proc ctrlcobutton {n} { global docpages global cp set str [lindex [.fc.c.lb1($n) configure -text] 4] if {$str == "title" || $str == "pict" || $str == "textbox" \ || $str == "animation" || $str == "pause" \ || $str == " "} { .fb1.bo configure -state disabled } if {$str == "title" || $str == "pict" || $str == "symbol" \ || $str == "animation" || $str == "pause" \ || $str == " "} { .fb1.bf configure -state disabled } if {$str == "title" || $str == "pict" || $str == "symbol" \ || $str == "table" || $str == "animation" \ || $str == "text" || $str == "textbox" || $str == "pause" \ || $str == " "} { .fb1.bt configure -state disabled } set str [lindex [lindex [lindex $docpages $cp] $n] 0] if {$str == "move"} { .fb1.bl configure -state disabled .fb1.bo configure -state disabled .fb1.bf configure -state disabled } } # ページ変更ボタン制御 proc ctrlpabutton {} { global cp global maxp if {$maxp == 0 || $maxp == 1} { .fb2.bp configure -state disabled .fb2.bn configure -state disabled } elseif {$cp == 0} { .fb2.bp configure -state disabled .fb2.bn configure -state normal } elseif {$cp == ($maxp-1)} { .fb2.bp configure -state normal .fb2.bn configure -state disabled } else { .fb2.bp configure -state normal .fb2.bn configure -state normal } if {$maxp == 0} { .fb2.bt configure -state disabled } else { .fb2.bt configure -state normal } } # Viewer の bind 制御 proc viewredraw {} { global Option if {[winfo exists .view] == 1} { view_setbind 1 } } # メニューの制御 proc checkmenu {} { global Option if {$Option(background) == {}} { .fm.mbo.m entryconfigure 8 -state disabled } else { .fm.mbo.m entryconfigure 8 -state normal } if {$Option(LANG) == "eng"} { .fm.mbo.m entryconfigure 0 -state disabled } else { .fm.mbo.m entryconfigure 0 -state normal } } # 表示言語変更 proc changelang {lang} { global message global Option global deffonts global work set Option(lang) $lang if {$lang == "jpn"} { set message(page) "頁表示" set message(contents) " 目次 " set message(ok) 了解 set message(cancel) キャンセル set message(no) いいえ set message(save) 保存 set message(browse) 参照... set message(select) 選択 set message(etc) その他 set message(default) デフォルト set message(load) "編集中の内容は破棄されますがよろしいですか?" set message(exit) "終了する前にファイルに保存しますか?" # メニュー .fm.mbf configure -text ファイル .fm.mbf.m delete 0 end .fm.mbf.m add command -label 新規作成 -command new .fm.mbf.m add command -label 読込み -command load .fm.mbf.m add command -label 保存 -command save .fm.mbf.m add separator .fm.mbf.m add command -label "HTML 形式で保存" -command outputHTML .fm.mbf.m add command -label "MGP 形式で保存" -command outputMGP .fm.mbf.m add separator .fm.mbf.m add command -label "EWIPE について" -command aboutEWIPE .fm.mbf.m add separator .fm.mbf.m add command -label 終了 -command exitewipe .fm.mbo configure -text オプション .fm.mbo.m delete 0 end .fm.mbo.m add cascade -label 表示言語 -menu .fm.mbo.m.lang .fm.mbo.m.lang delete 0 end .fm.mbo.m.lang add command -label 日本語 -command "changelang jpn" .fm.mbo.m.lang add command -label 英語 -command "changelang eng" .fm.mbo.m add cascade -label パスのタイプ -menu .fm.mbo.m.path .fm.mbo.m.path delete 0 end .fm.mbo.m.path add radiobutton -label 絶対パス -value 0 \ -variable Option(pathtype) .fm.mbo.m.path add radiobutton -label 相対パス -value 1 \ -variable Option(pathtype) .fm.mbo.m add separator .fm.mbo.m add cascade -label ページ番号 -menu .fm.mbo.m.pnum .fm.mbo.m.pnum delete 0 end .fm.mbo.m.pnum add radiobutton -label off -value 0 \ -variable Option(pagen) -command "call_viewer pagen" .fm.mbo.m.pnum add radiobutton -label on -value 1 \ -variable Option(pagen) -command "call_viewer pagen" .fm.mbo.m add cascade -label "時間" -menu .fm.mbo.m.time .fm.mbo.m.time delete 0 end .fm.mbo.m.time add radiobutton -label off -value 0 \ -variable Option(time) -command "call_viewer time" .fm.mbo.m.time add radiobutton -label on -value 1 \ -variable Option(time) -command "call_viewer time" .fm.mbo.m add cascade -label "時間のタイプ" -menu .fm.mbo.m.timetype .fm.mbo.m.timetype delete 0 end .fm.mbo.m.timetype add radiobutton -label "時刻" -value 0 \ -variable Option(timemode) .fm.mbo.m.timetype add radiobutton -label "経過時間" -value 1 \ -variable Option(timemode) .fm.mbo.m add command -label ポインタ -command setpointer .fm.mbo.m add command -label "背景選択" -command selectbg .fm.mbo.m add cascade -label "背景のタイプ" -menu .fm.mbo.m.bgtype .fm.mbo.m.bgtype delete 0 end .fm.mbo.m.bgtype add radiobutton -label 普通 -value 0 \ -variable Option(bgtype) -command changebg .fm.mbo.m.bgtype add radiobutton -label タイル -value 1 \ -variable Option(bgtype) -command changebg .fm.mbo.m add cascade -label "タイトルのタイプ" \ -menu .fm.mbo.m.titletype .fm.mbo.m.titletype delete 0 end .fm.mbo.m.titletype add radiobutton -label box -value 0 \ -variable Option(titletype) \ -command "set view_skip 1; call_viewer normal" .fm.mbo.m.titletype add radiobutton -label line -value 1 \ -variable Option(titletype) \ -command "set view_skip 1; call_viewer normal" .fm.mbo.m add separator .fm.mbo.m add cascade -label "HTML カラー" -menu .fm.mbo.m.htmlc .fm.mbo.m.htmlc delete 0 end .fm.mbo.m.htmlc add radiobutton -label モノクロ -value 0 \ -variable Option(htmlcolor) .fm.mbo.m.htmlc add radiobutton -label カラー -value 1 \ -variable Option(htmlcolor) .fm.mbo.m add cascade -label "HTML サイズ" -menu .fm.mbo.m.htmls .fm.mbo.m.htmls delete 0 end .fm.mbo.m.htmls add radiobutton -label 普通 -value 0 \ -variable Option(htmlfont) .fm.mbo.m.htmls add radiobutton -label 大 -value 1 \ -variable Option(htmlfont) .fm.mbo.m add separator .fm.mbo.m add cascade -label "Viewer サイズ" -menu .fm.mbo.m.vsize .fm.mbo.m.vsize delete 0 end .fm.mbo.m.vsize add radiobutton -label 640x480 -value 0 \ -variable Option(viewersize) -command changesize .fm.mbo.m.vsize add radiobutton -label 800x600 -value 1 \ -variable Option(viewersize) -command changesize .fm.mbo.m add cascade -label "Viewer 再描画" -menu .fm.mbo.m.view .fm.mbo.m.view delete 0 end .fm.mbo.m.view add radiobutton -label off -value 0 \ -variable Option(vredraw) -command viewredraw .fm.mbo.m.view add radiobutton -label on -value 1 \ -variable Option(vredraw) -command viewredraw .fm.mbo.m add command -label "View モード" -command "call_viewer view" .fm.mbo.m add separator .fm.mbo.m add cascade -label "オプション保存" -menu .fm.mbo.m.save .fm.mbo.m.save delete 0 end .fm.mbo.m.save add radiobutton -label off -value 0 \ -variable Option(saveoptions) .fm.mbo.m.save add radiobutton -label on -value 1 \ -variable Option(saveoptions) # 編集コマンドボタン .fb1.bl configure -text ラベル .fb1.bi configure -text 挿入 .fb1.ba configure -text 追加 .fb1.bc configure -text 削除 .fb1.bp configure -text 貼付 .fb1.be configure -text 編集 .fb1.bu configure -text 上 .fb1.bd configure -text 下 .fb1.bo configure -text 色 .fb1.bf configure -text 文字 .fb1.bt configure -text 属性 # ページ操作ボタン .fb2.bv configure -text Viewer .fb2.bt configure -text $message(contents) .fb2.bp configure -text 前頁 .fb2.bn configure -text 次頁 .fb2.bi configure -text 頁挿入 .fb2.ba configure -text 頁追加 } elseif {$lang == "eng"} { set message(page) " page " set message(contents) "contents" set message(ok) Ok set message(cancel) Cancel set message(no) No set message(save) Save set message(browse) Browse... set message(select) Select set message(etc) etc set message(default) default set message(load) "File modified, do you want to load (new) ?" set message(exit) "Do you want to save before exit ?" # メニュー .fm.mbf configure -text File .fm.mbf.m delete 0 end .fm.mbf.m add command -label New -command new .fm.mbf.m add command -label Load -command load .fm.mbf.m add command -label Save -command save .fm.mbf.m add separator .fm.mbf.m add command -label "Save as HTML" -command outputHTML .fm.mbf.m add command -label "Save as MGP" -command outputMGP .fm.mbf.m add separator .fm.mbf.m add command -label "About EWIPE" -command aboutEWIPE .fm.mbf.m add separator .fm.mbf.m add command -label Exit -command exitewipe .fm.mbo configure -text Option .fm.mbo.m delete 0 end .fm.mbo.m add cascade -label Language -menu .fm.mbo.m.lang .fm.mbo.m.lang delete 0 end .fm.mbo.m.lang add command -label Japanese -command "changelang jpn" .fm.mbo.m.lang add command -label English -command "changelang eng" .fm.mbo.m add cascade -label "Path type" -menu .fm.mbo.m.path .fm.mbo.m.path delete 0 end .fm.mbo.m.path add radiobutton -label "absolute path" -value 0 \ -variable Option(pathtype) .fm.mbo.m.path add radiobutton -label "relative path" -value 1 \ -variable Option(pathtype) .fm.mbo.m add separator .fm.mbo.m add cascade -label "Page number" -menu .fm.mbo.m.pnum .fm.mbo.m.pnum delete 0 end .fm.mbo.m.pnum add radiobutton -label off -value 0 \ -variable Option(pagen) -command "call_viewer pagen" .fm.mbo.m.pnum add radiobutton -label on -value 1 \ -variable Option(pagen) -command "call_viewer pagen" .fm.mbo.m add cascade -label "Time" -menu .fm.mbo.m.time .fm.mbo.m.time delete 0 end .fm.mbo.m.time add radiobutton -label off -value 0 \ -variable Option(time) -command "call_viewer time" .fm.mbo.m.time add radiobutton -label on -value 1 \ -variable Option(time) -command "call_viewer time" .fm.mbo.m add cascade -label "Time type" -menu .fm.mbo.m.timetype .fm.mbo.m.timetype delete 0 end .fm.mbo.m.timetype add radiobutton -label "time" -value 0 \ -variable Option(timemode) .fm.mbo.m.timetype add radiobutton -label "passed time" -value 1 \ -variable Option(timemode) .fm.mbo.m add command -label "Pointer" -command setpointer .fm.mbo.m add command -label "Select background" -command selectbg .fm.mbo.m add cascade -label "Background type" -menu .fm.mbo.m.bgtype .fm.mbo.m.bgtype delete 0 end .fm.mbo.m.bgtype add radiobutton -label normal -value 0 \ -variable Option(bgtype) -command changebg .fm.mbo.m.bgtype add radiobutton -label tiled -value 1 \ -variable Option(bgtype) -command changebg .fm.mbo.m add cascade -label "Title type" \ -menu .fm.mbo.m.titletype .fm.mbo.m.titletype delete 0 end .fm.mbo.m.titletype add radiobutton -label box -value 0 \ -variable Option(titletype) \ -command "set view_skip 1; call_viewer normal" .fm.mbo.m.titletype add radiobutton -label line -value 1 \ -variable Option(titletype) \ -command "set view_skip 1; call_viewer normal" .fm.mbo.m add separator .fm.mbo.m add cascade -label "HTML color" -menu .fm.mbo.m.htmlc .fm.mbo.m.htmlc delete 0 end .fm.mbo.m.htmlc add radiobutton -label Mono -value 0 \ -variable Option(htmlcolor) .fm.mbo.m.htmlc add radiobutton -label Color -value 1 \ -variable Option(htmlcolor) .fm.mbo.m add cascade -label "HTML size" -menu .fm.mbo.m.htmls .fm.mbo.m.htmls delete 0 end .fm.mbo.m.htmls add radiobutton -label Normal -value 0 \ -variable Option(htmlfont) .fm.mbo.m.htmls add radiobutton -label Large -value 1 \ -variable Option(htmlfont) .fm.mbo.m add separator .fm.mbo.m add cascade -label "Viewer size" -menu .fm.mbo.m.vsize .fm.mbo.m.vsize delete 0 end .fm.mbo.m.vsize add radiobutton -label 640x480 -value 0 \ -variable Option(viewersize) -command changesize .fm.mbo.m.vsize add radiobutton -label 800x600 -value 1 \ -variable Option(viewersize) -command changesize .fm.mbo.m add cascade -label "Viewer redraw" -menu .fm.mbo.m.view .fm.mbo.m.view delete 0 end .fm.mbo.m.view add radiobutton -label off -value 0 \ -variable Option(vredraw) -command viewredraw .fm.mbo.m.view add radiobutton -label on -value 1 \ -variable Option(vredraw) -command viewredraw .fm.mbo.m add command -label "View mode" -command "call_viewer view" .fm.mbo.m add separator .fm.mbo.m add cascade -label "Save options" -menu .fm.mbo.m.save .fm.mbo.m.save delete 0 end .fm.mbo.m.save add radiobutton -label off -value 0 \ -variable Option(saveoptions) .fm.mbo.m.save add radiobutton -label on -value 1 \ -variable Option(saveoptions) # 編集コマンドボタン .fb1.bl configure -text label .fb1.bi configure -text insert .fb1.ba configure -text add .fb1.bc configure -text cut .fb1.bp configure -text paste .fb1.be configure -text edit .fb1.bu configure -text up .fb1.bd configure -text down .fb1.bo configure -text color .fb1.bf configure -text font .fb1.bt configure -text attr # ページ操作ボタン .fb2.bv configure -text Viewer .fb2.bt configure -text $message(contents) .fb2.bp configure -text prev .fb2.bn configure -text next .fb2.bi configure -text insertpage .fb2.ba configure -text addpage } .pml delete 0 end .pml add command -label title -command "changelabel title" .pml add command -label item -command "changelabel item" .pml add command -label subitem -command "changelabel subitem" .pml add command -label subsubitem -command "changelabel subsubitem" .pml add command -label subsubsubitem -command "changelabel subsubsubitem" .pml add separator .pml add command -label left -command "changelabel left" .pml add command -label center -command "changelabel center" .pml add command -label right -command "changelabel right" .pml add separator .pml add command -label pict -command "changelabel pict" .pml add command -label symbol -command "changelabel symbol" .pml add command -label text -command "changelabel text" .pml add command -label textbox -command "changelabel textbox" .pml add command -label table -command "changelabel table" .pml add command -label animation -command "changelabel animation" .pml add separator .pml add command -label $message(cancel) .pmml delete 0 end .pmml add command -label title -command "makelabel title" .pmml add command -label item -command "makelabel item" .pmml add command -label subitem -command "makelabel subitem" .pmml add command -label subsubitem -command "makelabel subsubitem" .pmml add command -label subsubsubitem -command "makelabel subsubsubitem" .pmml add separator .pmml add command -label left -command "makelabel left" .pmml add command -label center -command "makelabel center" .pmml add command -label right -command "makelabel right" .pmml add separator .pmml add command -label pict -command "makelabel pict" .pmml add command -label symbol -command "makelabel symbol" .pmml add command -label text -command "makelabel text" .pmml add command -label textbox -command "makelabel textbox" .pmml add command -label table -command "makelabel table" .pmml add command -label animation -command "makelabel animation" .pmml add separator .pmml add command -label pause -command "makelabel pause" .pmml add separator .pmml add command -label $message(cancel) .pmc delete 0 end .pmc add command -label white -command "changecolor white" .pmc add command -label yellow -command "changecolor yellow" .pmc add command -label green -command "changecolor green" .pmc add command -label orange -command "changecolor orange" .pmc add command -label red -command "changecolor red" .pmc add command -label skyblue -command "changecolor skyblue" .pmc add command -label gray -command "changecolor gray" .pmc add separator .pmc add command -label $message(etc) -command "changecolor etc" .pmc add separator .pmc add command -label $message(cancel) .pmf delete 0 end foreach i $deffonts { .pmf add radiobutton -label $i -variable work(fonts) \ -value $i -command "changefont {}" } .pmf add separator .pmf add radiobutton -label $message(etc) -variable work(fonts) \ -value u -command "changefont etc" .pmf add separator .pmf add command -label $message(cancel) .pms delete 0 end .pms add command -label downarrow -command "changeitem downarrow" .pms add command -label uparrow -command "changeitem uparrow" .pms add command -label updownarrow -command "changeitem updownarrow" .pms add command -label cdot -command "changeitem cdot" .pms add command -label vdots -command "changeitem vdots" .pms add separator .pms add command -label $message(cancel) .pma delete 0 end .pma add command -label none -command "changeattr none" .pma add separator .pma add command -label "move nw" -command "changeattr {move nw}" .pma add command -label "move n" -command "changeattr {move n}" .pma add command -label "move ne" -command "changeattr {move ne}" .pma add command -label "move w" -command "changeattr {move w}" .pma add command -label "move e" -command "changeattr {move e}" .pma add command -label "move sw" -command "changeattr {move sw}" .pma add command -label "move s" -command "changeattr {move s}" .pma add command -label "move se" -command "changeattr {move se}" .pma add separator .pma add command -label $message(cancel) } # 色名 ←→ RGB 形式変換 (mode n:rgb → name r:name → rgb) proc name2rgb {color mode} { set colormap {{white #FFFFFF} {yellow #FFFF00} {green #00FF00} \ {orange #FFA500} {red #FF0000} {skyblue #88CEEB} \ {gray #BEBEBE} {RoyalBlue4 #27408B}} set rcolor -1 if {$mode == "n"} { foreach i $colormap { if {[lindex $i 1] == $color} { set rcolor [lindex $i 0] break } } } elseif {$mode == "r"} { foreach i $colormap { if {[lindex $i 0] == $color} { set rcolor [lindex $i 1] break } } } return $rcolor } # absolute -> relative proc relativepath {abspath absfile} { set pathlist [split $abspath "/"] set filelist [split $absfile "/"] for {set i 0} {$i < [expr [llength $pathlist] ]} {incr i} { lappend newlist ".." } for {set i 0} {$i < [llength $filelist]} {incr i} { if {[lindex $filelist $i] == [lindex $pathlist $i]} { set newlist [lreplace $newlist 0 0] } else { set p $i break } } for {set i $p} {$i < [llength $filelist]} {incr i} { lappend newlist [lindex $filelist $i] } foreach i $newlist { append relpath "$i/" } set relpath [string trimright $relpath "/"] return $relpath } # EWIPE バージョン情報 proc aboutEWIPE {} { global message global version toplevel .fe wm title .fe "about EWIPE" frame .fe.ft -relief raised -borderwidth 2 label .fe.ft.tt1 -text "EWIPE Version $version" label .fe.ft.tt2 -text "Copyright (C) 1997-2000 Hiromasa Sekishita" button .fe.bo -text $message(ok) -command { destroy .fe } pack .fe.ft.tt1 .fe.ft.tt2 -padx 5 -pady 5 pack .fe.ft .fe.bo -padx 5 -pady 5 wm withdraw .fe update idletasks set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2] set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2] wm geometry .fe +$x+$y wm deiconify .fe focus .fe.bo update grab .fe tkwait window .fe } wm title . "EWIPE" # メニュー frame .fm -relief raised -bd 2 menubutton .fm.mbf -text File -menu .fm.mbf.m menu .fm.mbf.m -tearoff 0 menubutton .fm.mbo -text Option -menu .fm.mbo.m menu .fm.mbo.m -tearoff 0 -postcommand checkmenu menu .fm.mbo.m.lang -tearoff 0 menu .fm.mbo.m.pnum -tearoff 0 menu .fm.mbo.m.time -tearoff 0 menu .fm.mbo.m.timetype -tearoff 0 menu .fm.mbo.m.path -tearoff 0 menu .fm.mbo.m.htmlc -tearoff 0 menu .fm.mbo.m.htmls -tearoff 0 menu .fm.mbo.m.vsize -tearoff 0 menu .fm.mbo.m.view -tearoff 0 menu .fm.mbo.m.save -tearoff 0 menu .fm.mbo.m.bgtype -tearoff 0 menu .fm.mbo.m.titletype -tearoff 0 pack .fm.mbf .fm.mbo -side left pack .fm -side top -fill x # 編集コマンドボタン frame .fb1 button .fb1.bl -command "popupmenu label" button .fb1.bi -command "inputtext {} {} 0" button .fb1.ba -command "inputtext {} {} 1" button .fb1.bc -command deleteline button .fb1.bp -command pasteline button .fb1.be -command edittext button .fb1.bu -command "move up" button .fb1.bd -command "move down" button .fb1.bo -command "popupmenu color" button .fb1.bf -command "popupmenu font" button .fb1.bt -command "popupmenu attr" pack .fb1.bl .fb1.bi .fb1.ba .fb1.bc .fb1.bp .fb1.be .fb1.bu \ .fb1.bd .fb1.bo .fb1.bf .fb1.bt -side left menu .pml -tearoff 0 menu .pmml -tearoff 0 menu .pmc -tearoff 0 menu .pmf -tearoff 0 -postcommand checkfont menu .pms -tearoff 0 menu .pma -tearoff 0 # 表示画面 frame .fc canvas .fc.c -height 400 -width 590 -bg RoyalBlue3 \ -yscrollcommand ".fc.vs set" -scrollregion "0 0 590 400" scrollbar .fc.vs -orient vertical -command ".fc.c yview" pack .fc.c .fc.vs -side left -fill y # ページ操作ボタン frame .fb2 button .fb2.bv -command "call_viewer normal" button .fb2.bt -command showtitle entry .fb2.ep -width 7 -justify center button .fb2.bp -command "set view_skip 1; nextpage -1" button .fb2.bn -command "set view_skip 1; nextpage 1" button .fb2.bi -command "createpage 0" button .fb2.ba -command "createpage 1" pack .fb2.bv .fb2.bt .fb2.ep .fb2.bp .fb2.bn .fb2.bi .fb2.ba \ -side left pack .fb1 .fc .fb2 -fill x # 初期設定 set commandlist {title item subitem subsubitem subsubsubitem \ right center left pict symbol text textbox table \ pp rp animation move pause} set lnum 0 ;# 行数 set cp 0 ;# 表示しているページ set cursor {} ;# 選択行 set clip(line) {} ;# カット行記憶用 set clip(page) {} ;# カットページ記憶用 set pwd [pwd] ;# 起動ディレクトリ set filedir [pwd] ;# 編集ファイルディレクトリ set Viewmode 0 ;# モード (1: Viewer only) set view_skip 0 set version "1.2.0" ;# EWIPE Version readdotfile set filename {} ;# ファイル名 set docpages {} if {$argv != ""} { argvcheck } definefont if {$docpages == {}} { if {$Option(startpage) == {}} { set docpages {} } else { set docpages $Option(startpage) } set docpagesorg $docpages } set maxp [llength $docpages] ;# ページ数 set mode page ;# 表示モード changelang $Option(lang) ;# 表示言語 changesize if {$Viewmode == 1} { call_viewer view } ctrlbutton disabled bind .fb2.ep "jumppage"