[ return ]

object.pl



#
# file: object.pl
#
#  Object-specific computations.
#

#
#     Copyright (C) 1995 Andrew H. Fagg (af0a@robotics.usc.edu)
#     
#     This program is free software; you can redistribute it and/or
#     modify it under the terms of the GNU General Public License
#     as published by the Free Software Foundation; either version 2
#     of the License, or any later version.
#     
#     This program 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 General Public License for more details.
#     
#     You should have received a copy of the GNU General Public License
#     along with this program; if not, write to the Free Software
#     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#

#
# sub compute_object_coding
#
#  Compute the neural coding for the specified object.
#
#

sub compute_object_coding
{
    local($oindex) = @_;	# Object index
    local(@parms, $shape, @vec, $parm);

				# Trick to make a vector of 0's
    @vec[0..$shape{"num"}-1] = split(//, "0" x $shape{num});

    $shape = $object{"shape", $oindex};	# Retrieve shape

				# Set shape element to 1
    $vec[$shape{"index", $shape}] = 1.0;

    @parms = split(':', $shape{"parms", $shape}); # Get the legal parms

    foreach $parm (@parms)
    {
				# Make sure parameter is defined
	defined $object{"parameter", $oindex, $parm} ||
	    die "compute_object_coding(): Object $oindex, parameter $parm not defined\n";

				# Code parameter in array
	@val = &value_to_gauss($object{"parameter", $oindex, $parm},
			       $gauss_min, $gauss_max, $gauss_std,
			       $gauss_size, $gauss_pad);

				# Stuff sub-array into @vec;
	splice(@vec, $shape{"pindex", $shape, $parm},
		      $gauss_size, @val);

				# Get the relative index in the array
				#  that represents the peak of the
				#  gaussian & a measure of its closeness
	($object{"parameter index", $i, $parm},
	 $object{"parameter match", $i, $parm}) =
	     &compute_max_gauss($object{"parameter", $oindex, $parm},
			       $gauss_min, $gauss_max, $gauss_std,
			       $gauss_size, $gauss_pad);

#	print "OBJECT: $oindex, $parm: " .
#	    $object{"parameter index", $i, $parm} .
#		" " . @val[$object{"parameter index", $i, $parm}] . "\n";

				# Make the index absolute in the PIP array.
	$object{"parameter index", $i, $parm} +=
	    $shape{"pindex", $shape, $parm};

#	print "OBJ: $oindex, $parm: " .
#	    $object{"parameter index", $i, $parm} .
#		" " . @vec[$object{"parameter index", $i, $parm}] . "\n";

    };
				# Set final code
    $object{"code", $oindex} = join(':', @vec);
};


#
# sub compute_all_object_coding
#
#  Loop through all objects and compute how they are to be coded
# in PIP
#
#  Also generates the max and min joint values that are used to
# simulate contact with the object.
#

sub compute_all_object_coding
{
    local($i);

    for($i=0; $i < $object{"num"}; ++$i)
    {
	&compute_object_coding($i);
	
    };
}


#
#  sub dump_nsl_objects
#
#   Loop through all objects and create a .nsl file that
# describes each.  These are placed within the .objects/ 
# directory.
#


sub dump_nsl_objects
{
    local($base) = @_;

    local($i, @code, $dir, $fname, $name);
    local($grasp, @grasps);
    local($gt, $gi);
    local(%tmap) = ();

    print "Generating Object Files...\n";
				# Directory
    $dir = $base . ".objects";

    mkdir($dir, 0777);		# Create it
    
    for($i=0; $i < $object{"num"}; ++$i)
    {
	%tmap = ();
				# Object name
	$name = $object{"name", $i};
				# File name to create
	$fname = $dir . "/" . $name . ".nsl";
				# Open the file
	open(FP, ">$fname") || die "Can't open file $fname.\n$_";
	
				# Write header
	print FP "// Object: $name\n\n";
				# Write neural code for object
	print FP "set data_value PIP_INPUT ";
	@act = split(/:/, $object{"code", $i});
	foreach $val (@act)	# Loop through each neuron.
	{
	    print FP "$val ";
	};
	print FP "\n";
				# Write out max and min flexion for joints 
				#  when grasping the object
				# We have one such pair for each grasp type.

				# Search through each grasp that maps to
				#  this object (we assume that each grasp
				#  type occurs once in this list

	@grasps = split(':', $ogmap{"grasps", $name});

	foreach $grasp (@grasps)
	{
	    $gi = $grasp{"index", $grasp}; # Index in the grasp structure
	    $gt = $grasp{"type", $gi};     # The type of the grasp

				# Run through each joint
	    foreach $j (@JOINTS)
	    {
				# Jacobian tells us whether to expect
				#  contact.  < 0 -> joint value is increasing
				#  when contact is made, >0 -> decreasing.

				# Remember final pos for non-zero jacobian
				#  values
		if($grasp{"jacobian", $gi, $j} < 0)
		{
		    $tmap{"max", $gt, $j} = $grasp{"final pos", $gi, $j};
		}
		elsif($grasp{"jacobian", $gi, $j} > 0)
		{
		    $tmap{"min", $gt, $j} = $grasp{"final pos", $gi, $j};
		};
	    };
	};
				# Now loop through each grasp type and
				#  generate the min/max values for each.

	foreach $gt (@GRASP_TYPES)
	{
	    print FP "set data_value max_flexion_hold_$gt ";

				# Loop through each joint.
	    foreach $j (@JOINTS)
	    {
				# If we defined above, then there is a max
				#  value, otherwise use default.

		if(defined $tmap{"max", $gt, $j})
		{
		    print FP $tmap{"max", $gt, $j} . " ";
		}
		else
		{
		    print FP "$JOINT_MAX ";
		}
	    };
	    print FP "\n";

				# Now do min joint values.
	    print FP "set data_value min_flexion_hold_$gt ";
	    foreach $j (@JOINTS)
	    {
		if(defined $tmap{"min", $gt, $j})
		{
		    print FP $tmap{"min", $gt, $j} . " ";
		}
		else
		{
		    print FP "$JOINT_MIN ";
		}
	    };
	    print FP "\n";


	};
				# Clean up.
	close FP;
    };
    
};


1;


[ return ]