# export a phase to DRAWXTL
#
# $Id: export_drawxtl.tcl 1209 2012-08-15 19:27:31Z lake $
# set local variables that define the proc to execute and the menu label
set label "export to DRAWXTL (.str) file"
set action export_drawxtl
set DXTLcolorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
proc export_drawxtl {} {
    global expmap expgui
    # don't bother if there are no phases to write
    if {[llength $expmap(phaselist)] == 0} {
	MyMessageBox -parent . -title "No phases" \
		-message "Sorry, no phases are present to write" \
		-icon warning
	return
    }
    foreach t [trace vinfo expgui(export_phase)] {
	eval trace vdelete expgui(export_phase) $t
    }
     MakeExportBox .export "Export coordinates to program DRAWXTL" ""
#	    "MakeWWWHelp expgui.html export"

    # trigger a quit on window delete
    wm protocol .export WM_DELETE_WINDOW {set expgui(export_phase) 0; destroy .export }
    set bx .export.special
    global DXTL
    if {[info global DXTL] == ""} {
	set DXTL(bonds) 0
	set DXTL(coords) 1
	set DXTL(blackarrow) Green
	set DXTL(redarrow) Red
    }
    set row 1
    grid [label $bx.1 -text "Title:"] -column 1 -row $row -sticky e
    grid [entry $bx.2 -textvariable DXTL(title) -width 40] \
	-row $row -column 2 -columnspan 5 -sticky w
    set DXTL(title) [expinfo title]
    incr row
    grid [checkbutton $bx.3 -text "Include coordinates in .str file" \
	      -variable DXTL(coords)] \
	-row $row -column 1 -columnspan 5 -sticky w
    incr row
    set DXTL(arrowbox) $bx.4
    grid [checkbutton $bx.4 -text "Display arrows for magnetic atoms" \
	      -variable DXTL(genarrows) -state disabled] \
	-row $row -column 1 -columnspan 5 -sticky w
    incr row
    set DXTL(arrowcolorbox) $bx.4a
    set DXTL(arrowcolorbox_row) $row
    grid [frame $bx.4a] -sticky ew -row $DXTL(arrowcolorbox_row) \
	-column 1 -columnspan 5 
    grid [label $bx.4a.h -text "Arrow colors: "] -column 0 -row 1 -sticky w
    grid [label $bx.4a.bll -text "   generated by Black operator "] -column 0 -row 2
    eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $::DXTLcolorlist
    grid $bx.4a.bl -column 2 -row 2
    grid [label $bx.4a.redl -text "  generated by Red operator "] -column 0 -row 3
    eval tk_optionMenu $bx.4a.red DXTL(redarrow) $::DXTLcolorlist
    grid $bx.4a.red -column 2 -row 3
    incr row
    # is DRAWxtl installed?
    set app {}
    if {![catch {set fp [open [file join $::env(HOME) .drawxtlrc] r]}]} {
	# line 12 is name of executable
	set i 0
	while {$i < 12} {
	    incr i
	    gets $fp appname
	}
	close $fp
	set app [auto_execok $appname]
    }
    if {$app != ""} {
	set show normal
	set DXTL(app) $appname
	set DXTL(launch) 1
    } else {
	set show disabled
	set DXTL(launch) 0
    }
    grid [checkbutton $bx.l -text "Launch DRAWxtl" \
	      -variable DXTL(launch) -state $show] \
	-row $row -column 1 -columnspan 5 -sticky w
    incr row
    grid [frame $bx.c -relief groove -bd 4] -row $row -column 0 -columnspan 5
    grid [label $bx.c.0 -text "Range of fractional coordinates to include" \
	      -anchor center] -row 0 -column 0 -columnspan 8
    foreach v {x y z} V {X Y Z} {
	incr row
	grid [label $bx.c.${v}1 -text "${V} min:"] -column 1 -row $row
	grid [entry $bx.c.${v}2 -textvariable DXTL(${v}min) -width 4] -column 2 -row $row
	grid [scale $bx.c.${v}3 -resolution 0.1 -variable DXTL(${v}min) \
		  -showvalue 0 -orient h -from -2 -to 1] -column 3 -row $row
	set DXTL(${v}min) -0.1
	grid [label $bx.c.${v}4 -text " max:"] -column 4 -row $row
	grid [entry $bx.c.${v}5 -textvariable DXTL(${v}max) -width 4] -column 5 -row $row
	grid [scale $bx.c.${v}6 -resolution 0.1 -variable DXTL(${v}max) \
		  -showvalue 0 -orient h -from 0 -to 3] -column 6 -row $row
	set DXTL(${v}max) 1.1
    }
    # atom type box
    grid [frame $bx.s -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky nsew
    grid [label $bx.s.0 -text "Atom representation" \
	      -anchor w] -row 0 -column 0 -sticky w
    grid [canvas $bx.s.canvas -relief sunk -bd 2 \
	      -scrollregion {0 0 5000 500} -width 250 -height 70 \
	      -yscrollcommand "$bx.s.scroll set" ] \
	-column 0 -row [incr row] -sticky nsew
    grid columnconfig $bx.s 0 -weight 1
    frame [set DXTL(lb) $bx.s.canvas.fr]
    $bx.s.canvas create window 0 0 -anchor nw -window $DXTL(lb)
    grid [scrollbar $bx.s.scroll \
	      -command "$bx.s.canvas yview"] -sticky ns -row $row -column 1
    # bond box
    incr row
    grid [frame $bx.b -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky ew
    grid [frame $bx.b.0] -row 0 -column 0 -columnspan 7 -sticky ew
    grid [label $bx.b.0.1 -text "Bond List" \
	      -anchor w] -row 0 -column 0 -sticky w
    grid columnconfig $bx.b.0 0 -weight 1
    grid [button $bx.b.0.b -text "Add Bond" -command DXTLaddBond \
	     ] -row 0 -column 1 -sticky e
    grid [canvas $bx.b.canvas -relief sunk -bd 2 \
	      -scrollregion {0 0 5000 500} -width 250 -height 70 \
	      -yscrollcommand "$bx.b.scroll set" ] \
	-column 0 -row [incr row] -sticky nsew
    grid columnconfig $bx.b 0 -weight 1
    frame [set DXTL(Blst) $bx.b.canvas.fr]
    $bx.b.canvas create window 0 0 -anchor nw -window $DXTL(Blst)
    grid [scrollbar $bx.b.scroll \
	      -command "$bx.b.canvas yview"] -sticky ns -row $row -column 1
    # Fourier Box
    incr row
    grid [frame $bx.f -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky nsew
    grid [label $bx.f.0 -text "Fourier display" \
	      -anchor w] -row 0 -column 0 -sticky w
    grid [frame $bx.f.1] -column 0 -row 1 -sticky news
    grid [frame $bx.f.2] -column 0 -row 2 -sticky news
    grid [canvas $bx.f.canvas -relief sunk -bd 2 \
	      -scrollregion {0 0 5000 500} -width 250 -height 70 \
	      -yscrollcommand "$bx.f.scroll set" ] \
	-column 0 -row 3 -sticky nsew
    grid columnconfig $bx.f 0 -weight 1
    frame [set DXTL(fb) $bx.f.canvas.fr]
    $bx.f.canvas create window 0 0 -anchor nw -window $DXTL(fb)
    grid [scrollbar $bx.f.scroll \
	      -command "$bx.f.canvas yview"] -sticky ns -row 3 -column 1
    grid [button $bx.f.1.1 -text "Setup\nFourier" \
              -command EditFourier] -column 0 -row 0
    grid [button [set DXTL(FourCompute) $bx.f.1.2] -text "Compute\nFourier" \
              -command {DXTLwritegrd $expgui(export_phase)}] -column 1 -row 0
    grid [label $bx.f.1.3 -text "Select\nMap"] -column 3 -row 0
    set DXTL(fmenu) [tk_optionMenu $bx.f.1.4 DXTL(mtype) test]
    grid $bx.f.1.4 -column 4 -row 0
    grid [button [set DXTL(AddContour) $bx.f.1.5] -text "Add\nContour" \
              -command AddContour] -column 5 -row 0
    SetupFourierButtons
return
    # force the window to stay on top
    putontop .export
    trace variable expgui(export_phase) w "SetDXTLatoms;SetupFourierButtons"
    SetDXTLatoms
    # this appears to be needed by OSX
    ResizeWin .export

    # Wait for the Write or Quit button to be pressed
    tkwait window .export
    afterputontop
    # test for Quit
    if {$expgui(export_phase) == 0} {return}

    # now open the file and write it
    set phase $expgui(export_phase)
    if [catch {
	set filnam [file rootname $expgui(expfile)]_${phase}.str
	set fp [open $filnam w]
	# deal with macromolecular phases
	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
	    MyMessageBox -parent . -title "MM phase" \
		-message "Sorry, macromolecular phases cannot be processed" \
		-icon warning
	    return
	}
	catch {unset typelist}
	foreach atom $expmap(atomlist_$phase) {
	    set typelist([atominfo $phase $atom type]) 1
	}
	# title info from GSAS title & phase title
	puts $fp "REM  created by EXPGUI from $expgui(expfile) on [clock format [clock seconds]]"
	puts $fp "title \"$DXTL(title)\""
        puts $fp "pack $DXTL(xmin) $DXTL(xmax) $DXTL(ymin) $DXTL(ymax) $DXTL(zmin) $DXTL(zmax)"
	puts $fp "edges 0.02 Black"
	puts $fp "phong 1.0 30."
	foreach type [array names typelist] {
	    if {$DXTL(display_$type) == "sphere"} {
		puts $fp "sphere $type $DXTL(radius_$type) $DXTL(color_$type)"
	    } elseif {$DXTL(display_$type) == "polyhedron"} {
		puts $fp "polysz $type $DXTL(radius_$type) $DXTL(color_$type)"
	    } elseif {$DXTL(display_$type) == "ellipsoid"} {
		puts $fp "ellipcolor $type * $DXTL(color_$type)"
	    }
	}
	if {$DXTL(coords)} {
	    # write out cell parameters
	    puts -nonewline $fp "cell"
	    foreach p {a b c alpha beta gamma} {
		puts -nonewline $fp " [phaseinfo $phase $p]"
	    }
	    puts $fp ""
	    # write out GSAS spacegroup
	    puts $fp "spgp [phaseinfo $phase spacegroup]"
	    # now loop over atoms
	    foreach atom $expmap(atomlist_$phase) {
		puts -nonewline $fp "atom [atominfo $phase $atom type] $atom "
		foreach v {x y z} {
		    puts -nonewline $fp "[atominfo $phase $atom $v] "
		}
		puts $fp ""
		
		set uiso [atominfo $phase $atom Uiso]
		# are there anisotropic atoms? If so convert them to Uequiv
		if {[atominfo $phase $atom temptype] == "A"} {
		    puts -nonewline $fp "Uij [atominfo $phase $atom type] $atom "
		    foreach v {U11 U22 U33 U12 U13 U23} {
			puts -nonewline $fp "[atominfo $phase $atom $v] "
		    }
		    puts $fp ""
		}
	    }
	} else {
	    puts $fp "import gsas [file tail $expgui(expfile)] $phase"
	}
	for {set i 1} {$i <= $DXTL(bonds)} {incr i} {
	    puts $fp "bond $DXTL(ba_$i) $DXTL(bb_$i) $DXTL(bw_$i) $DXTL(bmin_$i) $DXTL(bmax_$i) $DXTL(bc_$i)"
	}
	# list arrows, when requested
	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] != 1 && \
		$DXTL(genarrows)} {
	    DXTLwriteArrows $fp $phase
	}
        DXTLwriteFourierCommands
	puts $fp "END"
	close $fp
	if {$DXTL(launch)} {
	    exec $DXTL(app) $filnam &
	}
    } errmsg] {
	MyMessageBox -parent . -title "Export error" \
		-message "Export error: $errmsg" -icon warning
    } else {
	MyMessageBox -parent . -title "Done" \
		-message "File [file tail $filnam] was written"
    }
    catch {unset DXTL}
    foreach t [trace vinfo expgui(export_phase)] {
	eval trace vdelete expgui(export_phase) $t
    }
 }

# resize windows -- this appears to be needed by OSX 10.2
proc ResizeWin {win} {
    update
    wm geom $win [winfo reqwidth $win]x[winfo reqheight $win]
    # center the EXPGUI window
    wm withdraw $win
    set x [expr [winfo screenwidth $win]/2 - [winfo reqwidth $win]/2 ]
    set y [expr [winfo screenheight $win]/2 - [winfo reqheight $win]/2]
    wm geom $win +$x+$y
    wm deiconify $win
}


# add atoms to atom representation list
proc SetDXTLatoms {args} {
    global DXTL expgui expmap
    eval destroy [winfo children $DXTL(lb)]
    eval destroy [winfo children $DXTL(Blst)]
    set DXTL(bonds) 0
    if {$expgui(export_phase) == 0} {return}
    set phase $expgui(export_phase)
    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
	MyMessageBox -parent . -title "MM phase" \
	    -message "Sorry, macromolecular phases cannot be processed" \
	    -icon warning
	return
    }
    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 1} {
	set DXTL(genarrows) 0
	$DXTL(arrowbox) configure -state disabled
	grid forget $DXTL(arrowcolorbox) 
    } else {
	set DXTL(genarrows) 1
	$DXTL(arrowbox) configure -state normal
	grid $DXTL(arrowcolorbox) -sticky ew -row $DXTL(arrowcolorbox_row) \
	    -column 1 -columnspan 5
    }
    catch {unset typelist}
    set DXTL(title)  [phaseinfo $phase name]
    foreach atom $expmap(atomlist_$phase) {
	set typelist([atominfo $phase $atom type]) 1
    }
    set DXTL(typelist) [array names typelist]
    set row 0
    grid [label $DXTL(lb).l$row -text "type " -bg yellow\
	     ] -column 0 -row $row  -sticky ew
    grid [label $DXTL(lb).d$row -text " representation " -bg yellow
	 ] -column 1 -row $row -sticky ew
    grid [label $DXTL(lb).e$row -text " radius " -bg yellow\
	     ] -column 2 -row $row -sticky ew
    grid [label $DXTL(lb).c$row -text " color " -bg yellow\
	     ] -column 3 -row $row -sticky ew
    foreach type [array names typelist] {
	incr row
	grid [label $DXTL(lb).l$row -text $type] -column 0 -row $row
	tk_optionMenu $DXTL(lb).d$row DXTL(display_$type) sphere polyhedron ellipsoid none
	grid $DXTL(lb).d$row -column 1 -row $row
	grid [entry $DXTL(lb).e$row -textvariable DXTL(radius_$type) \
		-width 5] -column 2 -row $row
	eval tk_optionMenu $DXTL(lb).c$row DXTL(color_$type) $::DXTLcolorlist
	grid $DXTL(lb).c$row -column 3 -row $row
	set DXTL(display_$type) sphere
	set DXTL(radius_$type) 0.2
	set DXTL(color_$type) [lindex $::DXTLcolorlist $row]
    }
    # Resize the list
    update
    set sizes [grid bbox $DXTL(lb)]
    [winfo parent $DXTL(lb)] config -scrollregion $sizes \
	-width [lindex $sizes 2]
    set sizes [grid bbox $DXTL(Blst)]
    [winfo parent $DXTL(Blst)] config -scrollregion $sizes \
	-width [lindex $sizes 2]
    wm geom [winfo toplevel $DXTL(Blst)] {}
}

# add bonds to bond list
proc DXTLaddBond {} {
    global DXTL
    if {$DXTL(bonds) == 0} {
	# insert header
	set row 0
	grid [label $DXTL(Blst).a$row -text "from " -bg yellow\
		 ] -column 1 -row $row  -sticky ew
	grid [label $DXTL(Blst).b$row -text " to " -bg yellow\
		 ] -column 2 -row $row  -sticky ew
	grid [label $DXTL(Blst).c$row -text " width " -bg yellow\
		 ] -column 3 -row $row  -sticky ew
	grid [label $DXTL(Blst).d$row -text " min " -bg yellow\
	     ] -column 4 -row $row  -sticky ew
	grid [label $DXTL(Blst).e$row -text " max " -bg yellow\
		 ] -column 5 -row $row  -sticky ew
	grid [label $DXTL(Blst).f$row -text " color " -bg yellow\
		 ] -column 6 -row $row  -sticky ew
    }
    set row [incr DXTL(bonds)]
    eval tk_optionMenu $DXTL(Blst).ta$row DXTL(ba_$row) $DXTL(typelist)
    grid $DXTL(Blst).ta$row -column 1 -row $row
    eval tk_optionMenu $DXTL(Blst).tb$row DXTL(bb_$row) $DXTL(typelist)
    grid $DXTL(Blst).tb$row -column 2 -row $row
    grid [entry $DXTL(Blst).w$row -textvariable DXTL(bw_$row) \
	      -width 5] -column 3 -row $row
    grid [entry $DXTL(Blst).mi$row -textvariable DXTL(bmin_$row) \
	      -width 5] -column 4 -row $row
    grid [entry $DXTL(Blst).mx$row -textvariable DXTL(bmax_$row) \
	      -width 5] -column 5 -row $row
    eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $::DXTLcolorlist
    grid $DXTL(Blst).c$row -column 6 -row $row
    set DXTL(bw_$row) 0.02
    set DXTL(bmin_$row) 1.0
    set DXTL(bmax_$row) 2.0
    set DXTL(bc_$row) [lindex $::DXTLcolorlist $row]
    # Resize the list
    update
    set sizes [grid bbox $DXTL(Blst)]
    [winfo parent $DXTL(Blst)] config -scrollregion $sizes \
	-width [lindex $sizes 2]
}

proc DXTLwriteArrows {out phase} {
    global expgui expmap DXTL
    set fp [open geom.in w]
    puts $fp "N"
    puts $fp "M"
    if {[llength $expmap(phaselist)] > 1} {
	puts $fp "$phase"
    }
    puts $fp "N"
    puts $fp "X"
    close $fp
    catch {
        if {$::tcl_platform(platform) == "windows"} {
            exec [file join $expgui(gsasexe) geometry.exe] \
		[file root $expgui(expfile)] < geom.in >& geom.out
        } else {
            exec [file join $expgui(gsasexe) geometry] \
		[file root $expgui(expfile)] < geom.in >& geom.out
        }
	set fp [open geom.out r]
	while {[gets $fp line] >= 0} {
	    if {[string match "*Geometry*,L,N,*" $line]} {
		MyMessageBox -parent . -title "Old GSAS" \
		    -message "Old GEOMETRY program: You are using an old version of GSAS that cannot export magnetic vectors. Upgrade GSAS to generate arrows." -icon warning
		break
	    }
	    if {[string match "*name*elem*x *y *z*x *y *z*" $line]} {break}
	}
	set i 0
	while {[gets $fp line] >= 0} {
	    if {[string match "*Enter Geometry option*" $line]} {break}
	    incr i
	    if {$i == 2} {
		set name [string trim [string range $line 5 12]]
		set tail [string trim [string range $line 22 end]]
		set pos [lrange $tail 0 2]
		set spin [lindex $tail end]
	    } elseif {$i == 5} {
		set vec [string trim [string range $line 22 end]]
		if {[catch {set count($name)}]} {set count($name) 0}
		catch {
		    set k ?
		    incr count($name)
		    set k $count($name)
		}
		puts $out "rem spin for atom $name # $k ($spin)"
		if {$spin == "Red"} {
		    puts $out "arrow $pos     $vec    1. 0.15 $DXTL(redarrow)"
		} else {
		    puts $out "arrow $pos     $vec    1. 0.15 $DXTL(blackarrow)"
		}
	    } elseif {$i == 6} {
		set i 1
	    }
	}
    }
    catch {close $fp}
    catch {file delete -force geom.in geom.out}
    puts $out "mag_trans 1. 0 0  0 1. 0  0 0 1."
}

# Computes a Fourier map(s) and converts the maps from binary to ascii
#   returns a list of Fourier map types
proc DXTLwritegrd {phase} {
    global expgui expmap DXTL
    set lst [listFourier]
    if {$lst < 1} {
        MyMessageBox -parent . -title "No Fourier" \
            -message "You have not set up to compute a Fourier map." \
            -icon warning
        return
    }
    set typelist {}
    foreach l $lst {
        lappend typelist [Fourierinfo $l type]
    }
    set hists [FourierHists $phase]
    # make sure we have default limits
    getFourierLimits $phase
    if {[llength $hists] < 1} {
        MyMessageBox -parent . -title "No Fourier" \
            -message "You have not set up to compute a Fourier map for phase $phase." \
            -icon warning
        return
    }
    if {$::tcl_platform(platform) == "windows"} {
        set map [file join $expgui(gsasexe) gsas2map.exe]
        set fourier [file join $expgui(gsasexe) fourier.exe]
    } else {
        set map [file join $expgui(gsasexe) gsas2map]
        set fourier [file join $expgui(gsasexe) fourier]
    }
    if {![file exists $map]} {
        MyMessageBox -parent . -title "No Map Converter prog" \
            -message "Error Fourier map converter program ($map) not found." \
            -icon warning
        return
    }
    if {![file exists $fourier]} {
        MyMessageBox -parent . -title "No Fourier prog" \
            -message "Error Fourier program ($fourier) not found." \
            -icon warning
        return
    }
    set fp [open f.in w]
    if {[llength $typelist] > 1} {
	puts $fp [lindex $typelist 0]
    }
    puts $fp "E"
    foreach t [lrange $typelist 1 end] {
        puts $fp "F $t"
        puts $fp "E"
    }
    puts $fp "q"
    close $fp
    # delete any old grd files
    foreach f [glob -nocomplain "[file root $expgui(expfile)]*.grd"] {
        catch {file delete -force $f}
    }
    set deleteerror 0
    if {[llength [glob -nocomplain "[file root $expgui(expfile)]*.grd"]] >0} {
        MyMessageBox -parent . -title "Old grd files?" \
            -message "Warning: Could not delete old .grd files; it will probably not be possible to overwrite them either. Be aware that map results may be out of date." \
            -icon warning
        set deleteerror 1
    }
    catch {
        exec $fourier [file root $expgui(expfile)] >& f.out
        exec $map [file root $expgui(expfile)] < f.in >>& f.out
    }
    if {[llength [glob -nocomplain "[file root $expgui(expfile)]*.grd"]] == 0} {
        set fp [open f.out r]
        set lines {}
        while {[gets $fp line] >= 0} {
            append lines $line "\n"
        }
        close $fp
        MyMessageBox -parent . -title "No grd files" \
            -message "Error: no .grd files were created. See log file below\n\n$lines" \
            -icon error
        return {}
    } else {
        catch {close $fp}
        catch {file delete -force f.in f.out}
        return $typelist
    }
}

proc SetupFourierButtons {} {
    set phase $::expgui(export_phase)
    $::DXTL(FourCompute) config -state disabled
    $::DXTL(AddContour) config -state disabled
    $::DXTL(fmenu) delete 0 end
    set ::DXTL(mtype) ""
    set ::DXTL(mfil) ""
    # if the Fourier is not set up; return here
    if {[listFourier] < 1} return
    if {[llength [FourierHists $phase]] < 1} return
    # make sure we have default limits
    getFourierLimits $phase
    $::DXTL(FourCompute) config -state normal
    # if there are no maps, return here
    set maps [glob -nocomplain "[file root $::expgui(expfile)]*.grd"]
    if {[llength $maps] < 1} return
    set types {}
    foreach fil $maps {
        lappend types [lindex [split [file root [file tail $fil]] "_"] end]
    }
    $::DXTL(AddContour) config -state normal
    set i 0
    foreach fil $maps lbl $types {
        if {$i == 1} {$::DXTL(fmenu) invoke 0}
        incr i
        $::DXTL(fmenu) add command -label $lbl \
            -command "set DXTL(mtype) $lbl; set DXTL(mfil) $fil"
    }
}

proc EditFourier {} {
    error
}

proc AddContour {} {
    error
}

proc DXTLwriteFourierCommands {} {
    error
    #mapread grd 10CO_DELF.grd 4
    #mapcontour  2.000 mesh Green
    #mapcontour  2.500 solid Blue
}