
# Annotation-related commands.
#
# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California
#

proc annotation_form {} {
    global tdv_default
    global annotation_type icepak_root is_win annotation_on
    
    if {[info command control_anno] != ""} {
	# not ready for this yet
	#control_anno .v.view
	#return
    }
    
    set annotation_on 1
    
    set d [form_init .annos "Annotations" "" {accept reset cancel help}]
    if {$d != ""} {
	form_frame $d.fr sunken 3 {0 0}; set d $d.fr
	form_checkbutton $d.titl Title tdv_title_var($tdv_default) {1 1 -cols -}
	form_checkbutton $d.date Date tdv_date_var($tdv_default) {2 1 -cols -}
	if [info exists icepak_root] {
	    form_checkbutton $d.logo Logo annotation_type(logo) {3 1 -cols -}
	}
	foreach xx {
	    {Arrows arrow 11} {Text text 12} 
	    {Lines line 13} {Markers mark 14}
	} {
	    set t [lindex $xx 1]
	    form_checkbutton $d.check_$t [lindex $xx 0] \
		annotation_type($t) "[lindex $xx 2] 1 -cols 2"
	    form_button $d.add_$t Add "annotation_add $t" \
		"[lindex $xx 2] 3" annotation_type($t)
	    form_button $d.edit_$t Edit "annotation_edit $t" \
		"[lindex $xx 2] 4" annotation_type($t)
	    form_button $d.remove_$t Remove "annotation_remove $t" \
		"[lindex $xx 2] 5" annotation_type($t)
	    form_button $d.clear_$t Clear "annotation_clear $t" \
		"[lindex $xx 2] 6" annotation_type($t)
	}
	trace variable annotation_type w "annotation_update; list"
	trace variable annotation_on w "annotation_update; list"
	
	form_label $d.pl "For new annotations:" {20 1 -cols -}
	form_frame $d.p flat 0 {21 1 -cols -}
	form_label $d.p.coll "Color:" {0 0}
	form_label $d.p.widl "Line width:" {1 0}
	form_label $d.p.sizl "Point size:" {2 0}
	form_entry $d.p.col annotation_color string {0 1}
	form_entry $d.p.wid annotation_width string {1 1}
	form_entry $d.p.siz annotation_pointsize string {2 1}
	
	form_finish bot
    }
}

proc annotation_update {} {
    global annotation_on annotation_type annotation_image
    global annotation_color annotation_width tdv_date_var tdv_title_var
    
    if !$annotation_on {
	foreach t [array names annotation_image] {
	    foreach im $annotation_image($t) {
		$im configure -visible 0
	    }
	}
	
    } else {
	foreach t [array names annotation_type] {
	    switch $t {
		logo {
		    if [info exists annotation_image($t)] {
			$annotation_image($t) configure \
			    -visible $annotation_type($t)
		    } elseif $annotation_type($t) {
			set annotation_image($t) [annotation_create_$t]
		    }
		}
		arrow - text - line - mark {
		    if [info exists annotation_image($t)] {
			foreach im $annotation_image($t) {
			    $im configure -visible $annotation_type($t)
			}
		    }
		}
	    }
	}
    }
}

proc annotation_add {type} {
    global tdv_default view_panes
    global annotation_image
    global annotation_color annotation_width annotation_pointsize
    
    while 1 {
	switch $type {
	    arrow {
		banner "Select the first point with the left button; middle = finish."
		set p1 [tdv_obtain_screen_pos $view_panes(all_viewers)]
		if {$p1 == ""} break
		banner "Select the second point with the left button; middle = finish."
		set p2 [tdv_obtain_screen_pos $view_panes(all_viewers)]
		if {$p2 == ""} break
		set cmd [list tdv_arrow_geo -transform 0 \
			     -point1 "$p1 0" -point2 "$p2 0" \
			     -color $annotation_color -width $annotation_width]
	    }
	    line {
		banner "Select the first point with the left button; middle = finish."
		set p1 [tdv_obtain_screen_pos $view_panes(all_viewers)]
		if {$p1 == ""} break
		banner "Select the second point with the left button; middle = finish."
		set p2 [tdv_obtain_screen_pos $view_panes(all_viewers)]
		if {$p2 == ""} break
		set cmd [list tdv_line_im -transform 0 -point1 "$p1 0" -point2 "$p2 0" \
			     -color $annotation_color -width $annotation_width]
	    }
	    text {
		banner "Select the location with the left button; middle = finish."
		set p1 [tdv_obtain_screen_pos $view_panes(all_viewers)]
		if {$p1 == ""} break
		set text [question_box .text_anno Text "Enter the text"]
		if {$text == ""} break
		set cmd [list tdv_text_im -transform 0 -point "$p1 0" -text $text \
			     -color $annotation_color]
	    }
	    mark {
		banner "Select the location with the left button; middle = finish."
		set p1 [tdv_obtain_screen_pos $view_panes(all_viewers)]
		if {$p1 == ""} break
		set cmd [list tdv_point_im -transform 0 -point "$p1 0" \
			     -color $annotation_color -size $annotation_pointsize]
	    }
	}
	annotation_create $type $cmd
    }
    banner ""
}

proc annotation_create {type cmd} {
    global tdv_default annotation_image
    
    set im [eval $cmd]
    
    $tdv_default add_image $im
    $tdv_default add_tag $im annotation_$type
    lappend annotation_image($type) $im
}

proc annotation_remove {type} {
    global tdv_default view_panes
    global annotation_image
    
    while 1 {
	banner "Select the $type annotation to remove with the left button; middle = finish."
	set pos [tdv_obtain_screen_pos $view_panes(all_viewers)]
	if {$pos == ""} break
	set stuff [$tdv_default pick [lindex $pos 0] [lindex $pos 1] \
		       annotation_$type "" 10]
	set im [lindex $stuff 0]
	if {$im == ""} {
	    mess "No $type selected\n" red
	} else {
	    $im delete
	    set annotation_image($type) [ldelete $annotation_image($type) $im]
	}
    }
    banner ""
}

proc annotation_edit {type} {
    global tdv_default view_panes
    global annotation_image tdv_waiting_for_click tdv_waiting_for_motion
    
    banner "Move $type annotations with the middle button; right = modify, left = finish."
    
    switch $type {
	text  { set posnames point }
	mark  { set posnames point }
	line  { set posnames "point1 point2" }
	arrow { set posnames "point1 point2" }
    }
    
    set w $tdv_default
    set pcursor [$w get -cursor]
    tdv_cur $view_panes(all_viewers) pick
    while 1 {
	set tdv_waiting_for_click($w) 1
	
	tkwait variable tdv_waiting_for_click($w)
	if ![info exists tdv_waiting_for_click($w)] break
	
	set pos [lrange $tdv_waiting_for_click($w) 1 end] 
	set stop 0
	switch [lindex $tdv_waiting_for_click($w) 0] {
	    1 { set stop 1 }
	    2 { set move 1 }
	    3 { set move 0 }
	}
	if $stop break
	
	set stuff [$tdv_default pick [lindex $pos 0] [lindex $pos 1] \
		       annotation_$type "" 10]
	set im [lindex $stuff 0]
	if {$im == ""} {
	    mess "No $type selected\n" red
	    continue
	}
	set spec [lindex $stuff 1]
	set opos [lindex $stuff 2]
	
	if $move {
	    set movenames $posnames
	} else {
	    switch $type {
		line - arrow {
		    if {$spec > 0.5} {
			set movenames point2
		    } else {
			set movenames point1
		    }
		}
		default { set movenames $posnames }
	    }
	}
	foreach p $movenames {
	    set origpos($p) [$im get -$p]
	}
	
	if {!$move && ($type == "text")} {
	    set text [question_box .text_anno Text "Enter the text" \
			  [$im get -text]]
	    if {$text != ""} { $im configure -text $text }
	    
	} else {
	    while 1 {
		set tdv_waiting_for_motion($w) 1
		tkwait variable tdv_waiting_for_motion($w)
		if {$tdv_waiting_for_motion($w) == ""} break
		
		set np $tdv_waiting_for_motion($w)
		set dx [expr {[lindex $np 0] - [lindex $opos 0]}]
		set dy [expr {[lindex $np 1] - [lindex $opos 1]}]
		
		foreach p $movenames {
		    set op $origpos($p)
		    $im configure -$p [list [expr {[lindex $op 0] + $dx}] \
					    [expr {[lindex $op 1] + $dy}] \
					    [lindex $op 2]]
		}
	    }
	}
    }
    banner ""
    catch {unset tdv_waiting_for_click($tdv_default)}
    catch {unset tdv_waiting_for_motion($tdv_default)}
    $w configure -cursor $pcursor
}

proc annotation_clear {type} {
    global annotation_image
    
    if {$type == "all"} {
	foreach type [array names annotation_image] {
	    annotation_clear $type
	}
	return
    }
    if [info exists annotation_image($type)] {
	foreach im $annotation_image($type) {
	    $im delete
	}
	unset annotation_image($type)
    }
}

proc annotation_create_logo {} {
    global tdv_default
    global tool_logo_ppm
    
    set t [tdv_pixmap_im -transform 0 -pos {10 100 0} -ppmfile $tool_logo_ppm]
    $tdv_default add_image $t
    return $t
}

proc annotation_save {file} {
    global annotation_image annotation_type
    global annotation_width annotation_pointsize
    global annotation_color annotation_on
    global tdv_date_var tdv_title_var tdv_default
    
    if ![info exists annotation_on] return
    
    set fp [open $file w]
    puts $fp "set tdv_date_var(\$tdv_default) $tdv_date_var($tdv_default)"
    puts $fp "set tdv_title_var(\$tdv_default) $tdv_title_var($tdv_default)"
    foreach v {on color pointsize width} {
	puts $fp "set annotation_$v \"[set annotation_$v]\""
    }
    puts $fp "array set annotation_type \{[array get annotation_type]\}"
    foreach type [array names annotation_image] {
	foreach im $annotation_image($type) {
	    switch $type {
		arrow {
		    set cmd [list tdv_arrow_geo -transform 0 \
				 -point1 [$im get -point1] \
				 -point2 [$im get -point2] \
				 -color [$im get -color] \
				 -width [$im get -width]]
		}
		line {
		    set cmd [list tdv_line_im -transform 0 \
				 -point1 [$im get -point1] \
				 -point2 [$im get -point2] \
				 -color [$im get -color] \
				 -width [$im get -width]]
		}
		text {
		    set cmd [list tdv_text_im -transform 0 \
				 -point [$im get -point] \
				 -text [$im get -text] \
				 -color [$im get -color]]
		}
		mark {
		    set cmd [list tdv_point_im -transform 0 \
				 -point [$im get -point] \
				 -color [$im get -color] \
				 -size [$im get -size]]
		}
		default continue
	    }
	    puts $fp "annotation_create $type \{$cmd\}"
	}
    }
    puts $fp "annotation_update"
    close $fp
}
