luv

Workshop wiki

luft.lisp

luft/luft.lisp

system luft · 120 definitions · on GitHub

luft -- canonical cubical topology

Packed sites own topology and normalized vectors own chains. Surface realization lives in MESH.LISP; mutable occupancy and renderer backends remain outside this package.

defpackage#:luft
:use#:cl
:export

Domains and sites.

#:world-domain#:make-world-domain#:world-domain=#:world-domain-x-bits#:world-domain-y-bits#:world-domain-x-limit#:world-domain-y-limit#:site#:extent-mask#:axis#:side#:+vertex-extent+#:+x-edge-extent+#:+y-edge-extent+#:+z-edge-extent+#:+xy-face-extent+#:+xz-face-extent+#:+yz-face-extent+#:+cell-extent+#:+extent-bits+#:+site-sign-bit+#:+site-tag-bits+#:+vertical-coordinate-bits+#:+z-shift+#:+x-local-shift+#:+y-local-shift+#:+chunk-bits+#:+chunk-size+#:+chunk-morton-shift+#:+site-mask+#:+top-z+#:axis-index#:index-axis#:axis-bit#:make-extent#:make-site#:checked-site#:site-valid-p#:site-extent#:site-x#:site-y#:site-z#:site-anchor#:site-dimension#:site-extends-p#:site-negative-p#:site-positive-p#:site-polarity#:site-geometry#:opposite-site#:site-with-polarity#:step-site#:site-forward#:site-backward#:site-boundary-polarity#:site-boundary-low#:site-boundary-high#:map-site-boundary#:site-coface-forward#:site-coface-backward

Chunks.

#:chunk-key#:site-chunk-key#:site-chunk-local#:chunk-key-at#:chunk-key-x#:chunk-key-y#:chunk-origin-x#:chunk-origin-y#:map-chain-chunks

Boundary conditions.

#:outside-domain#:outside-domain-domain#:outside-domain-x#:outside-domain-y#:outside-domain-z#:outside-domain-occupancy#:treat-as-air#:treat-as-solid#:missing-chunk#:missing-chunk-domain#:missing-chunk-key#:use-chunk

Chains.

#:chain#:chain-domain#:make-chain#:chain-count#:chain-empty-p#:chain-sites#:chain-site-count#:chain-site-p#:map-chain#:chain=#:chain-builder#:make-chain-builder#:chain-builder-add-site#:chain-builder-add-chain#:finish-chain-builder#:chain+#:boundary-chain#:surface-chain#:chain-cell-occupancy-bit

Stars.

#:cell-occupancy-bit#:site-star-occupancy-mask

Face topology.

#:local-edge#:local-corner#:face-tangent-axes#:face-oriented-normal#:orient-face-outward#:face-edge-site#:face-corner-site

Manifold-sheet mesh.

#:+mesh-cell-size+#:+mesh-bevel-width+#:+mesh-instance-word-count+#:+mesh-instance-stock-bit-count+#:+mesh-template-vertex-word-count+#:+mesh-template-coordinate-bias+#:surface-mesh#:surface-mesh-domain#:surface-mesh-bevel-width#:surface-mesh-template-vertex-words#:surface-mesh-template-ranges#:surface-mesh-template-count#:surface-mesh-face-instance-words#:surface-mesh-face-instance-count#:surface-mesh-face-draws#:surface-mesh-band-instance-words#:surface-mesh-band-instance-count#:surface-mesh-band-draws#:surface-mesh-fan-instance-words#:surface-mesh-fan-instance-count#:surface-mesh-fan-draws#:surface-mesh-triangle-count#:surface-mesh-face-triangle-count#:surface-mesh-band-triangle-count#:surface-mesh-fan-triangle-count#:surface-mesh-singular-star-count#:star-singular-p#:decompose-star-mask#:make-surface-mesh#:mesh-chunk#:select-surface-mesh-stocks#:surface-mesh-with-triangle-ink#:surface-mesh-split-neighborhood#:vary-surface-mesh-bevel-widths

Tests.

#:run-luft-tests
in-package#:luft
declaim
optimize
speed2
safety3
debug2

--------------------------------------------------------------------------- Packed sites and domains

A site packs, from the least significant bit up: the extent mask (3), the polarity sign (1), Z (8), the within-chunk X and Y (6 each), and the Morton-interleaved chunk coordinates (12+12). Numeric order is therefore chunk-major with hierarchical (Morton) chunk locality, then column-major within a chunk: every (x, y) column's Z run is contiguous, and every power-of-two block of chunks is a contiguous range of any sorted vector.

Coordinates do not wrap. A domain is a box; probing beyond it is an explicit outside-domain condition with boundary restarts, so the policy for what lies past an edge belongs to the caller (a chunk store, a whole world, a test harness), never to the coordinate arithmetic.

deftypesite
'
unsigned-byte48
deftypeextent-mask
'
unsigned-byte3
deftypeaxis
'
member:x:y:z
deftypeside
'
member:low:high
deftypelocal-edge
'
member:u-low:u-high:v-low:v-high
deftypelocal-corner
'
member:low-low:low-high:high-low:high-high
deftypechunk-key
'
unsigned-byte24
defconstant+vertex-extent+#b000
defconstant+x-edge-extent+#b001
defconstant+y-edge-extent+#b010
defconstant+z-edge-extent+#b100
defconstant+xy-face-extent+#b011
defconstant+xz-face-extent+#b101
defconstant+yz-face-extent+#b110
defconstant+cell-extent+#b111
defconstant+extent-bits+3
defconstant+site-sign-bit+3
defconstant+site-tag-bits+4
defconstant+chunk-bits+6
defconstant+chunk-axis-bits+12
defconstant+site-mask+
1-
ash148
defun%spread-chunk-axis
value

Spread a 12-bit chunk coordinate onto the even bit positions.

let
v
logandvalue#xfff
setfv
logand
logiorv
ashv8
#x00ff00ff
v
logand
logiorv
ashv4
#x0f0f0f0f
v
logand
logiorv
ashv2
#x33333333
v
logand
logiorv
ashv1
#x55555555
v
defun%compact-chunk-axis
value

Compact the even bit positions back into a 12-bit chunk coordinate.

let
v
logandvalue#x555555
setfv
logand
logiorv
ashv-1
#x33333333
v
logand
logiorv
ashv-2
#x0f0f0f0f
v
logand
logiorv
ashv-4
#x00ff00ff
v
logand
logiorv
ashv-8
#x0000ffff
v
defun%chunk-morton
chunk-xchunk-y
logior
defstruct
world-domain
:constructor%make-world-domain
x-bitsy-bits
:copiernil
x-bits6:type
integer117
:read-onlyt
y-bits6:type
integer117
:read-onlyt
defunmake-world-domain
&key
horizontal-bits6
x-bitshorizontal-bits
y-bitshorizontal-bits

Make a boxed domain with power-of-two X and Y cell extents.

check-typex-bits
integer117
check-typey-bits
integer117
%make-world-domainx-bitsy-bits
defunworld-domain=
ab
check-typeaworld-domain
check-typebworld-domain
and
=
world-domain-x-bitsa
world-domain-x-bitsb
=
world-domain-y-bitsa
world-domain-y-bitsb
defunworld-domain-x-limit
domain

The domain's cell count along X; anchors range over [0, limit].

ash1
world-domain-x-bitsdomain
defunworld-domain-y-limit
domain
ash1
world-domain-y-bitsdomain
defunaxis-index
ecaseaxis
:x0
:y1
:z2
defunindex-axis
index
ecaseindex
0:x
1:y
2:z
defunmake-extent
&restaxes
reduce#'logioraxes:key#'axis-bit:initial-value0
defunsite-chunk-key

The Morton-interleaved chunk coordinates of site.

check-typesitesite
defunsite-chunk-local

site with its chunk bits cleared: a valid site of the chunk-local box.

check-typesitesite
defunsite-with-polarity
sitepolarity
check-typesitesite
check-typepolarity
member1-1
defunsite-valid-p
domainthing
check-typedomainworld-domain
and
typepthing'site
let
extent
and
<=
site-xthing
-
if
logbitp0extent
10
<=
site-ything
-
if
logbitp1extent
10
not
and
logbitp2extent
defunmake-site
domainxyz&optional
polarity1

Pack a canonical site inside domain's box. No coordinate wraps: anchors range over [0, limit] per horizontal axis, and a site extending along an axis cannot begin on that axis's far boundary.

check-typedomainworld-domain
check-typexinteger
check-typeyinteger
check-typez
integer0255
check-typeextentextent-mask
check-typepolarity
member1-1
unless
and
<=0x
-
if
logbitp0extent
10
<=0y
-
if
logbitp1extent
10
error

Site anchor (~D ~D ~D) with extent ~3,'0B lies outside the ~ ~Dx~D-cell domain.

xyzextent
when
and
logbitp2extent
error"A Z-extended site cannot begin on plane ~D."+top-z+
defunchecked-site
domainsite
unless
error"~S is not canonical in ~S."sitedomain
site
defunstep-site
domainsiteaxisdelta

Translate site; return NIL when the step leaves domain's box.

check-typedeltainteger
let
ecaseaxis
:x
incfxdelta
:y
incfydelta
:z
incfzdelta
if
or
minuspx
minuspy
minuspz
>x
-
if
logbitp0extent
10
>y
-
if
logbitp1extent
10
and
logbitp2extent
nil
defun%require-extent
siteaxispresent-p
unless
error"Site ~S has the wrong extent status along ~S."siteaxis
defun%boundary-incidence-sign
extentaxisside
let*
earlier
logandextent
1-bit
high
if
evenp
logcountearlier
1-1
if
eqside:high
high
-high
defunsite-boundary-high
domainsiteaxis
let*
unlessmoved
error"Missing high boundary of valid site ~S."site
defunsite-coface-backward
domainsiteaxis

Return the coface whose signed high boundary is site, or NIL below Z.

--------------------------------------------------------------------------- Normalized immutable chains

deftypesite-vector
'
simple-array
unsigned-byte64
defstruct
chain
:constructor%make-chain
domainsites
:conc-name%chain-
:copiernil
domainnil:typeworld-domain:read-onlyt

UB60 site values live in an unboxed UB64 machine-word array on SBCL.

sites
make-array0:element-type'
unsigned-byte64
:typesite-vector:read-onlyt
defunchain-domain
chain
%chain-domainchain
defunmake-chain
domain
%make-chaindomain
make-array0:element-type'
unsigned-byte64
defunchain-count
chain
length
%chain-siteschain
defunchain-empty-p
chain
zerop
defunchain-sites
chain

Return a fresh copy; the chain's stored normalized vector stays immutable.

let*
source
%chain-siteschain
copy
make-array
lengthsource
:element-type'
unsigned-byte64
replacecopysource
copy
defstruct
chain-builder
:constructor%make-chain-builder
domainbuffer
:conc-name%builder-
:copiernil
domainnil:typeworld-domain:read-onlyt
buffer
make-array0:element-type'
unsigned-byte64
:adjustablet:fill-pointer0
:type
vector
unsigned-byte64
defunmake-chain-builder
domain&key
initial-capacity0
check-typedomainworld-domain
check-typeinitial-capacity
integer0*
%make-chain-builderdomain
make-arrayinitial-capacity:element-type'
unsigned-byte64
:adjustablet:fill-pointer0
defunchain-builder-add-site
buildersite
checked-site
%builder-domainbuilder
site
vector-push-extendsite
%builder-bufferbuilder
site
defunchain-builder-add-chain
builderchain
unless
world-domain=
%builder-domainbuilder
error"Cannot combine chains over different domains."
loopforsiteacross
%chain-siteschain
do
vector-push-extendsite
%builder-bufferbuilder
builder
defun%normalize-vector
domainsites
setfsites
sortsites#'%site-order<
let
read0
write0
n
lengthsites
loopwhile
<readn
do
let
geometry
site-geometry
arefsitesread
positive0
negative0
loopwhile
and
<readn
=geometry
site-geometry
arefsitesread
do
if
site-negative-p
arefsitesread
incfnegative
incfpositive
incfread
let
net
-positivenegative
unless
zeropnet
let
site
site-with-polaritygeometry
if
pluspnet
1-1
dotimes
i
absnet
declare
ignorei
setf
arefsiteswrite
site
incfwrite
let
result
make-arraywrite:element-type'
unsigned-byte64
replaceresultsites:end2write
%make-chaindomainresult
defunfinish-chain-builder
builder
let*
buffer
%builder-bufferbuilder
sites
make-array
lengthbuffer
:element-type'
unsigned-byte64
replacesitesbuffer
%normalize-vector
%builder-domainbuilder
sites
defun%run-end
sitesstart
let
geometry
site-geometry
arefsitesstart
i
1+start
n
lengthsites
loopwhile
and
<in
=geometry
site-geometry
arefsitesi
do
incfi
i
defun%copy-run
sourcestartenddestinationwrite
replacedestinationsource:start1write:start2start:end2end
+write
-endstart
defunchain+
ab

Linear merge of two normalized chains, including run cancellation.

unless
error"Cannot add chains over different domains."
let*
av
%chain-sitesa
bv
%chain-sitesb
an
bn
out
make-array
+anbn
:element-type'
unsigned-byte64
ai0
bi0
write0
loopwhile
or
<aian
<bibn
do
cond
=aian
setfwrite
%copy-runbvbibnoutwrite
bibn
=bibn
setfwrite
%copy-runavaianoutwrite
aian
t
let
ag
bg
cond
<agbg
let
end
setfwrite
%copy-runavaiendoutwrite
aiend
>agbg
let
end
setfwrite
%copy-runbvbiendoutwrite
biend
t
let*
ae
be
net
+
*
-aeai
*
-bebi
unless
zeropnet
let
site
site-with-polarityag
if
pluspnet
1-1
dotimes
i
absnet
declare
ignorei
setf
arefoutwrite
site
incfwrite
setfaiaebibe
let
result
make-arraywrite:element-type'
unsigned-byte64
replaceresultout:end2write
%make-chainresult
defun%lower-bound-geometry
sitesgeometry
let
lo0
hi
lengthsites
loopwhile
<lohi
do
let*
mid
floor
+lohi
2
g
site-geometry
arefsitesmid
if
<ggeometry
setflo
1+mid
setfhimid
lo
defunchain-site-count
chainsite
let*
sites
%chain-siteschain
start
if
or
=start
lengthsites
/=geometry
site-geometry
arefsitesstart
0
-
%run-endsitesstart
start
defunmap-chain
loopforsiteacross
%chain-siteschain
do
chain
defunchain=
ab
and
typepa'chain
typepb'chain
let
av
%chain-sitesa
bv
%chain-sitesb
and
loopforibelowalways
=
arefavi
arefbvi
defunboundary-chain
chain
let*
domain
builder
make-chain-builderdomain:initial-capacity
map-chain
lambda
map-site-boundary
lambda
declare
ignoreaxisside
domainsite
chain
defunsurface-chain
solid-chain

Return the normalized boundary of an ordinary solid three-chain.

boundary-chainsolid-chain
define-conditionoutside-domain
error
domain:initarg:domain:readeroutside-domain-domain
x:initarg:x:readeroutside-domain-x
y:initarg:y:readeroutside-domain-y
z:initarg:z:readeroutside-domain-z
:report
lambda
conditionstream
formatstream"Cell (~D ~D ~D) lies outside the domain ~S."
outside-domain-xcondition
outside-domain-ycondition
outside-domain-zcondition
outside-domain-domaincondition
:documentation

A cell probe left its box. The signaling probe offers the boundary restarts TREAT-AS-AIR, TREAT-AS-SOLID, and USE-VALUE, so the caller's handler decides what lies past the edge: a world treats it as air, a chunk store answers from the neighboring chunk or defers, a test refuses.

defunoutside-domain-occupancy
domainxyz

Signal outside-domain for one probe, offering the boundary restarts.

restart-case
error'outside-domain:domaindomain:xx:yy:zz
treat-as-air
:report"Treat the missing cell as air."0
treat-as-solid
:report"Treat the missing cell as solid."1
use-value
bit
:report"Supply the occupancy bit."bit
define-conditionmissing-chunk
error
domain:initarg:domain:readermissing-chunk-domain
key:initarg:key:readermissing-chunk-key
:report
lambda
conditionstream
let
key
missing-chunk-keycondition
formatstream"Chunk (~D ~D) [key ~D] is not resident."key
:documentation

A probe crossed into a chunk that is not resident in the probing field. The signaling probe offers USE-CHUNK (supply the chunk's chain), plus the TREAT-AS-AIR and TREAT-AS-SOLID boundary restarts for the whole chunk, so a streaming store answers with data, defers, or fills with a constant.

defunchain-cell-occupancy-bit
chainxyz

Treat positive cubic-site occurrences in chain as Boolean occupancy. Cells above and below the Z range are air; probes beyond the horizontal box signal outside-domain with the boundary restarts.

--------------------------------------------------------------------------- Chunk vocabulary

A chunk is the aligned 64x64-cell full-height column block named by the Morton-interleaved chunk coordinates in a site's top bits. Because those bits are the most significant, a normalized chain is chunk-contiguous: each chunk, and each power-of-two block of chunks, is one contiguous run.

defunchunk-key-at
xy

The chunk key of the cell column at world coordinates X, Y.

defunchunk-key-x
key

The chunk-grid X coordinate of key.

defunchunk-origin-x
key

The world X coordinate of key's low corner.

defunmap-chain-chunks

Call function with each (chunk-key chunk-chain) run of chain in order.

let*
sites
%chain-siteschain
count
lengthsites
start0
loopwhile
<startcount
do
let
key
site-chunk-key
arefsitesstart
end
1+start
loopwhile
and
<endcount
=key
site-chunk-key
arefsitesend
do
incfend
let
run
make-array
-endstart
:element-type'
unsigned-byte64
replacerunsites:start2start:end2end
funcallfunctionkey
%make-chainrun
setfstartend
chain

--------------------------------------------------------------------------- Occupancy stars and strict-minority moment classification

defun%occupancy-bit
value
cond
nullvalue
0
eqvaluet
1
typepvalue'bit
value
t
error"Occupancy callback returned ~S, not NIL, T, 0, or 1."value
defuncell-occupancy-bit
domainoccupancyxyz

Central occupancy convention: cells outside Z=0..254 are air; probes beyond the horizontal box signal outside-domain with boundary restarts. occupancy must return a stable NIL, T, 0, or 1 for each in-domain cell.

defunsite-star-occupancy-mask
domainsiteoccupancy

Pack site's complete incident-cell star.

Absent axes are enumerated in X,Y,Z order. Zero means the cell one unit below the site on that axis (direction -1); one means the cell anchored at the site (direction +1).

let*
normal-mask
rank
logcountnormal-mask
samples
ash1rank
mask0
dotimes
samplesamplesmask
let
dotimes
axis-number3
when
logbitpaxis-numbernormal-mask
unless
logbitpnormal-positionsample
ecaseaxis-number
0
decfx
1
decfy
2
decfz
incfnormal-position
when
=1
cell-occupancy-bitdomainoccupancyxyz
setfmask
logiormask
ash1sample

--------------------------------------------------------------------------- Canonical face-local topology

defun%require-face
domainface
checked-sitedomainface
unless
error"Expected an oriented face site, not ~S."face
face
defun%face-tangent-indices
face
unless
error"Expected a face site, not ~S."face
let
unil
vnil
dotimes
axis-number3
when
logbitpaxis-number
ifu
setfvaxis-number
setfuaxis-number
valuesuv
defunface-tangent-axes
face
multiple-value-bind
uv
defun%canonical-face-normal
face
multiple-value-bind
uv
cond
and
=u0
=v1
values001
and
=u0
=v2
values0-10
and
=u1
=v2
values100
t
error"Invalid face extent ~3,'0B."
defunface-oriented-normal
face
multiple-value-bind
nxnynz
let
values
*pnx
*pny
*pnz
defun%axis-offset
axis-numberamount
ecaseaxis-number
0
valuesamount00
1
values0amount0
2
values00amount
defun%site-at-offset
domainsourcedxdydzextent
make-sitedomain
+
site-xsource
dx
+
site-ysource
dy
+
site-zsource
dz
extent1
defunface-edge-site
domainfaceedge

Return the canonical positive edge geometry at face's local edge.

%require-facedomainface
check-typeedgelocal-edge
multiple-value-bind
uv
ecaseedge
:u-low
%site-at-offsetdomainface000
ash1v
:u-high
multiple-value-bind
dxdydz
%site-at-offsetdomainfacedxdydz
ash1v
:v-low
%site-at-offsetdomainface000
ash1u
:v-high
multiple-value-bind
dxdydz
%site-at-offsetdomainfacedxdydz
ash1u
defunface-corner-site
domainfacecorner

Return the canonical positive vertex at local corner (U word first).

%require-facedomainface
check-typecornerlocal-corner
multiple-value-bind
uv
let
du
if
membercorner'
:high-low:high-high
10
dv
if
membercorner'
:low-high:high-high
10
multiple-value-bind
uxuyuz
multiple-value-bind
vxvyvz
%site-at-offsetdomainface
+uxvx
+uyvy
+uzvz
+vertex-extent+
defun%face-normal-side-occupancy
domainfaceoccupancydirection

direction is +/-1 relative to the oriented normal.

multiple-value-bind
nxnynz
let
dx
*directionnx
dy
*directionny
dz
*directionnz
cell-occupancy-bitdomainoccupancy
+
site-xface
if
minuspdx
-10
+
site-yface
if
minuspdy
-10
+
site-zface
if
minuspdz
-10
defunorient-face-outward
domaingeometric-faceoccupancy

Orient a face from solid to air; return NIL when it is not exposed.

%require-facedomaingeometric-face
let*
positive
site-with-polaritygeometric-face1
minus
%face-normal-side-occupancydomainpositiveoccupancy-1
plus
%face-normal-side-occupancydomainpositiveoccupancy1
cond
and
=minus1
=plus0
positive
and
=minus0
=plus1
tnil