namespace eval oscPack {

#
# This does simple conversion from list to an OSC binary string
# It does NOT do UDP
#
# Provides
#	packOSCpath $path $types $argList => binary string
#
#	makeElementFromPath  $path $types $argList => binary string
#	makeBundleFromElements $timestamp $elementArray => binary string
#	(also used to make bundles from bundles)
#
# 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.
##########################################################################
#
# oscPack configuration
#
	variable debug 0

# During packing:
# Have you supplied dummy values for True, False, Nil and Infinity ?
	variable haveGivenSymbols 0	; # alt 1

# During packing:
# Have you given us Hex rather than prepare a binary object in a scripting language ?
	variable haveGivenHexBlob 0	; # alt 1

# During packing:
# Have you already packed the Midi into one word ?
	variable havePackedMidi 1	; # alt 0

##########################################################################
#
# Main routines:
# 1) to generate a bundleElement from a path
# 2) to generate a bundle from a timestamp and an array of bundleElements
# Both return a binary string
#
	proc makeElementFromPath {path types argList} {
	    variable debug
		set oscBundleElementContent [oscPack::packOSCpath $path $types $argList]
		set oscBundleElementSize [binary format I [string length $oscBundleElementContent]]
		set oscBundleElement [append oscBundleElementSize $oscBundleElementContent]
		if {$debug == 1} {
			set test0 $oscBundleElement
			set bytes [string length $test0]
			set nibbles [expr {$bytes * 2}]
			binary scan $test0 H$nibbles hexrep
			puts stdout [format "Bundle, size and content: %d bytes, in hex:\n{%s}" $bytes $hexrep]
		}
		return $oscBundleElement
	}
	proc makeBundleFromElements {timestamp elementArray} {
	    variable debug
		upvar $elementArray elements
		# OK build it out of
		# #bundle
		# one byte 0
		# oscBundleTimestamp
		# oscBundleElementArray

		set oscBundleTimestamp [binary format W $timestamp]
		append retVar "#bundle" \0 $oscBundleTimestamp

		foreach index [array names elements] {
			append retVar $elements($index)
		}
		if {$debug == 1} {
			set bytes [string length $retVar]
			set nibbles [expr {$bytes * 2}]
			binary scan $retVar H$nibbles hexrep
			puts stdout [format "Bundle: %d bytes, in hex:\n{%s}" $bytes $hexrep]
		}
		return $retVar
	}
##########################################################################
#
# Main routine to pack a path, a string of types and a list of values.
# Returns a binary string
#
	proc packOSCpath {path types argList} {

		set msg {}
		set values [add_varargs $types $argList]

		#
		# Pad the OSC Address Pattern to a 32 bit multiple..
		#
		lo_message_add_string msg $path

		#
		# Pad the OSC Type Tag String to a 32 bit multiple..
		#
		lo_message_add_string msg ",$types"


		append msg $values
		return $msg
	}
##########################################################################
#
# Utility routines to pack the arguments
#
# Assume for the moment Linux C compiler (and therefore TCl), conforms
#  big-endian IEEE 754 for 64 bit floats, see http://wiki.tcl.tk/756
#
# Assume for the moment Linux C compiler (and therefore TCl), conforms
# big-endian IEEE 754
#
	proc add_varargs {types argList} {
	    variable havePackedMidi
	    variable haveGivenSymbols
	    variable haveGivenHexBlob
	    variable debug

	    set msg {}
	    set argCount [llength $argList]
	    set toplim [string length $types]
	    set noerr 1
	    set argCounter 0

	    for {set count 0} {$noerr == 1 && $count < $toplim} {incr count} {
		set useValue [lindex $argList $argCounter]
		set type [string index $types $count]
                switch -exact -- $type {
			    i { incr argCounter
				append msg [binary format I [expr {int(floor($useValue))}]]
			    }
			    s - S { incr argCounter
				lo_message_add_string msg $useValue
			    }
			    f { incr argCounter
				append msg [binary format f $useValue]
			    }
			    h - t { incr argCounter
				append msg [binary format W [expr {wide($useValue)}]]
			    }
			    d { incr argCounter
				append msg [binary format d $useValue]
			    }
			    c { incr argCounter ; lo_message_add_char msg $useValue
			    }
			    T - F - N - I { if {$haveGivenSymbols} { incr argCounter}
			    }
			    b {
				# Pack as an int32 size count, followed by that many 8-bit bytes of arbitrary binary data,
				# followed by 0-3 additional zero bytes to make the total number of bits a multiple of 32.
				if {$haveGivenHexBlob} {
					set nibbles [string length $useValue]
					set b [binary format H$nibbles $useValue]
					set bLen [expr {$nibbles/2}]
				} else {
					set b $useValue
					set bLen [string bytelength $b]
				}
				append msg [binary format I [expr {int(floor($bLen))}]]
				incr argCounter
				lo_message_add_blob msg $b $bLen
			    }
			    m {
				if {$havePackedMidi} {
					set m $useValue ; incr argCounter
				} else {
					# pack 4 byte values into one 32bit word
					set portId	$useValue ; incr argCounter ; set useValue [lindex $argList $argCounter]
					set statusByte	$useValue ; incr argCounter ; set useValue [lindex $argList $argCounter]
					set data1	$useValue ; incr argCounter ; set useValue [lindex $argList $argCounter]
					set data2	$useValue ; incr argCounter
					set m [expr {(0xff&$portId)<<24 | (0xff&$statusByte)<<16 | (0xff&$data1)<<8 | (0xff&$data2)}]
				}
				append msg [binary format I $m]
			    }
			    default {
				puts stderr [format "Hmm.. could not match %s" $type]
				set noerr 0
			    }
		}
	    }
	    if {$noerr == 1} {
		return $msg
	    } else {
		return {}
	    }
	}

	proc lo_message_add_char {msg c} {
	    upvar $msg myMsg

	    binary scan $c "c" int32
	    set val [binary format I $int32]
	    append myMsg $val
	}

	proc lo_message_add_string {msg s} {
	    # This is padded 1-4 nulls
	    upvar $msg myMsg

	    set slen [string length $s] ; # bytes
	    set outlen [ expr {4*(1 + int(floor($slen / 4)))}]
	    set val [binary format a$outlen $s]
	    append myMsg $val
	}

	proc lo_message_add_blob {msg b bLen} {
	    # This is padded 0-3 nulls
	    upvar $msg myMsg

	    set outlen [expr {int(4*ceil($bLen/4.0))}]
	    set val [binary format a$outlen $b]
	    append myMsg $val
	}
}