Changeset 08de14f in tol


Ignore:
Timestamp:
Jan 13, 2010, 12:08:27 AM (17 years ago)
Author:
Jorge Pérez <josp.jorge@…>
Branches:
1941-docker-image-to-test, devel, master
Children:
806a341
Parents:
0723286
Message:

refs #838 : now an array of buttons can be specified.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@1963 be4846ae-f051-483a-831f-b64e7d08527f

Location:
tol_pkg/GuiTools
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • tol_pkg/GuiTools/MultiDimSelect.tcl

    r0723286 r08de14f  
    44package require tablelist
    55
    6 
    7 snit::widgetadaptor DimSelector {
    8 
    9   option -addr -readonly yes -validatemethod _checkAddr
     6snit::widgetadaptor DimTable {
    107
    118  typevariable checkedImg
    … …  
    6259  }
    6360
     61  typemethod emptyStr { val } {
     62    return ""
     63  }
     64
     65  typemethod editEndCmd { w row col text } {
     66    if { [ $w columncget $col -name ] eq "selected" } {
     67      set img [ expr { $text ? $DimSelector::checkedImg : $DimSelector::uncheckedImg } ]
     68      $w cellconfigure $row,$col -image $img
     69    }
     70    return $text
     71  }
     72 
     73  typemethod editStartCmd { w row col text } {
     74    return $text
     75  }
     76
     77  component table -public table
     78
     79  delegate option * to hull
     80  delegate method * to hull
     81
     82  constructor { args } {
     83    eval installhull using LabelFrame $args
     84    set f [ $win getframe ]
     85    install table using ::tablelist::tablelist $f.tbl \
     86                  -columns { 0 "Selected" center 0 "Dimension Value" left } \
     87                  -editendcommand [ mytypemethod editEndCmd ] \
     88                  -editstartcommand [ mytypemethod editStartCmd ] \
     89                  -selectmode extended
     90    $table columnconfigure 0 -name selected -editable yes \
     91        -editwindow checkbutton \
     92        -formatcommand [ mytypemethod emptyStr ]
     93    if { [ $table cget -selectborderwidth ] == 0 } {
     94      $table configure -spacing 1
     95    }
     96    set hs [ scrollbar $f.hs -orient horizontal \
     97                 -command [ list $table xview ] ]
     98    set vs [ scrollbar $f.vs -orient vertical \
     99                 -command [list $table yview ] ]
     100    $table configure \
     101        -xscrollcommand "$hs set" \
     102        -yscrollcommand "$vs set"
     103    grid $table -row 0 -column 0 -sticky snew
     104    grid $vs -row 0 -column 1 -sticky ns
     105    grid $hs -row 1 -column 0 -sticky ew
     106    grid rowconfigure $f 0 -weight 1
     107    grid columnconfigure $f 0 -weight 1
     108    ::autoscroll::autoscroll $vs
     109    ::autoscroll::autoscroll $hs
     110  }
     111
     112  method getChecked { } {
     113    $table finishediting
     114    set info [ $table get 0 end ]
     115    puts "getChecked, info : $info"
     116    set result [ list ]
     117    foreach r $info {
     118      if { [ lindex $r 0 ] } {
     119        lappend result [ lindex $r 1 ]
     120      }
     121    }
     122    set result
     123  }
     124
     125  method appendRow { dimValue } {
     126    $table insert end [ list 0 $dimValue ]
     127    $table cellconfigure end,selected -image $DimTable::uncheckedImg
     128  }
     129
     130};
     131
     132snit::widgetadaptor DimSelector {
     133
     134  option -addr -readonly yes -validatemethod _checkAddr
     135
    64136  typemethod _invokeButton { obj_addr method dims } {
    65137    set try [ catch {
    … …  
    73145    tol::console stack release __aux_instance__
    74146    tol::console stack release __aux_result__
    75   }
    76 
    77   typemethod createTableDim { w } {
    78     frame $w
    79    
    80     set tbl [ ::tablelist::tablelist $w.tbl \
    81                   -columns { 0 "Selected" center 0 "Dimension Value" left } \
    82                   -editendcommand [ mytypemethod editEndCmd ] \
    83                   -editstartcommand [ mytypemethod editStartCmd ] \
    84                   -selectmode extended ]
    85     $tbl columnconfigure 0 -name selected -editable yes \
    86         -editwindow checkbutton \
    87         -formatcommand [ mytypemethod emptyStr ]
    88     if { [ $tbl cget -selectborderwidth ] == 0 } {
    89       $tbl configure -spacing 1
    90     }
    91     set hs [ scrollbar $w.hs -orient horizontal \
    92                  -command [ list $tbl xview ] ]
    93     set vs [ scrollbar $w.vs -orient vertical \
    94                  -command [list $tbl yview ] ]
    95     $tbl configure \
    96         -xscrollcommand "$hs set" \
    97         -yscrollcommand "$vs set"
    98     grid $tbl -row 0 -column 0 -sticky snew
    99     grid $vs -row 0 -column 1 -sticky ns
    100     grid $hs -row 1 -column 0 -sticky ew
    101     grid rowconfigure $w 0 -weight 1
    102     grid columnconfigure $w 0 -weight 1
    103     ::autoscroll::autoscroll $vs
    104     ::autoscroll::autoscroll $hs
    105     set w
    106   }
    107 
    108   typemethod getDimSelected { w } {
    109     $w finishediting
    110     set info [ $w get 0 end ]
    111     puts "getDimSelected, info : $info"
    112     set result [ list ]
    113     foreach r $info {
    114       if { [ lindex $r 0 ] } {
    115         lappend result [ lindex $r 1 ]
    116       }
    117     }
    118     set result
    119   }
    120  
    121   typemethod emptyStr { val } {
    122     return ""
    123   }
    124 
    125   typemethod editEndCmd { w row col text } {
    126     if { [ $w columncget $col -name ] eq "selected" } {
    127       set img [ expr { $text ? $DimSelector::checkedImg : $DimSelector::uncheckedImg } ]
    128       $w cellconfigure $row,$col -image $img
    129     }
    130     return $text
    131   }
    132  
    133   typemethod editStartCmd { w row col text } {
    134     return $text
    135   }
    136 
    137   typemethod appendRow { w dimValue } {
    138     $w insert end [ list 0 $dimValue ]
    139     $w cellconfigure end,selected -image $DimSelector::uncheckedImg
    140   }
     147  } 
    141148
    142149  method _checkAddr { option value } {
    … …  
    155162
    156163  constructor { args } {
    157     installhull using Dialog -modal none -geometry 200x200
    158     $win add -text Accept -command [ mymethod _onAccept ]
     164    installhull using Dialog -modal none
     165    $win add -text Accept -command [ mymethod invokeButton onAccept yes ]
    159166    $win add -text Close -command "destroy $win"
    160167    $self configurelist $args
    161168    set widgets [ list ]
    162     set f [ $win getframe ]
    163     set main [ frame $f.main ]
    164     set dimensions [ $self _getDimensions ]
    165     foreach dim $dimensions {
    166       $self _createDimWidget $dim
    167     }
    168     $self _packWidgets
     169    $self _createDimTables
     170    $self _createButtons
     171    set f [ $win getframe ]
    169172    grid rowconfigure $f 0 -weight 1
    170173    grid columnconfigure $f 0 -weight 1
    171174  }
    172175
    173   method _onAccept { } {
    174     set dims_selected [ $self _getDimSelected ]
     176  method _createDimTables { } {
     177    set f [ $win getframe ]
     178    set main [ frame $f.main ]
     179    set dimensions [ $self _getObjDimensions ]
     180    set widgets [ list ]
     181    grid $main -row 0 -column 0 -sticky snew
     182    grid rowconfigure $main 0 -weight 1
     183    foreach dim $dimensions {
     184      set idx [ llength $widgets ]
     185      set dt [ DimTable $main.dt$idx -text $dim -side top ]
     186      foreach dv [ $self _getObjDimValues $dim ] {
     187        $dt appendRow $dv
     188      }
     189      grid $dt -row 0 -column $idx -sticky snew
     190      grid columnconfigure $main $idx -weight 1
     191      lappend widgets $dt
     192    }
     193  }
     194
     195  method _createButtons { } {
     196    set f [ $win getframe ]
     197    set but_info [ $self _getObjButtons ]
     198    if { [ llength $but_info ] } {
     199      set sep [ Separator $f.sep -orient vertical ]
     200      grid $sep -row 0 -column 1 -sticky sn
     201      set fbut [ frame $f.fbut ]
     202      grid $fbut -row 0 -column 2 -sticky sn
     203      array set but_opts {
     204        -image ""
     205        -exit "no"
     206        -method ""
     207      }
     208      set idx 0
     209      foreach but $but_info {
     210        array set but_opts {
     211          -image ""
     212          -exit "no"
     213          -method ""
     214        }
     215        array set but_opts $but
     216        button $fbut.but$idx -text $but_opts(-label) \
     217            -image $but_opts(-image) \
     218            -command [ mymethod invokeButton $but_opts(-method) $but_opts(-exit) ]
     219        grid $fbut.but$idx -row $idx -column 0 -sticky ew
     220        incr idx
     221      }
     222    }
     223  }
     224
     225  method invokeButton { met ex } {
     226    set dims_selected [ $self getDimSelected ]
    175227    puts "dims_selected $dims_selected"
    176228    set level1 [ list ]
    … …  
    186238      }
    187239    }
    188     $type _invokeButton $options(-addr) onAccept "SetOfSet([ join $level1 , ])"
    189     after idle destroy $win
    190   }
    191 
    192   method _getDimSelected { } {
     240    $type _invokeButton $options(-addr) $met "SetOfSet([ join $level1 , ])"
     241    if { $ex } {
     242      after idle destroy $win
     243    }
     244  }
     245
     246  method getDimSelected { } {
    193247    set result [ list ]
    194248    foreach w $widgets d $dimensions {
    195       set ff [ $w getframe ]
    196       lappend result [ $type getDimSelected $ff.tl.tbl ]
    197     }
    198     set result
    199   }
    200 
    201   method _getDimensions { } {
    202     puts "_getDimensions"
     249      lappend result [ $w getChecked ]
     250    }
     251    set result
     252  }
     253
     254  method _getObjDimensions { } {
     255    puts "_getObjDimensions"
    203256    puts "*** [ tol::console stack list ] ***"
    204257    incr ids
    … …  
    211264      } ] } msg ]
    212265    if { $try } {
    213       puts "ERROR DimSelector::_getDimensions : $msg"
     266      puts "ERROR DimSelector::_getObjDimensions : $msg"
    214267      set result ""
    215268    } else {
    … …  
    218271    tol::console stack release $id_dims
    219272    tol::console stack release $id_obj
    220     puts "_getDimensions: DONE"
     273    puts "_getObjDimensions: DONE"
    221274    set result
    222275  }
    223276 
    224   method _getDimValues { dim } {
    225     puts "_getDimValues $dim"
    226     puts "*** [ tol::console stack list ] ***"
     277  method _getObjDimValues { dim } {
    227278    incr ids
    228279    set id_obj __aux_dsel__$ids
    … …  
    234285      } ] } msg ]
    235286    if { $try } {
    236       puts "ERROR DimSelector::_getDimValues : $msg"
     287      puts "ERROR DimSelector::_getObjDimValues : $msg"
    237288      set result ""
    238289    } else {
    … …  
    241292    tol::console stack release $id_values
    242293    tol::console stack release $id_obj
    243     puts "_getDimValues: DONE"
     294    set result
     295  }
     296
     297  method _getObjButtons { } {
     298    incr ids
     299    set id_obj __aux_dsel__$ids
     300    set id_buttons __buttons__$ids
     301    set try [ catch {
     302      tol::console eval [ string map [ list %A $options(-addr) %I1 $id_obj %I2 $id_buttons ] {
     303        @MultiDimSelect %I1 = GetObjectFromAddress("%A");
     304        Set %I2 = %I1::getButtonEntries(?);
     305      } ] } msg ]
     306    if { $try } {
     307      puts "ERROR DimSelector::_getObjButtons : $msg"
     308      set result ""
     309    } else {
     310      set result [ TolObj2TclObj [ list Set $id_buttons ] ]
     311    }
     312    tol::console stack release $id_buttons
     313    tol::console stack release $id_obj
    244314    set result
    245315  }
    … …  
    252322    set ff [ $w getframe ]
    253323    set tl [ $type createTableDim $ff.tl ]
    254     foreach dv [ $self _getDimValues $dim ] {
     324    foreach dv [ $self _getObjDimValues $dim ] {
    255325      $type appendRow $tl.tbl $dv
    256326    }

  • tol_pkg/GuiTools/test/test_0001/tolgui_test.tol

    r0723286 r08de14f  
    5454    Real 0
    5555  };
     56
     57  Real onTabla( Set selected )
     58  {
     59    WriteLn( "onTabla" );
     60    Real 0
     61  };
     62
     63  Real onGrafica( Set selected )
     64  {
     65    WriteLn( "onGrafica" );
     66    Real 0
     67  };
    5668 
    5769  ////////////////////////////////////////////////////////////////////////////
    … …  
    6173  ////////////////////////////////////////////////////////////////////////////
    6274  {
    63     Set Empty
     75    Set [[
     76      [[ "-label", "Grafica", "-exit", "no", "-method", "onGrafica" ]],
     77      [[ "-label", "Tabla", "-exit", "no", "-method", "onTabla" ]]
     78    ]]
    6479  };
    6580
Note: See TracChangeset for help on using the changeset viewer.