|
# This procedure frees memory allocated for SAA objects.
proc sexBehaviourFree {} {
global SAA_objectsID
foreach item [array names SAA_objectsID] {
if [catch { SAA_Free $SAA_objectsID($item) }
err] {
puts "$item
$err"
}
}
unset SAA_objectsID
}
# This init procedure is executed in init entry point.
proc initBehavior {} {
global env
package require SWC
package require SWU
global nbOfBabies
# Source file with the procedure that mixes colors of the parents.
source [file join $env(SI_LOCATION) 3D custom SoftWish \
SoftWishDemos behaviorDemo mixedColors.tcl]
settings [SWB_getScene]
set nbOfBabies 0
}
# This procedure is executed in update entry point.
proc sexBehaviour {} {
global SAA_Constants
global SAA_unConstants
global SAA_objectsID
global BirthFrame
global settings
global nbOfBabies
# Retrieve current scene.
set curSceneID [SWB_getScene]
# Retrieve the number of models in the scene.
SAA_sceneGetNbModels $curSceneID nbModels
# Retrieve names of the scene models and array with their IDs.
set listNames [ SWCSR_elementGetNames $curSceneID Models $nbModels \
SAA_objectsID(modelsID) ]
# Allocate some SAA auxiliary objects which will be used later.
set SAA_objectsID(curMatrixID) [SAA_AllocMatrix]
set SAA_objectsID(matrixID) [SAA_AllocMatrix]
set SAA_objectsID(babyID) [SAA_AllocElem]
set SAA_objectsID(childExpr) [ SAA_AllocElem ]
set count1 0
# For each model in the scene:
foreach item1 $listNames {
# Retrieve wire type of the model
SAA_elementGetWireType $curSceneID \
[access
$SAA_objectsID(modelsID) $count1] wireType
# If it is unvisible then continue with the next model.
if { $SAA_unConstants(SAA_WireType,$wireType)
!= "SAA_WIR_FULL" } {
incr count1
continue
}
# Check if a model can reproduce.
if { [ array names BirthFrame $item1 ] ==
$item1 } {
if { [ expr [
SWB_getCurrentFrame ] - $BirthFrame($item1) ] < $settings(maturity) } {
incr
count1
continue
}
}
# Retrieve data that are necessary for collision detection algorithm.
# Retrieve the transformation matrix.
SAA_modelGetMatrix $curSceneID [access
$SAA_objectsID(modelsID) $count1] \
$SAA_Constants(SAA_COORDSYS_GLOBAL)
$SAA_objectsID(curMatrixID)
# Retrieve bounding box for the sphere.
SAA_modelGetBoundingBox $curSceneID [access
$SAA_objectsID(modelsID) $count1] \
minX minY minZ maxX
maxY maxZ
# Save coordinates
set SAA_objectsID(curMinID) [ SWU_listToCArray
[list $minX $minY $minZ] float ]
set SAA_objectsID(curMaxID) [ SWU_listToCArray
[list $maxX $maxY $maxZ] float ]
set count2 [expr $count1 + 1]
# For each of the rest model:
foreach item2 [lrange $listNames $count2
$nbModels] {
# Retrieve wire type of the model
SAA_elementGetWireType
$curSceneID \
[access
$SAA_objectsID(modelsID) $count2] wireType
# If it is unvisible then continue with the next model.
if {
$SAA_unConstants(SAA_WireType,$wireType) != "SAA_WIR_FULL" } {
incr
count2
continue
}
# Check if a model can reproduce.
if { [ array names
BirthFrame $item2 ] == $item2 } {
if
{ [ expr [ SWB_getCurrentFrame ] - $BirthFrame($item2) ] < $settings(maturity) } {
incr
count2
continue
}
}
# Retrieve data that are necessary for collision detection algorithm.
# Get bounding box for the current model
SAA_modelGetBoundingBox
$curSceneID [access $SAA_objectsID(modelsID) \
$count2]
minX minY minZ maxX maxY maxZ
# Save its cooordinates in c arrays.
set
SAA_objectsID(minID) [ SWU_listToCArray [list $minX $minY $minZ] float ]
set
SAA_objectsID(maxID) [ SWU_listToCArray [list $maxX $maxY $maxZ] float ]
# Retrieve transformation matrix for the current model.
SAA_modelGetMatrix
$curSceneID [access $SAA_objectsID(modelsID) \
$count2]
$SAA_Constants(SAA_COORDSYS_GLOBAL) $SAA_objectsID(matrixID)
# Detect if models collide.
set result [
bbdetectcoll $SAA_objectsID(matrixID) $SAA_objectsID(curMatrixID) \
$SAA_objectsID(minID)
$SAA_objectsID(maxID) \
$SAA_objectsID(curMinID)
$SAA_objectsID(curMaxID)]
# I yes then:
if { $result == 1 } {
# Determine if models are of the same type. We assume that models have the same type if
# their names have the same character parts ( for example sphere1 and sphere2 )
regexp
{[A-Za-z]*} $item1 match1
regexp
{[A-Za-z]*} $item2 match2
# If models have the same type then:
if
{ [ string compare $match1 $match2] == 0 } {
# Create a new sphere and set the name "sphere" to it. Softimage automatically
adds
# numeric part to a name.
SAA_meshCreateSphere
$curSceneID 0.2 8 8 $SAA_objectsID(babyID)
set
babyName "sphere"
SAA_elementSetName
$curSceneID $SAA_objectsID(babyID) babyName
# Set expressions to etrnx, etrny of baby sphere, so they spiral.
# Get the position of birth.
SAA_modelGetTranslation
$curSceneID [access $SAA_objectsID(modelsID) \
$count2]
$SAA_Constants(SAA_COORDSYS_GLOBAL) X Y Z
incr
nbOfBabies
# Retrieve the new born baby name since it's different from "sphere" because it
also has
# a numeric part.
SAA_elementGetNameLength
$curSceneID $SAA_objectsID(babyID) length
SAA_elementGetName
$curSceneID $SAA_objectsID(babyID) [incr length] \
babyName
set
BirthFrame($babyName) [SWB_getCurrentFrame ]
set
exprStr "$X + ( Fc - [ SWB_getCurrentFrame ] + rand_0_1($nbOfBabies) )\
*
cos( (Fc - [ SWB_getCurrentFrame ]) * 20 + rand_0_1($nbOfBabies)) "
set
trackName etrnx
SAA_expressionCreate
$curSceneID $SAA_objectsID(babyID) \
trackName
0 NULL NULL exprStr $SAA_objectsID(childExpr)
set
exprStr "$Y + ( Fc - [ SWB_getCurrentFrame ] + rand_0_1($nbOfBabies))\
*
sin( ( Fc - [ SWB_getCurrentFrame ] ) * 20 + rand_0_1($nbOfBabies))"
set
trackName etrny
SAA_expressionCreate
$curSceneID $SAA_objectsID(babyID) \
trackName
0 NULL NULL exprStr $SAA_objectsID(childExpr)
# Set the color to the baby. The color is a mixture of the parent's colors.
mixedColors
$curSceneID [access $SAA_objectsID(modelsID) $count1] \
[access
$SAA_objectsID(modelsID) $count2] $SAA_objectsID(babyID)
}
# Free the memory and unset some variables.
}
SAA_Free
$SAA_objectsID(minID)
SAA_Free
$SAA_objectsID(maxID)
unset
SAA_objectsID(minID)
unset
SAA_objectsID(maxID)
incr count2
}
SAA_Free $SAA_objectsID(curMinID)
SAA_Free $SAA_objectsID(curMaxID)
unset SAA_objectsID(curMinID)
unset SAA_objectsID(curMaxID)
incr count1
}
sexBehaviourFree
}
# Update entry point
proc updateBehavior {} {
if [ catch { sexBehaviour } err ] {
return -code error "sexBehaviour >
$err"
}
}
# Cleanup entry point frees memory and unsets global variables.
proc cleanupBehavior {} {
catch { sexBehaviourFree }
}
# This prosedure creates widget where user can set maturity.
proc settings { sceneID } {
global settings
global done
package require Pop2Top
set done 2
wm withdraw .
# Create toplevel.
set t [toplevel .settings]
wm title $t "Settings"
# Get the number of the last frame in the scene.
SAA_sceneGetPlayCtrlEndFrame $sceneID endFrame
# Create scale.
scale $t.maturity -from 0 -to $endFrame -orient horizontal -variable
settings(maturity) \
-resolution 1 -length 150 -width 3
# Create label for the scale.
label $t.lm -text "Number of frames of baby maturity"
# pack scale and label.
grid $t.lm -row 0 -column 0 -sticky esn
grid $t.maturity -row 0 -column 1 -sticky e
# Create cancel and ok buttons.
set cf [frame $t.control]
button $cf.ok -text "Ok" -underline 0 -highlightcolor gray50
-command {global done; set done 1}
button $cf.cancel -text "Cancel" -underline 0 -highlightcolor
gray50 \
-command {global done; set done 0}
pack $cf.ok $cf.cancel -side left -pady 8 -padx 6
grid $cf -row 1 -column 0 -columnspan 2 -sticky ns
# Place widget on top of softimage window.
Pop2Top $t
# Wait till global variable done will be set.
tkwait variable done
destroy $t
if { $done == 0 } {
unset done
return -code error "tyty"
} else {
unset done
return
}
}
|
Shperes Sex Tcl Script