#=============================================================== # CLASS rWidgte : # Defined as top of hierarchie for the moment, but never # alone in an inherit list.That means that this class will only # be used in addition to someother inherit of class. For ex: # Class Tagada { # inherit rWidget OtherTagada. # It's job is to redefine some methods (define, init_show_attr,..) # and create some newones, called from the firstone. # Theorically, you can take "rWidget" away from the inherit list, # without changing the rest of the class of Tagada, and it must # run as stable as befor. #--------------------------------------------------------------- Class rWidget { public int_show_attr "N" public int_show_res "Y" # public geo_borderwidth 2 public geo_text "" protected _geo_bg "" protected _geo_fg "" protected _geo_disabled_fg "" protected _geo_relief "" protected _geo_borderwidth "" protected _geo_height "" protected _geo_width "" protected _geo_padx "" protected _geo_pady "" protected _geo_active_bg "" protected _geo_normal_bg "" # protected _res_list "_geo_bg _geo_fg _geo_relief _geo_borderwidth" protected _res_list "geo_fg geo_disabled_fg geo_bg geo_active_bg geo_normal_bg geo_relief geo_borderwidth geo_height geo_width " # common int_res_name "" common int_obj_list "" ;# list of entities allocated constructor { config } { lappend int_obj_list $this } method config {config} {} #------------------------------------------------------- # get_occurs : # Returns the list of all the widget entities # that are allocated. That's why it is a procedure. #....................................................... proc get_occurs { } { return $int_obj_list } proc reset_all { } { foreach entity $int_obj_list { if { [info exist $entity]} { $entity delete } else { } } set int_obj_list "" } #=============================================================== # cfg_calibrate : # This function completes the define and refresh method # to set objects configuration like ConfigDesi needs. Because # each object is represented differently on the form, it needs # a specific cfg_cal... method. #............................................................... method cfg_calibrate { args } { } #--------------------------------------------------------------- #=============================================================== #--------------------------------------------------------------- method _init_show_attr { } { if {[catch { Rmenu rs_menu_$this \ -int_lifetype "temporar" \ -int_geoman "place_it" \ -int_moveable "Y" \ -geo_orientation "vertical" \ -geo_relief "raised" \ -geo_x [expr [$this getPub -geo_x] + 20] \ -geo_y [expr [$this getPub -geo_y] + 10] \ -geo_int_expand 1 \ -int_invalid_size 1 \ -geo_int_padx 3 \ -geo_int_pady 0}]} { return 0 } foreach entity $_res_list { set tmp_res [set _$entity] rs_menu_$this add_member \ ${this}_$entity \ [$tmp_res getPub -geo_text] \ "$tmp_res select $this $entity" ${this}_$entity config -geo_relief "flat" \ -geo_anchor "w" } rs_menu_$this add_member ${this}_b_esc " Done " "$this display" rs_menu_$this display $geo_root } #=============================================================== #--------------------------------------------------------------- method init_show_attr { } { global Default # puts stderr "rWidget::init_show_attr come in" if { [catch { Boxmenu rs_menu_$this \ -int_geoman "place_it" \ -int_moveable "N" \ -geo_bg $Default(Color,LightCyan3) \ -geo_x [expr [$this getPub -geo_x] + 20] \ -geo_y [expr [$this getPub -geo_y] + 10] }] == 1 } { rs_menu_${this} config -geo_x [expr [$this getPub -geo_x] + 20] \ -geo_y [expr [$this getPub -geo_y] + 10] rs_menu_${this} display return 0 } foreach entit $_res_list { set tmp_res [set _$entit] # puts stderr "***text for $tmp_res is [$tmp_res getPub -geo_text]" if { ${tmp_res} != "" } { rs_menu_$this add_member [$tmp_res getPub -geo_text] \ "$tmp_res select $this $entit ; rs_menu_$this delete" # puts stderr "$this has $entit defined" } else { #puts stderr "$this has no $entit resource object" } # puts stderr "*** $tmp_res has value [$tmp_res getPub -int_value]" } rs_menu_$this add_soon [ Button rs_menu_${this}_done \ -geo_text "Done" \ -int_geoman "pack_it" \ -int_command "rs_menu_$this delete"] \ members rs_menu_$this display ${geo_root} # puts stderr "rWidget::init_show_attr goes out" } #=============================================================== # init_res : # Has to define the pointers to the resource pointers. # Must be called only one time, and not on each construct. # Last modif : 97.01.12 # Is bugged !!! #--------------------------------------------------------------- method init_res { args } { # puts stderr "rWidget::init_res : come in" set class [virtual info class] # puts stderr "Class got for $this is $class" foreach entity $_res_list { switch $entity { "geo_bg" { $this init_bg_res $class } "geo_fg" { if { [Resource :: have_you ${class}_fg] == 0} { set geo_fg [${class}_fg getPub -int_value] } else { rForeground ${class}_fg -int_host_class ${class} ${class}_fg config -int_value $geo_fg } set _geo_fg ${class}_fg if {[catch {${class}_fg info class}] == 0 } { ${class}_fg add_obj_to_rlist $this } } "geo_disabled_fg" { if { [Resource :: have_you ${class}_disabled_fg] == 0} { set geo_disabled_fg [${class}_disabled_fg getPub -int_value] } else { rDisabledFg ${class}_disabled_fg -int_host_class ${class} ${class}_disabled_fg config -int_value $geo_disabled_fg } set _geo_disabled_fg ${class}_disabled_fg if {[catch {${class}_disabled_fg info class}] == 0 } { ${class}_disabled_fg add_obj_to_rlist $this } } "geo_entry_active_bg" { if { [Resource :: have_you ${class}_entry_active_bg] == 0} { set geo_entry_active_bg [${class}_entry_active_bg getPub -int_value] } else { rEntryActiveBg ${class}_entry_active_bg -int_host_class ${class} ${class}_entry_active_bg config -int_value $geo_entry_active_bg } set _geo_entry_active_bg ${class}_entry_active_bg if {[catch {${class}_entry_active_bg info class}] == 0 } { ${class}_entry_active_bg add_obj_to_rlist $this } } "geo_active_bg" { if { [Resource :: have_you ${class}_active_bg] == 0} { set geo_active_bg [${class}_active_bg getPub -int_value] } else { rActiveBg ${class}_active_bg -int_host_class ${class} ${class}_active_bg config -int_value $geo_active_bg } set _geo_active_bg ${class}_active_bg if {[catch {${class}_active_bg info class}] == 0 } { ${class}_active_bg add_obj_to_rlist $this } } "geo_highlight_bg" { if { [Resource :: have_you ${class}_highlight_bg] == 0} { set geo_highlight_bg [${class}_highlight_bg getPub -int_value] } else { rHighlightBackground ${class}_highlight_bg -int_host_class ${class} ${class}_highlight_bg config -int_value $geo_highlight_bg } set _geo_highlight_bg ${class}_highlight_bg if {[catch {${class}_highlight_bg info class}] == 0 } { ${class}_highlight_bg add_obj_to_rlist $this } } "geo_active_fg" { if { [Resource :: have_you ${class}_active_fg] == 0} { set geo_active_fg [${class}_active_fg getPub -int_value] } else { rActiveFg ${class}_active_fg -int_host_class ${class} ${class}_active_fg config -int_value $geo_active_fg } set _geo_active_fg ${class}_active_fg if {[catch {${class}_active_fg info class}] == 0 } { ${class}_active_fg add_obj_to_rlist $this } } "geo_normal_bg" { if { [Resource :: have_you ${class}_normal_bg] == 0} { set $entity [${class}_normal_bg getPub -int_value] } else { rBackground ${class}_normal_bg -int_host_class ${class} ${class}_normal_bg config -int_value [set $entity] } set _geo_normal_bg ${class}_normal_bg if {[catch {${class}_normal_bg info class}] == 0 } { ${class}_normal_bg add_obj_to_rlist $this } } "geo_reverse_bg" { if { [Resource :: have_you ${class}_reverse_bg] == 0} { set geo_reverse_bg [${class}_reverse_bg getPub -int_value] } else { rReverseBg ${class}_reverse_bg -int_host_class ${class} ${class}_reverse_bg config -int_value $geo_reverse_bg } set _geo_reverse_bg ${class}_reverse_bg if {[catch {${class}_reverse_bg info class}] == 0 } { ${class}_reverse_bg add_obj_to_rlist $this } } "geo_selected_bg" { if { [Resource :: have_you ${class}_selected_bg] == 0} { set $geo_selected_bg [${class}_selected_bg getPub -int_value] } else { rSelectedBg ${class}_selected_bg -int_host_class ${class} ${class}_selected_bg config -int_value $geo_selected_bg } set _geo_selected_bg ${class}_selected_bg if {[catch {${class}_selected_bg info class}] == 0 } { ${class}_selected_bg add_obj_to_rlist $this } } "geo_selected_bw" { if { [Resource :: have_you ${class}_selected_bw] == 0} { set geo_selected_bw [${class}_selected_bw getPub -int_value] } else { rSelectedBorderWidth ${class}_selected_bw -int_host_class ${class} ${class}_selected_bw config -int_value $geo_selected_bw } set _geo_selected_bw ${class}_selected_bw if {[catch {${class}_selected_bw info class}] == 0 } { ${class}_selected_bw add_obj_to_rlist $this } } "geo_selected_fg" { if { [Resource :: have_you ${class}_selected_fg] == 0} { set geo_selected_fg [${class}_selected_fg getPub -int_value] } else { rSelectedFg ${class}_selected_fg -int_host_class ${class} ${class}_selected_fg config -int_value $geo_selected_fg } set _geo_selected_fg ${class}_selected_fg if {[catch {${class}_selected_fg info class}] == 0 } { ${class}_selected_fg add_obj_to_rlist $this } } "geo_relief" { if { [Resource :: have_you ${class}_relief] == 0} { #puts stderr "*** test exist ..._relief" set geo_relief [${class}_relief getPub -int_value] } else { #puts stderr "*** not test exist ..._relief. must create" rRelief ${class}_relief -int_host_class ${class} ${class}_relief config -int_value $geo_relief } set _geo_relief ${class}_relief #puts stderr "*** before put in list" if {[catch {${class}_relief info class}] == 0 } { ${class}_relief add_obj_to_rlist $this } #puts stderr "*** after put in list" } "geo_borderwidth" { if { [Resource :: have_you ${class}_borderwidth] == 0} { set $geo_borderwidth [${class}_borderwidth getPub -int_value] } else { rBorderWidth ${class}_borderwidth -int_host_class ${class} ${class}_borderwidth config -int_value $geo_borderwidth } set _geo_borderwidth ${class}_borderwidth if {[catch {${class}_borderwidth info class}] == 0 } { ${class}_borderwidth add_obj_to_rlist $this } } "geo_width" { if { [Resource :: have_you ${class}_width] == 0} { set geo_width [${class}_width getPub -int_value] } else { rWidth ${class}_width -int_host_class ${class} ${class}_width config -int_value $geo_width } set _geo_width ${class}_width if {[catch {${class}_width info class}] == 0 } { ${class}_width add_obj_to_rlist $this } } "geo_height" { if { [Resource :: have_you ${class}_height] == 0} { set geo_height [${class}_height getPub -int_value] } else { rHeight ${class}_height -int_host_class ${class} ${class}_height config -int_value $geo_height } set _geo_height ${class}_height if {[catch {${class}_height info class}] == 0 } { ${class}_height add_obj_to_rlist $this } } "geo_padx" { if { [Resource :: have_you ${class}_padx] == 0} { set geo_padx [${class}_padx getPub -int_value] } else { rPadX ${class}_padx -int_host_class ${class} ${class}_padx config -int_value $geo_padx } set _geo_padx ${class}_padx if {[catch {${class}_padx info class}] == 0 } { ${class}_padx add_obj_to_rlist $this } } "geo_pady" { if { [Resource :: have_you ${class}_pady] == 0} { set $geo_pady [${class}_pady getPub -int_value] } else { rPadY ${class}_pady -int_host_class ${class} ${class}_pady config -int_value $geo_pady } set _geo_pady ${class}_pady if {[catch {${class}_pady info class}] == 0 } { ${class}_pady add_obj_to_rlist $this } } "geo_rPad" { if { [Resource :: have_you ${class}_rPad] == 0} { set geo_rPad [${class}_rPad getPub -int_value] } else { rRPad ${class}_rPad -int_host_class ${class} ${class}_rPad config -int_value $geo_rPad } set _geo_rPad ${class}_rPad if {[catch {${class}_rPad info class}] == 0 } { ${class}_rPad add_obj_to_rlist $this } } "geo_entry_pady" { if { [Resource :: have_you ${class}_entry_pady] == 0} { set geo_entry_pady [${class}_entry_pady getPub -int_value] } else { rPadY ${class}_entry_pady -int_host_class ${class} ${class}_entry_pady config -int_value $geo_entry_pady } set _geo_entry_pady ${class}_entry_pady if {[catch {${class}_entry_pady info class}] == 0 } { ${class}_entry_pady add_obj_to_rlist $this } } default { puts stderr "Becarefull in rWidget::init_res ATTRIBUT $entity not known" } } #puts stderr "** This resource is : $entity == [info public $entity -value] " #puts stderr "** This resource is : _$entity == [info public _$entity -value] " #puts stderr "** one loop" } #puts stderr "--out of init_res" # virtual reconfig $entity [$this getPub -$entity] } #=============================================================== # This is the highest definition level for this method. This method # is prinzipiel guilty for all objetcs. But it is possible that # some objects manages their resource differently, or use resources # from other objects (Frame and ColorWhite), and have then an # other method definition (rframe.tko). #--------------------------------------------------------------- method init_bg_res { class } { set obj_exists true if { [Resource :: have_you ${class}_bg] == 0} { #puts stderr "${class}_bg Resource object does already exist" set geo_bg [${class}_bg getPub -int_value] } else { #puts stderr "${class}_bg Resource object did not exist" rBackground ${class}_bg -int_host_class ${class} ${class}_bg config -int_value $geo_bg } # Adding the object to the list of the created resource (bg): ${class}_bg add_obj_to_rlist $this set _geo_bg ${class}_bg } #=============================================================== # reset_resources : # make the values held in the Resources to the corresponding # attribut. #--------------------------------------------------------------- method reset_resources { } { #puts stderr "rWidget::reset_resources : list of resources for $this is $_res_list" foreach entity $_res_list { # puts stderr "rWidget::reset_resources; value of res. object [set _$entity] is [[$this getPro -_$entity] get]" if {[set resou [$this getPro -_$entity]] == ""} { #puts stderr "*** Error: $this should have the entity _$entity" } else { set test [[$this getPro -_$entity] get] if { $test != "" } { set $entity $test # set geo_[[$this getPro -_$entity] info common int_res_name -value] [[$this getPro -_$entity] get] } } } } #=============================================================== #--------------------------------------------------------------- method define { } { # puts stderr "rWidget::define pass for $this" virtual reset_resources set herit [$this info inherit] virtual cfg_calibrate if {[llength $herit] == 1} { set herit [ $herit :: info inherit] } $this [lindex $herit 1]::define } #=============================================================== #--------------------------------------------------------------- method refresh { } { virtual reset_resources set herit [$this info inherit] virtual cfg_calibrate if {[llength $herit] == 1} { set herit [ $herit :: info inherit] } $this [lindex $herit 1]::refresh } #=============================================================== # display : # que tout le monde connait #--------------------------------------------------------------- method __display { args } { set herit [$this info inherit] if { $_geo_bg == ""} { virtual init_res } if {[llength $herit] == 1} { set herit [ $herit :: info inherit] } $this [lindex $herit 1]::display $args # virtual display $args } #=============================================================== # reconfig : # que tout le personne connait # This method reconfigures an attribut of the object, thru # the resource specific attribut. #--------------------------------------------------------------- method reconfig { resource value } { # puts stderr "rWidget::reconfig=> resource = $resource, value = $value" # puts stderr "attribut is [set _$resource] ; actual value is [[set _$resource] get]" [set _$resource] take $value } } ;# end of class rWidget