Scicos blocks: move tkscaleblk to scicos_blocks
[scilab.git] / scilab / modules / scicos_blocks / macros / Sources / tkscaleblk.sci
1 //  Scicos
2 //
3 //  Copyright (C) INRIA - METALAU Project <scicos@inria.fr>
4 //
5 // This program is free software; you can redistribute it and/or modify
6 // it under the terms of the GNU General Public License as published by
7 // the Free Software Foundation; either version 2 of the License, or
8 // (at your option) any later version.
9 //
10 // This program is distributed in the hope that it will be useful,
11 // but WITHOUT ANY WARRANTY; without even the implied warranty of
12 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 // GNU General Public License for more details.
14 //
15 // You should have received a copy of the GNU General Public License
16 // along with this program; if not, write to the Free Software
17 // Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18 //
19 // See the file ../license.txt
20 //
21
22 function block=tkscaleblk(block,flag)
23   blknb=string(curblock())
24   if flag==4 then
25     cur=%cpr.corinv(curblock())
26     if size(cur,'*')==1 then // open widget only if the block 
27                              // is in main Scicos editor window
28       o=scs_m.objs(cur).graphics.orig;
29       sz=scs_m.objs(cur).graphics.sz
30       pos=point2pixel(1000,o)
31       pos(1)=pos(1)+width2pixel(1000,sz(1)) // widget position 
32       geom='wm geometry $w +'+string(pos(1))+'+'+ string(pos(2));
33       titled=block.label
34       if titled==[] then titled="TK source",end
35       tit='wm title $w Scale'+blknb // write block label
36       bounds=block.rpar(1:2)
37       bnds='-from '+string(bounds(1))+' -to '+string(bounds(2))
38       cmd='-command ""f'+blknb+' $w.frame.scale""'
39       lab='-label ""'+titled+'""';
40       L='-length 100'
41       I='-tickinterval '+string((bounds(2)-bounds(1))/4)
42       scale=strcat(['scale $w.frame.scale -orient vertical',..
43                     lab,bnds,cmd,L,I],' ')
44       initial=mean(bounds) // initial value is the mean
45       txt=['set w .vscale'+blknb;
46            'set y'+blknb+' 0';
47            'catch {destroy $w}';
48            'toplevel $w';
49            tit
50            geom
51            'frame $w.frame -borderwidth 10';
52            'pack $w.frame';
53            scale
54            'frame $w.frame.right -borderwidth 15';
55            'pack $w.frame.scale -side left -anchor ne';
56            '$w.frame.scale set '+string(initial);
57            'proc f'+blknb+' {w height} {global y'+blknb+';set y'+blknb+' $height}'
58           ];
59       TCL_EvalStr(txt) // call TCL interpretor to create widget
60       block.outptr(1)=mean(block.rpar(1:2))/block.rpar(3);
61     end
62   elseif flag==1 then // evaluate output during simulation
63     block.outptr(1)=evstr(TCL_GetVar('y'+blknb))/block.rpar(3);
64   end
65 endfunction
66 ///\withPrompt{}