cs/web-slice

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
+```

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); }}}

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]

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
+}
+

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 <stdlib.h>
+$cc include <string.h>
+$cc include <stdint.h>
+$cc include <unistd.h>
+$cc include <jpeglib.h>
+
+$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]
+}
+

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
+  # }
+}

user-programs/haippi7/laser-region-manager.folk

@@ -150,4 +150,4 @@ ws.onmessage = (msg) => {
         </html>
         }]
   } [Evaluator::serializeEnvironment]]
-}
+}

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
   }
-}
+}

virtual-programs/web-editor.folk

@@ -96,4 +96,4 @@ function handlePrint() {
             </html>
         }]
     }
-}
+}

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 <stdlib.h>
+$cc include <string.h>
+$cc include <stdint.h>
+$cc include <unistd.h>
+$cc include <jpeglib.h>
+
+$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]
+}