samples/tcl/spheres.tcl

   1 # test performance of display of heavy scene involving multiple interactive
   2 # objects, on example of 1000 spheres
   3
   4 #Category: Visualization
   5 #Title: Display of complex scene and animation
   6
   7 pload MODELING
   8 pload VISUALIZATION
   9
  10 vinit View1 w=1024 h=1024
  11 vclear
  12
  13 # parameter NB defines number of spheres by each coordinate
  14 set NB 10
  15 puts "Creating [expr $NB * $NB * $NB] spheres..."
  16 set slist {}
  17 for {set i 0} {$i < $NB} {incr i} {
  18   for {set j 0} {$j < $NB} {incr j} {
  19     for {set k 0} {$k < $NB} {incr k} {
  20       psphere s$i$j$k 1.
  21       lappend slist s$i$j$k
  22       ttranslate s$i$j$k 3.*$i 3.*$j 3.*$k
  23     }
  24   }
  25 }
  26
  27 puts "Measuring FPS of display of spheres as separate objects..."
  28 vaxo
  29 vsetdispmode 1
  30 eval vdisplay $slist
  31 vfit
  32
  33 # measure FPS
  34 puts [set fps_separate [vfps]]
  35 vclear
  36
  37 puts "Measuring FPS of display of spheres as single object..."
  38 eval compound $slist c
  39 vdisplay c
  40
  41 # measure FPS
  42 puts [set fps_compound [vfps]]
  43 vclear
  44
  45 # redisplay individual spheres, trying to avoid unnecessary internal updates
  46 #vfrustumculling 0 ;# try to disable updates of frustum culling structures
  47 eval vdisplay -mutable $slist
  48
  49 # auxiliary procedure to make random update of variable
  50 proc upd {theValueName theDeltaName theTime theToRand} {
  51   upvar $theValueName aValue
  52   upvar $theDeltaName aDelta
  53
  54   # set colors to corner spheres
  55   if { $theToRand == 1 } {
  56     set aValue [expr $aValue + $aDelta * $theTime / 100.0]
  57     set aDelta [expr 0.5 * (rand() - 0.5)]
  58     return $aValue
  59   }
  60
  61   set aRes [expr $aValue + $aDelta * $theTime / 100.0]
  62 }
  63
  64 # move corner spheres in cycle
  65 proc animateSpheres {{theDuration 10.0}} {
  66   set nb [expr $::NB - 1]
  67
  68   # set colors to corner spheres
  69   for {set i 0} {$i < $::NB} {incr i $nb} {
  70     for {set j 0} {$j < $::NB} {incr j $nb} {
  71       for {set k 0} {$k < $::NB} {incr k $nb} {
  72 #       vaspects -noupdate s$i$j$k -setcolor red -setmaterial plastic
  73         vaspects -noupdate s$i$j$k -setcolor red
  74         set x$i$j$k  0.0
  75         set y$i$j$k  0.0
  76         set z$i$j$k  0.0
  77         set dx$i$j$k 0.0
  78         set dy$i$j$k 0.0
  79         set dz$i$j$k 0.0
  80       }
  81     }
  82   }
  83
  84   set aDuration 0.0
  85   set aPrevRand 0.0
  86   set aTimeFrom [clock clicks -milliseconds]
  87   uplevel #0 chrono anAnimTimer reset
  88   uplevel #0 chrono anAnimTimer start
  89   set toRand 1
  90   for {set aFrameIter 1} { $aFrameIter > 0 } {incr aFrameIter} {
  91     set aCurrTime [expr [clock clicks -milliseconds] - $aTimeFrom]
  92     if { $aCurrTime >= [expr $theDuration * 1000.0] } {
  93       puts "Nb Frames: $aFrameIter"
  94       puts "Duration:  [expr $aCurrTime * 0.001] s"
  95       set fps [expr ($aFrameIter - 1) / ($aDuration * 0.001) ]
  96       puts "FPS:       $fps"
  97       uplevel #0 chrono anAnimTimer stop
  98       uplevel #0 chrono anAnimTimer show
  99       return $fps
 100     }
 101
 102     set aRandTime [expr $aCurrTime - $aPrevRand]
 103     if { $aRandTime > 1000 } {
 104       set toRand 1
 105       set aPrevRand $aCurrTime
 106     }
 107
 108     #puts "PTS: $aCurrTime ms"
 109     for {set i 0} {$i < $::NB} {incr i $nb} {
 110       for {set j 0} {$j < $::NB} {incr j $nb} {
 111         for {set k 0} {$k < $::NB} {incr k $nb} {
 112           uplevel #0 vsetlocation -noupdate s$i$j$k [upd x$i$j$k dx$i$j$k $aRandTime $toRand] [upd y$i$j$k dy$i$j$k $aRandTime $toRand] [upd z$i$j$k dz$i$j$k $aRandTime $toRand]
 113         }
 114       }
 115     }
 116     uplevel #0 vrepaint
 117     set aDuration [expr [clock clicks -milliseconds] - $aTimeFrom]
 118     set toRand 0
 119
 120     # sleep 1 ms allowing the user to interact with the viewer
 121     after 1 set waiter 1
 122     vwait waiter
 123   }
 124 }
 125
 126 puts "Animating movements of corner spheres (10 sec)..."
 127 puts "(you can interact with the view during the process)"
 128 set fps_animation [animateSpheres 10.0]
 129
 130 puts ""
 131 puts "Performance counters (FPS = \"Frames per second\"):"
 132 puts ""
 133 puts "Spheres as separate interactive objects:"
 134 puts "  Actual FPS: [lindex $fps_separate 1]"
 135 puts "  FPS estimate by CPU load: [expr 1000. / [lindex $fps_separate 3]]"
 136 puts ""
 137 puts "Spheres as one interactive object (compound):"
 138 puts "  Actual FPS: [lindex $fps_compound 1]"
 139 puts "  FPS estimate by CPU load: [expr 1000. / [lindex $fps_compound 3]]"
 140 puts ""
 141 puts "Animation FPS: $fps_animation"
 142 puts ""
 143 puts "Scene contains [lindex [trinfo c] 3] triangles"
 144 puts ""
 145 puts "Print 'animateSpheres 10.0' to restart animation"