builtin-programs/draw/image.folk
When the jpeg library is /jpegLib/ {
fn jpegLoader {im} {
if {[string match "*jpg" $im] || [string match "*jpeg" $im]} {
return [$jpegLib loadJpeg $im]
}
}
Claim [fn jpegLoader] is an image loader
}
When the png library is /pngLib/ {
fn pngLoader {im} {
if {[string match "*png" $im]} {
return [$pngLib loadPng $im]
}
}
Claim [fn pngLoader] is an image loader
}
When the gif library is /gifLib/ {
fn gifLoader {im} {
upvar coerceToImage coerceToImage
if {[string match "*gif" $im]} {
set gif [$gifLib loadGif $im]
if {$coerceToImage} {
return [lindex [dict get $gif frames] 0]
}
# WARNING: This is not an Image object -- it's a Gif
# object and requires special handling by the caller.
return $gif
}
}
Claim [fn gifLoader] is an image loader
}
When the collected results for {/loader/ is an image loader} are /loaders/ {
# Pass coerceToImage = 0 if the caller is willing to handle a Gif
# object, not just a normal Image.
fn loadImage {im {coerceToImage 1}} {
set results [Query! the image path $im maps to cached image /cachedIm/]
if {[llength $results] > 0} {
return [dict get [lindex $results 0] cachedIm]
}
set impath $im
if {[string match "http*://*" $impath]} {
set im /tmp/[regsub -all {\W+} $impath "_"]
if {![file exists $im]} {
exec curl -s -L -o$im $impath
}
}
set path [expr {[string index $im 0] eq "/" ?
$im : "$::env(HOME)/folk-images/$im"}]
if {![file exists $path]} {
set path [file join [pwd] $im]
}
foreach loaderResult $loaders {
set loader [dict get $loaderResult loader]
set result [{*}$loader $path]
if {$result ne {}} {
Hold! -key [list cache $impath] \
Claim the image path $impath maps to cached image $result
return $result
}
}
return $im
}
Claim the image loader is [fn loadImage]
}
Wish the GPU compiles pipeline "image" {
{vec2 viewport mat3 surfaceToClip
sampler2D image vec2 a vec2 b vec2 c vec2 d} {
vec2 vertices[6] = vec2[6](a, b, c, a, c, d);
vec3 v = surfaceToClip * vec3(vertices[gl_VertexIndex], 1.0);
return vec4(v.xy/v.z, 0.0, 1.0);
} {fn invBilinear} {
vec2 clipXy = (gl_FragCoord.xy / viewport) * 2.0 - 1.0;
vec3 surfaceXy = inverse(surfaceToClip) * vec3(clipXy, 1.0);
surfaceXy /= surfaceXy.z;
vec2 uv = invBilinear(surfaceXy.xy, a, b, c, d);
if( max( abs(uv.x-0.5), abs(uv.y-0.5))<0.5 ) {
vec4 texColor = texture(image, uv);
if (texColor.a < 0.01) {
return vec4(0.0);
}
return texColor;
}
return vec4(0.0);
}}
When the image library is /imageLib/ &\
/someone/ wishes to draw an image onto /p/ with /...options/ &\
/p/ has canvas /id/ with /...wiOptions/ &\
/p/ has canvas projection /surfaceToClip/ {
set im [dict get $options image]
if {[dict exists $options position]} {
lassign [dict get $options position] x0 y0
} else {
set x0 [dict get $options x]
set y0 [dict get $options y]
}
set radians [dict getdef $options radians 0]
if {[dict exists $options width] && [dict exists $options height]} {
set width [dict get $options width]
set height [dict get $options height]
} elseif {[dict exists $options width] && ![dict exists $options height]} {
set width [dict get $options width]
set height $(double([$imageLib Image_height $im]) / [$imageLib Image_width $im] * $width)
} elseif {![dict exists $options width] && [dict exists $options height]} {
set height [dict get $options height]
set width $(double([$imageLib Image_width $im]) / [$imageLib Image_height $im] * $height)
}
# TODO: implement anchor like in text
set anchor [dict getdef $options anchor "topleft"]
if {$anchor eq "center"} {
set a [list $($x0 - $width/2.0) $($y0 - $height/2.0)]
set b [list $($x0 + $width/2.0) $($y0 - $height/2.0)]
set c [list $($x0 + $width/2.0) $($y0 + $height/2.0)]
set d [list $($x0 - $width/2.0) $($y0 + $height/2.0)]
} elseif {$anchor eq "topleft"} {
set a [list $x0 $y0]
set b [list [+ $x0 $width] $y0]
set c [list [+ $x0 $width] [+ $y0 $height]]
set d [list $x0 [+ $y0 $height]]
} else {
error "Unsupported anchor: $anchor"
}
set wiResolution [list [dict get $wiOptions width] [dict get $wiOptions height]]
Wish the GPU loads image $im as texture
When the GPU has loaded image $im as texture /gim/ {
Wish the GPU draws pipeline "image" onto canvas $id with arguments \
[list $wiResolution $surfaceToClip \
$gim \
$a $b $c $d]
}
}
When the image library is /imageLib/ &\
the image loader is /loadImage/ &\
/someone/ wishes /p/ displays image /impath/ with /...options/ &\
/p/ has resolved geometry /geom/ {
# HACK: because we match partially
if {![info exists options]} { return }
fn loadImage
try {
set im [loadImage $impath 0]
} on error {e opts} {
Say $p has error $e with info $opts
return
}
if {[string match "*gif" $impath]} {
Wish $p displays gif $im with {*}$options
return
}
set width [/ [dict getdef $geom left [dict get $geom width]] 1.5]
set derivedHeight $(double([$imageLib Image_height $im])/[$imageLib Image_width $im] * $width)
set geomHeight [dict get $geom height]
if {$derivedHeight > $geomHeight} {
set width $($geomHeight / $derivedHeight * $width)
}
Wish to draw an image onto $p with \
image $im \
position [dict getdef $options position [list 0 0]] \
anchor topleft width [dict getdef $options width $width]
}
When /someone/ wishes /p/ displays image /im/ {
Wish $p displays image $im with scale 1.0
}