luv

Workshop wiki

tests.lisp

luft/tests.lisp

system luft · 29 definitions · on GitHub

in-package#:luft

Focused executable claims for the retained topology and the replacement manifold-sheet mesher.

defmacro%check
form&optionalnote
`
progn
unless,form
error"LUFT test failed in ~A~@[ (~A)~]: ~S"*luft-test-section*,note',form
defmacro%with-test-section
name
&bodybody
`
let,@body
defun%signals-error-p
thunk
handler-case
progn
funcallthunk
nil
error
t
defun%chain-from-sites
domainsites
let
builder
make-chain-builderdomain:initial-capacity
lengthsites
defun%boundary-sites
domainsite
let
parts'
map-site-boundary
lambda
declare
ignoreaxisside
pushpartparts
domainsite
nreverseparts
defun%test-sites-and-chains
%with-test-section
"packed sites, chains, and boundary"
let*
domain
make-world-domain:x-bits3:y-bits3
neighbor
solid
%chain-from-sitesdomain
listcellneighbor
surface
%check
null
site-backwarddomain
make-sitedomain230
:z

Boundary squared remains the chain-level topological invariant.

The value is immutable through its public vector view.

let
copy
setf
arefcopy0
0
defun%edge-set=
leftright
equal
sort
copy-listleft
#'<
sort
copy-listright
#'<
defun%test-sheet-decomposition
%with-test-section
"manifold sheet decomposition"
let
singular-count0
dotimes
mask256
when
incfsingular-count
let
%check
=
loopforcycleincyclessum
lengthcycle
%check
%edge-set=
loopforcycleincyclesappendcycle
%check
=128singular-count

Representatives of the two singular mechanisms and the maximally crossed checkerboard resolve into the intended ordinary sheets.

%check
equal'
#x02#x04
%check
equal'
#x08#x10
%check
equal'
#x01#x08#x20#x40

This is the deliberate spike boundary: its occupied-side cycle needs a covered junction and cannot be disguised as an ordinary eight-bit star.

defun%solid-for-star
mask&key
centre'
888
let*
domain
make-world-domain:horizontal-bits5
builder
make-chain-builderdomain:initial-capacity8
dotimes
when
logbitpsamplemask
let
coordinates
loopforaxis-numberbelow3collect
+
nthaxis-numbercentre
if
logbitpaxis-numbersample
0-1
chain-builder-add-sitebuilder
make-sitedomain
firstcoordinates
secondcoordinates
thirdcoordinates
+cell-extent+1
defun%map-mesh-triangles
let
templates
surface-mesh-template-vertex-wordsmesh
ranges
surface-mesh-template-rangesmesh
labels
visit
wordskind
loopforoffsetfrom0below
lengthwords
by4forbase=
list
arefwordsoffset
arefwords
+offset1
arefwords
+offset2
fortemplate-id=
ldb
byte160
arefwords
+offset3
forstart=
arefranges
*2template-id
forcount=
arefranges
1+
*2template-id
do
loopforvertexfromstartbelow
+startcount
by3do
funcallfunctionkind
pointbasevertex
pointbase
1+vertex
pointbase
+vertex2
visit
surface-mesh-face-instance-wordsmesh
:face
visit
surface-mesh-band-instance-wordsmesh
:band
visit
surface-mesh-fan-instance-wordsmesh
:fan
defun%ordered-edge
leftright
if
or
<
firstleft
firstright
and
=
firstleft
firstright
or
<
secondleft
secondright
and
=
secondleft
secondright
<
thirdleft
thirdright
listleftright
listrightleft
defun%mesh-geometric-edge-counts
mesh
let
counts
make-hash-table:test#'equal
%map-mesh-triangles
lambda
kindabc
declare
ignorekind
let
points
vectorabc
dotimes
index3
incf
gethash
%ordered-edge
arefpointsindex
arefpoints
mod
1+index
3
counts0
mesh
counts
defun%mesh-closed-p
mesh
loopforcountbeingthehash-valuesofalways
=count2
defun%mesh-nondegenerate-p
mesh
let
nondegenerate-pt
%map-mesh-triangles
lambda
kindabc
declare
ignorekind
when
every#'zerop
setfnondegenerate-pnil
mesh
nondegenerate-p
defun%mesh-unique-points
mesh
let
points
make-hash-table:test#'equal
%map-mesh-triangles
lambda
kindabc
declare
ignorekind
dolist
point
listabc
setf
gethashpointpoints
t
mesh
loopforpointbeingthehash-keysofpointscollectpoint
defun%mesh-oriented-plane-areas
mesh

Exact per-plane doubled-area signature, including render attributes.

let
areas
make-hash-table:test#'equal
%map-surface-mesh-triangle-records
lambda
kindstockambientmasknormalabc
declare
ignoremask
let*
cross
key
listkindstockambientnormal
%point-dotnormala
area
/
%point-dotcrossnormal
%point-dotnormalnormal
incf
gethashkeyareas0
area
mesh
areas
defun%same-plane-areas-p
leftright
and
=
hash-table-countleft
hash-table-countright
loopforkeybeingthehash-keysofleftusing
hash-valuearea
always
=area
gethashkeyright-1
defun%stream-template-coordinates-within-p
meshinstance-wordslowhigh
let
templates
surface-mesh-template-vertex-wordsmesh
ranges
surface-mesh-template-rangesmesh
loopforoffsetfrom0below
lengthinstance-words
by4fortemplate-id=
ldb
byte160
arefinstance-words
+offset3
forstart=
arefranges
*2template-id
forcount=
arefranges
1+
*2template-id
always
loopforvertexfromstartbelow
+startcount
always
loopforaxisbelow3forcoordinate=always
<=lowcoordinatehigh
defun%fan-templates-are-triangles-p
mesh
let
ranges
surface-mesh-template-rangesmesh
instances
surface-mesh-fan-instance-wordsmesh
loopforoffsetfrom0below
lengthinstances
by4fortemplate-id=
ldb
byte160
arefinstances
+offset3
forcount=
arefranges
1+
*2template-id
always
=3count
defun%fan-site-used-as-vertex-p
meshsite
let
templates
surface-mesh-template-vertex-wordsmesh
ranges
surface-mesh-template-rangesmesh
instances
surface-mesh-fan-instance-wordsmesh
loopforoffsetfrom0below
lengthinstances
by4thereis
and
loopforaxisbelow3always
=
arefinstances
+offsetaxis
let*
template-id
ldb
byte160
arefinstances
+offset3
start
arefranges
*2template-id
count
arefranges
1+
*2template-id
loopforvertexfromstartbelow
+startcount
thereis
defun%every-fan-triangle-at-site-uses-site-p
meshsite
let
templates
surface-mesh-template-vertex-wordsmesh
ranges
surface-mesh-template-rangesmesh
instances
surface-mesh-fan-instance-wordsmesh
foundnil
loopforoffsetfrom0below
lengthinstances
by4do
when
loopforaxisbelow3always
=
arefinstances
+offsetaxis
setffoundt
let*
template-id
ldb
byte160
arefinstances
+offset3
start
arefranges
*2template-id
count
arefranges
1+
*2template-id
unless
loopforvertexfromstartbelow
+startcount
thereis
finally
returnfound
defun%test-surface-mesh
%with-test-section
"integer site streams"
dolist
bevel-width'
123
flet
mesh-for-star
mask
make-surface-mesh:bevel-widthbevel-width
let
one
mesh-for-star#x01
%check
=bevel-width
surface-mesh-bevel-widthone
%check
=12
surface-mesh-face-triangle-countone
%check
=24
surface-mesh-band-triangle-countone
%check
=8
surface-mesh-fan-triangle-countone
%check
%stream-template-coordinates-within-pone
surface-mesh-fan-instance-wordsone
-bevel-width
bevel-width
let
pair
mesh-for-star#x03
%check
zerop
surface-mesh-singular-star-countpair
%check
%stream-template-coordinates-within-ppair
surface-mesh-fan-instance-wordspair
-bevel-width
bevel-width
let
convex-trapezoid
mesh-for-star#x70
concave-corner
mesh-for-star#x8f
concave-run
mesh-for-star#xcf
dolist
mask'
#x06#x18#x69
let
mesh
mesh-for-starmask
%check
plusp
surface-mesh-singular-star-countmesh
formatnil"width ~D mask ~2,'0X"bevel-widthmask
%check
formatnil"width ~D mask ~2,'0X"bevel-widthmask
let*
medial
%check
=4
surface-mesh-bevel-widthmedial
%check
every
lambda
point
=2
count4point:key
lambda
coordinate
modcoordinate8
points
dotimes
mask256
let*
%check
formatnil"medial mask ~2,'0X"mask
%check
formatnil"medial mask ~2,'0X"mask
%check
formatnil"merged medial mask ~2,'0X"mask
%check
formatnil"merged medial mask ~2,'0X"mask
%check
formatnil"merged count mask ~2,'0X"mask
%check
formatnil"merged plane areas mask ~2,'0X"mask
dolist
width'
1234
dolist
mask'
#x01#x70#x8f#x69
let*
witness
make-surface-meshsolid:bevel-width1
oracle
make-surface-meshsolid:bevel-widthwidth
varied
vary-surface-mesh-bevel-widthswitness
lambda
xyzstocks
declare
ignorexyzstocks
width
%check
formatnil"uniform affine width ~D mask ~2,'0X"widthmask
dotimes
mask256
let*
witness
varied
vary-surface-mesh-bevel-widthswitness
lambda
xyzstocks
declare
ignorestocks
if
oddp
+xyz
41
%check
formatnil"mixed affine closure mask ~2,'0X"mask
%check
formatnil"mixed affine triangles mask ~2,'0X"mask
defun%chunk-test-world

A four-chunk world with solids straddling every seam and the world box.

let*
domain
make-world-domain:horizontal-bits7
builder
make-chain-builderdomain:initial-capacity16384
flet
patch
x0x1y0y1
loopforxfromx0belowx1do
loopforyfromy0belowy1do

A cross over both interior seams, and both world-box corners.

patch48804880
patch0808
patch120128120128
defun%canonical-triangle-counts
meshes
let
table
make-hash-table:test#'equal
dolist
meshmeshestable
%map-mesh-triangles
lambda
kindabc
declare
ignorekind
let*
rotations
list
appendabc
appendbca
appendcab
best
firstrotations
dolist
rotation
restrotations
when
loopforlinrotationforrinbestwhen
/=lr
return
<lr
finally
setfbestrotation
incf
gethashbesttable0
mesh
defun%triangle-counts=
leftright
and
=
hash-table-countleft
hash-table-countright
loopforkeybeingthehash-keysofleftusing
hash-valuecount
always
=count
gethashkeyright0
defun%test-chunked-meshing
%with-test-section
"chunked meshing equals whole-world meshing"
let*
store
make-hash-table:test#'eql
chunk-meshes'
map-chain-chunks
lambda
keychain
setf
gethashkeystore
chain
world
%check
=4
hash-table-countstore
loopforkeybeingthehash-keysofstoreusing
hash-valuechain
do
push
handler-bind
missing-chunk
lambda
condition
let
neighbor
gethash
missing-chunk-keycondition
store
ifneighbor
invoke-restart'use-chunkneighbor
invoke-restart'treat-as-air
outside-domain
lambda
condition
declare
ignorecondition
invoke-restart'treat-as-air
mesh-chunkchainkey
chunk-meshes
%check
=
surface-mesh-singular-star-countwhole
reduce#'+chunk-meshes:key#'surface-mesh-singular-star-count
%check"chunked triangles differ from the whole-world mesh"
defunrun-luft-tests
&key
stream*standard-output*

Run the retained topology and replacement manifold-sheet mesh claims.