Xcos: updated TKSCALE simulation function

[scilab.git] / scilab / modules / scicos_blocks / macros / Sources / tkscaleblk.sci

diff --git a/scilab/modules/scicos_blocks/macros/Sources/tkscaleblk.sci b/scilab/modules/scicos_blocks/macros/Sources/tkscaleblk.sci
index eb333b3..8a27d79 100644 (file)
--- a/scilab/modules/scicos_blocks/macros/Sources/tkscaleblk.sci
+++ b/scilab/modules/scicos_blocks/macros/Sources/tkscaleblk.sci
@@ -1,6 +1,6 @@
 //  Scicos
 //
-//  Copyright (C) INRIA - METALAU Project <scicos@inria.fr>
+// Copyright (C) DIGITEO - Clément DAVID <clement.david@scilab.org>
 //
 // 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
@@ -14,53 +14,96 @@
 //
 // 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.
+// Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 //
 // See the file ../license.txt
 //
 
 function block=tkscaleblk(block,flag)
-  blknb=string(curblock())
-  if flag==4 then
-    cur=%cpr.corinv(curblock())
-    if size(cur,'*')==1 then // open widget only if the block 
-                             // is in main Scicos editor window
-      o=scs_m.objs(cur).graphics.orig;
-      sz=scs_m.objs(cur).graphics.sz
-      pos=point2pixel(1000,o)
-      pos(1)=pos(1)+width2pixel(1000,sz(1)) // widget position 
-      geom='wm geometry $w +'+string(pos(1))+'+'+ string(pos(2));
-      titled=block.label
-      if titled==[] then titled="TK source",end
-      tit='wm title $w Scale'+blknb // write block label
-      bounds=block.rpar(1:2)
-      bnds='-from '+string(bounds(1))+' -to '+string(bounds(2))
-      cmd='-command ""f'+blknb+' $w.frame.scale""'
-      lab='-label ""'+titled+'""';
-      L='-length 100'
-      I='-tickinterval '+string((bounds(2)-bounds(1))/4)
-      scale=strcat(['scale $w.frame.scale -orient vertical',..
-                    lab,bnds,cmd,L,I],' ')
-      initial=mean(bounds) // initial value is the mean
-      txt=['set w .vscale'+blknb;
-           'set y'+blknb+' 0';
-           'catch {destroy $w}';
-           'toplevel $w';
-           tit
-           geom
-           'frame $w.frame -borderwidth 10';
-           'pack $w.frame';
-           scale
-           'frame $w.frame.right -borderwidth 15';
-           'pack $w.frame.scale -side left -anchor ne';
-           '$w.frame.scale set '+string(initial);
-           'proc f'+blknb+' {w height} {global y'+blknb+';set y'+blknb+' $height}'
-          ];
-      TCL_EvalStr(txt) // call TCL interpretor to create widget
-      block.outptr(1)=mean(block.rpar(1:2))/block.rpar(3);
+    if flag == 1 then
+        // Output update
+        slider = get(block.uid + "#slider");
+
+        if slider <> [] then
+            // calculate real value
+            value = (block.rpar(1) + block.rpar(2) + get(slider,"value")) / block.rpar(3);
+
+            w = get(block.uid);
+            if w <> [] then
+                set(w, "info_message", string(value));
+            end
+
+            block.outptr(1) = value;
+        end
+    elseif flag == 4 then
+        // Initialization
+
+        // if already exists (stopped) then reuse
+        f = get(block.uid);
+        if f <> [] then
+            return;
+        end
+
+        f = figure("Figure_name", "TK Source: " + block.label, ...
+        "dockable", "off", ...
+        "infobar_visible" , "on", ...
+        "toolbar", "none", ...
+        "menubar_visible", "off", ...
+        "menubar", "none", ...
+        "backgroundcolor", [1 1 1], ...
+        "default_axes", "off", ...
+        "figure_size", [180 350], ...
+        "layout", "border", ...
+        "figure_position", [40 40], ...
+        "Tag", block.uid);
+
+        frame_slider = uicontrol(f, ...
+        "style", "frame", ...
+        "constraints", createConstraints("border", "left", [180, 0]), ...
+        "border", createBorder("line", "lightGray", 1), ...
+        "backgroundcolor", [1 1 1], ...
+        "layout", "gridbag");
+
+        // slider
+        bounds = block.rpar(1:2);
+        initial = mean(bounds);
+        uicontrol(frame_slider, ...
+        "Style", "slider", ...
+        "Tag", block.uid + "#slider", ...
+        "Min", bounds(1), ...
+        "Max", bounds(2), ...
+        "Value", initial, ...
+        "Position", [0 0 10 20], ...
+        "SliderStep", [block.rpar(3) 2*block.rpar(3)]);
+
+        frame_label = uicontrol(frame_slider, ...
+        "style", "frame", ...
+        "constraints", createConstraints("border", "right"), ...
+        "backgroundcolor", [1 1 1], ...
+        "layout", "gridbag");
+
+        // labels
+        labels = string([bounds(2) ; ...
+        mean([bounds(2) initial])  ; ...
+        initial                    ; ...
+        mean([bounds(1) initial])  ; ...
+        bounds(1)]);
+        labels = "<html>" + strcat(labels, "<br /><br /><br />") + "</html>";
+
+        uicontrol(frame_label, ...
+        "Style", "text", ...
+        "String", labels(1), ...
+        "FontWeight", "bold", ...
+        "backgroundcolor", [1 1 1]);
+
+        // update default value
+        block.outptr(1) = initial / block.rpar(3);
+    elseif flag == 5 then
+        // Ending
+        f = get(block.uid);
+        if f <> [] then
+            close(f);
+        end
     end
-  elseif flag==1 then // evaluate output during simulation
-    block.outptr(1)=evstr(TCL_GetVar('y'+blknb))/block.rpar(3);
-  end
 endfunction
-///\withPrompt{}
+