Artifact Content
Not logged in

Artifact a0c8b3fc73a1e8cfb721a39d56cd702468f52c58:


# Bluetooth LE Demo: Tabü Lümen TL800
# May/June 2015 <chw@ch-werner.de>
# inspired by https://github.com/sandeepmistry/node-lumen

package require Borg
package require Ble

proc ble_handler {event data} {
    dict with data {
	switch -- $event {
	    scan {
		if {[string match "iSmartLight*" $name]} {
		    # found the bulb, close scanner, then connect
		    ble close $handle
		    set ::lumen(scanning) 0
		    # no autoreconnect in order to connect immediately
		    ble connect $address ble_handler 0
		}
	    }
	    connection {
		if {$state eq "disconnected"} {
		    # fall back to scanning
		    ble close $handle
		    ble start [ble scanner ble_handler]
		    set ::lumen(found) 0
		    set ::lumen(scanning) 1
		} elseif {$state eq "connected"} {
		    set ::lumen(scanning) 0
		    if {!$::lumen(found)} {
			set d [ble userdata $handle]
			ble begin $handle
			dict with d {
			    {*}$svc1write $v1
			    {*}$svc1write $v2
			}
			after 50 [subst {catch {ble execute $handle}}]
		    }
		}
	    }
	    characteristic {
		if {[string match "*FFF1-*" $cuuid] && $access eq "r"} {
		    set d [ble userdata $handle]
		    dict set d svc1data $value
		    ble userdata $handle $d
		}
	    }
	    descriptor {
		if {[string match "*FFF1-*" $cuuid]} {
		    # connection setup magic
		    set d [ble userdata $handle]
		    set v1 [binary format H* \
				"08610766a7680f5a183e5e7a3e3cbeaa8a214b6b"]
		    set v2 [binary format H* \
				"07dfd99bfddd545a183e5e7a3e3cbeaa8a214b6b"]
		    set svc1read [list ble read $handle $suuid $sinstance \
				      $cuuid $cinstance]
		    set svc1write [list ble write $handle $suuid $sinstance \
				       $cuuid $cinstance]
		    dict set d svc1read $svc1read
		    dict set d svc1write $svc1write
		    dict set d v1 $v1
		    dict set d v2 $v2
		    ble userdata $handle $d
		}
	    }
	    transaction {
		set ::lumen(found) 1
		set d [ble userdata $handle]
		dict with d {
		    {*}$svc1read
		}
	    }
	}
	# write log message
	set msg "$event: "
	if {[info exists value]} {
	    # make hex string from byte array
	    binary scan $value H* value
	    dict set data value $value
	}
	append msg $data
	borg log verbose BLELumen $data
    }
}

proc lumen {cmd args} {
    switch -- $cmd {
	scan {
	    ble close all
	    ble start [ble scanner ble_handler]
	    set ::lumen(found) 0
	    set ::lumen(scanning) 1
	    return
	}
	disconnect {
	    ble close all
	    set ::lumen(found) 0
	    set ::lumen(scanning) 0
	    return
	}
	default {
	    if {$cmd ne "cmyk"} {
		sdltk accelerometer off
	    }
	}
    }
    set ble [ble info]
    if {[llength $ble]} {
	set d [ble userdata [lindex $ble 0]]
	if {![dict exists $d svc1data]} {
	    return
	}
	set v {}
	binary scan [dict get $d svc1data] H* v
	switch -- $cmd {
	    off {
		set v [string replace $v 0 1 "00"]
	    }
	    on {
		set v [string replace $v 0 9 "01dfd99bb5"]
		set v [string replace $v 12 13 "54"]
	    }
	    cool {
		set v [string replace $v 0 1 "01"]
		set v [string replace $v 12 13 "50"]
	    }
	    warm {
		set v [string replace $v 0 1 "01"]
		set v [string replace $v 12 13 "51"]
	    }
	    disco1 {
		set v [string replace $v 0 1 "01"]
		set v [string replace $v 12 13 "52"]
	    }
	    disco2 {
		set v [string replace $v 0 1 "01"]
		set v [string replace $v 12 13 "53"]
	    }
	    normal {
		set v [string replace $v 0 1 "01"]
		set v [string replace $v 12 13 "54"]
	    }
	    cmyk {
		if {[catch {
		    set c [lindex $args 0]
		    set m [lindex $args 1]
		    set y [lindex $args 2]
		    set k [lindex $args 3]
		    if {$c < 0.0} {set c 0.0}
		    if {$c > 1.0} {set c 1.0}
		    if {$m < 0.0} {set m 0.0}
		    if {$m > 1.0} {set m 1.0}
		    if {$y < 0.0} {set y 0.0}
		    if {$y > 1.0} {set y 1.0}
		    if {$k < 0.0} {set k 0.0}
		    if {$k > 1.0} {set k 1.0}
		    set c [expr {round($c * 105.0) + 120}]
		    set m [expr {round($m * 105.0) + 120}]
		    set y [expr {round($y * 105.0) + 120}]
		    set k [expr {round((1.0 - $k) * 15.0) + 240}]
		    set c [format "%02x" $c]
		    set m [format "%02x" $m]
		    set y [format "%02x" $y]
		    set k [format "%02x" $k]
		    set v [string replace $v 0 9 "01${c}${m}${y}${k}"]
		    set v [string replace $v 12 13 "54"]
		}]} {
		    return
		}
	    }
	    white {
		if {[catch {
		    set w [lindex $args 0]
		    if {$w >= 1.0} {
			set v34 9a58
		    } elseif {$w >= 0.9} {
			set v34 9ba3
		    } elseif {$w >= 0.7} {
			set v34 9bb5
		    } elseif {$w >= 0.5} {
			set v34 9b87
		    } elseif {$w >= 0.3} {
			set v34 9b99
		    } else {
			set v34 9bf2
		    }
		    set v [string replace $v 0 9 "01dfd9${v34}"]
		    set v [string replace $v 12 13 "54"]
		}]} {
		    return
		}
	    }
	    default {
		return
	    }
	}
	if {[dict exists $d svc1write]} {
	    {*}[dict get $d svc1write] [binary format H* $v]
	}
    }
}

wm attributes . -fullscreen 1
borg screenorientation portrait
bind all <Key-Break> exit

font configure TkDefaultFont -size 16

proc lumen_found {args} {
    set found 0
    if {[info exists ::lumen(found)]} {
	set found $::lumen(found)
    }
    set scanning 0
    if {[info exists ::lumen(scanning)]} {
	set scanning $::lumen(scanning)
    }
    if {$found} {
	. configure -background #448844
	if {!$scanning} {
	    .scan configure -text "Disconnect" -command {lumen disconnect}
	} else {
	    .scan configure -text "Scan" -command {lumen scan}
	}
    } else {
	. configure -background #884444
	if {$scanning} {
	    .scan configure -text "Disconnect" -command {lumen disconnect}
	} else {
	    .scan configure -text "Scan" -command {lumen scan}
	}
    }
}

ttk::button .scan -text Scan -command {lumen scan}
ttk::button .off -text Off -command {lumen off}
ttk::button .on -text On -command {lumen on}
ttk::button .cool -text Cool -command {lumen cool}
ttk::button .warm -text Warm -command {lumen warm}
ttk::button .disco1 -text "Disco 1" -command {lumen disco1}
ttk::button .disco2 -text "Disco 2" -command {lumen disco2}

pack .scan .off .on .cool .warm .disco1 .disco2 \
    -padx 30 -pady 15 -side top -fill x

proc lumen_cmyk_do {} {
    sdltk accelerometer on
    lumen cmyk $::lumen(c) $::lumen(m) $::lumen(y) $::lumen(k)
}

proc lumen_cmyk {args} {
    after cancel lumen_white_do
    after cancel lumen_cmyk_do
    after idle lumen_cmyk_do
}

foreach name {c m y k} {
    frame .s$name
    label .s$name.l -text [string toupper "$name"] -width 3
    scale .s$name.s -from 0.0 -to 1.0 -resolution 0.1 -width 30 \
	-tickinterval 0 -showvalue 0 -label "" -orient hor \
	-sliderlength 60 -variable lumen($name) -command lumen_cmyk
    pack .s$name.l -side left
    pack .s$name.s -side left -fill x -expand 1 -padx 30
    pack .s$name -padx 30 -pady 15 -side top -fill x
}

proc lumen_white_do {args} {
    sdltk accelerometer off
    lumen white $::lumen(w)
}

proc lumen_white {args} {
    after cancel lumen_white_do
    after cancel lumen_cmyk_do
    after idle lumen_white_do
}

frame .sw
label .sw.l -text "W" -width 3
scale .sw.s -from 0.0 -to 1.0 -resolution 0.1 -width 30 \
    -tickinterval 0 -showvalue 0 -label "" -orient hor \
    -sliderlength 60 -variable lumen(w) -command lumen_white
pack .sw.l -side left
pack .sw.s -side left -fill x -expand 1 -padx 30
pack .sw -padx 30 -pady 15 -side top -fill x

proc lumen_accel {axis value} {
    if {$axis == 1} {
	set n c
    } elseif {$axis == 2} {
	set n m
    } elseif {$axis == 3} {
	set n y
    }
    if {($value / 256) > 40} {
	set dir 0.1
    } elseif {($value / 256) < -40} {
	set dir -0.1
    } else {
	return
    }
    set value [expr {$::lumen($n) + $dir}]
    if {($value < 0.0) || ($value > 1.0)} {
	return
    }
    set ::lumen($n) $value
    lumen_cmyk
}

bind . <<Accelerometer>> {lumen_accel %s %x}

trace add variable ::lumen(found) write lumen_found
trace add variable ::lumen(scanning) write lumen_found

lumen scan