####################################################################
#  
#     A library:  nkovcom/LibsAndTools/n-kov.tcl
#
####################################################################
#   
#   (c) Alexey Noskov (http://a.n-kov.com). 
#   Last updated: 2022/07/22 13:10:36
#
####################################################################
#
# A general purpose tcl library
#
package provide n-kov 1.14
package require fileutil
package require json::write
namespace eval n-kov {

# a checkpoint-based profiler http://wiki.tcl.tk/21331
proc profiler {id} {
        global db_t
        global db_c
        array set db_t {}
        array set db_c {}
        global last
        switch -- $id {
                start {
                        set last [clock microseconds]
                }
                end {
                        set k [array names db_t]
                        puts [format {%-12s %s} {checkpoint:} {avgtime:}]
                        foreach ik $k {
                                puts [format {%-12s %.1f} $ik [expr {1.0*$db_t($ik)/$db_c($ik)}]]
                        }
                        array unset db_t
                        array unset db_c
                }
                default {
                        set delta [expr {[clock microseconds]-$last}]
                        set last [clock microseconds]
                        if {[info exists db_t($id)]} {incr db_t($id) $delta} {set db_t($id) $delta}
                        if {[info exists db_c($id)]} {incr db_c($id) 1     } {set db_c($id) 1     }
                }
        }
 }

    
#eval ${::n-kov::breakpoint} ;#http://wiki.tcl.tk/24690
set breakpoint {set prompt "%dbg%"
    set script {}
    while 1 {
	puts -nonewline $prompt
	flush stdout
	gets stdin line        ;# read...
	if {$line eq ";;"}  {
	    catch [join $script \n] res ;# eval...
	    set script {}
	    puts $res ;# print
	} elseif {$line eq "c"} {
	    break
	} else {
	    lappend script $line
	}
    }
}
    
set errorHeader "ERROR! Message:"



#http://wiki.tcl.tk/367#pagetoca965cf5d
# USAGE: fforeach aLine "./mybigfile.txt" {puts $aLine}
# Recommended to use ::fileutil::foreachLine is possible https://wiki.tcl-lang.org/page/fileutil
proc fforeach {fforeach_line_ref fforeach_file_path fforeach_body} {
    upvar $fforeach_line_ref fforeach_line
        set fforeach_fid [open $fforeach_file_path r]
    fconfigure $fforeach_fid -encoding utf-8
    while {[gets $fforeach_fid fforeach_line] >= 0} {
        # ------- FOREACH BODY ------------<
            uplevel $fforeach_body
        # ------END FOREACH BODY----------->
    }          
        close $fforeach_fid
 }


#http://wiki.tcl.tk/819#pagetoc9326db77
proc average L {
    expr ([join $L +])/[llength $L].
}

proc randomColor {} {
    format #%06x [expr {int(rand() * 0xFFFFFF)}]
}

proc Lpick L {
    lindex $L [expr {int(rand()*[llength $L])}]
}
proc RandomlyPicked {length {chars {A B C D E F G H I G K L M N O P Q R S T U V W X Y Z 0 1 2 3 4 5 6 7 8 9}} } {
    for {set i 0} {$i<$length} {incr i} {append res [Lpick $chars]}
    return $res
}


proc getRandFileName {{ext {}} {prefix {tmp_n-kov_}} {path /tmp}} {
    if {$path eq "/tmp"} {
	set tmpdir [::fileutil::tempdir]
    }
    while {1} {
	set curRand [RandomlyPicked 6]
	set retfn [file join $path $prefix$curRand$ext]	
	if {![file exist $retfn]} {	    
	    return $retfn
	}	
    }    
}
#processes  a=b in Tcl's manner (i.e., evaluates set a b)
proc setEquals {equals} {
    foreach el $equals {
	lassign [split $el =] p v
	uplevel "set $p $v"
    }
}


proc sleep {time} {
      after $time set end 1
      vwait end
  }



#From http://wiki.tcl.tk/16154
#=============================================================================
# PROC    : baseconvert
# PURPOSE : convert number in one base to another base
# AUTHOR  : Richard Booth
# DATE    : Fri Jul 14 10:40:50 EDT 2006
# ---------------------------------------------------------------------------
# ARGUMENTS :
#   % base_from
#       original base (expressed in base 10)
#   % base_to
#       base to convert number to (expressed in base 10)
#   % number
#       number expressed in base_from (must have form int.fra, int, or .fra)
# RESULTS :
#   * returns number expressed in base_to
# EXAMPLE-CALL :
#{
#  set num16 [baseconvert 10 16 3.1415926535]
#}
#=============================================================================
proc baseconvert {base_from base_to number} {
     set number [string tolower $number]
     if {![regexp {([0-9a-z]*)\.?([0-9a-z]*)} $number match sint sfra]} {
         puts "baseconvert error: number \"$number\" is not in correct format"
         return ""
     }
     set map 0123456789abcdefghijklmnopqrstuvwxyz
     set i -1
     foreach c [split $map ""] {
         incr i
         set D2I($c) $i
         set I2D($i) $c
     }
     set lint [string length $sint]
     set lfra [string length $sfra]
     set converted_number 0
     if {$lint > 0} {
         set B {}
         foreach c [split $sint ""] {
             lappend B $D2I($c)
         }
         set aint ""
         while {1} {
             set s 0
             set r 0
             set C {}
             foreach b $B {
                 set v [expr {$b + $r*$base_from}]
                 set b [expr {$v/$base_to}]
                 set r [expr {$v%$base_to}]
                 incr s $b
                 lappend C $b
             }
             set B $C
             set aint "$I2D($r)$aint"
             if {$s == 0} {break}
         }
         set converted_number $aint
     }
     if {$lfra > 0} {
         set s [expr {int(1.0*$lfra*log($base_from)/log($base_to))}]
         set B {}
         foreach c [split $sfra ""] {
             set B [linsert $B 0 $D2I($c)]
         }
         set afra ""
         for {set j 0} {$j < $s} {incr j} {
             set r 0
             set C {}
             foreach b $B {
                 set v [expr {$base_to*$b + $r}]
                 set r [expr {$v/$base_from}]
                 set b [expr {$v%$base_from}]
                 lappend C $b
             }
             set B $C
             set afra "$I2D($r)$afra"
         }
         append converted_number .$afra
     }
     return $converted_number
}



proc base {base number} {
    set negative [regexp ^-(.+) $number -> number] ;# (1)
    set digits {0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N
        O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p
        q r s t u v w x y z}
    set res {}
    while {$number} {
        set digit [expr {$number % $base}]
        set res [lindex $digits $digit]$res
        set number [expr {$number / $base}]
    }
    if $negative {set res -$res}
    set res
}


proc frombase {base number} {
    set digits {0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N
        O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p
        q r s t u v w x y z}
    set negative [regexp ^-(.+) $number -> number]
    set res 0
    foreach digit [split $number ""] {
        set decimalvalue [lsearch $digits $digit]
        if {$decimalvalue<0 || $decimalvalue >= $base} {
            error "bad digit $decimalvalue for base $base"
        }
        set res [expr {$res*$base + $decimalvalue}]
    }
    if $negative {set res -$res}
    set res
}








# The following two procedures generate all possible columns combinations of a 2D matrix (a list containing lists) - two versions (recursive and iterative). 
# outlist contains 1D list containing all possible combinations
# of the element lists with the length of the data list.
# Example:
# % set datalst {{0} {1 2} {3} {4 5 6} {7}}
# % set outlist {}
# #for recursive execution (elegant but never use for large lists, very easy to use):
# % ::n-kov::allVariations2DListRec datalst outlist 0 0 {}
# % set outlist
# { 0 1 3 4 7} { 0 1 3 5 7} { 0 1 3 6 7} { 0 2 3 4 7} { 0 2 3 5 7} { 0 2 3 6 7}
# #for iterative execution (not easy to use, choose for large lists):
# % proc getAbsSum {lst} {set lst [string map {- {}} $lst]; return "[expr [join $lst +]] [list $lst]"}
# This process called like getAbsSum "1 -1 3 -5" returns "10 {1 1 3 5}",
# where 10 is an absolute sum, {1 1 3 5} is the list of abs values.
# % puts "Returns: [allVariations2DListIterExec "{0} {1 -2} {3} {5 -6 -4} {-7}" getAbsSum]"
# <<< Calculating: stage 0 of 2...
# <<< Calculating: stage 1 of 2...
# <<< Calculating: stage 2 of 2...
# Returns: 15 {0 1 3 4 7}




# dvn - input list name (a link to variable);
# ovn - output list name (a link to variable);
# i,j,curl - internal parameters required for recursive.
# Good for small lists (DO NOT use for large lists):
proc allVariations2DListRec {dvn ovn {i 0} {j 0} {curl {}}} {    
    upvar #0 $dvn dl
    upvar #0 $ovn ol
    if {$i<[llength $dl]} {
	set curel [lindex $dl $i]
        allVariations2DListRec $dvn $ovn [expr {$i+1}] 0 "$curl [lindex $curel $j]"
	incr j
	if {$j<[llength $curel]} {
	    allVariations2DListRec $dvn $ovn $i $j $curl
	}
    } else {
	lappend ol $curl
	return	
    }
}
# See a description and usage example before the previous procedure.
# dl - data list;
# prc - evaluating procedure;
# cond - condition (default is less),
# returns best results from prc.
# Good for large lists:
proc allVariations2DListIterExec {dl prc {extra_data {}} {cond <}} {
    set maxlen 0
    foreach row $dl {
	set cur_len [llength $row]
	if {$cur_len>$maxlen} {
	    set maxlen $cur_len
	}
    }
    
    set datalist {}    
    set delta {}  
    
    for {set iGlob 0} {$iGlob<$maxlen} {incr iGlob} {
	#puts stderr "<<< Calculating: stage $iGlob of [expr {$maxlen-1}]..."
	set coreLst {}
	foreach row $dl {
	    if {$iGlob<[llength $row]} {
		lappend coreLst [lindex $row $iGlob]
	    } else {
		lappend coreLst [lindex $row end]
	    }
	}
	lassign [::$prc $coreLst $extra_data] cur_delta cur_datalist
	if {$cur_delta ne {}} {
	    if {$delta eq {}} {
		set delta $cur_delta
		set datalist $cur_datalist
	    } elseif "$cur_delta $cond $delta" {
		set delta $cur_delta
		set datalist $cur_datalist			    
	    }
	}
	for {set i 0} {$i<[llength $dl]} {incr i} {
	    set row [lindex $dl $i]
	    for {set j 0} {$j<[llength $row]} {incr j} {
		set row [lindex $dl $i]
		set rowLen [llength $row]
		if {$j<$rowLen} {		    
		    if {$rowLen != 1 && $iGlob < $j} {
			set cur_coreLst $coreLst
			lset cur_coreLst $i [lindex [lindex $dl $i] $j]
			lassign [::$prc $cur_coreLst $extra_data] cur_delta cur_datalist
			if {$cur_delta ne {}} {
			    if {$delta eq {}} {
				set delta $cur_delta
				set datalist $cur_datalist
			    } elseif "$cur_delta $cond $delta" {
				set delta $cur_delta
				set datalist $cur_datalist			    
			    }
			}
		    }
		}
	    }
	}	
    }
    if {$delta ne {}} {
	return [list $delta $datalist]
    }
}


proc tcl2json value {
    # Guess the type of the value; deep *UNSUPPORTED* magic!
    regexp {^value is a (.*?) with a refcount} \
	[::tcl::unsupported::representation $value] -> type
 
    switch $type {
	string {
	    return [json::write string $value]
	}
	dict {
	    return [json::write object {*}[
		dict map {k v} $value {tcl2json $v}]]
	}
	list {
	    return [json::write array {*}[lmap v $value {tcl2json $v}]]
	}
	int - double {
	    return [expr {$value}]
	}
	booleanString {
	    return [expr {$value ? "true" : "false"}]
	}
	default {
	    # Some other type; do some guessing...
	    if {$value eq "null"} {
		# Tcl has *no* null value at all; empty strings are semantically
		# different and absent variables aren't values. So cheat!
		return $value
	    } elseif {[string is integer -strict $value]} {
		return [expr {$value}]
	    } elseif {[string is double -strict $value]} {
		return [expr {$value}]
	    } elseif {[string is boolean -strict $value]} {
		return [expr {$value ? "true" : "false"}]
	    }
	    return [json::write string $value]
	}
    }
}




# IN-PROGRESS --> START
# # n-kov::parseLargeJSON
# #
# #      parse a large (Geo)JSON file. Suitable for GeoJSON files
# #      (FeatureCollection) or files with an object comprising 
# #      an array of features.
# #
# # Arguments:
# #      fileChannel  - a file openned for reading
# #      curStack     - a string collecting characters of a parsing
# #                     JSON object
# #      previousChunk - a row string from the previous iteration (use {}
# #                     for beginning)
# #      quote        - (optional) either double or single quotes as a
# #                     structural character (it should be predefined
# #                     either manually or by code , e.g., like in the first
# #                     line of Example. Default is double quote
# #      stepCharts   - (optional) number of characters, default is 1000
# #      key/val      - (optional) key and value indicating the beginning
# #                     of a target object 
# #
# #
# #
# #
# #
# # References:
# #      [1] https://tools.ietf.org/html/rfc7159
# #
# #
# # Example:
# # if {0} {    
# #     #quote type definition
# #     set first100Chars [read [set tmpchan [open foo.json]] 100];if {[string map {-1 200} [string first \" $first100Chars]] < [string map {-1 200} [string first \' $first100Chars]]} {set quote \"} else {set quote \'};close $tmpchan
# #     #init
# #     set f [open foo.json]
# #     while {}
# # }


# #
# #

# #set fileNameOrChannel berlin.osm.json;set quote \";set key type;set val Feature;set divider { };set stepCharts 1000000

# proc parseLargeJSON {fileNameOrChannel maincode {initcode {}}  {endcode {}} {quote \"} {key type} {val Feature} {divider { }} {stepCharts 1000000}} {
#     if {[file exists [file normalize $fileNameOrChannel]]} {
# 	set f [open $fileNameOrChannel]	
#     } else {
# 	set f $fileName
#     }
    
#     set fstring ${quote}${key}${quote}:${divider}${quote}${val}${quote}
#     set fstringLength [string length $fstring]
#     set curStack {}
#     set previousChunk {}
#     set curChunk {}
#     eval $initcode

    
#     while {[set curChunk [read $f $stepCharts]] ne {}} {
# 	set curChunk $previousChunk$curChunk
# 	while {[set curpos [string first $fstring $curChunk]]>-1} {
# 	    set curChunk [string range $curChunk [expr {$curpos+$fstringLength}] end]
# 	    set $previousChunk$curChunk
# 	}

	
# 	set curChunk $previousChunk
# 	previousChunk $curChunk	    
# 	#puts "Chunk #[incr i]"
#     }
    
#     set curChunk [read $fileChannel $stepCharts]
#     if {$curStack eq {} && $previousChunk eq {}} {
#     } elseif {$curChunk eq {}} {
# 	unset curStack_$fileChannel previousChunk_$fileChannel
# 	uplevel {eval $endcode}
#     } else {
# 	uplevel {eval $maincode}
#     }
# }
# }
# END <-- IN-PROGRESS


#