
# Undo and redo stuff.
#
# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California
#

proc undo_reset {} {
    global undo_log redo_log undo_tag redo_tag undo_in_group
    
    set undo_tag 0
    set redo_tag 0
    catch {unset undo_log}
    catch {unset redo_log}
    set undo_in_group 0
}

proc undo_group {on} {
    global undo_in_group undo_tag redo_tag undo_log
    if {$on && !$undo_in_group} {
	catch {unset undo_log($undo_tag)}
	catch {unset redo_log($undo_tag)}
	set undo_in_group 1
    } elseif {!$on && $undo_in_group} {
	set undo_in_group 0
	if [info exists undo_log($undo_tag)] {
	    incr undo_tag
	    set redo_tag $undo_tag
	}
    }
}
	
proc undo_record {undo redo} {
    global undo_log redo_log undo_tag redo_tag undo_inactive undo_in_group
    
    if [info exists undo_inactive] return
    
    #puts "record: $undo $redo"
    if $undo_in_group {
	if [info exists undo_log($undo_tag)] {
	    append undo_log($undo_tag) "; $undo"
	} else {
	    set undo_log($undo_tag) $undo
	}
	if [info exists redo_log($undo_tag)] {
	    append redo_log($undo_tag) "; $redo"
	} else {
	    set redo_log($undo_tag) $redo
	}
    } else {
	set undo_log($undo_tag) $undo
	set redo_log($undo_tag) $redo
	incr undo_tag
	set redo_tag $undo_tag
    }
}

proc undo_action {} {
    global undo_tag undo_log undo_inactive errorInfo
    
    if [info exists undo_inactive] return
    undo_group 0
    if !$undo_tag {
	mess "Can't undo any more operations.\n" red
	return
    }
    
    incr undo_tag -1
    set undo_inactive 1
    set bad [catch {uplevel \#0 $undo_log($undo_tag)} res]
    unset undo_inactive
    if $bad { puts $errorInfo; puts "CMD: uplevel \#0 $undo_log($undo_tag)"; error $res }
    #puts "undo: $undo_log($undo_tag)"
}

proc redo_action {} {
    global undo_tag undo_log redo_log redo_tag undo_inactive errorInfo
    
    if [info exists undo_inactive] return
    
    if {$redo_tag == $undo_tag} {
	mess "Can't redo any more operations.\n" red
	return
    }
    
    set undo_inactive 1
    set bad [catch {uplevel \#0 $redo_log($undo_tag)} res]
    unset undo_inactive
    incr undo_tag
    if $bad {  puts $errorInfo; error $res }
}

proc last_redo_command {} {
    global redo_log undo_tag
    
    set tag [expr $undo_tag - 1]
    if [info exists redo_log($tag)] {
	return $redo_log($tag)
    } else {
	return ""
    }
}

# ----------------------------------

# Vals consists of a list with name oldval newval

proc undo_record_change_shape {args} {
    #puts "change shape $sh $vals"
    
    set all_undo ""; set all_redo ""
    foreach {sh vals} $args {
	set obj [$sh get -object]
	set undo [list undo_set_shape_values [$obj getval obtype] \
		      [$obj getval name] [$sh get -name]]
	set redo $undo
	
	foreach v $vals {
	    lappend undo [lindex $v 0] [lindex $v 1]
	    lappend redo [lindex $v 0] [lindex $v 2]
	}
	append all_undo "$undo; "
	append all_redo "$redo; "
    }
    undo_record $all_undo $all_redo
}

proc undo_record_move_shape {sh commands} {
    set obj [$sh get -object]
    set undo [list undo_do_move_shape [$obj getval obtype] \
		  [$obj getval name] [$sh get -name]]
    set redo $undo
    
    set undo_c ""
    foreach c $commands {
	lappend redo $c
	switch [lindex $c 0] {
	    translate {
		foreach p {0 1 2} { set p$p [expr -[lindex [lindex $c 1] $p]] }
		set c2 [list translate [list $p0 $p1 $p2]]
	    }
	    rotate {
		set c2 [list rotate [lindex $c 1] [expr 360-[lindex $c 2]] \
			    [lindex $c 3]]
	    }
	    scale {
		set v2 ""
		foreach p {0 1 2} {
		    set v [lindex [lindex $c 1] $p]
		    if {$v != ""} {
			lappend v2 [expr 1/($v+0.0)] }
		}
		set c2 [list scale $v2 [lindex $c 2]]
	    }
	    mirror {
		set c2 $c
	    }
	}
	set undo_c [concat [list $c2] $undo_c]
    }
    set undo [concat $undo $undo_c]
    
    undo_record $undo $redo
}

proc undo_record_change_shtype {sh ntype {otype ""}} {
    #puts "change shtype $sh $ntype"
    
    if {$otype == ""} { set otype [string range [$sh get -type] 6 end] }
    set obj [$sh get -object]
    set undo [list undo_set_shape_type [$obj getval obtype] \
		  [$obj getval name] [$sh get -name]]
    set redo $undo
    lappend undo $otype
    lappend redo $ntype
    undo_record $undo $redo
}

proc undo_record_change_object {obj vals {oname ""}} {
    if {$oname == ""} { set oname [$obj getval name] }
    set undo [list undo_set_object_values [$obj getval obtype] \
		  [$obj getval name]]
    set redo [list undo_set_object_values [$obj getval obtype] $oname]

    foreach v $vals {
	lappend undo [lindex $v 0] [lindex $v 1]
	lappend redo [lindex $v 0] [lindex $v 2]
    }
    undo_record $undo $redo
}

proc undo_record_change_object_category {obj what old new shvals} {
    set undo [list undo_set_object_category [$obj getval name] \
		  $what $old $shvals]
    set redo [list undo_set_object_category [$obj getval name] \
		  $what $new ""]
    
    undo_record $undo $redo
}

proc undo_record_create {obj} {
    set undo [list undo_delete_object [$obj getval obtype] \
		  [$obj getval name]]
    set redo [list undo_create_object [$obj getval obtype] \
		  [$obj getval name] "" ""]
    undo_record $undo $redo
}

proc undo_record_create_full {obj} {
    undo_record_create_delete $obj 1
}

proc undo_record_delete {objects} {
    undo_record_create_delete $objects 0
}

proc undo_record_create_delete {objects create} {
    set cre ""
    set del ""
    foreach obj $objects {
	set obp ""
	foreach xx [$obj list_values] {
	    if [string match *_shape [lindex $xx 0]] continue
	    lappend obp [lrange $xx 0 1]
	}
	set shp ""
	foreach s [$obj getval section_list] {
	    set sh [$obj getval ${s}_shape]
	    set st [lindex [split [$sh get -type] _] 1]
	    set sp [$sh list_values canset nooffset]
	    lappend shp [list $s $st $sp]; #[lrange $sp 0 1] ???
	}
	append cre "[list undo_create_object [$obj getval obtype] \
			[$obj getval name] $obp $shp] ;"
	append del "[list undo_delete_object [$obj getval obtype] \
			[$obj getval name]] ;"
    }
    if $create {
	undo_record $del $cre
    } else {
	undo_record $cre $del
    }
}

proc undo_record_trash {objs in} {
    set names ""
    foreach o $objs { lappend names [$o getval name] }
    undo_record [list undo_trash $names [expr !$in]] \
	[list undo_trash $names $in]
}

proc undo_record_switch_model {obj prev} {
    set root [part_get_root]
    if {$obj == $root} {
	set objn [list undo_switch_model top ""]
    } else {
	set objn [list undo_switch_model obj [$obj getval name]]
    }
    if {$prev == $root} {
	set prevn [list undo_switch_model top ""]
    } else {
	set prevn [list undo_switch_model obj [$prev getval name]]
    }
    
    undo_record $prevn $objn
}

proc undo_record_change_active {obj} {
    set ch [list edit_toggle_current_active $obj 1 0]
    undo_record $ch $ch
}

proc undo_record_move_to_part {part objs} {
    set undo [list undo_move_to_part ""]
    set redo [list undo_move_to_part [$part getval name]]
    foreach obj $objs {
	lappend undo [$obj getval obtype] [$obj getval name]
	lappend redo [$obj getval obtype] [$obj getval name]
    }
    undo_record $undo $redo
}

# ----------

proc undo_set_object_values {type name args} {
    global current_object model_data model_container

    set obj [db_get_name $name]
    if {$obj == ""} return ;# somehow we got messed up here

    if {($type == "part") && ([$obj getval part_type] == "external")} {
	set nargs ""
	foreach {n a} $args {
	    switch -- $n {
		part_job_loaded { set n part_job }
	    }
	    lappend nargs $n $a
	}
	set args $nargs
	part_unload $obj
    }
    eval $obj setval $args
    #puts "$obj setval $args"
    if {$obj == $current_object} {
	edit_object_to_var $obj model_data model_data_units
    }
    set nname [$obj getval name]
    if {$nname != $name} {
	# Update the selection window.
	$model_container remove $name
	$model_container add $nname $obj

	edit_selection_rename $name $nname
	if {$type != "domain"} {
	    relabel_shapes $obj
	}
    }
    if {($type == "part") && ([$obj getval part_type] == "external") && ([$obj getval part_job] != "")} {
	part_load $obj
    }
    # This is generally needed for compound objects when it's the shtype that
    # is being undone (e.g. 3d fans)
    app_clean_up_[$obj getval obtype] $obj
    foreach sh [db_shapes $obj] {
        update_decorations $sh
    }
}

proc undo_set_shape_values {type name section args} {
    global current_shape shape_data

    set obj [db_get_name $name]
    set sh [$obj getval ${section}_shape]
    # This is wierd ...
    if {([$sh get -shtype] == "polygon") || ([$sh get -shtype] == "pipe")} {
	set nargs ""
	foreach {p v} $args {
	    if {$p == "nverts"} {
		$sh setval $p $v
	    } else {
		lappend nargs $p $v
	    }
	}
	set args $nargs
    }
    
    # Now we have to go through and set the expressions and regular parameters
    # separately.
    set args1 ""; set args2 ""
    foreach {p v} $args {
	if [string match *\$* $v] {
	    $sh setexpr $p $v
	} else {
	    $sh setval -noconstr $p $v
	    $sh setexpr $p ""
	}
    }
    if {$sh == $current_shape} {
	$sh to_var shape_data shape_data_units
	if {([$sh get -shtype] == "polygon") || ([$sh get -shtype] == "pipe")} {
	    edit_poly_changes
	}
	if {[$sh get -shtype] == "container"} update_container_bbvars
    }
    
    # Sometimes the data needs to get copied back from the shape to the object
    # e.g. fans
    set func [info command app_clean_up_[$obj getval obtype]]
    if {$func != ""} { $func $obj }
    
    update_decorations $sh
    db_dirty mesh
}

proc undo_set_object_category {name what val shvals} {
    global current_object current_shape
    set obj [db_get_name $name]
    if {$obj != $current_object} { model_set_current $obj }
    edit_set_category $what $val 0
    if {$shvals != ""} {
	eval undo_set_shape_values [$obj getval obtype] [list [$obj getval name]] [$current_shape get -name] $shvals
    }
}

proc undo_do_move_shape {type name section args} {
    global current_shape shape_data
    
    set obj [db_get_name $name]
    set sh [$obj getval ${section}_shape]
    set type [$obj getval obtype]
    set appfunc [info commands app_transform_$type]
    
    foreach a $args {
	if {$appfunc == ""} {
	    eval $sh $a
	} else {
	    eval $appfunc $sh $a
	    app_clean_up_$type $obj
	}
    }
    if {$sh == $current_shape} {
	$sh to_var shape_data shape_data_units
	if {[$sh get -shtype] == "container"} update_container_bbvars
    }
    update_decorations $sh
    db_dirty mesh
}

proc undo_set_shape_type {type name section shtype} {
    global current_shape shape_data type_visible
    
    set obj [db_get_name $name]
    set sh [$obj getval ${section}_shape]
    $sh configure -exp_shape $shtype
    if {$sh == $current_shape} {
	edit_set_category stype $shtype
    } else {
	create_shapes $obj
	if [info exists type_visible($type)] {
	    make_visible $obj $type_visible($type)
	}
	update_decorations [$obj getval ${section}_shape]
    }
    db_dirty mesh
}

proc undo_create_object {type name obparams shparams} {
    global current_object current_shape model_data shape_data
    
    set shapetypes ""
    foreach shp $shparams {
	lappend shapetypes [lrange $shp 0 1]
    }
    
#    update_mtype $type
    set obj [edit_new $type $name 0 $shapetypes]
    eval eval $obj setval $obparams ;# This is kind of bogus
    #puts "$obj setval $obparams"
    edit_object_to_var $obj model_data model_data_units
    foreach shp $shparams {
	set sh [$obj getval [lindex $shp 0]_shape]
	if {$sh != ""} {
	    eval eval $sh setval -noconstr [lindex $shp 2] ;# Kind of bogus
	    update_decorations $sh
	    if {$sh == $current_shape} {
		$sh to_var shape_data shape_data_units
		if {[$sh get -shtype] == "container"} update_container_bbvars
	    }
	}
    }
    set fn app_clean_up_$type
    if {$fn != ""} { $fn $obj }
    model_set_current $obj
}

proc undo_delete_object {type name} {
    edit_delete 0 [db_get_name $name]
}

proc undo_trash {names in} {
    set objs ""
    foreach n $names { lappend objs [db_get_name $n] }
    
    if $in {
	foreach obj $objs { trash_add $obj 0 }
    } else {
	trash_remove $objs "" 0 0
    }
}

proc undo_switch_model {how name} {
    global model_container current_object
    
    set prev $model_container
    
    if {$how == "top"} {
	set obj [part_get_root]
    } else {
	set obj [db_get_name $name]
    }
    
    if {$obj != ""} { part_do_switch_model $obj }
}

proc undo_move_to_part {partname args} {
    global model_container_root
    if {$partname == ""} {
	set to $model_container_root
    } else {
	set to [db_get_name $partname]
    }
    set objects ""
    foreach {t n} $args {
	set obj [db_get_name $n]
	lappend objects $obj
    }
    #objects_to_part $objects $to
    part_move_object_into $to $objects [tree_part_is_open $to] 0
}
