From fdefde38e13d6958362b4fd9f8d079998c3fb9f1 Mon Sep 17 00:00:00 2001 From: Cristobal Sciutto Date: Tue, 6 Jun 2023 18:02:03 -0400 Subject: [PATCH 1/5] more --- lib/c.tcl | 1 + test/cstructs.tcl | 26 +++++++ virtual-programs/web-slice.folk | 120 ++++++++++++++++++++++++++++++++ 3 files changed, 147 insertions(+) create mode 100644 virtual-programs/web-slice.folk 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/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] +} From 23714b5bddd97022fc720785fe7250c9651e8ae3 Mon Sep 17 00:00:00 2001 From: Cristobal Sciutto Date: Wed, 7 Jun 2023 17:27:08 -0400 Subject: [PATCH 2/5] my user-programs --- user-programs/cristobal/local-slice.folk | 14 ++++++++ user-programs/cristobal/web-server.folk | 0 .../cristobal}/web-slice.folk | 32 +++++++++++++++---- virtual-programs/intersect.folk | 2 +- 4 files changed, 41 insertions(+), 7 deletions(-) create mode 100644 user-programs/cristobal/local-slice.folk create mode 100644 user-programs/cristobal/web-server.folk rename {virtual-programs => user-programs/cristobal}/web-slice.folk (79%) 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-server.folk b/user-programs/cristobal/web-server.folk new file mode 100644 index 00000000..e69de29b diff --git a/virtual-programs/web-slice.folk b/user-programs/cristobal/web-slice.folk similarity index 79% rename from virtual-programs/web-slice.folk rename to user-programs/cristobal/web-slice.folk index 15e4ce00..e49713d1 100644 --- a/virtual-programs/web-slice.folk +++ b/user-programs/cristobal/web-slice.folk @@ -1,9 +1,17 @@ -Wish $this is outlined blue +# +# +# Web-slice +# -------------------------------------------- +# Serves slice at host:4273/web-slice/$x-$y +# +# + +Wish $this is outlined white -# 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] +# TODO: get C-structs to work # $cc struct image_t { # uint32_t width; # uint32_t height; @@ -95,10 +103,21 @@ $cc proc writeJPEG {image_t im char* filename} void { 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} { +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 - set filename "/tmp/web-image-frame.jpg" + # 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] @@ -116,5 +135,6 @@ When $this has camera slice /im/ { dict create statusAndHeaders "$headers\n\n" body $body - }} $im] + }} $im $x $y] } + 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 +} From 60cac9c62069526634b92ccf029e16cc12a0087d Mon Sep 17 00:00:00 2001 From: Cristobal Sciutto Date: Wed, 7 Jun 2023 18:07:54 -0400 Subject: [PATCH 3/5] update --- docs/setup.md | 22 +++++++++++++++++++ user-programs/cristobal/web-server.folk | 16 ++++++++++++++ .../haippi7/laser-region-manager.folk | 2 +- virtual-programs/web-editor.folk | 2 +- 4 files changed, 40 insertions(+), 2 deletions(-) create mode 100644 docs/setup.md 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/user-programs/cristobal/web-server.folk b/user-programs/cristobal/web-server.folk index e69de29b..559047af 100644 --- a/user-programs/cristobal/web-server.folk +++ b/user-programs/cristobal/web-server.folk @@ -0,0 +1,16 @@ +When the collected matches for [list /someone/ wishes the web server handles route /route/ with handler /handler/] are /matches/ { + Wish $this is outlined white + + set routes {} + foreach match $matches { + set route [dict get $match route] + lappend routes $route + } + + Wish $this is labelled [join $routes "\n"] + Wish $this is labelled "routes found: [llength $routes]" + + Wish the web server handles route /all-routes$ 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/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 +} From 29e2c0a6cb099d572424bd6fec39cf9fccda49fd Mon Sep 17 00:00:00 2001 From: Cristobal Sciutto Date: Wed, 7 Jun 2023 18:38:53 -0400 Subject: [PATCH 4/5] sketch of server --- user-programs/cristobal/web-server.folk | 16 -------------- user-programs/cristobal/web-slices.folk | 29 +++++++++++++++++++++++++ 2 files changed, 29 insertions(+), 16 deletions(-) delete mode 100644 user-programs/cristobal/web-server.folk create mode 100644 user-programs/cristobal/web-slices.folk diff --git a/user-programs/cristobal/web-server.folk b/user-programs/cristobal/web-server.folk deleted file mode 100644 index 559047af..00000000 --- a/user-programs/cristobal/web-server.folk +++ /dev/null @@ -1,16 +0,0 @@ -When the collected matches for [list /someone/ wishes the web server handles route /route/ with handler /handler/] are /matches/ { - Wish $this is outlined white - - set routes {} - foreach match $matches { - set route [dict get $match route] - lappend routes $route - } - - Wish $this is labelled [join $routes "\n"] - Wish $this is labelled "routes found: [llength $routes]" - - Wish the web server handles route /all-routes$ with handler { - html $routes - } -} 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 + # } +} From 131ebfd93798e94d8be6d79464caaa4514da57c0 Mon Sep 17 00:00:00 2001 From: Cristobal Sciutto Date: Tue, 6 Jun 2023 18:02:03 -0400 Subject: [PATCH 5/5] more --- virtual-programs/web-slice.folk | 120 ++++++++++++++++++++++++++++++++ 1 file changed, 120 insertions(+) create mode 100644 virtual-programs/web-slice.folk 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] +}