Skip to content

Basic ShaderToy shader support #271

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
osnr merged 4 commits into from
Jun 9, 2026
Merged

Basic ShaderToy shader support #271

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
bbf68a9
gpu: Move pipeline compiler into pipelines.folk
osnr Jun 8, 2026
4d93ca2
WIP: Toy shader (ShaderToy-compatible) support
osnr Jun 8, 2026
12d9eb9
toy-shader: Fix iResolution to work. iTime still broken
osnr Jun 8, 2026
0467ecf
toy-shader: Fix iTime
osnr Jun 9, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
360 changes: 4 additions & 356 deletions builtin-programs/gpu/draw.folk
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,8 @@ if {[info exists this] && $::tcl_platform(os) eq "darwin"} {
When the GPU library is /gpuLib/ &\
the GPU Vulkan handle type definer is /defineVulkanHandleType/ &\
the GPU texture library is /gpuTextureLib/ &\
the GPU pipeline library is /pipelineLib/ {
the GPU pipeline library is /pipelineLib/ &\
the GPU pipeline compiler library is /pipelineCompilerLib/ {

fn defineVulkanHandleType

Expand Down Expand Up @@ -525,359 +526,6 @@ proc makeGpu {gpuLib pipelineLib drawLib} { return [library create gpu {gpuLib p
tailcall "$drawLib $drawLibCmd" {*}$args
}
}

# Construct a reusable GLSL function that can be linked into and
# called from a shader/pipeline.
proc fn {fnDict arguments rtype body} {
set fnArgs [list]
# We inline all dependent functions from the caller scope
# immediately here, since we don't know if those dependencies
# would be accessible/in scope at all when this function gets
# actually compiled into a shader.
set depFnDict [dict create]
foreach {argtype argname} $arguments {
if {$argtype eq "fn"} {
# TODO: Support fn being a list {fnName fn}.
if {![dict exists $fnDict $argname]} {
puts stderr "Gpu::fn: $argname not found"
return -code 99 $argname
}
dict set depFnDict [string map {: ""} $argname] \
[dict get $fnDict $argname]
} else {
lappend fnArgs $argtype $argname
}
}
return [list $fnArgs $depFnDict $rtype $body]
}

# Construct a shader pipeline that can be used to draw to the
# screen.
proc pipeline {fnDict args} {
variable gpuLib
variable pipelineLib
variable drawLib

if {[llength $args] == 3} {
lassign $args vertArgs vertBody fragBody
set fragArgs [list]
} elseif {[llength $args] == 4} {
lassign $args vertArgs vertBody fragArgs fragBody
} else {
error {Gpu pipeline: should be used as [$gpu pipeline vertArgs vertBody fragBody], or [$gpu pipeline vertArgs vertBody fragArgs fragBody]}
}
set vertFnDict [dict create]
set fragFnDict [dict create]
set pushConstants [list]
foreach {argtype argname} $vertArgs {
if {$argtype eq "fn"} {
# TODO: Support fn being a list {name fn}.
if {![dict exists $fnDict $argname]} {
return -code 99 $argname
}
set fn [dict get $fnDict $argname]
set vertFnDict [dict merge $vertFnDict [lindex $fn 1]]
dict set vertFnDict $argname $fn
continue
}
lappend pushConstants $argtype $argname
}
foreach {argtype argname} $fragArgs {
if {$argtype eq "fn"} {
# TODO: Support fn being a list {name fn}.
if {![dict exists $fnDict $argname]} {
return -code 99 $argname
}
set fn [dict get $fnDict $argname]
set fragFnDict [dict merge $fragFnDict [lindex $fn 1]]
dict set fragFnDict $argname $fn
continue
} else {
error "Fragment arguments not supported"
}
}

# Create a C subcompiler to create a fast routine to encode
# the push constants on each draw call.
set cc [C]
$cc typedef int sampler2D
$cc struct vec2 { float x; float y; }
$cc struct vec3 { float x; float y; float z; }
$cc struct vec4 { float x; float y; float z; float w; }
$cc struct uvec4 { uint32_t x; uint32_t y; uint32_t z; uint32_t w; }
# Note that mat3 is COLUMN-MAJOR and every column has 1 float
# of padding at the end.
$cc struct mat3 { float data[12]; }

$cc argtype vec2 {
vec2 $argname;
{
int $[set argname]_objc = Jim_ListLength(interp, $obj);
__ENSURE($[set argname]_objc == 2);
double x; double y;
__ENSURE_OK(Jim_GetDouble(interp, Jim_ListGetIndex(interp, $obj, 0), &x));
__ENSURE_OK(Jim_GetDouble(interp, Jim_ListGetIndex(interp, $obj, 1), &y));
$argname = (vec2) { (float)x, (float)y };
}
}
$cc argtype vec3 {
vec3 $argname;
{
int $[set argname]_objc = Jim_ListLength(interp, $obj);
__ENSURE($[set argname]_objc == 3);
double x; double y; double z;
__ENSURE_OK(Jim_GetDouble(interp, Jim_ListGetIndex(interp, $obj, 0), &x));
__ENSURE_OK(Jim_GetDouble(interp, Jim_ListGetIndex(interp, $obj, 1), &y));
__ENSURE_OK(Jim_GetDouble(interp, Jim_ListGetIndex(interp, $obj, 2), &z));
$argname = (vec3) { (float)x, (float)y, (float)z };
}
}
$cc argtype vec4 {
vec4 $argname;
{
int $[set argname]_objc = Jim_ListLength(interp, $obj);
__ENSURE($[set argname]_objc == 4);
double x; double y; double z; double w;
__ENSURE_OK(Jim_GetDouble(interp, Jim_ListGetIndex(interp, $obj, 0), &x));
__ENSURE_OK(Jim_GetDouble(interp, Jim_ListGetIndex(interp, $obj, 1), &y));
__ENSURE_OK(Jim_GetDouble(interp, Jim_ListGetIndex(interp, $obj, 2), &z));
__ENSURE_OK(Jim_GetDouble(interp, Jim_ListGetIndex(interp, $obj, 3), &w));
$argname = (vec4) { (float)x, (float)y, (float)z, (float)w };
}
}
$cc argtype uvec4 {
uvec4 $argname;
{
int $[set argname]_objc = Jim_ListLength(interp, $obj);
__ENSURE($[set argname]_objc == 4);
jim_wide x; jim_wide y; jim_wide z; jim_wide w;
__ENSURE_OK(Jim_GetWide(interp, Jim_ListGetIndex(interp, $obj, 0), &x));
__ENSURE_OK(Jim_GetWide(interp, Jim_ListGetIndex(interp, $obj, 1), &y));
__ENSURE_OK(Jim_GetWide(interp, Jim_ListGetIndex(interp, $obj, 2), &z));
__ENSURE_OK(Jim_GetWide(interp, Jim_ListGetIndex(interp, $obj, 3), &w));
$argname = (uvec4) { (uint32_t)x, (uint32_t)y, (uint32_t)z, (uint32_t)w };
}
}
# Note that we take matrices from Tcl in ROW-MAJOR form and
# convert them to column-major form inline here.
$cc argtype mat3 {
mat3 $argname;
{
int $[set argname]_objc = Jim_ListLength(interp, $obj);
__ENSURE($[set argname]_objc == 3);
for (int y = 0; y < 3; y++) {
Jim_Obj* rowObj = Jim_ListGetIndex(interp, $obj, y);
__ENSURE(Jim_ListLength(interp, rowObj) == 3);
for (int x = 0; x < 3; x++) {
double el;
__ENSURE_OK(Jim_GetDouble(interp, Jim_ListGetIndex(interp, rowObj, x), &el));

int i = x * 4 + y;
$argname.data[i] = el;
}
}
}
}
$cc code [csubst {
typedef struct Args {
$[join [lmap {argtype argname} $pushConstants {
set alignas [expr {$argtype eq "mat3" ? "16" : "sizeof($argtype)"}]
subst {_Alignas($alignas) $argtype $argname;}
}] "\n"]
} Args;

typedef struct PushConstantsEncoder {
int (*encode)(Jim_Interp* interp, Jim_Obj* obj, uint8_t out[128]);
} PushConstantsEncoder;

static uint8_t argsBuf[128];
}]
$cc include <stddef.h>
$cc proc getArgsSize {} int { return sizeof(Args); }
$cc proc encodeArgs $pushConstants void {
Args args = {$[join [lmap {argtype argname} $pushConstants { subst {.$argname = $argname} }] " ,"]};
memcpy(argsBuf, &args, sizeof(args));
}
# This is what gets saved as the PushConstantsEncoder and
# called at draw time.
$cc proc encodeObj {Jim_Interp* interp Jim_Obj* obj uint8_t* out} int {
int objc = Jim_ListLength(interp, obj);
Jim_Obj* objv[1 + objc];
for (int i = 0; i < objc; i++) {
objv[1 + i] = Jim_ListGetIndex(interp, obj, i);
}

int ret = encodeArgs_Cmd(interp, 1 + objc, objv);
if (ret != JIM_OK) {
// You CANNOT use FOLK_ENSURE here, because this is
// passed as function pointer and does not capture the
// correct jmp_buf for the caller.
return -1;
}

memcpy(out, argsBuf, sizeof(Args));
return sizeof(Args);
}
$cc proc makeEncoder {} PushConstantsEncoder* {
PushConstantsEncoder* encoder = malloc(sizeof(PushConstantsEncoder));
encoder->encode = encodeObj;
return encoder;
}
set encoderLib [$cc compile]

set encodePushConstants [$encoderLib makeEncoder]
set pushConstantsSize [$encoderLib getArgsSize]

set pushConstantsCode [if {[llength $pushConstants] > 0} {
subst {
layout(push_constant) uniform Args {
[join [lmap {argtype argname} $pushConstants {
if {$argname eq "_"} continue
if {$argtype eq "sampler2D"} {
expr {"int $argname;"}
} else {
expr {"$argtype $argname;"}
}
}] "\n"]
} args;
}
}]

set vertShaderModule [$pipelineLib createShaderModule [glslc -fshader-stage=vert [csubst {
#version 450

$pushConstantsCode

$[join [lmap {fnName fn} $vertFnDict {
lassign $fn fnArgs _ fnRtype fnBody
subst {
$fnRtype $fnName ([join [lmap {fnArgtype fnArgname} $fnArgs {subst {$fnArgtype $fnArgname}}] ", "]) {
$fnBody
}
}
}] "\n"]

vec4 vert() {
$[join [lmap {argtype argname} $pushConstants {
if {$argname eq "_"} continue
if {$argtype eq "sampler2D"} continue
expr {"$argtype $argname = args.$argname;"}
}] " "]
$vertBody
}

void main() {
gl_Position = vert();
}
}]]]
# We pass the descriptor set with all textures (samplers) to all
# fragment shaders, so we never need to rebind it (at draw
# time, the shader may get an index into the array if it's
# meant to draw an texture).
#
# Note that we have individual combined image+samplers,
# instead of 1 global sampler and multiple images/textures,
# because that's the only way to allow each texture to have
# its own dimensions (dimensions are a property bound to the
# sampler).
#
# We have a whole code path basically just to handle v3dv
# (Raspberry Pi GPU), which doesn't support dynamic indexing
# (based on push constant) into the descriptor array. On GPUs
# like that, we manually emit an if ladder that checks each
# possible value of the push constant and uses the right
# statically-indexed descriptor.
set gpuSupportsDynamicIndexing [$gpuLib getDoesSupportShaderSampledImageArrayDynamicIndexing]
set fragShaderModule [$pipelineLib createShaderModule [glslc -fshader-stage=frag [csubst {
#version 450

layout(set = 0, binding = 0) uniform sampler2D _samplers[$[$gpuLib getMaxTextures]];

$pushConstantsCode

layout(location = 0) out vec4 outColor;

$[join [lmap {fnName fn} $fragFnDict {
lassign $fn fnArgs _ fnRtype fnBody
subst {
$fnRtype $fnName ([join [lmap {fnArgtype fnArgname} $fnArgs {subst {$fnArgtype $fnArgname}}] ", "]) {
$fnBody
}
}
}] "\n"]

vec4 frag($[join [lmap {argtype argname} $pushConstants {
if {$argname eq "_"} continue
expr {"$argtype $argname"}
}] ", "]) {
$fragBody
}

$[eval {
set samplerIdxs [lsearch -all -exact $pushConstants sampler2D]
proc emitFragInvocation {gpuSupportsDynamicIndexing pushConstants} { subst {
vec4 rawColor = frag([join [lmap {argtype argname} $pushConstants {
if {$argname eq "_"} continue
if {$argtype eq "sampler2D"} {
if {$gpuSupportsDynamicIndexing} {
expr {"_samplers\[args.$argname\]"}
} else {
# This should have been patched to a
# static expression like
# `_samplers[3]` by the caller.
expr {"$argname"}
}
} else {
expr {"args.$argname"}
}
}] ", "]);

// Premultiply the RGB
outColor = vec4(rawColor.rgb * rawColor.a, rawColor.a);
}}
list
}]
void main() {
$[if {$gpuSupportsDynamicIndexing || [llength $samplerIdxs] == 0} {
emitFragInvocation $gpuSupportsDynamicIndexing $pushConstants

} elseif {[llength $samplerIdxs] == 1} {
set samplerIdx [+ [lindex $samplerIdxs 0] 1]
set samplerName [lindex $pushConstants $samplerIdx]
set maxTextures [$gpuLib getMaxTextures]
set xs [list]
for {set i 0} {$i < $maxTextures} {incr i} {
set patchedPushConstants [lreplace $pushConstants $samplerIdx $samplerIdx \
_samplers\[$i\]]
lappend xs [subst {
[expr {$i == 0 ? "if" : "else if"}] (args.$samplerName == $i) {
[emitFragInvocation $gpuSupportsDynamicIndexing $patchedPushConstants]
}
}]
}
join $xs "\n"
} else {
error "display: Cannot currently compile a shader that has more than 1 sampler2D parameter on this GPU."
}]
}
}]]]

# pipeline needs to contain a specification of push constants,
# so they can be filled in at draw time.
set pipeline [$pipelineLib createPipeline \
$vertShaderModule $fragShaderModule \
$encodePushConstants \
$pushConstantsSize]
return $pipeline
}

proc glslc {args} {
set cmdargs [lreplace $args end end]
set glsl [lindex $args end]
set glslfile [file tempfile /tmp/glslfileXXXXXX].glsl
set glslfd [open $glslfile w]; puts $glslfd $glsl; close $glslfd
split [string map {\n ""} [exec glslc {*}$cmdargs -mfmt=num -o - $glslfile]] ","
}
}] }

set drawLib [$cc compile]
Expand Down Expand Up @@ -906,7 +554,7 @@ fn QueryAllFns! {} {
fn tryCompileFn {wisher name source} {
try {
set fns [QueryAllFns!]
set fn [$gpu fn $fns {*}$source]
set fn [$pipelineCompilerLib fn $fns {*}$source]

# Technically a misnomer: the function is just stored, not
# compiled until it's been inlined into a shader.
Expand All @@ -926,7 +574,7 @@ fn tryCompileFn {wisher name source} {
fn tryCompilePipeline {wisher name source} {
try {
set fns [QueryAllFns!]
set pipeline [$gpu pipeline $fns {*}$source]
set pipeline [$pipelineCompilerLib pipeline $fns {*}$source]

puts "gpu: tryCompilePipeline: Compiled $name"
Claim the GPU compiles pipeline $name to $pipeline
Expand Down
Loading