#============================================================
#          COMMON ROUTINES
#
#  Manuel Collado, http://mcollado.z15.es
#  March, 2020 - Public domain
#
#============================================================
package require Tk

# -----------------------------------------------------------
#      Shuffle a list 
# -----------------------------------------------------------
proc shuffle {lst} {
    upvar $lst x
    set len [llength $x]
    for {set k 0} {$k < $len} {incr k} {
        set nextpos [expr {int($k + rand()*($len-$k))}]
        set temp [lindex $x $nextpos]
        set x [lreplace $x $nextpos $nextpos [lindex $x $k]]
        set x [lreplace $x $k $k $temp]
    }
}

# -----------------------------------------------------------
#      Capitalize, remove accents and non-significant space 
# -----------------------------------------------------------
proc normalize_text {text} {
    set text [string toupper $text]
    regsub -all {[ÁÀÄÂ]} $text "A" text
    regsub -all {[ÉÈËÊ]} $text "E" text
    regsub -all {[ÍÌÏÎ]} $text "I" text
    regsub -all {[ÓÒÖÔ]} $text "O" text
    regsub -all {[ÚÙÜÛ]} $text "U" text
    regsub -all {[[:cntrl:][:blank:]]+} $text " " text
    regsub {^[ ]} $text "" text
    regsub {[ ]$} $text "" text
    return $text
}

# -----------------------------------------------------------
#      Choose an input text file 
# -----------------------------------------------------------
proc new_file {old_file} {
    set dir [file dirname $old_file]
    set name [file tail $old_file]
    set texttype {
        {{Text files} {.txt}}
    }
    return [tk_getOpenFile -filetypes $texttype -initialdir $dir -initialfile $name]
}

# -----------------------------------------------------------
#      Read a text fragment
# -----------------------------------------------------------
proc read_fragment {txtfile min max} {
    file stat $txtfile state
    set text ""
    set infile [open $txtfile]
    set offset [expr int(($state(size)-$max)*rand())]
    if {$offset > 0} {
        seek $infile $offset
        gets $infile
    }
    while {[string length $text] < $min && ![eof $infile]} {
        set text [normalize_text [append text " " [gets $infile]]]
    }
    close $infile
    while {[string length $text] > $max} {
        regsub {[ ]*[[:alnum:]]+[^[:alnum:]]*$} $text "" text
    }
    while {[string length $text] < $min} {
        append text " "
    }
    return $text
}

# -----------------------------------------------------------
#      Center a dialogo on the main window
# -----------------------------------------------------------
proc center_window {top} {
    tkwait visibility $top     ;# wait for the window to appear on screen
    set father .
    set child $top
    # size of the main window
    set w [winfo width $father]
    set h [winfo height $father]
    # location of the main window
    set x [winfo rootx $father]
    set y [winfo rooty $father]
    # location to center the dialog
    set xpos "+[ expr {$x+($w-[winfo width $child])/2}]"
    set ypos "+[ expr {$y+($h-[winfo height $child])/2}]"
    wm geometry $child "$xpos$ypos"
}

# -----------------------------------------------------------
#      Let a dialog to be modal
# -----------------------------------------------------------
proc make_modal {top delete_command} {
    if {$delete_command==""} {set delete_command "destroy $top}
    grab $top
    wm transient $top .
    wm protocol $top WM_DELETE_WINDOW "grab release $top; $delete_command"
    raise $top
    tkwait window $top 
}