#                   A P P L Y _ M A T . T C L
# BRL-CAD
#
# Copyright (c) 2004-2016 United States Government as represented by
# the U.S. Army Research Laboratory.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public License
# version 2.1 as published by the Free Software Foundation.
#
# This library is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this file; see the file named COPYING for more
# information.
#
###
#
#		A P P L Y _ M A T . T C L
#
# Procedures to apply matrices to objects in MGED
#
# Author - John R. Anderson
#

#
#	A P P L Y _ M A T _ T O _ R E G I O N S
#
# procedure to apply the provided matrix to the provided tree
# recurses until a region is encountered, where the matrix is applied at each leaf arc of the region.
# The matrix is not applied to any primitive encountered above the region level.
#
# Returns a new tree with the matrix applied

proc apply_mat_to_regions { tree mat } {
    set op [lindex $tree 0]
    switch -- $op {
	l
	{
	    set leaf [lindex $tree 1]
	    set new_leaf [$::cadwidgets::ged get $leaf]
	    set type [lindex $new_leaf 0]
	    if { $type != "comb" } {
		puts "WARNING: encountered primitive ($leaf) above region level!!!, ignoring"
		return $tree
	    }
	    if { [llength $tree] == 3 } {
		set old_mat [lindex $tree 2]
		set new_mat [mat_mul $mat $old_mat]
	    } else {
		set new_mat $mat
	    }
	    set index [lsearch -exact $new_leaf "region"]
	    if { $index < 0 } {
		error "ERROR: 'region' attribute missing from combination $leaf"
	    }
	    incr index
	    set region [lindex $new_leaf $index]
	    set index [lsearch -exact $new_leaf "tree"]
	    if { $index < 0 } {
		error "ERROR: no tree for combination $leaf"
	    }
	    incr index
	    set sub_tree [lindex $new_leaf $index]
	    if { $region == "yes" } {
		set new_tree [apply_mat_comb $sub_tree $new_mat]
	    } else {
		set new_tree [apply_mat_to_regions $sub_tree $new_mat]
	    }
	    set new_leaf [lreplace $new_leaf $index $index $new_tree]
	    set command [concat $::cadwidgets::ged adjust $leaf [lrange $new_leaf 1 end]]
	    if { [catch $command ret] } {
		error "ERROR: '$::cadwidgets::ged adjust' failed for combination $leaf\n\t$ret"
	    }
	    return [list l $leaf]
	}
	- -
	+ -
	u -
	n
	{
	    set left [lindex $tree 1]
	    set right [lindex $tree 2]
	    set new_left [apply_mat_to_regions $left $mat]
	    set new_right [apply_mat_to_regions $right $mat]
	    return [list $op $new_left $new_right]
	}
    }
}

#
#	A P P L Y _ M A T _ T O _ C O M B
#
# Apply provided matrix to the provided tree. This routine does not descend beyond the specified tree.
# The matrix is applied at each leaf arc in the tree.
#
# Returns the modified tree

proc apply_mat_comb { tree mat } {
    set op [lindex $tree 0]
    switch -- $op {
	l
	{
	    set leaf [lindex $tree 1]
	    if { [llength $tree] == 3 } {
		set old_mat [lindex $tree 2]
		set new_mat [mat_mul $mat $old_mat]
	    } else {
		set new_mat $mat
	    }
	    return [list "l" $leaf $new_mat]
	}
	- -
	+ -
	u -
	n
	{
	    set left [lindex $tree 1]
	    set right [lindex $tree 2]
	    set new_left [apply_mat_comb $left $mat]
	    set new_right [apply_mat_comb $right $mat]
	    return [list $op $new_left $new_right]
	}
    }
}

#
#	A P P L Y _ M A T
#
# This procedure applies the provided matrix to the list of objects specified.
# One of the "-primitives", "-regions", or "-top" options may be provided to specify
# where the matrix is to be applied (the default is "-top").
#
# If an object specified is a primitive, the matrix is pushed into the primitive.
#
# If "-primitives" is specified, then the matrix is applied at the top level object
# and "xpush" is used to push the changes to the primitive level.
#
# If "-regions" is specified, then the matrix is applied to each leaf in the first regions
# encountered as the tree is descended (matrices along the way are incorporated).
#
# If "-top" is specified (or no options are specified), then the matrix is applied to each
# leaf arc of the specified objects.
#
# Returns TCL_ERROR or TCL_OK

proc apply_mat { args } {
    set usage "Usage:\n\tapply_mat \[-primitives | -regions | -top\] matrix object1 \[object2 object3 ...\]"
    set argc [llength $args]
    if { $argc < 1 } {
	error $usage
    }
    set mat {}
    set objs {}
    set depth "top"
    set index 0
    while { $index < $argc } {
	set opt [lindex $args $index]
	switch -- $opt {
	    "-primitives" {
		set depth "primitives"
		incr index
	    }
	    "-regions" {
		set depth "regions"
		incr index
	    }
	    "-top" {
		set depth "top"
		incr index
	    }
	    default {
		break
	    }
	}
    }
    if { $index >= $argc } {
	error "No matrix or objects specified!!!\n$usage"
    }
    set mat [lindex $args $index]
    incr index
    if { $index >= $argc } {
	error "No objects specified!!!!\n$usage"
    }

    foreach obj [lrange $args $index end] {
	if { [catch "$::cadwidgets::ged get $obj" obj_db] } {
	    puts $obj_db
	    puts "WARNING: $obj does not exist, ignoring!!"
	    continue
	}

	set type [lindex $obj_db 0]
	if { $type != "comb" } {
	    # this is a primitive, so just apply the matrix
	    # using a temporary combination and a "push"
	    set tmp [$::cadwidgets::ged make_name ____]
	    $::cadwidgets::ged put $tmp comb region no tree [list l $obj $mat]
	    $::cadwidgets::ged push $tmp
	    $::cadwidgets::ged kill $tmp
	    continue
	}

	# The object is a combination
	set indx [lsearch -exact $obj_db tree]
	if { $indx < 0 } {
	    error "$obj does not have a Boolean tree!!!!"
	}
	incr indx
	set obj_tree [lindex $obj_db $indx]

	switch $depth {
	    "primitives" {
		set new_tree [apply_mat_comb $obj_tree $mat]
		$::cadwidgets::ged adjust $obj tree $new_tree
		$::cadwidgets::ged xpush $obj
	    }
	    "regions" {
		set new_tree [apply_mat_to_regions $obj_tree $mat]
		$::cadwidgets::ged adjust $obj tree $new_tree
	    }
	    "top" {
		set new_tree [apply_mat_comb $obj_tree $mat]
		$::cadwidgets::ged adjust $obj tree $new_tree
	    }
	}
    }
}

# Local Variables:
# mode: Tcl
# tab-width: 8
# c-basic-offset: 4
# tcl-indent-level: 4
# indent-tabs-mode: t
# End:
# ex: shiftwidth=4 tabstop=8