#!/bin/sh
# The next line restarts with tclsh.\
exec tclsh "$0" ${1+"$@"}

package require Tcl 8.5
package require Tk
package require snack

namespace path {::tcl::mathop ::tcl::mathfunc}
proc ::tcl::mathfunc::mid {a b c} {
    min [max $a $b] [max $b $c] [max $c $a]
}

proc adjust {parameter id operation {value 0} {unit ""}} {
    global channel

    switch -- $parameter {
    pitch {
        set fraction $value
        if {$operation eq "scroll"} {
            set value [+ $channel([list $id $parameter]) $value]
        } else {
            set value [int [+ [* $value 96.0] 12]]
        }
        if {$value < 12 || $value > 108 || $operation eq "scroll"} {
            set value [mid 12 $value 108]
            set fraction [/ [- $value 12] 96.0]
        }
        set note [lindex {C C# D D# E F F# G G# A A# B} [% $value 12]]
        set description [format %-2s%d $note [- [/ $value 12] 1]]
    } sample {
        set value [snack::getOpenFile -title "Open Sample"]
        if {$value eq ""} {
            return
        }
        set description [file tail $value]
    } default {
        if {$operation eq "scroll"} {
            set value [+ $channel([list $id $parameter]) [* 0.01 $value]]
        }
        set value [mid 0 $value 1]
        set fraction $value
        set description [int [* $fraction 100]]
    }}

    set channel([list $id $parameter]) $value
    set channel([list $id $parameter entry]) $description

    if {$parameter ne "sample"} {
        .config.frame.$id,$parameter.scale set $fraction $fraction
    }
}

proc create_channel {} {
    global channel config
    set id $channel(count)
    incr channel(count)
    set channel([list $id sound]) [snack::sound]
    set channel([list $id filter]) [snack::filter generator 440]
    set channel([list $id type]) sine
    set channel([list $id amplitude]) 0.8
    set channel([list $id pitch]) 1
    set channel([list $id shape]) 0.5
    set channel([list $id active]) 1

    # Create widgets for solo and mute.
    ttk::radiobutton .enable.frame.$id,solo -style Radiobox\
            -variable channel([list solo]) -value $id
    ttk::checkbutton .enable.frame.$id,active -style Checkbox\
            -variable channel([list $id active])
    grid .enable.frame.$id,solo .enable.frame.$id,active -sticky nsew

    # Create widgets for note entry.
    set widgets [list]
    for {set m 0} {$m < $config(measures)} {incr m} {
        set style Checkbox.[lindex {even odd} [% $m 2]]
        for {set d 0} {$d < $config(divisions)} {incr d} {
            set var channel([list $id notes $d $m])
            set $var 0
            set win .notes.frame.$id,$m,$d
            lappend widgets $win
            ttk::checkbutton $win -style $style -variable $var
        }
    }
    grid {*}$widgets -sticky nsew

    # Create note configuration widgets.
    set widgets [list]

    set win .config.frame.$id,type
    ttk::combobox $win -values {sine triangle rectangle noise sampled}\
            -state readonly -width 8 -textvariable channel([list $id type])
    lappend widgets $win

    set win .config.frame.$id,amplitude
    ttk::frame $win -relief sunken -borderwidth 2 -width 100
    ttk::scrollbar $win.scale -style Scale -orient horizontal\
            -command [list adjust amplitude $id]
    ttk::separator $win.sep -orient vertical
    ttk::entry $win.entry -style Flatentry -width 4 -justify right\
            -textvariable channel([list $id amplitude entry])
    pack propagate $win false
    pack $win.scale -side left -fill both -expand true
    pack $win.sep -side left -fill y
    pack $win.entry -side right -fill both
    $win.scale set 0.8 0.8
    lappend widgets $win
    adjust amplitude $id moveto 0.8

    if {$id % 3 == 0} {
        set win .config.frame.$id,pitch
        ttk::frame $win -relief sunken -borderwidth 2 -width 100
        ttk::scrollbar $win.scale -style Scale -orient horizontal\
                -command [list adjust pitch $id]
        ttk::separator $win.sep -orient vertical
        ttk::entry $win.entry -style Flatentry -width 4 -justify right\
                -textvariable channel([list $id pitch entry])
        pack propagate $win false
        pack $win.scale -side left -fill both -expand true
        pack $win.sep -side left -fill y
        pack $win.entry -side left -fill both
        $win.scale set 1 1
        lappend widgets $win
        adjust pitch $id moveto 0.5

        set win .config.frame.$id,shape
        ttk::frame $win -relief sunken -borderwidth 2 -width 100
        ttk::scrollbar $win.scale -style Scale -orient horizontal\
                -command [list adjust shape $id]
        ttk::entry $win.entry -style Flatentry -width 4 -justify right\
                -textvariable channel([list $id shape entry])
        ttk::separator $win.sep -orient vertical
        pack propagate $win false
        pack $win.scale -side left -fill both -expand true
        pack $win.sep -side left -fill y
        pack $win.entry -side right -fill both
        $win.scale set 0.5 0.5
        lappend widgets $win
        adjust shape $id moveto 0.5
    } elseif {$id % 3 == 1} {
        set win .config.frame.$id,sample
        ttk::frame $win -relief sunken -borderwidth 2
        ttk::button $win.button -style Flatbutton -image snackOpen\
                -command [list adjust sample $id open]
        ttk::separator $win.sep -orient vertical
        ttk::entry $win.entry -style Flatentry -width 15\
                -textvariable channel([list $id sample entry])
        $win.entry state readonly
        pack $win.button -side left -fill y
        pack $win.sep -side left -fill y
        pack $win.entry -side right -fill both -expand true
        lappend widgets $win -
    } else {
        set win .config.frame.$id,empty
        ttk::frame $win -relief sunken -borderwidth 2
        lappend widgets $win -
    }

    grid {*}$widgets -sticky nsew
    grid rowconfigure .enable.frame $id -uniform note
    grid rowconfigure .notes.frame  $id -uniform note
    grid rowconfigure .config.frame $id -uniform note
}

proc main {} {
    global channel config

    set channel(count) 0
    set config(measures) 4
    set config(divisions) 4
    set config(period) 250

    snack::createIcons

    # Define Scale widget style.
    ttk::style layout Horizontal.Scale {
        Horizontal.Scrollbar.trough -sticky nsew -children {
            Horizontal.Scrollbar.thumb -sticky nsew
        }
    }

    # Define Checkbox wiget style.
    foreach subclass {"" .even .odd} {
        ttk::style layout Checkbox$subclass {
            Checkbutton.padding -sticky nsew -children {
                Checkbutton.focus -sticky nsew -children {
                    Checkbutton.indicator -sticky nsew
                }
            }
        }
    }
    ttk::style map Checkbox.even -background {"" #f55 active #faa}
    ttk::style map Checkbox.odd  -background {"" #55f active #aaf}

    # Define Radiobox wiget style.
    ttk::style layout Radiobox {
        Radiobutton.padding -sticky nsew -children {
            Radiobutton.focus -sticky nsew -children {
                Radiobutton.indicator -sticky nsew
            }
        }
    }

    # Define Flatbutton wiget style.
    ttk::style layout Flatbutton {
        Button.padding -sticky nsew -children {
            Button.label -sticky nsew
        }
    }
    ttk::style configure Flatbutton -relief raised -padding 1 -shiftrelief 1
    ttk::style map Flatbutton {*}[ttk::style map TButton]

    # Define Flatentry widget style.
    ttk::style layout Flatentry {
        Entry.padding -sticky nsew -children {
            Entry.textarea -sticky nsew
        }
    }
    ttk::style configure Flatentry {*}[ttk::style configure TEntry]
    ttk::style map Flatentry {*}[ttk::style map TEntry]

    ttk::frame .enable
    ttk::frame .enable.frame
    ttk::frame .ruler
    ttk::frame .ruler.frame
    ttk::frame .notes
    ttk::frame .notes.frame
    ttk::frame .legend
    ttk::frame .config
    ttk::frame .config.frame
    ttk::scrollbar .yscroll -orient vertical
    ttk::scrollbar .xscroll -orient horizontal

    ttk::label .solo -text "Solo/\nEnable" -anchor c

    set widgets [list]
    for {set m 0} {$m < $config(measures)} {incr m} {
        set color [lindex {#f55 #55f} [% $m 2]]
        set win .ruler.frame.measures,$m
        lappend widgets $win
        if {$config(divisions) > 1} {
            lappend widgets {*}[lrepeat [- $config(divisions) 1] -]
        }
        ttk::label $win -background $color -foreground white -text [+ 1 $m]\
                -anchor c
    }
    grid {*}$widgets -sticky nsew
    grid rowconfigure .ruler.frame 0 -weight 1

    set widgets [list]
    for {set m 0; set i 0} {$m < $config(measures)} {incr m} {
        for {set d 0} {$d < $config(divisions)} {incr d; incr i} {
            set color [lindex {#f55 #55f} [% $m 2]]
            set win .ruler.frame.divisions,$m,$d
            lappend widgets $win
            ttk::label $win -background $color -foreground white -text [+ 1 $d]\
                    -anchor c
            grid columnconfigure .ruler.frame $i -uniform note
        }
    }
    grid {*}$widgets -sticky nsew
    grid rowconfigure .ruler.frame 1 -weight 1

    set widgets [list]
    foreach legend {waveform amplitude pitch shape} {
        set win .legend.$legend
        lappend widgets $win
        ttk::label $win -text [string totitle $legend] -anchor c
    }
    grid {*}$widgets -sticky nsew
    grid rowconfigure .legend 0 -weight 1

    foreach win {.legend .config.frame} {
        grid columnconfigure $win 0 -uniform waveform -weight 1
        grid columnconfigure $win 1 -uniform scale -weight 1
        grid columnconfigure $win 2 -uniform scale -weight 1
        grid columnconfigure $win 3 -uniform scale -weight 1
    }

    grid x        .solo    .ruler   .legend -sticky nsew
    grid .yscroll .enable  .notes   .config -sticky nsew
    grid x        x        .xscroll x       -sticky nsew
    grid rowconfigure    . .yscroll -weight 1
    grid columnconfigure . .xscroll -weight 1

    pack .enable.frame -fill both -expand true
    pack .ruler.frame -fill both -expand true
    pack .notes.frame -fill both -expand true
    pack .config.frame -fill both -expand true

    create_channel
    create_channel
    create_channel
    create_channel

    grid columnconfigure .legend 0 -minsize\
            [winfo reqwidth .config.frame.0,type]
    grid columnconfigure .legend 1 -minsize\
            [winfo reqwidth .config.frame.0,amplitude]
    grid columnconfigure .ruler.frame 0 -minsize\
            [winfo reqwidth .notes.frame.0,0,0]
    grid rowconfigure .enable.frame 0 -minsize\
            [winfo reqheight .config.frame.0,type]
    grid rowconfigure .notes.frame 0 -minsize\
            [winfo reqheight .config.frame.0,type]
}

catch {
    source /mingw/msys/local/bin/tkcon.tcl
    bind all <Alt-d> {tkcon show}
}

main

# vim: set ts=4 sts=4 sw=4 tw=80 et ft=tcl: