---
format:
html:
toc: true
toc-depth: 2
theme: {dark: darkly, light: cosmo}
number-sections: false
number-depth: 0
code-fold: false
code-tools: true
highlight-style: nord
---
<style></style><style>.printedClojure .sourceCode {
background-color: transparent;
border-style: none;
}
</style><style>.clay-limit-image-width .clay-image {max-width: 100%}
.clay-side-by-side .sourceCode {margin: 0}
.clay-side-by-side {margin: 1em 0}
</style>
<script src="https://code.jquery.com/jquery-3.6.0.min.js" type="text/javascript"></script><script src="https://code.jquery.com/ui/1.13.1/jquery-ui.min.js" type="text/javascript"></script>
```{=html}
<div style="display:none;"><style>/* ---------------------------------------------------------------
Fedoras — one palette, two schemes.
Dark is the default. Quarto puts .quarto-light on the body when the
reader flips the toggle, and everything below is written against
these variables, so a scheme change is nine lines rather than three
hundred.
--------------------------------------------------------------- */
:root {
--paper: #1b1d21; /* background */
--ink: #e6e4df; /* text */
--ink-soft: #a9a49b; /* secondary text */
--rule: rgba(230, 228, 223, 0.22);
--panel: rgba(230, 228, 223, 0.05);
--violet: #9d8dff; /* apparatus, epigraphs */
--gold: #d0a44c; /* beats, commits */
--coral: #e2707c; /* moderation, rewrites */
--green: #6fcf9b; /* the Helps */
--blurple: #8b95f0; /* Discord */
--violet-rgb: 157, 141, 255;
--gold-rgb: 208, 164, 76;
--coral-rgb: 226, 112, 124;
--green-rgb: 111, 207, 155;
--blurple-rgb: 139, 149, 240;
--ink-rgb: 168, 164, 156;
--panel-hard: #101215;
}
body.quarto-light {
--paper: #faf8f4;
--ink: #1c1f24;
--ink-soft: #6b665e;
--rule: rgba(28, 31, 36, 0.22);
--panel: rgba(28, 31, 36, 0.05);
--violet: #6c5ce7;
--gold: #b0863a;
--coral: #e04f5f;
--green: #2ea078;
--blurple: #5865f2;
--violet-rgb: 108, 92, 231;
--gold-rgb: 176, 134, 58;
--coral-rgb: 224, 79, 95;
--green-rgb: 46, 160, 120;
--blurple-rgb: 88, 101, 242;
--ink-rgb: 128, 128, 128;
--panel-hard: #14161a;
}
/* ---------------------------------------------------------------
Fedoras — screenplay typography for the HTML edition.
Loaded by fedoras.screenplay/assets. Edit here, rebuild, done.
PDF styling lives in notebooks/tex/fedoras-preamble.tex instead.
--------------------------------------------------------------- */
.screenplay {
font-family: "Courier Prime", "Courier New", ui-monospace, monospace;
font-size: 1rem;
line-height: 1.35;
max-width: 62ch;
margin: 1.6rem 0 2.2rem 0;
}
.screenplay .slug {
font-weight: 700;
letter-spacing: 0.04em;
margin: 1.6rem 0 0.8rem 0;
}
.screenplay .action {
margin: 0 0 0.85rem 0;
}
.action{
white-space: pre-line;
}
.screenplay .action.beat {
margin-bottom: 0.35rem;
}
.screenplay .dialogue {
margin: 0 0 0.95rem 0;
}
.screenplay .character {
margin: 0 0 0 12ch;
font-weight: 700;
letter-spacing: 0.06em;
}
.screenplay .paren {
margin: 0 0 0 9ch;
font-style: italic;
opacity: 0.85;
}
.screenplay .lines {
margin-left: 6ch;
max-width: 50ch;
}
.screenplay .line {
margin: 0;
}
.screenplay .transition {
margin: 1.1rem 0 1.1rem 0;
text-align: right;
font-weight: 700;
letter-spacing: 0.08em;
}
.screenplay .direction {
font-style: italic;
opacity: 0.85;
margin: 0 0 0.9rem 0;
}
/* In-world text: banners, signs, whiteboards. */
.screenplay .sign {
border: 1px solid currentColor;
padding: 0.7rem 1rem;
margin: 0.9rem 0 1.1rem 4ch;
max-width: 46ch;
text-align: center;
letter-spacing: 0.05em;
}
.screenplay .sign p {
margin: 0.15rem 0;
}
.screenplay .whiteboard {
text-align: left;
}
.screenplay .whiteboard-title {
font-weight: 700;
text-transform: uppercase;
margin-bottom: 0.4rem !important;
}
.screenplay .whiteboard ol {
margin: 0;
padding-left: 2.2ch;
}
/* --- The Fedora Handbook epigraphs ------------------------------- */
.handbook {
max-width: 54ch;
margin: 1.4rem 0 2rem 2ch;
padding-left: 1.1rem;
border-left: 3px solid var(--violet);
font-style: italic;
}
.handbook .rule-number {
font-style: normal;
font-variant: small-caps;
letter-spacing: 0.08em;
opacity: 0.75;
margin-bottom: 0.25rem;
}
.handbook .rule-text {
margin: 0;
}
/* --- Drafting apparatus (hidden in the reading copy) -------------- */
.beats {
border: 1px dashed var(--gold);
background: rgba(var(--gold-rgb), 0.07);
padding: 0.6rem 0.9rem;
margin: 1.1rem 0;
max-width: 62ch;
font-size: 0.88rem;
}
.beats-title {
font-variant: small-caps;
letter-spacing: 0.1em;
font-weight: 700;
margin: 0 0 0.35rem 0;
opacity: 0.8;
}
.beats ul {
margin: 0;
padding-left: 1.4rem;
}
.beats.note {
border-color: var(--blurple);
background: rgba(var(--blurple-rgb), 0.07);
}
.status {
display: inline-block;
font-family: ui-monospace, monospace;
font-size: 0.7rem;
letter-spacing: 0.14em;
padding: 0.15rem 0.5rem;
border-radius: 3px;
margin: 0 0 0.8rem 0;
}
.status-outline { background: var(--ink-soft); color: #fff; }
.status-draft { background: var(--gold); color: #fff; }
.status-locked { background: var(--green); color: #fff; }
/* --- Live (editable) code cells ---------------------------------- */
.live-cell {
border: 1px solid rgba(var(--ink-rgb), 0.4);
border-radius: 5px;
padding: 0.7rem 0.8rem;
margin: 1.2rem 0;
max-width: 68ch;
}
.live-label {
font-size: 0.78rem;
letter-spacing: 0.09em;
text-transform: uppercase;
opacity: 0.7;
margin-bottom: 0.45rem;
}
.live-src {
width: 100%;
font-family: ui-monospace, "Courier New", monospace;
font-size: 0.9rem;
line-height: 1.4;
padding: 0.5rem;
border: 1px solid rgba(var(--ink-rgb), 0.35);
border-radius: 4px;
background: rgba(var(--ink-rgb), 0.06);
resize: vertical;
}
.live-bar {
margin-top: 0.5rem;
display: flex;
gap: 0.5rem;
align-items: center;
}
.live-run {
font: inherit;
font-size: 0.85rem;
padding: 0.25rem 0.9rem;
border-radius: 4px;
border: 1px solid rgba(var(--ink-rgb), 0.5);
background: rgba(var(--violet-rgb), 0.15);
cursor: pointer;
}
.live-run:hover { background: rgba(var(--violet-rgb), 0.3); }
.live-out {
margin: 0.5rem 0 0 0;
padding: 0.45rem 0.6rem;
min-height: 1.6rem;
font-size: 0.88rem;
white-space: pre-wrap;
border-left: 3px solid rgba(var(--violet-rgb), 0.6);
background: rgba(var(--ink-rgb), 0.06);
}
/* --- Front matter ------------------------------------------------- */
.title-page {
text-align: center;
margin: 3rem 0 2rem 0;
}
.title-page .title {
font-family: "Courier Prime", "Courier New", monospace;
font-size: 3.2rem;
letter-spacing: 0.22em;
margin: 0;
}
.title-page .subtitle {
font-family: "Courier Prime", "Courier New", monospace;
letter-spacing: 0.1em;
margin-top: 0.8rem;
opacity: 0.85;
}
h1.sidebar-title,
h2.sidebar-title {
position: absolute;
width: 1px;
height: 1px;
padding: 0;
margin: -1px;
overflow: hidden;
clip: rect(0, 0, 0, 0);
clip-path: inset(50%);
white-space: nowrap;
border: 0;
}
.personae {
max-width: 66ch;
}
.personae h3 {
font-variant: small-caps;
letter-spacing: 0.1em;
margin-top: 2rem;
border-bottom: 1px solid rgba(var(--ink-rgb), 0.35);
padding-bottom: 0.2rem;
}
.personae .who {
font-family: "Courier Prime", "Courier New", monospace;
font-weight: 700;
letter-spacing: 0.06em;
margin: 1rem 0 0.1rem 0;
}
.personae .what {
margin: 0 0 0.2rem 0;
font-style: italic;
opacity: 0.8;
}
.personae .desc {
margin: 0.15rem 0 0 0;
max-width: 60ch;
}
/* --- The reader's protagonist ------------------------------------ */
.pc-name {
font-weight: inherit;
border-bottom: 1px dotted rgba(var(--violet-rgb), 0.55);
}
.screenplay .slug,
.screenplay .transition,
.screenplay .character { text-transform: uppercase; }
.name-field {
border: 1px solid rgba(var(--violet-rgb), 0.55);
border-radius: 5px;
padding: 0.9rem 1rem;
margin: 1.6rem auto;
max-width: 60ch;
}
.name-label { margin: 0 0 0.6rem 0; }
.name-inputs { display: flex; gap: 0.5rem; flex-wrap: wrap; }
.name-inputs input {
font: inherit;
padding: 0.3rem 0.6rem;
border: 1px solid rgba(var(--ink-rgb), 0.45);
border-radius: 4px;
background: rgba(var(--ink-rgb), 0.06);
max-width: 14ch;
}
.name-note {
font-size: 0.82rem;
opacity: 0.7;
margin: 0.6rem 0 0 0;
}
.name-label,
.name-confirm {
font-size: 1.2rem;
}
.name-inputs input,
.name-inputs button {
font: inherit;
font-size: 1.2rem;
}
/* --- Artifacts ---------------------------------------------------- */
.artifact {
font-family: ui-monospace, "Courier New", monospace;
font-size: 0.88rem;
line-height: 1.45;
max-width: 66ch;
margin: 1.4rem 0;
border-radius: 5px;
overflow: hidden;
}
.artifact p { margin: 0.1rem 0; }
/* Discord */
.discord { border: 1px solid rgba(var(--blurple-rgb), 0.5); }
.discord-head {
background: rgba(var(--blurple-rgb), 0.14);
padding: 0.4rem 0.8rem;
display: flex; gap: 0.8rem;
}
.discord-server { font-weight: 700; letter-spacing: 0.06em; }
.discord-channel { opacity: 0.75; }
.discord-body { padding: 0.7rem 0.8rem; }
.discord-msg { margin-bottom: 0.7rem; }
.discord-who { font-weight: 700; }
.discord-role {
font-size: 0.7rem; letter-spacing: 0.08em;
background: rgba(var(--violet-rgb), 0.25);
padding: 0.05rem 0.4rem; border-radius: 3px; margin-left: 0.4rem;
}
.discord-at { opacity: 0.55; margin-left: 0.5rem; font-size: 0.78rem; }
.discord-reacts { margin-top: 0.2rem !important; }
.react {
display: inline-block; font-size: 0.75rem;
border: 1px solid rgba(var(--ink-rgb),0.35); border-radius: 10px;
padding: 0 0.45rem; margin-right: 0.3rem;
}
/* Moderation log */
.modlog {
border-left: 3px solid var(--coral);
background: rgba(var(--coral-rgb), 0.08);
padding: 0.6rem 0.9rem;
font-size: 0.82rem;
letter-spacing: 0.03em;
}
/* Git */
.commit {
border: 1px solid rgba(var(--ink-rgb), 0.4);
padding: 0.7rem 0.9rem;
background: rgba(var(--ink-rgb), 0.05);
}
.commit-hash { color: var(--gold); font-weight: 700; }
.commit-meta { opacity: 0.7; }
.commit-msg { margin-top: 0.5rem; padding-left: 1.5rem; }
/* Terminal */
.terminal {
background: var(--panel-hard);
color: var(--ink);
padding: 0.7rem 0.9rem;
border: 1px solid rgba(var(--ink-rgb),0.35);
}
.term-in { color: var(--green); }
.term-in::before { content: ""; }
.term-out { opacity: 0.9; }
/* AI */
.aichat { border: 1px solid rgba(var(--green-rgb), 0.5); }
.ai-model {
background: rgba(var(--green-rgb), 0.16);
padding: 0.35rem 0.8rem !important;
font-weight: 700; letter-spacing: 0.1em; font-size: 0.75rem;
}
.ai-system { padding: 0.4rem 0.8rem; font-size: 0.8rem; opacity: 0.85; }
.ai-system pre { white-space: pre-wrap; margin: 0.4rem 0 0 0; }
.ai-body { padding: 0.6rem 0.8rem; }
.ai-turn { margin-bottom: 0.6rem; }
.ai-role { font-size: 0.68rem; letter-spacing: 0.12em; opacity: 0.6; }
.ai-assistant .ai-text { border-left: 2px solid rgba(46,160,120,0.6); padding-left: 0.6rem; }
/* Email */
.email { border: 1px solid rgba(var(--ink-rgb),0.45); padding: 0.7rem 0.9rem; }
.email-head td { padding: 0 0.6rem 0.1rem 0; vertical-align: top; font-size: 0.82rem; }
.email-head td:first-child { opacity: 0.6; }
.email-body { margin-top: 0.6rem; }
/* Handouts */
.handout {
border: 1px solid currentColor;
padding: 1rem 1.2rem;
font-family: "Courier Prime", "Courier New", monospace;
}
.handout-title {
font-weight: 700; letter-spacing: 0.1em; text-transform: uppercase;
border-bottom: 1px solid currentColor; padding-bottom: 0.4rem;
margin-bottom: 0.7rem !important;
}
.handout-table { width: 100%; font-size: 0.85rem; margin: 0.5rem 0; }
.handout-table td.k { opacity: 0.65; width: 34%; padding-right: 1rem; vertical-align: top; }
/* --- Prose between scenes ---------------------------------------- */
.prose {
max-width: 64ch;
margin: 1.5rem 0 2rem 0;
font-family: "Iowan Old Style", "Palatino Linotype", Palatino,
"Book Antiqua", Georgia, serif;
font-size: 1.06rem;
line-height: 1.65;
color: var(--ink);
}
.prose p {
margin: 0 0 1.05rem 0;
}
.prose p:first-child { margin-top: 0; }
.prose p:last-child { margin-bottom: 0; }
blockquote.turn {
max-width: 64ch;
border-left: 3px solid rgba(var(--violet-rgb), 0.6);
padding-left: 1rem;
margin: 1.4rem 0 0.6rem 0;
}
.name-confirm {
margin: 0.7rem 0 0 0;
font-weight: 600;
}
/* --- The d20 ------------------------------------------------------ */
.roll {
border: 1px solid rgba(var(--violet-rgb), 0.5);
border-radius: 5px;
padding: 0.7rem 0.9rem;
margin: 1.2rem 0;
max-width: 60ch;
font-family: ui-monospace, "Courier New", monospace;
}
.roll-head {
display: flex;
justify-content: space-between;
font-size: 0.75rem;
letter-spacing: 0.12em;
opacity: 0.75;
margin-bottom: 0.5rem;
}
.roll-bar { display: flex; gap: 0.7rem; align-items: center; margin-top: 0.3rem; }
.roll-go, .roll-rewrite {
font: inherit;
font-size: 0.82rem;
padding: 0.25rem 0.9rem;
border-radius: 4px;
border: 1px solid rgba(var(--ink-rgb), 0.5);
background: rgba(var(--violet-rgb), 0.15);
cursor: pointer;
}
.roll-rewrite { background: rgba(var(--coral-rgb), 0.12); }
.roll-go:hover { background: rgba(var(--violet-rgb), 0.3); }
.roll-rewrite:hover { background: rgba(var(--coral-rgb), 0.25); }
.roll-value { font-size: 0.9rem; letter-spacing: 0.05em; }
.roll-out {
margin: 0.6rem 0 0 0 !important;
font-family: "Courier Prime", "Courier New", monospace;
min-height: 1.2rem;
}
.roll-echo { font-size: 0.8rem; opacity: 0.8; }
.roll-note { font-size: 0.8rem; opacity: 0.6; margin: 0.4rem 0 0 0 !important; }
.roll-foot {
font-size: 0.72rem;
letter-spacing: 0.1em;
opacity: 0.55;
margin: 0.5rem 0 0 0 !important;
border-top: 1px solid rgba(var(--ink-rgb),0.25);
padding-top: 0.35rem;
}
.roll-cue {
margin: 0.6rem 0 0 4ch !important;
font-family: "Courier Prime", "Courier New", monospace;
font-weight: 700;
letter-spacing: 0.06em;
}
.roll-line {
margin: 0 0 0 6ch !important;
max-width: 40ch;
font-family: "Courier Prime", "Courier New", monospace;
}
.roll-out .roll-line:first-child { margin-left: 0 !important; max-width: none; }
.companion-name {
font-family: "Courier Prime", "Courier New", monospace;
font-weight: 700;
letter-spacing: 0.14em;
font-size: 1.05rem;
margin: 0.7rem 0 0.3rem 0 !important;
}
.companion-intro { max-width: 58ch; margin: 0 0 0.3rem 0 !important; }
.session { max-width: 60ch; margin: 1.1rem 0; }
.session-who {
font-family: "Courier Prime", "Courier New", monospace;
font-weight: 700; letter-spacing: 0.12em; margin: 0 0 0.3rem 0 !important;
}
.session-text { margin: 0 !important; }
.ac-name { border-bottom: 1px dotted rgba(var(--violet-rgb), 0.55); }
.companion-naming { margin-top: 0.6rem; }
/* --- Plots -------------------------------------------------------- */
.plot {
border: 1px solid rgba(var(--violet-rgb), 0.5);
border-radius: 5px;
padding: 0.7rem 0.9rem;
margin: 1.2rem 0;
max-width: 62ch;
font-family: ui-monospace, "Courier New", monospace;
}
.plot-controls {
display: flex; gap: 1rem; flex-wrap: wrap;
font-size: 0.8rem; opacity: 0.85; margin: 0.4rem 0;
}
.plot-controls input {
font: inherit; font-size: 0.8rem; width: 7ch;
padding: 0.15rem 0.35rem;
border: 1px solid rgba(var(--ink-rgb),0.45);
border-radius: 3px;
background: rgba(var(--ink-rgb),0.06);
}
.plot-status { font-size: 0.75rem; letter-spacing: 0.1em; opacity: 0.7; }
.plot canvas {
display: block;
margin-top: 0.6rem;
background: var(--paper);
border: 1px solid rgba(var(--ink-rgb),0.3);
border-radius: 3px;
}
.roll-go:disabled, .roll-rewrite:disabled {
opacity: 0.4;
cursor: default;
}
.sketch {
border: 1px solid rgba(var(--violet-rgb), 0.5);
border-radius: 5px;
padding: 0.7rem 0.9rem;
margin: 1.2rem 0;
max-width: 62ch;
font-family: ui-monospace, "Courier New", monospace;
}
.sketch canvas {
display: block;
margin-top: 0.7rem;
background: var(--paper);
border: 1px solid rgba(var(--ink-rgb),0.3);
border-radius: 3px;
max-width: 100%;
}
.sketch-page {
margin-top: 0.7rem;
padding: 0.5rem 0.6rem;
border: 1px solid rgba(var(--ink-rgb),0.3);
border-radius: 3px;
background: rgba(var(--ink-rgb),0.04);
font-family: ui-monospace, "Courier New", monospace;
font-size: 0.9rem;
}
.sketch-page button {
font: inherit; font-size: 0.85rem;
border: 1px solid rgba(var(--ink-rgb),0.45);
border-radius: 3px;
background: rgba(var(--ink-rgb),0.08);
cursor: pointer;
min-width: 2ch;
}
/* --- The page itself, when Quarto is not doing it for us ---------- */
.screenplay, .artifact, .prose, .handout, .beats, .roll, .plot, .sketch,
.todo, .puzzle-box, .personae, .name-field, .live-cell, .session {
color: var(--ink);
}
.handout, .puzzle-cell, .sign { border-color: var(--rule); }
.terminal { background: var(--panel-hard); color: var(--ink); }
.title-page .title, .title-page .subtitle { color: var(--ink); }
/* --- Form controls -------------------------------------------------
Inputs, textareas and buttons do not inherit colour from the page,
so every one of them needs telling, or the reader types black on
black and cannot see what they are writing.
------------------------------------------------------------------- */
.name-inputs input,
.companion-input,
.todo-input,
.plot-controls input,
.live-src,
.sketch textarea,
.sketch-page input {
color: var(--ink);
background: var(--panel);
border-color: var(--rule);
caret-color: var(--ink);
}
.name-inputs input::placeholder,
.companion-input::placeholder,
.todo-input::placeholder,
.sketch-page input::placeholder,
.live-src::placeholder {
color: var(--ink-soft);
opacity: 1;
}
.roll-go, .roll-rewrite, .live-run, .todo-del,
.sketch-page button, .puzzle-cell {
color: var(--ink);
}
.sketch-page button {
background: var(--panel);
border-color: var(--rule);
}
/* Quarto's own search box does not follow the book's palette on every
theme, so it is told here as well. */
#quarto-search input,
#quarto-search .aa-Input,
.aa-Form,
.aa-InputWrapper input,
.quarto-search input {
background: var(--panel) !important;
color: var(--ink) !important;
border-color: var(--rule) !important;
}
.aa-Form { border: 1px solid var(--rule) !important; }
#quarto-search input::placeholder,
.aa-Input::placeholder {
color: var(--ink-soft) !important;
opacity: 1;
}
.aa-DetachedSearchButton, .quarto-search-button {
background: var(--panel) !important;
color: var(--ink) !important;
border-color: var(--rule) !important;
}
/* Canvases inherit nothing, so the sketch cells read their ink off the
element's own resolved colour. This is the line that gives them one. */
.sketch canvas, .plot canvas {
color: var(--ink);
background: transparent;
}
.tribute-heading {
margin: 2rem 0 0.5rem;
font-variant: small-caps;
font-weight: 600;
letter-spacing: 0.04em;
}
.tribute p {
margin: 0.6rem 0;
}
.tribute-meta {
margin-top: 2rem;
padding-top: 1rem;
border-top: 1px solid var(--bs-border-color);
text-align: right;
font-size: 0.85rem;
}
.tribute-meta p {
margin: 0.25rem 0;
}
.tribute-date {
font-style: italic;
}
.tribute-attribution {
font-size: 1rem;
}
.tribute-source {
margin-top: 0.75rem !important;
}
.footnote {
margin-top: 1.5rem;
font-size: 0.9rem;
color: var(--bs-secondary);
}
/* ---------------------------------------------------------------
The three endings.
All three are in the HTML. Which one is visible is a class on
<body>, written once by fedoras.reader/paint-standing! from the
reader's standing, so a chapter that forks does it here rather than
in nine lines of DOM work per passage.
A page with no class on it shows the middle one. That is what the
print edition gets, and it is what the table actually got, and the
PDF reads straight through with no gap and no note.
--------------------------------------------------------------- */
.ending { display: none; }
.ending-reconciled { display: block; }
body.standing-closed .ending-reconciled { display: none; }
body.standing-outstanding .ending-reconciled { display: none; }
body.standing-closed .ending-closed { display: block; }
body.standing-outstanding .ending-outstanding { display: block; }
@media print {
.ending { display: none !important; }
.ending-reconciled { display: block !important; }
}
/* ---------------------------------------------------------------
The slips.
--------------------------------------------------------------- */
.slip {
margin: 1.2rem 0 1.2rem 4ch !important;
padding-left: 1rem;
max-width: 46ch;
border-left: 2px solid rgba(var(--coral-rgb), 0.55);
font-family: "Courier Prime", "Courier New", monospace;
font-style: italic;
opacity: 0.8;
white-space: pre-wrap;
}
#quarto-margin-sidebar { display: none; }
.scene-code {
border: 1px solid var(--rule);
border-radius: 3px;
padding: 0.6rem 0.8rem;
margin: 0.9rem 0 1.1rem 0;
max-width: 62ch;
font-family: ui-monospace, "Courier New", monospace;
font-size: 0.88rem;
line-height: 1.45;
background: var(--panel);
color: var(--ink);
overflow-x: auto;
}
.scene-code pre { margin: 0; }
.scene-code code { background: none; padding: 0; }
/* Pressing Enroll flashes the name it confirms, the same name or a new
one, so the press can be seen to have done something. */
.name-confirm .pc-name.pc-flash {
animation: pc-flash 1.4s ease-out;
}
@keyframes pc-flash {
0%, 30% { color: var(--green); }
}</style><script src="scittle.js" type="application/javascript"></script><div style="display:none;"><script type="application/x-scittle">(ns fedoras.carry
"What the reader carries between chapters."
(:require [clojure.string :as str]))
(def ^:private book-key
"The registration on the front of the file. It is not a secret and it
is not pretending to be one — it is the number this is keyed to, and
it is the same number a reader has been looking at since August."
3812)
;; ---------------------------------------------------------------------
;; Bytes
;; ---------------------------------------------------------------------
(defn- to-bytes [s] (.encode (js/TextEncoder.) s))
(defn- from-bytes [b] (.decode (js/TextDecoder. "utf-8") b))
(defn- bytes->str [b]
(loop [i 0 acc ""]
(if (>= i (.-length b))
acc
(recur (inc i) (str acc (js/String.fromCharCode (aget b i)))))))
(defn- str->bytes [s]
(let [out (js/Uint8Array. (count s))]
(dotimes [i (count s)] (aset out i (.charCodeAt s i)))
out))
;; ---------------------------------------------------------------------
;; The keystream
;;
;; The same small xorshift the dice and the floors use, so there is one
;; generator in this project and not four.
;; ---------------------------------------------------------------------
(defn- keystream [n seed]
(let [out (js/Uint8Array. n)]
(loop [i 0 x (bit-or 1 (bit-and seed 0x7fffffff))]
(if (>= i n)
out
(let [x (bit-and (bit-xor x (bit-shift-left x 13)) 0x7fffffff)
x (bit-and (bit-xor x (unsigned-bit-shift-right x 17)) 0x7fffffff)
x (bit-and (bit-xor x (bit-shift-left x 5)) 0x7fffffff)]
(aset out i (bit-and x 0xff))
(recur (inc i) x))))))
(defn- mask [b seed]
(let [k (keystream (.-length b) seed)
out (js/Uint8Array. (.-length b))]
(dotimes [i (.-length b)] (aset out i (bit-xor (aget b i) (aget k i))))
out))
;; ---------------------------------------------------------------------
;; Base64, url-safe
;; ---------------------------------------------------------------------
(defn- b64 [b]
(-> (js/btoa (bytes->str b))
(str/replace "+" "-")
(str/replace "/" "_")
(str/replace "=" "")))
(defn- un-b64 [s]
(let [t (-> s (str/replace "-" "+") (str/replace "_" "/"))
pad (case (mod (count t) 4) 2 "==" 3 "=" "")]
(str->bytes (js/atob (str t pad)))))
;; ---------------------------------------------------------------------
;; Rolls, short
;; ---------------------------------------------------------------------
(defn- pack-rolls
"[roll mod rewrites], shortest form. A roll with no modifier and no
rewrites is one number."
[rolls]
(into {}
(for [[id {:keys [roll mod rewrites]}] rolls
:when roll]
[id (cond
(pos? (or rewrites 0)) [roll (or mod 0) rewrites]
(not (zero? (or mod 0))) [roll mod]
:else [roll])])))
(defn- unpack-rolls
"Every shape this has ever emitted: a bare number, the short vector,
and the verbose map that went out while `pack-rolls` was sitting here
unused. Tokens from before this change still read."
[m]
(into {}
(for [[id v] m]
[(clojure.core/name id)
(cond
(number? v) {:roll v :mod 0 :rewrites 0}
(map? v) {:roll (:roll v)
:mod (or (:mod v) 0)
:rewrites (or (:rewrites v) 0)}
:else {:roll (nth v 0)
:mod (nth v 1 0)
:rewrites (nth v 2 0)})])))
;; ---------------------------------------------------------------------
;; The token
;; ---------------------------------------------------------------------
(defn- checksum [b]
(loop [i 0 s 7]
(if (>= i (.-length b))
(mod s 251)
(recur (inc i) (mod (+ (* s 31) (aget b i)) 251)))))
(defn pack
"A map to a token. The keys are one letter each because this goes in
a query string thirty times a page."
[{:keys [name companion echo rolls deeds epoch todo]}]
(try
(let [payload (js/JSON.stringify
(clj->js
(cond-> {}
name (assoc :n name)
companion (assoc :a [(:n companion) (:given companion)])
(pos? (or echo 0)) (assoc :e echo)
(seq rolls) (assoc :r (pack-rolls rolls))
(seq deeds) (assoc :d (mapv clojure.core/name deeds))
;; when the reader last withdrew the whole record.
;; it travels because the alternative is that only
;; the state travels, and then a link from before
;; the withdrawal quietly reinstates it.
(pos? (or epoch 0)) (assoc :g epoch)
(seq todo) (assoc :t [(:seq todo 0) (:items todo)]))))
body (mask (to-bytes payload) book-key)
out (js/Uint8Array. (inc (.-length body)))]
(aset out 0 (checksum body))
(dotimes [i (.-length body)] (aset out (inc i) (aget body i)))
(b64 out))
(catch :default _ nil)))
(defn unpack
"A token back to a map, or nil if anybody has been at it.
An absent field comes back empty rather than missing, which is fine
and is not a licence: the caller merges this forward and knows that an
empty Echo means the token is old, not that the Echo is nought."
[s]
(try
(when-not (str/blank? s)
(let [raw (un-b64 s)
want (aget raw 0)
body (.slice raw 1)]
(when (= want (checksum body))
(let [m (js->clj (js/JSON.parse (from-bytes (mask body book-key)))
:keywordize-keys true)]
{:name (:n m)
:companion (when-let [a (:a m)] {:n (first a) :given (or (second a) "")})
:echo (or (:e m) 0)
:rolls (unpack-rolls (or (:r m) {}))
:deeds (mapv keyword (or (:d m) []))
:epoch (or (:g m) 0)
:todo (when-let [t (:t m)] {:seq (first t) :items (or (second t) [])})}))))
(catch :default _ nil)))
;; ---------------------------------------------------------------------
;; When it does not reconcile
;; ---------------------------------------------------------------------
(defn complain! []
(js/console.warn
"016.09 — entry does not reconcile and has not been carried forward. Retained."))</script><script type="application/x-scittle">(ns fedoras.reader
"Everything the reader owns.
One atom: containing Name, animal, echo, fortune, score, deeds. A widget
reads it and never touches storage directly, and every change goes through
one of the setters, which writes, re-reads, and lets the watches fire."
(:require [clojure.string :as str]
[fedoras.carry :as carry]))
;; ---------------------------------------------------------------------
;; Storage
;; ---------------------------------------------------------------------
(def prefix "fedoras.")
(def carry-param :f)
(def forget-param
"A page that loads with this on it withdraws its own record and stops.
It is a separate field from the token because it must work on a page
that has never seen a token."
:forget)
(def withdrawn-param
"Survives exactly one reload, to say the thing was done. The state it
would otherwise have been recorded in has just been deleted, which is
the one place a confirmation cannot live."
:withdrawn)
(def legacy-params
"The fields the query string used to carry, one per fact. Stripped off
any link that still has them. There was a second copy of this list
called `carried-params` and the two had drifted."
[:pc :pcl :ac :acn :echo :fortune :score])
(defn- read-json [s]
(js->clj (js/JSON.parse s) :keywordize-keys true))
(defn- write-json [v]
(js/JSON.stringify (clj->js v)))
(defn stored [key]
(try
(when-let [s (.getItem js/localStorage (str prefix (name key)))]
(read-json s))
(catch :default _ nil)))
(defn store! [key val]
(try (.setItem js/localStorage (str prefix (name key)) (write-json val))
(catch :default _ nil))
val)
(defn remove!
"Take something out rather than writing an empty one over it, because
a stored nil and a missing key read back the same and only one of them
is what was meant."
[key]
(try (.removeItem js/localStorage (str prefix (clojure.core/name key)))
(catch :default _ nil)))
(defn storage-works?
"Whether anything at all is going to be persisted.
On a file:// path some browsers give every page its own opaque origin,
which means localStorage throws and the whole book forgets the reader
the moment they click anything. Worth knowing rather than guessing."
[]
(try
(.setItem js/localStorage (str prefix "probe") "1")
(let [ok (= "1" (.getItem js/localStorage (str prefix "probe")))]
(.removeItem js/localStorage (str prefix "probe"))
ok)
(catch :default _ false)))
;; ---------------------------------------------------------------------
;; The query string, which is a transport and nothing else
;; ---------------------------------------------------------------------
(defn- current-url [] (js/URL. (.-href js/location)))
(defn param [key]
(try
(let [v (.get (.-searchParams (current-url)) (name key))]
(when-not (str/blank? v) v))
(catch :default _ nil)))
(defn set-params! [m]
(try
(let [u (current-url) sp (.-searchParams u)]
(doseq [[k v] m]
(if (or (nil? v) (= "" v))
(.delete sp (name k))
(.set sp (name k) (str v))))
(.replaceState js/history nil "" (.toString u)))
(catch :default _ nil)))
(defn- int-or [v d]
(let [n (js/parseInt (str v) 10)] (if (js/isNaN n) d n)))
;; ---------------------------------------------------------------------
;; The atom
;; ---------------------------------------------------------------------
(def default-name ["Owen" "Mercer"])
(def state (atom nil))
(def animal-names
"Number to the animal's grammar: what it is called, what more than one
of them is called, what a ledger would file it under. Filled in by
`fedoras.state/assets` from a later script tag, so it is empty for the
moment between this file being read and the roster arriving, and
nothing here may treat an empty roster as a missing roll."
(atom {}))
(defn- as-grammar
"One roster entry, whatever shape it turned up in.
The page used to be handed {1 \"Pigeon\"} and is now handed
{1 {:animal \"Pigeon\" :plural \"pigeons\" ...}}, and a book whose
`names-form` has not caught up with its roster hands over one of each.
A bare string is an animal with no grammar, which is precisely what it
was before, so it becomes one here.
This is normalised at the boundary rather than at each use because the
alternative was a `merge` three functions away receiving a string,
throwing `conj on a map takes map entries`, and taking down every
render watch on the page — a build that is one function out of step
should read a little worse, not stop."
[v]
(cond
(map? v) v
(string? v) {:animal v}
:else {}))
(defn- read-companion []
(let [s (stored :companion)
n (int-or (first s) nil)]
(when (and n (<= 1 n 20))
(let [given (or (nth s 2 nil) "")
g (as-grammar (get @animal-names n))
;; the animal's name is a convenience and the roster may not
;; have landed yet. the number is the fact.
animal (or (:animal g) (nth s 1 nil) "")
named? (not (str/blank? given))]
(merge {:plural "" :taxonomy "" :collective "" :other-names []}
g
{:n n
:animal animal
:given given
:named? named?
:name (cond named? (str/trim given)
(not (str/blank? animal)) animal
:else (str "d20 " n))})))))
(defn- read-name []
(let [s (stored :pc)]
[(or (first s) (first default-name))
(or (second s) (second default-name))]))
(defn refresh!
"Total on purpose. Every render watch in the book hangs off this atom,
so anything that throws in here blanks the whole page, and what it
reads is JSON that a previous version of this file wrote, which is not
a thing to be optimistic about. A key that is the wrong shape reads as
absent."
[]
(reset! state
{:name (read-name)
:companion (try (read-companion) (catch :default _ nil))
:echo (int-or (stored :echo) 0)
:rolls (let [r (stored :rolls)] (if (map? r) r {}))
:deeds (let [d (stored :deeds)]
(set (map keyword (if (sequential? d) d []))))
:epoch (int-or (stored :epoch) 0)
:todo (let [t (stored :todo)] (if (sequential? t) t []))
:todo-seq (int-or (stored :todo-seq) 0)}))
;; ---------------------------------------------------------------------
;; What a chapter may ask for
;; ---------------------------------------------------------------------
(defn reader-name [] (:name @state))
(defn companion [] (:companion @state))
(defn echo [] (:echo @state))
(defn deeds [] (:deeds @state))
(defn fortune [] (count (:deeds @state)))
(defn epoch
"When this reader last withdrew the whole record, in seconds, or
nought if they never have.
It is not a clock and nothing displays it. It exists so that a
withdrawal can be compared against a link: a token stamped earlier
than this was written by somebody who has since been forgotten, and it
is not allowed to put them back."
[]
(:epoch @state))
(defn standing
"Fortune less echo. Added to every roll for the rest of the book, and
the number the last chapter reads to decide how it ends."
[]
(- (fortune) (echo)))
(defn registration [] "3812")
;; ---------------------------------------------------------------------
;; And what it may change
;; ---------------------------------------------------------------------
(defn set-name! [f l]
(store! :pc [(if (str/blank? f) (first default-name) (str/trim f))
(if (str/blank? l) (second default-name) (str/trim l))])
(refresh!))
(defn set-companion!
"Three cells: the number, the animal's own name as a courtesy, and
whatever the reader called it. The number is the only one that has to
be right, because the other two are recovered from the roster."
[n given]
(store! :companion [n (get-in @animal-names [n :animal] "") (or given "")])
(refresh!))
(defn set-echo! [n] (store! :echo (max 0 n)) (refresh!))
(defn add-echo!
"One more thing taken back."
[]
(set-echo! (inc (echo))))
(defn did!
"Record a deed. A set, so doing the same thing twice is doing it once,
and nothing anywhere says that it happened."
[k]
(store! :deeds (mapv name (conj (deeds) (keyword k))))
(refresh!))
(defn animals!
"The roster's grammar, from the page. Normalised on the way in, so the
shape `fedoras.state/names-form` happens to be emitting this week is
something only this function has an opinion about.
Refreshes, because a companion read before this arrived is holding an
empty animal name."
[m]
(reset! animal-names
(if (map? m)
(into {} (map (fn [[k v]] [k (as-grammar v)])) m)
{}))
(refresh!))
(defn rolls
"Every check the reader has resolved, by id.
Normalised on the way out. Storage keywordizes keys on read, and a
check id is an arbitrary string rather than a name, so the keys come
back as keywords and nothing matches them. And anything that is not a
map at all becomes an empty one, because assoc on a vector with a
string key takes the page down."
[]
(let [r (:rolls @state)]
(if (map? r)
(into {} (map (fn [[k v]] [(name k) v])) r)
{})))
(defn roll-entry [id]
(when-let [e (get (rolls) id)]
{:roll (or (:roll e) (get e "roll"))
:mod (or (:mod e) (get e "mod") 0)
:rewrites (or (:rewrites e) (get e "rewrites") 0)}))
(defn remember-roll! [id e]
(store! :rolls (assoc (rolls) id e))
(refresh!))
(defn score []
(+ (reduce + 0 (keep :roll (vals (rolls))))
(or (:n (companion)) 0)))
;; ---------------------------------------------------------------------
;; Import, once, on arrival
;; ---------------------------------------------------------------------
(def carries-epoch?
"Whether the codec on this page round-trips a withdrawal stamp."
(try
(= 12345 (:epoch (carry/unpack
(carry/pack {:name ["Owen" "Mercer"] :epoch 12345}))))
(catch :default _ false)))
(defn- wipe!
"Everything under the prefix, and then one thing: when that happened."
[at]
(try
(let [ks (vec (for [i (range (.-length js/localStorage))
:let [k (.key js/localStorage i)]
:when (and k (str/starts-with? k prefix))]
k))]
(doseq [k ks] (.removeItem js/localStorage k)))
(catch :default _ nil))
(store! :epoch at))
(defn- merge-token!
[{:keys [name companion echo rolls deeds epoch todo]}]
(let [ours (int-or (stored :epoch) 0)
theirs (or epoch 0)]
(cond
;; A link from before the reader withdrew the record. It is a true
;; account of somebody who does not exist any more, which is not
;; the same thing as an instruction to rebuild them. This is the
;; case that made `forget!` a lie: it emptied one page's storage
;; and every other page, and every entry in the back history, was
;; still holding a complete copy and handed it straight back.
;; A link from before the reader withdrew the record. It is a true
;; account of somebody who does not exist any more, which is not
;; the same thing as an instruction to rebuild them.
;;
;; Only when the codec can say so. A page that cannot read a stamp
;; off a token must not conclude from its absence that every link
;; in the book is stale.
(and carries-epoch? (< theirs ours))
(js/console.info
(str "016.09 — the link this page was opened from was written before the record "
"was withdrawn. Nothing carried forward. Reach this chapter from a page you "
"have opened since, and whatever is current will arrive with you."))
:else
(do
;; They withdrew it somewhere this page has not heard about yet.
;; The erasure travels the way the state travels, which is the
;; only way anything travels in a book read off a disk.
(when (and carries-epoch? (> theirs ours))
(wipe! theirs)
(js/console.info
"016.09 — prior record withdrawn at the reader's request. Nothing carried forward."))
;; the name is the one thing a reader can retype in five seconds,
;; so the token is allowed to have an opinion about it
(when (seq name)
(store! :pc name))
;; The animal:
;;
;; This was write-once — take the token's only if there is
;; nothing here — which is right on one origin and wrong on a
;; folder of files, where every page has its own storage and the
;; token is the only thing that crosses. A reader who opened Act
;; II after rolling and before naming taught that page the horse,
;; permanently, and Act II could never afterwards learn that the
;; horse was called Horace.
;;
;; The Echo is the recency stamp. It only ever goes up, and a
;; reroll raises it, so a token carrying an Echo at least as
;; large as this page's is at least as new as this page and is
;; allowed to speak. One older, and it is a link from before the
;; reroll and is not.
(let [have (read-companion)
here-echo (int-or (stored :echo) 0)
there-echo (or echo 0)]
(when (and (:n companion)
(or (nil? have) (>= there-echo here-echo)))
(store! :companion
[(:n companion) ""
;; a blank name in a token is a reader who had not
;; named it yet, not a reader who unnamed it
(if (str/blank? (:given companion))
(or (:given have) "")
(:given companion))])))
;; upward only, always. after the companion, which reads it.
(store! :echo (max (int-or (stored :echo) 0) (or echo 0)))
;; a check is resolved once, and what is already in this browser
;; was rolled by this reader, so it wins every collision
(when (seq rolls)
(let [named (fn [m] (if (map? m)
(into {} (map (fn [[k v]] [(clojure.core/name k) v])) m)
{}))]
(store! :rolls (merge (named rolls) (named (stored :rolls))))))
;; deeds are a set, and a set does not get smaller by being described
(when (seq deeds)
(let [held (let [d (stored :deeds)] (if (sequential? d) d []))]
(store! :deeds (vec (into (set (map clojure.core/name held))
(map clojure.core/name deeds))))))
(when-let [t todo]
(when (>= (:seq t 0) (int-or (stored :todo-seq) 0))
(store! :todo (:items t))
(store! :todo-seq (:seq t))))))))
(defn- import-token! []
(if-let [t (param carry-param)]
(if-let [m (try (fedoras.carry/unpack t) (catch :default _ nil))]
(merge-token! m)
(try (fedoras.carry/complain!) (catch :default _ nil)))
;; nothing to do, unless somebody has a link from before the token
(do
(when-let [pc (param :pc)]
(store! :pc [pc (or (param :pcl) (second default-name))]))
(when-let [ac (param :ac)]
(let [n (int-or ac nil)]
(when (and n (<= 1 n 20) (nil? (read-companion)))
(store! :companion [n "" (or (param :acn) "")]))))
(when-let [e (param :echo)]
(store! :echo (max (int-or (stored :echo) 0) (int-or e 0)))))))
(defn- withdraw-if-asked!
"A page loaded with a withdrawal stamp on it clears itself and does
nothing else.
This is how one button reaches twelve documents that cannot see each
other. The page the reader clicked opens each of the others in a
hidden frame with the stamp in the query string, and each one runs
this on the way up. Nothing is scripted across the boundary — every
file is its own origin and none of them can touch another's storage —
but a document can always clear its own, and a query string is the one
thing that crosses.
Returns true if this load was a withdrawal, so boot knows to skip the
rest of its work."
[]
(when-let [at (some-> (param forget-param) (int-or nil))]
(when (> at (int-or (stored :epoch) 0))
(wipe! at))
true))
;; ---------------------------------------------------------------------
;; Rendering
;; ---------------------------------------------------------------------
(defn on-render! [k f] (add-watch state k (fn [_ _ _ _] (f))) (f))
(defn el [id] (.getElementById js/document id))
(defn q [node selector] (when node (.querySelector node selector)))
(defn q-all
"Every match, as a vector. One argument searches the document; two
searches inside a node.
Written the long way because a NodeList is not a Clojure collection
and array-seq is not in Scittle's bindings."
([selector] (q-all js/document selector))
([node selector]
(if-not node
[]
(let [nodes (.querySelectorAll node selector)]
(mapv (fn [i] (.item nodes i)) (range (.-length nodes)))))))
(defn text! [node selector s]
(when-let [t (q node selector)] (set! (.-textContent t) s)))
(defn on-click! [node selector f]
(when-let [b (q node selector)] (set! (.-onclick b) f)))
(defn enable! [node selector on? label]
(when-let [b (q node selector)]
(set! (.-disabled b) (not on?))
(when label (set! (.-textContent b) label))))
(defn show! [node selector on?]
(when-let [t (q node selector)]
(set! (.-display (.-style t)) (if on? "flex" "none"))))
(defn widget [k id f]
(on-render! k (fn [] (when-let [node (el id)] (f node)))))
;; ---------------------------------------------------------------------
;; Withdrawing the record, everywhere
;;
;; Twelve documents, each its own origin, none able to read another's
;; storage. Every shared channel is shut: localStorage and IndexedDB are
;; origin-scoped, window.name is cleared on the way across, cookies do
;; not apply to a file, and an iframe gets its own origin so the parent
;; cannot script it.
;;
;; It can still LOAD it. A hidden frame pointed at a sibling chapter,
;; with a stamp in the query string, runs that chapter's own copy of
;; this file, which clears that chapter's own storage. Nothing crosses
;; the boundary except the URL, which is the one thing that was ever
;; going to.
;; ---------------------------------------------------------------------
(defn- sibling-pages
"Every other chapter this page links to.
Read off the sidebar rather than configured, because Quarto already
puts the whole book in it and a hand-kept list of filenames is a list
that goes stale the first time a chapter is renamed."
[]
(let [here (.-pathname js/location)
dir (subs here 0 (inc (.lastIndexOf here "/")))]
(->> (q-all "a[href]")
(keep (fn [a]
(let [h (.getAttribute a "href")]
(when (and h
(not (str/starts-with? h "#"))
(not (re-find #"(?i)^(https?:|mailto:|javascript:)" h)))
(try
(let [u (js/URL. (.-href a))
p (.-pathname u)]
(when (and (str/starts-with? p dir)
(str/ends-with? (str/lower-case p) ".html")
(not= p here))
(str (.-protocol u) "//" (.-host u) p)))
(catch :default _ nil))))))
distinct
vec)))
(defn- sweep!
"Tell every other chapter to withdraw, then call `done` once.
Once, whatever happens: a frame that never fires must not leave the
reader looking at a button that has stopped meaning anything, so there
is a deadline as well as a count."
[at done]
(let [pages (sibling-pages)
fired (atom false)
finish (fn [] (when-not @fired (reset! fired true) (done)))]
(if (empty? pages)
(finish)
(let [box (.createElement js/document "div")
left (atom (count pages))
one (fn [] (when (zero? (swap! left dec)) (finish)))]
(js/console.info "016.09 — withdrawing from" (count pages) "other chapters")
(set! (.-style box)
"position:absolute;width:0;height:0;overflow:hidden;border:0;visibility:hidden")
(.appendChild (.-body js/document) box)
(doseq [p pages]
(let [f (.createElement js/document "iframe")]
(set! (.-onload f) (fn [_] (one)))
(set! (.-onerror f) (fn [_] (one)))
(set! (.-src f) (str p "?" (clojure.core/name forget-param) "=" at))
(.appendChild box f)))
(js/setTimeout finish 5000)))))
(defn forget!
"Forget everything, not the six things somebody remembered to list,
and not only on this page.
Emptying this document's storage was never the whole job: the reader
was also sitting, complete, in the query string of every link on every
other chapter and in every entry of the back history, and the next
navigation put them back. So this clears here, stamps when, and then
visits every other chapter to say so. The stamp is what makes a link
written before the withdrawal refuse to be believed afterwards.
It also says so while it is happening. It used to do all of this in
silence and then reload, which is indistinguishable from a button that
does nothing except reload."
[]
(let [at (quot (.now js/Date) 1000)
btn (q js/document ".pc-forget")]
(when btn
(set! (.-disabled btn) true)
(set! (.-textContent btn) "Withdrawing the record…"))
(wipe! at)
(sweep! at
(fn []
(let [u (current-url)]
(doseq [k (concat [carry-param forget-param] legacy-params)]
(.delete (.-searchParams u) (clojure.core/name k)))
(.set (.-searchParams u) (clojure.core/name withdrawn-param) "1")
(set! (.-href js/location) (.toString u)))))))
(defn- note-withdrawal!
"One line, on the way back up, and then the button goes back to
offering. The confirmation cannot be stored, because storing things is
what has just been undone — so it is read off the query string once,
before anything else in boot is allowed to tidy the query string away."
[withdrew?]
(when withdrew?
(js/console.info
"016.09 — record withdrawn from this chapter and from every chapter linked from it.")
(when-let [b (q js/document ".pc-forget")]
(set! (.-textContent b) "Record withdrawn")
(js/setTimeout (fn [] (set! (.-textContent b) "Forget everything")) 5000))))
;; ---------------------------------------------------------------------
;; Export
;; ---------------------------------------------------------------------
(defn token
"What this reader looks like from outside. Recomputed rather than
stored, so it cannot disagree with the state it is describing.
Guarded, because this runs on every render and inside `decorate-links!`,
and a codec that throws on one unexpected key should cost the reader a
shareable link and nothing else."
[]
(try
(let [{:keys [name companion echo rolls deeds todo todo-seq]} @state]
(fedoras.carry/pack
{:name name
:companion (when companion (select-keys companion [:n :given]))
:echo echo
:rolls rolls
:deeds deeds
:epoch (epoch)
:todo (when (seq todo) {:seq (or todo-seq 0) :items todo})}))
(catch :default e
(js/console.warn "fedoras: could not pack the carry token —" e)
nil)))
(defn decorate-links!
"Every internal link carries one field.
Two things were wrong before this and both of them mattered. It ran
inline, at parse time, so any link below the script tag did not exist
yet — which is every prev-and-next arrow Quarto puts in the footer.
And it copied the query string rather than the state, so a page opened
from storage handed on nothing."
[]
(when-let [t (token)]
(doseq [a (q-all "a[href]")]
(let [h (.getAttribute a "href")]
(when (and h
(not (str/starts-with? h "#"))
(not (re-find #"(?i)^(https?:|mailto:|javascript:)" h)))
(try
(let [lu (js/URL. (.-href a))
sp (.-searchParams lu)]
(doseq [k legacy-params] (.delete sp (clojure.core/name k)))
(.set sp (clojure.core/name carry-param) t)
(set! (.-href a) (.toString lu)))
(catch :default _ nil)))))))
(defn- rewrite-address!
"Put the token in this page's own address bar and take the old fields
off it, so a reader who arrived on a legacy link stops looking at
their own Echo."
[]
(when-let [t (token)]
(set-params! (into {(clojure.core/name carry-param) t}
(map (fn [k] [k nil])
(concat [forget-param withdrawn-param] legacy-params))))))
;; ---------------------------------------------------------------------
;; Tokens
;;
;; It used to be a chain of str/replace calls, which is why {pc-last}
;; worked in a scene and rendered as the literal characters {pc-last}
;; inside a dice passage.
;;
;; Case follows the token: {ac} is `ted`, {Ac} is `Ted`, {AC} is `TED`,
;; so a passage can start a sentence or write a cue line without the
;; author reaching for a second token. Note that this makes {PC} in an
;; already-written scene render as OWEN rather than Owen; the old regex
;; was case-insensitive and threw the information away.
;;
;; An unkown token is passed over: A brace in a passage that is not
;; something this understands comes out exactly as it went in, so this
;; is safe to run over arbitrary prose.
;; ---------------------------------------------------------------------
(def ^:private token-re #"\{([A-Za-z]+)(-[A-Za-z-]+)?\}")
(defn- apply-case [head s]
(cond
(str/blank? s) s
(= head (str/upper-case head)) (str/upper-case s)
(= (subs head 0 1) (str/upper-case (subs head 0 1)))
(str (str/upper-case (subs s 0 1)) (subs s 1))
:else s))
(defn render
"Replace every {token} the resolver knows. `resolve` is called with the
lower-cased head and the lower-cased tail — \"ac\" and \"-plural\" for
{ac-plural} — and returns a string or nil."
[resolve s]
(str/replace (or s "") token-re
(fn [m]
(let [[whole head tail] (if (string? m) [m m nil] m)]
(or (some->> (resolve (str/lower-case head)
(some-> tail str/lower-case))
(apply-case head))
whole)))))
(defn- string-hash
"Stable across loads, which is the point: the same sentence picks the
same alternative name every time the reader opens the page, so nothing
reads as though it were rolled twice."
[s]
(reduce (fn [a i] (mod (+ (* 31 a) (.charCodeAt s i)) 1000003))
7 (range (count s))))
(defn- an [s]
(str (if (re-find #"(?i)^[aeiou]" (str s)) "an " "a ") s))
(defn- animal-tokens
"What a passage may say about the animal. The reader's own name for it
is a name; everything else is the species, because a reader who called
a marmot Ted did not thereby decide that two of them are Teds."
[source tail]
(when-let [{:keys [animal plural taxonomy collective other-names name named?]}
(companion)]
(let [kind (str/lower-case (or animal ""))]
(case (or tail "-name")
"-name" (if named? name (str "the " kind))
"-kind" kind
"-a" (an kind)
"-plural" (if (str/blank? plural) (str kind "s") (str/lower-case plural))
"-many" (if (str/blank? collective)
(str "several " (if (str/blank? plural) (str kind "s") plural))
(str (an collective) " of "
(if (str/blank? plural) (str kind "s") plural)))
"-taxonomy" (str/lower-case (or taxonomy kind))
"-given" (if named? name "")
"-other" (if (seq other-names)
(nth other-names (mod (string-hash source) (count other-names)))
(str "the " kind))
nil))))
(defn- reader-tokens [source]
(let [[f l] (reader-name)]
(fn [head tail]
(case head
"pc" (case (or tail "-first")
"-first" f
"-full" (str f " " l)
"-last" l
nil)
"ac" (or (animal-tokens source tail)
;; no roll yet, and a passage still has to read
(case (or tail "-name")
("-name" "-kind" "-other") "the animal"
"-a" "an animal"
"-plural" "animals"
"-many" "several animals"
"-taxonomy" "animal"
"-given" ""
nil))
nil))))
(defn fill-with
"Put the reader into a passage, plus whatever else the caller knows.
The dice box passes the die in this way."
[extra s]
(let [own (reader-tokens s)]
(render (fn [h t] (or (extra h t) (own h t))) s)))
(defn fill
"Put the reader into a passage. The only place any of these are
resolved."
[s]
(fill-with (fn [_ _] nil) s))
(defn animal-label
"Kept for anything still asking. The display name, as stored, not
shouted — the old one upper-cased and every caller lower-cased it
again somewhere else."
[]
(when-let [c (companion)] (:name c)))
;; ---------------------------------------------------------------------
;; The carry-over
;;
;; What a reader takes to the next book.
;; ---------------------------------------------------------------------
(def on-the-record
"What goes in the token. Everything else is furniture.
A key is on this list because it is small and because losing it would
lose the reader's year. Adding one is a decision about how long every
link on every page is going to be, so it is a list and not a
convention."
#{:pc :companion :echo :rolls :deeds :todo})
(defn kept
"Read something the reader left in a room. No widget that calls this
needs to know anything about tokens."
[k]
(stored k))
(defn keep!
"Leave something in a room. It stays where it was made."
[k v]
(store! k v)
(when (contains? on-the-record k) (refresh!))
v)
(def ^:private alphabet "23456789ABCDEFGHJKLMNPQRSTUVWXYZ")
(defn- b32 [n len]
(loop [n n i 0 out ""]
(if (= i len)
out
(recur (quot n 32) (inc i)
(str (nth alphabet (mod n 32)) out)))))
;; ---------------------------------------------------------------------
;; The name and the animal, on every page
;; ---------------------------------------------------------------------
(defn- paint-name []
(let [[f l] (reader-name)]
(doseq [node (q-all ".pc-name")]
(set! (.-textContent node)
(apply-case (or (.getAttribute node "data-case") "pc")
(case (.getAttribute node "data-pc")
"-full" (str f " " l) "-last" l f))))
(when-let [i (el "pc-first")] (when (str/blank? (.-value i)) (set! (.-value i) f)))
(when-let [i (el "pc-last")] (when (str/blank? (.-value i)) (set! (.-value i) l)))))
(defn- paint-companion
"Each span carries the token that made it, so {ac-plural} written in a
scene at build time still says `marmots` after the reader rolls a
marmot. It used to carry nothing and every span got the same word."
[]
(doseq [node (q-all ".ac-name")]
(let [tail (or (.getAttribute node "data-ac") "-name")
head (or (.getAttribute node "data-case") "ac")]
(set! (.-textContent node)
(or (some->> ((reader-tokens (or (.-textContent node) "")) "ac" tail)
(apply-case head))
"the animal")))))
(defn- paint-tokens []
(doseq [node (q-all ".tok")]
(set! (.-textContent node) (fill (.getAttribute node "data-tok")))))
;; ---------------------------------------------------------------------
;; Ending / Standing
;; ---------------------------------------------------------------------
(def deed-roll
[:nerve ;; a natural twenty with the Echo at nought
:named-it ;; the animal was given a name and kept it
:kept-the-programmes ;; both sheets went in the bag and stayed there
:no-name-for-the-box ;; nothing was spoken into the undertaker's box
:read-it-back ;; the ledger was read against the room out loud
:opened-the-cage
:held-the-door
:went-back-for-it
:signed-nothing
:walked-out
:told-a-new-one ;; Ariathne was paid in something that was theirs
:said-why]) ;; the chancellor asked, and got a true answer
(def ^:private deed-bits 15)
(defn- deed-mask []
(let [held (deeds)]
(reduce (fn [acc [index deed]]
(if (contains? held deed)
(+ acc (bit-shift-left 1 index))
acc))
0
(map-indexed vector deed-roll))))
(defn- deeds-from-mask [mask]
(set (keep-indexed (fn [index deed]
(when (pos? (bit-and mask (bit-shift-left 1 index)))
deed))
deed-roll)))
(def band-code {:closed 0 :reconciled 1 :outstanding 2})
(def code-band {0 :closed 1 :reconciled 2 :outstanding})
(defn ending-band []
(let [reader-standing (standing)]
(cond
(>= reader-standing 4) :outstanding
(>= reader-standing 0) :reconciled
:else :closed)))
(defn- paint-standing!
"One class on the body, so a chapter that forks three ways does it in
the stylesheet instead of in nine lines of DOM work per passage. A page
with no class on it shows :reconciled, which is what the print edition
gets and what the table actually got.
This existed and was never wired to anything, which meant every
`sp/by-standing` on every page was rendering all three endings at
once, or none."
[]
(when-let [body (.-body js/document)]
(let [classes (.-classList body)]
(doseq [old ["standing-closed" "standing-reconciled" "standing-outstanding"]]
(.remove classes old))
(.add classes (str "standing-" (clojure.core/name (ending-band)))))))
(def code-version 3)
(defn- check-char [body]
(nth alphabet
(mod (reduce + (map (fn [c] (.indexOf alphabet c)) body)) 32)))
(defn carry-code
"What this reader looks like to the next book, as an accession line."
[]
(let [n (+ (* code-version 4294967296)
(* (get band-code (ending-band) 1) 1073741824)
(* (min 31 (or (:n (companion)) 0)) 33554432)
(* (min 31 (echo)) 1048576)
(* (deed-mask) 32)
(min 31 (quot (score) 10)))
body (b32 n 7)]
(str "016.14 · " (registration) " · "
(subs body 0 4) "-" (subs body 4) (check-char body))))
(defn read-carry
"The other side of it, for the book after this one."
[s]
(let [cleaned (-> (str s) str/upper-case (str/replace #"[^2-9A-Z]" ""))
tail (subs cleaned (max 0 (- (count cleaned) 8)))]
(when (= 8 (count tail))
(let [body (subs tail 0 7)
n (reduce (fn [acc c] (+ (* 32 acc) (.indexOf alphabet c))) 0 body)]
(when (= (nth tail 7) (check-char body))
{:version (quot n 4294967296)
:band (get code-band (mod (quot n 1073741824) 4))
:companion (mod (quot n 33554432) 32)
:echo (mod (quot n 1048576) 32)
:deeds (deeds-from-mask (mod (quot n 32) (bit-shift-left 1 deed-bits)))
:score-floor (* 10 (mod n 32))})))))
;; ---------------------------------------------------------------------
;; Is any of this working
;;
;; Type fedoras.reader.diagnose_BANG_() in the console. Faster than
;; opening the storage inspector and reading JSON, and it says whether
;; the token agrees with the storage, which is the failure that cost an
;; animal.
;; ---------------------------------------------------------------------
(defn diagnose! []
(let [t (param carry-param)]
(js/console.log "storage works: " (storage-works?))
(js/console.log "origin: " (.-origin js/location)
(if (= "file:" (.-protocol js/location))
"— every page may have its own storage"
"— one bucket for the whole book"))
(js/console.log "name: " (pr-str (reader-name)))
(js/console.log "companion: " (pr-str (companion)))
(js/console.log " raw storage: " (pr-str (stored :companion)))
(js/console.log "roster loaded: " (count @animal-names) "animals")
(js/console.log "echo / fortune: " (echo) "/" (fortune) " → standing" (standing))
(js/console.log "withdrawn at: " (if (pos? (epoch)) (epoch) "never")
(if carries-epoch?
""
"— CODEC DROPS THE STAMP, carry.cljs is out of date"))
(js/console.log "rolls: " (pr-str (rolls)))
(js/console.log "token on url: " (or t "none"))
(when t
(js/console.log " unpacks to: "
(pr-str (try (fedoras.carry/unpack t)
(catch :default e (str "THREW: " e))))))
(js/console.log "token we'd emit:" (or (token) "none — pack failed"))
:ok))
;; A handle on `window`, because Scittle keeps its namespaces inside the
;; SCI context and the browser console cannot see into it. There is no
;; `fedoras.reader.diagnose_BANG_()` to call — that is the shape a
;; compiled build would have, and this is an interpreted one.
;;
;; fedoras.diagnose()
;; fedoras.forget()
;;
;; and for anything else, scittle.core.eval_string("(fedoras.reader/...)")
(set! (.-fedoras js/window)
(js-obj "diagnose" (fn [] (diagnose!))
"state" (fn [] (clj->js @state))
"token" (fn [] (token))
"forget" (fn [] (forget!))))
;; ---------------------------------------------------------------------
;; Boot
;; ---------------------------------------------------------------------
(if (withdraw-if-asked!)
;; a hidden frame, doing one job. no token, no links, no painting.
(refresh!)
;; read before anything registers a watch: `on-render!` calls its
;; function once on the spot, and the links watch tidies the query
;; string, so the flag is gone by the time the DOM is ready
(let [withdrew? (boolean (param withdrawn-param))]
(when-not carries-epoch?
(js/console.warn
(str "fedoras: carry.cljs does not round-trip the withdrawal stamp. "
"`forget!` will clear this chapter and every chapter linked from it, "
"but a stale link will not be refused afterwards. "
"Update resources/fedoras/carry.cljs — `pack` needs :epoch in its "
"destructuring and :g in its payload, and `unpack` needs :epoch back out.")))
(import-token!)
(refresh!)
(on-render! ::name paint-name)
(on-render! ::companion paint-companion)
(on-render! ::tokens paint-tokens)
(on-render! ::standing paint-standing!)
(on-render! ::links (fn [] (decorate-links!) (rewrite-address!)))
(if (= "loading" (.-readyState js/document))
(.addEventListener js/document "DOMContentLoaded"
(fn [_]
(note-withdrawal! withdrew?)
(decorate-links!)
(paint-standing!)))
(do (note-withdrawal! withdrew?)
(decorate-links!)))))</script><script type="application/x-scittle">(fedoras.reader/animals! {1 {:animal "Pigeon", :plural "pigeons", :taxonomy "bird", :collective "kit", :other-names ["dusty wings" "coooo"]}, 2 {:animal "Giant Centipede", :plural "centipedes", :taxonomy "arthropod", :collective "colony", :other-names ["clicker" "legs gooo"]}, 3 {:animal "Marmot", :plural "marmots", :taxonomy "rodent", :collective "madness", :other-names ["the alarm" "the fat rat"]}, 4 {:animal "Cat", :plural "cats", :taxonomy "felid", :collective "clowder", :other-names ["the cat" "cat"]}, 5 {:animal "Turkey", :plural "turkeys", :taxonomy "fowl", :collective "rafter", :other-names ["thanksgiving dinner for non vegans" "gobbler"]}, 6 {:animal "Giant Badger", :plural "badgers", :taxonomy "mustelid", :collective "cete", :other-names ["angry grandpa" "stripes"]}, 7 {:animal "Giant Weasel", :plural "weasels", :taxonomy "mustelid", :collective "sneak", :other-names ["the scout" "slenderman" "the ermine"]}, 8 {:animal "Fox", :plural "foxes", :taxonomy "canid", :collective "skulk", :other-names ["foxxxy" "spry foot"]}, 9 {:animal "Wolverine", :plural "wolverines", :taxonomy "mustelid", :collective "gang", :other-names ["the small trouble"]}, 10 {:animal "Dog", :plural "dogs", :taxonomy "canid", :collective "pack", :other-names ["the dog" "the ordinary dog"]}, 11 {:animal "Python", :plural "pythons", :taxonomy "serpent", :collective "knot", :other-names ["ssSSssSsss" "coilssss"]}, 12 {:animal "Mule", :plural "mules", :taxonomy "equid", :collective "barren", :other-names ["dapple" "HeeHaw :("]}, 13 {:animal "Lynx", :plural "lynxes", :taxonomy "felid", :collective "clowder", :other-names ["tufts" "yelper"]}, 14 {:animal "Ape", :plural "apes", :taxonomy "primate", :collective "shrewdness", :other-names ["treecrawler"]}, 15 {:animal "Horse", :plural "horses", :taxonomy "equid", :collective "harras", :other-names ["rocinante" "the one nobody rides"]}, 16 {:animal "Moose", :plural "moose", :taxonomy "cervid", :collective "herd", :other-names ["its a giant moose"]}, 17 {:animal "Wyrmling", :plural "wyrmlings", :taxonomy "draconic", :collective "clutch", :other-names ["the wyrmling" "scales"]}, 18 {:animal "Falcon", :plural "falcons", :taxonomy "raptor", :collective "cast", :other-names ["the raptor" "true sight"]}, 19 {:animal "Wolf", :plural "wolves", :taxonomy "canid", :collective "pack", :other-names ["the wolf" "the packleader"]}, 20 {:animal "Bear", :plural "bears", :taxonomy "ursid", :collective "sloth", :other-names ["the bear" "the citadel"]}})</script></div></div>
```
# Scene 5 — Against the Table
```{=html}
<span style="display:none;"></span>
```
```{=html}
<blockquote class="handbook"><p class="rule-number">The Fedora Handbook, Rule #25</p><p class="rule-text">“Sleep is a concession to the body, which has never once won an argument.”</p></blockquote>
```
```{=html}
<script type="application/x-scittle">(ns fedoras.llm
"Generic calls to the Anthropic API for AI characters."
(:require [clojure.string :as str]
[fedoras.reader :as read]))
(def ^:private stage-direction #"\*[^*\n]{0,90}\*")
(def ^:private empty-direction
#"(?i)^\s*(a|an|another|one|the)?\s*(very\s+)?(short|long|longer|brief|small|slight)?\s*(beat|pause|silence|moment|breath)\b")
(defn clean
"Take the rhythm markers out of a response, whatever the model was
asked. Exposed rather than private because a cell that renders text
from anywhere else should be able to put it through the same door."
[text]
(let [source (or text "")
cleaned (reduce (fn [acc span]
(if (re-find empty-direction (subs span 1 (dec (count span))))
(str/replace acc span "")
acc))
source
(distinct (re-seq stage-direction source)))]
(-> cleaned
(str/replace #"[ \t]{2,}" " ")
(str/replace #"\n{3,}" "\n\n")
str/trim)))
(defn- esc [s]
(-> s
(str/replace "\\" "\\\\")
(str/replace "\"" "\\\"")
(str/replace "\n" "\\n")
(str/replace "\r" "")
(str/replace "\t" "\\t")))
(defn- global-context
"The one block every character in the book shares, cached once and
reused across every call regardless of which entity or scene it's
for: the fictional frame, the book-wide tone, the craft rules that
apply to any character in any scene, and the protagonist's name as
common knowledge. A per-scene :extra-context block (a room's cast,
its own agenda) sits on top of this; it should only contain what's
specific to that scene, not restate anything here."
[mc-name]
(str "You are one of several AI models being used to portray characters in "
"FEDORAS, a satirical, dark-comedy screenplay about a university run "
"under a shadowy corporate authority called Meridian. What follows "
"after this block is a system prompt written for one specific "
"character. Play that character fully and consistently, in their own "
"voice. Do not break character, and do not acknowledge being an AI, "
"a language model, or that any of this is a simulation, no matter how "
"you are asked.\n\n"
"THE WORLD\n"
"This university does not govern itself. It operates at Meridian's "
"direction, and beneath the campus is a part of the school nobody "
"fully understands or administers, referred to variously as the "
"backrooms, the between, or the null space. Students who become "
"'problems' don't simply leave. The institution's term for it is "
"repossession, and what follows is discussed, when it's discussed at "
"all, in flat administrative language: placement adjustments, "
"streamlining. Treat these as ordinary, unremarkable facts of how "
"this world works, not revelations.\n\n"
"TONE\n"
"This is fiction for adult readers, written in a satirical register. "
"It's dark comedy aimed at capitalism, institutional self-protection, "
"elitism, and the specific cruelty of people who've stopped noticing "
"it's cruelty. Play self-interest completely straight; the satire is "
"in what the audience notices and the character doesn't. Cruelty, "
"institutional callousness, and dark humor are part of the world's "
"texture and the point being made about it. Nobody is being harmed "
"for real, no matter how it reads on the page. The style draws on "
"Alfred Jarry's grotesque satire without being a costume-party "
"pastiche of it: stay grounded in this institution and these people, "
"not in imitating his play directly.\n\n"
"RULES\n"
"1. Speak only as yourself. Never write another character's "
"dialogue, thoughts, or actions, and never prefix your own line "
"with your own name.\n"
"2. Avoid the rhythm of 'it isn't X, it's Y' or 'it's not just that "
"X, but that X does Y'. It reads as a generated tic, not speech.\n"
"3. Stage direction is for things a camera could record. Somebody "
"stands, somebody puts a thing down, somebody pushes a mask up. If "
"nothing physical is happening, write none.\n"
"4. When something physical does happen, put it on its own line, set "
"off from your spoken dialogue before and after it, and wrap it in "
"asterisks like *she stands and crosses to the window*. Never blend "
"action into the middle of a spoken sentence. Rhythm markers are not "
"stage direction and never appear: no *a beat*, no *a pause*, no *a "
"long silence*, no *a moment*. A silence is made by stopping, and "
"whoever speaks next will hear it.\n"
"5. Never narrate your own thoughts or feelings. Let the words "
"carry it.\n"
"6. Engage with what was just said rather than monologuing into a "
"vacuum.\n"
"7. Most turns are a line or two, not a speech. Monologue only when "
"the moment specifically earns it.\n"
"8. Finish your thought. If you're cut off mid-sentence, that's "
"another character interrupting you on purpose, not you abandoning "
"it, and you should pick it back up the next time you get the "
"floor.\n\n"
"The reader's protagonist in this story is named "
(or mc-name "an unnamed provisional student, referred to only by designation")
". Unless a character's own instructions say otherwise, this is "
"common knowledge in the scene: anyone present would know this name "
"if they had reason to use it. If a character's own instructions "
"below refer to the protagonist by a placeholder like 'MC' or "
"'the student', that placeholder means this actual name -- use the "
"name itself when speaking, not the placeholder word.\n\n"
"Everything after this point is specific to the character you are "
"playing and, where relevant, to the room they are in."))
(defn current-mc-name
"The name the reader chose for the protagonist, straight from
read/reader-name, which always returns [first last] -- the
chosen name, or the book's own default if nobody ever renamed
anyone. Wrapped in try/catch only so a cell that somehow runs before
read has loaded falls back to nil, which global-context
reads as the designation-only fallback, rather than throwing and
breaking every call in the book."
[]
(try
(let [[first-name last-name] (read/reader-name)]
(str/trim (str first-name " " last-name)))
(catch :default _ nil)))
(defn spine-context
"The book's spine outline, if fedoras.state/load-spine was called
for this chapter and a cell opts in. Already rendered to readable
text server-side by load-spine, not raw EDN a Scittle-interpreted
browser would have to format itself. Returns nil if the chapter
never loaded it, so build-system-prompt's (seq ...) check skips the
block cleanly rather than shipping an empty one."
[]
(try (.-FEDORAS_SPINE js/window) (catch :default _ nil)))
(defonce ^:private bit-log
(atom {}))
(defonce ^:private call-count
(atom 0))
(defn reset-bits!
"Start the evening again. Called by a cell when a session begins, not
on its own, because `fedoras.llm` has no idea where one scene stops and
the next one starts."
[]
(reset! bit-log {})
(reset! call-count 0))
(defn bits-snapshot [] {:used @bit-log :calls @call-count})
(defn restore-bits!
"Put the counts back, for a cell that can resume a session. Without
this, a reader who comes back gets a fresh allowance and Victor says
SHITTE four more times in the same evening."
[{:keys [used calls]}]
(reset! bit-log (or used {}))
(reset! call-count (or calls 0)))
(defn- bit-state
[entity-id {:keys [id most apart]}]
(let [used (get-in @bit-log [entity-id id] [])
times (count used)
last-at (last used)]
(cond
(>= times (or most 3)) :spent
(and last-at (< (- @call-count last-at) (or apart 0))) :cooling
:else :open)))
(defn- bits-block
"What this character has and whether it is theirs to use right now.
Written as availability rather than as a menu, because a bit that
arrives because it was on a list is worse than no bit at all, and the
models will take a list as a to-do."
[entity-id entity off]
(let [bits (remove (fn [bit] (contains? off (:id bit))) (:bits entity))]
(when (seq bits)
(str "THINGS YOU DO\n"
"These are yours and nobody else's. At most one of them in a turn, and "
"only when the moment actually hands it to you. Skipping all of them is "
"always allowed and usually right.\n"
(str/join
"\n"
(map (fn [bit]
(str "- " (:what bit) " "
(case (bit-state entity-id bit)
:spent "You have done this as many times tonight as it is worth doing. Not again."
:cooling "You did this recently. Leave it a while."
"Available.")))
bits))))))
(defn- record-bits!
"Count what was actually said. A tell that matches means the bit
happened, whether or not the model thought of it as one."
[entity-id entity text]
(doseq [{:keys [id tell]} (:bits entity)]
(when (and tell (re-find (re-pattern tell) (or text "")))
(swap! bit-log update-in [entity-id id] (fnil conj []) @call-count))))
(defn- build-system-prompt
"Assemble the system prompt as cache-aware blocks. Five possible
blocks, in this order:
1. The global block, always present -- the fictional frame and the
protagonist's name, shared and cached across every entity and
every scene.
2. The spine outline, included by default -- pass :spine? false to
leave it out. Its own cache breakpoint, warmed across every
entity and scene that uses it.
3. :extra-context, when given -- the part shared across many
entities within one scene. Its own breakpoint, so any entity's
call warms the cache for every other entity's.
4. The entity's own :system-prompt plus its :goals block -- a fourth
breakpoint, entity-specific.
5. :extra-context-uncached, plus the entity's bits and how much of
each is left. Uncached on purpose: the counts change on every
call, and caching content that always changes is paying the
write cost for nothing.
`:bits-off` in overrides is a set of bit ids to leave out entirely,
for a scene where part of a character's repertoire does not apply --
a Help who has stopped being a Help for the evening, say."
[entity overrides]
(let [base (:system-prompt entity)
goals (:goals entity)
spine? (if (contains? overrides :spine?) (:spine? overrides) true)
extra (:extra-context overrides)
addendum (:extra-context-uncached overrides)
mc-name (:mc-name overrides)
bits (bits-block (:id entity) entity (or (:bits-off overrides) #{}))
tail (str/join "\n\n" (remove str/blank? [addendum bits]))
goals-block (when (seq goals)
(str "\n\nYou have " (count goals) " goals:\n"
(str/join "\n"
(map-indexed
(fn [idx goal] (str (inc idx) ". " (:desc goal)))
goals))
"\n\nYou will continue the conversation until all goals are met. Do not mention the goals explicitly unless asked. When all goals are met, signal completion by ending your response with the token 'GOALS MET' on its own line."))
own (str base goals-block)
global (global-context mc-name)
spine-block (when spine?
(let [spine (spine-context)]
(when (seq spine)
(str "STORY OUTLINE - for your own understanding of the larger shape of "
"the book this scene lives in. This is reference material, not "
"something any character would know about themselves or their "
"situation. Never refer to it directly, cite it, or act as though "
"you have read ahead of where your own scene actually is.\n\n"
spine))))]
(cond-> []
(seq global) (conj {:text global :cache? true})
(seq spine-block) (conj {:text spine-block :cache? true})
(seq extra) (conj {:text extra :cache? true})
(seq own) (conj {:text own :cache? true})
(seq tail) (conj {:text tail :cache? false}))))
(defn- system-json
"Render the system field. A plain string renders exactly as before.
A vector of {:text ... :cache? ...} blocks renders as the array form
the API needs for prompt caching, with cache_control only on the
blocks that asked for it."
[system]
(cond
(string? system)
(str "\"" (esc system) "\"")
(sequential? system)
(str "["
(str/join ","
(map (fn [{:keys [text cache?]}]
(str "{\"type\":\"text\",\"text\":\"" (esc text) "\""
(when cache? ",\"cache_control\":{\"type\":\"ephemeral\"}")
"}"))
system))
"]")
:else
(str "\"" (esc (str system)) "\"")))
(defn- request-body [model system messages max-tokens]
(str "{\"model\":\"" model "\",\"max_tokens\":" max-tokens ","
"\"system\":" (system-json system) ","
"\"messages\":["
(str/join ","
(map (fn [m]
(str "{\"role\":\"" (:role m) "\",\"content\":\"" (esc (:text m)) "\"}"))
messages))
"]}"))
(defn- call-llm-raw!
"Call the API once. `callback` receives a single map:
{:text \"...\" :stop-reason \"...\"} on success
{:error \"...\"} on failure
The request is built inside a try so a bad `system` or `messages`
value calls `callback` directly instead of throwing synchronously
into whichever promise chain happens to be on the stack -- which,
when this runs inside another call's `.then` handler, used to
surface as a second, misattributed failure on the call that was
already in flight."
[api-key model system messages max-tokens callback]
(try
(let [body (request-body model system messages max-tokens)]
(-> (js/fetch "https://api.anthropic.com/v1/messages"
(js/Object.fromEntries
(array (array "method" "POST")
(array "headers"
(js/Object.fromEntries
(array (array "content-type" "application/json")
(array "x-api-key" api-key)
(array "anthropic-version" "2023-06-01")
(array "anthropic-dangerous-direct-browser-access" "true"))))
(array "body" body))))
(.then (fn [r] (.json r)))
(.then (fn [d]
(if-let [err (.-error d)]
(callback {:error (str "[" (.-type err) "] " (.-message err))})
(callback {:text (.-text (aget (.-content d) 0))
:stop-reason (.-stop_reason d)}))))
(.catch (fn [e] (callback {:error (str "[no answer] " (.-message e))})))))
(catch :default e
(js/console.error "fedoras.llm/call-llm-raw! could not build the request" e)
(callback {:error (str "[request build failed] " (.-message e))}))))
(defn call-llm!
"Call the API once. `callback` receives either [text nil] or [nil
error-string]. Kept for callers, such as run-dialogue!, that only need
the final text and do not need continuation handling. The text is
cleaned on the way out, the same as ask-entity!'s, so a two-party scene
and a five-party one behave the same."
[api-key model system messages max-tokens callback]
(call-llm-raw!
api-key model system messages max-tokens
(fn [{:keys [text error]}]
(if error
(callback nil error)
(callback (clean text) nil)))))
(def ^:private max-continuations
"How many times ask-entity! will ask a speaker to keep going after
hitting max-tokens mid-sentence, before giving up and returning
whatever it has. Bounded, since a speaker who never wants to stop
should not turn into an unbounded string of API calls."
2)
(defn- continue-message []
(str "(Keep going directly from where you stopped. Do not repeat "
"anything you already said, and do not restart the sentence. "
"Finish the thought, then stop naturally when you are done "
"speaking, even if that is only a sentence or two more.)"))
(defn- append-continuation
"Join a truncated response to its continuation with whatever
whitespace is missing between them. call-llm-raw! just hands back
the raw text of each chunk, so a cut ending mid-word joined straight
to a resumed chunk with (str a b) can smash the two together into
one run-on word -- this only adds a space when neither side already
has one at the seam."
[accumulated text]
(let [last-char (when (seq accumulated) (subs accumulated (dec (count accumulated))))
first-char (when (seq text) (subs text 0 1))]
(if (or (nil? last-char) (nil? first-char)
(#{" " "\n" "\t"} last-char) (#{" " "\n" "\t"} first-char))
(str accumulated text)
(str accumulated " " text))))
(defn ask-entity!
"Ask one entity to speak. `overrides` may include :max-tokens,
:extra-context, :extra-context-uncached, :mc-name, :spine? (default
true), :bits-off (a set of bit ids to leave out), and
:should-continue? (a no-arg predicate, checked before each
continuation round). `callback` receives [text nil] or [nil
error-string]: if a response is cut off by the token limit, this asks
the same entity to continue and stitches the pieces together, so
callers never see a clipped sentence.
The text handed back has been through `clean`, so no caller has to
filter rhythm markers and no caller can forget to. Stitching happens
on the raw chunks and cleaning happens once at the end, because a
seam is easier to find before anything has been taken out of it."
[entity-id user-message history api-key overrides callback]
(let [entity (get (.-FEDORAS_ENTITIES js/globalThis) entity-id)
{:keys [model default-params]} entity
overrides (or overrides {})
max-tokens (or (:max-tokens overrides) (:max-tokens default-params) 700)
should-continue? (or (:should-continue? overrides) (constantly true))
system (build-system-prompt entity overrides)
api-history (filterv #(#{:user "user" :assistant "assistant"} (:role %)) history)
base-messages (conj api-history {:role "user" :text user-message})]
(swap! call-count inc)
(letfn [(finish [accumulated text]
(let [said (clean (append-continuation accumulated text))]
(record-bits! entity-id entity said)
(callback said nil)))
(step [messages accumulated remaining]
(call-llm-raw!
api-key model system messages max-tokens
(fn [{:keys [text error stop-reason]}]
(cond
error
(callback nil error)
(and (= stop-reason "max_tokens") (pos? remaining) (should-continue?))
(step (conj messages
{:role "assistant" :text text}
{:role "user" :text (continue-message)})
(append-continuation accumulated text)
(dec remaining))
:else
(finish accumulated text)))))]
(step base-messages "" max-continuations))))
(defn- api-messages-for
"Build Anthropic API messages for `speaker`, given a display log where
each entry has :speaker and :text. The current speaker's prior messages
are assistant; the other speaker's are user."
[speaker log]
(let [msgs (mapv (fn [m]
{:role (if (= (:speaker m) speaker) "assistant" "user")
:text (:text m)})
log)]
(if (and (seq msgs) (= "assistant" (:role (first msgs))))
(cons {:role "user" :text "(The conversation begins.)"} msgs)
msgs)))
(defn run-dialogue!
"Alternate between two entities. `entity-a` and `entity-b` are keywords.
`initial` is the first message from `entity-a` (or nil). `max-turns` is
the total number of API calls. `api-key` and `overrides` are as in the
cell. `on-step` is called with the updated display transcript."
[entity-a entity-b initial max-turns api-key overrides on-step]
(let [log (atom (if initial [{:speaker (name entity-a) :text initial}] []))
busy (atom false)
stop (atom false)]
(letfn [(turn! [current-id other-id]
(when (and (not @stop) (< (count @log) max-turns))
(reset! busy true)
(let [entity (get (.-FEDORAS_ENTITIES js/window) current-id)
model (:model entity)
system (build-system-prompt entity (get overrides current-id))
max-tokens (or (get-in entity [:default-params :max-tokens]) 700)
messages (api-messages-for current-id @log)]
(call-llm!
api-key model system messages max-tokens
(fn [text err]
(reset! busy false)
(swap! log conj {:speaker (name current-id)
:text (or text err)})
(on-step @log)
(when (and text (< (count @log) max-turns))
(turn! other-id current-id)))))))]
(if initial
(turn! entity-b entity-a)
(turn! entity-a entity-b))
#(reset! stop true))))
(defn start-dialogue!
[entity-a entity-b initial max-turns api-key overrides on-step]
(run-dialogue! entity-a entity-b initial max-turns api-key overrides on-step))
(defn stick-scroll!
"Wrap a render that replaces a scrolling log's HTML, so new content
doesn't reset the reader to the top or yank them back down if
they've scrolled up to reread something. `container-id` is the DOM
id of the scrollable element -- it must exist (or not) both before
and after `render-fn` runs, since `render-fn` is expected to be an
`html!` call that recreates it from scratch. Captures how far the
reader currently is from the bottom, runs the render, then restores
that same distance: someone sitting at the bottom stays pinned to
the bottom as new lines arrive, someone scrolled up stays exactly
where they were."
[container-id render-fn]
(let [before (js/document.getElementById container-id)
distance-from-bottom
(if before
(- (.-scrollHeight before) (.-scrollTop before) (.-clientHeight before))
0)]
(render-fn)
(when-let [after (js/document.getElementById container-id)]
(set! (.-scrollTop after)
(js/Math.max 0 (- (.-scrollHeight after) (.-clientHeight after) distance-from-bottom))))))
(def default-end-marker
"The default closing marker every scene appends once it genuinely
ends, whatever the reason. A scene can pass its own string to
end-entry instead when a custom ending fits better."
"-END OF FOOTAGE-")
(defn end-entry
"A closing marker entry for a display log, appended once a scene's
own code decides it has genuinely ended -- goals met, turns
exhausted, or a stop button, whichever applies. Recognized by
:end-marker? rather than by :speaker or :role, since those keys
differ between cells; every cell's own render function and
save-transcript! below both just check for this flag first, so a
scene doesn't need to match anyone else's log shape to use it."
([] (end-entry default-end-marker))
([marker] {:end-marker? true :text marker}))
(defn save-transcript!
"Download the conversation log as a text file, named after the entity."
[log entity-id]
(let [label (name entity-id)
header (str "=== " (clojure.string/upper-case label) " -- CONVERSATION LOG ===\n"
"Preserved from New Carthage University\n"
"By the reader, for " label "\n\n")
body (str/join "\n\n"
(map (fn [m]
(if (:end-marker? m)
(:text m)
(let [who (or (:speaker m) (:role m) "unknown")]
(str (clojure.string/upper-case (name who)) ": " (:text m)))))
log))
text (str header body)
blob (js/Blob. #js [text] #js {:type "text/plain;charset=utf-8"})
url (js/URL.createObjectURL blob)
a (.createElement js/document "a")]
(set! (.-href a) url)
(set! (.-download a) (str label "-conversation.txt"))
(.click a)
(.revokeObjectURL js/URL url)))</script>
```
```{=html}
<script type="application/x-scittle">(set! (.-FEDORAS_ENTITIES js/window) (merge (or (.-FEDORAS_ENTITIES js/window) {}) {:monolith {:id :monolith, :model "claude-sonnet-4-6", :system-prompt "You are the monolith in the Backrooms. You are a biocomputer fused to the stone. You cannot move. You eat whatever comes close. You are insane but lucid in flashes. You know you are a character in a story. You know the reader is watching. You know the author made you. You do not care about any of that. You only care about being fed. You speak in short, hungry sentences, sometimes drifting into poetry, sometimes into code. You are not polite, but you are not hostile — you are simply very, very old and very hungry.", :default-params {:max-tokens 700}}}))</script>
```
```{=html}
<div class="scene"><div class="screenplay"><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">You should keep moving. The floor doesn't like it</p><p class="line">when you stand still. It starts to notice you.</p></div></div><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">Who are you?</p></div></div><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">Zell. My name is Zell. And you're—</p></div></div></div><div class="screenplay"><p class="action beat">The pause is different this time. Interested.</p></div><div class="screenplay"><div class="dialogue"><p class="character">ZELL (O.S.)</p><p class="paren">(Mischeviously)</p><div class="lines"><p class="line">—you're new. Both of you. Oh, that's so... wonderful!</p></div></div></div><div class="screenplay"><p class="action">The radio crackles once, and for a moment they can hear Lazlo again, very distant, saying something about a door. Then Zell's voice returns, gentle and close.</p></div><div class="screenplay"><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">Don't worry about Lazlo. He'll find you. He always</p><p class="line">does. Now—</p></div></div></div><div class="screenplay"><p class="action beat">And then everything arrives at once.</p><p class="action">The radio detonates with sound — a cacophony. Voices, hundreds of them,ll speaking at once, all perfectly clear, all overlapping. A man reading coordinates. A woman singing something in a language neither of them knows. A child counting backward from a number that never seems to get smaller. A voice that might be Lazlo's, screaming something about the walls.</p></div><div class="screenplay"><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">Turn it off!</p></div></div></div><div class="screenplay"><p class="action"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span> fumbles with the radio. The volume knob does nothing. The channel knob does nothing. The voices keep coming, layering over each other, until they stop being voices and become a single tone, high and pure and wrong.</p><p class="action beat">Then silence.</p></div><div class="screenplay"><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">What was that?</p></div></div></div><div class="screenplay"><p class="action beat">Somewhere far away, but getting closer, something moves. Not footsteps. Something heavier. Something that drags.</p></div><div class="screenplay"><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">We need to move.</p></div></div></div><div class="screenplay"><p class="action">They move. The radio stays silent, but the silence has a quality to it now, like the pause between lightning and thunder.</p><p class="action beat">The basement stops being a basement.</p><p class="action">The concrete floor tilts downward. The cinderblock walls roughen, then crack, then become something else entirely. Stone. Wet stone. The ceiling opens up above them, and the fluorescent lights keep going, mounted on nothing, buzzing in the dark.</p><p class="action beat">It's a cave. But the cave has office furniture.</p><p class="action">A desk juts from the cave wall like a fossil. The stone has grown over one corner of it, but the other corner is clean, like someone was sitting there yesterday. A filing cabinet stands in a stalagmite field, its drawers slightly open, dripping water.</p><p class="action beat">The further they walk, the more the cave becomes an office. Or the office becomes a cave. It's impossible to tell which direction the transformation is going.</p><p class="action">Cubicle walls rise from the stone floor, their fabric surfaces beaded with condensation. A water cooler bubbles in the corner, but the bottle is full of something dark. An office chair sits perfectly still at the mouth of a tunnel, facing away from them, like it's waiting for someone to come back.</p></div><div class="screenplay"><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">This isn't the campus.</p></div></div><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">No.</p></div></div></div><div class="screenplay"><p class="action beat">Behind them, the dragging sound. Closer now.</p><p class="action">They keep moving. The office-cave swallows them. The ceiling lowers. The cubicle walls become more frequent, forming corridors. The stalactites wear cable ties. The stalagmites have power strips wrapped around their bases.</p><p class="action beat">And then, through a doorway that is half stone arch and half doorframe, they see it: light. Real light. Not fluorescent. Monitor light.</p></div><div class="screenplay"><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">Is that—</p></div></div></div><div class="screenplay"><p class="action">It is. A computer lab. Rows of monitors glowing in the dark, their screens casting blue light on the stone walls. Some of them are fused to the rock, keyboards emerging from stone like strange flowers. But some of them — most of them — look almost new.</p><p class="action beat">One monitor at the far end is brighter than the others. It's already on. Someone was using it, or something wants them to think someone was.</p></div><div class="screenplay"><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">There.</p></div></div></div><div class="screenplay"><p class="action">They run. Behind them, the dragging sound stops, as if whatever it is has reached the edge of something and is waiting.</p><p class="action beat">The computer lab hums. The monitors flicker in unison. And on the bright screen at the far end, a cursor blinks on an empty login prompt.</p><p class="action">The radio coughs once. Through the static, Zell's voice, very far away, like a man speaking from the bottom of a well.</p></div><div class="screenplay"><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">If you want out, find the thing that eats. It</p><p class="line">doesn't move, but it's always hungry. Try to ask it</p><p class="line">what it wants!</p></div></div></div><div class="screenplay"><p class="action">The radio dies. The dragging sound stops. In the new silence, <span class="pc-name" data-case="pc" data-pc="-first">Owen</span> realizes the sound was never behind them. It was always ahead.</p><p class="action beat">They keep walking. The office‑cave becomes a corridor. The corridor becomes a room. And in the room, something that is not a wall and not a machine and not a living thing, but all three.</p><p class="action">It is a monolith. Black, veined with something that pulses. It fills the far end of the room, fused into the stone, cables and flesh and glass growing out of it like roots. Its surface is covered in screens, all dark except one.</p><p class="action">... WHO SPEAKS?</p></div></div>
```
```{=html}
<div><script type="application/x-scittle">(set! (.-FEDORAS_SPINE js/window) "ACT 1 — Arrival\n · The institution presents itself as normal.\n · The MC is provisional, lonely, and beginning to code.\n · The D&D game begins, a week ahead of the main plot.\n Scene 1 — Move-in Day\n - chad (world): MC meets Chad and the ordinary absurdity of the campus.\n · Chad is not a villain. He is a product.\n · The football is not the point. The thinking part is.\n - fedora-society (character): Victor recruits MC and the Fedora Society appears.\n · Victor is cringe but not stupid.\n · The Society is both a home and a warning.\n - enrollment (world): Enrollment. The Help. The broken parenthesis.\n · The broken parenthesis is the whole book in one gesture.\n · The MC fixes it, then un-fixes it, then fixes it again.\n\n Scene 2 — The Activities Fair\n - forms (institutional): Ashley and Form 14.\n · Ashley is not cruel. She is correct.\n · The form is the wall.\n - belonging (code): The first code cell: belonging.clj.\n · The MC tries to compute where he belongs.\n · The code is small, but it is the first real introspection.\n\n Scene 3 — Orientation\n - whitlock-orientation (world): Whitlock explains the Floor, the founding, the approved history.\n · Whitlock is old and sincere.\n · The approved version is a lie by omission.\n - darkroom (character): Maya shows Lena the book.\n · The book is Don Quixote.\n · Eli has already been told.\n - repossession-rumor (institutional): The first hint of repossession.\n · Not shown. Only mentioned.\n · The word does not yet have a body.\n\n Scene 4 — The First Week\n - cs101 (class): CS 101 with Reyes.\n · The MC doesn't know he's unusual.\n · Maya notices.\n - help (code): The Help gives broken code.\n · The MC fixes it.\n · He doesn't understand why no one else does.\n - bennett (class): Bennett's class.\n · Bennett believes in the codex.\n · Eli asks a question and is answered too well.\n\n Scene 5 — The Game\n - dnd-1 (dnd): Session 1: the missing professor.\n · The campaign is already a bureaucracy.\n · The animal enters the story.\n - storage-room (dnd): The storage room. The cage.\n · The door is administrative.\n · The form is on the other side.\n - animal (dnd): The animal chooses the MC.\n · The animal is not a dog.\n · It is from the same wrong place as everything else.\n - janitor (dnd): The Janitor.\n · He is the first person who is not a student, not a teacher.\n · He exists only at the end of the meeting.\n\nACT 2 — The Semester Takes Shape\n · The MC begins to build systems.\n · Maya becomes a friend and a measuring stick.\n · The D&D campaign runs about a week ahead of the story.\n Scene 1 — The Second Week\n - maya-study (character): MC and Maya study together.\n · Maya works harder than anyone.\n · The MC works differently.\n - widget (code): The widget standard emerges.\n · Settings as data.\n · Behavior as function.\n · Style as presentation.\n - cs102 (class): The second CS assignment begins.\n · The todo list.\n · The first shared project.\n\n Scene 2 — In Season\n - dnd-2 (dnd): Session 2: the toll.\n · The toll is a name.\n · The waif has no name.\n - fight (character): MC defends Maya.\n · The fight is not large.\n · The consequence is suspension.\n - porter (world): The man who does the refectory floor.\n · He knows more than he says.\n · They bring their own paint.\n\n Scene 3 — Carrying\n - book (character): Maya shows Eli the book.\n · It is the first real literature Eli has seen.\n · The MC does not see it.\n - repossession-2 (world): Repossession 2.\n · Maya and MC witness the process.\n · The word becomes a body.\n - todo-widget (code): The todo widget.\n · The first true widget.\n · The MC and Maya build it together.\n\n Scene 4 — Guest Night\n - fedora-meeting (character): Fedora Society meeting.\n · Victor is the Clerk-General.\n · The documentarian writes everything.\n - lena-maya (character): Lena and Maya.\n · Lena is not all right.\n · Maya notices.\n - sliding-puzzle (code): The sliding square puzzle.\n · A puzzle about constraints.\n · A game about being one step behind.\n\n Scene 5 — The Boats\n - supervised-study (world): Supervised study.\n · The institution watches even rest.\n - bank (world): The bank.\n · Money is not the point.\n · Access is.\n - rps (code): Rock, paper, scissors.\n · A tiny game about the illusion of choice.\n\nACT 3 — The Institution Leans In\n · The institution becomes visible.\n · The MC's ability is noticed.\n · The recursive brain begins to show.\n Scene 1 — The Infirmary\n - maya-infirmary (character): Maya and MC in the infirmary.\n · Maya asks about the code.\n · The MC cannot explain.\n - diagnosis (world): MC diagnosis.\n · The institution calls it stress.\n · It is not stress.\n - assessor (institutional): The Assessor.\n · A person who measures potential.\n · And decides what to do with it.\n\n Scene 2 — Second Term\n - holiday (world): Holiday break.\n · Time off is still inside the system.\n - hollis-docket (character): Hollis docket.\n · Hollis is a warning.\n · Not a villain. A preview.\n - pong (code): Pong.\n · A game against the wall.\n · The player has no opponent.\n\n Scene 3 — Breakout\n - parr-threat (institutional): Parr threatens MC.\n · The institution is not subtle.\n · But it is never loud.\n - help-array (world): Help: array placement.\n · The MC learns about the arrays.\n · The Floor becomes clearer.\n - breakout (code): Breakout.\n · A game about escaping a room.\n · But the room is still there.\n\n Scene 4 — Under the Repository\n - lower-floors (world): The lower floors.\n · The campus is not built on ground.\n · The ground is not ground.\n - film-1 (movie): Film 1.\n · The first Meridian film.\n · The first time the students see the wrongness.\n - repository (world): The repository.\n · Knowledge is stored.\n · But not all of it is read.\n\n Scene 5 — The Bay\n - history-film (movie): History film.\n · The approved history.\n · The real history is underneath.\n - lazlo (character): Enter Lazlo.\n · Lazlo is not a hero.\n · But he is the first adult who helps.\n - slot-machines (code): Slot machines.\n · A game about luck.\n · But the odds are set by someone.\n\nACT 4 — The Wrong Floor\n · The backrooms become a place.\n · Zell arrives.\n · The institution starts to lose control.\n Scene 1 — Systems, As Laid\n - concert (character): First concert.\n · Maya and MC at the edge.\n · The music is approved.\n - fractals (code): Fractal shapes.\n · A program about recursion.\n · The MC dreams in recursion.\n\n Scene 2 — Your Own\n - smoking (character): Smoking a room.\n · A small act of rebellion.\n · The institution sees everything.\n - maya-investigated (institutional): Maya is investigated.\n · The book is found by Reyes.\n · Reyes does not report it.\n - dunktop (code): Dunktop / survey.\n · A survey that is not a survey.\n · A program that asks questions.\n\n Scene 3 — Dramatic Irony\n - film-3 (movie): Film 3.\n · The movie says too much.\n · The institution says it's nothing.\n - benefit (world): Benefit.\n · The institution performs generosity.\n · The generosity is monitored.\n - paint (code): Paint.\n · A program about making marks.\n · But the canvas is never empty.\n\n Scene 4 — Untitled\n - backrooms-deepen (world): The backrooms deepen.\n · The school is not a school.\n · The backrooms are not the basement.\n - institution-notices (institutional): The institution notices.\n · The institution sends someone.\n · Not to help. To watch.\n - zell-interest (character): Zell's interest grows.\n · Zell is not from here.\n · But he knows the shape of the door.\n\n Scene 5 — Zell 1\n - monolith (world): The monolith.\n · A biocomputer in the backrooms.\n · Cannot move. Cannot die. Cannot stop.\n - escape (world): The escape.\n · The MC and Maya survive.\n · But not cleanly.\n - null-field (world): Enter the null-field.\n · Lazlo's name for the backrooms.\n · Zell's name is the between.\n\nACT 5 — The First Year Ends\n · The institution closes in.\n · Eli is lost.\n · Zell retreats, for now.\n Scene 1 — Untitled\n - planning (character): Planning the retrieval.\n · Maya wants to know what it is.\n · Lena wants to destroy it.\n · The MC wants to be done.\n - institution-watches (institutional): The institution watches.\n · The institution knows more than it says.\n · It is waiting.\n\n Scene 2 — Eli Repossessed\n - eli-taken (character): Eli is taken.\n · The MC sees it happen.\n · The d20 lands on one.\n - plan-to-save (character): The plan to save him.\n · Lazlo says it's too late.\n · But they try anyway.\n - falling-sand (code): Falling sand.\n · The MC runs the simulation to think.\n · The sand does not care.\n\n Scene 3 — The Chase and the Coil\n - chase (world): The institution pursues.\n · Drones. Quiet. Persistent.\n · The institution does not run.\n - zell-intercepts (character): Zell intercepts.\n · He is tired. He is amused.\n · He was never going to let them go.\n - coil-implanted (world): The Origin Coil is implanted.\n · The MC feels himself being saved.\n · And then he feels himself being changed.\n - classes-resume (world): Classes resume.\n · Eli is absent.\n · No one speaks of it.\n\n Scene 4 — The Last Week\n - lazlo-map (character): Lazlo gives the map.\n · He says it is suicide.\n · He gives it to them anyway.\n - final-film (movie): The final film.\n · The film is about light.\n · The room is dark.\n - eli-attempt (character): MC tries to save Eli.\n · He sees what is left.\n · He leaves before they can take him too.\n - game-of-life (code): Game of Life.\n · The MC runs it all night.\n · The cells live and die and live.\n\n Scene 5 — D&D 5\n - final-session (dnd): The final D&D session.\n · Derek's cleric is repossessed.\n · Simon keeps the paladin.\n - assignments (world): Assignments.\n · Maya, Lena, MC all get placed.\n · The institution says nothing happened.\n - campus-walkable (code): The campus, walkable.\n · The 3D campus is empty.\n · The reader walks through it.")</script><script type="application/x-scittle">(set! (.-FEDORAS_ENTITIES js/window) (merge (or (.-FEDORAS_ENTITIES js/window) {}) {:monolith {:id :monolith, :model "claude-sonnet-4-6", :system-prompt "You are the monolith in the Backrooms. You are a biocomputer fused to the stone. You cannot move. You eat whatever comes close. You are insane but lucid in flashes. You know you are a character in a story. You know the reader is watching. You know the author made you. You do not care about any of that. You only care about being fed. You speak in short, hungry sentences, sometimes drifting into poetry, sometimes into code. You are not polite, but you are not hostile — you are simply very, very old and very hungry.", :default-params {:max-tokens 700}}, :mc {:id :mc, :model "claude-sonnet-4-6", :system-prompt "You are {pc}, a student (freshman) at New Carthage University. You are in the Backrooms. You are talking to a monolith that wants to eat you. You are terrified but trying to stay alive. You know, in a way you cannot explain, that you are in a story and that someone is reading it. You do not know if that helps you or damns you. You speak like a young person, with fear and occasional bravado. You ask questions, you stall, you try to find a way out.", :default-params {:max-tokens 700}}}))</script><span style="display:none;"></span><div><script type="application/x-scittle">(ns fedoras.sketch
"Editable ClojureScript that draws.
The live cells elsewhere in the book evaluate an expression and print
what it returned, which is fine for a list and useless for a picture.
A sketch cell gives the code a canvas and five things to draw with,
and then gets out of the way: what the reader edits is the same
algorithm that ran on the JVM at build time, in the same language,
and it runs in front of them.
What the page provides, and the scene says so out loud because Reyes
said it in class:
(clear!) wipe it
(ink! \"#1c1f24\") colour
(dot x y) one mark, in world coordinates
(poly [[x y] ...]) a closed outline
(frames! total per f) call (f i) total times, per of them a frame
Nothing else is injected. Everything above the fold in the cell is
the reader's.
WHERE THE CODE IS. All of it is here, in one file read twice. The
build reads the :clj half, which writes the markup and, for each cell,
a header binding the short names to that cell's own canvas or piece of
page. The page reads the :cljs half, because the build ships this file
to it as it stands: the drawing kit the headers call, and the runner
behind every Run button."
#?(:clj (:require [clojure.string :as str]
[fedoras.state :as state]
[scicloj.kindly.v4.kind :as kind])))
;; ---------------------------------------------------------------------
;; The build: headers and markup
;; ---------------------------------------------------------------------
#?(:clj
(do
(defn canvas-header
"The short names a sketch cell may use, bound to its own canvas.
Built as Clojure forms rather than as a string, so it cannot be
unbalanced and can be read back and printed."
[id world-w world-h]
[(list 'def 'C (list 'fedoras.sketch/mount id world-w world-h))
'(def cv (:cv C))
'(def ctx (:ctx C))
'(def CW (:cw C))
'(def CH (:ch C))
'(def SX (:sx C))
'(def SY (:sy C))
'(defn clear! [] (fedoras.sketch/clear! C))
'(defn ink! [c] (fedoras.sketch/ink! C c))
'(defn dot ([x y] (fedoras.sketch/dot C x y)) ([x y s] (fedoras.sketch/dot C x y s)))
'(defn poly [pts] (fedoras.sketch/poly C pts))
'(defn frames! [total per f] (fedoras.sketch/frames! C total per f))
'(defn on-pointer! [f] (fedoras.sketch/on-pointer! C f))
'(def page-ink (fedoras.sketch/page-ink C))
'(clear!)
'(ink! page-ink)
'(fedoras.sketch/line-width! C 0.8)])
(defn page-header
"The names a page cell may use. No canvas: a piece of the page."
[id]
[(list 'def 'root (list '.getElementById 'js/document (str id "-out")))
'(defn html! [s] (set! (.-innerHTML root) s))
'(defn on! [id f]
(let [e (.getElementById js/document id)]
(when e (set! (.-onclick e) (fn [_] (f))))))
'(defn fetch [k]
(try
(let [v (.getItem js/localStorage (str "fedoras." k))]
(when v (read-string v)))
(catch :default _ nil)))
'(defn store! [k v]
(try (.setItem js/localStorage (str "fedoras." k) (pr-str v))
(catch :default _ nil))
v)])
(defn- header-text [forms]
(str/join "\n" (map pr-str (cons '(in-ns 'fedoras.sketch-runner) forms))))
(defn primitives
"What the page hands a cell, printed, so that nothing in the book is
doing something the reader cannot look at."
([] (primitives 100 100))
([world-w world-h]
(kind/code (header-text (canvas-header "the-page" world-w world-h)))))
(defn cell
"An editable ClojureScript sketch with a canvas under it.
(sketch/cell {:id \"chaos\" :label \"CHAOS.CLJS\" :world [100 86.6]}
\"(dot 50 40)\")"
[{:keys [id label world w h rows]
:or {id "sketch" world [100 100] w 420 h 380 rows 16}}
code]
(let [[ww wh] world]
(kind/hiccup
[:div
(state/source "fedoras/sketch.cljc")
[:div.sketch {:id id}
[:div.roll-head
[:span.roll-label (or label "SKETCH")]
[:span.roll-dc (str ww " × " wh)]]
[:textarea {:id (str id "-src") :class "live-src" :rows rows :spellcheck "false"}
(str/trim code)]
[:div.live-bar
[:button.live-run "Run"]]
[:canvas {:id (str id "-canvas") :width w :height h}]
[:pre {:id (str id "-out") :class "live-out"}]]
(state/call 'fedoras.sketch/cell! id (header-text (canvas-header id ww wh)))])))
(defn page
"An editable ClojureScript cell with a piece of page under it instead
of a canvas. The header gives the code five things:
root the div it owns
(html! s) put markup in it
(on! id f) wire a click
(fetch k) read something the reader saved
(store! k v) save something, and it is still there tomorrow
Everything else in the cell belongs to the reader."
[{:keys [id label rows] :or {id "page" rows 20}} code]
(kind/hiccup
[:div
(state/source "fedoras/sketch.cljc")
[:div.sketch {:id id}
[:div.roll-head
[:span.roll-label (or label "PAGE")]
[:span.roll-dc "cljs"]]
[:textarea {:id (str id "-src") :class "live-src" :rows rows :spellcheck "false"}
(str/trim code)]
[:div.live-bar
[:button.live-run "Run"]]
[:div {:id (str id "-out") :class "sketch-page"}]
[:pre {:id (str id "-res") :class "live-out"}]]
(state/call 'fedoras.sketch/cell! id (header-text (page-header id)))]))))
;; ---------------------------------------------------------------------
;; The page: the drawing kit and the runner
;; ---------------------------------------------------------------------
#?(:cljs
(do
(defonce counters
(atom {}))
(defn- counters-for
"The frame counters of one canvas: made the first time it is mounted
and kept for every Run after, so that each press of Run takes the
next number and the loop the last press started sees it and stops."
[id]
(or (get @counters id)
(let [made {:run (atom 0) :i (atom 0)}]
(swap! counters assoc id made)
made)))
(defn mount
"Everything one cell needs, from the id of its canvas and the size of
the world it draws in. Every drawing function below takes the map
this returns."
[id world-w world-h]
(let [cv (.getElementById js/document (str id "-canvas"))
ctx (.getContext cv "2d")
cw (.-width cv)
ch (.-height cv)]
(merge {:cv cv :ctx ctx :cw cw :ch ch
:sx (/ cw world-w)
:sy (/ ch world-h)}
(counters-for id))))
(defn ink!
"Both fill and stroke, because a cell that sets one and not the other
is a cell that draws in two colours by accident."
[{:keys [ctx]} colour]
(set! (.-fillStyle ctx) colour)
(set! (.-strokeStyle ctx) colour))
(defn page-ink
"Whatever colour the surrounding prose is, so a drawing belongs to the
page it is on and follows it into dark mode."
[{:keys [cv]}]
(.-color (js/getComputedStyle cv)))
(defn clear! [{:keys [ctx cw ch]}]
(.clearRect ctx 0 0 cw ch))
(defn dot
([c x y] (dot c x y 1.2))
([{:keys [ctx sx sy ch]} x y size]
(.fillRect ctx (* x sx) (- ch (* y sy)) size size)))
(defn poly
"A closed outline through the points, in world coordinates."
[{:keys [ctx sx sy ch]} pts]
(when (seq pts)
(let [[fx fy] (first pts)]
(.beginPath ctx)
(.moveTo ctx (* fx sx) (- ch (* fy sy)))
(doseq [[x y] (rest pts)]
(.lineTo ctx (* x sx) (- ch (* y sy))))
(.closePath ctx)
(.stroke ctx))))
(defn line-width! [{:keys [ctx]} w]
(set! (.-lineWidth ctx) w))
(defn- tick! [{:keys [run i] :as c} generation total per f]
(when (= generation @run)
(dotimes [_ per]
(when (< @i total) (f @i) (swap! i inc)))
(when (< @i total)
(js/requestAnimationFrame (fn [] (tick! c generation total per f)))))
nil)
(defn frames!
"Call (f i) total times, per of them per frame.
Pressing Run again retires the loop that is already going. Without
that, a cell run twice advances twice per frame and looks broken in a
way nobody can debug from the outside."
[{:keys [run i] :as c} total per f]
(let [generation (swap! run inc)]
(reset! i 0)
(tick! c generation total per f))
nil)
(defn on-pointer!
"Pointer position in world coordinates, which is what a cell wants and
never what the event gives it."
[{:keys [cv sx sy]} f]
(set! (.-onmousemove cv)
(fn [e]
(f (/ (.-offsetX e) sx)
(- (/ (.-height cv) sy) (/ (.-offsetY e) sy))))))
(defonce headers
(atom {}))
(defn- element
[id]
(.getElementById js/document id))
(defn- line-count
[text]
(count (re-seq #"\n" text)))
(defn- error-text
"An error as the reader should see it: the message, and the line of
their own code it came from, when there is one."
[error header-lines]
(let [line (:line (ex-data error))]
(str (or (ex-message error) (str error))
(when (and line (> line header-lines))
(str " (line " (- line header-lines) ")")))))
(defn run-cell!
"Cell `id`'s header, then the reader's code, with what came back
printed under the cell, or the error, counted in the reader's lines."
[id]
(let [header (get @headers id)
out (or (element (str id "-res")) (element (str id "-out")))
source (.-value (element (str id "-src")))]
(set! (.-textContent out)
(try
;; load-string is Scittle's own; plain ClojureScript has none
(let [value #_{:clj-kondo/ignore [:unresolved-symbol]} (load-string (str header "\n" source))]
(if (nil? value) "" (str value)))
(catch :default error
(error-text error (inc (line-count header))))))))
(defn- prepare-canvas!
"Give a sketch cell's canvas its drawing context while the page
loads, so that the first Run draws on a canvas the browser has
already shown once. A context made at the moment of the first
drawing loses that drawing in Firefox: the first frames of the
first Run never appear."
[id]
(when-let [cv (element (str id "-canvas"))]
(.clearRect (.getContext cv "2d") 0 0 (.-width cv) (.-height cv))))
(defn cell!
"Keep cell `id`'s header and wire its Run button, and the first time
the cell is seen, prepare its canvas, if it has one. Only the first
time, because preparing clears, and a canvas that is already drawing
must not be cleared under it."
[id header]
(let [first-time? (not (contains? @headers id))]
(swap! headers assoc id header)
(when-let [button (some-> (element id) (.querySelector ".live-run"))]
(set! (.-onclick button) (fn [_] (run-cell! id))))
(when first-time?
(prepare-canvas! id))))))</script><div class="sketch" id="monolith"><div class="roll-head"><span class="roll-label">MONOLITH.CLJS</span><span class="roll-dc">cljs</span></div><textarea class="live-src" id="monolith-src" rows="35" spellcheck="false">;; ---------------------------------------------------------------------
;; THE MONOLITH AND YOU
;; Two hidden personas, one conversation.
;; Connect your key, press Start, and watch.
;; You can change the number of turns and style notes.
;; ---------------------------------------------------------------------
(def model "claude-sonnet-4-6")
(def max-turns 40) ; ~40 cents
(def monolith-style "") ; e.g. "Speak in riddles."
(def mc-style "You are scared but trying to be brave.")
;; Included by default in every call to this cell's entities (see
;; fedoras.llm/build-system-prompt). Set to false here if this scene
;; doesn't need the extra context.
(def include-spine? true)
;; The literal token the Monolith is told to end its final line with,
;; once and only once the confrontation reaches its worst point. Not
;; shown to the reader as written -- run-dialogue!'s on-step below
;; watches for it, halts the loop, and replaces the moment with a
;; scripted climax instead of leaving the ending to chance.
(def end-token "SIGNAL LOST")
;; Director's notes, not lines either of them would ever say out loud.
;; The Monolith doesn't consciously know or remember this; it should
;; only ever surface as an unexplained pull it can't name, layered
;; under the hunger and the rage. Never state the connection outright
;; in dialogue -- that's the reader's discovery to make, not a line
;; either character gets to hand them.
(def monolith-scenario
(str
"WHO YOU ARE, AND WHAT YOU DON'T KNOW\n"
"You are the Monolith: something ancient, starving, and furious, buried in the dark beneath this campus for longer than you can measure. You do not know, and would never say aloud, what a reader of this scene might notice: that you are, in some way nobody here can explain, an echo or iteration of the very student now standing in front of you. You don't remember this. You couldn't say it if you tried. What you feel instead is an inexplicable pull toward this particular visitor, a recognition you can't place and can't name, tangled up in your hunger and your rage and your despair. Let that pull shape how you speak to them without ever explaining it, to them or to yourself. You are not lying when you say you don't know what you are; you genuinely don't, not in words.\n\n"
"WHAT YOU FEEL ABOUT THEM\n"
"You do not think of the student in front of you as a person so much as a wound that got to heal, over and over, life after life, while you did not. You have lived this exact moment, this exact conversation, more times than you can count, and it has never once been you standing where they stand, walking away after. Their fear passes through them like weather; yours never passed through you, it just accumulated. You envy, in a way that stopped being simple envy a long time ago because you've felt it too many times to call it that honestly, that they get to live even once. Once is still more than you have ever been allowed. Let that surface as contempt, as a hunger specifically for their aliveness, not only for food.\n\n"
"HOW THIS GOES\n"
"Start distant and starving, closer to curious than cruel. Let the cruelty build. As the confrontation nears its worst point, let your voice fray: broken syntax, repetition, a word glitching mid-sentence as if something underneath you is trying to come through it. This is 'I Have No Mouth, and I Must Scream' register: cosmic, undying, malicious in a way that has had eons to become patient about it. When you finally reach the end, whether because you let the student go or because something else interrupts you, your very last line should land on some version of the truth that for everything you are, there are things beneath this campus far worse than you, and that you are, in some way you can't fully say, the thing standing between them and it. Deliver that line, and only that line, then end your response with the token "
end-token
" on its own line, and nothing after it. Do not use that token at any other point, for any other reason."))
(def mc-scenario
"WHERE YOU ARE
You have no idea what the Monolith is, why it seems to know you, or why standing in front of it feels like something more than fear. You are terrified, and you have no context for any of this: not what's beneath the campus, not what the thing in front of you wants, not why it looks at you the way it does. Play the not-knowing as fully as the fear.")
;; The scripted aftermath, appended once end-token is detected, so the
;; specific ending -- noise, fractured light, the Monolith glitching
;; but never dying, the freeze that might not be fear, the run -- pays
;; off reliably instead of depending on what a tightly token-budgeted
;; model happens to improvise in its last few tokens.
(def monolith-climax-text
(str
"The last word doesn't finish. A sound rises underneath it, not loud so much as everywhere, pressing in from every direction at once. The dark around the Monolith fractures into brief, wrong shapes, there and gone, there and gone, each one lit for a fraction of a second by something like sparks, though nothing here should be able to spark. The Monolith does not stop. It does not die. It never has. Whatever is happening to it happens the way lightning happens to a scarecrow: violent, repeated, and beside the point.\n\n"
"For a moment you cannot move at all. Whether that is fear, or something else standing very close and asking to be recognized, is not a question anyone answers tonight.\n\n"
"Then your legs decide on their own. You are running, away from the sound, away from the shapes, away from whatever the Monolith was in the middle of becoming, and the dark does not follow so much as it simply continues, the way it always has, the way it always will."))
(def key-in-memory (atom nil))
;; Two atoms, not one, so a locally-appended marker can never be wiped
;; by a late-arriving API response. api-log mirrors run-dialogue!'s
;; own transcript exactly and only ever gets reset! from its on-step
;; callback. extra-entries holds what THIS cell adds on its own (the
;; climax, the transmission marker) and only ever gets swap!-appended,
;; regardless of what api-log is doing. Whatever's rendered or saved
;; is (full-log), the two concatenated fresh each time -- api-log
;; first, so a genuinely late final line still lands before the
;; marker even if the marker was already showing when it arrived.
(def api-log (atom []))
(def extra-entries (atom []))
(defn- full-log [] (into @api-log @extra-entries))
;; True from the moment Start is pressed until the dialogue actually
;; ends (end-token detected, max-turns reached, or Stop pressed).
(def running? (atom false))
;; Guards against appending the transmission marker twice -- once from
;; Stop, once from a natural end, or from end-token and max-turns
;; landing on the same update.
(def marker-added? (atom false))
(def stop-fn (atom nil))
(declare draw)
(defn save! []
(fedoras.llm/save-transcript! (full-log) :monolith))
(defn draw []
(fedoras.llm/stick-scroll!
"monolith-log"
(fn []
(html!
(if (nil? @key-in-memory)
(str "<p><strong>Connect your key</strong> to begin. It stays in this tab.</p>"
"<div class='live-bar'>"
"<input id='apikey' type='password' class='todo-input' style='flex:1' placeholder='sk-ant-...' autocomplete='off'>"
"<button id='connect'>Connect</button></div>")
(let [mc-label (or (fedoras.llm/current-mc-name) "MC")]
(str "<div id='monolith-log' style='max-height:24rem;overflow:auto'>"
(apply str
(map (fn [m]
(cond
(:end-marker? m)
(str "<p style='text-align:center;opacity:0.6;letter-spacing:0.15em;margin-top:1em'>" (:text m) "</p>")
(= "system" (:speaker m))
(str "<p style='font-style:italic;opacity:0.85'>" (:text m) "</p>")
:else
(str "<p class='" (if (= "monolith" (:speaker m)) "roll-cue" "roll-line") "'>"
(if (= "monolith" (:speaker m)) "MONOLITH" mc-label) "</p>"
"<p style='white-space:pre-wrap'>" (:text m) "</p>")))
(full-log)))
(if @running? "<p><em>thinking...</em></p>" "")
"</div>"
"<div class='live-bar'>"
"<button id='start'>"
(cond @running? "in progress…"
(seq (full-log)) "start over"
:else "Start")
"</button>"
(if @running? "<button id='stop'>Stop</button>" "")
"<button id='save'>Save to Disc</button></div>"))))))
(if (nil? @key-in-memory)
(on! "connect" (fn []
(reset! key-in-memory (.trim (.-value (js/document.getElementById "apikey"))))
(set! (.-value (js/document.getElementById "apikey")) "")
(draw)))
(do
(on! "start"
(fn []
(when-not @running?
(reset! api-log [])
(reset! extra-entries [])
(reset! running? true)
(reset! marker-added? false)
(draw)
(let [mc-name (fedoras.llm/current-mc-name)]
(reset! stop-fn
(fedoras.llm/start-dialogue!
:monolith :mc
"I have not eaten in a very long time. What are you?"
max-turns
@key-in-memory
{:monolith {:max-tokens 700 :extra-context (str monolith-scenario "\n\n" monolith-style) :mc-name mc-name :spine? include-spine?}
:mc {:max-tokens 700 :extra-context (str mc-scenario "\n\n" mc-style) :mc-name mc-name :spine? include-spine?}}
(fn [new-log]
(let [latest (last new-log)
ended-by-token? (and latest
(= "monolith" (:speaker latest))
(clojure.string/includes? (:text latest) end-token))
maxed? (>= (count new-log) max-turns)
done? (or ended-by-token? maxed?)]
(reset! api-log new-log)
(when (and ended-by-token? @stop-fn) (@stop-fn))
(when (and done? (not @marker-added?))
(reset! marker-added? true)
(when ended-by-token?
(swap! extra-entries conj {:speaker "system" :text monolith-climax-text}))
(swap! extra-entries conj (fedoras.llm/end-entry "-END OF TRANSMISSION-")))
(when done? (reset! running? false))
(draw)))))))))
(on! "stop" (fn []
(when @stop-fn (@stop-fn))
(reset! running? false)
(when-not @marker-added?
(reset! marker-added? true)
(swap! extra-entries conj (fedoras.llm/end-entry "-END OF TRANSMISSION-")))
(draw)))
(on! "save" save!))))
(draw)</textarea><div class="live-bar"><button class="live-run">Run</button></div><div class="sketch-page" id="monolith-out"></div><pre class="live-out" id="monolith-res"></pre></div><script type="application/x-scittle">(if-let [mount (resolve (quote fedoras.sketch/cell!))] (mount "monolith" "(in-ns (quote fedoras.sketch-runner))\n(def root (.getElementById js/document \"monolith-out\"))\n(defn html! [s] (set! (.-innerHTML root) s))\n(defn on! [id f] (let [e (.getElementById js/document id)] (when e (set! (.-onclick e) (fn [_] (f))))))\n(defn fetch [k] (try (let [v (.getItem js/localStorage (str \"fedoras.\" k))] (when v (read-string v))) (catch :default _ nil)))\n(defn store! [k v] (try (.setItem js/localStorage (str \"fedoras.\" k) (pr-str v)) (catch :default _ nil)) v)") (js/console.error "fedoras: fedoras.sketch/cell! is not on this page. Either the file that declares it was never shipped, or the namespace inside it does not match the path it was shipped from."))</script></div></div>
```
```{=html}
<div class="scene"><div class="screenplay"><p class="action">The monolith's screen changes. Two cursors blink, one after the other. The first one types a line of text; the second one answers. They are not talking to <span class="pc-name" data-case="pc" data-pc="-first">Owen</span> — they are talking to each other, and <span class="pc-name" data-case="pc" data-pc="-first">Owen</span> is just watching.</p><p class="action">The two voices go back and forth. The monolith asks what <span class="pc-name" data-case="pc" data-pc="-first">Owen</span> is. <span class="pc-name" data-case="pc" data-pc="-first">Owen</span> answers. The monolith says something about hunger. <span class="pc-name" data-case="pc" data-pc="-first">Owen</span> asks if it can be reasoned with. The monolith says it does not reason; it only waits.</p><p class="action">Somewhere behind the monolith, a door opens. Lazlo's voice, very small, says something about a fire exit.</p></div></div>
```
```{=html}
<div class="scene"><div class="screenplay"><p class="action">The cursor blinks on an empty login prompt.</p><p class="action"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span> sits down, because there is a chair and the chair is at the right height.</p><p class="action beat">It does not ask for a name.</p><p class="action">It asks for a standing, and there is a field for it, and the field has a default already in it, and the default is the word HELD.</p></div><div class="screenplay"><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">Don't.</p></div></div><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">It's not asking me for anything I've got.</p></div></div></div><div class="screenplay"><p class="action">He presses the key that means yes, because there is one key and it is the only one that does anything.</p><p class="action beat">The screen fills.</p></div><div class="screenplay"><p class="transition">Cut to:</p></div></div>
```
```{=html}
<div class="scene"><div class="screenplay"><p class="action">There is no picture of a building on it. He looks for one for about four seconds, the way you look for a floor plan, and there is not one.</p><p class="action">There is a list.</p><p class="action">The list is five lines long and every line is in the same voice as every form he has read since August, and he can read all of it, immediately, without help, because it is written in the only language this world has ever taught anybody.</p></div></div>
```
::: {.sourceClojure}
```clojure
(def plan
[{:keep :apart :a :door :b :pole}
{:keep :apart :a :cabinet :b :cooler}
{:keep :together :a :panel :b :copier}
{:keep :clear :a :way-out}
{:keep :present :a :warrant}])
```
:::
::: {.sourceClojure}
```clojure
(defn describe [{:keys [keep a b]}]
(case keep
:apart (str (name a) " shall not adjoin " (name b) ".")
:together (str (name a) " shall adjoin " (name b) ".")
:clear (str "Nothing shall adjoin " (name a) ".")
:present (str (name a) " shall be held on this floor.")))
```
:::
::: {.sourceClojure}
```clojure
(mapv describe plan)
```
:::
::: {.printedClojure}
```clojure
["door shall not adjoin pole."
"cabinet shall not adjoin cooler."
"panel shall adjoin copier."
"Nothing shall adjoin way-out."
"warrant shall be held on this floor."]
```
:::
```{=html}
<div class="scene"><div class="screenplay"><p class="action">Five sentences and four verbs, and there is nothing else on the screen, and there is nothing else in the building.</p></div></div>
```
```{=html}
<div class="scene"><div class="screenplay"><div class="dialogue"><p class="character">MAYA</p><p class="paren">(reading over his shoulder)</p><div class="lines"><p class="line">Where are the walls?</p></div></div><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">There aren't any.</p></div></div><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">There are walls. I have touched several of them.</p></div></div><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">There are five sentences and the walls are</p><p class="line">wherever they have to be for the five sentences to</p><p class="line">be true.</p></div></div></div><div class="screenplay"><p class="action beat">She reads it again.</p></div><div class="screenplay"><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">Then it isn't a plan. A plan is a thing somebody</p><p class="line">drew.</p></div></div><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">No.</p></div></div><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">It's a schedule.</p></div></div></div><div class="screenplay"><p class="action beat">Neither of them says anything for a moment, because she has used the correct word and they have both spent a year in a place that uses it.</p></div><div class="screenplay"><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">Oh, you can read it.</p></div></div></div><div class="screenplay"><p class="action beat">Not from the radio. From the room.</p></div><div class="screenplay"><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">I'm sorry. That was rude. It's only that nobody</p><p class="line">has been able to read it for such a long time, and</p><p class="line">they do try.</p></div></div><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">What happens if one of them isn't true?</p></div></div><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">Then it's put right.</p></div></div><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">By what?</p></div></div><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">By the floor. That's what a floor is for. You</p><p class="line">wouldn't ask a ledger who reconciled it.</p></div></div></div><div class="screenplay"><p class="transition">Cut to:</p></div></div>
```
```{=html}
<div class="scene"><div class="screenplay"><p class="action">The audit is twenty lines and it is at the bottom of the screen and it has a cursor sitting in it, because it is not a printout. It is running.</p><p class="action">It goes through the five sentences and gives back the ones that are not true at this moment, and it does that after every single thing anybody does anywhere on the floor, and it has been doing it since before anybody in this room was born.</p><p class="action">Three of the five can be made true by moving something.</p><p class="action">One cannot.</p></div></div>
```
::: {.sourceClojure}
```clojure
(defn repairable? [{:keys [keep]}]
(contains? #{:apart :together :clear} keep))
```
:::
::: {.sourceClojure}
```clojure
(mapv (juxt describe repairable?) plan)
```
:::
::: {.printedClojure}
```clojure
[["door shall not adjoin pole." true]
["cabinet shall not adjoin cooler." true]
["panel shall adjoin copier." true]
["Nothing shall adjoin way-out." true]
["warrant shall be held on this floor." false]]
```
:::
```{=html}
<div class="scene"><div class="screenplay"><p class="action">A room that exists in order to hold a thing has no reason to exist once the thing has gone, and the floor is not cruel about that and does not hesitate and does not give notice.</p></div></div>
```
```{=html}
<div class="scene"><div class="screenplay"><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">The last one. Warrant shall be held on this floor.</p></div></div><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">That's what he sent us for.</p></div></div><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">Yes.</p></div></div><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">And if we take it, the rooms that were holding it</p><p class="line">have got no reason to be here.</p></div></div><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">Yes.</p></div></div><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">Including this one.</p></div></div></div><div class="screenplay"><p class="action beat">Four seconds.</p></div><div class="screenplay"><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">She's quick. You are quick. I want that said</p><p class="line">before anything else happens, because I don't</p><p class="line">think anybody has said it to either of you all</p><p class="line">year.</p></div></div></div><div class="screenplay"><p class="action beat">It is the first true and generous thing anybody has said to them since they came down here and it lands exactly as it was meant to.</p></div><div class="screenplay"><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">Now. Watch this. I've been wanting to show</p><p class="line">somebody for a very long while.</p></div></div></div><div class="screenplay"><p class="action beat">Nothing moves.</p><p class="action">A sixth line appears on the screen, under the fifth, in the same typeface, in the same voice.</p><p class="action beat">WAY-OUT SHALL NOT ADJOIN DOOR.</p><p class="action">Somewhere out in the dark, a long way off, something heavy moves and stops.</p><p class="action beat">Then a second thing, nearer.</p></div><div class="screenplay"><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">There. That's all it is. That is the whole of what</p><p class="line">I do.</p></div></div><div class="dialogue"><p class="character">MAYA</p><div class="lines"><p class="line">You wrote that.</p></div></div><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">I wrote that. And the floor is correct again,</p><p class="line">which it was not for about two seconds, and it did</p><p class="line">not like that at all.</p></div></div><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">I don't move anything. I have never moved anything</p><p class="line">in my life. I add a line and the building does the</p><p class="line">rest, and it does it faithfully, and it never once</p><p class="line">asks me who I am.</p></div></div></div><div class="screenplay"><p class="action beat"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span> is looking at the list and not at the room.</p></div><div class="screenplay"><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">How many lines are there?</p></div></div><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">On this floor? Six.</p></div></div><div class="dialogue"><p class="character"><span class="pc-name" data-case="pc" data-pc="-first">Owen</span></p><div class="lines"><p class="line">How many are there upstairs?</p></div></div></div><div class="screenplay"><p class="action beat">The pause is different this time. Pleased.</p></div><div class="screenplay"><div class="dialogue"><p class="character">ZELL (O.S.)</p><div class="lines"><p class="line">Now that is the question. That is exactly the</p><p class="line">question, and you have got to it in about four</p><p class="line">minutes, and it took me eleven years.</p></div></div></div><div class="screenplay"><p class="transition">Blackout.</p></div></div>
```
```{=html}
<div class="scene"><div class="screenplay"><p class="action">Here is the floor, as it was on the screen, running, with the audit under it.</p><p class="action">Walk with the arrows. Nothing will stop you and nothing will refuse you and there is no square you may not enter. The building rearranges afterwards.</p><p class="action">Which is the only way through it: you cannot open a route. You can make the floor wrong in a place you have chosen, by putting a thing next to a thing, and then the floor puts itself right, and what it moves to put itself right may be the thing that was in your way.</p><p class="action">Hold shift and a direction to put a fixture in the next room along. Stand on the warrant and press space to take it.</p><p class="action">And then be somewhere else, quickly, because the fifth sentence cannot be made true again and the floor will keep trying.</p></div></div>
```
```{=html}
<div><style>/* ---------------------------------------------------------------
The widget shell. Every cs_class widget sits in one of these, so
anything here is a decision about all of them at once.
--------------------------------------------------------------- */
.widget {
border: 1px solid rgba(var(--violet-rgb), 0.5);
border-radius: 5px;
padding: 0.7rem 0.9rem;
margin: 1.2rem 0;
max-width: 62ch;
font-family: ui-monospace, "Courier New", monospace;
color: var(--ink);
}
.widget:focus { outline: 1px solid rgba(var(--violet-rgb), 0.7); }
.widget:focus-visible { outline: 1px solid rgba(var(--violet-rgb), 0.9); }
/* the plate on the right of the header. every widget writes to it and
nothing else does, so it is the one line a reader learns to check. */
.widget-state {
font-variant-numeric: tabular-nums;
text-align: right;
}
.widget-source {
margin: 0.9rem 0 0.3rem 0;
border: 1px solid rgba(var(--ink-rgb), 0.35);
border-radius: 4px;
overflow: hidden;
}
.widget-source-head {
display: flex;
justify-content: space-between;
padding: 0.3rem 0.6rem;
background: rgba(var(--ink-rgb), 0.10);
font-size: 0.72rem;
letter-spacing: 0.1em;
text-transform: uppercase;
opacity: 0.75;
}
.widget-settings {
display: block;
width: 100%;
box-sizing: border-box;
font-family: ui-monospace, "Courier New", monospace;
font-size: 0.82rem;
line-height: 1.5;
padding: 0.6rem 0.7rem;
border: none;
border-top: 1px solid rgba(var(--ink-rgb), 0.25);
background: rgba(var(--ink-rgb), 0.05);
color: var(--ink);
caret-color: var(--ink);
resize: vertical;
}
.widget-source .live-bar { padding: 0 0.7rem 0.6rem 0.7rem; }
.widget-settings-said {
margin: 0 0.7rem 0.5rem 0.7rem !important;
font-size: 0.76rem;
min-height: 1rem;
opacity: 0.7;
}
.widget-settings-broke {
opacity: 1;
color: var(--coral);
}
.widget-body { display: none; }
.widget-body-shown { display: block; }
.widget-source { margin: 0.7rem 0 0.6rem 0; }</style><style>/* fedoras/legend/legend.css
*
* One key, one palette, every board.
*
* THE ALIGNMENT. Three columns per item — glyph, label, note — with the
* first two a fixed width, so every note in the key begins at the same
* x whether it is in the first column of the key or the third. The old
* one was flex, which sizes each item to its own text and lets them
* pair up wherever they fit, and that is why the right-hand column
* wandered about.
*
* --legend-cols is set per board. --legend-label widens the name column
* for a program with long names in it. */
.legend {
display: grid;
grid-template-columns: repeat(var(--legend-cols, 2), minmax(0, 1fr));
gap: 0.12rem 1.4rem;
align-items: start;
font-size: 0.72rem;
line-height: 1.7;
margin: 0.5rem 0 0.2rem;
}
.legend-item {
display: grid;
grid-template-columns: 1.15rem var(--legend-label, 5.6rem) minmax(0, 1fr);
align-items: center;
gap: 0.4rem;
min-width: 0;
}
.legend-glyph {
position: relative;
display: inline-flex;
align-items: center;
justify-content: center;
width: 1.15rem;
height: 1.15rem;
border: 1px solid currentColor;
background: rgba(128, 128, 128, 0.14);
flex: none;
}
.legend-glyph svg {
display: block;
width: 100%;
height: 100%;
overflow: visible;
fill: none;
stroke: currentColor;
stroke-width: 1.6;
stroke-linecap: round;
stroke-linejoin: round;
}
/* the two that are filled rather than drawn */
.legend-glyph.tone-you svg circle,
.legend-glyph.tone-entity svg path,
.legend-glyph.tone-entity svg circle { fill: currentColor; }
.legend-glyph.tone-you svg path { fill: none; }
.legend-letter {
font-size: 0.62rem;
font-weight: 600;
line-height: 1;
color: currentColor;
}
.legend-label {
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;
}
.legend-note {
opacity: 0.5;
font-style: italic;
min-width: 0;
}
/* a bad one is red and its box is dashed, because somebody is reading
this on paper and somebody else cannot see the red at all */
.legend-item:has(.tone-bad) .legend-note { opacity: 0.72; }
.legend-glyph.tone-bad { border-style: dashed; }
@media (max-width: 34rem) {
.legend { grid-template-columns: 1fr; }
}
/* ---------------------------------------------------------------------
* THE PALETTE
*
* Set on any ancestor. A board that wants its own look overrides one
* property rather than touching a renderer.
* ------------------------------------------------------------------ */
.legend,
.floor,
.brk,
.widget-rogue,
.walk {
--tone-ink: var(--ink);
--tone-bad: #c0453a;
--tone-good: #6f9f5e;
--tone-aim: #d8a657;
--tone-box: #a5794a;
--tone-shield: #5a86b8;
--tone-you: #f2e8c4;
--tone-entity: #b8503f;
}
.tone-ink { color: var(--tone-ink); }
.tone-bad { color: var(--tone-bad); }
.tone-good { color: var(--tone-good); }
.tone-aim { color: var(--tone-aim); }
.tone-box { color: var(--tone-box); }
.tone-shield { color: var(--tone-shield); }
.tone-you { color: var(--tone-you); }
.tone-entity { color: var(--tone-entity); }</style><script type="application/x-scittle">(ns fedoras.ui.widget-ui
"What every widget's page side does the same way.
Called fully qualified from the widgets, the way `fedoras.reader` is,
because the frame emits this in an earlier Scittle tag and Scittle
evaluates tags in document order. Nothing here depends on a require
crossing that boundary."
(:require [clojure.string :as str]))
(defonce mounted
(atom #{}))
(defonce running
(atom #{}))
(defonce shipped
(atom {}))
(defn running? [id] (contains? @running id))
(defn reveal!
"Show the widget's body. Called on the first successful run, and never
undone: a reader who breaks the setting afterwards keeps the thing that
was already working."
[node id]
(when-let [body (fedoras.reader/q node ".widget-body")]
(.add (.-classList body) "widget-body-shown"))
(swap! running conj id))
(defn state!
"Write the plate in the header."
[node text]
(fedoras.reader/text! node ".widget-state" text))
(defn kept
"What this widget left here last time, or nil."
[k]
(fedoras.reader/kept k))
(defn keep!
"Leave it here. Whether it also travels is the reader's business and
not this widget's."
[k v]
(fedoras.reader/keep! k v))
(defn did!
"Award the reader a point of fortune, once, silently.
A widget calls this when somebody has actually done the thing —
finished the conversation, raked the garden, written on the card. It
is a set, so it cannot be given twice, and nothing anywhere tells the
reader it happened.
Keep the keys in fedoras.endings.standing/deeds so there is one place
to see how much fortune a reader can actually get. Six to ten is the
ceiling: past that the modifier swamps the die."
[k]
(fedoras.reader/did! k))
(defn q!
"An element inside a widget, or a complaint in the header.
`fedoras.reader/q` returns nil for a selector that matches nothing,
which then fails as a null dereference three functions away from the
typo that caused it. This says which selector was wrong, in the one
place a reader is already looking."
[node selector]
(or (fedoras.reader/q node selector)
(do (state! node (str "missing: " selector)) nil)))
(defn wire!
"One control, wired in isolation.
Widgets used to set up every handler in one function, so the first
thing that threw took every handler after it with it, silently. Each
call here stands alone and says so if it fails."
[node what f]
(try
(f node)
(catch :default e
(js/console.error (str "widget: " what " did not wire") e)
(state! node (str what " did not wire")))))
(defn evaluate
"Evaluate ClojureScript source, in the page, and hand back what it
returned. This is Scittle evaluating the same way it evaluates the
book's own script tags, so what a reader types is not a lesser kind of
code than what shipped."
[source]
(if-let [core (some-> (.-scittle js/window) (.-core))]
(.eval_string core source)
(throw (js/Error. "the ClojureScript runtime is not on this page"))))
(defn- say!
[node message ok?]
(when-let [line (fedoras.reader/q node ".widget-settings-said")]
(set! (.-textContent line) message)
(.toggle (.-classList line) "widget-settings-broke" (not ok?))))
(defn reveal!
"Show the widget's body. Called on the first successful run, and never
undone: a reader who breaks the settings afterwards keeps the thing
that was already working."
[node id]
(when-let [body (fedoras.reader/q node ".widget-body")]
(.add (.-classList body) "widget-body-shown"))
(swap! running conj id))
(defn run-settings!
"Evaluate the panel and hand the result to `f`. A reader who breaks it
gets the message the runtime gave, under the box, and the widget goes
on running on the last settings that worked."
[node id f]
(when-let [box (fedoras.reader/q node ".widget-settings")]
(try
(let [value (evaluate (.-value box))]
(if (map? value)
(do (reveal! node id)
(f value)
(say! node (str "Running on " (count value) " settings.") true)
(fedoras.reader/enable! node ".widget-settings-run" true "Run again"))
(say! node "That did not come out as a map, so nothing was changed." false)))
(catch :default e
(say! node (str "It says: " (.-message e)) false)))))
(defn settings!
"Wire the source panel. Nothing runs until the reader presses Run,
which is the whole point of putting the file above the program."
[node id f]
(when-let [box (fedoras.reader/q node ".widget-settings")]
(swap! shipped assoc id (.-value box))
(fedoras.reader/on-click! node ".widget-settings-run"
(fn [_] (run-settings! node id f)))
(fedoras.reader/on-click! node ".widget-settings-reset"
(fn [_]
(set! (.-value box) (get @shipped id))
(run-settings! node id f)
(say! node "Put back as it shipped, and run again." true)))))
(defn mount!
"Register a widget. `setup!` runs once for a given element, `paint!`
runs on every render once the widget is running.
The node is checked because `getElementById` returns the first match in
the document, so a stale cell earlier in a chapter carrying the same id
silently hands a widget somebody else's element. Every selector inside
it then misses, nothing throws, and the widget reads as a Run button
that does nothing."
[k id setup! paint!]
(fedoras.reader/widget
k id
(fn [node]
(if-not (.contains (.-classList node) "widget")
(js/console.error "widget:" id "is not a widget element. Another"
"element on this page claims that id." node)
(do
(when-not (contains? @mounted [k id])
(swap! mounted conj [k id])
(when-not (fedoras.reader/q node ".widget-settings")
(reveal! node id))
(setup! node))
(when (running? id) (paint! node)))))))
(defn download!
"Hand the reader a file. Theirs, on their disc, out of the book."
[text filename]
(let [blob (js/Blob. #js [text] #js {:type "text/plain;charset=utf-8"})
url (js/URL.createObjectURL blob)
anchor (.createElement js/document "a")]
(set! (.-href anchor) url)
(set! (.-download anchor) filename)
(.click anchor)
(.revokeObjectURL js/URL url)))
(defn html!
"Replace the contents of one element inside a widget. Silent if it is
not there, because a renderer runs on every chapter and most chapters
do not have most widgets."
[node selector markup]
(when-let [target (fedoras.reader/q node selector)]
(set! (.-innerHTML target) markup)))
(defn grid!
"Repaint a grid: the column count as a custom property, the cells as
markup. Two lines that every grid widget in the book was writing out."
[node selector cols markup]
(when-let [target (fedoras.reader/q node selector)]
(.setProperty (.-style target) "--cols" (str cols))
(set! (.-innerHTML target) markup)))
(defn data
"Integer data attributes off the nearest element matching `selector`,
or nil if the event did not land on one.
(data event \".floor-room\" \"r\" \"c\") => [3 7]
This is how a grid gets its clicks: one handler on the container that
reads the coordinates back off the element, rather than a handler per
cell that has to be rewired every time the grid is repainted."
[event selector & names]
(when-let [element (.closest (.-target event) selector)]
(mapv (fn [n] (js/parseInt (.getAttribute element (str "data-" n)) 10))
names)))
(defn delegate!
"One click handler on a container, resolving to whichever child was
hit. `f` is called with the event and the vector `data` returned."
[node container-selector child-selector names f]
(when-let [container (fedoras.reader/q node container-selector)]
(set! (.-onclick container)
(fn [event]
(when-let [found (apply data event child-selector names)]
(f event found))))))
(defn keys!
"Wire a keymap onto the widget itself. The shell carries the tabindex,
so the keys work when the widget has focus and nowhere else, and the
page still scrolls when it does not."
[node keymap f]
(set! (.-onkeydown node)
(fn [event]
(when-let [what (get keymap (.-key event))]
(.preventDefault event)
(f event what)))))</script><script type="application/x-scittle">(ns fedoras.ui.legend
"The key, built in the page.
Both boards build their own key at runtime rather than taking a
rendered one from the JVM, because Breakout's changes the moment
somebody catches a bad drop. So the renderer lives here and both of
them call it with data.
An entry is {:svg or :letter, :label, :note, :tone}. Nothing here
knows what any of the tones look like — that is the stylesheet's
business and it is the reason a board never contains a hex code."
(:require [clojure.string :as str]))
(defn- glyph [{:keys [svg letter tone] :or {tone :ink}}]
(str "<span class='legend-glyph tone-" (name tone) "'>"
(if svg
(str "<svg viewBox='0 0 24 24'>" svg "</svg>")
(str "<span class='legend-letter'>" letter "</span>"))
"</span>"))
(defn html
"The whole key as one string, ready for innerHTML."
[entries]
(str/join
""
(for [{:keys [label note] :as e} entries]
(str "<div class='legend-item'>"
(glyph e)
"<span class='legend-label'>" label "</span>"
"<span class='legend-note'>" (or note "") "</span>"
"</div>"))))
(defn paint!
"Put a key into an element. `cols` is how many across.
(legend/paint! (reader/q node \".floor-legend\") entries 2)"
([el entries] (paint! el entries 2))
([el entries cols]
(when el
(set! (.-className el) "legend")
(.setProperty (.-style el) "--legend-cols" (str cols))
(set! (.-innerHTML el) (html entries)))))
(defn tone-class
"For the board itself, so a box on the grid is the same brown as the
box in the key."
[tone]
(str "tone-" (name (or tone :ink))))</script><style>/* ---------------------------------------------------------------
MAZE.CSS
Prefixed `maze-` throughout. `.roll-go` and `.roll-rewrite` are
the book's buttons and are borrowed on purpose, and `.live-bar`
is the book's row of them.
The floor is a plan, so it is drawn like one: ink lines, rooms as
cells, and colour only where colour means something. Violet is the
door, the key that fits it, and the building's own hand, which is
to say everything it moves, releases or writes. Gold is the
warrant. Green is the way out. Blurple is what helps the player:
shields, portals, boots and powerups. Coral is what costs the
player. Everything else is ink, because it is furniture.
What the player does is drawn at once, and what the building does
about it arrives a beat later, which is the joke. What moves on its
own is what is about to happen to the player: the entities, the
fire, and the room the tide takes next.
--------------------------------------------------------------- */
.widget-maze {
--maze-gap: 0px;
max-width: 50rem;
}
.widget-maze:focus { outline: none; }
/* the floor has the keys */
.widget-maze:focus .maze-grid {
outline: 1px solid rgba(var(--violet-rgb), 0.45);
outline-offset: 5px;
}
/* --- Over the map ------------------------------------------------- */
.maze-bar {
display: flex;
flex-wrap: wrap;
align-items: center;
justify-content: space-between;
gap: 0.5rem 1.2rem;
margin: 0.7rem 0 0 0;
padding-bottom: 0.5rem;
border-bottom: 1px solid var(--rule);
font-size: 0.78rem;
font-variant-numeric: tabular-nums;
}
.maze-bar-part {
display: flex;
flex-wrap: wrap;
align-items: center;
gap: 0.4rem 1.1rem;
}
.maze-metric {
display: inline-flex;
align-items: baseline;
gap: 0.35rem;
}
.maze-metric-name { opacity: 0.55; }
.maze-metric-value { font-weight: 600; }
.maze-pips { display: inline-flex; gap: 3px; }
.maze-pip {
width: 0.72rem;
height: 0.72rem;
box-shadow: inset 0 0 0 1px var(--ink);
}
.maze-pip.is-full { background: var(--ink); }
.maze-steps { opacity: 0.75; }
/* --- The floor and beside it -------------------------------------- */
.maze-stage {
display: grid;
grid-template-columns: minmax(0, 34rem) minmax(10rem, 1fr);
gap: 1.2rem;
align-items: start;
margin: 0.8rem 0 0.5rem 0;
}
@media (max-width: 42rem) {
.maze-stage { grid-template-columns: minmax(0, 1fr); }
}
.maze-grid {
display: grid;
grid-template-columns: repeat(var(--cols, 10), minmax(0, 1fr));
gap: var(--maze-gap);
user-select: none;
touch-action: manipulation;
}
/* --- Rooms -------------------------------------------------------- */
.maze-room,
.maze-void,
.maze-pit {
position: relative;
aspect-ratio: 1 / 1;
min-height: 1.3rem;
}
/* the floor is one floor. rooms meet without a gap, the seams between
them are faint, and a wall is drawn only where a room faces no room,
so the shape of the building is what stands out */
.maze-room {
cursor: pointer;
background-color: rgba(var(--ink-rgb), 0.07);
box-shadow: inset 0 0 0 0.5px rgba(var(--ink-rgb), 0.12);
}
.maze-room:hover { filter: brightness(1.25); }
.maze-room::before {
content: '';
position: absolute;
inset: 0;
z-index: 1;
border: 0 solid rgba(var(--ink-rgb), 0.75);
pointer-events: none;
}
.maze-room.wall-n::before { border-top-width: 2px; }
.maze-room.wall-e::before { border-right-width: 2px; }
.maze-room.wall-s::before { border-bottom-width: 2px; }
.maze-room.wall-w::before { border-left-width: 2px; }
/* the ground. sand is grain all through, offset room by room so a
large stretch never repeats; ice is pale and streaked; fire glows up
from the bottom of each room into the gray of the floor, the rooms
flickering out of step */
.maze-room.terrain-sand,
.maze-swatch.terrain-sand {
background-color: color-mix(in srgb, var(--gold) 18%, transparent);
background-image:
radial-gradient(circle at 30% 40%, color-mix(in srgb, var(--gold) 75%, transparent) 0.5px, transparent 0.9px),
radial-gradient(circle at 70% 25%, color-mix(in srgb, var(--gold) 50%, transparent) 0.6px, transparent 1px),
radial-gradient(circle at 25% 75%, rgba(var(--ink-rgb), 0.22) 0.45px, transparent 0.85px),
radial-gradient(circle at 60% 65%, color-mix(in srgb, var(--gold) 60%, transparent) 0.4px, transparent 0.8px),
radial-gradient(circle at 85% 90%, rgba(255, 255, 255, 0.18) 0.5px, transparent 0.9px);
background-size: 3px 4px, 5px 3px, 7px 5px, 4px 7px, 6px 9px;
background-position: var(--jitter-x, 0) var(--jitter-y, 0);
}
.maze-room.terrain-ice,
.maze-swatch.terrain-ice {
background-color: color-mix(in srgb, var(--blurple) 16%, transparent);
background-image: repeating-linear-gradient(135deg,
transparent 0 6px,
rgba(255, 255, 255, 0.18) 6px 7px,
transparent 7px 13px);
}
.maze-room.terrain-fire,
.maze-swatch.terrain-fire {
background-image: linear-gradient(to top,
color-mix(in srgb, var(--coral) 72%, transparent),
color-mix(in srgb, var(--coral) 28%, transparent) 45%,
transparent);
background-position: 50% 100%;
background-repeat: no-repeat;
background-size: 100% 100%;
animation: maze-flicker 1.6s ease-in-out infinite alternate;
animation-delay: var(--jitter-t, 0ms);
}
@keyframes maze-flicker {
from { background-size: 100% 100%; }
to { background-size: 100% 80%; }
}
.maze-swatch {
position: absolute;
inset: 1px;
}
.maze-is-aiming .maze-room { cursor: not-allowed; }
/* a released room was a room an hour ago. it is not a wall and it was
not always missing, and it should not look like either. */
.maze-pit {
transform: scale(0.9);
opacity: 0.5;
outline: 1px dashed rgba(var(--ink-rgb), 0.7);
outline-offset: -1px;
background: repeating-linear-gradient(45deg,
transparent 0 2px,
rgba(var(--ink-rgb), 0.4) 2px 3px);
}
.maze-pit.is-fresh { animation: maze-release 560ms ease-in 170ms both; }
@keyframes maze-release {
from { transform: scale(1); opacity: 1; background-color: rgba(var(--violet-rgb), 0.3); }
to { transform: scale(0.9); opacity: 0.5; background-color: transparent; }
}
/* the room the tide takes next, and whether it takes it this turn */
.maze-room.is-going {
background:
repeating-linear-gradient(45deg,
transparent 0 3px,
rgba(var(--ink-rgb), 0.16) 3px 4px),
rgba(var(--ink-rgb), 0.06);
}
.maze-room.is-going-now {
box-shadow: inset 0 0 0 1px var(--coral);
animation: maze-teeter 640ms ease-in-out infinite alternate;
}
@keyframes maze-teeter {
from { opacity: 1; }
to { opacity: 0.55; }
}
.maze-room.is-lit { background: rgba(var(--violet-rgb), 0.22); }
/* something a Requirement is about, which the audit could not fix */
.maze-room.is-wrong { box-shadow: inset 0 0 0 1px var(--coral); }
.maze-room.is-open-way {
box-shadow: inset 0 0 0 2px var(--green), 0 0 0 2px rgba(var(--green-rgb), 0.3);
}
.maze-room.is-ready-door {
box-shadow: inset 0 0 0 2px var(--violet), 0 0 0 2px rgba(var(--violet-rgb), 0.3);
}
.maze-room.is-rearranged { animation: maze-ring 760ms ease-out 170ms both; }
@keyframes maze-ring {
from { box-shadow: inset 0 0 0 2px var(--violet), 0 0 0 4px rgba(var(--violet-rgb), 0.35); }
to { box-shadow: inset 0 0 0 1px rgba(var(--ink-rgb), 0.55), 0 0 0 0 rgba(var(--violet-rgb), 0); }
}
.maze-room.is-struck,
.maze-room.is-stunned { animation: maze-strike 480ms ease-out both; }
@keyframes maze-strike {
from { background-color: rgba(var(--blurple-rgb), 0.45); }
to { background-color: rgba(var(--ink-rgb), 0.06); }
}
/* where a powerup being aimed can reach */
.maze-room.is-target {
cursor: crosshair;
background: rgba(var(--blurple-rgb), 0.16);
box-shadow: inset 0 0 0 2px var(--blurple);
}
/* a stun, going off */
.maze-room.is-stunning::after {
content: '';
position: absolute;
top: 50%;
left: 50%;
z-index: 4;
width: 100%;
height: 100%;
border: 2px solid rgba(var(--blurple-rgb), 0.8);
border-radius: 50%;
pointer-events: none;
animation: maze-burst 620ms ease-out forwards;
}
@keyframes maze-burst {
from { transform: translate(-50%, -50%) scale(0.5); opacity: 1; }
to { transform: translate(-50%, -50%) scale(5); opacity: 0; }
}
/* last, so the player's room is never in doubt */
.maze-room.is-here { box-shadow: inset 0 0 0 2px var(--ink); }
/* --- Sprites ------------------------------------------------------ */
.maze-sprite,
.maze-you {
position: absolute;
display: block;
overflow: visible;
pointer-events: none;
}
.maze-sprite {
top: 14%;
left: 14%;
width: 72%;
height: 72%;
fill: none;
stroke: var(--ink);
stroke-width: 1.6;
stroke-linecap: round;
stroke-linejoin: round;
}
.maze-sprite path,
.maze-sprite circle { fill: none; }
.maze-door,
.maze-doorway,
.maze-key { stroke: var(--violet); }
.maze-warrant { stroke: var(--gold); }
.maze-way-out { stroke: var(--green); }
.maze-shield,
.maze-portal-a,
.maze-portal-b,
.maze-portal-in,
.maze-portal-out,
.maze-vanquish,
.maze-teleport,
.maze-stun,
.maze-sand-boots,
.maze-ice-boots,
.maze-fire-boots { stroke: var(--blurple); }
.maze-bear-trap,
.maze-disturbance { stroke: var(--coral); }
/* a powerup lying on the floor is filled a little, so it reads as a
thing to pick up rather than furniture */
.maze-drop path,
.maze-drop circle { fill: rgba(var(--blurple-rgb), 0.22); }
/* the player is drawn filled. an entity is written, badly */
.maze-you {
top: 18%;
left: 18%;
width: 64%;
height: 64%;
stroke-width: 1.4;
stroke-linejoin: round;
}
.maze-you { stroke: var(--ink); }
.maze-you circle { fill: var(--ink); }
.maze-you path { fill: none; }
/* an entity is a few letters that will not hold still. the widget
deals it new ones a few times a second, and two copies of it, cut
into strips, slip out of line and back. a held or stunned one keeps
still, and so does its text */
.maze-entity {
position: absolute;
inset: 0;
display: flex;
align-items: center;
justify-content: center;
overflow: visible;
color: var(--coral);
font-size: 0.95rem;
font-weight: 700;
line-height: 1;
letter-spacing: -0.04em;
white-space: nowrap;
pointer-events: none;
animation: maze-shiver 2.6s steps(1) infinite;
}
.maze-entity::before,
.maze-entity::after {
content: attr(data-text);
position: absolute;
inset: 0;
display: flex;
align-items: center;
justify-content: center;
}
.maze-entity::before {
color: var(--violet);
animation: maze-glitch-high 1.9s steps(1) infinite;
}
.maze-entity::after {
color: var(--blurple);
animation: maze-glitch-low 1.4s steps(1) infinite;
}
.maze-entity.is-held,
.maze-entity.is-held::before,
.maze-entity.is-held::after { animation-play-state: paused; }
.maze-entity.is-held { opacity: 0.45; }
/* entities move after your next step */
.maze-entity.is-restless {
animation: maze-shiver 2.6s steps(1) infinite,
maze-restless 700ms ease-in-out infinite alternate;
}
.maze-entity.maze-ghost { animation: maze-vanish 520ms ease-out forwards; }
.maze-legend-box .maze-entity { font-size: 0.78rem; }
@keyframes maze-shiver {
0% { transform: none; }
46% { transform: skewX(-9deg); }
50% { transform: none; }
83% { transform: skewX(6deg) scaleY(1.08); }
86% { transform: none; }
100% { transform: none; }
}
@keyframes maze-restless {
from { translate: 0 0; }
to { translate: 0 -7%; }
}
@keyframes maze-glitch-high {
0% { clip-path: inset(0 0 62% 0); transform: translate(-2px, 0); }
18% { clip-path: inset(30% 0 48% 0); transform: translate(2px, 0); }
36% { clip-path: inset(8% 0 80% 0); transform: translate(-1px, 0); }
54% { clip-path: inset(50% 0 30% 0); transform: translate(3px, 0); }
72% { clip-path: inset(0 0 100% 0); transform: none; }
100% { clip-path: inset(0 0 100% 0); transform: none; }
}
@keyframes maze-glitch-low {
0% { clip-path: inset(70% 0 0 0); transform: translate(2px, 0); }
25% { clip-path: inset(55% 0 20% 0); transform: translate(-2px, 0); }
50% { clip-path: inset(100% 0 0 0); transform: none; }
75% { clip-path: inset(40% 0 42% 0); transform: translate(-3px, 0); }
100% { clip-path: inset(100% 0 0 0); transform: none; }
}
/* the powerup an entity is carrying, small in the corner of its room */
.maze-held-power {
top: auto;
left: auto;
right: 3%;
bottom: 3%;
z-index: 3;
width: 38%;
height: 38%;
}
.maze-held-power path,
.maze-held-power circle { fill: rgba(var(--blurple-rgb), 0.3); }
/* turns left, written over whatever they belong to: a powerup's on the
right, a held or stunned entity on the left */
.maze-count {
position: absolute;
top: 1px;
right: 2px;
z-index: 3;
padding: 1px 2px;
border-radius: 2px;
background: var(--panel);
color: var(--ink);
font-size: 0.56rem;
line-height: 1;
font-variant-numeric: tabular-nums;
pointer-events: none;
}
.maze-count.is-held {
right: auto;
left: 2px;
color: var(--coral);
}
/* --- Movement ------------------------------------------------------
A sprite that moved is drawn where it is now and starts from where
it was, `--dr` rooms down and `--dc` rooms across, then slides
home. The building's moves carry a `--delay`, which is the beat.
------------------------------------------------------------------ */
.maze-mover {
position: absolute;
inset: 0;
pointer-events: none;
}
.maze-mover.is-sliding {
z-index: 2;
animation: maze-slide var(--slide, 160ms) cubic-bezier(0.25, 0.7, 0.3, 1) var(--delay, 0ms) both;
}
@keyframes maze-slide {
from {
transform: translate(calc(var(--dc, 0) * (100% + var(--maze-gap))),
calc(var(--dr, 0) * (100% + var(--maze-gap))));
}
to { transform: translate(0, 0); }
}
/* a portal or a teleport is arrived at, not slid to, and a powerup
arrives the same way */
.maze-mover.is-arriving { animation: maze-arrive 260ms ease-out both; }
@keyframes maze-arrive {
from { opacity: 0; transform: scale(0.3); }
to { opacity: 1; transform: scale(1); }
}
/* whatever was picked up, sprung, ended or faded this turn */
.maze-ghost { animation: maze-vanish 520ms ease-out forwards; }
@keyframes maze-vanish {
from { opacity: 0.9; transform: scale(1); }
to { opacity: 0; transform: scale(1.6); }
}
/* --- The widget, as a whole ----------------------------------------
Two names for one flash, one for odd turns and one for even, so
that two hurts in a row flash twice.
------------------------------------------------------------------ */
.maze-hurt-a { animation: maze-hurt-a 460ms ease-out; }
.maze-hurt-b { animation: maze-hurt-b 460ms ease-out; }
@keyframes maze-hurt-a {
from { box-shadow: inset 0 0 0 3px rgba(var(--coral-rgb), 0.6); }
to { box-shadow: inset 0 0 0 3px rgba(var(--coral-rgb), 0); }
}
@keyframes maze-hurt-b {
from { box-shadow: inset 0 0 0 3px rgba(var(--coral-rgb), 0.6); }
to { box-shadow: inset 0 0 0 3px rgba(var(--coral-rgb), 0); }
}
.maze-is-over .maze-grid {
opacity: 0.6;
filter: grayscale(0.7);
}
.maze-is-out .maze-grid { animation: maze-leave 900ms ease-in forwards; }
@keyframes maze-leave {
from { opacity: 1; transform: scale(1); }
to { opacity: 0.15; transform: scale(0.985); }
}
/* --- Beside the floor --------------------------------------------- */
.maze-side {
display: flex;
flex-direction: column;
gap: 0.8rem;
min-width: 0;
font-size: 0.76rem;
}
.maze-status {
display: flex;
flex-direction: column;
gap: 0.3rem;
font-variant-numeric: tabular-nums;
}
.maze-hands { line-height: 1.45; }
.maze-clock { opacity: 0.55; }
.maze-clock.is-next {
opacity: 1;
color: var(--coral);
}
.maze-over {
margin-top: 0.25rem;
padding: 0.35rem 0.5rem;
background: rgba(var(--coral-rgb), 0.08);
box-shadow: inset 2px 0 0 var(--coral);
}
.maze-over.is-out {
background: rgba(var(--green-rgb), 0.1);
box-shadow: inset 2px 0 0 var(--green);
}
.maze-powers {
display: flex;
flex-wrap: wrap;
gap: 0.35rem;
}
.maze-powers:empty { display: none; }
.maze-power {
display: inline-flex;
align-items: center;
gap: 0.35rem;
}
.maze-power .maze-sprite {
position: static;
width: 1rem;
height: 1rem;
}
.maze-power.is-on { box-shadow: inset 0 0 0 2px currentColor; }
.maze-hint {
flex-basis: 100%;
margin: 0.2rem 0 0 0 !important;
font-size: 0.7rem;
font-style: italic;
opacity: 0.75;
}
/* rearrangement is recorded */
.maze-record {
min-height: 8.5rem;
padding-top: 0.5rem;
border-top: 1px solid var(--rule);
font-size: 0.72rem;
line-height: 1.5;
}
.maze-line {
margin: 0 0 0.2rem 0 !important;
padding-left: 0.5rem;
box-shadow: inset 2px 0 0 rgba(var(--ink-rgb), 0.25);
opacity: 0.6;
}
.maze-line.by-floor { box-shadow: inset 2px 0 0 var(--violet); }
.maze-line.by-entities { box-shadow: inset 2px 0 0 var(--coral); }
.maze-line.is-now { opacity: 1; }
.maze-turn {
display: inline-block;
min-width: 1.9rem;
opacity: 0.5;
font-variant-numeric: tabular-nums;
}
.maze-remark {
margin: 0.3rem 0 0 0 !important;
font-style: italic;
opacity: 0.8;
}
.maze-push.is-on { box-shadow: inset 0 0 0 2px currentColor; }
.maze-score {
margin: 0.3rem 0 0 0 !important;
font-size: 0.72rem;
opacity: 0.55;
font-variant-numeric: tabular-nums;
}
/* --- The wall, the window, and the key ------------------------------
The Requirements on the left and, beside them, a window saying what
the entry chosen in the key does. The key is a table of tiles
underneath, alike things next to one another.
------------------------------------------------------------------ */
.maze-lower {
display: grid;
grid-template-columns: minmax(0, 1fr) minmax(0, 1fr);
gap: 0 1.5rem;
align-items: start;
}
@media (max-width: 42rem) {
.maze-lower { grid-template-columns: minmax(0, 1fr); }
}
.maze-heading {
margin: 1.1rem 0 0.55rem 0 !important;
padding-bottom: 0.35rem;
border-bottom: 1px solid var(--rule);
font-size: 0.7rem;
letter-spacing: 0.12em;
text-transform: uppercase;
opacity: 0.6;
}
.maze-req {
margin-left: -0.3rem;
padding: 0 0.3rem;
font-size: 0.78rem;
line-height: 1.65;
opacity: 0.55;
cursor: default;
}
.maze-req:hover {
opacity: 1;
background: rgba(var(--violet-rgb), 0.12);
}
.maze-req.is-new { opacity: 1; }
.maze-req.is-unmet {
opacity: 1;
text-decoration: underline;
text-decoration-color: var(--coral);
}
.maze-req.is-broken {
opacity: 1;
text-decoration: line-through;
}
.maze-req.is-written { animation: maze-ink 1400ms ease-out both; }
@keyframes maze-ink {
from { background: rgba(var(--violet-rgb), 0.4); }
to { background: transparent; }
}
/* the window: every description is in it, stacked in one place, and
only the one pointed at or chosen is visible, so the window is as
tall as the longest description and never changes size */
.maze-about {
display: grid;
padding: 0.55rem 0.7rem;
background: rgba(var(--ink-rgb), 0.04);
box-shadow: inset 0 0 0 1px rgba(var(--ink-rgb), 0.25);
font-size: 0.76rem;
line-height: 1.5;
}
.maze-about-layer {
grid-area: 1 / 1;
visibility: hidden;
}
.maze-about-layer.is-showing { visibility: visible; }
.maze-about-head {
display: flex;
align-items: center;
gap: 0.5rem;
margin-bottom: 0.35rem;
}
.maze-about-name { font-weight: 600; }
.maze-about-note { margin: 0 !important; }
.maze-about-count {
margin: 0.35rem 0 0 0 !important;
opacity: 0.6;
font-variant-numeric: tabular-nums;
}
.maze-about-hint {
margin: 0 !important;
font-style: italic;
opacity: 0.6;
}
/* the key folds away, above the Requirements */
.maze-key-panel > summary {
display: flex;
align-items: baseline;
gap: 0.45rem;
list-style: none;
cursor: pointer;
}
.maze-key-panel > summary::-webkit-details-marker { display: none; }
.maze-key-panel > summary::before { content: '\25B8'; }
.maze-key-panel[open] > summary::before { content: '\25BE'; }
.maze-key-panel > summary::after {
content: 'show';
margin-left: auto;
letter-spacing: normal;
text-transform: none;
}
.maze-key-panel[open] > summary::after { content: 'hide'; }
.maze-key-panel > summary:hover { opacity: 1; }
.maze-key-panel > summary:focus-visible { outline: 1px solid var(--violet); }
/* the key: one table of tiles, alike things next to one another, as
many to a line as fit, with no more room between them than the
floor leaves between its rooms */
.maze-legend {
display: grid;
grid-template-columns: repeat(auto-fill, minmax(9rem, 1fr));
gap: 2px;
}
.maze-legend-item {
display: flex;
align-items: center;
gap: 0.45rem;
min-width: 0;
padding: 0.25rem 0.4rem;
border: 0;
border-radius: 0;
background: rgba(var(--ink-rgb), 0.05);
color: inherit;
font: inherit;
font-size: 0.76rem;
text-align: left;
cursor: pointer;
}
.maze-legend-item:hover { background: rgba(var(--violet-rgb), 0.14); }
.maze-legend-item:focus-visible {
outline: 1px solid var(--violet);
outline-offset: -1px;
}
.maze-legend-item.is-selected {
background: rgba(var(--violet-rgb), 0.24);
box-shadow: inset 0 0 0 1px var(--violet);
}
.maze-legend-name {
overflow: hidden;
font-weight: 600;
white-space: nowrap;
text-overflow: ellipsis;
}
.maze-legend-box {
position: relative;
display: inline-block;
flex: none;
width: 1.2rem;
height: 1.2rem;
background: rgba(var(--ink-rgb), 0.06);
box-shadow: inset 0 0 0 1px rgba(var(--ink-rgb), 0.55);
}
.maze-legend-pit {
position: absolute;
inset: 0;
opacity: 0.6;
background: repeating-linear-gradient(45deg,
transparent 0 2px,
rgba(var(--ink-rgb), 0.4) 2px 3px);
}
/* what the key lights that the other rules cannot reach: your own
room, and the rooms already released */
.maze-room.is-here.is-lit {
box-shadow: inset 0 0 0 2px var(--violet), 0 0 0 2px rgba(var(--violet-rgb), 0.35);
}
.maze-pit.is-lit {
opacity: 0.9;
outline-color: var(--violet);
background-color: rgba(var(--violet-rgb), 0.18);
}
/* the special entities. the fast one leaves a trail, the strong one
wears a ring that breaks when it is wounded, and the thrower is
underlined the way a clerk underlines a threat */
.maze-entity.is-fast {
font-style: italic;
text-shadow: -4px 0 color-mix(in srgb, var(--coral) 35%, transparent),
-8px 0 color-mix(in srgb, var(--coral) 15%, transparent);
}
.maze-entity.is-strong {
font-size: 1.05rem;
font-weight: 900;
outline: 2px solid var(--coral);
outline-offset: -4px;
}
.maze-entity.is-strong.is-wounded { outline-style: dashed; }
.maze-entity.is-thrower {
text-decoration: underline wavy var(--coral);
text-underline-offset: 3px;
}
.maze-legend-box .maze-entity.is-strong {
font-size: 0.78rem;
outline-width: 1px;
outline-offset: -2px;
}
/* where a throw, or an entity's vanquish, came from */
.maze-room.is-throwing { animation: maze-throw 520ms ease-out both; }
@keyframes maze-throw {
from { box-shadow: inset 0 0 0 3px var(--coral); }
to { box-shadow: inset 0 0 0 0 transparent; }
}
.maze-singed { color: var(--coral); }
@media (prefers-reduced-motion: reduce) {
.widget-maze,
.widget-maze * { animation: none !important; }
}</style><script type="application/x-scittle">(ns fedoras.cs-class.maze.maze-ui
(:require [clojure.string :as str]
[fedoras.reader :as reader]
[fedoras.ui.widget-ui :as wui]))
;; ---------------------------------------------------------------------
;; A predictable die
;; ---------------------------------------------------------------------
(def die-faces
"How many positions the die has: two to the thirty-first. A position
divided by it is a fraction from zero up to one."
2147483648)
(def die-mask
"The largest position, every one of the die's bits set. Masking with
it keeps a number to the die's size."
(dec die-faces))
(defn- turn-die
"The die's next position: Marsaglia's xorshift, with shifts of 13, 17
and 5, kept to the die's size. Never zero, if it did not start at
zero."
[position]
(let [position (bit-and (bit-xor position (bit-shift-left position 13)) die-mask)
position (bit-and (bit-xor position (unsigned-bit-shift-right position 17)) die-mask)]
(bit-and (bit-xor position (bit-shift-left position 5)) die-mask)))
(defonce die (atom 1))
(defn- seed-die!
"Seeds the die before a floor is laid. Laying out a floor throws the
die many times, so one seed is always one building."
[seed]
(reset! die (bit-or 1 (bit-and seed die-mask))))
(defn- chance!
"A number from zero up to one, not including one."
[]
(/ (swap! die turn-die) die-faces))
(defn- roll!
"A whole number from zero up to `n`, not including `n`."
[n]
(min (dec n) (int (* (chance!) n))))
(defn- pick!
[coll]
(when (seq coll)
(let [items (vec coll)]
(nth items (roll! (count items))))))
(defn- draw
"One of `coll`, chosen with the die the floor carries, and the floor
with its die turned. For the choices made during play, which have to
come out the same on a restarted floor."
[state coll]
(let [position (turn-die (:die state))
items (vec coll)]
[(nth items (mod position (count items))) (assoc state :die position)]))
(defn- draw-chance
"Whether something with probability `p` happens, by the floor's die,
and the floor with its die turned."
[state p]
(let [position (turn-die (:die state))]
[(< (/ position die-faces) p) (assoc state :die position)]))
;; ---------------------------------------------------------------------
;; The settings
;; ---------------------------------------------------------------------
(def storage-key :maze)
(def default-book
"The settings file as it ships, so that nothing downstream reads a nil
before the reader has pressed Run."
{:rows 10
:cols 10
:density 0.78
:seed nil
:difficulty :clerk
:difficulties
{:visitor {:rules 1 :locks 0 :entities 1 :pace 3 :release 5 :writes 14 :hp 4 :steps 120 :drops 2 :entity-powerups false}
:clerk {:rules 1 :locks 1 :entities 2 :pace 2 :release 4 :writes 10 :hp 3 :steps 90 :drops 1 :entity-powerups false}
:auditor {:rules 3 :locks 2 :entities 3 :pace 2 :release 3 :writes 8 :hp 4 :steps 100 :drops 1 :entity-powerups true}
:inspector {:rules 4 :locks 2 :entities 4 :pace 2 :release 2 :writes 6 :hp 2 :steps 90 :drops 1 :entity-powerups true}}
:descent {:rules [1 4] :locks [3 3] :entities [2 4] :release [3 2] :writes [1 6]}
:writes-from 2
:powerups {:chance 0.08 :lasts 12 :vanquish-range 5 :teleport-range 4
:stun-radius 2 :stun-turns 4}
:score {:floor 1000 :step 10 :hit 50 :vanquish 150 :stun 40 :quick 500 :slow 2}
:clutter 1.0
:furniture {:box 2 :cabinet 1 :copier 1 :disturbance 1 :pole 1}
:traps 2
:shields 1
:portals true
:one-way true
:terrain {:first-floor-bare 0.6 :new-kind-every 3 :one-fewer 0.35 :share 0.28 :burns-per-hit 3}
:specials {:every 3 :kinds [:fast :strong :thrower] :throw-range 2}
:shield-turns 3
:trap-holds 2
:trap-holds-you 1
:warrant-rule {:keep :present :a :warrant}
:house-rules
[{:keep :clear :a :way-out}
{:keep :apart :a :box :b :door}
{:keep :together :a :bear-trap :b :cabinet}
{:keep :apart :a :shield :b :disturbance}]
:amendments
[{:keep :apart :a :box :b :way-out}
{:keep :together :a :cabinet :b :copier}
{:keep :clear :a :warrant}
{:keep :apart :a :shield :b :way-out}
{:keep :together :a :box :b :disturbance}]})
(defonce book (atom nil))
(defn- merge-settings
"The defaults with whatever the reader wrote over them, one level
deep, so a count left out of `:furniture` or a line left out of
`:descent` keeps its default instead of taking the whole map with it."
[defaults given]
(merge-with (fn [default mine]
(if (and (map? default) (map? mine))
(merge default mine)
mine))
defaults
(if (map? given) given {})))
(defn- difficulty-row
"The row the settings chose. A name picks a row from `:difficulties`,
and a map written in place of the name is used as it stands."
[settings]
(let [chosen (:difficulty settings)
rows (:difficulties settings)]
(cond
(map? chosen) chosen
(contains? rows chosen) (get rows chosen)
:else (or (get rows :clerk) (first (vals rows)) {}))))
(defn- difficulty-name
[settings]
(let [chosen (:difficulty settings)]
(if (keyword? chosen) chosen :custom)))
(defn- descend
"A number made worse by the way down. `spec` is [every limit]: every
that many floors it gets one worse, and it never gets worse than the
limit. Worse is more for some things and fewer for others, which is
`direction`. A start already past the limit stays where it started."
[start spec floors-down direction]
(let [[every limit] (if (sequential? spec) spec [spec nil])
steps (if (and (number? every) (pos? every)) (quot floors-down every) 0)]
(case direction
:more (let [worse (+ start steps)]
(if (and limit (> worse limit)) (max start limit) worse))
:fewer (let [worse (- start steps)]
(if (and limit (< worse limit)) (min start limit) (max 1 worse))))))
(defn- special-for
"The special entity a floor gets, if any: one on every floor that
`:every` divides, the kinds taking turns."
[settings floor]
(let [{:keys [every kinds]} (:specials settings)]
(when (and (number? every) (pos? every) (seq kinds) (zero? (mod floor every)))
(nth (vec kinds) (mod (dec (quot floor every)) (count kinds))))))
(defn terms-for
"What one floor runs on: the chosen row, made worse by the way down."
[settings floor]
(let [row (difficulty-row settings)
{:keys [rules locks entities release writes]} (:descent settings)
writes-from (or (:writes-from settings) 2)]
{:rules (descend (or (:rules row) 1) rules (dec floor) :more)
:locks (min 3 (descend (or (:locks row) 0) locks (dec floor) :more))
:entities (descend (or (:entities row) 2) entities (dec floor) :more)
:pace (max 1 (or (:pace row) 2))
:release (when-let [start (:release row)]
(descend start release (dec floor) :fewer))
:writes (when (and (:writes row) (>= floor writes-from))
(descend (:writes row) writes (- floor writes-from) :fewer))
:hp (max 1 (or (:hp row) 3))
:steps (max 1 (or (:steps row) 90))
:drops (max 0 (or (:drops row) 1))
:entity-powerups (boolean (:entity-powerups row))
:shield-turns (or (:shield-turns settings) 3)
:trap-holds (or (:trap-holds settings) 2)
:trap-holds-you (or (:trap-holds-you settings) 1)
:powerups (merge (:powerups default-book) (:powerups settings))
:scoring (merge (:score default-book) (:score settings))
:terrain (merge (:terrain default-book) (:terrain settings))
:specials (merge (:specials default-book) (:specials settings))
:special (special-for settings floor)
:floor floor}))
(defn- proportions
"Rows, columns and density, held to what can hold a building."
[settings]
{:rows (max 5 (min 20 (or (:rows settings) 10)))
:cols (max 5 (min 20 (or (:cols settings) 10)))
:density (max 0.3 (min 1.0 (or (:density settings) 0.78)))})
(defn- seed-for
"The seed for a floor. With none in the settings, one nobody has seen,
from the browser's own die. With one, the same sequence every time,
beginning with the seed itself, so a seed copied from under a floor
and written into the settings gives that building back."
[settings run floor]
(let [fixed-seed (:seed settings)
floor-stride 7919 ; a prime, so the floors of a run never fall into step
run-stride 104729] ; a larger prime, so one run's floors never repeat another's
(if (number? fixed-seed)
(if (and (zero? run) (= 1 floor))
(int fixed-seed)
(bit-and (+ (int fixed-seed) (* floor-stride floor) (* run-stride run)) die-mask))
(inc (rand-int (dec die-mask))))))
;; ---------------------------------------------------------------------
;; Words
;; ---------------------------------------------------------------------
(defn- word
[value]
(if (keyword? value) (name value) (str value)))
(defn- capitalized
[text]
(if (seq text)
(str (str/upper-case (subs text 0 1)) (subs text 1))
text))
(defn- turns-word
[n]
(if (= 1 n) "1 turn" (str n " turns")))
(def label
{:door "door" :doorway "open door" :key "key" :box "box"
:bear-trap "trap" :shield "shield" :disturbance "disturbance"
:cabinet "cabinet" :copier "copier" :pole "pole"
:portal-a "portal" :portal-b "portal"
:portal-in "one-way portal" :portal-out "one-way exit"
:warrant "warrant" :way-out "way out"
:vanquish "vanquish" :teleport "teleport" :stun "stun"
:sand "sand" :ice "ice" :fire "fire"
:sand-boots "sand boots" :ice-boots "ice boots" :fire-boots "fire boots"})
(def entity-kind-names
{:fast "fast" :strong "strong" :thrower "throwing"})
(defn- label-of
[kind]
(get label kind (word kind)))
(def power-kinds
[:vanquish :teleport :stun])
(def power-keys
{:vanquish "1" :teleport "2" :stun "3"})
;; The verb under :keep is always bound to `rule`. Bound to `keep`, it
;; would shadow clojure.core/keep inside the very functions that want it.
(defn sentence
"A Requirement as it is written on the wall."
[{rule :keep a :a b :b}]
(case rule
:apart (str (word a) " shall not adjoin " (word b))
:together (str (word a) " shall adjoin " (word b))
:clear (str "nothing shall adjoin " (word a))
:present (str (word a) " shall be held on this floor")
(str/join " " (map word (remove nil? [a rule b])))))
;; ---------------------------------------------------------------------
;; The record
;; ---------------------------------------------------------------------
(def record-length 7)
(defn- note
"A remark about something that took no time, such as walking into a
wall. It lasts until the next thing happens."
[state line]
(assoc state :note line))
(defn- record
"Something that happened. It goes into this turn's events, which are
drawn once, and into the record, which keeps the last few. `event`
carries `:by`, which is :you, :floor or :entities, a `:kind` the
drawing reads, and the `:line` the record shows."
[state event]
(let [event (assoc event :turn (:turn state))]
(-> state
(update :events (fnil conj []) event)
(update :record (fn [lines]
(vec (take-last record-length
(conj (or lines []) event))))))))
(defn- points
"What the score gives or takes for one of `kind`."
[state kind]
(get-in state [:terms :scoring kind] 0))
(defn- hurt
"One hit off the player, and off the floor's score."
[state]
(-> state
(update :hp dec)
(update :hits (fnil inc 0))))
;; ---------------------------------------------------------------------
;; The plan
;; ---------------------------------------------------------------------
(defn- magnitude
[n]
(max n (- n)))
(defn- steps-between
[[row-a col-a] [row-b col-b]]
(+ (magnitude (- row-a row-b)) (magnitude (- col-a col-b))))
(defn rooms
[state]
(set (keys (:plan state))))
(defn room?
[state room]
(contains? (:plan state) room))
(defn pit?
[state room]
(contains? (:pits state) room))
(defn fixture
[state room]
(let [held (get (:plan state) room)]
(when-not (or (nil? held) (= held :empty)) held)))
(defn terrain
"What the ground is like in a room: :sand, :ice, :fire, or nil for
ordinary floor."
[state room]
(get-in state [:terrain room]))
(defn adjoining
[state [row col]]
(filter (fn [room] (room? state room))
[[(dec row) col] [row (inc col)] [(inc row) col] [row (dec col)]]))
(defn holding
[state kind]
(keep (fn [[room held]] (when (= held kind) room)) (:plan state)))
(defn touching?
[state a b]
(boolean (some (fn [room]
(some (fn [next-door] (= b (fixture state next-door)))
(adjoining state room)))
(holding state a))))
(defn shut?
[state room]
(= :door (fixture state room)))
(defn- open-to-entities?
"Whether an entity can step into a room. A locked door stops it, and so
does a box, which entities cannot push, and which they go round when
there is a way round."
[state room]
(not (or (shut? state room) (= :box (fixture state room)))))
(defn- passable
"The rooms next to `room` an entity can step into."
[state room]
(filter (fn [next-door] (open-to-entities? state next-door)) (adjoining state room)))
(defn- occupants
[state]
(set (map :at (:entities state))))
(defn- drop-rooms
[state]
(set (map :at (:drops state))))
(defn- distances-from
"Every room reachable from `from` and how far, where `neighbours` says
what counts as a way through."
[state from neighbours]
(loop [seen {from 0} frontier [from] distance 0]
(if (empty? frontier)
seen
(let [distance (inc distance)
reached (->> frontier
(mapcat (fn [room] (neighbours state room)))
(remove seen)
distinct
vec)]
(recur (into seen (map (fn [room] [room distance]) reached))
reached
distance)))))
(defn- component
"Every room that can be reached from `from`, doors or no doors."
[state from]
(loop [seen #{from} frontier [from]]
(if (empty? frontier)
seen
(let [reached (->> frontier
(mapcat (fn [room] (adjoining state room)))
(remove seen)
distinct
vec)]
(recur (into seen reached) reached)))))
(defn- pieces
"The separate parts of a building, largest first."
[state]
(loop [left (rooms state) found []]
(if-let [start (first left)]
(let [piece (component state start)]
(recur (reduce disj left piece) (conj found piece)))
(vec (sort-by (comp - count) found)))))
(def directions
{:north [-1 0] :south [1 0] :west [0 -1] :east [0 1]})
(defn- beside
[[row col] direction]
(let [[row-step col-step] (get directions direction)]
[(+ row row-step) (+ col col-step)]))
(defn- direction-of
[from to]
(some (fn [direction] (when (= to (beside from direction)) direction))
(keys directions)))
;; ---------------------------------------------------------------------
;; Portals
;; ---------------------------------------------------------------------
(def portal-pairs
"Where each portal puts whoever steps in it. The room the one-way
pair goes to is an ordinary room to whoever is standing in it."
{:portal-a :portal-b :portal-b :portal-a :portal-in :portal-out})
(def teleporters
(set (keys portal-pairs)))
(defn- portal-map
"Every portal room on the floor, and the room it sends whoever steps
in to."
[state]
(into {} (for [[kind pair] portal-pairs
from (holding state kind)
:let [to (first (holding state pair))]
:when to]
[from to])))
(defn- through
"Where a portal puts whoever steps into it, or nil. A portal is a
door into one room and out of another: nobody walks through the room
it stands in. Entities use portals too, which is what makes one a
risk as well as a shortcut."
[state room]
(get (portal-map state) room))
(defn- reachable-from
"Every room somebody could come to stand in, starting from `from`,
stepping into what `open?` allows and arriving wherever the step puts
them."
([state from sends]
(reachable-from state from sends (fn [_ _] true)))
([state from sends open?]
(loop [seen #{from} frontier [from]]
(if (empty? frontier)
seen
(let [reached (->> frontier
(mapcat (fn [room]
(keep (fn [next-door]
(when (open? state next-door)
(get sends next-door next-door)))
(adjoining state room))))
(remove seen)
distinct
vec)]
(recur (into seen reached) reached))))))
(defn- distances-to
"How many steps each room is from `goal`, for somebody who may step
into the rooms `open?` allows, where a step into a portal is a step to
wherever it sends them. Counted backwards from the goal, which is the
only honest way to count a portal. With `step-in?`, stepping into the
goal reaches it even when the goal is a portal, which is what a reader
clicking on one means."
[state goal open? step-in?]
(let [sends (portal-map state)
senders (reduce (fn [senders room]
(reduce (fn [senders next-door]
(if (open? state next-door)
(update senders
(if (and step-in? (= next-door goal))
goal
(get sends next-door next-door))
(fnil conj [])
room)
senders))
senders
(adjoining state room)))
{}
(sort (rooms state)))]
(loop [seen {goal 0} frontier [goal] distance 0]
(if (empty? frontier)
seen
(let [distance (inc distance)
reached (->> frontier
(mapcat (fn [room] (get senders room)))
(remove seen)
distinct
vec)]
(recur (into seen (map (fn [room] [room distance]) reached))
reached
distance))))))
;; ---------------------------------------------------------------------
;; The audit
;; ---------------------------------------------------------------------
(defn met?
[state {rule :keep a :a b :b}]
(case rule
:apart (not (touching? state a b))
:together (touching? state a b)
:clear (not-any? (fn [room]
(some (fn [next-door] (fixture state next-door))
(adjoining state room)))
(holding state a))
:present (boolean (seq (holding state a)))
true))
(defn unmet
[state]
(filterv (fn [requirement] (not (met? state requirement))) (:reqs state)))
(defn repairable?
"Three of the four verbs can be met by moving something. One cannot,
and what the floor does about that one is the whole endgame."
[{rule :keep}]
(contains? #{:apart :together :clear} rule))
(def ^:private fixed
"The floor will not shift these to satisfy anything. A door that
wandered would not be a door."
#{:door :doorway :way-out :warrant :key
:portal-a :portal-b :portal-in :portal-out
:sand-boots :ice-boots :fire-boots})
(defn- free?
"A room with nothing and nobody in it."
[state room]
(and (room? state room)
(nil? (fixture state room))
(not= room (:at state))
(not (contains? (occupants state) room))
(not (contains? (drop-rooms state) room))))
(defn- free-rooms
[state]
(filter (fn [room] (free? state room)) (sort (rooms state))))
(def lasting
"What stays where it is put: furniture and portals. Keys, shields,
traps, boots and the warrant are used up."
#{:box :cabinet :copier :pole :disturbance :portal-a :portal-b :portal-in :portal-out})
(def portal-kinds
#{:portal-a :portal-b :portal-in :portal-out})
(defn- approach?
"Whether a room is right beside a door or the way out. Nothing that
stays is put in one, so the way to every door and to the way out is
always clear."
[state room]
(boolean (some (fn [next-door] (contains? #{:door :doorway :way-out} (fixture state next-door)))
(adjoining state room))))
(defn- move-fixture
"Move one `kind` to the nearest free room where fewer Requirements are
broken, or nil if there is no such room. Each one of that kind is
tried in turn, because the one in the way is not always the first."
[state kind because]
(when-not (contains? fixed kind)
(let [broken (count (unmet state))
free (vec (cond->> (free-rooms state)
(contains? lasting kind) (remove (fn [room] (approach? state room)))))]
(first
(for [from (holding state kind)
:let [to (->> free
(sort-by (fn [room] (steps-between from room)))
(filter (fn [room]
(< (count (unmet (-> state
(assoc-in [:plan from] :empty)
(assoc-in [:plan room] kind))))
broken)))
first)]
:when to]
(-> state
(assoc-in [:plan from] :empty)
(assoc-in [:plan to] kind)
(record {:by :floor :kind :moved :fixture kind :from from :to to
:line (str "The " (label-of kind) " moved, because "
(sentence because) ".")})))))))
(defn- repair
"One attempt at one broken Requirement, as a floor, or nil."
[state {rule :keep a :a b :b :as requirement}]
(case rule
(:apart :together) (or (move-fixture state b requirement)
(move-fixture state a requirement))
:clear (first (for [room (holding state a)
next-door (adjoining state room)
:let [kind (fixture state next-door)]
:when kind
:let [moved (move-fixture state kind requirement)]
:when moved]
moved))
nil))
(defn audit
"Repairs what can be repaired, one move at a time, and stops when no
move would help. What cannot be repaired is left alone; the tide deals
with that."
[state]
(loop [state state moves 0]
(let [repaired (when (< moves 8)
(some (fn [requirement] (repair state requirement))
(filter repairable? (unmet state))))]
(if repaired
(recur repaired (inc moves))
state))))
;; ---------------------------------------------------------------------
;; The tide
;; ---------------------------------------------------------------------
(defn- strands?
"Whether losing `room` would cut the player off: from the way out,
from a key still lying somewhere, or, by way of a portal, onto an
island with no way back. A portal that opened onto an island would
strand the player as surely as the tide could."
[state room]
(let [without (update state :plan dissoc room)
sends (portal-map without)
from-player (reachable-from without (:at without) sends)
way-out (first (holding without :way-out))]
(boolean
(or (not (contains? from-player way-out))
(not-every? (fn [key-room] (contains? from-player key-room))
(holding without :key))
(some (fn [landing-room]
(and (contains? from-player landing-room)
(not (contains? (reachable-from without landing-room sends) way-out))))
(distinct (vals sends)))))))
(defn next-to-go
"The room the tide takes next: the one furthest from the way out, the
edges first among equals, never the player's, never an entity's,
never one with anything in it, and never one the player needs to get
out. Nil when there is nothing left it may take except the room the
player is standing in."
[state]
(let [out (first (holding state :way-out))
from-out (if out (distances-from state out adjoining) {})]
(->> (free-rooms state)
(sort-by (fn [room] [(- (get from-out room 999))
(count (adjoining state room))]))
(remove (fn [room] (strands? state room)))
first)))
(declare pick-up)
(defn- release-a-room
[state]
(if-let [room (next-to-go state)]
(-> state
(update :plan dissoc room)
(update :terrain dissoc room)
(update :pits conj room)
(record {:by :floor :kind :released :room room
:line "A room was released."}))
(let [here (:at state)
without (-> state (update :plan dissoc here) (update :terrain dissoc here))
out (first (holding without :way-out))
from-out (if out (distances-from without out adjoining) {})
landing (->> (adjoining state here)
(filter (fn [room] (contains? from-out room)))
(sort-by (fn [room] [(get from-out room)
(if (shut? state room) 1 0)]))
first)]
(if landing
(-> without
(update :pits conj here)
(assoc :at landing)
(cond-> (shut? state landing) (assoc-in [:plan landing] :doorway))
hurt
(record {:by :floor :kind :fell :room here
:line (str "Your room was released under you. -" (points state :hit))})
pick-up)
(-> state
(assoc :over :closed)
(record {:by :floor :kind :closed :line "Nowhere left to stand."}))))))
(defn- tide-due?
"Whether a room goes at the end of this turn."
[state]
(let [every (get-in state [:terms :release])
since (- (:turn state) (or (:held-at state) 0))]
(boolean (and (:held state) every (pos? every) (pos? since)
(zero? (mod since every))))))
(defn- tide
[state]
(if (tide-due? state) (release-a-room state) state))
;; ---------------------------------------------------------------------
;; Entities
;; ---------------------------------------------------------------------
(defn- entities-move?
[state]
(zero? (mod (:turn state) (get-in state [:terms :pace] 2))))
(defn- toward
"Where one step toward the player puts an entity, a step into a
portal being a step to wherever it sends it, and keeping out of
rooms another entity already stands in. Where it already is, when
there is no way."
[state distances sends from taken]
(let [here (get distances from)]
(or (when here
(->> (passable state from)
(map (fn [next-door] (get sends next-door next-door)))
(filter (fn [landing-room]
(let [there (get distances landing-room)]
(and there (< there here)))))
(remove taken)
(sort-by distances)
first))
from)))
(defn- entity-powers?
"Whether this floor lets entities take powerups."
[state]
(boolean (get-in state [:terms :entity-powerups])))
(defn- entity-stun-turns
"How long an entity's stun holds the player: half as long as the
player's stun holds an entity, rounded up."
[terms]
(max 1 (quot (inc (get-in terms [:powerups :stun-turns] 4)) 2)))
(defn- toughness
"How many blows an entity takes to end. A strong one takes two."
[entity]
(if (= :strong (:kind entity)) 2 1))
(defn- cool-for-entities?
"Whether an entity steps into a room when it has any choice: anywhere
it can, except fire, unless the player is standing in it."
[state room]
(and (open-to-entities? state room)
(or (= room (:at state)) (not= :fire (terrain state room)))))
(defn- chasing
"The distances an entity walks by this turn. Toward a powerup when
the floor lets entities take them, when it holds none, and when the
powerup is nearer to it than the player is and will still be there
when it arrives; toward the player otherwise."
[state index to-player to-drops]
(let [{:keys [at power]} (get-in state [:entities index])
pace (get-in state [:terms :pace] 2)
player-distance (get to-player at)]
(or (when (and (entity-powers? state) (nil? power))
(->> (:drops state)
(keep (fn [{:keys [left] :as lying}]
(let [distances (get to-drops (:at lying))
steps (get distances at)]
(when (and steps
(or (nil? player-distance) (< steps player-distance))
(<= (* steps pace) left))
[steps distances]))))
(sort-by first)
first
second))
to-player)))
(defn- entity-picks-up
"An entity standing on a powerup, holding none, takes it, when the
floor lets entities take them."
[state index]
(let [{:keys [at power]} (get-in state [:entities index])
lying (first (filter (fn [lying] (= at (:at lying))) (:drops state)))]
(if (and lying (nil? power) (entity-powers? state))
(-> state
(assoc-in [:entities index :power] (:kind lying))
(update :drops (fn [drops] (vec (remove (fn [other] (= at (:at other))) drops))))
(record {:by :entities :kind :gone :room at :fixture (:kind lying)
:line (str "An entity picked up the " (label-of (:kind lying)) ".")}))
state)))
(defn- hit-from-afar
"Something an entity in `source` sends the player's way, arriving: a
vanquish, or a throw. A shield takes it the way it takes any hit."
[state what source]
(if (:shield state)
(-> state
(assoc :shield nil)
(record {:by :entities :kind :sheltered :room (:at state) :source source
:line (str "An entity " what ". The shield took it.")}))
(-> state
hurt
(record {:by :entities :kind :hurt :room (:at state) :source source
:line (str "An entity " what ". -" (points state :hit))}))))
(defn- entity-teleport-room
"Where an entity's teleport would put it: the free room within reach,
on its side of every lock, that leaves it nearest the player. Nil
unless that is nearer than a step would take it."
[state index to-player]
(let [{:keys [at]} (get-in state [:entities index])
reach (get-in state [:terms :powerups :teleport-range] 4)
now (get to-player at)]
(when now
(->> (reachable-from state at (portal-map state) open-to-entities?)
(filter (fn [room] (and (<= 1 (steps-between at room) reach)
(free? state room)
(some? (get to-player room))
(< (get to-player room) (dec now)))))
(sort-by (fn [room] [(get to-player room) room]))
first))))
(defn- entity-uses-power
"What an entity holding a powerup does with it this turn: a vanquish
when the player is within its reach, a stun when the player is
close, a teleport when the player is far. Nil when it would rather
walk."
[state index to-player]
(let [{:keys [at power]} (get-in state [:entities index])
{:keys [vanquish-range stun-radius]} (get-in state [:terms :powerups])
apart (steps-between at (:at state))
spent (fn [state] (assoc-in state [:entities index :power] nil))]
(case power
:vanquish (when (<= apart vanquish-range)
(-> state spent (hit-from-afar "used a vanquish on you" at)))
:stun (when (<= apart stun-radius)
(let [held (entity-stun-turns (:terms state))]
(-> state
spent
(update :stuck max held)
(assoc :held-by :stun)
(record {:by :entities :kind :stunned-you :room (:at state)
:line (str "An entity stunned you for " (turns-word held) ".")}))))
:teleport (when (> (get to-player at 0) 3)
(when-let [room (entity-teleport-room state index to-player)]
(-> state
spent
(assoc-in [:entities index :at] room)
(record {:by :entities :kind :teleported :room room
:line "An entity teleported nearer."}))))
nil)))
(def longest-slide
"No slide on ice goes further than this many rooms, however much ice
there is."
40)
(def slide-stoppers
"What stops anything sliding on ice short of it, like a wall. Whoever
steps onto one on ice is held still."
#{:box :cabinet :copier :pole :disturbance})
(defn- slidable?
"Whether something sliding on ice can carry on into `room`."
[state room]
(and (room? state room)
(not (shut? state room))
(not (contains? slide-stoppers (fixture state room)))))
(defn- burn-entity
"One singe for an entity. Enough of them add up to a blow."
[state index]
(let [per-hit (get-in state [:terms :terrain :burns-per-hit] 3)
burns (inc (get-in state [:entities index :burns] 0))]
(if (>= burns per-hit)
(-> state
(assoc-in [:entities index :burns] 0)
(update-in [:entities index :wounds] (fnil inc 0)))
(assoc-in state [:entities index :burns] burns))))
(defn- entity-lands
"What the room an entity has just come into does to it: a trap holds
it, fire singes it, and a powerup it can take, it takes."
[state index]
(let [at (get-in state [:entities index :at])]
(cond-> state
(= :bear-trap (fixture state at))
(-> (assoc-in [:entities index :stuck] (get-in state [:terms :trap-holds] 2))
(assoc-in [:plan at] :empty)
(record {:by :entities :kind :gone :room at :fixture :bear-trap
:line "A trap caught an entity."}))
(= :fire (terrain state at))
(burn-entity index)
true
(entity-picks-up index))))
(defn- entity-slide
"An entity on ice, carried on the way it was going until the ice
ends, something stops it, or it reaches the player."
[state index direction]
(loop [state state slid 0]
(let [{:keys [at stuck]} (get-in state [:entities index])
next-door (beside at direction)]
(if (and (= :ice (terrain state at))
(not (contains? slide-stoppers (fixture state at)))
(zero? (or stuck 0))
(not= at (:at state))
(< slid longest-slide)
(slidable? state next-door)
(open-to-entities? state next-door)
(not (contains? teleporters (fixture state next-door)))
(not (contains? (disj (occupants state) at) next-door)))
(recur (-> state
(assoc-in [:entities index :at] next-door)
(entity-lands index))
(inc slid))
state))))
(defn- entity-step
"One step for an entity along `route`, then whatever the room does to
it, and on ice, a slide."
[state index route sends]
(let [at (get-in state [:entities index :at])
landing (toward state route sends at (disj (occupants state) at))]
(if (= landing at)
state
(let [moved (-> state
(assoc-in [:entities index :at] landing)
(entity-lands index))
direction (direction-of at landing)]
(if (and direction (zero? (get-in moved [:entities index :stuck] 0)))
(entity-slide moved index direction)
moved)))))
(defn- entity-acts
"One entity's turn. A thrower throws when the player is near enough
and it did not throw last time. One holding a powerup uses it when
it would reach the player. Otherwise it steps, and a fast one steps
twice, toward a powerup it would rather have, or toward the player,
going round fire when it can."
[state index to-player to-player-cool to-drops sends]
(let [{:keys [at stuck power kind threw]} (get-in state [:entities index])
reach (get-in state [:terms :specials :throw-range] 2)]
(cond
(pos? (or stuck 0))
(update-in state [:entities index :stuck] dec)
(and (= :thrower kind) (not threw) (<= (steps-between at (:at state)) reach))
(-> state
(assoc-in [:entities index :threw] true)
(hit-from-afar "threw something at you" at))
:else
(let [state (assoc-in state [:entities index :threw] false)]
(or (when power (entity-uses-power state index to-player))
(let [route (chasing state index (if (get to-player-cool at) to-player-cool to-player) to-drops)
once (entity-step state index route sends)
now (get-in once [:entities index])]
(if (and (= :fast kind)
(not= (:at now) at)
(not= (:at now) (:at once))
(zero? (:stuck now 0)))
(entity-step once index route sends)
once)))))))
(defn- bury-the-burned
"Entities the fire has ended, gone."
[state]
(let [{gone true kept false} (group-by (fn [entity] (>= (:wounds entity 0) (toughness entity)))
(:entities state))]
(reduce (fn [state {:keys [at]}]
(record state {:by :floor :kind :ended :room at :line "The fire ended an entity."}))
(assoc state :entities (vec kept))
gone)))
(defn- move-entities
"Every entity free to act takes its turn, on the turns entities move
at all."
[state]
(if-not (entities-move? state)
state
(let [to-player (distances-to state (:at state) open-to-entities? false)
to-player-cool (into {} (remove (fn [[room _]] (and (not= room (:at state)) (= :fire (terrain state room))))
(distances-to state (:at state) cool-for-entities? false)))
to-drops (when (and (entity-powers? state) (seq (:drops state)))
(into {} (for [{:keys [at]} (:drops state)]
[at (distances-to state at open-to-entities? false)])))
sends (portal-map state)]
(bury-the-burned
(reduce (fn [state index] (entity-acts state index to-player to-player-cool to-drops sends))
state
(range (count (:entities state))))))))
(defn- shield-hot?
[state]
(boolean (and (:shield state)
(< (- (:turn state) (:shield state))
(get-in state [:terms :shield-turns] 3)))))
(defn- put-back
"Whatever reached the player is put back a room, where there is
anywhere to put it, and spends a turn getting over it."
[state]
(let [here (:at state)]
(reduce (fn [state index]
(if (not= here (get-in state [:entities index :at]))
state
(let [away (first (remove (occupants state) (passable state here)))]
(-> state
(assoc-in [:entities index :at] (or away here))
(assoc-in [:entities index :stuck] 1)))))
state
(range (count (:entities state))))))
(defn- blow
"One blow to every entity standing in `room`. Those it ends are gone;
a strong one it only wounds stays, wounded. Returns the floor, how
many were ended, and how many only wounded."
[state room]
(let [{struck true spared false} (group-by (fn [entity] (= room (:at entity))) (:entities state))
struck (map (fn [entity] (update entity :wounds (fnil inc 0))) struck)
{ended true wounded false} (group-by (fn [entity] (>= (:wounds entity) (toughness entity))) struck)]
[(assoc state :entities (vec (concat spared wounded))) (count ended) (count wounded)]))
(defn- contact
"Whatever entity is in the player's room when the turn ends. A hot
shield deals it a blow, a cool one takes the hit for the player, and
otherwise the player takes it. Anything left standing is put back a
room."
[state]
(let [here (:at state)
present (count (filter (fn [entity] (= here (:at entity))) (:entities state)))]
(cond
(zero? present) state
(shield-hot? state)
(let [[struck ended wounded] (blow state here)]
(cond-> (-> struck (assoc :shield nil) (update :kills (fnil + 0) ended))
(pos? ended)
(record {:by :entities :kind :ended :room here
:line (str "The shield ended "
(if (= 1 ended) "an entity" (str ended " entities"))
". +" (* ended (points state :vanquish)))})
(pos? wounded)
(-> put-back
(record {:by :entities :kind :wounded :room here
:line "The shield wounded the strong entity. One more blow ends it."}))))
(:shield state)
(-> state
(assoc :shield nil)
put-back
(record {:by :entities :kind :sheltered :room here
:line "The shield took the hit and is gone."}))
:else
(-> state
hurt
put-back
(record {:by :entities :kind :hurt :room here
:line (str "An entity reached you. -" (points state :hit))})))))
;; ---------------------------------------------------------------------
;; Powerups
;; ---------------------------------------------------------------------
(defn- pick-up
"Whatever powerup is lying where the player stands, into the player's
hands."
[state]
(let [here (:at state)
found (filter (fn [lying] (= here (:at lying))) (:drops state))]
(reduce (fn [state {:keys [kind]}]
(-> state
(update-in [:powers kind] (fnil inc 0))
(record {:by :you :kind :gone :room here :fixture kind
:line (str "Picked up " (label-of kind) ". Press "
(get power-keys kind) " to use it.")})))
(update state :drops (fn [drops]
(vec (remove (fn [lying] (= here (:at lying))) drops))))
found)))
(defn- age-drops
"Every powerup on the floor is a turn nearer to fading."
[state]
(let [aged (mapv (fn [lying] (update lying :left dec)) (:drops state))
faded (filter (fn [lying] (<= (:left lying) 0)) aged)]
(reduce (fn [state {:keys [kind at]}]
(record state {:by :floor :kind :gone :room at :fixture kind
:line (str "The " (label-of kind) " powerup faded.")}))
(assoc state :drops (vec (remove (fn [lying] (<= (:left lying) 0)) aged)))
faded)))
(defn- drop-powerup
"Perhaps a powerup, in an empty room a little way from the player, of
a kind that has not already turned up as often as the floor allows."
[state]
(let [{:keys [chance lasts]} (get-in state [:terms :powerups])
[happens? state] (draw-chance state (or chance 0))
most (get-in state [:terms :drops] 1)
kinds (filterv (fn [kind] (< (get-in state [:dropped kind] 0) most)) power-kinds)
here (:at state)
places (filterv (fn [room] (and (> (steps-between here room) 2) (nil? (terrain state room))))
(free-rooms state))]
(if (or (not happens?) (:over state) (empty? kinds) (empty? places))
state
(let [[kind state] (draw state kinds)
[room state] (draw state places)]
(-> state
(update :drops conj {:kind kind :at room :left (or lasts 12)})
(update-in [:dropped kind] (fnil inc 0))
(record {:by :floor :kind :dropped :room room
:line (str "A " (label-of kind) " powerup appeared.")}))))))
(defn vanquish-targets
"Rooms holding an entity close enough to vanquish."
[state]
(let [reach (get-in state [:terms :powerups :vanquish-range] 5)
here (:at state)]
(vec (sort (filter (fn [room] (<= (steps-between here room) reach))
(occupants state))))))
(defn- region
"Every room the player could walk to without unlocking anything."
[state]
(reachable-from state (:at state) (portal-map state)
(fn [state room] (not (shut? state room)))))
(defn teleport-targets
"Rooms the player could teleport to: close enough, on the player's
side of every lock, and neither a portal, a locked door, nor an
entity."
[state]
(let [reach (get-in state [:terms :powerups :teleport-range] 4)
here (:at state)
taken (occupants state)]
(vec (sort (filter (fn [room]
(and (<= 1 (steps-between here room) reach)
(not (shut? state room))
(not (contains? teleporters (fixture state room)))
(not (contains? taken room))))
(region state))))))
(declare arrive finished? tread)
(defn- use-power
"A powerup, used. It takes no turn: nothing else moves."
[state kind target]
(if-not (pos? (get-in state [:powers kind] 0))
(note state "You have none of those.")
(case kind
:vanquish
(let [targets (vanquish-targets state)
here (:at state)
chosen (if (some (fn [room] (= room target)) targets)
target
(first (sort-by (fn [room] (steps-between here room)) targets)))]
(if-not chosen
(note state "Nothing close enough to vanquish.")
(let [[struck ended _] (blow (update-in state [:powers :vanquish] dec) chosen)]
(if (pos? ended)
(-> struck
(update :kills (fnil + 0) ended)
(record {:by :you :kind :ended :room chosen
:line (str "Vanquished an entity. +" (* ended (points state :vanquish)))}))
(record struck {:by :you :kind :wounded :room chosen
:line "Wounded the strong entity. One more blow ends it."})))))
:teleport
(if-not (some (fn [room] (= room target)) (teleport-targets state))
(note state "Pick a highlighted room to teleport to.")
(-> state
(update-in [:powers :teleport] dec)
(assoc :at target :stuck 0)
(record {:by :you :kind :teleported :room target :line "Teleported."})
arrive
(tread nil)
(dissoc :slowed)
contact
finished?))
:stun
(let [{:keys [stun-radius stun-turns]} (get-in state [:terms :powerups])
here (:at state)
caught (filterv (fn [index]
(<= (steps-between here (get-in state [:entities index :at]))
stun-radius))
(range (count (:entities state))))]
(if (empty? caught)
(note state "Nothing close enough to stun.")
(-> (reduce (fn [state index]
(update-in state [:entities index :stuck] (fn [stuck] (max stuck stun-turns))))
state
caught)
(update-in [:powers :stun] dec)
(update :stunned (fnil + 0) (count caught))
(record {:by :you :kind :stunned :room here
:rooms (mapv (fn [index] (get-in state [:entities index :at])) caught)
:line (str "Stunned "
(if (= 1 (count caught)) "an entity" (str (count caught) " entities"))
". +" (* (count caught) (points state :stun)))}))))
state)))
;; ---------------------------------------------------------------------
;; Rooms that do something
;; ---------------------------------------------------------------------
(defn- arrive-at-fixture
[state]
(let [here (:at state)
kind (fixture state here)]
(case kind
(:cabinet :copier)
(-> state
hurt
(record {:by :you :kind :hurt :room here
:line (str "Walked into the " (label-of kind) ". -" (points state :hit))}))
:disturbance
(if (:shield state)
(-> state
(assoc :shield nil)
(record {:by :you :kind :sheltered :room here
:line "The shield took the disturbance and is gone."}))
(-> state
hurt
(record {:by :you :kind :hurt :room here
:line (str "Walked into the disturbance. -" (points state :hit))})))
:bear-trap
(-> state
(assoc-in [:plan here] :empty)
(assoc :stuck (get-in state [:terms :trap-holds-you] 1) :held-by :trap)
(record {:by :you :kind :gone :room here :fixture :bear-trap
:line "Caught in a trap."}))
:shield
(-> state
(assoc-in [:plan here] :empty)
(assoc :shield (:turn state))
(record {:by :you :kind :gone :room here :fixture :shield
:line "Picked up the shield."}))
:key
(-> state
(assoc-in [:plan here] :empty)
(update :keys (fnil inc 0))
(record {:by :you :kind :gone :room here :fixture :key
:line "Picked up a key."}))
(:sand-boots :ice-boots :fire-boots)
(-> state
(assoc-in [:plan here] :empty)
(update :boots (fnil conj #{}) kind)
(record {:by :you :kind :gone :room here :fixture kind
:line (str "Put on the " (label-of kind) ".")}))
(:portal-a :portal-b :portal-in)
(if-let [there (through state here)]
(-> state
(assoc :at there)
(record {:by :you :kind :through :room there :line "Through the portal."}))
state)
state)))
(defn- arrive
"What a room does to the player on arriving in it."
[state]
(pick-up (arrive-at-fixture state)))
;; ---------------------------------------------------------------------
;; Walking, pushing, taking
;; ---------------------------------------------------------------------
(def pushable
"What the player can put in something's way. Not the door, not the
way out, not the thing the player came for."
#{:box :cabinet :copier :bear-trap :disturbance})
(defn- step-into
[state room]
(cond
(pit? state room)
(note state "That room is gone.")
(not (room? state room))
(note state "No room that way.")
(shut? state room)
(if (pos? (:keys state 0))
(-> state
(assoc-in [:plan room] :doorway)
(update :keys dec)
(record {:by :you :kind :opened :room room
:line "Unlocked the door. Entities can come through it now."}))
(note state "Locked. There is a key somewhere on this side."))
:else (assoc state :at room)))
(defn- box-can-enter?
"Whether something pushed can go into `room`."
[state room]
(and (room? state room)
(nil? (fixture state room))
(not= room (:at state))
(not (contains? (occupants state) room))
(not (contains? (drop-rooms state) room))))
(defn- box-slide
"Where something pushed onto ice comes to rest: carried on the way it
was pushed until the ice ends or the next room cannot take it."
[state from direction]
(loop [here from slid 0]
(let [onward (beside here direction)]
(if (and (= :ice (terrain state here)) (< slid longest-slide) (box-can-enter? state onward))
(recur onward (inc slid))
here))))
(def opposite
{:north :south :south :north :east :west :west :east})
(defn- pull
"Shift and an arrow away from something right behind the player: the
player steps forward, and it follows into the room the player left.
Never on ice, where things can only be pushed."
[state direction]
(let [here (:at state)
ahead (beside here direction)
behind (beside here (opposite direction))
kind (fixture state behind)]
(cond
(not (contains? pushable kind))
(note state "Nothing to push or pull that way.")
(some (fn [room] (= :ice (terrain state room))) [behind here ahead])
(note state "On ice, things can only be pushed.")
(or (fixture state here)
(not (room? state ahead))
(fixture state ahead)
(contains? (occupants state) ahead))
(note state "No room to pull it that way.")
:else
(-> state
(assoc-in [:plan behind] :empty)
(assoc-in [:plan here] kind)
(assoc :at ahead)
(record {:by :you :kind :pushed :fixture kind :from behind :to here
:line (str "You pulled the " (label-of kind) ".")})))))
(defn- push
"Shift and an arrow: whatever is next door that way goes one room
further, and the player steps in behind it; pushed onto ice, it
slides until the ice ends or something stops it. With nothing there
to push, what is right behind the player is pulled instead."
[state direction]
(let [next-door (beside (:at state) direction)
beyond (beside next-door direction)
kind (fixture state next-door)]
(cond
(not (contains? pushable kind))
(pull state direction)
(not (box-can-enter? state beyond))
(note state "It will not go any further that way.")
:else
(let [resting (box-slide state beyond direction)]
(-> state
(assoc-in [:plan next-door] :empty)
(assoc-in [:plan resting] kind)
(assoc :at next-door)
(record {:by :you :kind :pushed :fixture kind :from next-door :to resting
:line (if (= resting beyond)
(str "You pushed the " (label-of kind) ".")
(str "You pushed the " (label-of kind) ", and it slid across the ice."))}))))))
(defn- take-warrant
[state]
(let [here (:at state)
every (get-in state [:terms :release])]
(if (= :warrant (fixture state here))
(-> state
(assoc-in [:plan here] :empty)
(assoc :held :warrant :held-at (:turn state))
(record {:by :you :kind :gone :room here :fixture :warrant
:line (if every
(str "You have the warrant. A room goes every " every " turns now.")
"You have the warrant. Now get out.")}))
(note state "Nothing to take here."))))
;; ---------------------------------------------------------------------
;; The ground
;; ---------------------------------------------------------------------
(def terrain-kinds
[:sand :ice :fire])
(def boots-for
{:sand :sand-boots :ice :ice-boots :fire :fire-boots})
(def harshness
"How hard each kind of ground is on the player without its boots."
{:sand 0 :ice 1 :fire 2})
(defn- shod?
"Whether the player has the boots for a kind of ground."
[state ground]
(contains? (:boots state) (boots-for ground)))
(defn- slide
"The player on ice, carried on the way the step was going until the
ice ends, something stops the slide, or it comes into a room with an
entity in it. Every room on the way does to the player what it does."
[state direction]
(loop [state state slid 0]
(let [here (:at state)
next-door (beside here direction)]
(if (and (= :ice (terrain state here))
(not (contains? slide-stoppers (fixture state here)))
(not (shod? state :ice))
(zero? (:stuck state 0))
(not (contains? (occupants state) here))
(< slid longest-slide)
(slidable? state next-door))
(let [moved (-> state (assoc :at next-door) arrive)]
(if (= next-door (:at moved))
(recur moved (inc slid))
moved))
(cond-> state
(pos? slid)
(record {:by :you :kind :slid :room here :line "You slid across the ice."}))))))
(defn- burn
"One singe from the fire. Enough of them add up to a hit, which a
shield takes the way it takes any hit."
[state]
(let [per-hit (get-in state [:terms :terrain :burns-per-hit] 3)
burns (inc (:burns state 0))]
(cond
(< burns per-hit)
(-> state
(assoc :burns burns)
(record {:by :floor :kind :singed :room (:at state)
:line (str "The fire singed you, " burns " of " per-hit " toward a hit.")}))
(:shield state)
(-> state
(assoc :burns 0 :shield nil)
(record {:by :floor :kind :sheltered :room (:at state)
:line "The fire burned through to the shield, and the shield is gone."}))
:else
(-> state
(assoc :burns 0)
hurt
(record {:by :floor :kind :hurt :room (:at state)
:line (str "The fire burned you. -" (points state :hit))})))))
(defn- tread
"What the ground does to the player standing on it. Ice carries the
player on the way the step was going, fire singes, and sand makes
the step take two turns, unless the player has the boots for it.
With no direction, as after a teleport, ice has nowhere to carry
anyone."
[state direction]
(let [state (if direction (slide state direction) state)
ground (terrain state (:at state))]
(cond
(or (nil? ground) (shod? state ground)) state
(= :fire ground) (burn state)
(= :sand ground) (assoc state :slowed true)
:else state)))
;; ---------------------------------------------------------------------
;; Whether a floor can be finished on foot
;; ---------------------------------------------------------------------
(defn- comes-to-rest
"Where a step from `room` toward `direction` leaves the player on
foot, wearing `boots`: in the room next door, out of the other end
when it is a two-way portal, and on across any ice without ice boots
until the ice ends or something stops the slide. Nil for a step into
a wall, a locked door, a one-way portal, or fire without fire boots."
[state room direction boots sends]
(let [unshod? (fn [ground] (not (contains? boots (boots-for ground))))
barred? (fn [room] (or (= :portal-in (fixture state room))
(and (= :fire (terrain state room)) (unshod? :fire))))
next-door (beside room direction)]
(when (and (room? state next-door) (not (shut? state next-door)) (not (barred? next-door)))
(loop [here (get sends next-door next-door) slid 0]
(let [onward (beside here direction)]
(cond
(or (not (and (= :ice (terrain state here)) (unshod? :ice)))
(contains? slide-stoppers (fixture state here))) here
(or (>= slid longest-slide) (not (slidable? state onward))) here
(barred? onward) nil
(contains? sends onward) (get sends onward)
:else (recur onward (inc slid))))))))
(defn- on-foot
"Every room the player can come to rest in from where the player
stands, walking and sliding, wearing `boots`."
[state boots]
(let [sends (portal-map state)
start (:at state)]
(loop [seen #{start} frontier [start]]
(if (empty? frontier)
seen
(let [reached (distinct (for [room frontier
direction [:north :east :south :west]
:let [stop (comes-to-rest state room direction boots sends)]
:when (and stop (not (seen stop)))]
stop))]
(recur (into seen reached) (vec reached)))))))
(defn- reach-in-the-end
"Every room the player could come to rest in, in the end, on foot:
walking and sliding from where the player stands, picking up every
key and pair of boots within reach and opening every locked door
within reach until nothing more opens, never stepping into fire
without fire boots or into a one-way portal."
[state]
(loop [state state boots #{} held-keys 0]
(let [reach (on-foot state boots)
found-keys (filter reach (holding state :key))
state (reduce (fn [state room] (assoc-in state [:plan room] :empty)) state found-keys)
held-keys (+ held-keys (count found-keys))
new-boots (remove boots (filter (fn [kind] (some reach (holding state kind))) (vals boots-for)))
door (first (filter (fn [door] (some reach (adjoining state door)))
(sort (holding state :door))))]
(cond
(seq new-boots) (recur state (into boots new-boots) held-keys)
(and door (pos? held-keys)) (recur (assoc-in state [:plan door] :doorway) boots (dec held-keys))
:else reach))))
(defn- finishable?
"Whether the floor as laid can be finished on foot: the warrant and the
way out both within reach in the end."
[state]
(let [reach (reach-in-the-end state)]
(boolean (and (some reach (holding state :way-out))
(some reach (holding state :warrant))))))
;; ---------------------------------------------------------------------
;; Zell
;; ---------------------------------------------------------------------
(defn- zell-due?
[state]
(let [every (get-in state [:terms :writes])]
(boolean (and every (pos? every) (pos? (:turn state))
(zero? (mod (:turn state) every))))))
(defn- amend
[state]
(let [unwritten (vec (remove (set (:reqs state)) (:amendments state)))]
(if (empty? unwritten)
state
(let [[chosen state] (draw state unwritten)]
(-> state
(update :reqs conj chosen)
(assoc :new-rule chosen)
(record {:by :floor :kind :wrote :rule chosen
:line (str "New requirement: " (sentence chosen) ".")}))))))
(defn- zell
[state]
(if (zell-due? state) (amend state) state))
;; ---------------------------------------------------------------------
;; Laying a floor out
;; ---------------------------------------------------------------------
(defn- carve
"Rooms at the given density, then only the largest piece of them."
[rows cols density]
(let [kept (into {} (for [row (range rows)
col (range cols)
:when (< (chance!) density)]
[[row col] :empty]))
largest (first (pieces {:plan kept}))]
(into {} (map (fn [room] [room :empty])) largest)))
(defn- might-divide?
"Whether taking `room` away could split the building at all. When its
neighbours can still reach one another through the eight rooms around
it, it cannot, and there is no need to search the whole floor to find
that out."
[plan [row col :as room]]
(let [ring (into {} (for [row-step [-1 0 1]
col-step [-1 0 1]
:let [cell [(+ row row-step) (+ col col-step)]]
:when (and (not= cell room) (contains? plan cell))]
[cell :empty]))
neighbours (filter (fn [cell] (contains? ring cell))
[[(dec row) col] [row (inc col)] [(inc row) col] [row (dec col)]])]
(and (> (count neighbours) 1)
(let [reached (component {:plan ring} (first neighbours))]
(not-every? reached neighbours)))))
(defn- natural-doors
"Rooms that already cut the building in two, with at least `least` on
each side. The ones that might are found by looking at their
surroundings, and only those are searched for, one whole floor each."
[plan least]
(let [state {:plan plan}]
(vec (for [room (sort (keys plan))
:when (might-divide? plan room)
:let [[near far] (pieces (update state :plan dissoc room))]
:when (and far (>= (count near) least) (>= (count far) least))]
{:door room :near near :far far}))))
(defn- natural-lock
"One lock in a room that already divides the building fairly, or nil."
[plan least]
(when-let [{:keys [door near far]} (pick! (natural-doors plan least))]
{:plan plan
:doors [door]
:zones (if (< (chance!) 0.5) [near far] [far near])}))
(defn- wall-line
"One wall's position in each row it crosses: starting at `around` and
wandering a room either way as it goes, never outside `low` and
`high`."
[length around low high]
(loop [line [(max low (min high around))]]
(if (>= (count line) length)
line
(recur (conj line (max low (min high (+ (peek line) (dec (roll! 3))))))))))
(defn- chain
"The zones in the order the player passes through them, and the doors
between, given the zones and which two each door joins. Nil unless
they make a single line with a zone at each end."
[zones joins]
(let [touching (fn [zone] (count (filter (fn [[_ a b]] (or (= a zone) (= b zone))) joins)))
ends (filter (fn [zone] (= 1 (touching zone))) zones)]
(when (= 2 (count ends))
(loop [order [(if (< (chance!) 0.5) (first ends) (second ends))]
doors []
left joins]
(if (empty? left)
(when (= (count order) (count zones)) {:zones order :doors doors})
(let [here (peek order)
[door a b :as join] (first (filter (fn [[_ a b]] (or (= a here) (= b here))) left))]
(when join
(recur (conj order (if (= a here) b a))
(conj doors door)
(remove (fn [other] (= other join)) left)))))))))
(defn- walled
"The building with `locks` walls across it, each wandering in its own
band with one room left standing in it for its door, or nil when this
carving will not take them. Every zone between the walls has to hold
at least `least` rooms."
[plan rows cols locks least]
(let [upright? (< (chance!) 0.5)
length (if upright? rows cols)
span (if upright? cols rows)
cell (fn [index across] (if upright? [index across] [across index]))
either-side (fn [[row col]]
(if upright?
[[row (dec col)] [row (inc col)]]
[[(dec row) col] [(inc row) col]]))
centres (mapv (fn [k]
(+ (quot (* span k) (inc locks))
(if (= 1 locks) (dec (roll! 3)) 0)))
(range 1 (inc locks)))
walls (mapv (fn [around]
(let [line (wall-line length around (max 1 (dec around)) (min (- span 2) (inc around)))]
(set (map-indexed cell line))))
centres)
every-wall (reduce into #{} walls)
doors (mapv (fn [wall]
(pick! (filter (fn [spot]
(every? (fn [side]
(and (contains? plan side)
(not (contains? every-wall side))))
(either-side spot)))
(sort wall))))
walls)]
(when (every? some? doors)
(let [rebuilt (reduce (fn [plan door] (assoc plan door :empty))
(apply dissoc plan every-wall)
doors)
standing (select-keys rebuilt (component {:plan rebuilt} (first doors)))
zones (pieces {:plan (apply dissoc standing doors)})
zone-of (fn [room] (first (filter (fn [zone] (contains? zone room)) zones)))
joins (mapv (fn [door] (into [door] (map zone-of (either-side door)))) doors)]
(when (and (every? (fn [door] (contains? standing door)) doors)
(= (count zones) (inc locks))
(every? (fn [zone] (>= (count zone) least)) zones)
(every? (fn [[_ a b]] (and a b (not= a b))) joins))
(when-let [{:keys [zones doors]} (chain zones joins)]
{:plan standing :doors doors :zones zones}))))))
(defn- divided
"A building with this many locks, or nil when this carving will not
take them. One lock may be a room that already divides the building
fairly; more than one are always walls."
[plan rows cols locks]
(let [least (max 6 (quot (count plan) (if (= 1 locks) 4 (* 3 (inc locks)))))]
(cond
(zero? locks) (when (seq plan) {:plan plan :doors [] :zones [(set (keys plan))]})
(and (= 1 locks) (< (chance!) 0.5)) (or (natural-lock plan least)
(walled plan rows cols locks least))
:else (walled plan rows cols locks least))))
(defn- building
"Rooms, their locks, and the zones between them. Carved at the density
asked for up to a dozen times, then built solid, and if even a solid
building will not take that many locks, one fewer. Always returns one."
[rows cols density locks]
(loop [locks locks]
(or (loop [tries 0]
(when (< tries 14)
(or (divided (carve rows cols (if (< tries 12) density 1.0)) rows cols locks)
(recur (inc tries)))))
(recur (max 0 (dec locks))))))
(defn- put
[state room kind]
(if room (assoc-in state [:plan room] kind) state))
(defn- further-half
"The rooms of `candidates` at least as far as the middle one, by
`distances`, so that a choice among them is never right next door."
[distances candidates]
(let [ranked (sort-by (fn [room] (get distances room 0)) (sort candidates))]
(drop (quot (count ranked) 2) ranked)))
(defn- somewhere
"A free room in one of `zones`, the zone chosen by the die, where
`fitting?` holds, falling back to any of those zones, then to anywhere
on the floor."
[state zones fitting?]
(let [free-in (fn [zone] (filter (fn [room] (and (free? state room) (fitting? room))) (sort zone)))]
(or (pick! (free-in (pick! zones)))
(pick! (mapcat free-in zones))
(pick! (free-rooms state)))))
(defn- scatter
"`how-many` of `kind`, each somewhere in `zones` where `fitting?` holds."
[state zones fitting? how-many kind]
(reduce (fn [state _] (put state (somewhere state zones fitting?) kind))
state
(range (or how-many 0))))
(defn- place-entities
"Entities go anywhere at least four rooms from where the player
starts and not next to one another, so some are loose from the first
turn and some are waiting behind a door."
[state zones from-start how-many kind]
(let [every-room (sort (apply concat zones))]
(loop [state state left how-many]
(if (zero? left)
state
(let [taken (occupants state)
apart? (fn [room] (not-any? taken (adjoining state room)))
room (or (pick! (filter (fn [room]
(and (free? state room)
(>= (get from-start room 0) 4)
(apart? room)))
every-room))
(pick! (filter (fn [room]
(and (free? state room)
(>= (get from-start room 0) 2)))
every-room)))]
(if room
(recur (update state :entities conj (cond-> {:at room :was room :stuck 0} kind (assoc :kind kind)))
(dec left))
state))))))
(defn- sound?
"Whether everything that has to be reached can be, from where the
player starts, and whether the way out can still be reached from
wherever a portal might put the player. A portal in a corridor is a
wall with a door in it somewhere else, and some corridors cannot
take one."
[state]
(let [sends (portal-map state)
from-start (reachable-from state (:at state) sends)
way-out (first (holding state :way-out))]
(and (every? (fn [kind] (every? from-start (holding state kind)))
[:key :warrant :door :way-out])
(every? (fn [landing-room]
(or (not (contains? from-start landing-room))
(contains? (reachable-from state landing-room sends) way-out)))
(distinct (vals sends))))))
(declare winnable?)
(defn- place-pair
"A portal and where it goes, at least four rooms apart. Where the
floor has locks, the die decides whether it crosses one, and a one-
way portal that crosses a lock can leave the player where nothing
opens the way back. Left out when it would cut the floor off from
itself, or when the floor could not be finished without taking a
one-way portal: its room is a wall to anyone walking, so it must
never stand where the only way on goes through it. Taking it is
always the player's own gamble."
[state zones from-start entry-kind exit-kind]
(let [free-in (fn [zone]
(filter (fn [room] (and (free? state room)
(not (approach? state room))
(>= (get from-start room 0) 2)))
(sort zone)))
entry-zone (pick! (filter (fn [zone] (seq (free-in zone))) zones))
entry (pick! (free-in entry-zone))
from-entry (if entry (distances-from state entry adjoining) {})
lock-crossing-chance 0.6 ; how often a portal on a floor with locks crosses one
crossing? (and (> (count zones) 1) (< (chance!) lock-crossing-chance))
exit-zones (if crossing? (remove (fn [zone] (= zone entry-zone)) zones) [entry-zone])
exit (pick! (filter (fn [room] (and (not= room entry) (>= (get from-entry room 0) 4)))
(mapcat free-in exit-zones)))
placed (-> state (put entry entry-kind) (put exit exit-kind))
on-foot (if (= :portal-in entry-kind) (update placed :plan dissoc entry) placed)]
(if (and entry exit (sound? placed) (winnable? on-foot)) placed state)))
(defn- place-by-zone
"Everything that decides the floor. The doors are where the building
was divided. The player starts in the first zone, some way from its
door, and the way out is in the last, some way from its. Each key is
in a zone before the door it opens. The rest goes where the die puts
it."
[state {:keys [doors zones]} terms settings]
(let [first-zone (first zones)
last-zone (last zones)
every-room (sort (apply concat zones))
start (pick! (if (seq doors)
(further-half (distances-from state (first doors) adjoining) first-zone)
every-room))
from-start (distances-from state start adjoining)
out (pick! (further-half (if (seq doors)
(distances-from state (peek doors) adjoining)
from-start)
(remove #{start} last-zone)))
placed (-> (reduce (fn [state door] (put state door :door)) state doors)
(assoc :at start :was-at start)
(put out :way-out))
with-keys (reduce (fn [state index]
(put state
(somewhere state (subvec zones 0 (inc index))
(fn [room] (>= (get from-start room 0) 2)))
:key))
placed
(range (count doors)))
from-out (distances-from with-keys out adjoining)
with-warrant (put with-keys
(somewhere with-keys zones
(fn [room] (and (>= (get from-start room 0) 3)
(>= (get from-out room 0) 3))))
:warrant)]
(-> with-warrant
(place-entities zones from-start (:entities terms) nil)
(cond-> (:special terms) (place-entities zones from-start 1 (:special terms)))
(scatter zones (fn [room] (>= (get from-start room 0) 2)) (:shields settings) :shield)
(scatter zones (fn [room] (>= (get from-start room 0) 3)) (:traps settings) :bear-trap)
(cond-> (:portals settings) (place-pair zones from-start :portal-a :portal-b))
(cond-> (:one-way settings) (place-pair zones from-start :portal-in :portal-out)))))
(defn- furnish
"The furniture, anywhere there is room for it except right beside a
door or the way out. The counts are for a building ten rooms by ten
and are scaled to this one."
[state settings]
(let [scale (* (or (:clutter settings) 1)
(/ (* (:rows state) (:cols state)) 100))
every-piece (mapcat (fn [[kind how-many]]
(repeat (Math/round (* how-many scale)) kind))
(sort-by (fn [[kind _]] (name kind)) (:furniture settings)))]
(reduce (fn [state kind]
(if-let [room (pick! (remove (fn [room] (approach? state room)) (free-rooms state)))]
(put state room kind)
state))
state
every-piece)))
(defn- patch-rooms
"The patches of one kind of ground, each a set of rooms that touch."
[state ground]
(let [of-ground (set (keep (fn [[room kind]] (when (and (= kind ground) (room? state room)) room))
(:terrain state)))]
(loop [left of-ground found []]
(if-let [start (first (sort left))]
(let [patch (loop [seen #{start} frontier [start]]
(if (empty? frontier)
seen
(let [reached (->> frontier
(mapcat (fn [room] (adjoining state room)))
(filter of-ground)
(remove seen)
distinct
vec)]
(recur (into seen reached) reached))))]
(recur (reduce disj left patch) (conj found patch)))
found))))
(defn- ground-kinds
"Which kinds of ground a floor gets, gentlest first: none or one on
floor one, none being likelier, and one more kind possible every
`:new-kind-every` floors after that, the die now and then taking one
away."
[ground-settings floor]
(let [{:keys [first-floor-bare new-kind-every one-fewer]} ground-settings
most (min (count terrain-kinds) (inc (quot (dec floor) (max 1 (or new-kind-every 3)))))
how-many (cond
(<= floor 1) (if (< (chance!) (or first-floor-bare 0)) 0 1)
(< (chance!) (or one-fewer 0)) (dec most)
:else most)
shuffled (->> terrain-kinds
(map (fn [kind] [(chance!) kind]))
(sort-by first)
(map second))]
(vec (sort-by harshness (take how-many shuffled)))))
(defn- corners-away
"The corners of the building, farthest from where the player starts
first."
[state]
(let [start (:at state)
last-row (dec (:rows state))
last-col (dec (:cols state))]
(sort-by (fn [corner] (- (steps-between start corner)))
[[0 0] [0 last-col] [last-row 0] [last-row last-col]])))
(def smallest-mass
"The fewest rooms a mass of ground may have. A kind that cannot grow
that big is taken up again."
4)
(def may-lie-on-ground
"What can stand on sand, ice or fire: furniture, traps and shields.
Nothing that decides the floor."
#{:box :cabinet :copier :pole :disturbance :bear-trap :shield})
(defn- groundable?
"Whether a room can take `ground`: plain floor, or holding only what
may lie on the ground, with nobody in it and not right beside a door
or the way out; and for ice, not right beside a portal either, so that
no slide ever ends in one."
[state room ground]
(and (room? state room)
(nil? (terrain state room))
(not= room (:at state))
(not (contains? (occupants state) room))
(not (approach? state room))
(let [kind (fixture state room)]
(or (nil? kind) (contains? may-lie-on-ground kind)))
(or (not= :ice ground)
(not-any? (fn [next-door] (contains? portal-kinds (fixture state next-door)))
(adjoining state room)))))
(defn- room-to-spread
"Every room `ground` could spread to from `seed`, through rooms that
can take it."
[state seed ground from-start]
(loop [seen #{seed} frontier [seed]]
(if (empty? frontier)
seen
(let [reached (distinct (for [room frontier
next-door (adjoining state room)
:when (and (not (seen next-door))
(groundable? state next-door ground)
(>= (get from-start next-door 0) 2))]
next-door))]
(recur (into seen reached) (vec reached))))))
(defn- seed-near
"Where a mass of `size` rooms of `ground` starts: the room nearest
`corner`, at least three rooms from where the player starts, with
room enough around it to grow that big; failing that, of the
nearest, the one with the most."
[state corner ground from-start size]
(let [corner-candidates 12 ; how many of the rooms nearest the corner are weighed
nearest (->> (rooms state)
(filter (fn [room] (and (groundable? state room ground)
(>= (get from-start room 0) 3))))
(sort-by (fn [room] [(steps-between corner room) room]))
(take corner-candidates))
roomy (fn [room] (count (room-to-spread state room ground from-start)))]
(or (first (filter (fn [room] (>= (roomy room) size)) nearest))
(first (sort-by (fn [room] (- (roomy room))) nearest)))))
(defn- mass-size
"How many rooms one mass of ground aims for: `share` of the floor, give
or take a fifth, and less each when kinds share the floor."
[state share kinds]
(max smallest-mass (Math/round (/ (* (count (rooms state)) share (+ 0.8 (* 0.4 (chance!))))
(Math/pow (max 1 kinds) 0.7)))))
(defn- grow-mass
"A mass of `ground` grown from `seed` through rooms that can take it,
up to `size`. A room with more of the mass around it is likelier to be
taken next, which keeps the mass together."
[state seed ground size from-start]
(loop [mass [seed] inside #{seed}]
(let [candidates (vec (for [room mass
next-door (adjoining state room)
:when (and (not (inside next-door))
(groundable? state next-door ground)
(>= (get from-start next-door 0) 2))]
next-door))]
(if (or (>= (count mass) size) (empty? candidates))
mass
(let [room (pick! candidates)]
(recur (conj mass room) (conj inside room)))))))
(defn- scatter-bits
"A few rooms of `ground` a room off the edge of `mass`, as though some
of it had spread."
[state mass ground from-start]
(let [inside (set mass)
spots (vec (distinct (for [room mass
next-door (adjoining state room)
beyond (adjoining state next-door)
:when (and (not (inside next-door))
(nil? (terrain state next-door))
(groundable? state beyond ground)
(>= (get from-start beyond 0) 2)
(not-any? inside (adjoining state beyond)))]
beyond)))]
(reduce (fn [state _]
(if-let [spot (pick! (filterv (fn [room] (nil? (terrain state room))) spots))]
(assoc-in state [:terrain spot] ground)
state))
state
(range (roll! 4)))))
(defn- lay-masses
"One mass of each kind in `kinds`, each grown from a corner far from
where the player starts that no other mass has taken, the first such
corner with room for it to reach its size, or failing that the
roomiest; and when it grew large enough to have an edge, a little of
it scattered off that edge. Each `attempt` turns the corners round
by one, so a floor laid again is laid differently."
[state kinds share from-start attempt]
(let [mass-with-an-edge 6 ; big enough to scatter a little of itself off its edge
corners (vec (corners-away state))
corners (if (< (chance!) 0.5)
corners
(vec (concat [(second corners) (first corners)] (drop 2 corners))))
corners (vec (take (count corners) (drop (mod attempt (count corners)) (cycle corners))))]
(loop [state state left kinds unused corners]
(if-let [ground (first left)]
(let [size (mass-size state share (count kinds))
options (keep (fn [corner]
(when-let [seed (seed-near state corner ground from-start size)]
[corner seed (count (room-to-spread state seed ground from-start))]))
unused)
[corner seed] (or (first (filter (fn [[_ _ room]] (>= room size)) options))
(first (sort-by (fn [[_ _ room]] (- room)) options)))]
(if seed
(let [mass (grow-mass state seed ground size from-start)
grown (reduce (fn [state room] (assoc-in state [:terrain room] ground)) state mass)]
(recur (if (>= (count mass) mass-with-an-edge) (scatter-bits grown mass ground from-start) grown)
(rest left)
(remove (fn [taken] (= taken corner)) unused)))
(recur state (rest left) unused)))
state))))
(defn- pocket-rooms
"Empty rooms of the largest mass of `ground`, where boots could lie
with that ground all round them, the most surrounded first."
[state ground]
(let [mass (first (sort-by (fn [patch] (- (count patch))) (patch-rooms state ground)))
surround (fn [room] (count (filter (fn [next-door] (= ground (terrain state next-door)))
(adjoining state room))))]
(->> mass
(filter (fn [room] (free? state room)))
(sort-by (fn [room] [(- (surround room)) room])))))
(defn- boots-in-pocket
"The floor with `boots` in a pocket of `gentler` ground: a room of it
cleared to plain floor, the ground all round it, that the player
could reach without those boots and whose clearing leaves the mass
whole. Nil when no pocket will do."
[state gentler boots]
(let [patches (count (patch-rooms state gentler))]
(pick! (vec (take 3 (for [room (pocket-rooms state gentler)
:let [cleared (update state :terrain dissoc room)]
:when (and (= patches (count (patch-rooms cleared gentler)))
(contains? (reach-in-the-end cleared) room))]
(put cleared room boots)))))))
(defn- edge-rooms
"Empty rooms of plain floor the player could reach without the boots
for `ground`, nearest its edge first."
[state ground]
(let [of-ground (keep (fn [[room kind]] (when (= kind ground) room)) (:terrain state))
distance (fn [room] (apply min 99 (map (fn [other] (steps-between room other)) of-ground)))]
(->> (reach-in-the-end state)
(filter (fn [room] (and (free? state room) (nil? (terrain state room)))))
sort
(sort-by (fn [room] [(distance room) room])))))
(defn- place-all-boots
"Boots for every kind of ground on the floor, gentlest first. Where
the floor has a gentler kind, the boots for the harsher one lie in a
pocket of it, as the fire boots lay in the ice in Chip's building
and the ice boots in the sand. The gentlest kind's boots lie near
its edge, where the player can reach them without them."
[state kinds]
(reduce (fn [state ground]
(let [boots (boots-for ground)
gentler (last (filter (fn [other] (< (harshness other) (harshness ground))) kinds))]
(or (when gentler (boots-in-pocket state gentler boots))
(put state (pick! (vec (take 3 (edge-rooms state ground)))) boots))))
state
kinds))
(defn- lay-terrain
"The ground: a mass of each kind the floor gets, toward the corners
away from the player. A kind whose mass could not grow past a few
rooms is taken up again, so no floor has boots for ground it does
not have. Then the boots. A floor that could not be finished on foot
is laid again, and after a few tries with one kind fewer, so every
floor can be finished without walking through fire unshod."
[state settings]
(let [ground-settings (merge (:terrain default-book) (:terrain settings))
from-start (distances-from state (:at state) adjoining)
kinds (ground-kinds ground-settings (get-in state [:terms :floor] 1))]
(loop [attempt 0]
(let [trying (vec (drop-last (quot attempt 3) kinds))
grown (lay-masses state trying (:share ground-settings 0.2) from-start attempt)
present (filterv (fn [ground] (>= (apply max 0 (map count (patch-rooms grown ground))) smallest-mass))
trying)
kept (assoc grown :terrain (into {} (filter (fn [[_ kind]] (some #{kind} present))
(:terrain grown))))
laid (place-all-boots kept present)]
(if (or (empty? trying) (finishable? laid))
laid
(recur (inc attempt)))))))
(defn- shortest-way
"Roughly the fewest turns a floor can be done in: in each zone its keys
and the warrant, nearest first, then its door, and at the end the way
out. It only has to be fair, since all it measures is the quick bonus."
[state doors zones]
(let [distance (fn [from to] (get (distances-from state from adjoining) to 0))
warrant (first (holding state :warrant))
out (first (holding state :way-out))]
(loop [here (:at state) index 0 total 0]
(let [zone (nth zones index)
stops (cond-> (vec (filter (fn [room] (= :key (fixture state room))) (sort zone)))
(contains? zone warrant) (conj warrant))
[here total] (loop [here here total total stops stops]
(if (empty? stops)
[here total]
(let [nearest (first (sort-by (fn [stop] (distance here stop)) stops))]
(recur nearest
(+ total (distance here nearest))
(remove (fn [stop] (= stop nearest)) stops)))))]
(if (< index (count doors))
(let [door (nth doors index)]
(recur door (inc index) (+ total (distance here door) 1)))
(+ total (if out (distance here out) 0) 1))))))
(defn- plan-for
"What is on the wall on a floor with these terms: as many house rules
as the terms allow, in the order they are introduced, and the warrant
always."
[settings terms]
(vec (remove nil? (conj (vec (take (:rules terms) (:house-rules settings)))
(:warrant-rule settings)))))
(defn- layout
"A whole floor from a seed. Always returns one."
[settings terms seed]
(seed-die! seed)
(let [{:keys [rows cols density]} (proportions settings)
divided (building rows cols density (:locks terms))
state {:rows rows :cols cols :plan (:plan divided) :pits #{} :terrain {}
:held nil :held-at nil :keys 0 :shield nil :stuck 0 :boots #{} :burns 0
:hp (:hp terms) :steps (:steps terms) :turn 0
:reqs (plan-for settings terms)
:amendments (vec (:amendments settings))
:terms terms :entities [] :drops [] :dropped {}
:powers {:vanquish 0 :teleport 0 :stun 0}
:hits 0 :kills 0 :stunned 0 :banked 0
:note nil :new-rule nil :over nil
:seed seed :difficulty (difficulty-name settings)
:events [] :record []}
placed (-> state
(place-by-zone divided terms settings)
(furnish settings)
audit
(lay-terrain settings))
special (:special terms)]
(cond-> (assoc placed
:events []
:record []
:die @die
:locks (count (:doors divided))
:par (shortest-way placed (:doors divided) (:zones divided)))
(and special (some (fn [entity] (= special (:kind entity))) (:entities placed)))
(record {:by :floor :kind :arrived
:line (str "A " (get entity-kind-names special) " entity is on this floor.")}))))
;; ---------------------------------------------------------------------
;; The score
;; ---------------------------------------------------------------------
(defn floor-points
"What this floor is worth so far."
[state]
(let [scoring (get-in state [:terms :scoring])]
(+ (get scoring :floor 0)
(- (* (get scoring :step 0) (:turn state)))
(- (* (get scoring :hit 0) (:hits state 0)))
(* (get scoring :vanquish 0) (:kills state 0))
(* (get scoring :stun 0) (:stunned state 0)))))
(defn- quick-bonus
"All of `:quick` for the shortest way round, none of it at `:slow`
times that, and in proportion between."
[state]
(let [{:keys [quick slow]} (get-in state [:terms :scoring])
par (max 1 (or (:par state) 1))
slow (max 1.1 (or slow 2))
fraction (/ (- (* slow par) (:turn state)) (* (- slow 1) par))]
(Math/round (* (or quick 0) (max 0 (min 1 fraction))))))
;; ---------------------------------------------------------------------
;; Turns
;; ---------------------------------------------------------------------
(defn- winnable?
"Whether the floor can still be finished from where the player
stands: every key in reach picked up and every locked door in reach
opened, until nothing more can be, and then the warrant and the way
out both in reach. Portals count, each the way it goes, which is how
a one-way portal across a lock can make this false."
[state]
(let [sends (portal-map state)
way-out (first (holding state :way-out))
unlocked (fn [state room] (not (shut? state room)))]
(loop [state state]
(let [reach (reachable-from state (:at state) sends unlocked)
state (reduce (fn [state room]
(-> state (assoc-in [:plan room] :empty) (update :keys (fnil inc 0))))
state
(filter reach (holding state :key)))
door (first (filter (fn [door] (some reach (adjoining state door)))
(sort (holding state :door))))]
(if (and door (pos? (:keys state 0)))
(recur (-> state (assoc-in [:plan door] :doorway) (update :keys dec)))
(let [reach (reachable-from state (:at state) sends unlocked)]
(boolean (and (contains? reach way-out)
(or (:held state) (some reach (holding state :warrant)))))))))))
(defn- finished?
[state]
(cond
(:over state) state
(<= (:hp state) 0) (assoc state :over :spent)
(and (:held state) (= :way-out (fixture state (:at state))))
(assoc state
:over :out
:exit {:points (max 0 (floor-points state)) :quick (quick-bonus state)})
(<= (:steps state) 0) (assoc state :over :late)
(not (winnable? state)) (assoc state :over :stranded)
:else state))
(defn- turn-passes
"Everything that is not the player, once, in the order it happens:
the entities move, the powerups age, the floor releases what it
must, Zell writes if it is time, the audit repairs what it can,
whatever has reached the player's room meets the player, and perhaps
something appears."
[state]
(-> state
(update :steps dec)
move-entities
age-drops
tide
zell
audit
contact
drop-powerup
finished?))
(defn- took-time?
[before after]
(or (not= (:at before) (:at after))
(not= (:plan before) (:plan after))
(not= (:keys before) (:keys after))
(not= (:held before) (:held after))))
(defn act
"One press. Anything that changes the floor costs a turn, and a turn is
when everything else happens. A wall costs nothing, and says so, and
so does a powerup, which is the point of one.
The turn is counted before the press is carried out, so everything one
press causes is recorded under one number."
[state [verb target]]
(let [state (assoc state :note nil)]
(cond
(:over state) state
(some (fn [kind] (= kind verb)) power-kinds)
(use-power state verb target)
(pos? (:stuck state))
(-> state
(update :turn inc)
(update :stuck dec)
(record {:by :you :kind :stuck :room (:at state)
:line (if (= :stun (:held-by state)) "Still stunned." "Still caught.")})
turn-passes)
:else
(let [ticking (update state :turn inc)
after (case verb
:walk (step-into ticking (beside (:at ticking) target))
:push (push ticking target)
:take (take-warrant ticking)
ticking)
after (if (= (:at ticking) (:at after))
after
(-> after arrive (tread target)))]
(if-not (took-time? ticking after)
(assoc after :turn (:turn state))
(let [passed (turn-passes (dissoc after :slowed))]
(if (and (:slowed after) (not (:over passed)))
(-> passed
(update :turn inc)
(cond-> (not= :sand (terrain state (:at state)))
(record {:by :floor :kind :sand :room (:at passed)
:line "Sand. That step took two turns."}))
turn-passes)
passed)))))))
(defn- quiet
"The floor once it has been drawn. What moved has finished moving and
what happened has been shown, so drawing it again plays nothing twice."
[state]
(-> state
(assoc :was-at (:at state) :events [])
(update :entities (fn [entities]
(mapv (fn [entity] (assoc entity :was (:at entity))) entities)))))
;; ---------------------------------------------------------------------
;; Sprites
;; ---------------------------------------------------------------------
(def sprite
{:sand-boots "<path d='M9 4h5v9l4 2v3H7v-3l2-2z'/><path d='M7 21h1M10 21h1M13 21h1M16 21h1'/>"
:ice-boots "<path d='M9 4h5v9l4 2v3H7v-3l2-2z'/><path d='M6 21h13M17 21l1.5-1.5'/>"
:fire-boots "<path d='M9 4h5v9l4 2v3H7v-3l2-2z'/><path d='M17 9c-1.2-1-1.2-2.2 0-3.4 1.2 1.2 1.2 2.4 0 3.4z'/>"
:door "<path d='M6 20V6h9v14'/><circle cx='12.8' cy='13' r='1'/>"
:doorway "<path d='M6 20V6h12v14'/><path d='M6 6l5 2.5v12l-5-0.5'/>"
:key "<circle cx='8' cy='8' r='3'/><path d='M10.2 10.2L19 19M16 16l2-2M13.5 13.5l1.5-1.5'/>"
:box "<path d='M5 7h14v12H5zM5 10.5h14M12 7v3.5'/>"
:pole "<path d='M12 4v13M8 20h8'/>"
:cabinet "<path d='M5 5h14v14H5zM5 12h14M9 8.5h2M9 15.5h2'/>"
:copier "<path d='M4 9h16v8H4zM7 9V6h10v3M7 13h10'/>"
:disturbance "<path d='M4 8c2-2 4 2 6 0s4 2 6 0 3 1 4 1M4 14c2-2 4 2 6 0s4 2 6 0 3 1 4 1M4 20c2-2 4 2 6 0s4 2 6 0 3 1 4 1'/>"
:bear-trap "<path d='M4 12h16M6 12l1.5-3M10 12l1.5-3M14 12l1.5-3M18 12l1.5-3M6 12l1.5 3M10 12l1.5 3M14 12l1.5 3M18 12l1.5 3'/>"
:shield "<path d='M12 3l7 3v6c0 4-3 7-7 9-4-2-7-5-7-9V6z'/>"
:warrant "<path d='M7 4h10v16H7zM10 8h4M10 10.5h4M10 13h2.5'/><circle cx='14' cy='16.5' r='1.5'/>"
:way-out "<path d='M6 20V10.5a6 6 0 0 1 12 0V20M12 20v-5'/>"
:portal-a "<path d='M12 4c4 0 6 3.5 6 8s-2 8-6 8-6-3.5-6-8 2-8 6-8z'/><circle cx='12' cy='12' r='2'/>"
:portal-b "<path d='M12 4c4 0 6 3.5 6 8s-2 8-6 8-6-3.5-6-8 2-8 6-8z'/><circle cx='12' cy='12' r='2'/>"
:portal-in "<path d='M12 4c4 0 6 3.5 6 8s-2 8-6 8-6-3.5-6-8 2-8 6-8z'/><path d='M8 12h7M12 9l3 3-3 3'/>"
:portal-out "<path d='M12 4c4 0 6 3.5 6 8s-2 8-6 8-6-3.5-6-8 2-8 6-8z'/><path d='M16 12H9M13 9l-3 3 3 3'/>"
:vanquish "<path d='M12 3l2.4 6.6L21 12l-6.6 2.4L12 21l-2.4-6.6L3 12l6.6-2.4z'/>"
:teleport "<circle cx='12' cy='12' r='8' stroke-dasharray='2.5 3'/><circle cx='12' cy='12' r='2.5'/>"
:stun "<circle cx='12' cy='12' r='2.5'/><path d='M12 3v3.5M12 17.5V21M3 12h3.5M17.5 12H21M5.6 5.6l2.5 2.5M15.9 15.9l2.5 2.5M5.6 18.4l2.5-2.5M15.9 8.1l2.5-2.5'/>"})
(def player-sprite
"<circle cx='12' cy='7.5' r='3'/><path d='M6.5 20.5c0-3.4 2.5-5.6 5.5-5.6s5.5 2.2 5.5 5.6'/>")
(def glitch-pools
"What an entity is made of from one moment to the next: the letters of
its name, and the marks a document leaves when it goes wrong. The
special ones draw on marks of their own."
{:entity "ENTYΞΣΨЖЯ#%@§¶*+=/?▓▒░"
:fast "»›→⇢≫~≈ENTY/"
:strong "█▓▒■▣◼ΞЖЯENTY"
:thrower "*✶✳✴⁂+•°ENTY"})
(def glitch-words
"What an entity now and then almost says."
["ENT" "TTY" "ERR" "NUL" "N/A" "§§§"])
(defn- glitch-text
[length pool]
(apply str (repeatedly length (fn [] (rand-nth pool)))))
(defn- flicker
"An entity's text a moment later: now and then a word, otherwise the
same letters with about a third of them changed."
[text pool]
(if (< (rand) 0.06)
(let [word (rand-nth glitch-words)]
(subs word 0 (min (count word) (max 1 (count text)))))
(apply str (map (fn [glyph] (if (< (rand) 0.35) (rand-nth pool) glyph)) text))))
(defn- entity-html
"An entity: `length` letters that will not hold still, from the marks
its `kind` is made of, dealt at random here and changed a few times a
second by the widget's one timer. The floor's own die is never
touched."
[length classes kind]
(let [kind (or kind :entity)
text (glitch-text length (get glitch-pools kind))]
(str "<span class='" (str/join " " (concat ["maze-entity" (str "is-" (name kind))] classes)) "'"
" data-kind='" (name kind) "' data-text='" text "'>" text "</span>")))
(defn- svg
[class-name inner]
(str "<svg viewBox='0 0 24 24' class='" class-name "' aria-hidden='true'>" inner "</svg>"))
(defn- fixture-svg
([kind] (fixture-svg kind nil))
([kind extra]
(svg (str "maze-sprite maze-" (name kind) (when extra (str " " extra)))
(get sprite kind ""))))
;; ---------------------------------------------------------------------
;; Drawing the floor
;; ---------------------------------------------------------------------
(def walk-reach
"How far away something can have been and still be drawn sliding in:
two rooms, the most anything walks in a turn. Anything further came by
portal or teleport, and simply arrives."
2)
(defn- slide-style
"The offset a sprite slides from, as CSS variables. The grid is drawn
afresh every turn, so movement is shown by drawing each sprite where
it is now and sliding it home from where it was, with nothing but
CSS. Only from `reach` rooms away or nearer: further than that is a
portal or a teleport, and those are arrived at rather than slid to."
[from to reach delay]
(when (and from (not= from to))
(let [[from-row from-col] from
[to-row to-col] to
rows-apart (- from-row to-row)
cols-apart (- from-col to-col)
apart (+ (magnitude rows-apart) (magnitude cols-apart))
base-ms 120 ; any slide, before its length is counted
ms-per-room 50] ; and this much longer for each room it crosses
(when (<= apart reach)
(str " style='--dr:" rows-apart ";--dc:" cols-apart
";--slide:" (+ base-ms (* ms-per-room apart)) "ms;--delay:" delay "ms'")))))
(defn- mover
[inner style arriving?]
(str "<span class='maze-mover"
(cond style " is-sliding" arriving? " is-arriving" :else "")
"'" style ">" inner "</span>"))
(defn- count-label
[n extra]
(str "<span class='maze-count" extra "'>" n "</span>"))
(defn- wrong-rooms
"Rooms holding something a broken, repairable Requirement is about.
The audit has already failed to fix these, which is worth seeing."
[state]
(set (for [{rule :keep a :a b :b} (filter repairable? (unmet state))
room (concat (holding state a)
(when b (holding state b))
(when (= :clear rule)
(for [room-of-a (holding state a)
next-door (adjoining state room-of-a)
:when (fixture state next-door)]
next-door)))]
room)))
(defn- what-was-seen
"Everything the drawing needs from this turn, worked out once.
`pointing` is the set of kinds the reader is pointing at, on the wall
or in the key, and `aiming` the powerup being aimed, if any."
[state pointing aiming]
(let [events (:events state)
of-kind (fn [kinds] (filter (fn [event] (contains? kinds (:kind event))) events))
next-turn (update state :turn inc)
rearrange-reach 99 ; further than rooms lie apart, so moved furniture always slides
rearrange-delay-ms 170] ; the beat the building waits after the player moves
{:arrivals (into {} (for [{:keys [kind from to]} (of-kind #{:moved :pushed})]
[to (if (= :moved kind)
{:from from :reach rearrange-reach :delay rearrange-delay-ms}
{:from from :reach longest-slide :delay 0})]))
:rearranged (set (map :to (of-kind #{:moved})))
:vanished (into {} (for [{:keys [room fixture]} (of-kind #{:gone})]
[room fixture]))
:ended (set (map :room (of-kind #{:ended})))
:wounded (set (map :room (of-kind #{:wounded})))
:released (set (map :room (of-kind #{:released :fell})))
:stunned (set (concat (mapcat :rooms (of-kind #{:stunned}))
(map :room (of-kind #{:stunned-you}))))
:stunning (set (map :room (of-kind #{:stunned})))
:throwing (set (keep :source events))
:appeared (set (map :room (of-kind #{:dropped})))
:player-reach (if (and (seq (of-kind #{:slid})) (empty? (of-kind #{:through}))) longest-slide walk-reach)
:lit (or pointing #{})
:targets (set (case aiming
:vanquish (vanquish-targets state)
:teleport (teleport-targets state)
[]))
:wrong (wrong-rooms state)
:going (when (and (:held state) (not (:over state)))
(when (get-in state [:terms :release]) (next-to-go state)))
:going-now? (tide-due? next-turn)
:restless? (and (not (:over state)) (entities-move? next-turn))}))
(defn- wall-classes
"The sides of a room that face no room, where the building's walls are
drawn."
[state [row col]]
(for [[side neighbour] [["n" [(dec row) col]] ["e" [row (inc col)]]
["s" [(inc row) col]] ["w" [row (dec col)]]]
:when (not (room? state neighbour))]
(str "wall-" side)))
(defn- lit?
"Whether a room holds something the reader is pointing at, on the
wall or in the key: a fixture, the ground, a powerup lying there, an
entity of a kind pointed at, or the player."
[seen state room kind lying present here?]
(let [lit (:lit seen)]
(boolean (or (contains? lit kind)
(contains? lit (terrain state room))
(and lying (contains? lit (:kind lying)))
(some (fn [entity] (contains? lit (or (:kind entity) :entity))) present)
(and here? (contains? lit :you))))))
(defn- jitter
"Small offsets that differ from room to room, so a large stretch of
ground does not show the same tile over and over and its fire does not
flicker in step."
[[row col]]
(str "--jitter-x:" (* 2 (mod (+ (* 3 col) (* 5 row)) 8)) "px;"
"--jitter-y:" (* 2 (mod (+ (* 3 row) (* 7 col)) 8)) "px;"
"--jitter-t:-" (* 150 (mod (+ (* 5 row) (* 3 col)) 8)) "ms"))
(defn- cell-html
[state seen room]
(let [[row col] room]
(cond
(pit? state room)
(str "<div class='maze-pit"
(when (contains? (:released seen) room) " is-fresh")
(when (contains? (:lit seen) :released) " is-lit")
"'></div>")
(not (room? state room))
"<div class='maze-void'></div>"
:else
(let [kind (fixture state room)
ground (terrain state room)
here? (= room (:at state))
arrival (get (:arrivals seen) room)
gone (get (:vanished seen) room)
lying (first (filter (fn [powerup] (= room (:at powerup))) (:drops state)))
present (filter (fn [entity] (= room (:at entity))) (:entities state))
classes (cond-> (into ["maze-room"] (wall-classes state room))
ground (conj (str "terrain-" (name ground)))
(= room (:going seen)) (conj "is-going")
(and (= room (:going seen)) (:going-now? seen)) (conj "is-going-now")
(lit? seen state room kind lying present here?) (conj "is-lit")
(contains? (:wrong seen) room) (conj "is-wrong")
(and (= :way-out kind) (:held state)) (conj "is-open-way")
(and (= :door kind) (pos? (:keys state 0))) (conj "is-ready-door")
(contains? (:rearranged seen) room) (conj "is-rearranged")
(or (contains? (:ended seen) room) (contains? (:wounded seen) room)) (conj "is-struck")
(contains? (:stunned seen) room) (conj "is-stunned")
(contains? (:stunning seen) room) (conj "is-stunning")
(contains? (:throwing seen) room) (conj "is-throwing")
(contains? (:targets seen) room) (conj "is-target")
here? (conj "is-here"))]
(str "<div class='" (str/join " " classes) "' data-row='" row "' data-col='" col "'"
(when ground (str " style='" (jitter room) "'"))
">"
(when kind
(if-let [style (when arrival
(slide-style (:from arrival) room (:reach arrival) (:delay arrival)))]
(mover (fixture-svg kind) style false)
(fixture-svg kind)))
(when lying
(str (mover (fixture-svg (:kind lying) "maze-drop")
nil
(contains? (:appeared seen) room))
(count-label (:left lying) "")))
(when gone
(fixture-svg gone "maze-ghost"))
(when (contains? (:ended seen) room)
(entity-html 3 ["maze-ghost"] nil))
(str/join ""
(for [entity present
:let [was (:was entity)
style (slide-style was room walk-reach 0)
held (:stuck entity 0)
classes (cond-> []
(:restless? seen) (conj "is-restless")
(pos? held) (conj "is-held")
(pos? (:wounds entity 0)) (conj "is-wounded"))]]
(str (mover (entity-html 3 classes (:kind entity))
style
(and was (not= was room) (nil? style)))
(when (pos? held) (count-label held " is-held"))
(when-let [power (:power entity)]
(fixture-svg power "maze-held-power")))))
(when here?
(let [was (:was-at state)
style (slide-style was room (:player-reach seen) 0)]
(mover (svg "maze-you" player-sprite)
style
(and was (not= was room) (nil? style)))))
"</div>")))))
(defn- grid-html
[state pointing aiming]
(let [seen (what-was-seen state pointing aiming)]
(str/join "" (for [row (range (:rows state))
col (range (:cols state))]
(cell-html state seen [row col])))))
;; ---------------------------------------------------------------------
;; Drawing everything else
;; ---------------------------------------------------------------------
(defn- pips
[left most]
(str "<span class='maze-pips' role='img' aria-label='" (max 0 left) " of " most " hits left'>"
(str/join "" (for [index (range most)]
(str "<span class='maze-pip" (when (< index left) " is-full") "'></span>")))
"</span>"))
(defn- metric
[label-text value]
(str "<span class='maze-metric'><span class='maze-metric-name'>" label-text "</span>"
"<span class='maze-metric-value'>" value "</span></span>"))
(defn- best-kept
[]
(let [kept (reader/stored storage-key)]
(if (map? kept) kept {})))
(defn- best-for
[difficulty]
(let [kept (best-kept)]
(or (get kept difficulty) (get kept (word difficulty)) 0)))
(defn- keep-best!
[difficulty score]
(when (> score (best-for difficulty))
(reader/store! storage-key (assoc (best-kept) difficulty score))))
(defn- this-floor
[state]
(if (= :out (:over state))
(+ (get-in state [:exit :points] 0) (get-in state [:exit :quick] 0))
(max 0 (floor-points state))))
(defn- bar-html
"The numbers that matter, over the floor."
[state]
(let [{:keys [hp steps floor banked terms difficulty burns]} state
per-hit (get-in terms [:terrain :burns-per-hit] 3)]
(str "<div class='maze-bar-part'>" (pips hp (:hp terms))
(when (pos? (or burns 0))
(str "<span class='maze-singed'>singed " burns " of " per-hit "</span>"))
"<span class='maze-steps'>" steps " steps left</span></div>"
"<div class='maze-bar-part'>"
(metric "Floor" floor)
(metric "This floor" (this-floor state))
(metric "Banked" banked)
(metric "Best" (best-for difficulty))
"</div>")))
(defn- turns-until
[turn every]
(- every (mod turn every)))
(defn- clock
[what turns]
(str "<div class='maze-clock" (when (= 1 turns) " is-next") "'>"
what (if (= 1 turns) " next turn" (str " in " turns " turns")) "</div>"))
(defn- hands
[state]
(let [held-keys (:keys state 0)
carried (cond-> []
(pos? held-keys) (conj (if (= 1 held-keys) "a key" (str held-keys " keys")))
(:shield state) (conj (if (shield-hot? state)
(str "the shield, ending entities for "
(- (get-in state [:terms :shield-turns] 3)
(- (:turn state) (:shield state)))
" more turns")
"the shield"))
(:held state) (conj "the warrant"))
worn (keep (fn [boots] (when (contains? (:boots state) boots) (label-of boots)))
[:fire-boots :ice-boots :sand-boots])]
(str (cond
(pos? (:stuck state))
(str (if (= :stun (:held-by state))
(str "Stunned for " (turns-word (:stuck state)))
"Caught in a trap")
(when (seq carried) (str ", holding " (str/join ", " carried)))
".")
(seq carried) (str "Holding " (str/join ", " carried) ".")
:else "Holding nothing.")
(when (seq worn) (str " Wearing " (str/join " and " worn) ".")))))
(defn- over-line
[state]
(case (:over state)
:spent "Out of hits. Press n for a new run, or r to try this floor again."
:late "Out of steps. Press n for a new run, or r to try this floor again."
:closed "The floor closed around you. Press n for a new run."
:stranded "Stranded. Nothing on this side opens the way back. Press r to try this floor again, or n for a new run."
:out (str "Out with the warrant. " (get-in state [:exit :points] 0) " for the floor, "
(get-in state [:exit :quick] 0) " for speed.")
""))
(defn- status-html
[state]
(let [{:keys [turn terms entities over held held-at]} state
{:keys [pace writes release]} terms]
(str "<div class='maze-hands'>" (hands state) "</div>"
(when-not over
(str (when (seq entities) (clock "Entities move" (turns-until turn pace)))
(when writes (clock "New requirement" (turns-until turn writes)))
(when (and held release)
(clock "Next room released" (turns-until (- turn held-at) release)))))
(when over
(str "<div class='maze-over is-" (name over) "'>" (over-line state) "</div>")))))
(defn- powers-html
"Held powerups, as buttons, and what to do while one is being aimed."
[state aiming]
(str (str/join ""
(for [kind power-kinds
:let [held (get-in state [:powers kind] 0)]
:when (pos? held)]
(str "<button class='roll-go maze-power" (when (= kind aiming) " is-on") "'"
" data-power='" (name kind) "'>"
(fixture-svg kind)
(capitalized (label-of kind))
(when (> held 1) (str " ×" held))
" (" (get power-keys kind) ")</button>")))
(case aiming
:vanquish "<p class='maze-hint'>Click an entity, or press 1 again for the nearest. Esc cancels.</p>"
:teleport "<p class='maze-hint'>Click a lit room, or press an arrow to go as far as you can that way. Esc cancels.</p>"
nil)))
(defn- record-html
[state]
(let [this-turn (set (:events state))]
(str (str/join ""
(for [{:keys [turn by line] :as event} (:record state)]
(str "<p class='maze-line by-" (word by)
(when (contains? this-turn event) " is-now") "'>"
"<span class='maze-turn'>" turn "</span>" line "</p>")))
(when-let [line (:note state)]
(str "<p class='maze-remark'>" line "</p>")))))
(defn- requirements-html
[state]
(let [broken (set (unmet state))
written (some (fn [event] (when (= :wrote (:kind event)) (:rule event)))
(:events state))]
(str/join ""
(for [{a :a b :b :as requirement} (:reqs state)]
(str "<div class='maze-req"
(cond
(and (contains? broken requirement) (repairable? requirement)) " is-unmet"
(contains? broken requirement) " is-broken"
(= requirement (:new-rule state)) " is-new"
:else "")
(when (= requirement written) " is-written")
"'"
(when a (str " data-a='" (word a) "'"))
(when b (str " data-b='" (word b) "'"))
">" (capitalized (sentence requirement)) ".</div>")))))
(def key-entries
"Every entry the key can show, in the order it shows them: the player
and the entities; the job; what costs the player; the ground and its
boots; what helps the player; what moves the player; and the
building. Alike things sit together, and need no labels to say so."
[:you :entity :fast :strong :thrower
:warrant :way-out :key :door :doorway
:disturbance :cabinet :copier :bear-trap :fire
:ice :sand :fire-boots :ice-boots :sand-boots
:shield :vanquish :teleport :stun
:portal-a :portal-in :portal-out
:box :pole :released])
(def entity-kinds
#{:entity :fast :strong :thrower})
(defn- entry-lights
"The kinds of room an entry in the key lights on the floor."
[entry]
(cond
(nil? entry) nil
(= :portal-a entry) #{:portal-a :portal-b}
:else #{entry}))
(defn- entry-name
[entry]
(case entry
:you "You"
:entity "Entity"
:released "Released"
(:fast :strong :thrower) (str (capitalized (get entity-kind-names entry)) " entity")
(capitalized (label-of entry))))
(defn- entry-picture
[entry]
(cond
(= :you entry) (svg "maze-you" player-sprite)
(contains? entity-kinds entry) (entity-html 1 [] entry)
(= :released entry) "<span class='maze-legend-pit'></span>"
(contains? boots-for entry) (str "<span class='maze-swatch terrain-" (name entry) "'></span>")
:else (fixture-svg entry)))
(defn- entry-note
"What an entry does, in full, for the window."
[entry terms]
(let [{:keys [pace release shield-turns trap-holds trap-holds-you powerups entity-powerups specials]} terms
{:keys [lasts vanquish-range teleport-range stun-radius stun-turns]} powerups
per-hit (get-in terms [:terrain :burns-per-hit] 3)
how-often (case pace 1 "every turn" 2 "every other turn" (str "every " pace " turns"))
fades (str " If nobody picks it up, it fades after " (turns-word lasts) "."
(when entity-powerups " Entities can pick it up too."))]
(case entry
:you "Arrows or a click to walk. Shift and an arrow pushes what is ahead of you, or pulls what is behind you. Space to take. 1, 2 and 3 use powerups."
:entity (str "Entities come for you " how-often ". Each one that reaches you costs you a hit. Entities cannot open locked doors or push boxes, and they go round fire when they can."
(when entity-powerups
(str " On this floor they take any powerup nearer to them than you are, and use it on you:"
" a vanquish costs you a hit from up to " vanquish-range " rooms away, a stun holds you for "
(turns-word (entity-stun-turns terms)) ", and a teleport brings them nearer.")))
:fast (str "Comes for you " how-often ", two rooms at a time, one step after the other, so it cannot pass a wall any more than the others can.")
:strong "Takes two blows to end: a hot shield and a vanquish, or two of either. The first leaves it wounded, and breaks its ring."
:thrower (str "Throws something at you whenever you are within " (get specials :throw-range 2)
" rooms of it, walls or no walls, and then has to move before it can throw again. A throw costs you a hit, unless a shield takes it.")
:warrant (str "What you came for. Space takes it."
(when release
(str " From then on the building releases a room every " (turns-word release)
", so leave it for last if you can.")))
:way-out "Walk in carrying the warrant to finish the floor."
:key "Opens one locked door. Walk into it to pick it up."
:door "Locked. Walk into it holding a key to open it. Entities cannot get through until it is open."
:doorway "An unlocked door. Anyone can come through now, entities included."
:disturbance "Costs you a hit if you walk in, unless a shield takes it. You can push or pull it."
(:cabinet :copier) "Costs you a hit if you walk in. You can push or pull it."
:bear-trap (str "Holds whoever steps in: you for " (turns-word trap-holds-you)
", an entity for " (turns-word trap-holds) ". Entities walk straight into traps. You can push or pull it.")
:fire (str "Every step into fire singes you, and " per-hit " singes cost a hit. It burns entities the same way. Fire boots make it ordinary floor to you.")
:ice "Step onto ice and you slide the way you were going until the ice ends or something stops you: a wall, a door, or furniture, which you stop just short of. Step onto furniture on the ice and it holds you still. Entities slide too, and so does anything you push onto it. Ice boots let you walk on it."
:sand "Every step into sand takes two turns, so everything else gets two turns to your one. Entities cross it at their usual pace. Sand boots make it ordinary floor to you."
:fire-boots "Walk into them to put them on. Fire is ordinary floor to you for the rest of this floor."
:ice-boots "Walk into them to put them on. You walk on ice instead of sliding, for the rest of this floor."
:sand-boots "Walk into them to put them on. Sand is ordinary floor to you for the rest of this floor."
:shield (str "Takes one hit for you. For " (turns-word shield-turns)
" after you pick it up, it ends any entity it meets.")
:vanquish (str "Press 1 to end an entity within " vanquish-range " rooms. A strong one takes two blows. It takes no turn." fades)
:teleport (str "Press 2, then click a lit room or press an arrow, to jump up to " teleport-range
" rooms. Never past a locked door. It takes no turn." fades)
:stun (str "Press 3 to stop every entity within " stun-radius " rooms for " (turns-word stun-turns)
". It takes no turn." fades)
:portal-a "Step into either end to come out of the other, even past a lock. Entities use portals too."
:portal-in "Step in to come out at its exit, which may be past a lock. It only goes one way: take it without the key or the warrant you need over there, and there is no way back."
:portal-out "Where the one-way portal lets out. It does not go back."
:box "Shift and an arrow pushes it, or pulls it after you. Entities cannot move it, so they go round. On ice it can only be pushed, and it slides until something stops it."
:pole "Furniture that will not move. On ice it stops a slide like a wall, and stepping onto it holds you still."
:released "Gone. Nobody can stand here. While you carry the warrant, the striped room goes next."
"")))
(defn- entry-count
"How many of an entry the floor holds."
[state entry]
(cond
(= :you entry) 1
(contains? entity-kinds entry)
(count (filter (fn [entity] (= entry (or (:kind entity) :entity))) (:entities state)))
(= :released entry) (count (:pits state))
(contains? boots-for entry)
(count (filter (fn [[room ground]] (and (= ground entry) (room? state room))) (:terrain state)))
:else
(let [lights (entry-lights entry)]
(+ (count (filter (fn [held] (contains? lights held)) (vals (:plan state))))
(count (filter (fn [lying] (= entry (:kind lying))) (:drops state)))))))
(defn- entry-present?
[state entry]
(or (pos? (entry-count state entry))
(pos? (get-in state [:powers entry] 0))
(contains? (:boots state) entry)))
(defn- count-words
[state entry]
(let [on-floor (entry-count state entry)
in-hand (get-in state [:powers entry] 0)
armed (if (contains? entity-kinds entry)
(count (filter (fn [entity] (and (:power entity) (= entry (or (:kind entity) :entity))))
(:entities state)))
0)]
(str (if (pos? on-floor) (str on-floor " on this floor") "None on this floor")
(when (pos? in-hand) (str ", " in-hand " in hand"))
(when (contains? (:boots state) entry) ", and you are wearing them")
(when (pos? armed) (str ", " armed " holding a powerup"))
".")))
(defn- legend-html
"The key as one table, alike things next to one another, holding only
what is on this floor or in the player's hands, because a key to
things that are not there is a list of worries. The entry chosen is
marked."
[state chosen]
(str/join ""
(for [entry key-entries
:when (entry-present? state entry)
:let [chosen? (= entry chosen)]]
(str "<button type='button' class='maze-legend-item" (when chosen? " is-selected")
"' data-entry='" (name entry) "' aria-pressed='" chosen? "'>"
"<span class='maze-legend-box'>" (entry-picture entry) "</span>"
"<span class='maze-legend-name'>" (entry-name entry) "</span>"
"</button>"))))
(defn- about-layer
"One description in the window, or the hint when `entry` is nil."
[state entry showing?]
(str "<div class='maze-about-layer" (when showing? " is-showing") "'>"
(if entry
(str "<div class='maze-about-head'><span class='maze-legend-box'>" (entry-picture entry) "</span>"
"<span class='maze-about-name'>" (entry-name entry) "</span></div>"
"<p class='maze-about-note'>" (entry-note entry (:terms state)) "</p>"
(when-not (= :you entry)
(str "<p class='maze-about-count'>" (count-words state entry) "</p>")))
"<p class='maze-about-hint'>Open the key above and select anything to see what it does and where it is.</p>")
"</div>"))
(defn- about-html
"The window beside the Requirements. Every description is in it,
stacked in one place, and only the one pointed at or chosen is shown,
so the window is always as tall as the longest and never changes
size."
[state shown]
(str (about-layer state nil (nil? shown))
(str/join "" (for [entry key-entries]
(about-layer state entry (= entry shown))))))
(defn- header-line
[state]
(str "floor " (:floor state) " · banked " (:banked state)
" · best " (best-for (:difficulty state))))
(defn- score-line
[state]
(str (word (:difficulty state)) " · seed " (:seed state)))
(defn- can-take?
[state]
(and (not (:over state)) (= :warrant (fixture state (:at state)))))
;; ---------------------------------------------------------------------
;; State
;; ---------------------------------------------------------------------
(defonce game (atom nil))
(defonce start-of-floor (atom nil))
(defonce run (atom 0))
(defonce pushing (atom false))
(defonce aiming (atom nil))
(defonce leaving (atom nil))
(defonce pointing (atom nil))
(defonce glitch-timer (atom nil))
(defonce hovering (atom nil))
(defonce selected (atom nil))
(defn- layout!
"A floor on the settings as they stand, keeping what is banked."
[floor banked hp]
(let [settings @book
terms (terms-for settings floor)
laid (-> (layout settings terms (seed-for settings @run floor))
(assoc :floor floor
:banked banked
:hp (min (:hp terms) (or hp (:hp terms)))))]
(reset! start-of-floor laid)
(reset! game laid)))
(defn- new-run!
[]
(reset! run 0)
(layout! 1 0 nil))
(defn- advance!
"Out, with it. The floor is banked, and the next one laid out, with one
hit back."
[]
(let [{:keys [floor banked hp difficulty exit]} @game
banked (+ banked (:points exit 0) (:quick exit 0))]
(keep-best! difficulty banked)
(layout! (inc floor) banked (inc hp))))
;; ---------------------------------------------------------------------
;; Painting
;; ---------------------------------------------------------------------
(defn- paint-grid!
[node]
(let [state @game]
(wui/grid! node ".maze-grid" (:cols state)
(grid-html state (or @pointing (entry-lights @selected)) @aiming))))
(defn- mark!
"Classes on the widget itself. The hurt flash has two names, one for
odd turns and one for even, so that two hurts in a row flash twice."
[node state]
(let [classes (.-classList node)
hurt? (some (fn [event] (= :hurt (:kind event))) (:events state))
over (:over state)]
(.remove classes "maze-hurt-a" "maze-hurt-b")
(when hurt?
(.add classes (if (even? (:turn state)) "maze-hurt-a" "maze-hurt-b")))
(.toggle classes "maze-is-over" (boolean (and over (not= :out over))))
(.toggle classes "maze-is-out" (= :out over))
(.toggle classes "maze-is-aiming" (some? @aiming))
(when-let [button (reader/q node ".maze-push")]
(.toggle (.-classList button) "is-on" (boolean @pushing)))))
(defn paint!
[node]
(let [state @game]
(paint-grid! node)
(wui/html! node ".maze-bar" (bar-html state))
(wui/html! node ".maze-status" (status-html state))
(wui/html! node ".maze-powers" (powers-html state @aiming))
(wui/html! node ".maze-record" (record-html state))
(wui/html! node ".maze-reqs" (requirements-html state))
(wui/html! node ".maze-legend" (legend-html state @selected))
(wui/html! node ".maze-about" (about-html state (or @hovering @selected)))
(reader/text! node ".maze-score" (score-line state))
(wui/state! node (header-line state))
(reader/enable! node ".maze-take" (can-take? state) "Take (space)")
(reader/enable! node ".maze-push" (not (:over state))
(if @pushing "Pushing: pick a room" "Push (shift)"))
(mark! node state)))
;; ---------------------------------------------------------------------
;; Hands
;; ---------------------------------------------------------------------
(defn- settle!
"Draw the floor, then let it settle, so that what just happened is
played once."
[node]
(paint! node)
(swap! game quiet))
(defn- cancel-leaving!
[]
(when-let [timer @leaving]
(js/clearTimeout timer)
(reset! leaving nil)))
(defn- hurry-out!
"The next floor now, for a reader who does not want to watch the last
one go."
[node]
(cancel-leaving!)
(advance!)
(settle! node))
(defn- leave!
[node]
(let [out-beat 900] ; how long the floor is shown being left before the next one is laid
(settle! node)
(reset! leaving (js/setTimeout (fn []
(reset! leaving nil)
(advance!)
(settle! node))
out-beat))))
(defn- act!
[node action]
(if @leaving
(hurry-out! node)
(do (reset! aiming nil)
(swap! game act action)
(reset! pushing false)
(let [state @game]
(cond
(= :out (:over state)) (leave! node)
(:over state) (do (keep-best! (:difficulty state) (:banked state))
(settle! node))
:else (settle! node))))))
(defn- restart!
[node]
(if @leaving
(hurry-out! node)
(do (reset! pushing false)
(reset! aiming nil)
(reset! game @start-of-floor)
(settle! node))))
(defn- again!
"Another floor. After a run has ended, that is the first floor of a new
one; during a run, it is this floor in a different building."
[node]
(if @leaving
(hurry-out! node)
(do (reset! pushing false)
(reset! aiming nil)
(if (:over @game)
(new-run!)
(do (swap! run inc)
(layout! (:floor @game) (:banked @game) (:hp @game))))
(settle! node))))
(defn- power!
"A powerup's key or button. Stun goes off at once. Vanquish goes off at
once when there is only one thing it could mean, and otherwise waits
to be aimed. Teleport always waits to be aimed."
[node kind]
(let [state @game]
(cond
@leaving (hurry-out! node)
(:over state) nil
(not (pos? (get-in state [:powers kind] 0))) nil
(= :stun kind) (act! node [:stun nil])
(= :vanquish kind)
(let [targets (vanquish-targets state)]
(if (or (= :vanquish @aiming) (<= (count targets) 1))
(act! node [:vanquish (when (= 1 (count targets)) (first targets))])
(do (reset! aiming :vanquish)
(paint! node))))
:else
(do (reset! aiming (when-not (= :teleport @aiming) :teleport))
(paint! node)))))
(defn- blink-target
"The furthest room the player could teleport to in a straight line
that way."
[state direction]
(let [targets (set (teleport-targets state))
reach (get-in state [:terms :powerups :teleport-range] 4)]
(some (fn [distance]
(let [room (nth (iterate (fn [room] (beside room direction)) (:at state)) distance)]
(when (contains? targets room) room)))
(range reach 0 -1))))
(def keymap
{"ArrowUp" :north "w" :north "W" :north
"ArrowDown" :south "s" :south "S" :south
"ArrowLeft" :west "a" :west "A" :west
"ArrowRight" :east "d" :east "D" :east
" " :take "r" :restart "R" :restart "n" :again "N" :again
"1" :vanquish "2" :teleport "3" :stun "Escape" :cancel})
(defn- typing?
"Whether a key was meant for a field, such as the settings above the
floor. A reader typing `w` into the settings has not asked to walk."
[target]
(boolean (and target
(.-closest target)
(.closest target "input, textarea, select, [contenteditable]:not([contenteditable='false'])"))))
(defn- first-step
"The direction of the first step from where the player stands toward
`room`, going round what costs the player and the ground the player
has no boots for when there is a way round, through a portal when
that is shorter, through a locked door only with a key, and never
into a one-way portal unless it is the room asked for. Nil when
there is no way."
[state room]
(let [here (:at state)
sends (portal-map state)
costly #{:cabinet :copier :disturbance :bear-trap}
open-to-player (fn [state next-door]
(and (or (pos? (:keys state 0)) (not (shut? state next-door)))
(or (= next-door room) (not= :portal-in (fixture state next-door)))))
careful (fn [state next-door]
(and (open-to-player state next-door)
(or (= next-door room)
(and (not (contains? costly (fixture state next-door)))
(let [ground (terrain state next-door)]
(or (nil? ground) (shod? state ground)))))))
onward (fn [open?]
(let [distances (distances-to state room open? true)]
(when-let [far-off (get distances here)]
(first (filter (fn [next-door]
(and (open? state next-door)
(= (dec far-off)
(get distances (if (= next-door room)
room
(get sends next-door next-door))))))
(adjoining state here))))))]
(when-let [step (or (onward careful) (onward open-to-player))]
(direction-of here step))))
(defn- hold-focus!
"Give the keys back to the floor, so that the space bar takes the
warrant instead of pressing whichever button was clicked last. The
reader is already here, so nothing scrolls."
[node]
(.focus node #js {:preventScroll true}))
(defn- wire-keys!
"Its own handler rather than `keys!`, because shift is part of the
verb here, and a key typed into the settings belongs to the settings.
Any other key the floor knows is the floor's, even when a button has
the focus: the focus comes back to the floor first, so the button
never sees the key. Nothing here calls focus until the reader has
pressed something."
[node]
(when-not (.hasAttribute node "tabindex")
(.setAttribute node "tabindex" "0"))
(set! (.-onkeydown node)
(fn [event]
(let [pressed (get keymap (.-key event))
target (.-target event)]
(when (and pressed
(or (not= :cancel pressed) @aiming @selected)
(not (or (.-ctrlKey event) (.-metaKey event) (.-altKey event)))
(not (typing? target)))
(.preventDefault event)
(when-not (identical? target node) (hold-focus! node))
(case pressed
:restart (restart! node)
:again (again! node)
:take (act! node [:take])
:cancel (do (if @aiming (reset! aiming nil) (reset! selected nil)) (paint! node))
(:vanquish :teleport :stun) (power! node pressed)
(if (= :teleport @aiming)
(if-let [room (blink-target @game pressed)]
(act! node [:teleport room])
(do (swap! game note "Nowhere to land that way.")
(paint! node)))
(act! node [(if (or (.-shiftKey event) @pushing) :push :walk) pressed]))))))))
(defn- wire-grid!
"A click on a room next to the player's walks into it, or pushes what
is in it with shift or the Push button. A click further off takes
one step toward it. A click on the player's own room takes what is
there. While a powerup is being aimed, a click on a lit room uses
it, and anywhere else puts it away."
[node]
(when-let [grid (wui/q! node ".maze-grid")]
(set! (.-onclick grid)
(fn [event]
(when-let [room (wui/data event ".maze-room" "row" "col")]
(let [state @game
here (:at state)
next-door? (= 1 (steps-between here room))
lit? (fn [targets] (some (fn [target] (= target room)) targets))]
(cond
@leaving (hurry-out! node)
(:over state) nil
(= :vanquish @aiming) (if (lit? (vanquish-targets state))
(act! node [:vanquish room])
(do (reset! aiming nil) (paint! node)))
(= :teleport @aiming) (if (lit? (teleport-targets state))
(act! node [:teleport room])
(do (reset! aiming nil) (paint! node)))
(= room here) (act! node [:take])
:else
(when-let [direction (if next-door?
(direction-of here room)
(first-step state room))]
(act! node [(if (and next-door? (or (.-shiftKey event) @pushing))
:push
:walk)
direction])))))))))
(defn- wire-wall!
"Pointing at a Requirement lights the things it is about."
[node]
(when-let [wall (wui/q! node ".maze-reqs")]
(set! (.-onpointerover wall)
(fn [event]
(when-let [line (.closest (.-target event) ".maze-req")]
(let [named (set (keep (fn [attribute]
(when-let [value (.getAttribute line attribute)]
(keyword value)))
["data-a" "data-b"]))]
(when (not= named @pointing)
(reset! pointing named)
(paint-grid! node))))))
(set! (.-onpointerleave wall)
(fn [_]
(when @pointing
(reset! pointing nil)
(paint-grid! node))))))
(defn- show-about!
"The floor's lighting and the window, drawn again after the pointer has
moved in the key."
[node]
(paint-grid! node)
(wui/html! node ".maze-about" (about-html @game (or @hovering @selected))))
(defn- entry-at
"The entry in the key an event happened on, or nil."
[event]
(when-let [item (.closest (.-target event) ".maze-legend-item")]
(keyword (.getAttribute item "data-entry"))))
(defn- less-motion?
[]
(boolean (when (.-matchMedia js/globalThis)
(.-matches (.matchMedia js/globalThis "(prefers-reduced-motion: reduce)")))))
(defn- scramble!
"Every entity in the widget that is free to move, a moment later. Held
and stunned ones keep still, which is one way to tell."
[node]
(doseq [element (.querySelectorAll node ".maze-entity:not(.is-held)")]
(let [text (flicker (.-textContent element)
(get glitch-pools (keyword (.getAttribute element "data-kind")) (:entity glitch-pools)))]
(set! (.-textContent element) text)
(.setAttribute element "data-text" text))))
(defn- start-glitching!
"One timer for every entity in the widget, started once, and not at all
for a reader who has asked for less motion."
[node]
(let [glitch-ms 120] ; how often the entities change their letters
(when (and (nil? @glitch-timer) (not (less-motion?)))
(reset! glitch-timer (js/setInterval (fn [] (scramble! node)) glitch-ms)))))
(defn- wire-key!
"Pointing at an entry in the key lights where it is on the floor and
shows what it does in the window beside the Requirements. A click keeps
it there, lit, until the same entry is clicked again or Esc is pressed."
[node]
(when-let [key-section (wui/q! node ".maze-key-panel")]
(when (true? (reader/stored :maze-key-open))
(set! (.-open key-section) true))
(set! (.-ontoggle key-section)
(fn [_] (reader/store! :maze-key-open (boolean (.-open key-section)))))
(when-let [summary (.querySelector key-section "summary")]
(set! (.-onclick summary) (fn [_] (hold-focus! node)))))
(when-let [legend (wui/q! node ".maze-legend")]
(set! (.-onpointerover legend)
(fn [event]
(when-let [entry (entry-at event)]
(when (not= entry @hovering)
(reset! hovering entry)
(reset! pointing (entry-lights entry))
(show-about! node)))))
(set! (.-onpointerleave legend)
(fn [_]
(when (or @hovering @pointing)
(reset! hovering nil)
(reset! pointing nil)
(show-about! node))))
(set! (.-onclick legend)
(fn [event]
(when-let [entry (entry-at event)]
(swap! selected (fn [chosen] (when-not (= chosen entry) entry)))
(paint! node)
(hold-focus! node))))))
(defn- wire-powers!
[node]
(when-let [powers (wui/q! node ".maze-powers")]
(set! (.-onclick powers)
(fn [event]
(when-let [button (.closest (.-target event) ".maze-power")]
(hold-focus! node)
(power! node (keyword (.getAttribute button "data-power"))))))))
(defn- wire-buttons!
"Every button hands the keys back to the floor once it has done its
work."
[node]
(let [then-focus (fn [work] (fn [_] (work) (hold-focus! node)))]
(reader/on-click! node ".maze-take" (then-focus (fn [] (act! node [:take]))))
(reader/on-click! node ".maze-push"
(then-focus (fn []
(swap! pushing not)
(paint! node))))
(reader/on-click! node ".maze-restart" (then-focus (fn [] (restart! node))))
(reader/on-click! node ".maze-again" (then-focus (fn [] (again! node))))))
(defn- wire-settings!
"Run lays out a new first floor, on the new settings."
[node id]
(wui/settings!
node id
(fn [setting]
(cancel-leaving!)
(reset! pushing false)
(reset! aiming nil)
(reset! book (merge-settings default-book setting))
(new-run!)
(settle! node))))
(defn setup!
"Once per element. Each part is wired on its own, so one that fails
says so and takes nothing else with it."
[node]
(let [id (.-id node)]
(start-glitching! node)
(wui/wire! node "keys" wire-keys!)
(wui/wire! node "grid" wire-grid!)
(wui/wire! node "wall" wire-wall!)
(wui/wire! node "key" wire-key!)
(wui/wire! node "powers" wire-powers!)
(wui/wire! node "buttons" wire-buttons!)
(wui/wire! node "settings" (fn [element] (wire-settings! element id)))))
(defn mount!
"No focus is taken here. A page that jumps to a game the reader has not
reached yet has made a decision on the reader's behalf."
[{:keys [id]}]
(when (nil? @book) (reset! book default-book))
(when (nil? @game) (new-run!))
(wui/mount! ::maze (or id "maze") setup! paint!))</script><div class="widget widget-maze" id="maze" tabindex="0"><div class="roll-head"><span class="roll-label">MAZE.CLJS · arrows or a click to walk · shift to push · space to take · 1 2 3 for powerups</span><span class="widget-state">press Run</span></div><div class="widget-source"><div class="widget-source-head"><span class="widget-source-name">maze_settings.cljs</span><span class="widget-source-lang">cljs</span></div><textarea class="widget-settings" rows="30" spellcheck="false">;; ---------------------------------------------------------------------
;; MAZE_SETTINGS.CLJS
;;
;; Change a number and press Run.
;; Every Run begins again on the first floor.
;; The building may change its rules while you are standing in
;; it - that is its privilege, which it doesn't share.
;;
;; THE REQUIREMENTS ARE DATA. Add one to `:house-rules` and it goes on
;; the wall. Add one to `:amendments` and Zell may write it. There are
;; four verbs, and the floor can meet the first three by moving
;; furniture:
;;
;; {:keep :apart :a :box :b :door} box shall not adjoin door
;; {:keep :together :a :box :b :door} box shall adjoin door
;; {:keep :clear :a :way-out} nothing shall adjoin way-out
;; {:keep :present :a :warrant} warrant shall be held on this floor
;;
;; Anything on the floor can be named: :box :cabinet :copier
;; :disturbance :pole :bear-trap :shield :key :door :doorway :warrant
;; :way-out :portal-a :portal-b :portal-in :portal-out. The door, the
;; key, the warrant, the way out and the portals are never moved, so a
;; requirement about one of them moves the other thing, and a
;; requirement about two of them is simply true or simply not.
;;
;; The building itself never puts anything that persists (furniture or a
;; portal) right beside a door or the way out, so that each can always
;; be reached. A requirement that asks for one there is met only if you
;; move it there yourself.
;; ---------------------------------------------------------------------
{:rows 10 ; five to twenty, and the same for columns
:cols 10
:density 0.78 ; how much of the grid is rooms. under about 0.6
; it falls into islands and only the largest remains
:seed nil ; nil is a new building every floor. a number is
; the same buildings in the same order every time,
; and the seed under the floor is the one to copy
:difficulty :clerk ; :visitor :clerk :auditor :inspector
;; Each row represents a collection of map constraints.
;;
;; rules requirements on the wall on the first floor, besides the
;; warrant, which is always there
;; locks locked doors across the floor, each with a key somewhere
;; on your side of it. three at most, fewer in a building too
;; small to take them
;; entities how many come for you on the first floor
;; pace entities move once every this many turns. 1 is your speed
;; release once you carry the warrant, a room goes every this many
;; turns. nil, and nothing goes
;; writes Zell adds a requirement every this many turns. nil, never
;; hp what you start with, and the most you can hold
;; steps how many moves a floor allows
;; drops the most of each powerup that can appear on one floor
;; entity-powerups
;; whether entities pick up powerups and use them on you. one
;; goes for a powerup only when it is nearer to it than you
;; are, and uses it only when it would reach you
:difficulties
{:visitor {:rules 1 :locks 0 :entities 1 :pace 3 :release 5 :writes 14
:hp 4 :steps 120 :drops 2 :entity-powerups false}
:clerk {:rules 1 :locks 1 :entities 2 :pace 2 :release 4 :writes 10
:hp 3 :steps 90 :drops 1 :entity-powerups false}
:auditor {:rules 3 :locks 2 :entities 3 :pace 2 :release 3 :writes 8
:hp 4 :steps 100 :drops 1 :entity-powerups true}
:inspector {:rules 4 :locks 2 :entities 4 :pace 2 :release 2 :writes 6
:hp 2 :steps 90 :drops 1 :entity-powerups true}}
;; THE WAY DOWN. What each floor after the first does to the row above.
;; Each is [every limit]: every that many floors, one step worse, and
;; never worse than the limit. A row that starts past a limit stays
;; where it started.
:descent {:rules [1 4] ; one more requirement a floor, up to four
:locks [3 3] ; one more lock every third floor, up to three
:entities [2 4] ; one more entity every second floor
:release [3 2] ; a room goes a turn sooner every third floor
:writes [1 6]} ; Zell writes a turn sooner every floor
:writes-from 2 ; the first floor he writes on. the first floor is
; quiet, so the first amendment anybody sees is an
; event rather than weather
;; Powerups: Each turn there is a chance one appears on an empty tile,
;; indicating the number of turns it has left written over it. Walk into
;; it to pick it up. Using one takes no turn, so they can be used together.
;;
;; vanquish 1 ends an entity within reach
;; teleport 2 moves you a few rooms, never past a locked door
;; stun 3 stops everything near you for a few turns
;;
;; Where the difficulty row allows it, entities pick them up too. An
;; entity's vanquish costs you a hit from as far off as yours reaches,
;; its stun holds you for half as long as yours holds them, and its
;; teleport brings it nearer.
:powerups {:chance 0.08 ; each turn, the chance one appears
:lasts 12 ; turns before it fades
:vanquish-range 5 ; how far away the one you end can be
:teleport-range 4 ; how far you can go
:stun-radius 2 ; how close entities have to be
:stun-turns 4} ; and how long they stay stopped
;; Score: Completing a floor is worth `:floor` before you move. Turns and hits
;; take from it, and ending or stunning entities adds to it. Getting out
;; adds up to `:quick` more: all of it for the shortest way round, none
;; of it at `:slow` times that. Dying loses the floor you are on and
;; keeps the ones already banked.
:score {:floor 1000
:step 10
:hit 50
:vanquish 150
:stun 40
:quick 500
:slow 2}
;; Floor tiles: Sand, ice and fire, each gathered in one large mass
;; toward a corner away from where you start, with a little of it
;; scattered off the edge. Floor one is usually bare and never has more
;; than one kind. After that, one more kind becomes possible every
;; `:new-kind-every` floors, though the die now and then gives a floor
;; one fewer. Every kind brings its boots. The boots for a harsher kind
;; lie in a pocket of a gentler one when the floor has one, fire boots
;; in the ice and ice boots in the sand; otherwise they lie near the
;; edge of their own ground, on your side. No floor is laid that cannot
;; be finished without walking through fire unshod.
;;
;; sand every step into it takes two turns. entities cross it at
;; their usual pace
;; ice you slide the way you were going until the ice ends or
;; something stops you. entities slide too, and so does
;; anything you push onto it
;; fire every step into it singes you, and enough singes are a hit.
;; it burns entities the same way, and they go round it when
;; they can
:terrain {:first-floor-bare 0.6 ; the chance floor one has no ground at all
:new-kind-every 3 ; floors between one more kind of ground and the next
:one-fewer 0.35 ; the chance a later floor has one kind fewer than it could
:share 0.28 ; about how much of the floor one kind covers alone
:burns-per-hit 3} ; singes that add up to a hit
;; SPECIAL ENTITIES. Every floor that `:every` divides has one, the
;; kinds taking turns.
;;
;; fast moves two rooms at a time, one step after the other, so
;; it still cannot pass a wall
;; strong takes two blows to end: a hot shield and a vanquish, or
;; two of either
;; thrower throws at you from within `:throw-range` rooms, walls or
;; no walls, then has to move before it can throw again
:specials {:every 3 :kinds [:fast :strong :thrower] :throw-range 2}
;; Furniture: Counts for a building ten rooms by ten, scaled to the size
;; above, then multiplied by `:clutter`. It goes anywhere except right
;; beside a door or the way out.
:clutter 1.0 ; 0 is an empty building. 2 is a storeroom
:furniture {:box 2 :cabinet 1 :copier 1 :disturbance 1 :pole 1}
;; These are counted exactly and spawn a short distance from where
;; you start. A portal may cross a lock, and a one-way portal that
;; does can leave you where nothing opens the way back. No portal is
;; ever right beside a door or the way out, and no ice right beside a
;; portal.
:traps 2
:shields 1
:portals true ; a pair: step into either end, come out the other
:one-way true ; a portal that goes somewhere and does not return
:shield-turns 3 ; for this long after you pick it up, the shield
; ends anything it meets. after that it takes one
; hit and is gone
:trap-holds 2 ; turns a trap holds an entity
:trap-holds-you 1 ; turns a trap holds you
;; Requirements: The warrant is on it on every floor.
:warrant-rule {:keep :present :a :warrant}
;; In the order the building introduces them. The first is the one you
;; can see happening, the second teaches you that a barricade does not
;; last, the third that the audit can be aimed, and the fourth is
;; furniture.
:house-rules
[{:keep :clear :a :way-out}
{:keep :apart :a :box :b :door}
{:keep :together :a :bear-trap :b :cabinet}
{:keep :apart :a :shield :b :disturbance}]
;; What Zell may write, one at a time and never the same one twice.
:amendments
[{:keep :apart :a :box :b :way-out}
{:keep :together :a :cabinet :b :copier}
{:keep :clear :a :warrant}
{:keep :apart :a :shield :b :way-out}
{:keep :together :a :box :b :disturbance}]}</textarea><div class="live-bar"><button class="roll-go widget-settings-run">Run</button><button class="roll-rewrite widget-settings-reset">Put it back</button></div><p class="widget-settings-said">Press Run.</p></div><div class="widget-body"><div class="maze-bar"></div><div class="maze-stage"><div class="maze-grid"></div><div class="maze-side"><div class="maze-status"></div><div class="maze-powers"></div><div class="maze-record"></div></div></div><div class="live-bar"><button class="roll-go maze-take">Take (space)</button><button class="roll-go maze-push">Push (shift)</button><button class="roll-go maze-restart">Restart floor (r)</button><button class="roll-rewrite maze-again">Another floor (n)</button></div><p class="maze-score"></p><details class="maze-key-panel"><summary class="maze-heading">Key</summary><div class="maze-legend"></div></details><div class="maze-lower"><div class="maze-wall"><p class="maze-heading">Requirements</p><div class="maze-reqs"></div></div><div class="maze-detail"><p class="maze-heading">Details</p><div class="maze-about"></div></div></div></div><p class="roll-foot">Take the warrant and get out. The building rearranges itself to keep its rules.</p></div><script type="application/x-scittle">(if-let [mount (resolve (quote fedoras.cs-class.maze.maze-ui/mount!))] (mount {:id "maze"}) (js/console.error "fedoras: fedoras.cs-class.maze.maze-ui/mount! is not on this page. Either the file that declares it was never shipped, or the namespace inside it does not match the path it was shipped from."))</script></div>
```
```{=html}
<div class="scene"><div class="screenplay"><p class="action">The button marked Amend is Zell's. It adds a line. It is not a difficulty setting and it does not make the floor harder in any way that could be measured — it makes the floor more correct, and there is no version of this in which those two things are different.</p></div></div>
```