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