#
# Write out a set of HTML pages summarizing the model

# Set up the internal->external name mappings for some data types
#
foreach {n v} [array get shape_title] {
    set object_param_name_map(current_stype,$n) $v
}
foreach {n v} [array get mat_title] {
    set object_param_name_map(mat_type,$n) $v
}

proc summary_html_write {{fileprefix summary} {objects ""} {subtables 0}
			 {lib_mats 0}} {
    global object_type_title shape_title env

    if {$objects == ""} {
	set objects [db_list_objects_recursive]
    }

    set file1 $fileprefix.html
    set file2 ${fileprefix}_details.html
    set file3 ${fileprefix}_geometry.html
    set fp1 [open [directory]/$file1 w]
    set fp2 [open [directory]/$file2 w]
    set fp3 [open [directory]/$file3 w]

    # Make the detailed table first so we know what links we have
    # detailed     = [2]Geometry, [1]Detailed, [0]Brief 
    # [= which report to do now]
    #
    foreach fp [list $fp3 $fp2 $fp1] detailed {2 1 0} {
	catch {unset found}

	if {[info exists env(TCL_DEBUG)] && $env(TCL_DEBUG) != "" && \
	    $env(TCL_DEBUG) == 2576 && $detailed == 0} {
	    debugger_break           ;# For use with Tcl Dev Kit Debugger.
	}

	foreach obj $objects {
	    set type [$obj getval obtype]

	    if {!$lib_mats && ([$obj getval mat_lib_path ""] != "")} continue
	    if ![$obj si_value active] continue

	    if {$detailed == 2} {
		set shapes [db_shapes $obj]
		if {[llength $shapes] == 1} {
		    set sht [[lindex $shapes 0] get -shtype]
		    set desc [list $object_type_title($type) \
				  [list current_stype $sht] \
				  [list $shape_title($sht)] $type]
		} elseif {$shapes == ""} {
		    continue            ;# Nothing to do here.
		} else {
		    continue
#		    This does not work:
#		    set desc [list $object_type_title($type) \
#				  [list current_stype "(multiple)"] \
#				  "(multiple)" "(multiple)"]
#
#                   Do this instead:
# 		    ... (print out the bounding box for this object)
#		    # --TO-DO-- --cjo
#
#		    set obb [db_bbox_of_object $obj]
#		    set desc ...
		}
	    } elseif {$subtables || $detailed} {
		set desc [list $object_type_title($type) \
		      [db_subtypes $obj 2] [db_subtypes $obj 1] $type]
	    } else {
		set desc [list $object_type_title($type) "" "" $type]
	    }
	    lappend found($desc) $obj
	}

	foreach desc [lsort [array names found]] {
      	    summary_html_one_table $fp [lindex $desc 3] \
      		[lindex $desc 1] [lindex $desc 2] $found($desc) $detailed \
      		$file2 $file3 link_var"
	}
    }
    close $fp1
    close $fp2
    close $fp3

    mess "Wrote $file1\n"
    mess "Wrote $file2\n"
    mess "Wrote $file3\n"
    
    help_url file:[abs_directory]/$file1
}

# obtype   [3] = Base Object type, i.e., "blower".
# subtypes [1] = Subtypes list, i.e., "{current_stype quad}".
# desc     [2] = Subtype, i.e., "type2_single".
# objects      = List of desc's of all Objects of type $obtype.
# detailed     = [2]Geometry, [1]Detailed, [0]Brief [= which report to do now]
# detailed_file= summary_details.html
# geometry_file= summary_geometry.html
# link_var     = name of Array (access via upvar) of #tag URL's for
#                the detailed summary report.
#
proc summary_html_one_table {fp obtype subtypes desc objects detailed
			     detailed_file geom_file link_var} {
    global object_params object_type_title object_param_name_map
    global html_report_shape_params
    
    upvar 1 $link_var links
    array set subtype_vals $subtypes

# lvalue typical value: block-current_stype-hexa-brief-model_object__29
#
    set detailed_material [expr {($detailed == 1) && ($obtype == "material")}]

    if {$detailed == 2} {
#                                           Geometry report.
	set grouplist Geometry
	set headers(Geometry) {{Name name}}
    } elseif $detailed_material {
	set grouplist Object
	set headers(Object) {{Name name}}
    } elseif {$detailed == 1} {
#                                           Detailed report.
	set grouplist ""
    } else {
#                                           Brief report.
	set grouplist Object
	set headers(Object) {{Name name}}
	if {$obtype != "material"} {
	    lappend headers(Object) {Assembly containing_part_name} \
		                    {Shape current_stype}
	}
    }

    if {$detailed == 2} {
#                                           Geometry report.
	if {$subtypes == "(multiple)"} {
	    lappend headers(Geometry) [list Size diff string]
	} else {
	    foreach {title name type} \
		$html_report_shape_params([lindex $subtypes 1]) {
		lappend headers(Geometry) [list $title $name $type]
	    }
	}
    } else {
#                                           Detailed/Brief report.
	foreach this_param $object_params($obtype) {
	    foreach this_varname {
		obp_title obp_varname obp_datatype defval obp_unittype \
		choices obp_group appears_in_brief_or_detailed its_active_when
	    } this_value $this_param { 
		set $this_varname $this_value
	    }
	    if {$obp_title == "\#"} continue

	    if {$appears_in_brief_or_detailed == ""} continue

# Is this the same as checking if {$detailed == 2}?
#
	    if {($appears_in_brief_or_detailed == "detailed") != $detailed} \
		continue
	    
	    # See if this is something we want to see based on the
	    # subtypes
	    if {$its_active_when == "always"} {
		set ok 1
	    } elseif {$its_active_when == ""} {
		set ok 0
	    } else {
		set ok 1
		foreach term $its_active_when {
		    set varname [lindex $term 0]
		    if [info exists subtype_vals($varname)] {
			set var_value $subtype_vals($varname)
			if ![lmember [lrange $term 1 end] $var_value] {
			    set ok 0            ;# Why?
			    break
			}
		    } else {
			lappend activedata($obp_varname) $term
		    }
		}
	    }

	    # If this is already one of the subtype fields then don't use it
	    foreach {subtype_name subtype_value} $subtypes {
		if {$subtype_name == $obp_varname} {
		    set ok 0                           ;# Why?
		}
	    }

	    # Example Groups are: "", Object, Thermal, Material, General,
	    # Sides, Network, External HTC, Heat transfer data, 
	    #
	    if $ok {
		if ![info exists headers($obp_group)] {

		    lappend grouplist $obp_group

		    if {$detailed && !$detailed_material} {
			set headers($obp_group) [list [list Name name string]]
		    }
		}
		lappend headers($obp_group) \
		    [list $obp_title $obp_varname $obp_datatype]
	    }
	}
    }

    if !$detailed {
	lappend grouplist "Additional details"
	lappend "headers(Additional details)" \
	    [list "" call_func app_additional_details]
    }

    catch {unset writenames}
    foreach group $grouplist {
	foreach title $headers($group) {
	    lappend writenames($group) [lindex $title 1] [lindex $title 2]
	}
    }	

# Figure out what goes in all the columns
#
# $objects contains desc lines for all the objects of type $obtype.
#
    catch {unset colok}

    foreach obj $objects {
	set sh [db_shapes $obj 0]

	foreach this_group [array names writenames] {

	    foreach {this_varname this_datatype} $writenames($this_group) {

		set ok 1
		if [info exists activedata($this_varname)] {
		    foreach this_active_term $activedata($this_varname) {
			set active_value \
			    [$obj si_value [lindex $this_active_term 0]]
			if {[llength $this_active_term] > 1} {
			    if ![lmember \
			      [lrange $this_active_term 1 end] $active_value] {
				set ok 0
				break
			    }
			} else {
			    if {$active_value == 0} {
				set ok 0
				break
			    }
			}
		    }
		}

		set link_text ""
		set link_value ""
		if $ok {
		    switch $this_varname {
			containing_part_name {
			    set part [$obj get -model_container]
			    set part_type [$part getval obtype]
			    set link_text [$part getval name]

			    if {$part != ""} {
				if {$detailed == 1} {
				    set full_link [join [concat \
					$part_type $subtypes $table_group $part] -]
				} else {
				    set full_link [join [concat \
					$part_type $subtypes brief $part] -]
				}
				set link_value "\#$full_link"
			    }
			}
			call_func {
			    set func ${this_datatype}_$obtype
			    if {[info command $func] != ""} {
				set link_text [join [$func $obj] "<br>"]
			    }
			}
			default {
			    if [$obj checkval $this_varname] {
				set link_text \
				    [$obj get_value_with_units $this_varname]
			    } elseif {[lindex $this_datatype 0] != "coords"} {
				set link_text \
				    [$sh get_value_with_units $this_varname]
			    } else {
				# This is the {$this_datatype == "coords"} case.
				#
				# If we just pull out the coords value
				# we won't get the units.  So get the
				# components separately.
				#
				set link_text ""
				catch {unset gotu}
				foreach n1 $this_varname {
				    set val1 [$sh get_value_with_units $n1]
				    lappend link_text $val1
				    set gotu([lindex $val1 1]) 1
				}
				set appu ""
				if {[array size gotu] == 1} {
				    set val1 ""
				    foreach v $link_text {
					lappend val1 [lindex $v 0]
				    }
				    set appu " [lindex [lindex $link_text 0] 1]"
				    set link_text $val1
				}
				if {[lindex $this_datatype 1] == "diff"} {
				    set link_text [join $link_text " x "]
				} else {
				    set link_text [join $link_text ", "]
				}
				append link_text $appu
			    }

			    switch [lindex $this_datatype 0] {
				bool {
				    if $link_text {
					set link_text YES
					set ln \
					    links([list $obj $this_group])
					if [info exists $ln] {
					    set link_value ${detailed_file}\#[set $ln]
					}
				    } else {
					set link_text NO
				    }
				}
				mat {
				    if {$link_text == "default"} {
					set nval default_[lindex $this_datatype 1]_material
					global $nval
					set link_text [expression_evaluate [set $nval]]
				    }
				}
				coords {

				}
				default {
				    if {[llength $link_text] == 1} {
					set link_text [lindex $link_text 0]
				    }
				    if {$this_varname == "name"} {
					set name_ln \
					    links([list $obj name])
					if [info exists $name_ln] {
					    set link_value \
					${detailed_file}\#[set $name_ln]
    					}
				    } elseif [info exists object_param_name_map($this_varname,$link_text)] {
					set link_text $object_param_name_map($this_varname,$link_text)
				    } elseif {($this_datatype == "float") && ([llength $link_text] == 2)} {
					if {([scan [lindex $link_text 0] %f fval] == 1) && !$fval} {
					    set link_text ""
					} elseif {[lindex $link_text 0] == "default"} {
					    set link_text default
					}
				    }
				}
			    }
			}
		    }
		} else {
		    set link_text ""
		}
		#puts "$obj $this_varname $link_text"
		set col_link_text($obj,$this_varname) $link_text

		if {$link_value != ""} {
		    set col_link_href($obj,$this_varname) $link_value
		}
		if {($link_text != "") && ($link_text != "NO")} { 
		    set colok($this_varname) 1
		}
	    }
	}
    }

    #puts $detailed
    #parray colok
    #parray headers
    
    # Filter out the unused headers
    foreach group [array names headers] {
	set headers2 ""
	foreach header $headers($group) {
	    if [info exists colok([lindex $header 1])] { 
		lappend headers2 $header 
	    }
	}
	set headers($group) $headers2
    }
    
    # Now write out the data.  For the brief table we write out one
    # big table.  For the detailed table we write one table per group.  
    # Except for materials.
    #
    # detailed = [2]Geometry, [1]Detailed, [0]Brief   [specifies which report]
    #
    if {($detailed == 1) && !$detailed_material} {
	set table_groups ""
	foreach group $grouplist {
	    if {$group == "Object"} continue
	    lappend table_groups [list $group]
	}
    } else {
	set table_groups [list $grouplist]
    }

    foreach table_group $table_groups {
	set totc 0
	foreach group $table_group {
	    incr totc [llength $headers($group)]
	}
	if {($detailed == 1) && !$detailed_material} {
	    set gname " : [lindex $table_group 0]"
	} else {
	    set gname ""
	}
	
	# First figure out if there is anything to be written here at all
	set lines ""
	set nlines 0
	foreach obj $objects {
	    if {$detailed == 1} {
		set anchor_value [join [concat $obtype $subtypes $table_group $obj] -]
	    } else {
		set anchor_value [join [concat $obtype $subtypes brief $obj] -]
	    }
	    set line ""
	    set ok 0
	    append line "<tr>\n"

	    foreach group $table_group {

		foreach {w_varname w_datatype} $writenames($group) {
		    if {$w_varname == "name"} {
			set anchor_string "<a name=$anchor_value>"

			if {$detailed == 1} {
			    set links([list $obj name]) \
				$anchor_value                    ;# New --cjo.
			    set col_link_href($obj,name) \
				${detailed_file}\#$anchor_value  ;# New --cjo.
			}
		    } else {
			set anchor_string ""
		    }

		    if [info exists colok($w_varname)] {
			regsub -all " " $col_link_text($obj,$w_varname) {\&nbsp;} link_nbsp_text
			if {[info exists col_link_href($obj,$w_varname)] &&
			    ($col_link_href($obj,$w_varname) != "")} {
			    set new_line "<td>$anchor_string<a href=$col_link_href($obj,$w_varname)>$link_nbsp_text</a></td>\n"
			} else {
			    set new_line "<td>$anchor_string$link_nbsp_text</td>\n"
			}
			append line $new_line

			if {($w_varname != "name") && ($link_nbsp_text != "")} {
			    set ok 1
			}
		    }
		}
	    }
	    append line "</tr>\n"

	    if $ok {
		append lines $line
		incr nlines
		set links([list $obj $group]) $anchor_value
            } else {
                if {$detailed == 1} {
		    catch {unset links([list $obj name])}      ;# New --cjo.
	        }
            }
	}
        if !$nlines continue  ;# Nothing to see here, move along, move along.

	catch {unset no_line2}
	set ttitle "$object_type_title($obtype) : [join $desc ", "]$gname"
	puts $fp "<table frame=border rules=all border=2 cellpadding=2>"
	puts $fp "<tr><td colspan=$totc><b>$ttitle</b> ($nlines)</td></tr>"

	if {(($detailed != 1) || $detailed_material) && \
             ([llength $table_group] > 1)} {
	    puts $fp "<tr>"
	    foreach group $table_group {
		set nh [llength $headers($group)]
		if $nh {
		    set rs " rowspan=2"
		    foreach h $headers($group) {
			if {[string trim [lindex $h 0]] != ""} {
			    set rs ""; break
			}
		    }
		    puts $fp "<td colspan=$nh$rs><b>$group</b></td>"
		    if {$rs != ""} { set no_line2($group) 1 }
		}
	    }
	    puts $fp "</tr>"
	}
	puts $fp "<tr>"
	foreach group $table_group {
	    if [info exists no_line2($group)] continue
	    foreach title $headers($group) {
		set head1 [summary_html_header_name [lindex $title 0] $group]
		puts $fp "<td><b>$head1</b></td>"
	    }
	}
	puts $fp "</tr>"
	#parray colok
	puts $fp $lines
	puts $fp "</table></br>"
    }
}

proc summary_html_header_name {header group} {
    set strip [list $group]
    if {[string index $group end] == "s"} {
	lappend strip [string range $group 0 end-1]
    }
    foreach str $strip {
	set str [string tolower $str]
	if [string match $str* [string tolower $header]] {
	    set header [string range $header [string length $str] end]
	}
	if [string match *$str [string tolower $header]] {
	    set header [string range $header 0 end-[string length $str]]
	}
    }
    set header [string trim $header]
    set header [string toupper [string index $header 0]][string range $header 1 end]
    return $header
}

# -----------------------------------------------------------------------------
#
# For checking for malformed object_params() entries.
#
# Some typical entries:
#
#    { "Heat exchange type"               # Title
#      heat_type string "tempchange"      # varname, datatype, default_value
#      {} {tempchange input conductance}  # unittype, enum-value_list
#      "Heat transfer data" {} {}         # Group header name for reports,
#    }                                    # which_reports_to_appear_in, active
#
proc summary_html_check_object_params_entries {obtype detailed} {
    global object_params

#    if {$detailed < 1} { error "We don't need to go further." }

    foreach this_param $object_params($obtype) {
	foreach this_varname {
	    obp_title obp_varname obp_datatype defval obp_unittype choices \
	    obp_group appears_in_brief_or_detailed its_active_when
	} this_value $this_param { 
		set $this_varname $this_value
	}
	puts "\nType:     $obtype<"
	puts "Title:    $obp_title<"
	puts "Varname:  $obp_varname<"
	puts "Datatype: $obp_datatype<"
	puts "Default:  $defval<"
	puts "Unittype: $obp_unittype<"
	puts "Choices:  $choices<"
	puts "Group:    $obp_group<"
	puts "Report:   $appears_in_brief_or_detailed<"
	puts "Active:   $its_active_when<"
    }
}

# -----------------------------------------------------------------------------
#
# These two are used to go from and to a CSV format for the parameters in a
# semi-automatic way
#
proc summary_html_dump_obparams {} {
    global object_params
    set fp [open object_params.csv w]
    puts $fp "Object type;Parameter;Internal name;Category;Which table;In additional details"
    foreach obtype [lsort [array names object_params]] {
	foreach p $object_params($obtype) {
	    foreach n {
		title name type defval units choices group appears_in_brief_or_detailed its_active_when
	    } v $p { set $n $v }
	    if {$title == "\#"} continue
	    puts $fp "$obtype;$title;$name;$group;$appears_in_brief_or_detailed;"
	}
    }
    close $fp
}

# This is so that somebody can update the object parameters titles, etc -
# not normally used
#
proc summary_html_update_obparams {} {
    source ../../tmp/explicit_obparams.tcl

    set fp [open ../../tmp/object_params_modified.csv r]
    gets $fp
    while {![eof $fp]} {
	foreach n {obtype title name group appears_in_brief_or_detailed} v [split [gets $fp] ,] {
	    set $n $v
	}
	set new_title($obtype,$name) $title
	set new_group($obtype,$name) $group
	set new_appears_in_brief_or_detailed($obtype,$name) $appears_in_brief_or_detailed
    }
    close $fp

    set nch 0

    set fp [open ../../tmp/new_obparams.tcl w]
    foreach obtype [array names object_params] {
	puts $fp "\nset object_params($obtype) {"
	foreach p $object_params($obtype) {
	    foreach n {
		title name type defval units choices group appears_in_brief_or_detailed its_active_when
	    } v $p {
		set $n $v
	    }
	    if {$title == "\#"} {
		puts $fp "    {$p}"
		continue
	    }
	    if [info exists new_title($obtype,$name)] {
		set title $new_title($obtype,$name)
		unset new_title($obtype,$name)
		incr nch
	    }
	    if [info exists new_group($obtype,$name)] {
		set group $new_group($obtype,$name)
		unset new_group($obtype,$name)
		incr nch
	    }
	    if [info exists new_appears_in_brief_or_detailed($obtype,$name)] {
		set appears_in_brief_or_detailed $new_appears_in_brief_or_detailed($obtype,$name)
		unset new_appears_in_brief_or_detailed($obtype,$name)
		incr nch
	    }
	    foreach n {
		title name units
	    } {
		set v [set $n]
		if {[string trim $v] == ""} { set v \{\} }
		set $n $v
	    }
	    puts $fp "    { \"$title\""
	    puts $fp "      $name \"$type\" \"$defval\""
	    puts $fp "      $units \{$choices\}"
	    puts $fp "      \"$group\" \{$appears_in_brief_or_detailed\} \{$its_active_when\}"
	    puts $fp "    }"
	}
	puts $fp "}"
    }
    close $fp
    puts "nch $nch"
    
    unset object_params
    global object_params
    
    set nch 0
    foreach obtype [array names object_params] {
	foreach p $object_params($obtype) {
	    foreach n {
		title name type defval units choices group appears_in_brief_or_detailed its_active_when
	    } v $p {
		set $n $v
	    }
	    if [info exists new_title($obtype,$name)] {
		if {$title != $new_title($obtype,$name)} {
		    puts "$obtype $name TITLE : $title -> $new_title($obtype,$name)"
		    incr nch
		}
	    }
	    if [info exists new_group($obtype,$name)] {
		if {$group != $new_group($obtype,$name)} {
		    puts "$obtype $name GROUP : $group -> $new_group($obtype,$name)"
		    incr nch
		}
	    }
	    if [info exists new_appears_in_brief_or_detailed($obtype,$name)] {
		if {$appears_in_brief_or_detailed != $new_appears_in_brief_or_detailed($obtype,$name)} {
		    puts "$obtype $name SUMM1 : $appears_in_brief_or_detailed -> $new_appears_in_brief_or_detailed($obtype,$name)"
		    incr nch
		}
	    }
	}
    }
    puts "nch2 $nch"
}
