namespace eval oscUnpack {

#
# This does conversion from OSC binary to TCL values
# It does NOT do UDP and pattern matching...
# http://opensoundcontrol.org/spec-1_0
#
# Written by Dave Joubert and Alexandre Ferrieux
# Alexandre had the brainwave about pre-scanning the binary into 
# 32bit ints and floats and wrote the nitty-gritty decode routines.
# This provided a 10 times boost in performance compared to the
# original code, which was only debug quality.
#
# Requires
#	Tcl 8.x (It deliberately does not require 8.5
#	osctime (To handle bundles properly)
#
# Provides
#	unpackOSCpath $oscBinStr => multi-level list
#	handleEvent $oscBinStr (result is passed on to $callback ...)
#
# OSC Spec conformance:
#	type i (32bit Int)
#	type s String
#	type f (32bit Float) (NOT IEEE 754 conformant. Depends on supplied TCL libary)
#	type d 64 bit ("double") (NOT IEEE 754 conformant. Depends on supplied TCL libary)
#	type b (Binary Blob)
#	types True False Nil Infinity
#
#	type t OSC-timetag 64-bit big-endian fixed-point time tag
#	type h 64 bit big-endian two's complement integer
#	type m 4 byte MIDI message. Bytes from MSB to LSB are: port id, status byte, data1, data2
#
#	type S Alternate type represented as an OSC-string (for example, for systems that differentiate "symbols" from "strings"
#	type c an ASCII character, sent as 32 bits
#	type r 32 bit RGBA color
#
# Missing (optional):
#	type [ Indicates the beginning of an array. The tags following are for data in the Array until a close brace tag is reached.
#	type ] Indicates the end of an array.
# #######################################################################################
#
# The first three flags, wantSymbols wantHexBlob wantPackedMidi are not in the OSC spec,
# but might suit your programming style. The default values set in this library, conform
# to the standard OSC API.
# The use of these flags does not affect the OSC message at a binary level.
#
# Would you like dummy values for True, False, Nil and Infinity ?
# If so, you must fill in the list of what you would like back...
# If you do not ask for dummy values, please note that the count according to the types
# parameter, will NOT match the count of the values. This conforms with the OSC API.
# This makes life irritating if all you want to do is give the values to a 'foreach';
# in that case, set the symbols....
#
	variable wantSymbols {}		; # example alt [list {<T>} {<F>} {<N>} {<I>}]

# Would you like the blob returned as hex ?
# This is useful when you are running in debug mode, and you want to be able to print
# the values...
#
	variable wantHexBlob 0	; # alt 1

# Would you like the MIDI returned unpacked ?
# If you want it unpacked, please remember that there will be a discrepancy
# between the count of the types, and the count of the values
# Unpacked MIDI returns 
#
	variable wantPackedMidi 1	; # alt 0

# After unpacking:
# Once the packet has been unpacked, should we do a callback ?
# This emulates the standard fileevent way of doing things,
# there is just the hidden OSC decode step in between.
#
# So, instead of doing
# fileevent ... readable [list oscMsgEvent ....]
# and then decodeing the packet inside oscMsgEvent via unpackOSCpath
# and then acting on the message..
#
# you can do
# set ::oscUnpack::callback handleOSCmsg
#
# fileevent ... readable [list oscMsgEvent ....]
# and oscMsgEvent just calls handleEvent, which split the packet
# and call handleOSCmsg for you
#
# The callback signature is:
# proc handleOSCmsg {path types [list value1 value2 .....]}
# Note, the callback will only see messages, not bundles.
	variable callback {}	; # alt: you supply the callback proc name

##########################################################################
#
# Main routine to unpack an OSC binary string and return a result
# It returns a multi-level list: (Note, bundles can contain bundles...)
# case 1 {message {path types {values......}}}
# case 2 {bundle {message {path types {values......}}} {message ...} .....}
# case 3 {bundle {message ...} {bundle {message ...} {message ..}} } etc
#
	proc unpackOSCpath buf {
	    variable callback

	    if {$callback != {}} {error "unpackOSCpath should not be used with a callback!!"}
	    binary scan $buf I* l
	    binary scan $buf f* m
	    return [osc_decodeWithResult $l $m $buf]

	}
#
# Main routine to unpack an OSC binary string on behalf of a fileevent.
# It does not return anything, but uses the callback specified above
# in $callback If you forgot to set $callback, nothing happens...
#
	proc handleEvent buf {
	    variable callback

	    if {$callback == {}} {error "handleEvent should be used with a callback!!"}
	    binary scan $buf I* l
	    binary scan $buf f* m
	    osc_decodeWithCallback $l $m $buf

	}
# ###################################################################################
#
# The rest of the code is for internal use
#
# Note, 2 virtually identical routines, duplicated to minimise
# the number of 'if' statements:
# osc_decodeWithResult
# osc_decodeWithCallback
#
# Critical differences:
# osc_decodeWithResult does not have to check the bundle timestamp 
# against 'now', and therefore has no delay
# osc_decodeWithCallback does not have to build a return list
#
	proc osc_decodeWithResult {l m b} {
	    set pos 0
	    set path [osc_string pos $l $b]
	    if {$path=="#bundle"} {
		set len [llength $l]
		set t [osc_wide pos $b $l] ; incr pos 2
		set out [list bundle $t]
		while {$pos<$len} {
		    set n [expr {[lindex $l $pos]/4}]

		    set l2 [lrange $l [expr {$pos+1}] [expr {$pos+$n}]]
		    set m2 [lrange $m [expr {$pos+1}] [expr {$pos+$n}]]
		    set b2 [string range $b [expr {4*($pos+1)}] [expr {4*($pos+$n)}]]
		    lappend out [osc_decodeWithResult $l2 $m2 $b2]
		    set pos [expr {$pos+$n+1}]
		}
	    } else {
		return [internalUnpackOSCpath $b $path $l $m pos]
	    }
	    return $out
	}

	proc osc_decodeWithCallback {l m b} {
	    set pos 0
	    set path [osc_string pos $l $b]
	    if {$path=="#bundle"} {
		set len [llength $l]
		set t [osc_wide pos $b $l] ; incr pos 2
		while {$pos<$len} {
		    set n [expr {[lindex $l $pos]/4}]

		    set l2 [lrange $l [expr {$pos+1}] [expr {$pos+$n}]]
		    set m2 [lrange $m [expr {$pos+1}] [expr {$pos+$n}]]
		    set b2 [string range $b [expr {4*($pos+1)}] [expr {4*($pos+$n)}]]

		    set delay [::osctime::oscTimeToDelay $t 1000] ; # standardise to millisecs
		    if {$delay > 0} {
			after $delay [list ::oscUnpack::osc_decodeWithCallback $l2 $m2 $b2]
		    } else {
			osc_decodeWithCallback $l2 $m2 $b2
		    }
		    set pos [expr {$pos+$n+1}]
		}
	    } else {
		internalUnpackOSCpath $b $path $l $m pos
	    }
	}
#
# Internal routine to unpack an OSC binary string into a message
# It might return a 2-level list: {message path types {values......}}
# OR
# It might pass the values on via a callback
#
	proc internalUnpackOSCpath {b path l m vpos } {
	    upvar $vpos pos
	    variable wantPackedMidi
	    variable wantSymbols
	    variable wantHexBlob
	    variable callback

	    set types [osc_string pos $l $b]
	    if {![regexp {^,(.*)$} $types pipo types]} {
		error "Typestring not starting with comma: $types"
	    }

	    set out [list]
	    set mustSupplySymbols [llength $wantSymbols]

	    foreach t [split $types ""] {
		switch -exact -- $t {
		    i - r {lappend out [lindex $l $pos];incr pos}
		    c {lappend out [binary format "xxxc" [lindex $l $pos]];incr pos}
		    m {
			if {$wantPackedMidi} {
			    lappend out [lindex $l $pos]
			} else {
			    set bpos [expr {$pos << 2}]
			    binary scan [string range $b $bpos [expr {$bpos+3}]] "cccc" portId status data_1 data_2
			    #
			    # Save the user the hassle of remembering that these are bytes, and that -96 is actually 160
			    if {$data_1 < 0} {set data_1 [expr {256+$data_1}]}
			    if {$data_2 < 0} {set data_2 [expr {256+$data_2}]}
			    if {$portId < 0} {set portId [expr {256+$portId}]}
			    if {$status < 0} {set status [expr {256+$status}]}
			    lappend out $portId $status $data_1 $data_2
			}
			incr pos
		    }
		    f {lappend out [lindex $m $pos];incr pos}
		    s - S {lappend out [osc_string pos $l $b]}
		    b {
			if {$wantHexBlob} {
			    lappend out [Hex [osc_blob pos $l $b]]
			} else {
			    lappend out [osc_blob pos $l $b]
			}
		    }
		    h - t {lappend out [osc_wide pos $b $l] ; incr pos 2}
		    d {lappend out [osc_wideFloat pos $b]}
		    T - F - N - I {
			if {$mustSupplySymbols} {
			    switch -exact -- $t {
				T {lappend out [lindex $wantSymbols 0]}
				F {lappend out [lindex $wantSymbols 1]}
				N {lappend out [lindex $wantSymbols 2]}
				I {lappend out [lindex $wantSymbols 3]}
			    }
			}
		    }
		    default {error "Unsupported type tag '$t'"}
		}
	    }
	    if {$callback == {}} {
		return [list {message} $path $types $out]
	    } else {
		$callback $path $types $out
	    }
	}
#
# Support routines to transform bytes to final form.
#
	proc osc_blob {vpos l b} {
	    upvar $vpos pos
	    set len [lindex $l $pos]
	    set out [string range $b [expr {4*($pos+1)}] [expr {4*($pos+1)+$len-1}]]
	    set pos [expr {$pos+1+(($len+3)/4)}]
	    return $out

	}

	proc osc_string {vpos l b} {
	    upvar $vpos pos
	    set n 0
	    while {1} {
		set x [lindex $l [expr {$pos+$n}]]
		if {!($x&0xFF)} break
		incr n
	    }
	    if {$x&0xFF00} {
		set pad 1
	    } elseif {$x&0xFF0000} {
		set pad 2
	    } elseif {$x&0xFF000000} {
		set pad 3
	    } else {
		set pad 4
	    }

	    set out [string range $b [expr {4*$pos}] [expr {4*($pos+$n+1)-1-$pad}]]
	    set pos [expr {$pos+$n+1}]
	    return $out

	}

	#
	# 2 potential ways, binary scan has the same logic as osc_wideFloat,
	# but bit-twiddling is slightly faster....
	#
	proc osc_wide {vpos b l} {
	    upvar $vpos pos
	    # set n [expr {$pos << 2}]
	    # binary scan [string range $b $n [expr {$n+7}]] W out
	    # return $out

	    expr {(wide([lindex $l $pos])<<32)|([lindex $l [expr {$pos+1}]]&0xFFFFFFFF)}

	}

	proc osc_wideFloat {vpos b} {
	    upvar $vpos pos
	    set n [expr {$pos << 2}]
	    binary scan [string range $b $n [expr {$n+7}]] d out

	    incr pos 2
	    return $out

	}

	proc Hex b {
	    binary scan $b H* x
	    return $x

	}
}