diff --git a/docs/setup.md b/docs/setup.md new file mode 100644 index 00000000..16aa7362 --- /dev/null +++ b/docs/setup.md @@ -0,0 +1,22 @@ +# Setup notes + +## Useful for configuring the webcam + +``` +# List devices and their controls +v4l2-ctl --list-devices +v4l2-ctl --list-ctrls-menus + +# Manual focus +v4l2-ctl -d /dev/video0 --set-ctrl=focus_auto=0 # default=1 +v4l2-ctl -d /dev/video0 --set-ctrl=focus_absolute=0 + +# Manual light exposure controls +v4l2-ctl -d /dev/video0 --set-ctrl=exposure_auto=1 # default=3 (Aperture Priority Mode) +v4l2-ctl -d /dev/video0 --set-ctrl=exposure_absolute=166 # min=12 max=664 default=166 + +# Brightness and other useful controls +v4l2-ctl -d /dev/video0 --set-ctrl=sharpness=170 # default=128 +v4l2-ctl -d /dev/video0 --set-ctrl=brightness=150 # default=128 +v4l2-ctl -d /dev/video0 --set-ctrl=backlight_compensation=1 # default=0 +``` diff --git a/lib/c.tcl b/lib/c.tcl index b09c5bb9..09b4dbb8 100644 --- a/lib/c.tcl +++ b/lib/c.tcl @@ -70,6 +70,7 @@ namespace eval c { char { expr {{ char $argname = Tcl_GetString($obj)[0]; }}} size_t { expr {{ size_t $argname; Tcl_GetLongFromObj(interp, $obj, (long *)&$argname); }}} intptr_t { expr {{ intptr_t $argname; Tcl_GetLongFromObj(interp, $obj, (long *)&$argname); }}} + uint8_t { expr {{ uint8_t $argname; sscanf(Tcl_GetString($obj), "%"PRIu8, &$argname); }}} uint16_t { expr {{ uint16_t $argname; Tcl_GetIntFromObj(interp, $obj, (int *)&$argname); }}} uint32_t { expr {{ uint32_t $argname; sscanf(Tcl_GetString($obj), "%"PRIu32, &$argname); }}} uint64_t { expr {{ uint64_t $argname; sscanf(Tcl_GetString($obj), "%"PRIu64, &$argname); }}} diff --git a/test/cstructs.tcl b/test/cstructs.tcl index 17f0fb41..a9a7fdf2 100644 --- a/test/cstructs.tcl +++ b/test/cstructs.tcl @@ -21,7 +21,33 @@ $cc proc omar {} Person { }; return ret; } + $cc compile puts [omar] assert {[dict get [omar] name last] eq "Rizwan"} + + +set c2 [c create] + +$c2 struct image_t { + uint32_t width; + uint32_t height; + int components; + uint32_t bytesPerRow; + uint8_t* data; +} + +$c2 proc imageThereAndBack {image_t im} image_t { + return im; +} + +$c2 compile + +set im [ dict create width 1 \ + height 1 \ + components 1 \ + bytesPerRow 1 \ + data 0x0] + +[imageThereAndBack im] diff --git a/user-programs/cristobal/local-slice.folk b/user-programs/cristobal/local-slice.folk new file mode 100644 index 00000000..7895e571 --- /dev/null +++ b/user-programs/cristobal/local-slice.folk @@ -0,0 +1,14 @@ +# +# +# Local-slice +# -------------------------------------------- +# Render slice on the table +# +# + +Wish $this is outlined white + +When $this has camera slice /slice/ { + Wish $this displays camera slice $slice +} + diff --git a/user-programs/cristobal/web-slice.folk b/user-programs/cristobal/web-slice.folk new file mode 100644 index 00000000..e49713d1 --- /dev/null +++ b/user-programs/cristobal/web-slice.folk @@ -0,0 +1,140 @@ +# +# +# Web-slice +# -------------------------------------------- +# Serves slice at host:4273/web-slice/$x-$y +# +# + +Wish $this is outlined white + +set cc [c create] +$cc cflags -L[lindex [exec /usr/sbin/ldconfig -p | grep libjpeg] end] + +# TODO: get C-structs to work +# $cc struct image_t { +# uint32_t width; +# uint32_t height; +# int components; +# uint32_t bytesPerRow; +# uint8_t* data; +# } + +$cc code { + typedef struct { + uint32_t width; + uint32_t height; + int components; + uint32_t bytesPerRow; + uint8_t *data; + } image_t; +} + +$cc argtype image_t { + image_t $argname; + sscanf( + Tcl_GetString($obj), + "width %u height %u components %d bytesPerRow %u data 0x%p", + &$argname.width, &$argname.height, &$argname.components, &$argname.bytesPerRow, &$argname.data + ); +} + +$cc rtype image_t { + $robj = Tcl_ObjPrintf( + "width %u height %u components %d bytesPerRow %u data 0x%" PRIxPTR, + $rvalue.width, $rvalue.height, $rvalue.components, $rvalue.bytesPerRow, (uintptr_t) $rvalue.data + ); +} + +$cc include +$cc include +$cc include +$cc include +$cc include + +$cc code { + + void + write_jpeg(FILE* dest, uint8_t* grey, uint32_t width, uint32_t height, uint32_t bytes_per_row) + { + JSAMPARRAY image; + image = calloc(height, sizeof (JSAMPROW)); + for (size_t i = 0; i < height; i++) { + image[i] = calloc(width * 3, sizeof (JSAMPLE)); + for (size_t j = 0; j < width; j++) { + image[i][j * 3 + 0] = grey[i * bytes_per_row + j]; + image[i][j * 3 + 1] = grey[i * bytes_per_row + j]; + image[i][j * 3 + 2] = grey[i * bytes_per_row + j]; + } + } + + struct jpeg_compress_struct compress; + struct jpeg_error_mgr error; + compress.err = jpeg_std_error(&error); + jpeg_create_compress(&compress); + jpeg_stdio_dest(&compress, dest); + + compress.image_width = width; + compress.image_height = height; + compress.input_components = 3; + compress.in_color_space = JCS_RGB; + + jpeg_set_defaults(&compress); + jpeg_set_quality(&compress, 100, TRUE); + jpeg_start_compress(&compress, TRUE); + jpeg_write_scanlines(&compress, image, height); + jpeg_finish_compress(&compress); + jpeg_destroy_compress(&compress); + + for (size_t i = 0; i < height; i++) { + free(image[i]); + } + free(image); + } +} + + +$cc proc writeJPEG {image_t im char* filename} void { + FILE* out = fopen(filename, "w"); + write_jpeg(out, im.data, im.width, im.height, im.bytesPerRow); + fclose(out); +} + +c loadlib [lindex [exec /usr/sbin/ldconfig -p | grep libjpeg] end] +$cc compile + +When $this has camera slice /im/ & $this has region /r/ { + + # Serve slice at its coordinates + lassign [lindex $r 0 0] ox oy + set x [expr {round(floor($ox / 10) * 10)}] + set y [expr {round(floor($oy / 10) * 10)}] + + set path "/web-slice/$x-$y$" + Wish $this is labelled $path + + # TODO: I don't like this [list apply] with parameter capture. + # Understand why this is needed, and then make it better. + Wish the web server handles route $path with handler [list apply {{im x y} { + + set filename "/tmp/web-slice-$x-$y.jpg" + writeJPEG $im $filename + set fsize [file size $filename] + set fd [open $filename r] + + fconfigure $fd -encoding binary -translation binary + set body [read $fd $fsize] + close $fd + + set headers [join [list \ + "HTTP/1.1 200 OK" \ + "Connection: close" \ + "Content-Type: image/jpeg" \ + "Content-Length: $fsize" \ + ] "\n"] + + dict create statusAndHeaders "$headers\n\n" body $body + + }} $im $x $y] +} + diff --git a/user-programs/cristobal/web-slices.folk b/user-programs/cristobal/web-slices.folk new file mode 100644 index 00000000..c636e305 --- /dev/null +++ b/user-programs/cristobal/web-slices.folk @@ -0,0 +1,29 @@ +# +# +# Web-slice server +# -------------------------------------------- +# Serves slice at host:4273/web-slice/$x-$y +# +# + + +When the collected matches for [list /someone/ wishes the web server handles route /route/ with handler /handler/] are /matches/ { + Wish $this is outlined white + + # Get /web-slice/* routes + set routes {} + foreach match $matches { + set route [dict get $match route] + if {[string match "/web-slice/*" $route]} { + lappend routes $route + } + } + + Wish $this is labelled [join $routes "\n"] + Wish $this is labelled "web-slices found: [llength $routes]" + + # Expose them on an index page + # Wish the web server handles route /web-slices$ with handler { + # html $routes + # } +} diff --git a/user-programs/haippi7/laser-region-manager.folk b/user-programs/haippi7/laser-region-manager.folk index cfca7d46..4e385fa0 100644 --- a/user-programs/haippi7/laser-region-manager.folk +++ b/user-programs/haippi7/laser-region-manager.folk @@ -150,4 +150,4 @@ ws.onmessage = (msg) => { }] } [Evaluator::serializeEnvironment]] -} \ No newline at end of file +} diff --git a/virtual-programs/intersect.folk b/virtual-programs/intersect.folk index 351a293c..3a3c70f5 100644 --- a/virtual-programs/intersect.folk +++ b/virtual-programs/intersect.folk @@ -27,4 +27,4 @@ When /someone/ wishes /p/ has neighbors & /p/ has region /r/ & /p2/ has region / #Display::stroke [list [list $b2MaxX $b2MaxY] {500 500}] 3 white #Display::stroke [list [list $b2MinX $b2MinY] [list $b2MaxX $b2MaxY]] 10 blue } -} \ No newline at end of file +} diff --git a/virtual-programs/web-editor.folk b/virtual-programs/web-editor.folk index 5b68746d..cc474f84 100644 --- a/virtual-programs/web-editor.folk +++ b/virtual-programs/web-editor.folk @@ -96,4 +96,4 @@ function handlePrint() { }] } -} \ No newline at end of file +} diff --git a/virtual-programs/web-slice.folk b/virtual-programs/web-slice.folk new file mode 100644 index 00000000..15e4ce00 --- /dev/null +++ b/virtual-programs/web-slice.folk @@ -0,0 +1,120 @@ +Wish $this is outlined blue + +# see webcam image on: http://folk0.local:4273/frame-image/ +set cc [c create] +$cc cflags -L[lindex [exec /usr/sbin/ldconfig -p | grep libjpeg] end] + +# $cc struct image_t { +# uint32_t width; +# uint32_t height; +# int components; +# uint32_t bytesPerRow; +# uint8_t* data; +# } + +$cc code { + typedef struct { + uint32_t width; + uint32_t height; + int components; + uint32_t bytesPerRow; + uint8_t *data; + } image_t; +} + +$cc argtype image_t { + image_t $argname; + sscanf( + Tcl_GetString($obj), + "width %u height %u components %d bytesPerRow %u data 0x%p", + &$argname.width, &$argname.height, &$argname.components, &$argname.bytesPerRow, &$argname.data + ); +} + +$cc rtype image_t { + $robj = Tcl_ObjPrintf( + "width %u height %u components %d bytesPerRow %u data 0x%" PRIxPTR, + $rvalue.width, $rvalue.height, $rvalue.components, $rvalue.bytesPerRow, (uintptr_t) $rvalue.data + ); +} + +$cc include +$cc include +$cc include +$cc include +$cc include + +$cc code { + + void + write_jpeg(FILE* dest, uint8_t* grey, uint32_t width, uint32_t height, uint32_t bytes_per_row) + { + JSAMPARRAY image; + image = calloc(height, sizeof (JSAMPROW)); + for (size_t i = 0; i < height; i++) { + image[i] = calloc(width * 3, sizeof (JSAMPLE)); + for (size_t j = 0; j < width; j++) { + image[i][j * 3 + 0] = grey[i * bytes_per_row + j]; + image[i][j * 3 + 1] = grey[i * bytes_per_row + j]; + image[i][j * 3 + 2] = grey[i * bytes_per_row + j]; + } + } + + struct jpeg_compress_struct compress; + struct jpeg_error_mgr error; + compress.err = jpeg_std_error(&error); + jpeg_create_compress(&compress); + jpeg_stdio_dest(&compress, dest); + + compress.image_width = width; + compress.image_height = height; + compress.input_components = 3; + compress.in_color_space = JCS_RGB; + + jpeg_set_defaults(&compress); + jpeg_set_quality(&compress, 100, TRUE); + jpeg_start_compress(&compress, TRUE); + jpeg_write_scanlines(&compress, image, height); + jpeg_finish_compress(&compress); + jpeg_destroy_compress(&compress); + + for (size_t i = 0; i < height; i++) { + free(image[i]); + } + free(image); + } +} + + +$cc proc writeJPEG {image_t im char* filename} void { + FILE* out = fopen(filename, "w"); + write_jpeg(out, im.data, im.width, im.height, im.bytesPerRow); + fclose(out); +} + +c loadlib [lindex [exec /usr/sbin/ldconfig -p | grep libjpeg] end] +$cc compile + +When $this has camera slice /im/ { + Wish the web server handles route "/frame-image/$" with handler [list apply {{im} { + + set filename "/tmp/web-image-frame.jpg" + writeJPEG $im $filename + set fsize [file size $filename] + set fd [open $filename r] + + fconfigure $fd -encoding binary -translation binary + set body [read $fd $fsize] + close $fd + + set headers [join [list \ + "HTTP/1.1 200 OK" \ + "Connection: close" \ + "Content-Type: image/jpeg" \ + "Content-Length: $fsize" \ + ] "\n"] + + dict create statusAndHeaders "$headers\n\n" body $body + + }} $im] +}