
# Copyright (c) 2001 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California
#

# For all the jobs here, return a list with the name of the job and all the
# field values.

proc library_browse_local {dir fields} {
    if [file isfile $dir/model] {
	return [list [list $dir [library_browse_one $dir $fields]]]
    }
    set ret ""
    foreach f [glob -nocomplain $dir/*] {
        if [file isdirectory $f] {
            set ret [concat $ret [library_browse_local $f $fields]]
	} elseif {[file isfile $f] && [file extension $f] == ".tar"} {
            set ret [concat $ret [library_browse_tarfile $dir $f $fields]]
        }
    }
    return $ret
}

proc library_browse_tarfile {dir tarfile fields} {
    global tar_delim tar_files tar_index
    if {![info exists tar_files($tarfile)]} {
	if ![info exists tar_files] { library_load_all }
	if {![info exists tar_files($tarfile)]} {
	    return ""
	}
    }
    set fp $tar_files($tarfile)
    foreach i [array names tar_index "$tarfile${tar_delim}*/model"] {
        set ent [lindex [split $i $tar_delim] 1]
        if {![file exists "$dir/$ent"]} {
            set name [file dirname $ent]
            set data [tarfile_read $tarfile $ent]
            set job [tarfile_read $tarfile "$name/job"]
            set job_title ""
            set job_notes ""
            if {$job != ""} {
                eval $job
            }
            lappend ret [list $tarfile${tar_delim}$name [library_browse_fields $name $fields \
                $data $job_title $job_notes]]
        }
    }
    return $ret
}

proc library_browse_one {dir fields} {
    if [catch {open $dir/model r} fp] {return ""}
    set data [read $fp]
    close $fp
    set job_title ""; set job_notes ""
    catch {source $dir/job}
    return [library_browse_fields $dir $fields $data $job_title $job_notes]
}

proc library_browse_fields {dir fields data title notes} {
    foreach f $fields { set want($f) 1 }
    foreach i [split $data "\n"] {
	set line [string trim $i]
	if {($line == "") || [string match \#* $line]} continue
	set p [lindex $line 0]
	if [info exists want($p)] {
	    set val($p) [lindex $line 1]
	} elseif {$p == "setval"} {
	    foreach {p v} [lrange $line 1 end] {
		if [info exists want($p)] {
		    set val($p) $v
		}
	    }
	} elseif {$p == "shape"} {
	    set val([lindex $line 1]) [lindex $line 2]
	} elseif {$p == "object"} {
	    set val(obtype) [lindex $line 1]
	    set s_name [file split $dir]
	    set val(name) [lindex $s_name [expr [llength $s_name] - 1]]
	}
    }

    set val(job_title) $title
    set val(job_notes) $notes
    if [info exists val(obtype)] {
	array set defs [object_defaults $val(obtype)]
	foreach f [array names want] {
	    if ![info exists val($f)] {
		if [info exists defs($f)] {
		    set val($f) $defs($f)
		} else {
		    set val($f) 0
		}
	    }
	}
    }

    foreach p [array names val] {
	regsub -all \\\\n $val($p) \n val($p)
    }

    return [array get val]
}

proc library_browse_with_constraints {dirs fields constraints newfields_proc} {
    busy 1

    set choices ""
    foreach dir $dirs {
	set choices [concat $choices [library_browse_local $dir $fields]]
    }
    set ret ""
    foreach ch $choices {
	catch {unset vals}
	set name [lindex $ch 0]
	array set vals [lindex $ch 1]
	if {$newfields_proc != ""} {
	    $newfields_proc vals
	}
	set ok 1
	foreach con $constraints {
	    foreach i {0 1 2 3 4} v {f min max globs exact} { set $v [lindex $con $i] }
	    if ![info exists vals($f)] continue
	    set v $vals($f)
	    if {($min != "") && ($v < $min)} { set ok 0; break }
	    if {($max != "") && ($v > $max)} { set ok 0; break }
	    if {$globs != ""} {
		set gok 0
		foreach g $globs {
		    if [string match *$g* $v] { set gok 1; break }
		}
		if !$gok {
		    set ok 0
		    #if {$f != "obtype"} { puts "BAD $name $f $v" }
		    break
		}
	    }
	    if {$exact != ""} {
		if {[lsearch -exact $exact $v] < 0} {
		    set ok 0
		    #if {$f != "obtype"} { puts "BAD $name $f $v" }
		    break
		}
	    }
	}
	if $ok {
	    lappend ret [list $name [array get vals]]
	}
    }
    busy 0
    return $ret
}

# ------------------------------------------------

proc library_browse_form {name title constraints display dirs1 newfields_proc \
			  extra_frame_proc} {
    global $name ${name}_units

    set dirs ""
    foreach d $dirs1 {
	lappend dirs [library_dir $d]
    }

    form_kill .$name

    set scmd [list library_browse_search $name $dirs $newfields_proc]
    set ccmd [list library_browse_create $name]
    set buts [list [list Search $scmd] [list Create $ccmd] cancel]
    set d [form_init .$name $title "" $buts "" 1 1 1]
    if {$d != ""} {
	# First figure out what we are going to put in the constraint list
	set catlist ""
	set nc 0
	catch {unset ${name}(want_fields)}
	foreach c $constraints {
	    foreach v {f title how utype cat} n $c { set $v $n }
	    lappend ${name}(want_fields) $f
	    catch {unset ${name}(choicelist-$f)}

	    switch [lindex $how 0] {
		options {
		    foreach {v n} [lrange $how 1 end] {
			if ![info exists ${name}(choice-$f)] {
			    set ${name}(choice-$f) $v
			}
			lappend ${name}(choicelist-$f) [list $v $n]
		    }
		}
		string {
		    set ${name}(string-$f) [lindex $how 1]
		    set ${name}(on-$f) [lindex $how 2]
		}
		default {
		    foreach {t v on} $how {
			switch $t {
			    min { set ${name}(min-$f) $v; set ${name}(min-on-$f) $on }
			    max { set ${name}(max-$f) $v; set ${name}(max-on-$f) $on }
			}
		    }
		}
	    }
	    if {$utype != ""} {
		set ${name}(utype-$f) [lindex $utype 0]
		set ${name}_units(min-$f) [lindex $utype 1]
		set ${name}_units(max-$f) [lindex $utype 1]
	    }
	    if {$title == ""} {
		set ${name}(on-$f) 1
		continue
	    }
	    if {$cat != ""} {
		if ![info exists in_form($cat)] {
		    lappend catlist [list cat$nc $cat]
		    incr nc
		}
		lappend in_form($cat) [list $f $title]
	    }
	}
	
	form_label $d.criterial "Criteria:" {0 0}
	form_label $d.resultsl "Results:" {1 0}
	form_label $d.detailsl "Details:" {2 0}
	
	# Make the forms.
	set pages [form_notebook $d.constraints $catlist {0 1}]
	foreach page $pages cat $catlist {
	    set row 0
	    foreach item $in_form([lindex $cat 1]) {
		set f [lindex $item 0]
		if [info exists ${name}(choicelist-$f)] {
		    form_checkbutton $page.on$f [lindex $item 1] \
			${name}(on-$f) "$row 0"
		    
		    set func [concat list [set ${name}(choicelist-$f)]]
		    futil_menuentry_labels $page.choice$f ${name}(choice-$f) \
			$func "$row 1 -sticky w" ${name}(on-$f)
		    incr row
		    
		} elseif [info exists ${name}(string-$f)] {
		    form_checkbutton $page.on$f [lindex $item 1] \
			${name}(on-$f) "$row 0"
		    form_entry $page.string$f ${name}(string-$f) string \
			"$row 1 -sticky w" ${name}(on-$f)
		    incr row
		    
		} else {
		    foreach mm {min max} mm2 {Min Max} {
			if [info exists ${name}($mm-$f)] {
			    set lab "$mm2 [string tolower [string index [lindex $item 1] 0]][string range [lindex $item 1] 1 end]"
			    form_checkbutton $page.on$mm$f $lab \
				${name}($mm-on-$f) "$row 0 -sticky w"
			    if [info exists ${name}_units($mm-$f)] {
				model_unitentry $page.$mm$f ${name}($mm-$f) \
				    [set ${name}(utype-$f)] "$row 1" \
				    ${name}($mm-on-$f)
			    } else {
				form_entry $page.$mm$f ${name}($mm-$f) \
				    float "$row 1" ${name}($mm-on-$f)
			    }
			    incr row
			}
		    }
		}
	    }
	}
	form_notebook_finish $d.constraints
	
	# Now determine what goes into the results list and the details list
	
	set ${name}(detail_data) ""
	set ${name}(result_data) ""
	set titles ""
	set widths ""
	foreach disp $display {
	    set col 0
	    foreach {var title units where width} $disp {
		lappend ${name}(want_fields) $var
		if {[lsearch $where results] >= 0} {
		    lappend titles $title
		    lappend widths $width
		    if {[lindex $units 0] == "set"} { set units [eval $units]}
		    lappend ${name}(result_data) $var $units
		    incr col
		}
		if {[lsearch $where details] >= 0} {
		    if {[lindex $units 0] == "set"} { set units [eval $units]}
		    lappend ${name}(detail_data) $var $title $units
		}
	    }
	}
	form_sync_listboxes $d.results $titles $widths \
	    [list library_browse_select_one $name] 6 {1 1}
	set ${name}(result_list) $d.results
	
	form_text $d.details "" "" {2 1} "" 30x16
	set ${name}(detail_text) $d.details
	
	if {$extra_frame_proc != ""} {
	    form_frame $d.extra flat 0 {1 2 -rows 2 -anchor s}
	    form_label $d.extra.l "Preview:" {0 0}
	    form_frame $d.extra.f flat 0 {1 0}
	    set ${name}(after_search_cmd) "$extra_frame_proc $d.extra.f"
	    eval $extra_frame_proc $d.extra.f \"\"
	} else {
	    set ${name}(after_search_cmd) ""
	}
	
	if 0 {
	    form_frame $d.buttons flat 0 {0 2}
	    form_button $d.buttons.search Search \
		[list library_browse_search $name $dirs $newfields_proc] {0 0}
	    form_button $d.buttons.create Create \
		[list library_browse_create $name] {1 0}
	    form_button $d.buttons.cancel Cancel \
		"form_cancel .$name" {2 0}
	    form_button $d.buttons.help Help \
		"help_window_path .$name" {3 0}
	}
	
	form_finish +100+100
    }
}

proc library_browse_select_one {name double numsel} {
    global $name ${name}_units
    
    if {$numsel < 0} return
    
    set res [lindex [set ${name}(search_results)] $numsel]
    array set this [lindex $res 1]
    set text ""
    foreach {var title units} [set ${name}(detail_data)] {
	if [info exists this($var)] {
	    if {$units != ""} {
		set v "[unit_convert $this($var) $units 1] $units"
	    } else {
		set v $this($var)
	    }
	} else {
	    set v ""
	}
	append text "$title = $v\n"
    }
    form_text_set [set ${name}(detail_text)] $text
    set ${name}(result_selected) [lindex $res 0]
    
    set cmd [set ${name}(after_search_cmd)]
    if {$cmd != ""} { eval $cmd this }
    
    if $double { library_browse_create $name }
}

proc library_browse_create {name} {
    global $name
    set sel [set ${name}(result_selected)]
    if {$sel == ""} { user_error "No object selected."; return }
    form_done .$name
#    puts "library_load_object [file dirname $sel] [file tail $sel] [part_get_root]"
    library_load_object "" $sel/model [part_get_root] object
}

proc library_browse_search {name dirs newfields_proc} {
    global $name ${name}_units
    
    set fields [set ${name}(want_fields)]
    set constraints ""
    foreach f $fields {
	set globs ""
	set exact ""
	foreach mm {min max} {
	    if {[info exists ${name}($mm-$f)] && [set ${name}($mm-on-$f)]} {
		if [info exists ${name}_units($mm-$f)] {
		    set $mm [unit_convert [set ${name}($mm-$f)] \
				 [set ${name}_units($mm-$f)] 0]
		} else {
		    set $mm [set ${name}($mm-$f)]
		}
	    } else {
		set $mm ""
	    }
	}
	if {[info exists ${name}(choice-$f)] && [set ${name}(on-$f)]} {
	    set exact [list [set ${name}(choice-$f)]]
	} elseif {[info exists ${name}(string-$f)] && [set ${name}(on-$f)]} {
	    set globs [list [set ${name}(string-$f)]]
	}
	if {($min != "") || ($max != "") || ($globs != "") || ($exact != "")} {
	    lappend constraints [list $f $min $max $globs $exact]
	}
    }
    
    #puts "library_browse_with_constraints \"$dirs\" \"$fields\" \"$constraints\" $newfields_proc"
    busy 1
    set got [library_browse_with_constraints $dirs $fields $constraints \
		 $newfields_proc]
    busy 0
    #puts $got
    
    set ${name}(search_results) $got
    set ${name}(result_selected) ""
    
    foreach one $got {
	catch {unset this}
	array set this [lindex $one 1]
	
	set n 0
	foreach {var units} [set ${name}(result_data)] {
	    if [info exists this($var)] {
		if {$units != ""} {
		    set v [unit_convert $this($var) $units 1]
		} else {
		    set v $this($var)
		}
	    } else {
		set v ""
	    }
	    lappend vals($n) $v
	    incr n
	}
    }
    set to_list ""
    foreach n [lsort -integer [array names vals]] {
	lappend to_list $vals($n)
    }
    form_sync_listboxes_set [set ${name}(result_list)] $to_list
    
    form_text_set [set ${name}(detail_text)] ""
    set ${name}(result_selected) ""
    
    set cmd [set ${name}(after_search_cmd)]
    if {$cmd != ""} { eval $cmd \"\" }
    
    if {$to_list == ""} {
	user_error "No objects matched your search criteria."
    }
}
