centroid-calculation.folk

Wish $this is titled "Centroid calculation"
When when tag /tag/ has centroid /any/ on display /any/ /lambda/ with environment /e/ &\
     tag /tag/ has quad /q/ &\
     display /disp/ has intrinsics /any/ {
    set centroid [quad centroid [quad change $q "display $disp"]]
    Claim tag $tag has centroid $centroid on display $disp
}

When /someone/ wishes to draw a stroke on display /disp/ with /...options/ &\
     display /disp/ has width /width/ height /height/ &\
     display /disp/ has intrinsics /intrinsics/ {
    set points [dict get $options points]
    set projectedPoints [lmap point $points {
        intrinsics project $intrinsics $width $height $point
    }]
    dict set options points $projectedPoints
    Wish to draw a stroke with {*}$options
}

i-hat.folk

Claim $this is i-hat

j-hat.folk

Claim $this is j-hat

matrix-calculation.folk

Wish $this is titled "Matrix calculation"
When /origin/ is origin-point &\
     /iHat/ is i-hat & /jHat/ is j-hat &\
     tag /origin/ has centroid /oc/ on display /disp/ &\
     /origin/ has region /or/ &\
     tag /iHat/ has centroid /ic/ on display /disp/ &\
     tag /jHat/ has centroid /jc/ on display /disp/ {
  Wish tag $origin is stabilized
  Wish tag $iHat is stabilized
  Wish tag $jHat is stabilized
  
  lassign $oc ox oy
  set oa [region angle $or]
  lassign $ic ix iy
  lassign $jc jx jy

  set matrix [list [list [- $ix $ox] [- $jx $ox]] \
                   [list [- $iy $oy] [- $jy $oy]]]

  set convertToDisplayMatrix [list \
      [list [* [cos $oa]  100] [* [sin $oa] -100]] \
      [list [* [sin $oa] -100] [* [cos $oa] -100]]]
  set displayMatrix [matmul $convertToDisplayMatrix $matrix]
  
  Claim $this has 2d matrix $matrix origin $oc \
                  i-hat $ic j-hat $jc display $disp
  Claim $this has display matrix $displayMatrix origin $oc \
                  i-hat $ic j-hat $jc display $disp
}

matrix-drawing.folk

Wish $this is titled "Matrix drawing"
proc matvecmul {matrix vector} {
  lassign [lindex $matrix 0] mat00 mat01
  lassign [lindex $matrix 1] mat10 mat11
  lassign $vector vec0 vec1
  return [list [expr {$mat00 * $vec0 + $mat01 * $vec1}] \
               [expr {$mat10 * $vec0 + $mat11 * $vec1}]]
}
proc vecadd {v1 v2} {
  lassign $v1 x1 y1; lassign $v2 x2 y2
  return [list [+ $x1 $x2] [+ $y1 $y2]]
}
When /someone/ has 2d matrix /matrix/ origin /oc/ \
                   i-hat /ic/ j-hat /jc/ display /disp/ {
  set lines [list [list $oc $ic green -1] [list $oc $jc red -1]]
  lassign $oc ox oy oz
  set count 3
  for {set i -$count} {$i <= $count} {incr i} {
    set p1 [vecadd [matvecmul $matrix [list $i -$count]] $oc]
    set p2 [vecadd [matvecmul $matrix [list $i $count]] $oc]
    set p3 [vecadd [matvecmul $matrix [list -$count $i]] $oc]
    set p4 [vecadd [matvecmul $matrix [list $count $i]] $oc]
    lappend p1 [lindex $oc 2]; lappend p2 [lindex $oc 2]
    lappend p3 [lindex $oc 2]; lappend p4 [lindex $oc 2]
    lappend lines [list $p1 $p2 white -2] [list $p3 $p4 white -2]
  }
  foreach line $lines {
    Wish to draw a stroke on display $disp with \
         points [lrange $line 0 1] width 6 \
         color [lindex $line 2] layer [lindex $line 3]
  }
}

matrix-info.folk

proc myFormat {meters} {
  return [format {%0.2f} $meters]
}

Wish tag $this is stabilized
When /someone/ has display matrix /matrix/ /...anything/ &\
     $this has region /r/ {
  set offsetX 0; set offsetY 220
  set spacingX 10; set spacingY 5
  
  set m00 [myFormat [lindex $matrix 0 0]]; set m01 [myFormat [lindex $matrix 0 1]]
  set m10 [myFormat [lindex $matrix 1 0]]; set m11 [myFormat [lindex $matrix 1 1]]
  
  Wish $this draws text $m00 with color white anchor bottomright \
       offset [list [- $offsetX $spacingX] [- $offsetY $spacingY]]
  Wish $this draws text $m10 with color white anchor topright \
       offset [list [- $offsetX $spacingX] [+ $offsetY $spacingY]]
  Wish $this draws text $m01 with color white anchor bottomleft \
       offset [list [+ $offsetX $spacingX] [- $offsetY $spacingY]]
  Wish $this draws text $m11 with color white anchor topleft \
       offset [list [+ $offsetX $spacingX] [+ $offsetY $spacingY]]
}

origin-point.folk

Claim $this is origin-point