# $Id: readexp.tcl 85 2009-12-04 23:00:09Z toby $
# Routines to deal with the .EXP "data structure"
set expmap(Revision) {$Revision: 85 $ $Date: 2009-12-04 23:00:09 +0000 (Fri, 04 Dec 2009) $}

#  The GSAS data is read from an EXP file.
#   ... reading an EXP file into an array
proc expload {expfile} {
    global exparray tcl_platform
    # $expfile is the path to the data file.
    if [catch {set fil [open "$expfile" r]}] {
	tk_dialog .expFileErrorMsg "File Open Error" \
		"Unable to open file $expfile" error 0 "Exit" ; return 1
    }
    set len [gets $fil line]
    if {[string length $line] != $len} {
	tk_dialog .expConvErrorMsg "old tcl" \
		"You are using an old version of Tcl/Tk and your .EXP file has binary characters; run convstod or upgrade" \
		error 0 "Exit"
	exit
    }
    if {$len > 160} {
	# a UNIX-type file
	set i1 0
	set i2 79
	while {$i2 < $len} {
	    set nline [string range $line $i1 $i2]
	    incr i1 80
	    incr i2 80
	    set key [string range $nline 0 11]
	    set exparray($key) [string range $nline 12 end]
	}
    } else {
	while {$len > 0} {
	    set key [string range $line 0 11]
	    set exparray($key) [string range $line 12 end]
	    set len [gets $fil line]
	}
    }
    close $fil
    return 0
}

proc createexp {expfile title} {
    global exparray expmap
    catch {unset exparray}
    foreach key   {"     VERSION" "      DESCR" "ZZZZZZZZZZZZ" " EXPR NPHAS"} \
	    value {"   6"         ""            "  Last EXP file record" } {
	# truncate long keys & pad short ones
	set key [string range "$key        " 0 11]
	set exparray($key) $value
    }
    expinfo title set $title
    exphistory add " created readexp.tcl [lindex $expmap(Revision) 1] [clock format [clock seconds]]"
    expwrite $expfile
}

# get information out from an EXP file
#   creates the following entries in global array expmap
#     expmap(phaselist)     gives a list of defined phases
#     expmap(atomlist_$p)   gives a list of defined atoms in phase $p
#     expmap(htype_$n)      gives the GSAS histogram type for histogram
#     expmap(powderlist)    gives a list of powder histograms
#     expmap(phaselist_$n)  gives a list of phases used in histogram $n
#
proc mapexp {} {
    global expmap exparray
    # get the defined phases
    set line [readexp " EXPR NPHAS"]
#    if {$line == ""} {
#	set msg "No EXPR NPHAS entry. This is an invalid .EXP file"
#	tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
#	destroy .
#    }
    set expmap(phaselist) {}
    # loop over phases
    foreach iph {1 2 3 4 5 6 7 8 9} {
	set i5s [expr ($iph - 1)*5]
	set i5e [expr $i5s + 4]
	set flag [string trim [string range $line $i5s $i5e]]
	if {$flag == ""} {set flag 0}
	if $flag {lappend expmap(phaselist) $iph}
    }
    # get the list of defined atoms for each phase
    foreach iph $expmap(phaselist) {
	set expmap(atomlist_$iph) {}
	foreach key [array names exparray "CRS$iph  AT*A"] {
	    regexp { AT *([0-9]+)A} $key a num
	    lappend expmap(atomlist_$iph) $num
	}
	# note that sometimes an .EXP file contains more atoms than are actually defined
	# drop the extra ones
	set expmap(atomlist_$iph) [lsort -integer $expmap(atomlist_$iph)]
	set natom [phaseinfo $iph natoms]
	if {$natom != [llength $expmap(atomlist_$iph)]} {
	    set expmap(atomlist_$iph) [lrange $expmap(atomlist_$iph) 0 [expr $natom-1]]
	}
    }
    # now get the histogram types
    set nhist [string trim [readexp { EXPR  NHST }]]
    set n 0
    set expmap(powderlist) {}
    for {set i 0} {$i < $nhist} {incr i} {
	set ihist [expr $i + 1]
	if {[expr $i % 12] == 0} {
	    incr n
	    set line [readexp " EXPR  HTYP$n"]
	    if {$line == ""} {
		set msg "No HTYP$n entry for Histogram $ihist. This is an invalid .EXP file"
		tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
		destroy .
	    }
	    set j 0
	} else {
	    incr j
	}
	set expmap(htype_$ihist) [lindex $line $j]
	# at least for now, ignore non-powder histograms
	if {[string range $expmap(htype_$ihist) 0 0] == "P"} {
	    lappend expmap(powderlist) $ihist
	}
    }

    # now process powder histograms
    foreach ihist $expmap(powderlist) {
	# make a 2 digit key -- hh
	if {$ihist < 10} {
	    set hh " $ihist"
	} else {
	    set hh $ihist
	}
	set line [readexp "HST $hh NPHAS"]
	if {$line == ""} {
	    set msg "No NPHAS entry for Histogram $ihist. This is an invalid .EXP file"
	    tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
	    destroy .
	}
	set expmap(phaselist_$ihist) {}
	# loop over phases
	foreach iph {1 2 3 4 5 6 7 8 9} {
	    set i5s [expr ($iph - 1)*5]
	    set i5e [expr $i5s + 4]
	    set flag [string trim [string range $line $i5s $i5e]]
	    if {$flag == ""} {set flag 0}
	    if $flag {lappend expmap(phaselist_$ihist) $iph}
	}
    }
}

# return the value for a ISAM key
proc readexp {key} {
    global exparray
    # truncate long keys & pad short ones
    set key [string range "$key        " 0 11]
    if [catch {set val $exparray($key)}] {
	global expgui
	if $expgui(debug) {puts "Error accessing record $key"}
	return ""
    }
    return $val
}

# return the number of records matching ISAM key (may contain wildcards)
proc existsexp {key} {
    global exparray
    # key can contain wild cards so don't pad
    return [llength [array names exparray  $key]]
}


# replace a section of the exparray with $value 
#   replace $char characters starting at character $start (numbered from 1)
proc setexp {key value start chars} {
    global exparray
    # truncate long keys & pad short ones
    set key [string range "$key        " 0 11]
    if [catch {set exparray($key)}] {
	global expgui
	if $expgui(debug) {puts "Error accessing record $key"}
	return ""
    }

    # pad value to $chars 
    set l0 [expr $chars - 1]
    set value [string range "$value                                           " 0 $l0]

    if {$start == 1} {
	set ret {}
	set l1 $chars
    } else {
	set l0 [expr $start - 2]
	set l1 [expr $start + $chars - 1]
	set ret [string range $exparray($key) 0 $l0]
    }
    append ret $value [string range $exparray($key) $l1 end]
    set exparray($key) $ret
}

proc makeexprec {key} {
    global exparray
    # truncate long keys & pad short ones
    set key [string range "$key        " 0 11]
    if [catch {set exparray($key)}] {
	# set to 68 blanks
	set exparray($key) [format %68s " "]
    }
}

# delete an exp recorde
# returns 1 if OK; 0 if not found
proc delexp {key} {
    global exparray
    # truncate long keys & pad short ones
    set key [string range "$key        " 0 11]
    if [catch {unset exparray($key)}] {
	return 0
    }
    return 1
}
# test an argument if it is a valid number; reform the number to fit
proc validreal {val length decimal} {
    upvar $val value
    if [catch {expr $value}] {return 0}
    if [catch {
	set tmp [format "%${length}.${decimal}f" $value]
	while {[string length $tmp] > $length} {
	    set tmp [format "%${length}.${decimal}E" $value]
	    incr decimal -1
	}
	set value $tmp
    }] {return 0}
    return 1
}

# test an argument if it is a valid integer; reform the number into
# an integer, if appropriate -- be sure to pass the name of the variable not the value
proc validint {val length} {
    upvar $val value
    # FORTRAN type assumption: blank is 0
    if {$value == ""} {set value 0}
    set tmp [expr round($value)]
    if {$tmp != $value} {return 0}
    if [catch {
	set value [format "%${length}d" $tmp]
    }] {return 0}
    return 1
}

# process history information
#    action == last 
#       returns number and value of last record
#    action == add
#
proc exphistory {action "value 0"} {
    global exparray
    if {$action == "last"} {
	set key [lindex [lsort -decreasing [array names exparray *HSTRY*]] 0]
	if {$key == ""} {return ""}
	return [list [string trim [string range $key 9 end]] $exparray($key)]
    } elseif {$action == "add"} {
	set key [lindex [lsort -decreasing [array names exparray *HSTRY*]] 0]
	if {$key == ""} {
	    set index 1
	} else {
	    set index [string trim [string range $key 9 end]]
	    if {$index != "***"} {
		if {$index < 999} {incr index}
		set key [format "    HSTRY%3d" $index]
		set exparray($key) $value
	    }
	}
	set key [format "    HSTRY%3d" $index]
	set exparray($key) $value
    }
}
# get overall info 
#   parm:
#     print     -- GENLES print option (*)
#     cycles    -- number of GENLES cycles (*)
#     title     -- the overall title (*)
proc expinfo {parm "action get" "value {}"} {
    switch ${parm}-$action {
	title-get {
	    return [string trim [readexp "      DESCR"]]
	}
	title-set {
	    setexp "      DESCR" " $value" 1 68
	}

	cycles-get {
	    return [string trim [cdatget MXCY]]
	}
	cycles-set {
	    if ![validint value 1] {return 0}
	    cdatset MXCY [format %4d $value]
	}
	print-get {
	    set print [string trim [cdatget PRNT]]
	    if {$print != ""} {return $print}
	    return 0
	}
	print-set {
	    if ![validint value 1] {return 0}
	    cdatset PRNT [format %3d $value]
	}
	default {
	    set msg "Unsupported expinfo access: parm=$parm action=$action"
	    tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
	    destroy .
	}
    }
    return 1
}

proc cdatget {key} {
    foreach i {1 2 3 4 5 6 7 8 9} {
	if {[existsexp "  GNLS CDAT$i"] == 0} break
	set line [readexp "  GNLS CDAT$i"]
	if {$line == {}} break
	foreach i1 {2 10 18 26 34 42 50 58 66} \
		i2 {9 17 25 33 41 49 57 65 73} {
	    set item [string range $line $i1 $i2]
	    if {[string trim $item] == {}} continue
	    if [regexp "${key}(.*)" $item a b] {return $b}
	}
    }
    return {}
}

proc cdatset {key value} {
    # round 1 see if we can find the string
    foreach i {1 2 3 4 5 6 7 8 9} {
	set line [readexp "  GNLS CDAT$i"]
	if {$line == {}} break
	foreach i1 {2 10 18 26 34 42 50 58 66} \
		i2 {9 17 25 33 41 49 57 65 73} {
	    set item [string range $line $i1 $i2]
	    if {[string trim $item] == {}} continue
	    if [regexp "${key}(.*)" $item a b] {
		# found it now replace it
		incr i1
		setexp "  GNLS CDAT$i" "${key}${value}" $i1 8
		return
	    }
	}
    }
    # not found, take the 1st blank space, creating a card if needed
    foreach i {1 2 3 4 5 6 7 8 9} {
	set line [readexp "  GNLS CDAT$i"]
	if {$line == {}} {makeexprec "  GNLS CDAT$i"}
	foreach i1 {2 10 18 26 34 42 50 58 66} \
		i2 {9 17 25 33 41 49 57 65 73} {
	    set item [string range $line $i1 $i2]
	    if {[string trim $item] == {}} {
		# found a blank space: now replace it
		incr i1
		setexp "  GNLS CDAT$i" "${key}${value}" $i1 8
		return
	    }
	}
    }
    return {}
}

# get phase information: phaseinfo phase parm action value
#   phase: 1 to 9 (as defined)
#   parm:
#     name -- phase name
#     natoms -- number of atoms
#     a b c alpha beta gamma -- cell parameters (*)
#     cellref -- refinement flag for the unit cell(*)
#     celldamp  -- damping for the unit cell refinement (*)
#     spacegroup -- space group symbol
#  action: get (default) or set
#  value: used only with set
#  * =>  read+write supported
proc phaseinfo {phase parm "action get" "value {}"} {
    switch ${parm}-$action {

	name-get {
	    return [string trim [readexp "CRS$phase    PNAM"]]
	}

	spacegroup-get {
	    return [string trim [readexp "CRS$phase  SG SYM"]]
	}

	name-set {
	    setexp "CRS$phase    PNAM" " $value" 1 68
	}

	natoms-get {
	    return [string trim [readexp "CRS$phase   NATOM"]]	    
	}

	a-get {
	   return [string trim [string range [readexp "CRS$phase  ABC"] 0 9]]
	}
	b-get {
	   return [string trim [string range [readexp "CRS$phase  ABC"] 10 19]]
	}
	c-get {
	   return [string trim [string range [readexp "CRS$phase  ABC"] 20 29]]
	}
	alpha-get {
	   return [string trim [string range [readexp "CRS$phase  ANGLES"] 0 9]]
	}
	beta-get {
	   return [string trim [string range [readexp "CRS$phase  ANGLES"] 10 19]]
	}
	gamma-get {
	   return [string trim [string range [readexp "CRS$phase  ANGLES"] 20 29]]
	}

	a-set {
	    if ![validreal value 10 6] {return 0}
	    setexp "CRS$phase  ABC" $value 1 10 	    
	}
	b-set {
	    if ![validreal value 10 6] {return 0}
	    setexp "CRS$phase  ABC" $value 11 10 	    
	}
	c-set {
	    if ![validreal value 10 6] {return 0}
	    setexp "CRS$phase  ABC" $value 21 10 	    
	}
	alpha-set {
	    if ![validreal value 10 4] {return 0}
	    setexp "CRS$phase  ANGLES" $value 1 10 	    
	}
	beta-set {
	    if ![validreal value 10 4] {return 0}
	    setexp "CRS$phase  ANGLES" $value 11 10 	    
	}
	gamma-set {
	    if ![validreal value10 4] {return 0}
	    setexp "CRS$phase  ANGLES" $value 21 10 	    
	}
	cellref-get {
	    if {[string toupper [string range [readexp "CRS$phase  ABC"] 34 34]] == "Y"} {
		return 1
	    }
	    return 0
	}
	cellref-set {
	    if $value {
		setexp "CRS$phase  ABC" "Y" 35 1
	    } else {
		setexp "CRS$phase  ABC" "N" 35 1
	    } 	    
	}
	celldamp-get {
	    set val [string range [readexp "CRS$phase  ABC"] 39 39]
	    if {$val == " "} {return 0}
	    return $val
	}
	celldamp-set {
	    setexp "CRS$phase  ABC" $value 40 1
	}

	default {
	    set msg "Unsupported phaseinfo access: parm=$parm action=$action"
	    tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
	    destroy .
	}
    }
    return 1
}

# get atom information: atominfo phase atom parm action value
#   phase: 1 to 9 (as defined)
#   atom: a valid atom number [see expmap(atomlist_$phase)]
#      Note that atom and phase can be paired lists, but if there are extra
#      entries in the atoms list, the last phase will be repeated.
#      so that atominfo 1 {1 2 3} xset 1 
#               will set the xflag for atoms 1-3 in phase 1
#      but atominfo {1 2 3} {1 1 1} xset 1 
#               will set the xflag for atoms 1 in phase 1-3
#   parm:
#     type -- element code
#     mult -- atom multiplicity
#     label -- atom label (*)
#     x y z -- coordinates (*)
#     frac --  occupancy (*)
#     temptype -- I or A for Isotropic/Anisotropic
#     Uiso  -- Isotropic temperature factor (*)
#     U11  -- Anisotropic temperature factor (*)
#     U22  -- Anisotropic temperature factor (*)
#     U33  -- Anisotropic temperature factor (*)
#     U12  -- Anisotropic temperature factor (*)
#     U13  -- Anisotropic temperature factor (*)
#     U23  -- Anisotropic temperature factor (*)
#     xref/xdamp -- refinement flag/damping value for the coordinates (*)
#     uref/udamp -- refinement flag/damping value for the temperature factor(s)  (*)
#     fref/fdamp -- refinement flag/damping value for the occupancy (*)
#  action: get (default) or set
#  value: used only with set
#  * =>  read+write supported

proc atominfo {phaselist atomlist parm "action get" "value {}"} {
    foreach phase $phaselist atom $atomlist {
	if {$phase == ""} {set phase [lindex $phaselist end]}
	if {$atom < 10} {
	    set key "CRS$phase  AT  $atom"
	} elseif {$atom < 100} {
	    set key "CRS$phase  AT $atom"
	} else {
	    set key "CRS$phase  AT$atom"
	}
	switch -glob ${parm}-$action {
	    type-get {
		return [string trim [string range [readexp ${key}A] 2 9] ]
	    }
	    mult-get {
		return [string trim [string range [readexp ${key}A] 58 61] ]
	    }
	    label-get {
		return [string trim [string range [readexp ${key}A] 50 57] ]
	    }
	    label-set {
		setexp ${key}A $value 51 8
	    }
	    temptype-get {
		return [string trim [string range [readexp ${key}B] 62 62] ]
	    }
	    x-get {
		return [string trim [string range [readexp ${key}A] 10 19] ]
	    }
	    x-set {
		if ![validreal value 10 6] {return 0}
		setexp ${key}A $value 11 10
	    }
	    y-get {
		return [string trim [string range [readexp ${key}A] 20 29] ]
	    }
	    y-set {
		if ![validreal value 10 6] {return 0}
		setexp ${key}A $value 21 10
	    }
	    z-get {
		return [string trim [string range [readexp ${key}A] 30 39] ]
	    }
	    z-set {
		if ![validreal value 10 6] {return 0}
		setexp ${key}A $value 31 10
	    }
	    frac-get {
		return [string trim [string range [readexp ${key}A] 40 49] ]
	    }
	    frac-set {
		if ![validreal value 10 6] {return 0}
		setexp ${key}A $value 41 10
	    }
	    U*-get {
		regsub U $parm {} type
		if {$type == "iso" || $type == "11"} {
		    return [string trim [string range [readexp ${key}B] 0 9] ]
		} elseif {$type == "22"} {
		    return [string trim [string range [readexp ${key}B] 10 19] ]
		} elseif {$type == "33"} {
		    return [string trim [string range [readexp ${key}B] 20 29] ]
		} elseif {$type == "12"} {
		    return [string trim [string range [readexp ${key}B] 30 39] ]
		} elseif {$type == "13"} {
		    return [string trim [string range [readexp ${key}B] 40 49] ]
		} elseif {$type == "23"} {
		    return [string trim [string range [readexp ${key}B] 50 59] ]
		}
	    }
	    U*-set {
		if ![validreal value 10 6] {return 0}
		regsub U $parm {} type
		if {$type == "iso" || $type == "11"} {
		    setexp ${key}B $value 1 10
		} elseif {$type == "22"} {
		    setexp ${key}B $value 11 10
		} elseif {$type == "33"} {
		    setexp ${key}B $value 21 10
		} elseif {$type == "12"} {
		    setexp ${key}B $value 31 10
		} elseif {$type == "13"} {
		    setexp ${key}B $value 41 10
		} elseif {$type == "23"} {
		    setexp ${key}B $value 51 10
		}
	    }
	    xref-get {
		if {[string toupper [string range [readexp ${key}B] 64 64]] == "X"} {
		    return 1
		}
		return 0
	    }
	    xref-set {
		if $value {
		    setexp ${key}B "X" 65 1
		} else {
		    setexp ${key}B " " 65 1
		} 	    
	    }
	    xdamp-get {
		set val [string range [readexp ${key}A] 64 64]
		if {$val == " "} {return 0}
		return $val
	    }
	    xdamp-set {
		setexp ${key}A $value 65 1
	    }
	    fref-get {
		if {[string toupper [string range [readexp ${key}B] 63 63]] == "F"} {
		    return 1
		}
		return 0
	    }
	    fref-set {
		if $value {
		    setexp ${key}B "F" 64 1
		} else {
		    setexp ${key}B " " 64 1
		} 	    
	    }
	    fdamp-get {
		set val [string range [readexp ${key}A] 63 63]
		if {$val == " "} {return 0}
		return $val
	    }
	    fdamp-set {
		setexp ${key}A $value 64 1
	    }

	    uref-get {
		if {[string toupper [string range [readexp ${key}B] 65 65]] == "U"} {
		    return 1
		}
		return 0
	    }
	    uref-set {
		if $value {
		    setexp ${key}B "U" 66 1
		} else {
		    setexp ${key}B " " 66 1
		} 	    
	    }
	    udamp-get {
		set val [string range [readexp ${key}A] 65 65]
		if {$val == " "} {return 0}
		return $val
	    }
	    udamp-set {
		setexp ${key}A $value 66 1
	    }
	    default {
		set msg "Unsupported atominfo access: parm=$parm action=$action"
		tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
		destroy .
	    }
	}
    }
    return 1
}

# get histogram information: histinfo histlist parm action value
# histlist is a list of histogram numbers
# parm:
#     title
#     scale (*)
#     sref/sdamp -- refinement flag/damping value for the scale factor (*)
#     lam1, lam2 (*)
#     ttref refinement flag for the 2theta (ED Xray) (*)
#     wref refinement flag for the wavelength (*)
#     ratref refinement flag for the wavelength ratio (*)
#     difc, difa -- TOF calibration constants (*)
#     dcref,daref -- refinement flag for difc, difa (*)
#     zero (*)
#     zref refinement flag for the zero correction (*)
#     ipola (*)
#     pola (*)
#     pref refinement flag for the polarization (*)
#     kratio (*)
#     ddamp -- damping value for the diffractometer constants (*)
#     backtype -- background function number *
#     backterms -- number of background terms *
#     bref/bdamp -- refinement flag/damping value for the background (*)
#     bterm$n -- background term #n (*)
#     bank -- Bank number
#     tofangle -- detector angle (TOF only)
#     foextract  -- Fobs extraction flag (*)
proc histinfo {histlist parm "action get" "value {}"} {
    foreach hist $histlist {
	if {$hist < 10} {
	    set key "HST  $hist"
	} else {
	    set key "HST $hist"
	}
	switch -glob ${parm}-$action {
	    foextract-get {
		if {[string toupper [string range [readexp "${key} EPHAS" ] 49 49]] == "T"} {
		    return 1
		}
		return 0
	    }
	    foextract-set {
		if $value {
		    setexp "${key} EPHAS" "T" 50 1
		} else {
		    setexp "${key} EPHAS" "F" 50 1
		} 	    
	    }
	    title-get {
		return [string trim [readexp "${key}  HNAM"] ]
	    }
	    scale-get {
		return [string trim [string range [readexp ${key}HSCALE] 0 14]]
	    }
	    scale-set {
		if ![validreal value 15 6] {return 0}
		setexp ${key}HSCALE $value 1 15
	    }
	    sref-get {
		if {[string toupper [string range [readexp ${key}HSCALE] 19 19]] == "Y"} {
		    return 1
		}
		return 0
	    }
	    sref-set {
		if $value {
		    setexp ${key}HSCALE "Y" 20 1
		} else {
		    setexp ${key}HSCALE "N" 20 1
		} 	    
	    }
	    sdamp-get {
		set val [string range [readexp ${key}HSCALE] 24 24]
		if {$val == " "} {return 0}
		return $val
	    }
	    sdamp-set {
		setexp ${key}HSCALE $value 25 1
	    }

	    difc-get -
	    lam1-get {
		return [string trim [string range [readexp "${key} ICONS"] 0 9]]
	    }
	    difc-set -
	    lam1-set {
		if ![validreal value 10 7] {return 0}
		setexp "${key} ICONS" $value 1 10
	    }
	    difa-get -
	    lam2-get {
		return [string trim [string range [readexp "${key} ICONS"] 10 19]]
	    }
	    difa-set -
	    lam2-set {
		if ![validreal value 10 7] {return 0}
		setexp "${key} ICONS" $value 11 10
	    }
	    zero-get {
		return [string trim [string range [readexp "${key} ICONS"] 20 29]]
	    }
	    zero-set {
		if ![validreal value 10 5] {return 0}
		setexp "${key} ICONS" $value 21 10
	    }
	    ipola-get {
		return [string trim [string range [readexp "${key} ICONS"] 54 54]]
	    }
	    ipola-set {
		if ![validint value 1] {return 0}
		setexp "${key} ICONS" $value 55 1
	    }
	    pola-get {
		return [string trim [string range [readexp "${key} ICONS"] 40 49]]
	    }
	    pola-set {
		if ![validreal value 10 5] {return 0}
		setexp "${key} ICONS" $value 41 10
	    }
	    kratio-get {
		return [string trim [string range [readexp "${key} ICONS"] 55 64]]
	    }
	    kratio-set {
		if ![validreal value 10 5] {return 0}
		setexp "${key} ICONS" $value 56 10
	    }

	    wref-get {
	    #------------------------------------------------------
	    # col 33: refine flag for lambda, difc, ratio and theta
	    #------------------------------------------------------
		if {[string toupper [string range \
			[readexp "${key} ICONS"] 32 32]] == "L"} {
		    return 1
		}
		return 0
	    }
	    wref-set {
		if $value {
		    setexp "${key} ICONS" "L" 33 1
		} else {
		    setexp "${key} ICONS" " " 33 1
		} 	    
	    }
	    ratref-get {
		if {[string toupper [string range \
			[readexp "${key} ICONS"] 32 32]] == "R"} {
		    return 1
		}
		return 0
	    }
	    ratref-set {
		if $value {
		    setexp "${key} ICONS" "R" 33 1
		} else {
		    setexp "${key} ICONS" " " 33 1
		} 	    
	    }
	    dcref-get {
		if {[string toupper [string range \
			[readexp "${key} ICONS"] 32 32]] == "C"} {
		    return 1
		}
		return 0
	    }
	    dcref-set {
		if $value {
		    setexp "${key} ICONS" "C" 33 1
		} else {
		    setexp "${key} ICONS" " " 33 1
		} 	    
	    }
	    ttref-get {
		if {[string toupper [string range \
			[readexp "${key} ICONS"] 32 32]] == "T"} {
		    return 1
		}
		return 0
	    }
	    ttref-set {
		if $value {
		    setexp "${key} ICONS" "T" 33 1
		} else {
		    setexp "${key} ICONS" " " 33 1
		} 	    
	    }


	    pref-get {
	    #------------------------------------------------------
	    # col 34: refine flag for POLA & DIFA
	    #------------------------------------------------------
		if {[string toupper [string range \
			[readexp "${key} ICONS"] 33 33]] == "P"} {
		    return 1
		}
		return 0
	    }
	    pref-set {
		if $value {
		    setexp "${key} ICONS" "P" 34 1
		} else {
		    setexp "${key} ICONS" " " 34 1
		} 	    
	    }
	    daref-get {
		if {[string toupper [string range \
			[readexp "${key} ICONS"] 33 33]] == "A"} {
		    return 1
		}
		return 0
	    }
	    daref-set {
		if $value {
		    setexp "${key} ICONS" "A" 34 1
		} else {
		    setexp "${key} ICONS" " " 34 1
		} 	    
	    }

	    zref-get {
	    #------------------------------------------------------
	    # col 34: refine flag for zero correction
	    #------------------------------------------------------
		if {[string toupper [string range [readexp "${key} ICONS"] 34 34]] == "Z"} {
		    return 1
		}
		return 0
	    }
	    zref-set {
		if $value {
		    setexp "${key} ICONS" "Z" 35 1
		} else {
		    setexp "${key} ICONS" " " 35 1
		} 	    
	    }

	    ddamp-get {
		set val [string range [readexp "${key} ICONS"] 39 39]
		if {$val == " "} {return 0}
		return $val
	    }
	    ddamp-set {
		setexp "${key} ICONS" $value 40 1
	    }

	    backtype-get {
		set val [string trim [string range [readexp "${key}BAKGD "] 0 4]]
		if {$val == " "} {return 0}
		return $val
	    }
	    backtype-set {
		if ![validint value 5] {return 0}
		setexp "${key}BAKGD " $value 1 5
	    }
	    backterms-get {
		set val [string trim [string range [readexp "${key}BAKGD "] 5 9]]
		if {$val == " "} {return 0}
		return $val
	    }
	    backterms-set {
		# this takes a bit of work -- if terms are added, add lines as needed to the .EXP
		set oldval [string trim [string range [readexp "${key}BAKGD "] 5 9]]
		if ![validint value 5] {return 0}
		if {$oldval < $value} {
		    set line1  [expr 2 + ($oldval - 1) / 4]
		    set line2  [expr 1 + ($value - 1) / 4]
		    for {set i $line1} {$i <= $line2} {incr i} {
			# create a blank entry if needed
			makeexprec ${key}BAKGD$i
		    }
		    incr oldval
		    for {set num $oldval} {$num <= $value} {incr num} {
			set f1 [expr 15*(($num - 1) % 4)]
			set f2 [expr 15*(1 + ($num - 1) % 4)-1]
			set line  [expr 1 + ($num - 1) / 4]
			if {[string trim [string range [readexp ${key}BAKGD$line] $f1 $f2]] == ""} {
			    set f1 [expr 15*(($num - 1) % 4)+1]
			    setexp ${key}BAKGD$line 0.0 $f1 15			
			}
		    }
		}
		setexp "${key}BAKGD " $value 6 5

	    }
	    bref-get {
		if {[string toupper [string range [readexp "${key}BAKGD"] 14 14]] == "Y"} {
		    return 1
		}
		return 0
	    }
	    bref-set {
		if $value {
		    setexp "${key}BAKGD "  "Y" 15 1
		} else {
		    setexp "${key}BAKGD "  "N" 15 1
		} 	    
	    }
	    bdamp-get {
		set val [string range [readexp "${key}BAKGD "] 19 19]
		if {$val == " "} {return 0}
		return $val
	    }
	    bdamp-set {
		setexp "${key}BAKGD " $value 20 1
	    }
	    bterm*-get {
		regsub bterm $parm {} num
		set f1 [expr 15*(($num - 1) % 4)]
		set f2 [expr 15*(1 + ($num - 1) % 4)-1]
		set line  [expr 1 + ($num - 1) / 4]
		return [string trim [string range [readexp ${key}BAKGD$line] $f1 $f2] ]
	    }
	    bterm*-set {
		regsub bterm $parm {} num
		if ![validreal value 15 6] {return 0}
		set f1 [expr 15*(($num - 1) % 4)+1]
		set line  [expr 1 + ($num - 1) / 4]
		setexp ${key}BAKGD$line $value $f1 15
	    }
	    bank-get {
		return [string trim [string range [readexp "${key} BANK"] 0 4]]
	    }
	    tofangle-get {
		return [string trim [string range [readexp "${key}BNKPAR"] 10 19]]
	    }
	    default {
		set msg "Unsupported histinfo access: parm=$parm action=$action"
		tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
		destroy .
	    }
	}
    }
    return 1
}

# read the information that differs by both histogram and phase (profile & phase fraction)
# use: hapinfo hist phase parm action value
#  
#     frac -- phase fraction (*)
#     frref/frdamp -- refinement flag/damping value for the phase fraction (*)
#     proftype -- profile function number
#     profterms -- number of profile terms
#     pdamp -- damping value for the profile (*)
#     pcut -- cutoff value for the profile (*)
#     pterm$n -- profile term #n
#     pref$n -- refinement flag value for profile term #n (*)
#     extmeth -- Fobs extraction method (*)
proc hapinfo {histlist phaselist parm "action get" "value {}"} {
    foreach phase $phaselist hist $histlist {
	if {$phase == ""} {set phase [lindex $phaselist end]}
	if {$hist == ""} {set hist [lindex $histlist end]}
	if {$hist < 10} {
	    set hist " $hist"
	}
	set key "HAP${phase}${hist}"
	switch -glob ${parm}-$action {
	    extmeth-get {
		set i1 [expr ($phase - 1)*5]
		set i2 [expr $i1 + 4]
		return [string trim [string range [readexp "HST $hist EPHAS"] $i1 $i2]]
	    }
	    extmeth-set {
		set i1 [expr ($phase - 1)*5 + 1]
		if ![validint value 5] {return 0}
		setexp "HST $hist EPHAS" $value $i1 5
	    }
	    frac-get {
		return [string trim [string range [readexp ${key}PHSFR] 0 14]]
	    }
	    frac-set {
		if ![validreal value 15 6] {return 0}
		setexp ${key}PHSFR $value 1 15
	    }
	    frref-get {
		if {[string toupper [string range [readexp ${key}PHSFR] 19 19]] == "Y"} {
		    return 1
		}
		return 0
	    }
	    frref-set {
		if $value {
		    setexp ${key}PHSFR "Y" 20 1
		} else {
		    setexp ${key}PHSFR "N" 20 1
		} 	    
	    }
	    frdamp-get {
		set val [string range [readexp ${key}PHSFR] 24 24]
		if {$val == " "} {return 0}
		return $val
	    }
	    frdamp-set {
		setexp ${key}PHSFR $value 25 1
	    }
	    proftype-get {
		set val [string range [readexp "${key}PRCF "] 0 4]
		if {$val == " "} {return 0}
		return $val
	    }
	    profterms-get {
		set val [string range [readexp "${key}PRCF "] 5 9]
		if {$val == " "} {return 0}
		return $val
	    }
	    pcut-get {
		return [string trim [string range [readexp "${key}PRCF "] 10 19]]
	    }
	    pcut-set {
		if ![validreal value 10 5] {return 0}
		setexp "${key}PRCF " $value 11 10
	    }
	    pdamp-get {
		set val [string range [readexp "${key}PRCF "] 24 24]
		if {$val == " "} {return 0}
		return $val
	    }
	    pdamp-set {
		setexp "${key}PRCF   " $value 25 1
	    }
	    pterm*-get {
		regsub pterm $parm {} num
		set f1 [expr 15*(($num - 1) % 4)]
		set f2 [expr 15*(1 + ($num - 1) % 4)-1]
		set line  [expr 1 + ($num - 1) / 4]
		return [string trim [string range [readexp "${key}PRCF $line"] $f1 $f2] ]
	    }
	    pterm*-set {
		if ![validreal value 15 6] {return 0}
		regsub pterm $parm {} num
		set f1 [expr 1+ 15*(($num - 1) % 4)]
		set line  [expr 1 + ($num - 1) / 4]
		setexp "${key}PRCF $line" $value $f1 15
	    }
	    pref*-get {
		regsub pref $parm {} num
		set f [expr 24+$num]
		if {[string toupper [string range [readexp "${key}PRCF  "] $f $f]] == "Y"} {
		    return 1
		}
		return 0
	    }
	    pref*-set {
		regsub pref $parm {} num
		set f [expr 25+$num]
		if $value {
		    setexp ${key}PRCF "Y" $f 1
		} else {
		    setexp ${key}PRCF "N" $f 1
		} 	    
	    }
	    default {
		set msg "Unsupported hapinfo access: parm=$parm action=$action"
		tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
		destroy .
	    }
	}
    }
    return 1
}

# write the .EXP file
proc expwrite {expfile} {
    global tcl_platform exparray
    set blankline "                                                                   "
    set fp [open ${expfile} w]
    set keylist [lsort [array names exparray]]
    # reorder the keys so that VERSION comes 1st
    set pos [lsearch -exact $keylist {     VERSION}]
    set keylist "{     VERSION} [lreplace $keylist $pos $pos]"
    if {$tcl_platform(platform) == "windows"} { 
	foreach key $keylist {
	    puts $fp [string range \
		    "$key$exparray($key)$blankline" 0 79]
	}
    } else {
	foreach key $keylist {
	    puts -nonewline $fp [string range \
		    "$key$exparray($key)$blankline" 0 79]
	}
    }
    close $fp
}