Changeset 1114


Ignore:
Timestamp:
Feb 14, 2011 1:14:00 PM (10 years ago)
Author:
toby
Message:

more RB capability

Location:
branches/sandbox
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/sandbox/rb.tcl

    r1112 r1114  
    14481448    if {$app == ""} {
    14491449        MyMessageBox -parent . -title "No DRAWxtl" \
    1450                 -message "Sorry, DRAWxtl is not installed no phases are present to write" \
     1450                -message "Sorry, DRAWxtl is not installed" \
    14511451                -icon warning
    14521452        return
     
    14721472    if {$app == ""} {
    14731473        MyMessageBox -parent . -title "No DRAWxtl" \
    1474                 -message "Sorry, DRAWxtl is not installed no phases are present to write" \
     1474                -message "Sorry, DRAWxtl is not installed" \
    14751475                -icon warning
    14761476        return
     
    15041504    if {$app == ""} {
    15051505        MyMessageBox -parent . -title "No DRAWxtl" \
    1506                 -message "Sorry, DRAWxtl is not installed no phases are present to write" \
     1506                -message "Sorry, DRAWxtl is not installed" \
    15071507                -icon warning
    15081508        return
  • branches/sandbox/rigid.tcl

    r1112 r1114  
    392392
    393393
    394     grid [button $nm.plot -text "Plot Rigid Body & Phase" -command "PlotStrBody $x"] -row 8 -column 2 -columnspan 3
     394    grid [frame $nm.p] -row 8 -column 1 -columnspan 4 -sticky e
     395    grid [button $nm.p.fit -text "Fit rigid body to phase" -command "FitBody2coords $x $nm"] -row 0 -column 1
     396    grid [button $nm.p.plot -text "Plot rigid body & phase" -command "PlotStrBody $x $nm"] -row 1 -column 1
     397    grid [label $nm.p.l -text "Bonds: "] -row 1 -column 2
     398    grid [entry $nm.p.e] -row 1 -column 3
     399    $nm.p.e delete 0 end
     400    $nm.p.e insert 0 "0.9-1.1, 1.3-1.6"
     401
    395402    grid [frame $nm.l] -row 9 -column 2 -columnspan 3
    396403    grid [button $nm.l.s -text "Save" -width 6 -command {RB_Write_Map}] -column 1 -row 1
     
    404411}
    405412
    406 proc PlotStrBody {rbtype} {
     413proc FitBody2coords {rbtype menu} {
     414    set warn ""
     415    foreach i {1 2 3} lbl {x y z} {
     416        if {[string trim [set ::euler$i]] == ""} {
     417            set ::euler$i 0.0
     418        }
     419        if {[string trim [set ::origin$i]] == ""} {
     420            set ::origin$i .0
     421        }
     422        if {[catch {expr [set ::euler$i]}]} {
     423            append warn "\tError in Euler angle around $lbl\n"
     424        }
     425        if {[catch {expr [set ::origin$i]}]} {
     426            append warn "\tError in origin $lbl\n"
     427        }
     428    }
     429    if {[catch {expr $::rb_finput}]} {
     430        append warn "\tError in 1st atom number\n"
     431    }
     432    if {$warn != ""} {
     433        MyMessageBox -parent $menu -title "Input error" \
     434                -message "Invalid input:\n$warn" -icon warning
     435        return
     436    }
     437    set Euler [list "1 $::euler1" "2 $::euler2" "3 $::euler3"]
     438    set origin "$::origin1 $::origin2 $::origin3"
     439    set phase $::rb_phase
     440    set cell {}
     441    foreach p {a b c alpha beta gamma} {
     442        lappend cell [phaseinfo $phase $p]
     443    }
     444    set coords [RB2cart [lindex [ReadRigidBody $rbtype] 1]]
     445    set natom [llength $coords]
     446    set firstind [lsearch $::expmap(atomlist_$phase) $::rb_finput]
     447    set atoms [lrange \
     448                   [lrange $::expmap(atomlist_$phase) $firstind end] \
     449                   0 [expr {$natom-1}]]
     450    # now loop over atoms
     451    set frcoords {}
     452    foreach atom $atoms {
     453        set xyz {}
     454        foreach v {x y z} {
     455            lappend xyz [atominfo $phase $atom $v]
     456        }
     457        lappend frcoords $xyz
     458    }
     459    # it would be nice to have checkboxes for each atom, but for now use em all
     460    set useflags {}
     461    foreach i $coords {lappend useflags 1}
     462    # do the fit
     463    foreach {neworigin newEuler rmsdev newfrac rmsbyatom} \
     464        [FitBody $Euler $cell $coords $useflags $frcoords $origin] {}
     465    foreach i {1 2 3} val $neworigin pair $newEuler {
     466        set ::origin$i $val
     467        set ::euler$i [lindex $pair 1]
     468    }
     469    # show deviations
     470    foreach atom $atoms rms $rmsbyatom {
     471        puts "[atominfo $phase $atom label]\t$rms"
     472    }
     473    #puts "CalcBody $Euler $cell $coords $origin"
     474    #puts $coords
     475    #puts $frcoords
     476    #DRAWxtlPlotRBFit $frcoords $phase $::rb_finput 0 $bondlist $bondlist
     477 }
     478
     479
     480proc PlotStrBody {rbtype menu} {
     481    set warn ""
     482    foreach i {1 2 3} lbl {x y z} {
     483        if {[catch {expr [set ::euler$i]}]} {
     484            append warn "\tError in Euler angle around $lbl\n"
     485        }
     486        if {[catch {expr [set ::origin$i]}]} {
     487            append warn "\tError in origin $lbl\n"
     488        }
     489    }
     490    if {[catch {expr $::rb_finput}]} {
     491        append warn "\tError in 1st atom number\n"
     492    }
     493    if {$warn != ""} {
     494        MyMessageBox -parent $menu -title "Input error" \
     495                -message "Invalid input:\n$warn" -icon warning
     496        return
     497    }
     498    # translate bond list
     499    set bl [$menu.p.e get]
     500    regsub -all "," $bl " " bl
     501    set bondlist {}
     502    set warn ""
     503    foreach b $bl {
     504        if {[llength [split $b "-"]] == 2} {
     505            lappend bondlist [split $b "-"]
     506        } else {
     507            set warn "error parsing bond list"
     508        }
     509    }
     510    if {$warn != ""} {
     511        MyMessageBox -parent . -title "Input warning" \
     512                -message "Invalid bond input" -icon warning
     513    }
    407514     set Euler [list "1 $::euler1" "2 $::euler2" "3 $::euler3"]
    408515     set origin "$::origin1 $::origin2 $::origin3"
     
    417524    #puts $coords
    418525    #puts $frcoords
    419     DRAWxtlPlotRBFit $frcoords $phase $::rb_finput 0
     526    DRAWxtlPlotRBFit $frcoords $phase $::rb_finput 0 $bondlist $bondlist
    420527 }
    421528#
     
    470577    set nm .newmap
    471578    if {[llength $atoms] == 0} {
    472         foreach w "$nm.finputm $nm.plot $nm.l.s" {
     579        foreach w "$nm.finputm $nm.p.plot $nm.p.fit $nm.p.e $nm.l.s" {
    473580            $w config -state disabled
    474581        }
    475582        $nm.finput config -text "None allowed" -state disabled
    476583    } else {
    477         foreach w "$nm.finputm $nm.plot $nm.l.s" {
     584        foreach w "$nm.finputm $nm.p.plot $nm.p.fit $nm.p.e $nm.l.s" {
    478585            $w config -state normal
    479586        }
Note: See TracChangeset for help on using the changeset viewer.