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

# ポインタ種類設定

proc setpointertype {type} {
    .pointer.po.en delete 0 end
    .pointer.po.en insert 0 $type
    setpointertest
}

# ポインタ色設定

proc setpointercolor {n color} {

    switch $n {
	0 {
	    .pointer.pof.en delete 0 end
	    .pointer.pof.en insert 0 $color
	}
	1 {
	    .pointer.pob.en delete 0 end
	    .pointer.pob.en insert 0 $color
	}
	2 {
	    .pointer.penl.en delete 0 end
	    .pointer.penl.en insert 0 $color
	}
	3 {
	    .pointer.penr.en delete 0 end
	    .pointer.penr.en insert 0 $color
	}
    }
    setpointertest
}

# ポインタ種類選択メニュー

proc setpointermenu {} {
    global message
    
    .pointer.pmp delete 0 end
    .pointer.pmp add command -label normal -command "setpointertype normal"
    .pointer.pmp add command -label arrow -command "setpointertype arrow"
    .pointer.pmp add command -label top_left_arrow \
	    -command "setpointertype top_left_arrow"
    .pointer.pmp add command -label dot -command "setpointertype dot"
    .pointer.pmp add command -label hand1 -command "setpointertype hand1"
    .pointer.pmp add command -label hand2 -command "setpointertype hand2"
    .pointer.pmp add separator
    .pointer.pmp add command -label $message(cancel)

    set x [winfo pointerx .pointer]
    set y [winfo pointery .pointer]
    
    .pointer.pmp post $x $y
    focus .pointer.pmp
    bind .pointer.pmp <FocusOut> {
	.pointer.pmp unpost
    }
}

# ポインタ色選択メニュー

proc setpointermenuc {n} {
    global message
    
    .pointer.pmp delete 0 end
    .pointer.pmp add command -label white -command "setpointercolor $n white"
    .pointer.pmp add command -label yellow -command "setpointercolor $n yellow"
    .pointer.pmp add command -label green -command "setpointercolor $n green"
    .pointer.pmp add command -label orange -command "setpointercolor $n orange"
    .pointer.pmp add command -label red -command "setpointercolor $n red"
    .pointer.pmp add command -label skyblue -command \
	    "setpointercolor $n skyblue"
    .pointer.pmp add command -label gray -command "setpointercolor $n gray"
    .pointer.pmp add command -label black -command "setpointercolor $n black"
    .pointer.pmp add separator
    .pointer.pmp add command -label $message(cancel)

    set x [winfo pointerx .pointer]
    set y [winfo pointery .pointer]
    
    .pointer.pmp post $x $y
    focus .pointer.pmp
    bind .pointer.pmp <FocusOut> {
	.pointer.pmp unpost
    }
}

# ポインタテスト

proc setpointertest {} {
    global tcl_platform

    set type [.pointer.po.en get]
    set fg [.pointer.pof.en get]
    set bg [.pointer.pob.en get]

    if {$type == "" || $type == "normal"} {
	.pointer configure -cursor {}
	if {[winfo exists .view] == 1} {
	    .view.c configure -cursor {}
	}
    } else {
	if {$tcl_platform(platform) == "windows"} {
	    if {[catch {.pointer configure -cursor $type}]} {
		.pointer configure -cursor {}
	    }
	    if {[winfo exists .view] == 1} {
		if {[catch {.view.c configure -cursor $type}]} {
		    .view.c configure -cursor {}
		}
	    }
	} else {
	    if {[catch {.pointer configure -cursor "$type $fg $bg"}]} {
		.pointer configure -cursor {}
	    }
	    if {[winfo exists .view] == 1} {
		if {[catch {.view.c configure -cursor "$type $fg $bg"}]} {
		    .view.c configure -cursor {}
		}
	    }
	}
    }
}

# ポインタ設定

proc setpointer {} {
    global message
    global Option
    
    toplevel .pointer
    wm title .pointer "Setting pointer"
    
    if {$Option(lang) == "jpn"} {
	set lb(test) "テスト"
	set lb(po)   "ポインタ    "
	set lb(pof)  "前景色      "
	set lb(pob)  "背景色      "
        set lb(penl) "左のペンの色"
        set lb(penr) "右のペンの色"
    } elseif {$Option(lang) == "eng"} {
	set lb(test) "Test"
	set lb(po)   "pointer         "
	set lb(pof)  "foreground color"
	set lb(pob)  "background color"
        set lb(penl) "left pen color  "
        set lb(penr) "right pen color "
    }
    
    frame .pointer.po
    label .pointer.po.lb -text $lb(po)
    entry .pointer.po.en -width 20
    button .pointer.po.bt -text $message(select) -command "setpointermenu"

    frame .pointer.pof
    label .pointer.pof.lb -text $lb(pof)
    entry .pointer.pof.en -width 20
    button .pointer.pof.bt -text $message(select) -command "setpointermenuc 0"

    frame .pointer.pob
    label .pointer.pob.lb -text $lb(pob)
    entry .pointer.pob.en -width 20
    button .pointer.pob.bt -text $message(select) -command "setpointermenuc 1"

    frame .pointer.penl
    label .pointer.penl.lb -text $lb(penl)
    entry .pointer.penl.en -width 20
    button .pointer.penl.bt -text $message(select) -command "setpointermenuc 2"

    frame .pointer.penr
    label .pointer.penr.lb -text $lb(penr)
    entry .pointer.penr.en -width 20
    button .pointer.penr.bt -text $message(select) -command "setpointermenuc 3"

    frame .pointer.fb
    button .pointer.fb.bt -text $lb(test) -command setpointertest
    button .pointer.fb.bo -text $message(ok) -command {
	set Option(pointer) [.pointer.po.en get]
	set Option(pointerfg) [.pointer.pof.en get]
	set Option(pointerbg) [.pointer.pob.en get]
	set Option(penleft) [.pointer.penl.en get]
	set Option(penright) [.pointer.penr.en get]
	destroy .pointer
    }
    button .pointer.fb.bc -text $message(cancel) -command "destroy .pointer"
    menu .pointer.pmp -tearoff 0

    pack .pointer.po.lb .pointer.po.en .pointer.po.bt -side left -padx 2
    pack .pointer.pof.lb .pointer.pof.en .pointer.pof.bt -side left -padx 2
    pack .pointer.pob.lb .pointer.pob.en .pointer.pob.bt -side left -padx 2
    pack .pointer.penl.lb .pointer.penl.en .pointer.penl.bt -side left -padx 2
    pack .pointer.penr.lb .pointer.penr.en .pointer.penr.bt -side left -padx 2
    pack .pointer.fb.bt .pointer.fb.bo .pointer.fb.bc -side left
    pack .pointer.po .pointer.pof .pointer.pob .pointer.penl .pointer.penr \
	    .pointer.fb -pady 5

    wm geometry .pointer {}
    wm minsize .pointer 350 250
    wm maxsize .pointer 350 250
   
    .pointer.po.en delete 0 end
    .pointer.po.en insert 0 $Option(pointer)
    .pointer.pof.en delete 0 end
    .pointer.pof.en insert 0 $Option(pointerfg)
    .pointer.pob.en delete 0 end
    .pointer.pob.en insert 0 $Option(pointerbg)
    .pointer.penl.en delete 0 end
    .pointer.penl.en insert 0 $Option(penleft)
    .pointer.penr.en delete 0 end
    .pointer.penr.en insert 0 $Option(penright)
    setpointertest

    update
    focus .pointer
    grab .pointer
    tkwait window .pointer
    if {[winfo exists .view] == 1} {
	changepointer
    }
}

