0026342: No materials are read from STEP
[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 #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"