From 3ddc9e924e7e747f3d75501eaa8cd731d67f5e7c Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Sun, 13 Aug 2023 23:07:57 -0400 Subject: More small monitoring improvements. Remote flamegraph tid --- virtual-programs/display.folk | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index d5623d10..5e16797f 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -80,19 +80,20 @@ On process { } set displayCommands [lmap sublist [lsort -command lcomp $displayList] {lindex $sublist 1}] + set renderTime [baretime [list foreach command $displayCommands { {*}$command }]] set commitTime [baretime commitThenClearStaging] - set inLastSecond 0 + set framesInLastSecond 0 set now [clock milliseconds] lappend frames $now foreach frame $frames { if {$frame > $now - 1000} { - incr inLastSecond + incr framesInLastSecond } } - set frames [lreplace $frames 0 end-$inLastSecond] - Commit { Claim the display time is "render $renderTime us + commit $commitTime us ($inLastSecond fps)" } + set frames [lreplace $frames 0 end-$framesInLastSecond] + Commit { Claim the display time is "render $renderTime us + commit $commitTime us ($framesInLastSecond fps)" } } } # TODO: remove this compatibility hack -- cgit v1.2.3 From 11cdb9051327c873b334284ad8409be64fc6b3e7 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Sun, 13 Aug 2023 23:08:28 -0400 Subject: WIP: Start on incremental detector. Fix stride in AprilTags --- virtual-programs/apriltags.folk | 107 ++++++++++++++++++++++++++++------------ 1 file changed, 75 insertions(+), 32 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/apriltags.folk b/virtual-programs/apriltags.folk index 3e95ee64..f8b94da2 100644 --- a/virtual-programs/apriltags.folk +++ b/virtual-programs/apriltags.folk @@ -35,38 +35,81 @@ When /someone/ detects tags /tags/ at /timestamp/ in time /aprilTime/ { } } -# On process { -# source pi/AprilTags.tcl -# AprilTags::init +On process { + source pi/AprilTags.tcl + AprilTags::init + + # TODO: Clean this up. We retract these so that we don't bounce + # statements back to the main Folk process that it sends us. + Retract /anyone/ wishes $::thisProcess shares all wishes + Retract /anyone/ wishes $::thisProcess shares all claims + Wish $::thisProcess receives statements like \ + [list /someone/ claims the camera frame is /grayFrame/ at /timestamp/] + Wish $::thisProcess receives statements like \ + [list /someone/ claims /process/ detects tags /tags/ at /timestamp/ in time /aprilTime/] + Wish $::thisProcess shares statements like \ + [list /someone/ wishes /process/ receives statements like /pattern/] + Wish $::thisProcess shares statements like \ + [list /someone/ claims $::thisProcess has pid /pid/] + Wish $::thisProcess shares statements like \ + [list /someone/ claims $::thisProcess detects tags /tags/ at /timestamp/ in time /aprilTime/] + Wish $::thisProcess shares statements like \ + [list /someone/ wishes /something/ is labelled /text/] + Wish $::thisProcess shares statements like \ + [list /someone/ wishes /something/ displays camera slice /slice/] + + proc subimage {im x y subwidth subheight} { + dict with im { + set x [expr {int($x)}] + set y [expr {int($y)}] + set subdata [expr {$data + ($y*$width + $x) * $components}] + dict create \ + width [int $subwidth] \ + height [int $subheight] \ + components $components \ + bytesPerRow $bytesPerRow \ + data [format 0x%x $subdata] + } + } -# # TODO: Clean this up. We retract these so that we don't bounce -# # statements back to the main Folk process that it sends us. -# Retract /anyone/ wishes $::thisProcess shares all wishes -# Retract /anyone/ wishes $::thisProcess shares all claims -# Wish $::thisProcess receives statements like \ -# [list /someone/ claims the camera frame is /grayFrame/] -# Wish $::thisProcess shares statements like \ -# [list /someone/ wishes /process/ receives statements like /pattern/] -# Wish $::thisProcess shares statements like \ -# [list /someone/ claims tag /tag/ has center /center/ size /size/] -# Wish $::thisProcess shares statements like \ -# [list /someone/ claims tag /tag/ has corners /corners/] -# Wish $::thisProcess shares statements like \ -# [list /someone/ claims the AprilTag time is /aprilTime/] -# Wish $::thisProcess shares statements like \ -# [list /someone/ claims $::thisProcess has pid /pid/] + When the camera frame is /grayFrame/ at /timestamp/ & \ + /process/ detects tags /prevTags/ at /something/ in time /something/ { -# When the camera frame is /grayFrame/ { -# set aprilTime [time { -# set tags [AprilTags::detect $grayFrame] -# }] -# Commit { -# Claim the AprilTag time is $aprilTime + if {$process eq $::thisProcess} { return } -# foreach tag $tags { -# Claim tag [dict get $tag id] has center [dict get $tag center] size [dict get $tag size] -# Claim tag [dict get $tag id] has corners [dict get $tag corners] -# } -# } -# } -# } + set tags [list] + set frameWidth [dict get $grayFrame width] + set frameHeight [dict get $grayFrame height] + set aprilTime 0 + foreach prevTag $prevTags { + set size [dict get $prevTag size] + set corners [dict get $prevTag corners] + set x [min {*}[lmap corner $corners {lindex $corner 0}]] + set y [min {*}[lmap corner $corners {lindex $corner 1}]] + set x1 [max {*}[lmap corner $corners {lindex $corner 0}]] + set y1 [max {*}[lmap corner $corners {lindex $corner 1}]] + + set x [max [- $x $size] 0] + set y [max [- $y $size] 0] + set x1 [min [+ $x1 $size] $frameWidth] + set y1 [min [+ $y1 $size] $frameHeight] + + set subimage [subimage $grayFrame $x $y [- $x1 $x] [- $y1 $y]] + Wish 6 displays camera slice $subimage + set aprilTime [+ $aprilTime [baretime { + lappend tags {*}[AprilTags::detect $subimage] + }]] + } + + Wish 6 is labelled "[llength $prevTags] -> [llength $tags] ($aprilTime us)" + + # Commit { + # Claim the AprilTag time is $aprilTime + + # foreach tag $tags { + # Claim tag [dict get $tag id] has center [dict get $tag center] size [dict get $tag size] + # Claim tag [dict get $tag id] has corners [dict get $tag corners] + # } + # } + } +} -- cgit v1.2.3 From f5f8719a3d13e6dcd5efe6fac1c9d52f0d891135 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 14 Aug 2023 21:03:45 -0400 Subject: apriltags: WIP: First working incremental detector --- virtual-programs/apriltags.folk | 60 ++++++++++++++++++++++++----------------- 1 file changed, 36 insertions(+), 24 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/apriltags.folk b/virtual-programs/apriltags.folk index f8b94da2..d9557644 100644 --- a/virtual-programs/apriltags.folk +++ b/virtual-programs/apriltags.folk @@ -1,6 +1,7 @@ if {$::isLaptop} return -On process { +# Plain detector. Runs on entire camera frame. +set mainDetectorProcess [On process { source pi/AprilTags.tcl AprilTags::init @@ -21,20 +22,12 @@ On process { set aprilTime [time { set tags [AprilTags::detect $grayFrame] }] - Commit { - Claim $::thisProcess detects tags $tags at $timestamp in time $aprilTime - } + Claim $::thisProcess detects tags $tags at $timestamp in time $aprilTime } -} - -When /someone/ detects tags /tags/ at /timestamp/ in time /aprilTime/ { - Claim the AprilTag time is $aprilTime - foreach tag $tags { - Claim tag [dict get $tag id] has center [dict get $tag center] size [dict get $tag size] - Claim tag [dict get $tag id] has corners [dict get $tag corners] - } -} +}] +# Incremental detector. Looks at regions where there were tags in the +# old camera frame. On process { source pi/AprilTags.tcl AprilTags::init @@ -46,7 +39,7 @@ On process { Wish $::thisProcess receives statements like \ [list /someone/ claims the camera frame is /grayFrame/ at /timestamp/] Wish $::thisProcess receives statements like \ - [list /someone/ claims /process/ detects tags /tags/ at /timestamp/ in time /aprilTime/] + [list /someone/ claims $mainDetectorProcess detects tags /tags/ at /timestamp/ in time /aprilTime/] Wish $::thisProcess shares statements like \ [list /someone/ wishes /process/ receives statements like /pattern/] Wish $::thisProcess shares statements like \ @@ -95,21 +88,40 @@ On process { set y1 [min [+ $y1 $size] $frameHeight] set subimage [subimage $grayFrame $x $y [- $x1 $x] [- $y1 $y]] - Wish 6 displays camera slice $subimage set aprilTime [+ $aprilTime [baretime { - lappend tags {*}[AprilTags::detect $subimage] + foreach tag [AprilTags::detect $subimage] { + dict with tag { + set center [vec2 add $center [list $x $y]] + set corners [lmap corner $corners {vec2 add $corner [list $x $y]}] + } + lappend tags $tag + } }]] } - Wish 6 is labelled "[llength $prevTags] -> [llength $tags] ($aprilTime us)" + # Wish 6 is labelled "[llength $prevTags] -> [llength $tags] ($aprilTime us)" - # Commit { - # Claim the AprilTag time is $aprilTime + Claim $::thisProcess detects tags $tags at $timestamp in time $aprilTime + } +} + +When the collected matches for [list /someone/ detects tags /tags/ at /timestamp/ in time /aprilTime/] are /matches/ { + # Find all tag IDs, then find the latest for each ID. + # Sort by timestamp, earliest first. + proc mcomp {a b} {> [dict get $a timestamp] [dict get $b timestamp]} + set matches [lsort -command mcomp $matches] + + set tagsSeen [dict create] + foreach match $matches { + set tags [dict get $match tags] + foreach tag $tags { + dict set tagsSeen [dict get $tag id] $tag + } + } - # foreach tag $tags { - # Claim tag [dict get $tag id] has center [dict get $tag center] size [dict get $tag size] - # Claim tag [dict get $tag id] has corners [dict get $tag corners] - # } - # } + dict for {id tag} $tagsSeen { + Claim tag $id has center [dict get $tag center] size [dict get $tag size] + Claim tag $id has corners [dict get $tag corners] } + Claim the AprilTag time is [lmap m $matches {dict get $m aprilTime}] } -- cgit v1.2.3 From cf16ae229066352c3194e8b225bdf9b996a40738 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 14 Aug 2023 22:56:16 -0400 Subject: Try to fix collect incremental --- virtual-programs/tags-and-calibration.folk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'virtual-programs') diff --git a/virtual-programs/tags-and-calibration.folk b/virtual-programs/tags-and-calibration.folk index afb4aef4..b219b541 100644 --- a/virtual-programs/tags-and-calibration.folk +++ b/virtual-programs/tags-and-calibration.folk @@ -119,7 +119,8 @@ When (non-capturing) tag /tag/ has center /c/ size /size/ { } When (non-capturing) tag /tag/ is a tag { - puts "Added tag $tag" + puts "Added tag $tag" + On unmatch { puts "Removed tag $tag" } set tempPath "$::env(HOME)/folk-printed-programs/$tag.folk.temp" -- cgit v1.2.3 From 986aa91a7483efa686eae99d218edaf2afbded42 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 14 Aug 2023 23:49:28 -0400 Subject: Use old positions so tags move 'monotonically' --- virtual-programs/apriltags.folk | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/apriltags.folk b/virtual-programs/apriltags.folk index d9557644..1f38f29b 100644 --- a/virtual-programs/apriltags.folk +++ b/virtual-programs/apriltags.folk @@ -105,17 +105,29 @@ On process { } } -When the collected matches for [list /someone/ detects tags /tags/ at /timestamp/ in time /aprilTime/] are /matches/ { - # Find all tag IDs, then find the latest for each ID. - # Sort by timestamp, earliest first. - proc mcomp {a b} {> [dict get $a timestamp] [dict get $b timestamp]} - set matches [lsort -command mcomp $matches] +# This cache is used to remember the last seen position of each tag, +# so that if the incremental detector blinks out, we still use the +# tag's last-found position from it, instead of the older position +# from the full detector, so as you move a tag its position doesn't +# glitch backward. +set ::tagsCache [dict create] +# TODO: Garbage-collect this cache. +When the collected matches for [list /someone/ detects tags /tags/ at /timestamp/ in time /aprilTime/] are /matches/ { set tagsSeen [dict create] foreach match $matches { - set tags [dict get $match tags] - foreach tag $tags { - dict set tagsSeen [dict get $tag id] $tag + set timestamp [dict get $match timestamp] + foreach tag [dict get $match tags] { + set id [dict get $tag id] + dict set tag timestamp $timestamp + + if {[dict exists $::tagsCache $id] && + [dict get $::tagsCache $id timestamp] > $timestamp} { + set tag [dict get $::tagsCache $id] + } else { + dict set ::tagsCache $id $tag + } + dict set tagsSeen $id $tag } } -- cgit v1.2.3 From f42902b4cf694a4ec3f4f345699384ab53e32ece Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Tue, 15 Aug 2023 17:14:19 -0400 Subject: WIP: Rewrite peering to use shm instead of websockets Huge performance increases, but crashy. --- virtual-programs/apriltags.folk | 1 + virtual-programs/camera.folk | 3 ++- virtual-programs/display.folk | 6 ++++-- virtual-programs/time.folk | 2 +- 4 files changed, 8 insertions(+), 4 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/apriltags.folk b/virtual-programs/apriltags.folk index 1f38f29b..ac2c4f8b 100644 --- a/virtual-programs/apriltags.folk +++ b/virtual-programs/apriltags.folk @@ -102,6 +102,7 @@ On process { # Wish 6 is labelled "[llength $prevTags] -> [llength $tags] ($aprilTime us)" Claim $::thisProcess detects tags $tags at $timestamp in time $aprilTime + # Wish 6 is labelled "\n\nStep time $::stepTime\n[join [lmap s [dict values [Statements::all]] {statement short $s}] "\n"]" } } diff --git a/virtual-programs/camera.folk b/virtual-programs/camera.folk index 4f59a576..225a5880 100644 --- a/virtual-programs/camera.folk +++ b/virtual-programs/camera.folk @@ -20,7 +20,7 @@ On process { puts "Camera tid: [getTid] booting at [clock milliseconds]" - forever { + while true { set cameraTime [time { set grayFrame [Camera::grayFrame] }] @@ -28,6 +28,7 @@ On process { Claim the camera time is $cameraTime Claim the camera frame is $grayFrame at [clock milliseconds] } + Step } } diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index 5e16797f..b0b878ca 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -60,7 +60,7 @@ On process { [list /someone/ claims the display time is /displayTime/] set ::frames [list] - forever { + while true { set displayList [list] foreach match [Statements::findMatches {/someone/ wishes display runs /command/ on layer /layer/}] { lappend displayList [list [dict get $match layer] [dict get $match command]] @@ -93,7 +93,9 @@ On process { } } set frames [lreplace $frames 0 end-$framesInLastSecond] - Commit { Claim the display time is "render $renderTime us + commit $commitTime us ($framesInLastSecond fps)" } + + Commit { Claim the display time is "render $renderTime us + commit $commitTime us ($::stepTime) ($framesInLastSecond fps)" } + Step } } # TODO: remove this compatibility hack diff --git a/virtual-programs/time.folk b/virtual-programs/time.folk index 961b1863..1dff734d 100644 --- a/virtual-programs/time.folk +++ b/virtual-programs/time.folk @@ -1,3 +1,3 @@ When $::thisProcess has step count /t/ { - Claim the clock time is [/ [clock milliseconds] 1000.0] + Claim the clock time is [/ [clock milliseconds] 1000.0] } -- cgit v1.2.3