Capstone: an interactive modeller#
A small modelling program you can run. It opens a window on a floor with three objects standing on it; you orbit the camera by dragging, click an object to select it, and change it from the keyboard: extrude the face you clicked, subdivide, scale, turn, move, add and delete. W saves the scene as an OBJ file and reads it straight back to prove the file is sound.
Almost nothing in it is new. The meshes come from meshes and modelling-operations, the camera and the picking from scene-graphs, the file format from model-formats, and the drawing is the lit, depth-tested pipeline of the GPU scene chapter, shader included. What this chapter adds is the part that joins them: one mesh representation that the operations edit, the picker searches, the card draws and the writer saves.
A session, with the terminal beside the window:
added cube1 12 triangles 8 vertices volume 1.0000
added prism2 20 triangles 12 vertices volume 0.8660
added sphere3 128 triangles 66 vertices volume 0.4772
selected cube1 (triangle 0)
extruded cube1 20 triangles 12 vertices volume 1.5000
extruded cube1 28 triangles 16 vertices volume 2.0000
selected sphere3 (triangle 9)
subdivided sphere3 512 triangles 258 vertices volume 0.5115
scaled sphere3 512 triangles 258 vertices volume 0.9989
added prism4 20 triangles 12 vertices volume 0.8660
wrote model.obj: 298 vertices, 580 triangles, volume 4.7310
read model.obj: 298 vertices, 580 triangles, volume 4.7310 ok
Every operation prints the object’s volume, using the signed_volume test from meshes. That is the modelling chapter’s rule carried into an interactive program: a closed mesh has a volume you can predict, and an operation that breaks the mesh shows up as a number that is wrong.
Controls#
Input | Effect |
|---|---|
left click | select the object under the pointer, and remember which face was hit |
left drag | orbit the camera |
right drag | zoom: down moves the camera away, up brings it closer |
| zoom out, zoom in |
| add a cube, a hexagonal prism, a sphere |
| extrude the clicked face outward by 0.5 |
| subdivide the selection |
| scale the selection by 0.8, by 1.25 |
| turn the selection 15 degrees |
arrow keys | move the selection 0.25 across the floor |
| orbit around the selection instead of the origin |
| remove the selection |
| write |
| save the current view as |
| quit |
One mesh, four users#
Each object keeps its geometry as the indexed triangle mesh: an array of positions and a flat list of indices, three per triangle, wound counter-clockwise seen from outside. The operations change that mesh in place; the picker tests rays against it; the writer prints it; and a vertex buffer made from it is what the card draws. Where the object sits in the world is kept apart from the mesh, as a position, a turn about y and a uniform scale, combined into a model matrix when needed.
The program starts with the same header as the GPU scene chapter, and the same foundations.pl beside it holding the vector and matrix subs from foundations, followed by a line 1;:
use strict;
use warnings;
use SDL2 qw(:all);
use Peta::WebGPU;
use SDL2::Image;
BEGIN { require './foundations.pl' } # the v_* and m_* subs, then 1;
my $max_frames = shift // 0; # 0: run until the window is closed
my $PI = 4 * atan2(1, 1);
use SDL2 qw(:all), not a later import, for the reason the device chapter spent a section on: every SDL_* constant below must exist while the file is compiled.
Building shapes#
Three routines come from earlier chapters. extrude is modelling-operations’ unchanged. subdivide is that chapter’s subdivision written out whole, with the midpoint cache it insists on, and with the sphere projection made optional. signed_volume is the meshes winding check.
# modelling-operations: a convex polygon in the xy plane, counter-clockwise
# seen from +z, swept along +z by $h and capped at both ends.
sub extrude {
my ($poly, $h) = @_;
my $n = @$poly;
# The outer parens are load-bearing: `my @v = (A), (B)` parses as
# `(my @v = A), B` and silently stores only the first list.
my @v = ( (map { [ $_->[0], $_->[1], 0 ] } @$poly),
(map { [ $_->[0], $_->[1], $h ] } @$poly) );
my @i;
# top cap: fan over the upper ring, already CCW seen from +z
push @i, ($n, $n + $_, $n + $_ + 1) for 1 .. $n - 2;
# bottom cap: same fan reversed, so it faces -z
push @i, (0, $_ + 1, $_) for 1 .. $n - 2;
# sides: one quad per edge, wound outward
for my $e (0 .. $n - 1) {
my $f = ($e + 1) % $n;
push @i, ($e, $f, $n + $f), ($e, $n + $f, $n + $e);
}
return (\@v, \@i);
}
# modelling-operations: split every triangle into four at its edge
# midpoints. With $radius, each new vertex is pushed out onto the sphere
# of that radius. The mesh is changed in place.
sub subdivide {
my ($v, $i, $radius) = @_;
my %mid;
my $midpoint = sub {
my ($a, $b) = @_;
# Cache by edge: the two triangles sharing it must get ONE vertex.
my $key = $a < $b ? "$a,$b" : "$b,$a";
return $mid{$key} //= do {
my $m = v_scale(v_add($v->[$a], $v->[$b]), 0.5);
$m = v_scale(v_norm($m), $radius) if $radius;
push @$v, $m;
$#$v;
};
};
my @ni;
for (my $k = 0; $k < @$i; $k += 3) {
my ($a, $b, $c) = @{$i}[$k, $k + 1, $k + 2];
my $ab = $midpoint->($a, $b);
my $bc = $midpoint->($b, $c);
my $ca = $midpoint->($c, $a);
push @ni, ($a,$ab,$ca), ($ab,$b,$bc), ($ca,$bc,$c), ($ab,$bc,$ca);
}
@$i = @ni;
}
# meshes: the enclosed volume of a closed mesh, positive when every
# triangle winds counter-clockwise seen from outside.
sub signed_volume {
my ($v, $i) = @_;
my $vol = 0;
for (my $k = 0; $k < @$i; $k += 3) {
my ($a, $b, $c) = @{$v}[ @{$i}[$k, $k+1, $k+2] ];
$vol += v_dot($a, v_cross($b, $c)) / 6;
}
return $vol;
}
The primitives are built from those. A cube is a square extruded, exactly as modelling-operations showed; a hexagonal prism is a hexagon extruded; a sphere is an octahedron subdivided twice with every new vertex pushed onto the sphere.
# A prism of unit height whose cross-section has an apothem of 0.5, so
# four sides make the unit cube. Centred on the origin, standing on y.
sub prism {
my ($sides) = @_;
my $r = 0.5 / cos($PI / $sides);
my @poly = map { my $t = 2 * $PI * ($_ + 0.5) / $sides; [ $r * cos $t, $r * sin $t ] }
0 .. $sides - 1;
my ($v, $i) = extrude(\@poly, 1);
# (x, y, z) -> (x, z, -y) is a rotation, so the winding survives it.
return ([ map { [ $_->[0], $_->[2] - 0.5, -$_->[1] ] } @$v ], $i);
}
sub sphere {
my ($r, $levels) = @_;
my @v = ([$r,0,0], [-$r,0,0], [0,$r,0], [0,-$r,0], [0,0,$r], [0,0,-$r]);
my @i = (0,2,4, 2,1,4, 1,3,4, 3,0,4, 2,0,5, 1,2,5, 3,1,5, 0,3,5);
subdivide(\@v, \@i, $r) for 1 .. $levels;
return (\@v, \@i);
}
extrude sweeps along z, and a modeller wants its objects standing on a floor with y up, so prism turns the result over. The turn must be a rotation, not a swap of two axes. Swapping y and z is a reflection, and a reflection reverses every triangle’s winding, the fact the GPU scene chapter met as a model rendering inside out. Mapping (x, y, z) to (x, z, -y) is a quarter turn about x, and the volume check confirms it: the cube reports 1.0000, not -1.0000.
The numbers the program starts with are the analytic ones: the unit cube’s 1, the hexagonal prism’s sqrt(3)/2 = 0.8660, and the level-2 sphere’s 0.4772, which is modelling-operations’ 3.81773 for a unit sphere scaled by 0.5 ** 3.
The window and the pipeline#
The window, the device, the surface and the shader are the GPU scene chapter’s, unchanged. The shader lights each pixel with shading’s model and reads each instance’s model matrix and colour from a storage buffer.
my $win = SDL2::Window->new(title => 'pperl modeller', w => 800, h => 600, resizable => 1);
my $gpu = Peta::WebGPU::Device->new(window => $win);
my $surf = $gpu->surface;
my ($W, $H) = $surf->size;
my $WGSL = <<'WGSL';
struct Scene {
view_proj: mat4x4<f32>,
light_dir: vec4<f32>, // xyz: toward the light, world space
eye: vec4<f32>, // xyz: camera position, world space
};
struct Instance {
model: mat4x4<f32>,
colour: vec4<f32>,
};
@group(0) @binding(0) var<uniform> scene: Scene;
@group(0) @binding(1) var<storage, read> inst: array<Instance>;
struct VOut {
@builtin(position) pos: vec4<f32>,
@location(0) world: vec3<f32>,
@location(1) normal: vec3<f32>,
@location(2) colour: vec3<f32>,
};
@vertex
fn vs(@location(0) p: vec3<f32>, @location(1) n: vec3<f32>,
@builtin(instance_index) i: u32) -> VOut {
let m = inst[i].model;
let w = m * vec4<f32>(p, 1.0);
var o: VOut;
o.pos = scene.view_proj * w;
o.world = w.xyz;
o.normal = (m * vec4<f32>(n, 0.0)).xyz;
o.colour = inst[i].colour.rgb;
return o;
}
@fragment
fn fs(v: VOut) -> @location(0) vec4<f32> {
let n = normalize(v.normal);
let l = normalize(scene.light_dir.xyz);
let e = normalize(scene.eye.xyz - v.world);
let lambert = max(dot(n, l), 0.0);
let h = normalize(l + e);
let spec = pow(max(dot(n, h), 0.0), 32.0);
let c = v.colour * (0.1 + 0.9 * lambert) + vec3<f32>(0.4) * spec;
return vec4<f32>(min(c, vec3<f32>(1.0)), 1.0);
}
WGSL
my $pipe = $gpu->render_pipeline($gpu->shader($WGSL),
format => $surf->format, depth => 1, cull => 'back',
vertex_buffers => [ { attributes => ['float32x3', 'float32x3'] } ]);
my $depth = $gpu->depth_buffer($W, $H);
my $scene = $gpu->uniform_buffer(24 * 4);
The shader turns normals with the model matrix, which the GPU scene chapter showed is correct only for rotation, translation and uniform scale. That is why [ and ] scale all three axes together: a non-uniform scale would need the inverse-transpose matrix passed alongside, and without it the lighting of a stretched object would be quietly wrong.
Flat faces, and the floor as instances#
The meshes share vertices between triangles, which the operations need: an extruded face must drag its neighbours’ corners with it. The card needs the opposite. A modeller shows its faces flat, so each triangle is lit by its own normal, and a vertex carries one normal, so a corner shared by several faces has to become several vertices. That is the meshes chapter’s cube with 24 vertices instead of 8, taken to its end: every triangle gets three vertices of its own.
# Flat shading: each triangle gets its own three vertices carrying the
# face normal, so nothing is shared and there is no index buffer.
sub flat_vertices {
my ($v, $i) = @_;
my @data;
for (my $k = 0; $k < @$i; $k += 3) {
my ($a, $b, $c) = @{$v}[ @{$i}[$k, $k+1, $k+2] ];
my $n = v_norm(v_cross(v_sub($b, $a), v_sub($c, $a)));
push @data, @$a, @$n, @$b, @$n, @$c, @$n;
}
return $gpu->vertex_buffer(pack 'f*', @data);
}
sub srgb_decode { return [ map { $_ ** 2.2 } @_ ] } # colours picked by eye
# The floor: one quad, drawn 400 times by instancing, as a checkerboard.
my $TILES = 20;
my $floor_quad = flat_vertices([[-0.5,0,0.5], [0.5,0,0.5], [0.5,0,-0.5], [-0.5,0,-0.5]],
[0, 1, 2, 0, 2, 3]);
my @TILE_COLOUR = (srgb_decode(0.30, 0.30, 0.33), srgb_decode(0.38, 0.38, 0.41));
my @tiles;
for my $k (0 .. $TILES * $TILES - 1) {
my ($tx, $tz) = ($k % $TILES, int($k / $TILES));
push @tiles, @{ m_translate($tx - $TILES / 2 + 0.5, 0, $tz - $TILES / 2 + 0.5) },
@{ $TILE_COLOUR[($tx + $tz) % 2] }, 1;
}
my $floor = $gpu->storage_buffer(pack 'f*', @tiles);
With nothing shared, an index buffer would only count 0, 1, 2, ..., so the objects are drawn with draw, not draw_indexed.
Flat shading is also what makes the operations visible: a subdivided sphere shows its new, smaller facets at once.
Instancing is used where one mesh repeats, and in this program that is the floor: one quad and 400 instances, each a translation and one of two greys, drawn by a single draw(6, 400). The storage buffer has the layout the shader’s Instance expects, 20 floats each, as in the GPU scene chapter. The objects are the opposite case, each with its own mesh, so each is one draw with its own one-instance buffer, and the same shader serves both.
The colours are picked by eye and decoded with the power 2.2, because the window’s surface is an sRGB format, as the device chapter measured.
Objects#
my %COLOUR = (cube => srgb_decode(0.55, 0.65, 0.80),
prism => srgb_decode(0.60, 0.78, 0.55),
sphere => srgb_decode(0.85, 0.80, 0.60));
my $HIGHLIGHT = srgb_decode(1.00, 0.55, 0.10);
my (@objects, $sel, $sel_tri);
my $serial = 0;
sub model_matrix {
my ($o) = @_;
# Read right to left: scale, then turn, then place.
return m_mul(m_translate(@{ $o->{pos} }),
m_mul(m_rotate_y($o->{yaw}), m_scale(($o->{scale}) x 3)));
}
# Rebuild what the card and the picker hold after the mesh changed.
sub refresh {
my ($o) = @_;
my ($v, $i) = @{ $o->{mesh} }{qw(v i)};
$o->{vb} = flat_vertices($v, $i);
$o->{count} = @$i;
# Bounding sphere in object space: the box's centre, the farthest vertex.
my @lo = @{ $v->[0] };
my @hi = @lo;
for my $p (@$v) {
for (0 .. 2) {
$lo[$_] = $p->[$_] if $p->[$_] < $lo[$_];
$hi[$_] = $p->[$_] if $p->[$_] > $hi[$_];
}
}
$o->{centre} = v_scale(v_add(\@lo, \@hi), 0.5);
$o->{radius} = 0;
for my $p (@$v) {
my $d = v_len(v_sub($p, $o->{centre}));
$o->{radius} = $d if $d > $o->{radius};
}
}
sub report {
my ($what, $o) = @_;
my ($v, $i) = @{ $o->{mesh} }{qw(v i)};
printf "%-10s %-8s %4d triangles %4d vertices volume %.4f\n", $what, $o->{name},
@$i / 3, scalar @$v, signed_volume($v, $i) * $o->{scale} ** 3;
}
sub add_object {
my ($kind) = @_;
my ($v, $i) = $kind eq 'cube' ? prism(4)
: $kind eq 'prism' ? prism(6)
: sphere(0.5, 2);
my $n = $serial++;
my $o = { name => $kind . ($n + 1), mesh => { v => $v, i => $i },
pos => [ 1.6 * ($n % 5 - 1), 0.5, -1.6 * int($n / 5) ],
yaw => 0, scale => 1, colour => $COLOUR{$kind},
round => $kind eq 'sphere',
inst => $gpu->storage_buffer(20 * 4) };
refresh($o);
push @objects, $o;
($sel, $sel_tri) = ($o, undef);
report('added', $o);
}
model_matrix is the foundations order rule applied once: T * R * S scales first, then turns, then places, so an object turns about its own centre wherever it stands. Written R * T * S it would swing round the origin instead.
refresh is the one place a mesh change is made visible. It rebuilds the vertex buffer and recomputes the bounding sphere the picker tests first, the meshes chapter’s cheap approximation. Every operation calls it; forgetting to is the bug where the picture and the clicks disagree.
The volume report prints is multiplied by the cube of the scale, because signed_volume measures the mesh in its own space and the scale lives in the model matrix.
New objects are placed along a row of slots so they do not appear inside one another, and each new object becomes the selection.
The camera#
The orbit camera from scene-graphs, unchanged, and the per-frame upload of the GPU scene chapter:
my $TARGET = [0, 0.5, 0];
my ($yaw, $pitch, $dist) = (0.6, 0.45, 7);
my $FOVY = 45;
my $GL_TO_WGPU = [1,0,0,0, 0,1,0,0, 0,0,0.5,0, 0,0,0.5,1];
# scene-graphs: two angles and a distance around a target.
sub orbit_eye {
# $yaw and $pitch in radians, $dist from the target. Clamp pitch
# short of +/- 90 degrees: at exactly vertical the view direction
# is parallel to `up` and look_at degenerates.
my ($target, $yaw, $pitch, $dist) = @_;
return [ $target->[0] + $dist * cos($pitch) * sin($yaw),
$target->[1] + $dist * sin($pitch),
$target->[2] + $dist * cos($pitch) * cos($yaw) ];
}
sub upload {
my $eye = orbit_eye($TARGET, $yaw, $pitch, $dist);
my $proj = m_mul($GL_TO_WGPU, m_perspective($FOVY, $W / $H, 0.1, 100));
my $vp = m_mul($proj, m_look_at($eye, $TARGET, [0, 1, 0]));
# The light orbits with the camera, high and off to one side, so the
# faces in view are always lit and a box's three show three shades.
my $light = v_sub(orbit_eye($TARGET, $yaw + 0.7, 1.0, 1), $TARGET);
$scene->write(pack 'f*', @$vp, @$light, 0, @$eye, 1);
for my $o (@objects) {
my $colour = $sel && $o == $sel ? $HIGHLIGHT : $o->{colour};
$o->{inst}->write(pack 'f*', @{ model_matrix($o) }, @$colour, 1);
}
}
sub draw {
my ($target) = @_;
my $pass = $gpu->render_pass($target, clear => [0.05, 0.05, 0.08, 1], depth => $depth)
->pipeline($pipe);
$pass->bind([$scene, $floor])->vertices($floor_quad)->draw(6, $TILES * $TILES);
$pass->bind([$scene, $_->{inst}])->vertices($_->{vb})->draw($_->{count}) for @objects;
$pass->end;
}
$GL_TO_WGPU is the depth-range conversion from the GPU scene chapter; without it the near half of the view volume is clipped away and anything close to the camera vanishes.
The light is placed with the same orbit_eye, 0.7 radians round from the camera and 1 radian up, at distance 1, so subtracting the target leaves a unit vector. A light fixed in the world leaves the far side of every object at the ambient level once you orbit round to it. This one moves with the camera, so the faces in view are always lit, and because it stands off to one side and above, a box’s three visible faces get three different Lambert terms: from the starting view, 0.84 for the top, 0.52 for the side facing +x and 0.14 for the side facing +z.
The selection is a colour, nothing more. upload writes each object’s instance buffer every frame, and the selected object’s gets the highlight instead of its own colour. The mesh and the pipeline are untouched, so selecting costs one 80-byte write.
Every object has its own instance buffer and binds it before its own draw. One buffer rewritten between draws would put every object where the last one is, the symptom the GPU scene chapter measured.
draw takes its target as an argument, so the same routine draws into a frame for the window and into a texture for a screenshot.
Clicking on an object#
A click becomes a ray through the pixel, exactly as scene-graphs builds it, and the ray is tested against every object’s bounding sphere, then against the triangles of the objects whose sphere it passes through. pick_ray and ray_sphere are that chapter’s, unchanged; tan_half is the tangent of half the vertical field of view, given in degrees as m_perspective takes it.
# scene-graphs: a ray through the centre of pixel ($sx, $sy).
sub tan_half { my $h = $_[0] * $PI / 360; return sin($h) / cos($h) }
sub pick_ray {
my ($eye, $target, $up, $fovy, $aspect, $sx, $sy, $W, $H) = @_;
my $f = v_norm(v_sub($target, $eye));
my $s = v_norm(v_cross($f, $up));
my $u = v_cross($s, $f);
my $ndc_x = 2 * ($sx + 0.5) / $W - 1;
my $ndc_y = 1 - 2 * ($sy + 0.5) / $H; # screen y is down
my $th = tan_half($fovy);
my @d = map {
$f->[$_] + $s->[$_] * $ndc_x * $th * $aspect + $u->[$_] * $ndc_y * $th
} 0..2;
return ($eye, v_norm(\@d));
}
sub ray_sphere {
# Returns the near intersection distance, or undef. $d MUST be
# normalised or $t is in units of $d's length rather than distance.
my ($o, $d, $c, $r) = @_;
my $oc = v_sub($o, $c);
my $b = 2 * v_dot($oc, $d);
my $cc = v_dot($oc, $oc) - $r * $r;
my $disc = $b*$b - 4*$cc;
return undef if $disc < 0;
my $t = (-$b - sqrt($disc)) / 2;
return $t > 0 ? $t : undef;
}
# Möller-Trumbore: the distance along the ray to triangle ($a, $b, $c),
# or undef. Both sides count; the nearest hit decides.
sub ray_triangle {
my ($o, $d, $a, $b, $c) = @_;
my $e1 = v_sub($b, $a);
my $e2 = v_sub($c, $a);
my $p = v_cross($d, $e2);
my $det = v_dot($e1, $p);
return undef if abs($det) < 1e-12; # ray parallel to the plane
my $s = v_sub($o, $a);
my $u = v_dot($s, $p) / $det;
return undef if $u < 0 || $u > 1;
my $q = v_cross($s, $e1);
my $w = v_dot($d, $q) / $det;
return undef if $w < 0 || $u + $w > 1;
my $t = v_dot($e2, $q) / $det;
return $t > 1e-9 ? $t : undef;
}
ray_triangle is the Möller-Trumbore test that modelling-operations named and left elided. It solves for the hit distance t and the barycentric weights u and w at once; the ray hits the triangle when both weights and their sum lie between 0 and 1, the same inside test the rasteriser applies to a pixel centre.
The picker needs the triangle, not only the object. Extrude acts on the face you clicked, and which face that was is exactly what the nearest triangle hit says. That is why picking runs here in Perl against the very meshes the operations edit.
sub pick {
my ($sx, $sy) = @_;
my ($o, $d) = pick_ray(orbit_eye($TARGET, $yaw, $pitch, $dist), $TARGET, [0, 1, 0],
$FOVY, $W / $H, $sx, $sy, $W, $H);
my ($best, $best_t, $best_tri);
# The floor is drawn, so it hides whatever is below it. It is not
# selectable, but a ray that reaches it first has hit nothing.
if ($o->[1] > 0 && $d->[1] < 0) {
my $t = -$o->[1] / $d->[1];
$best_t = $t if abs($o->[0] + $t * $d->[0]) <= $TILES / 2
&& abs($o->[2] + $t * $d->[2]) <= $TILES / 2;
}
for my $obj (@objects) {
my $m = model_matrix($obj);
my $c = [ @{ xform($m, [ @{ $obj->{centre} }, 1 ]) }[0 .. 2] ];
my $r = $obj->{radius} * $obj->{scale};
# Bounding sphere first. ray_sphere ignores hits behind the eye,
# so an eye INSIDE the sphere must skip the test, not fail it.
next unless v_len(v_sub($o, $c)) < $r || defined ray_sphere($o, $d, $c, $r);
my @w = map { [ @{ xform($m, [ @$_, 1 ]) }[0 .. 2] ] } @{ $obj->{mesh}{v} };
my $i = $obj->{mesh}{i};
for (my $k = 0; $k < @$i; $k += 3) {
my $t = ray_triangle($o, $d, @w[ @{$i}[$k, $k+1, $k+2] ]) // next;
($best, $best_t, $best_tri) = ($obj, $t, $k / 3)
if !defined $best_t || $t < $best_t;
}
}
return ($best, $best_tri);
}
The ray is built from the same eye, target, field of view and aspect ratio that upload gives the card, so the ray through a pixel is the line of sight the card rendered through it. That is checkable. Rendering each object alone into a texture shows which objects cover each pixel; rendering all of them shows which one is in front. Over a grid of 30000 pixels of the session above, the picker returned nothing wherever no object was drawn, and the front object wherever one was. From a view along the row, 669 of 13400 sampled pixels showed two or more objects overlapping, and it returned the front one at every one of them.
Symptom: clicking the floor beside an object selects the object. Cause: the picker ignores something the renderer draws. The sphere scaled up about its centre sinks below the floor; the floor hides that part, but a ray that passes through the floor still reaches it. Without the floor test above, 3 of those 30000 pixels pick the sphere where the frame shows only floor. The rule is general: the picker must test everything that is drawn, even what cannot be selected, because what cannot be selected can still be in the way. Below the floor the test does not apply, because from there the floor is a back face and culled.
Symptom: an object cannot be clicked once the camera is close to it. Cause: the eye is inside the object’s bounding sphere, where ray_sphere answers undef because its only hit is behind the eye. That check is right for the question scene-graphs asked, which was where a ray first meets a sphere; the bounding test asks a different one, whether the ray can reach anything inside. A prism scaled five times and orbited from 2 units away put the eye 2.000 from the centre of a sphere of radius 2.331: ray_sphere said undef, and pick still found the prism.
For a handful of objects the linear loop over objects is fine; a scene of thousands would put the bounding spheres into the BVH that chapter builds.
Push and pull: extruding a face#
Modelling-operations’ extrude sweeps a polygon into a solid. A modeller needs the same operation applied to a face of a solid that already exists, which is the push/pull that chapter called the most useful operation in the set.
A click hits one triangle, but a face of a cube is two triangles, and of a subdivided cube eight. The face the click means is the hit triangle and everything connected to it across shared edges that lies in the same plane:
sub tri_normal {
my ($v, $i, $t) = @_;
my ($a, $b, $c) = @{$v}[ @{$i}[3 * $t .. 3 * $t + 2] ];
return v_norm(v_cross(v_sub($b, $a), v_sub($c, $a)));
}
# The face a click means: the hit triangle and every triangle reachable
# from it across shared edges that lies in the same plane.
sub face_of {
my ($v, $i, $t0) = @_;
my $edges_of = sub { # triangle $t's three undirected edges
my @c = @{$i}[3 * $_[0] .. 3 * $_[0] + 2];
return map { my ($p, $q) = ($c[$_], $c[($_ + 1) % 3]); $p < $q ? "$p,$q" : "$q,$p" } 0 .. 2;
};
my %by_edge;
for my $t (0 .. @$i / 3 - 1) { push @{ $by_edge{$_} }, $t for $edges_of->($t) }
my $n = tri_normal($v, $i, $t0);
my %in = ($t0 => 1);
my @todo = ($t0);
while (defined(my $t = shift @todo)) {
for my $u (map { @{ $by_edge{$_} } } $edges_of->($t)) {
next if $in{$u} || v_dot(tri_normal($v, $i, $u), $n) < 1 - 1e-9;
$in{$u} = 1;
push @todo, $u;
}
}
return sort { $a <=> $b } keys %in;
}
# Push/pull: move a face along its normal and wall in the gap. The face's
# triangles are re-pointed at moved copies of its vertices; every boundary
# edge a->b gains the quad a, b, b', a', wound like extrude's sides.
sub extrude_face {
my ($o, $t0, $h) = @_;
my ($v, $i) = @{ $o->{mesh} }{qw(v i)};
my @face = face_of($v, $i, $t0);
my $n = tri_normal($v, $i, $t0);
my (@edges, %directed);
for my $t (@face) {
my @c = @{$i}[3 * $t .. 3 * $t + 2];
for (0 .. 2) {
push @edges, [ $c[$_], $c[($_ + 1) % 3] ];
$directed{"$c[$_],$c[($_ + 1) % 3]"} = 1;
}
}
my %moved;
for my $t (@face) {
for my $k (3 * $t .. 3 * $t + 2) {
my $old = $i->[$k];
$moved{$old} //= do { push @$v, v_add($v->[$old], v_scale($n, $h)); $#$v };
$i->[$k] = $moved{$old};
}
}
for my $e (@edges) {
my ($a, $b) = @$e;
next if $directed{"$b,$a"}; # inside the face: both sides moved
push @$i, ($a, $b, $moved{$b}), ($a, $moved{$b}, $moved{$a});
}
$o->{round} = 0; # no longer a sphere to project onto
}
face_of is a flood fill over the edge adjacency that the meshes chapter says a half-edge structure keeps ready; here it is rebuilt from the index list on each call, which for a few hundred triangles is instant. The same-plane test compares normals, and connectivity across shared edges keeps two separate faces that happen to be parallel, such as the tops of two steps, apart.
The extrusion itself is the manifold invariant used as a recipe. An edge of the face whose reverse is also in the face is interior: both triangles beside it move, and nothing needs adding. An edge whose reverse is not in the face is boundary: the triangle beyond it stays behind, so the gap between the old edge and the moved one needs a wall. The wall quad takes the edge in the face’s own direction, a to b, because its neighbour beyond runs it b to a; along the top it runs b' to a', opposite to the moved face. Every shared edge is then traversed once each way, which is exactly the condition for a closed, consistently wound mesh. The same reasoning gives extrude’s side quads their order.
The numbers say whether it worked. The cube’s top is two triangles with four boundary edges, so an extrusion adds 4 vertices and 8 triangles and, at height 0.5, half a unit of volume:
extruded cube1 20 triangles 12 vertices volume 1.5000
extruded cube1 28 triangles 16 vertices volume 2.0000
The second E extrudes the same face again, because the face’s triangles keep their numbers when they move, so the remembered click still names them. On a subdivided cube the top is eight triangles and nine vertices, and one extrusion took it from 48 triangles and 26 vertices to 64 and 35, volume 1.0000 to 1.5000. Extruding a single triangle of the sphere grew its volume by 0.009508, which is that triangle’s area times 0.5 to the sixth decimal. After each of these, every edge of every mesh was shared by exactly two triangles and no directed edge occurred twice.
Subdividing is modelling-operations’ routine applied to the selection. A sphere keeps its round flag, so its new vertices go onto the sphere and it becomes rounder: D on the level-2 sphere gave 512 triangles, 258 vertices and volume 0.5115, modelling-operations’ level-3 4.09160 scaled by 0.5 ** 3. Any other object is split flat, adding triangles without changing its shape or its volume, which is the preparation for extruding a smaller face. Subdividing renumbers every triangle, so it forgets the clicked face; E then asks for a new click.
Saving to OBJ#
# model-formats: read_obj, unchanged.
sub read_obj {
my ($path) = @_;
open my $fh, '<', $path or die "$path: $!";
my (@v, @f);
while (my $line = <$fh>) {
next if $line =~ /^\s*(#|$)/;
my @tok = split ' ', $line;
my $kw = shift @tok;
if ($kw eq 'v') { push @v, [ @tok[0..2] ] }
elsif ($kw eq 'f') {
# A face may have MORE than three vertices. Fan-triangulate.
# Each token may be v, v/vt, v//vn or v/vt/vn: take the first.
my @vi = map { my ($n) = split m{/}, $_; $n } @tok;
# Indices are 1-based; a NEGATIVE index counts back from the
# current end of the vertex list.
@vi = map { $_ < 0 ? @v + $_ : $_ - 1 } @vi;
push @f, [ $vi[0], $vi[$_], $vi[$_ + 1] ] for 1 .. $#vi - 1;
}
}
close $fh;
return (\@v, \@f);
}
# model-formats' write_obj, for a whole scene: one `o` line per object,
# vertices baked into world space, face indices counted across the file.
sub save_obj {
my ($path) = @_;
open my $fh, '>', $path or die "$path: $!";
print $fh "# pperl modeller, ", scalar @objects, " objects\n";
my $base = 0;
for my $o (@objects) {
my $m = model_matrix($o);
my ($v, $i) = @{ $o->{mesh} }{qw(v i)};
print $fh "o $o->{name}\n";
printf $fh "v %.6f %.6f %.6f\n", @{ xform($m, [ @$_, 1 ]) }[0 .. 2] for @$v;
for (my $k = 0; $k < @$i; $k += 3) {
# OBJ indices are 1-BASED, and count every vertex written so far
printf $fh "f %d %d %d\n", map { $base + $_ + 1 } @{$i}[$k, $k+1, $k+2];
}
$base += @$v;
}
close $fh;
my ($nv, $nt, $vol) = (0, 0, 0);
for my $o (@objects) {
my ($v, $i) = @{ $o->{mesh} }{qw(v i)};
$nv += @$v;
$nt += @$i / 3;
$vol += signed_volume($v, $i) * $o->{scale} ** 3;
}
my ($rv, $rf) = read_obj($path);
my $rvol = signed_volume($rv, [ map { @$_ } @$rf ]);
printf "wrote %s: %d vertices, %d triangles, volume %.4f\n", $path, $nv, $nt, $vol;
printf "read %s: %d vertices, %d triangles, volume %.4f %s\n", $path,
scalar @$rv, scalar @$rf, $rvol,
(@$rv == $nv && @$rf == $nt && abs($rvol - $vol) < 1e-4 ? 'ok' : 'MISMATCH');
}
OBJ has no scene tree, as the model-formats table says, so each object’s model matrix is applied to its vertices on the way out and the file holds world positions. An o line names each object; readers that understand it keep the objects apart, and read_obj skips it like any other line it does not know.
Face indices count across the whole file, not per object. The second object’s first vertex is number 9 if the first object wrote 8, which is what $base carries. Restart the count per object and every object after the first is built from the first one’s vertices: the counts still match, and only the volume gives it away. That is why the check reads the file back with model-formats’ own reader and compares three numbers, not two. The volume of everything read back must equal the sum of the objects’ volumes, and it can only do so if every face refers to the vertices it was written with.
The session at the top wrote four objects in one file, 298 vertices and 580 triangles, and read back the same counts and the same volume, 4.7310.
Screenshots#
P renders the current view into a texture and writes it as a PNG: the checking path of the device chapter, in the program.
my $shots = 0;
sub screenshot {
my $tex = $gpu->texture(width => $W, height => $H, format => $surf->format);
upload();
draw($tex);
# read returns the texture's own byte order, B, G, R, A for a bgra
# format; the surface is told which, so nothing is swapped in Perl.
my $order = $surf->format =~ /^bgra/ ? SDL_PIXELFORMAT_BGRA32 : SDL_PIXELFORMAT_RGBA32;
my $file = sprintf 'shot%d.png', ++$shots;
SDL2::Image::save_png(SDL2::Surface->from_pixels($tex->read, $W, $H, $order), $file) == 0
or die "$file: ", SDL_GetError(), "\n";
print "saved $file\n";
}
The texture has the surface’s format, so the pipeline built for the window draws into it unchanged, and the depth buffer, already the window’s size, fits it. On the machine this was checked on that format is bgra8unorm-srgb, whose bytes come back as B, G, R, A. Rather than swap them in Perl, the surface is created with SDL_PIXELFORMAT_BGRA32, which names that byte order, and SDL2::Image writes the file.
The screenshot runs inside the frame loop, so it has to be quick. The device chapter’s save_png sets every pixel from Perl through GD, which is the right tool for checking an image once and the wrong one here: while it runs, the loop neither polls events nor presents frames, and the window stops responding until it finishes. Handing the whole buffer to SDL2::Image is one call.
Keys and the mouse#
The keyboard is a table from key to action:
sub with_selection {
my ($code) = @_;
return print "nothing selected\n" unless $sel;
$code->($sel);
}
my %KEY = (
SDLK_1() => sub { add_object('cube') },
SDLK_2() => sub { add_object('prism') },
SDLK_3() => sub { add_object('sphere') },
SDLK_e() => sub {
with_selection(sub {
return print "click a face of $_[0]{name} first\n" unless defined $sel_tri;
extrude_face($_[0], $sel_tri, 0.5);
refresh($_[0]);
report("extruded", $_[0]);
});
},
SDLK_d() => sub {
with_selection(sub {
subdivide($_[0]{mesh}{v}, $_[0]{mesh}{i}, $_[0]{round} ? 0.5 : undef);
$sel_tri = undef; # triangle numbers have changed
refresh($_[0]);
report("subdivided", $_[0]);
});
},
SDLK_RIGHTBRACKET() => sub { with_selection(sub { $_[0]{scale} *= 1.25; report('scaled', $_[0]) }) },
SDLK_LEFTBRACKET() => sub { with_selection(sub { $_[0]{scale} *= 0.8; report('scaled', $_[0]) }) },
SDLK_r() => sub { with_selection(sub { $_[0]{yaw} += $PI / 12 }) },
SDLK_LEFT() => sub { with_selection(sub { $_[0]{pos}[0] -= 0.25 }) },
SDLK_RIGHT() => sub { with_selection(sub { $_[0]{pos}[0] += 0.25 }) },
SDLK_UP() => sub { with_selection(sub { $_[0]{pos}[2] -= 0.25 }) },
SDLK_DOWN() => sub { with_selection(sub { $_[0]{pos}[2] += 0.25 }) },
SDLK_f() => sub { with_selection(sub { $TARGET = [ @{ $_[0]{pos} } ] }) },
SDLK_DELETE() => sub {
with_selection(sub {
@objects = grep { $_ != $_[0] } @objects;
print "deleted $_[0]{name}\n";
($sel, $sel_tri) = ();
});
},
SDLK_EQUALS() => sub { $dist = $dist * 0.8 < 2 ? 2 : $dist * 0.8 },
SDLK_MINUS() => sub { $dist = $dist * 1.25 > 40 ? 40 : $dist * 1.25 },
SDLK_w() => sub { save_obj('model.obj') },
SDLK_p() => sub { screenshot() },
);
The () after each constant is required. => quotes a bareword on its left, so SDLK_1 => sub { ... } makes the key the string "SDLK_1", not 49. It compiles under use strict, because a quoted word is not a bareword, and the key simply never matches. It is the import trap in another form, and this time strict does not catch it.
Moving and turning change only the model matrix, which upload sends every frame, so they need no refresh. The operations that change the mesh call it.
The mouse needs one decision: a left press may be the start of a click or of a drag. The handler counts how far the pointer moves while the button is down, and only a release after less than 4 pixels of movement is a click:
my ($dragged, $running) = (0, 1);
sub handle {
my ($ev) = @_;
my $type = $ev->{type};
if ($type == SDL_QUIT) { $running = 0 }
elsif ($type == SDL_KEYDOWN) {
if ($ev->{sym} == SDLK_ESCAPE) { $running = 0 }
elsif (my $action = $KEY{ $ev->{sym} }) { $action->() }
}
elsif ($type == SDL_MOUSEBUTTONDOWN && $ev->{button} == SDL_BUTTON_LEFT) { $dragged = 0 }
elsif ($type == SDL_MOUSEMOTION && $ev->{state} & SDL_BUTTON_LMASK) {
$dragged += abs($ev->{xrel}) + abs($ev->{yrel});
$yaw -= 0.01 * $ev->{xrel};
$pitch += 0.01 * $ev->{yrel};
$pitch = 1.4 if $pitch > 1.4;
$pitch = -1.4 if $pitch < -1.4;
}
elsif ($type == SDL_MOUSEMOTION && $ev->{state} & SDL_BUTTON_RMASK) {
$dist *= exp(0.01 * $ev->{yrel});
$dist = 2 if $dist < 2;
$dist = 40 if $dist > 40;
}
elsif ($type == SDL_MOUSEBUTTONUP && $ev->{button} == SDL_BUTTON_LEFT && $dragged < 4) {
($sel, $sel_tri) = pick($ev->{x}, $ev->{y});
print $sel ? "selected $sel->{name} (triangle $sel_tri)\n" : "selected nothing\n";
}
elsif ($type == SDL_WINDOWEVENT && $ev->{event} == SDL_WINDOWEVENT_SIZE_CHANGED) {
($W, $H) = @$ev{qw(data1 data2)};
$surf->configure($W, $H);
$depth = $gpu->depth_buffer($W, $H); # must match the frame
}
}
The held buttons arrive in the motion event’s state, as the device chapter showed, so the handler needs no memory of which button went down. Dragging right moves the eye the other way round, so the scene turns with the pointer as if held. The pitch clamp at 1.4 radians keeps the eye short of vertical, where scene-graphs warns that m_look_at degenerates. Zoom by dragging is multiplicative, exp of the movement, so the same drag changes the view by the same proportion near and far: 50 pixels down multiplies the distance by e ** 0.5 = 1.6487.
A click on nothing clears the selection, which is how to deselect.
The resize branch is the GPU scene chapter’s: after $win->set_size(640, 480) the handler reconfigured the surface to 640x480, made a matching depth buffer, and frames carried on drawing.
The frame loop#
add_object($_) for qw(cube prism sphere);
($sel, $sel_tri) = ();
my $frames = 0;
while ($running) {
while (my $ev = SDL_PollEvent()) { handle($ev) }
my $frame = $surf->next_frame or next;
upload();
draw($frame);
$frame->present;
$running = 0 if $max_frames && ++$frames >= $max_frames;
}
Nothing in a modeller moves by itself, so unlike the GPU scene chapter’s cubes there is no simulation clock and no fixed step: every change is the answer to an event, and the frame shows the state after the events it drained. The surface’s default fifo mode paces the loop to the display, as the device chapter measured.
Every pass of the loop must reach present quickly. The window shows only what the loop presents, and the window system judges the program alive by whether it keeps taking events off the queue. Anything that holds the loop for seconds, such as a slow screenshot or a long computation in a key handler, leaves the window frozen on its last frame and, after a while, marked as not responding. Work that takes that long belongs outside the frame loop or split across frames.
Running it#
The blocks above, in order, are the whole program. Save them as modeller.pl beside foundations.pl and run:
pperl modeller.pl
pperl modeller.pl 600 stops after 600 frames, for unattended runs. It needs a binary built with --features webgpu, a usable adapter, and an X11 or Wayland display for the window.
The program was checked with input pushed onto SDL’s event queue while its frame loop ran: a click on the cube’s top selected cube1 at triangle 0, the top cap; two E presses extruded it; a click on the sphere, D and ] subdivided and scaled it; a drag of 60 pixels turned the camera 0.6 radians without selecting anything; a click on empty sky cleared the selection; W wrote and re-read the file. The window’s own contents, captured from the screen as it ran, showed each step: the orange highlight moving from the cube to the sphere, the column rising from the cube, the finer facets of the sphere, and the view turning. The PNG that P wrote was identical, in all 480000 pixels, to the window’s contents captured at the same moment.
What this demonstrates#
Every chapter of the guide appears in one program, and the program works because they agree on one representation: counter-clockwise triangles in an indexed mesh, column-major matrices, a right-handed world with y up. The operations, the picker, the renderer and the writer each read that representation, and none of them converts it for another.
The checks carry over as well. The volume after each operation, the pick compared against the rendered pixels, and the file read back and compared against the scene are the same kind of test the earlier chapters used: a number known in advance, computed a second way.