Real-time probability-based beat generator

digable.tcl

#!/bin/sh
#
# digable - Real-time probability-based beat generator
#
# Author:       David Benjamin <[email protected]>
# Last updated: Mon Apr 30 20:54:52 MST 2001
#
# The next line restarts using wish \
exec wish "$0" "$@"

# Constants
# ---------

# Socket settings for the "syntmono" server
set SOCKET_HOST localhost
set SOCKET_PORT 2001

# Color scheme for the program
set COLOR_MAIN  #cc33ff
set COLOR_START #cc0099
set COLOR_STOP  #990066
set COLOR_QUIT  #660033

# Global variables
# ----------------

set active  0    ;# Is the beat playing?
set pos     0    ;# Current position in the sequence (starting with 0)
set toggle  0    ;# Toggles between 0 and 1 for each position in the sequence
set doSwing 1    ;# Is the beat swung?
set complex 0.00 ;# Complexity of the beat (-1.00 .. 1.00)
set funk    0.05 ;# Funkiness of the beat (0.00 .. 1.00)
set nudge   0    ;# Nudge amount

# Functions
# ---------

# Reports an error and exits the program
proc tkerror {msg} {
    tk_messageBox -parent . -title Error -type ok -icon error -message $msg
    exit
}

# Opens a socket connection to the "syntmono" server
proc init {} {
    global SOCKET_HOST SOCKET_PORT sockID
 
    # Try to read the default beat
    if [catch {source "beats/default"}] {
        tkerror "Error reading the default beat!"
    }
    
    # Try to connect to the "syntmono" server socket
    if [catch {set sockID [socket $SOCKET_HOST $SOCKET_PORT]}] {
        tkerror "Error connecting to syntmono!"
    }

    # Configure the socket to flush after each line of output
    fconfigure $sockID -buffering line
}

# Event handler for start button
proc start {} {
    global active pos toggle playID

    set pos    0
    set toggle 0

    if {$active} {
        after cancel $playID
    } else {
        set active 1
    }

    play
}

# Event handler for stop button
proc stop {} {
    global active
    set active 0
}

# Event handler for quit button
proc quit {} {
    global sockID
    close $sockID
    exit
}

# Begins playing the beat
proc play {} {
    global active toggle tick nudge swing playID

    set tick2 [expr $tick - $nudge]
    if     {$nudge > 0} { incr nudge -1 } \
    elseif {$nudge < 0} { incr nudge  1 }
    
    if {$active} {
        if {$toggle} {
            set toggle 0
            set playID [after [expr $tick2 - $swing] play]
        } else {
            set toggle 1
            set playID [after [expr $tick2 + $swing] play]
        }
        
        trigger
    }
}

# Updates internal timing based on BPM
proc updateTiming {bpm} {
    global tick doSwing swing nudge
    
    set tick [expr 15000 / $bpm]
    
    if {$doSwing} {
        set swing [expr $tick / 3]
    } else {
        set swing 0
    }
}

# Triggers the sample(s) for this position
proc trigger {} {
    global KICK_PROBS SNARE_PROBS CLHH_PROBS
    global KICK_VOLS  SNARE_VOLS  CLHH_VOLS
    global PATTERN_LEN pos toggle complex funk

    set kickProb  [lindex $KICK_PROBS  $pos]
    set snareProb [lindex $SNARE_PROBS $pos]
    set clhhProb  [lindex $CLHH_PROBS  $pos]
    set kickVol   [lindex $KICK_VOLS   $pos]
    set snareVol  [lindex $SNARE_VOLS  $pos]
    set clhhVol   [lindex $CLHH_VOLS   $pos]
    
    if {$complex < 0.0} {
        if {$kickProb != 1.0} {
            set kickProb [expr $kickProb + $complex]
        }
        if {$snareProb != 1.0} {
            set snareProb [expr $snareProb + $complex]
        }
        set multiplier 1.0
    } else {
        set multiplier [expr 1.0 - $complex]
    }

    set randPre  [expr rand()]
    set randPost [expr $randPre * $multiplier]

    if {$randPre < $funk} {
        set tmp       $kickProb
        set kickProb  $snareProb
        set snareProb $tmp
        set tmp       $kickVol
        set kickVol   $snareVol
        set snareVol  $tmp
    }

    if {$randPost < $kickProb} {
        kick $kickVol
    } elseif {$randPost <= $snareProb} {
        snare $snareVol
    }
    if {$randPost < $clhhProb} {
        clhh $clhhVol
    }

    incr pos
    if {$pos == $PATTERN_LEN} {
        set pos 0
    }
}

# Sample triggers
proc kick  {vol} { global sockID; puts $sockID "NoteOn 0 1 36 $vol" }
proc snare {vol} { global sockID; puts $sockID "NoteOn 0 1 38 $vol" }
proc clhh  {vol} { global sockID; puts $sockID "NoteOn 0 1 42 $vol" }

# Main routine
# ------------

# Hide the main window
wm withdraw .

# Initialize the program
init

# User Interface
# --------------

# Set the main color scheme for the program
tk_setPalette $COLOR_MAIN

# Create the buttons frame
frame .buttons
    button .buttons.start -text "Start" -command start -background $COLOR_START
    button .buttons.stop  -text "Stop"  -command stop  -background $COLOR_STOP
    button .buttons.quit  -text "Quit"  -command quit  -background $COLOR_QUIT

    pack .buttons.start .buttons.stop .buttons.quit \
         -side left -fill x -expand 1
pack .buttons -side top -fill x

# Create the status frame
frame .status
    label .status.tickLabel -text "Tick:"
    label .status.tick -textvariable tick
    label .status.tickMS -text "ms"
    label .status.swingLabel -text "Swing:"
    label .status.swing -textvariable swing
    label .status.swingMS -text "ms"

    pack .status.tickLabel .status.tick .status.tickMS -side left
    pack .status.swingLabel .status.swing .status.swingMS -side left
pack .status -side bottom

# Create the scales frame
frame .scales
    frame .scales.top
        scale .scales.top.complex -label "Complexity:" -from -1 -to 1 \
                                  -resolution 0.01 -orient horizontal \
                                  -variable complex
        scale .scales.top.funk    -label "Funkiness:" -from 0 -to 1 \
                                  -resolution 0.01 -orient horizontal \
                                  -variable funk
        pack .scales.top.complex .scales.top.funk -side left -fill x -expand 1
    pack .scales.top -side top -fill x

    frame .scales.bottom
        scale .scales.bottom.bpm -label "BPM:" -from 60 -to 240 -length 600 \
                                 -orient horizontal -command updateTiming
        .scales.bottom.bpm set $DEFAULT_BPM
        scale .scales.bottom.nudge -label "Nudge:" -from -10 -to 10 \
                                  -orient horizontal -variable nudge
        checkbutton .scales.bottom.swing -text "Swing" -variable doSwing \
                    -command { updateTiming [.scales.bottom.bpm get] }
        pack .scales.bottom.bpm .scales.bottom.nudge .scales.bottom.swing \
             -anchor s -side left -fill x -expand 1
    pack .scales.bottom -side bottom -fill x
pack .scales -side bottom -fill x

# Set up the main window
wm title     . "Digable by Ramenboy <[email protected]>"
wm protocol  . WM_DELETE_WINDOW quit
wm deiconify .