Ignore:
Timestamp:
Jan 21, 2011 4:43:16 PM (10 years ago)
Author:
toby
Message:

fix save as bug, expand rb.tcl to delete & handle gaps in body lists; likewise in rigid.tcl

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/sandbox/rigid.tcl

    r1111 r1112  
    55 #proc RB_Populate
    66
    7 lappend auto_path c:/gsas/expgui
    8 package require Tk
    9 package require BWidget
    10 #package require La
    11 #namespace import La::*
    12 source c:/gsas/sandboxexpgui/readexp.tcl
    13 source c:/gsas/sandboxexpgui/gsascmds.tcl
    14 source c:/gsas/sandboxexpgui/rb.tcl
    15 
    16 
    17 expload rb6.exp
    18 mapexp
     7# debug code to load test files when run as an independent script
     8if {[array name expgui shell] == ""} {
     9    lappend auto_path c:/gsas/expgui
     10    package require Tk
     11    package require BWidget
     12    #package require La
     13    #namespace import La::*
     14    source c:/gsas/sandboxexpgui/readexp.tcl
     15    source c:/gsas/sandboxexpgui/gsascmds.tcl
     16    source c:/gsas/sandboxexpgui/rb.tcl
     17    expload rb6.exp
     18    mapexp
     19} else {
     20    source [file join $expgui(scriptdir) rb.tcl]
     21}
    1922
    2023############################################################
     
    2225#                                       y = matrix number
    2326#                                       z = coordinate number
    24 #          ::rb_number          number of rigid bodies.
    2527#          ::rb_map(x)          number of times rigid body is mapped.
    2628#          ::rb_matrix_num(x)   number of matrices in rigid body.
     
    3436proc RB_Load_RBdata {args} {
    3537     catch {unset ::rb}
    36 #Read the number of rigid bodies in EXP file
    37      set ::rb_number [RigidBodyCount]
    38 
    39 #Read the Rigid Body Information
    40      for {set i 1} {$i <= $::rb_number} {incr i} {
     38#Loop over the rigid body types in EXP file
     39    foreach i [RigidBodyList] {
    4140             set rb($i) [ReadRigidBody $i]
    4241             #Set the number of times rigid body is mapped.
     
    208207
    209208     set rb_body_list [NoteBook $rb_nb -side top]
    210      for {set x 1} {$x <= $::rb_number} {incr x} {
     209    # loop over rigid body types
     210    set pagelist {}
     211    foreach x [RigidBodyList] {
    211212         $rb_body_list insert $x rb_body$x -text "Rigid Body Type $x"  \
    212213         -raisecmd "RB_Populate $rb_body_list $x"
     214        lappend pagelist rb_body$x
    213215     }
    214216     $rb_body_list insert 16 rb_body16 -text "Create Rigid Body"
     217    lappend pagelist rb_body16
    215218     grid $rb_body_list -sticky news -column 0 -row 1 -columnspan 2
    216219     grid columnconfig $rcb 1 -weight 1
    217220     grid rowconfig    $rcb 1 -weight 1
    218      $rb_body_list raise rb_body$panelnum
     221    $rb_body_list raise [lindex $pagelist 0]
    219222}
    220223
     
    230233     #Rigid body mapping control panel along with matrix multipliers and damping factor labels
    231234     grid [label  $con.rb_num -text "Rigid Body Type $x"] -row 0 -column 0 -padx 5 -pady 5
    232      grid [button $con.rb_newmap -text "Map New Body" -command "RB_Map_New $x"] -row 0 -column 1 -padx 5 -pady 5
     235     grid [button $con.rb_newmap -text "Map Body $x" -command "RB_Map_New $x"] -row 0 -column 1 -padx 5 -pady 5
    233236
    234237     grid [label $con.rb_mlbl1 -text "Matrix"] -row 1 -column 0
     
    249252     grid [label $main.rb_origin -text "Origin"] -row 0 -column 3 -columnspan 3
    250253     grid [label $main.rb_euler -text "Euler Angles"] -row 0 -column 6 -columnspan 3
    251      grid [label $main.rb_ref -text "Refinement"] -row 1 -column 2
     254     grid [label $main.rb_ref -text "Phase"] -row 1 -column 2
     255     #grid [label $main.rb_ref -text "Refinement"] -row 1 -column 2
    252256     grid [label $main.rb_map -text "Map"] -row 1 -column 1
    253257     grid [label $main.rb_x   -text "x"] -row 1 -column 3
     
    270274     foreach p $phase {
    271275             incr row
    272              set count [RigidBodyMappingCount $p $x]
    273              for {set z 1} {$z <= $count} {incr z} {
     276             foreach z [RigidBodyMappingList $p $x] {
    274277                      set row [expr $row + $z]
    275278                      RB_Load_Mapdata $p $x $z
    276279                      grid [label $main.rb_map$p$z -text "$z"] -row $row -column 1
    277                       grid [button $main.rb_cb$p$z -text "off" -command "RB_View_Parameters $p $x $z"] -row $row -column 2
     280                      grid [label $main.rb_cb$p$z -text $p] -row $row -column 2
     281
     282                      #grid [button $main.rb_cb$p$z -text "off" -command "RB_View_Parameters $p $x $z"] -row $row -column 2
    278283                      set origin $::rb_map_origin($p,$x,$z)
    279284                      puts $origin
     
    298303                      set atomnum $::rb_map_beginning($p,$x,$z)
    299304                      for {set j 1} {$j <=$::rb_coord_num($x,$y)} {incr j} {
    300                           set atom [atominfo $p $atomnum type]
     305                          set atom [atominfo $p $atomnum label]
    301306                          grid [label $main.rb_site$p$z$j -text "$atom"] -row $row -column $col
    302307                          incr atomnum
     
    310315}
    311316
    312 proc RB_Choose_Atom {phase args} {
     317proc RB_Choose_Atom {rbnum args} {
    313318#     set ::rb_finput ""
     319    set phase $::rb_phase
     320    # get the number of atoms in this type of body
     321    set natoms [llength [lindex [lindex [lindex [ReadRigidBody $rbnum] 1] 0] 3]]
     322    set atomlist [RigidStartAtoms $::rb_phase $natoms]
     323    if {[llength $atomlist] == 0} {
     324        RB_ProcessPhase $rbnum
     325        return
     326    }
    314327     catch {destroy .chooseatom}
    315328     set ca .chooseatom
    316329     toplevel $ca
    317330     wm title $ca "Choose Atom"
    318      set atomlist $::expmap(atomlist_$phase)
    319331#     puts $atomlist
    320332     foreach {top main side lbl} [MakeScrollTable $ca] {}
     
    347359    set nm .newmap
    348360    toplevel $nm
    349     wm title $nm "Rigid Body Mapping"
     361    wm title $nm "Map Rigid Body #$x"
    350362    set ::phase 1
    351363    set nmap [expr $::rb_map($x) + 1]
     
    365377    trace variable ::rb_finput w "RB_Atom_List \$::rb_phase \$::rb_finput $nm $x 1"
    366378
    367     grid [button $nm.finput -text "list atoms" -command {RB_Choose_Atom $::rb_phase}] -row 4 -column 3
     379    grid [button $nm.finput -text "list allowed" -command "RB_Choose_Atom $x"] -row 4 -column 3
    368380    grid [label $nm.o1l -text "x"] -row 5 -column 2
    369381    grid [label $nm.o2l -text "y"] -row 5 -column 3
     
    381393
    382394    grid [button $nm.plot -text "Plot Rigid Body & Phase" -command "PlotStrBody $x"] -row 8 -column 2 -columnspan 3
    383     button $nm.save -text "Save" -width 6 -command {RB_Write_Map}
    384 
    385 
    386     grid $nm.save -row 9 -column 3
     395    grid [frame $nm.l] -row 9 -column 2 -columnspan 3
     396    grid [button $nm.l.s -text "Save" -width 6 -command {RB_Write_Map}] -column 1 -row 1
     397    grid [button $nm.l.q -text "Quit" -width 6 -command "destroy $nm"] -column 2  -row 1
     398
     399    foreach item [trace vinfo ::rb_phase] {
     400            eval trace vdelete ::rb_phase $item
     401    }
     402    trace variable ::rb_phase w "RB_ProcessPhase $x"
     403    set ::rb_phase ""
    387404}
    388405
     
    414431   MapRigidBody $::rb_phase $::body_type $::rb_finput $origin $euler
    415432   incr ::rb_map($::body_type)
     433    incr ::expgui(changed)
    416434   RB_Control_Panel $::body_type
    417435   destroy .newmap
     
    423441     }
    424442     set col 8
    425      grid [label $address.atomlbl -text "Atoms Mapped to Rigid Body"] -row 3 -column 8 -columnspan $::rb_coord_num($x,$y)
    426      for {set j 1} {$j <=$::rb_coord_num($x,$y)} {incr j} {
    427          set atom [atominfo $phase $atomnum type]
    428          grid [label $address.atom$phase$x$j -text "$atom"] -row 4 -column $col
    429          incr atomnum
    430          incr col
    431      }
    432 }
    433 
     443    if {$atomnum == ""} return
     444     grid [label $address.atomlbl -text "Atoms Mapped to Rigid Body"] -row 3 -column 8 -columnspan 99
     445    # get the number of atoms in this type of body
     446    set natoms [llength [lindex [lindex [lindex [ReadRigidBody $x] 1] 0] 3]]   
     447    set atoms [RigidStartAtoms $phase $natoms]
     448    if {[lsearch $atoms $atomnum] == -1} {
     449         grid [label $address.atomerr -text "(invalid 1st atom)"] -row 4 -column $col
     450        return
     451    }
     452    set atoms [lrange $::expmap(atomlist_$phase) \
     453                   [lsearch $::expmap(atomlist_$phase) $atomnum] end]
     454    foreach j [lrange $atoms 0 [expr {$natoms - 1}]] {
     455        set atom [atominfo $phase $j label]
     456        grid [label $address.atom$phase$x$j -text $atom] -row 4 -column $col
     457        incr col
     458     }
     459}
     460
     461proc RB_ProcessPhase {rbnum args} {
     462    if {$::rb_phase == ""} {
     463        set atoms {}
     464    } else {
     465        # get the number of atoms in this type of body
     466        set natoms [llength [lindex [lindex [lindex [ReadRigidBody $rbnum] 1] 0] 3]]
     467
     468        set atoms [RigidStartAtoms $::rb_phase $natoms]
     469    }
     470    set nm .newmap
     471    if {[llength $atoms] == 0} {
     472        foreach w "$nm.finputm $nm.plot $nm.l.s" {
     473            $w config -state disabled
     474        }
     475        $nm.finput config -text "None allowed" -state disabled
     476    } else {
     477        foreach w "$nm.finputm $nm.plot $nm.l.s" {
     478            $w config -state normal
     479        }
     480        $nm.finput config -text "Show allowed" -state normal
     481    }
     482}
    434483
    435484RB_Load_RBdata
Note: See TracChangeset for help on using the changeset viewer.