luv

Workshop wiki

mesh-variation-policy.lisp

luft/mesh-variation-policy.lisp

system luft · 27 definitions · on GitHub

in-package#:luft
defmacro%do-surface-mesh-triangle-scalars
meshkindstockambientmaskaxayazbxbybzcxcycz
&bodybody

Iterate mesh's packed triangles with scalar coordinates and no callback.

This is the dense-loop counterpart to %map-surface-mesh-triangle-records. The latter deliberately materializes convenient point and normal lists for cold transformations and inspection; performance-sensitive compilers should keep the packed instance/template representation through their inner loop.

let
mesh-value
gensym"MESH"
templates
gensym"TEMPLATES"
ranges
gensym"RANGES"
visit
gensym"VISIT"
words
gensym"WORDS"
kind-value
gensym"KIND"
offset
gensym"OFFSET"
base-x
gensym"BASE-X"
base-y
gensym"BASE-Y"
base-z
gensym"BASE-Z"
meta
gensym"META"
stock-value
gensym"STOCK"
ambient-value
gensym"AMBIENT"
template-id
gensym"TEMPLATE-ID"
start
gensym"START"
count
gensym"COUNT"
vertex
gensym"VERTEX"
attributes
gensym"ATTRIBUTES"
labels
coordinate
basevertex-offsetaxis
`
`
let*
,mesh-value,mesh
,templates
surface-mesh-template-vertex-words,mesh-value
,ranges
surface-mesh-template-ranges,mesh-value
flet
,visit
,words,kind-value
declare
type
simple-array
unsigned-byte32
,words
loopfor,offsetfixnumfrom0below
length,words
by+mesh-instance-word-count+for,base-x=
aref,words,offset
for,base-y=
aref,words
+,offset1
for,base-z=
aref,words
+,offset2
for,meta=
aref,words
+,offset3
for,template-id=
ldb
byte160
,meta
for,stock-value=for,ambient-value=for,start=
aref,ranges
*2,template-id
for,count=
aref,ranges
1+
*2,template-id
do
loopfor,vertexfixnumfrom,startbelow
+,start,count
by3for,attributes=do
let
,kind,kind-value
,stock,stock-value
,ambient,ambient-value
,mask
ldb
byte310
,attributes
,ax,
coordinatebase-x00
,ay,
coordinatebase-y01
,az,
coordinatebase-z02
,bx,
coordinatebase-x10
,by,
coordinatebase-y11
,bz,
coordinatebase-z12
,cx,
coordinatebase-x20
,cy,
coordinatebase-y21
,cz,
coordinatebase-z22
declare
ignorable,kind,stock,ambient,mask,ax,ay,az,bx,by,bz,cx,cy,cz
typefixnum,stock,ambient,mask
typemesh-global-tick,ax,ay,az,bx,by,bz,cx,cy,cz
,@body
,visit
surface-mesh-face-instance-words,mesh-value
:face
,visit
surface-mesh-band-instance-words,mesh-value
:band
,visit
surface-mesh-fan-instance-words,mesh-value
:junction
defun%unit-bevel-coordinate-site-and-direction
coordinate

Decode one nonnegative width-one tick coordinate without materialization.

declare
optimize
speed3
safety1
let
cell
ashcoordinate-3
case
logandcoordinate7
0
valuescell0
1
valuescell1
7
values-1
t
error"Width-one point coordinate ~D has no canonical lattice-site owner."coordinate
declaim
ftype
function
values
integer0#.
ash117
integer0#.
ash117
integer0#.
ash117
integer-11
integer-11
integer-11
&optional
%unit-bevel-point-owner
defun%unit-bevel-point-owner
xyz

Return the scalar owner site and local direction for a witness point.

multiple-value-bind
site-xdirection-x
multiple-value-bind
site-ydirection-y
multiple-value-bind
site-zdirection-z
valuessite-xsite-ysite-zdirection-xdirection-ydirection-z
defun%pack-global-mesh-point
xyz

Pack a world-domain tick point into one lexicographically ordered fixnum.

declare
optimize
speed3
safety1
unless
error"Global mesh point ~S exceeds the LUFT world-domain tick range."
listxyz
defun%triangle-cross-scalars
axayazbxbybzcxcycz
declare
optimize
speed3
safety1
typemesh-global-tickaxayazbxbybzcxcycz
let
ux
the
signed-byte14
-bxax
uy
the
signed-byte14
-byay
uz
the
signed-byte14
-bzaz
vx
the
signed-byte14
-cxax
vy
the
signed-byte14
-cyay
vz
the
signed-byte14
-czaz
values
the
signed-byte29
-
thefixnum
*uyvz
thefixnum
*uzvy
the
signed-byte29
-
thefixnum
*uzvx
thefixnum
*uxvz
the
signed-byte29
-
thefixnum
*uxvy
thefixnum
*uyvx
defun%emit-global-triangle-scalars
builderkindstockambientmasknxnynzaxayazbxbybzcxcycz

Emit one global-tick triangle without point, base, origin, or normal lists.

declare
optimize
speed3
safety1
typesurface-mesh-builderbuilder
typefixnumstockambientmask
type
signed-byte29
nxnynz
typemesh-global-tickaxayazbxbybzcxcycz
let*
base-x
ash
minaxbxcx
-3
base-y
ash
minaybycy
-3
base-z
ash
minazbzcz
-3
origin-x
ashbase-x3
origin-y
ashbase-y3
origin-z
ashbase-z3
scratch
surface-mesh-builder-vertex-scratchbuilder
%scratch-trianglescratch0
ecasekind
:face0
:band1
:junction2
mask
-axorigin-x
-ayorigin-y
-azorigin-z
-bxorigin-x
-byorigin-y
-bzorigin-z
-cxorigin-x
-cyorigin-y
-czorigin-z
nxnynz
%emit-instancebuilderkindbase-xbase-ybase-zstockambient3
defun%unit-bevel-point-site
point

Return the canonical lattice site and local direction owning point.

point must come from a width-one luft surface, so every coordinate is exactly on, one tick above, or one tick below its owning lattice plane.

let
sitenil
directionnil
dolist
coordinatepoint
multiple-value-bind
cellremainder
caseremainder
0
push0direction
1
push1direction
7
pushsite
push-1direction
t
error"Width-one point coordinate ~D has no canonical lattice-site owner."coordinate
values
nreversesite
nreversedirection

Budget every possible page plus a conservative two-word directory entry. The actual directory is one pointer per page, so this keeps the fast path bounded without depending on implementation-specific object sizes.

defun%dense-bevel-site-index
xyzx0y0z0y-spanz-span
declare
optimize
speed3
safety1
typefixnumxyzx0y0z0y-spanz-span
thefixnum
+
thefixnum
-zz0
thefixnum
*z-span
thefixnum
+
thefixnum
-yy0
thefixnum
*y-span
thefixnum
-xx0
defun%paged-byte-stock-mask-policy-p
domainstock-maskssite-widths

Whether stock-masks can use the bounded direct page directory for domain.

and
typepstock-masks'
simple-array
unsigned-byte8
typepsite-widths'
simple-array
unsigned-byte8

Zero is the unobserved-site sentinel inside a page. Wider or zero masks retain the fully general EQL hash compiler below.

loopforstock-maskacrossstock-masksalways
pluspstock-mask
defun%compile-paged-byte-stock-mask-bevel-sites
owner-witnessesstock-maskssite-widthswidth-census

Fold a positive byte stock lane through sparse 8-cubed pages.

Return the sparse or dense realized width field, its exact site count and maximum width, and its inclusive coordinate bounds. Pages are only the one-pass accumulation language; the returned field has the same tight layout used by the generic compiler and all realization passes.

declare
optimize
speed3
safety1
type
simple-array
unsigned-byte8
stock-masks
type
simple-array
unsigned-byte8
site-widths
type
simple-array
unsigned-byte32
5
width-census
let*
domain
surface-mesh-domain
cdarowner-witnesses
directory-count
*x-pagesy-pagesz-pages
pages
make-arraydirectory-count:initial-elementnil
touched
make-array
min1024directory-count
:element-type'
unsigned-byte32
:adjustablet:fill-pointer0
site-count0
minimum-site-xmost-positive-fixnum
maximum-site-xmost-negative-fixnum
minimum-site-ymost-positive-fixnum
maximum-site-ymost-negative-fixnum
minimum-site-zmost-positive-fixnum
maximum-site-zmost-negative-fixnum
declare
typefixnumx-pagesy-pagesz-pagesdirectory-countsite-countminimum-site-xmaximum-site-xminimum-site-ymaximum-site-yminimum-site-zmaximum-site-z
labels
directory-index
xyz
thefixnum
+
ashz-3
thefixnum
*z-pages
thefixnum
+
ashy-3
thefixnum
*y-pages
ashx-3
local-index
xyz
the
unsigned-byte9
logior
logandz7
ash
logandy7
3
ash
logandx7
6
observe
xyzstock-mask
declare
type
integer0#.
ash117
xy
type
integer0255
z
type
unsigned-byte8
stock-mask
let*
page-index
directory-indexxyz
page
arefpagespage-index
unlesspage
setfpage
make-array+bevel-site-page-volume+:element-type'
unsigned-byte8
:initial-element0
arefpagespage-index
page
vector-push-extendpage-indextouched
let*
page
the
simple-array
unsigned-byte8
page
index
local-indexxyz
old
arefpageindex
when
zeropold
incfsite-count
setfminimum-site-x
minminimum-site-xx
maximum-site-x
maxmaximum-site-xx
minimum-site-y
minminimum-site-yy
maximum-site-y
maxmaximum-site-yy
minimum-site-z
minminimum-site-zz
maximum-site-z
maxmaximum-site-zz
setf
arefpageindex
logioroldstock-mask
declare
inlinedirectory-indexlocal-indexobserve
ftype
function
fixnumfixnumfixnum
fixnum
directory-indexlocal-index
ftype
function
fixnumfixnumfixnum
unsigned-byte8
*
observe
dolist
owner-witnessowner-witnesses
let
witness
cdrowner-witness
%do-surface-mesh-triangle-scalars
witnesskindstockambientmaskaxayazbxbybzcxcycz
declare
ignorekindambientmask
unless
<stock
lengthstock-masks
error"Mesh stock ~D is outside the compiled bevel policy of ~D entries."stock
lengthstock-masks
let
stock-mask
arefstock-masksstock
multiple-value-bind
asxasyasz
multiple-value-bind
bsxbsybsz
multiple-value-bind
csxcsycsz
observeasxasyaszstock-mask
unless
and
=asxbsx
=asybsy
=aszbsz
observebsxbsybszstock-mask
unless
or
and
=asxcsx
=asycsy
=aszcsz
and
=bsxcsx
=bsycsy
=bszcsz
observecsxcsycszstock-mask
when
zeropsite-count
setfminimum-site-x0maximum-site-x0minimum-site-y0maximum-site-y0minimum-site-z0maximum-site-z0
let*
site-x-span
1+
-maximum-site-xminimum-site-x
site-y-span
1+
-maximum-site-yminimum-site-y
site-z-span
1+
-maximum-site-zminimum-site-z
site-volume
*site-x-spansite-y-spansite-z-span
dense-widths
when
make-arraysite-volume:element-type'
unsigned-byte8
:initial-element0
width-by-site
unlessdense-widths
make-hash-table:test#'eql:size
max16site-count
maximum-width1
declare
typefixnumsite-x-spansite-y-spansite-z-spansite-volumemaximum-width
loopforpage-indexacrosstoucheddo
multiple-value-bind
page-xremainder
truncatepage-index
*y-pagesz-pages
multiple-value-bind
page-ypage-z
truncateremainderz-pages
let
page
the
simple-array
unsigned-byte8
arefpagespage-index
dotimes
let
site-mask
arefpageindex
unless
zeropsite-mask
let
x
+
ashpage-x3
ashindex-6
y
+
ashpage-y3
ldb
byte33
index
z
+
ashpage-z3
ldb
byte30
index
declare
typefixnumxyz
unless
<site-mask
lengthsite-widths
error"Incident mesh stocks compiled to invalid bevel mask ~D at ~S."site-mask
listxyz
let
width
arefsite-widthssite-mask
unless
and
integerpwidth
error"Site-local bevel policy assigned invalid width ~S at ~S."width
listxyz
setfmaximum-width
maxmaximum-widthwidth
incf
arefwidth-censuswidth
ifdense-widths
setf
arefdense-widths
%dense-bevel-site-indexxyzminimum-site-xminimum-site-yminimum-site-zsite-y-spansite-z-span
width
setf
gethashwidth-by-site
width
valueswidth-by-sitedense-widthssite-countmaximum-widthminimum-site-xmaximum-site-xminimum-site-ymaximum-site-yminimum-site-zmaximum-site-z

The policy compiler above chooses one of two deliberately equivalent representations. Downstream transition planning and emission share this small immutable view instead of growing another all-in-one compiler function merely to keep the field's representation details lexical.

defstruct
%bevel-site-width-field
:constructor%make-bevel-site-width-field
width-by-sitedense-widthsminimum-site-xminimum-site-yminimum-site-zsite-y-spansite-z-span
width-by-sitenil:type
ornullhash-table
:read-onlyt
dense-widthsnil:type
ornull
simple-array
unsigned-byte8
:read-onlyt
minimum-site-x0:typefixnum:read-onlyt
minimum-site-y0:typefixnum:read-onlyt
minimum-site-z0:typefixnum:read-onlyt
site-y-span1:typefixnum:read-onlyt
site-z-span1:typefixnum:read-onlyt
defmacro%with-bevel-site-width-field
site-width
field&bodybody

Execute body with an inline site-width lookup over field.

The representation is unpacked once around an entire planning or emission stage, keeping the scalar triangle loop independent of the policy compiler without paying structure-access or generic-call costs per vertex.

let
field-var
gensym"FIELD"
width-by-site
gensym"WIDTH-BY-SITE"
dense-widths
gensym"DENSE-WIDTHS"
minimum-site-x
gensym"MINIMUM-SITE-X"
minimum-site-y
gensym"MINIMUM-SITE-Y"
minimum-site-z
gensym"MINIMUM-SITE-Z"
site-y-span
gensym"SITE-Y-SPAN"
site-z-span
gensym"SITE-Z-SPAN"
`
let*
,field-var,field
,width-by-site
%bevel-site-width-field-width-by-site,field-var
,dense-widths
%bevel-site-width-field-dense-widths,field-var
,minimum-site-x
%bevel-site-width-field-minimum-site-x,field-var
,minimum-site-y
%bevel-site-width-field-minimum-site-y,field-var
,minimum-site-z
%bevel-site-width-field-minimum-site-z,field-var
,site-y-span
%bevel-site-width-field-site-y-span,field-var
,site-z-span
%bevel-site-width-field-site-z-span,field-var
declare
type
ornullhash-table
,width-by-site
type
ornull
simple-array
unsigned-byte8
,dense-widths
typefixnum,minimum-site-x,minimum-site-y,minimum-site-z,site-y-span,site-z-span
labels
,site-width
let
width
if,dense-widths
aref,dense-widths
%dense-bevel-site-indexsite-xsite-ysite-z,minimum-site-x,minimum-site-y,minimum-site-z,site-y-span,site-z-span
gethash,width-by-site
unless
and
integerpwidth
error"No site-local bevel width was compiled for ~S."
the
integer14
width
declare
inline,site-width
ftype
function
fixnumfixnumfixnum
integer14
,site-width
,@body
defmacro%with-transformed-bevel-triangle
taxtaytaztbxtbytbztcxtcytcz
site-widthaxayazbxbybzcxcycz&bodybody

Bind the exact site-width transform of one width-one witness triangle.

`
multiple-value-bind
asxasyaszadxadyadz
multiple-value-bind
bsxbsybszbdxbdybdz
multiple-value-bind
csxcsycszcdxcdycdz
let*
aw
,site-widthasxasyasz
bw
if
and
=asxbsx
=asybsy
=aszbsz
aw
,site-widthbsxbsybsz
cw
cond
and
=asxcsx
=asycsy
=aszcsz
aw
and
=bsxcsx
=bsycsy
=bszcsz
bw
t
,site-widthcsxcsycsz
ad
1-aw
bd
1-bw
cd
1-cw
,tax
+,ax
*adadx
,tay
+,ay
*adady
,taz
+,az
*adadz
,tbx
+,bx
*bdbdx
,tby
+,by
*bdbdy
,tbz
+,bz
*bdbdz
,tcx
+,cx
*cdcdx
,tcy
+,cy
*cdcdy
,tcz
+,cz
*cdcdz
declare
type
integer14
awbwcw
type
integer03
adbdcd
typemesh-global-tick,tax,tay,taz,tbx,tby,tbz,tcx,tcy,tcz
,@body