From b3cfcd67f3a0402b40b6cce6a115bf43a7c98ef8 Mon Sep 17 00:00:00 2001 From: Jacob Haip Date: Sun, 23 Apr 2023 22:58:33 -0400 Subject: move laser folk programs to lamp's folder --- user-programs/folk-haip.local/laser-web-debug.folk | 77 ----------------- user-programs/folk-haip.local/web-image.folk | 96 ---------------------- user-programs/haippi7/laser-web-debug.folk | 77 +++++++++++++++++ user-programs/haippi7/project-laser-dot.folk | 6 ++ user-programs/haippi7/web-image.folk | 96 ++++++++++++++++++++++ 5 files changed, 179 insertions(+), 173 deletions(-) delete mode 100644 user-programs/folk-haip.local/laser-web-debug.folk delete mode 100644 user-programs/folk-haip.local/web-image.folk create mode 100644 user-programs/haippi7/laser-web-debug.folk create mode 100644 user-programs/haippi7/project-laser-dot.folk create mode 100644 user-programs/haippi7/web-image.folk (limited to 'user-programs') diff --git a/user-programs/folk-haip.local/laser-web-debug.folk b/user-programs/folk-haip.local/laser-web-debug.folk deleted file mode 100644 index f65107c2..00000000 --- a/user-programs/folk-haip.local/laser-web-debug.folk +++ /dev/null @@ -1,77 +0,0 @@ -When the collected matches for [list tag /t/ has center /c/ size /s/] are /matches/ { - Wish the web server handles route "/laser-web-debug" with handler [list Evaluator::tryRunInSerializedEnvironment { - set blobsHtml "
    " - set blobsJson "" - foreach match $matches { - append blobsHtml "
  1. [dict get $match t]: [dict get $match c]
    2. " - append blobsJson "{\"id\": [dict get $match t], \"x\": [lindex [dict get $match c] 0], \"y\": [lindex [dict get $match c] 1]}," - } - append blobsHtml "
" - append blobsJson "" - html [string map [list MY_BLOBS_HTML $blobsHtml MY_BLOBS_JSON $blobsJson] { - - - - - - - - MY_BLOBS_HTML - - - - - - }] - } [Evaluator::serializeEnvironment]] -} \ No newline at end of file diff --git a/user-programs/folk-haip.local/web-image.folk b/user-programs/folk-haip.local/web-image.folk deleted file mode 100644 index 104cb43b..00000000 --- a/user-programs/folk-haip.local/web-image.folk +++ /dev/null @@ -1,96 +0,0 @@ -set cc [c create] -$cc cflags -L[lindex [exec /usr/sbin/ldconfig -p | grep libjpeg] end] - -# defineImageType $cc -# for some reason defineImageType doesn't work here so we do it manually -$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 code { - #include - #include - #include - - void -jpeg(FILE* dest, uint8_t* rgb, uint32_t width, uint32_t height, int quality) -{ - 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] = rgb[(i * width + j)]; - image[i][j * 3 + 1] = rgb[(i * width + j)]; - image[i][j * 3 + 2] = rgb[(i * width + 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, quality, 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 saveTempImage {image_t im char* filename} void { - // write capture to jpeg - // char filename[100] = "web-image-test.jpg"; - FILE* out = fopen(filename, "w"); - jpeg(out, im.data, im.width, im.height, 100); - fclose(out); -} -c loadlib [lindex [exec /usr/sbin/ldconfig -p | grep libjpeg] end] -$cc compile - -When the camera frame is /im/ { - Wish the web server handles route "/frame-image/$" with handler [list Evaluator::tryRunInSerializedEnvironment { - # set width [dict get $im width] - # set height [dict get $im height] - set filename "/tmp/web-image-frame.jpg" - saveTempImage $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 - dict create statusAndHeaders "HTTP/1.1 200 OK\nConnection: close\nContent-Type: image/jpeg\nContent-Length: $fsize\n\n" body $body - } [Evaluator::serializeEnvironment]] -} \ No newline at end of file diff --git a/user-programs/haippi7/laser-web-debug.folk b/user-programs/haippi7/laser-web-debug.folk new file mode 100644 index 00000000..0f7b26a0 --- /dev/null +++ b/user-programs/haippi7/laser-web-debug.folk @@ -0,0 +1,77 @@ +When the collected matches for [list laser blob /t/ has center /c/ size /s/] are /matches/ { + Wish the web server handles route "/laser-web-debug" with handler [list Evaluator::tryRunInSerializedEnvironment { + set blobsHtml "
    " + set blobsJson "" + foreach match $matches { + append blobsHtml "
  1. [dict get $match t]: [dict get $match c]
    2. " + append blobsJson "{\"id\": [dict get $match t], \"x\": [lindex [dict get $match c] 0], \"y\": [lindex [dict get $match c] 1]}," + } + append blobsHtml "
" + append blobsJson "" + html [string map [list MY_BLOBS_HTML $blobsHtml MY_BLOBS_JSON $blobsJson] { + + + + + + + + MY_BLOBS_HTML + + + + + + }] + } [Evaluator::serializeEnvironment]] +} \ No newline at end of file diff --git a/user-programs/haippi7/project-laser-dot.folk b/user-programs/haippi7/project-laser-dot.folk new file mode 100644 index 00000000..32e0b4b0 --- /dev/null +++ b/user-programs/haippi7/project-laser-dot.folk @@ -0,0 +1,6 @@ +When laser blob /t/ has center /c/ size /s/ { + lassign [::cameraToProjector $c] cx cy + # Display::stroke [list [list $cx $cy] [list [expr {$cx+1}] [expr {$cy+1}]]] 20 red + Display::text device $cx $cy 12 "Laser blob" 0 + puts "Drawing blobbbb at $cx $cy" +} \ No newline at end of file diff --git a/user-programs/haippi7/web-image.folk b/user-programs/haippi7/web-image.folk new file mode 100644 index 00000000..104cb43b --- /dev/null +++ b/user-programs/haippi7/web-image.folk @@ -0,0 +1,96 @@ +set cc [c create] +$cc cflags -L[lindex [exec /usr/sbin/ldconfig -p | grep libjpeg] end] + +# defineImageType $cc +# for some reason defineImageType doesn't work here so we do it manually +$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 code { + #include + #include + #include + + void +jpeg(FILE* dest, uint8_t* rgb, uint32_t width, uint32_t height, int quality) +{ + 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] = rgb[(i * width + j)]; + image[i][j * 3 + 1] = rgb[(i * width + j)]; + image[i][j * 3 + 2] = rgb[(i * width + 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, quality, 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 saveTempImage {image_t im char* filename} void { + // write capture to jpeg + // char filename[100] = "web-image-test.jpg"; + FILE* out = fopen(filename, "w"); + jpeg(out, im.data, im.width, im.height, 100); + fclose(out); +} +c loadlib [lindex [exec /usr/sbin/ldconfig -p | grep libjpeg] end] +$cc compile + +When the camera frame is /im/ { + Wish the web server handles route "/frame-image/$" with handler [list Evaluator::tryRunInSerializedEnvironment { + # set width [dict get $im width] + # set height [dict get $im height] + set filename "/tmp/web-image-frame.jpg" + saveTempImage $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 + dict create statusAndHeaders "HTTP/1.1 200 OK\nConnection: close\nContent-Type: image/jpeg\nContent-Length: $fsize\n\n" body $body + } [Evaluator::serializeEnvironment]] +} \ No newline at end of file -- cgit v1.2.3