From 8166e4a8091f85fb15c62eacd2af56b800591709 Mon Sep 17 00:00:00 2001 From: Books Date: Tue, 13 Oct 2026 20:33:57 +1100 Subject: [PATCH] AutoLISP: load and run .lsp routines (fixes #758) (#855) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * AutoLISP: load and run .lsp routines (#758) CADCraft runs AutoLISP routines. `.lsp` files load with APPLOAD, (load) or by dropping them on the window, and at startup from the support folder (acad.lsp once per session or per drawing with ACADLSPASDOC, acaddoc.lsp per drawing, then S::STARTUP; never from a drawing's own folder). (defun c:NAME …) defines commands, (autoload) defers loading to first use, and (expression) and !variable work at the command line and at prompts. docs/autolisp.md lists what is supported. The interpreter (crates/engine/src/lisp) reads source with its own stack and evaluates on an explicit-stack machine, so a routine can stop for input (getpoint, pause in command) and carry on later on one thread, deep recursion is an error rather than a crash, and long loops run a slice per frame (Esc stops them). It follows AutoLISP: 32-bit wrapping integers, dynamic scope, *error*, vl-catch-all-apply, AutoLISP's error wording. About 200 built-ins cover the language, command (with pause and commands left open), entity lists (entget/entmake/entmod/entdel/entlast/ entnext/handent, through the DXF reader and writer's groups, exposed by cadcraft-io and handed to the engine through a hook), ssget with modes and filters, tables, system variables, get… input with initget, and units. A routine is one undo step; each drawing has its own symbols. Also: keywords typed as _KEYWORD match at prompts; TEXT run by a routine's command takes one line; DIMENSION records carry their measurement (42); Prompt::raw shows a get… prompt as written; the interface asks Session::prompting() (a command's or a routine's prompt) where it asked whether a command runs, so clicks, right-click and Delete work at a routine's prompts; getcorner and based get… prompts drag a rubber band. Tests: the language, errors, startup files, interactive input, hostile input (lisp/tests.rs); the #648 corpus, 18/18, when CADCRAFT_LISP_CORPUS points at it (tests/lisp_corpus.rs); drop, frames and canvas clicks in the app (ui-egui/tests/lisp_files.rs). * AutoLISP: bound memory, drop nested values iteratively, guard the per-frame tick - Cons cells drop with a work list over both car and cdr (and function bodies), so a list nested a million deep in its car no longer overflows the stack when it goes away. - Memory caps so a runaway routine fails with a LISP error instead of an uncatchable out-of-memory abort: at most 5,000,000 live cons cells (counted in Value::cons / Drop, checked every step; cells the drawing's variables already held at the run's start don't count against it), no string a built-in makes longer than 8 MiB (strcat checks before joining, printed text is cut), and a 2 GiB per-run budget for new strings, printed text and files read. - Session::lisp_tick runs under catch_unwind, and so does every slice of the LISP machine: a panic ends the routine with "internal error", puts the drawing back and leaves the session usable. - Regression tests for each (deep car nesting, nested functions, the cell cap, string length and budget, a panicking built-in in a blocking run and in a ticked one). Co-Authored-By: Claude Opus 5.5 --------- Co-authored-by: Brandon Thomas Co-authored-by: Claude Opus 5.5 --- apps/cadcraft-cli/src/main.rs | 5 + apps/cadcraft-web/src/main.rs | 5 + apps/cadcraft/src/main.rs | 12 + crates/engine/src/cmd/draw.rs | 18 +- crates/engine/src/cmd/file.rs | 18 + crates/engine/src/cmd/lisp.rs | 110 ++ crates/engine/src/cmd/mod.rs | 2 + crates/engine/src/guard.rs | 2 +- crates/engine/src/lib.rs | 155 ++- crates/engine/src/lisp/builtins.rs | 1486 ++++++++++++++++++++++++++++ crates/engine/src/lisp/drawing.rs | 962 ++++++++++++++++++ crates/engine/src/lisp/eval.rs | 656 ++++++++++++ crates/engine/src/lisp/input.rs | 383 +++++++ crates/engine/src/lisp/mod.rs | 613 ++++++++++++ crates/engine/src/lisp/read.rs | 249 +++++ crates/engine/src/lisp/startup.rs | 59 ++ crates/engine/src/lisp/tests.rs | 553 +++++++++++ crates/engine/src/lisp/value.rs | 562 +++++++++++ crates/engine/src/prompt.rs | 7 + crates/engine/src/sysvars.rs | 3 + crates/engine/tests/lisp_corpus.rs | 239 +++++ crates/io/src/dxf_read.rs | 6 + crates/io/src/dxf_write.rs | 22 + crates/io/src/lib.rs | 2 + crates/render/src/dim.rs | 9 + crates/ui-egui/src/canvas.rs | 14 +- crates/ui-egui/src/cmdline.rs | 30 +- crates/ui-egui/src/context_menu.rs | 4 +- crates/ui-egui/src/control.rs | 2 +- crates/ui-egui/src/i18n/uk.tsv | 2 + crates/ui-egui/src/lib.rs | 31 +- crates/ui-egui/tests/lisp_files.rs | 66 ++ docs/autolisp.md | 87 ++ docs/file-format-parity.md | 2 +- docs/gaps.md | 2 +- docs/roadmap.md | 2 +- 36 files changed, 6339 insertions(+), 41 deletions(-) create mode 100644 crates/engine/src/cmd/lisp.rs create mode 100644 crates/engine/src/lisp/builtins.rs create mode 100644 crates/engine/src/lisp/drawing.rs create mode 100644 crates/engine/src/lisp/eval.rs create mode 100644 crates/engine/src/lisp/input.rs create mode 100644 crates/engine/src/lisp/mod.rs create mode 100644 crates/engine/src/lisp/read.rs create mode 100644 crates/engine/src/lisp/startup.rs create mode 100644 crates/engine/src/lisp/tests.rs create mode 100644 crates/engine/src/lisp/value.rs create mode 100644 crates/engine/tests/lisp_corpus.rs create mode 100644 crates/ui-egui/tests/lisp_files.rs create mode 100644 docs/autolisp.md diff --git a/apps/cadcraft-cli/src/main.rs b/apps/cadcraft-cli/src/main.rs index 40e74ee..8e303ec 100644 --- a/apps/cadcraft-cli/src/main.rs +++ b/apps/cadcraft-cli/src/main.rs @@ -172,6 +172,11 @@ fn install_io() { cadcraft_engine::cmd::file::set_write_as(|d, name, o| { cadcraft_io::write_with(d, name, &cadcraft_io::SaveOptions { version: o.version, binary: o.binary }).map_err(|e| e.to_string()) }); + // AutoLISP's entget, entmake and entmod see entities as DXF groups. + cadcraft_engine::cmd::file::set_entity_codec(cadcraft_engine::cmd::file::EntityCodec { + groups: cadcraft_io::entity_groups, + entity: cadcraft_io::entity_from_groups, + }); } fn open(s: &mut Session, path: &str) -> Result<(), String> { diff --git a/apps/cadcraft-web/src/main.rs b/apps/cadcraft-web/src/main.rs index 0859aba..4525233 100644 --- a/apps/cadcraft-web/src/main.rs +++ b/apps/cadcraft-web/src/main.rs @@ -80,6 +80,11 @@ mod web { cadcraft_engine::cmd::file::set_write_as(|d, name, o| { cadcraft_io::write_with(d, name, &cadcraft_io::SaveOptions { version: o.version, binary: o.binary }).map_err(|e| e.to_string()) }); + // AutoLISP's entget, entmake and entmod see entities as DXF groups. + cadcraft_engine::cmd::file::set_entity_codec(cadcraft_engine::cmd::file::EntityCodec { + groups: cadcraft_io::entity_groups, + entity: cadcraft_io::entity_from_groups, + }); // `?host=parent`: a same-origin page framing CADCraft (such as a Nextcloud app) opens // drawings in it and stores what it saves. Otherwise there is no file system here: saved // files reach the user as browser downloads. diff --git a/apps/cadcraft/src/main.rs b/apps/cadcraft/src/main.rs index 34e2a7e..8b17514 100644 --- a/apps/cadcraft/src/main.rs +++ b/apps/cadcraft/src/main.rs @@ -115,6 +115,11 @@ pub fn install_io() { cadcraft_engine::cmd::file::set_write_as(|d, name, o| { cadcraft_io::write_with(d, name, &cadcraft_io::SaveOptions { version: o.version, binary: o.binary }).map_err(|e| e.to_string()) }); + // AutoLISP's entget, entmake and entmod see entities as DXF groups. + cadcraft_engine::cmd::file::set_entity_codec(cadcraft_engine::cmd::file::EntityCodec { + groups: cadcraft_io::entity_groups, + entity: cadcraft_io::entity_from_groups, + }); } fn services() -> Services { @@ -322,6 +327,13 @@ fn main() -> eframe::Result { // Autosave files (SAVEFILEPATH) default to `/autosave`. if let Some(dir) = config_dir() { app.enable_autosave(&dir.join("autosave")); + // Startup LISP (acad.lsp, acaddoc.lsp) is read from `/support`; the + // folder is made so it is there to put them in. + let support = dir.join("support"); + if let Err(e) = std::fs::create_dir_all(&support) { + log::warn!("no LISP support folder {}: {e}", support.display()); + } + app.session.set_lisp_support_dir(Some(support)); } app.integrated_titlebar = cfg!(target_os = "macos"); if surface.present_mode == eframe::wgpu::PresentMode::AutoNoVsync { diff --git a/crates/engine/src/cmd/draw.rs b/crates/engine/src/cmd/draw.rs index 8bb5024..b5efa62 100644 --- a/crates/engine/src/cmd/draw.rs +++ b/crates/engine/src/cmd/draw.rs @@ -1438,11 +1438,22 @@ struct TextM { justify: (HAlign, VAlign), asking_justify: bool, line: usize, + /// Run by a LISP routine (`command`): one line of text ends the command, as AutoLISP's + /// `command` runs TEXT; typed and in scripts each line asks for the next. + single_line: bool, } impl TextM { - fn new(_s: &Session) -> Self { - TextM { at: None, height: None, rotation: None, justify: (HAlign::Left, VAlign::Baseline), asking_justify: false, line: 0 } + fn new(s: &Session) -> Self { + TextM { + at: None, + height: None, + rotation: None, + justify: (HAlign::Left, VAlign::Baseline), + asking_justify: false, + line: 0, + single_line: s.lisp_running(), + } } } @@ -1503,6 +1514,9 @@ impl Interactive for TextM { let k = make_text(s, at, &t, h, r, self.justify); s.add_entity(k)?; self.line += 1; + if self.single_line { + return Ok(Step::Done); + } } (Some(_), Some(_), Some(_), Input::Enter) => return Ok(Step::Done), _ => {} diff --git a/crates/engine/src/cmd/file.rs b/crates/engine/src/cmd/file.rs index 73876d8..25e49ae 100644 --- a/crates/engine/src/cmd/file.rs +++ b/crates/engine/src/cmd/file.rs @@ -37,6 +37,24 @@ pub fn io() -> Option<&'static IoHooks> { IO.get() } +/// An entity as DXF groups and back, for AutoLISP's `entget`, `entmake` and `entmod` +/// (installed by the app with the DXF reader and writer, a lower layer). +pub struct EntityCodec { + /// The entity's type name and the groups of its record, without its `0` group. + pub groups: fn(&Drawing, &cadcraft_doc::Entity) -> (String, Vec), + /// An entity from a type name and groups. + pub entity: fn(&str, &[cadcraft_dxf::Tag]) -> Option<(cadcraft_doc::Common, cadcraft_doc::EntityKind)>, +} + +static CODEC: OnceLock = OnceLock::new(); + +pub fn set_entity_codec(c: EntityCodec) { + let _ = CODEC.set(c); +} +pub fn entity_codec() -> Option<&'static EntityCodec> { + CODEC.get() +} + /// COMPARE (drawing comparison). pub mod compare; diff --git a/crates/engine/src/cmd/lisp.rs b/crates/engine/src/cmd/lisp.rs new file mode 100644 index 0000000..edb0b40 --- /dev/null +++ b/crates/engine/src/cmd/lisp.rs @@ -0,0 +1,110 @@ +//! AutoLISP commands: APPLOAD loads a `.lsp` file; `lisp` evaluates LISP for programmatic +//! callers (scripts, the control channel, MCP, the CLI). + +use serde_json::{Value, json}; + +use super::{bad, str_param}; +use crate::lisp::value::{Value as Lv, to_text}; +use crate::{Accept, CommandSpec, EngineError, Input, Interactive, Prompt, Result, Session, Step}; + +pub fn specs() -> Vec { + vec![ + CommandSpec::new("appload", "Load Application...", run_appload) + .menu(&["Tools", "Load Application..."]) + .alias(&["ap"]) + .params("{path: .lsp file} | {name, data: base64 | text} → {value?, error?}") + .noundo() + .interactive(|_| Ok(Box::new(ApploadM))), + CommandSpec::new("lisp", "Evaluate LISP", run_lisp) + .params( + "{code: LISP source, inputs?: [answers to get… calls: numbers, strings, [x,y] points]} → {value (printed as prin1), output: lines printed, error?}", + ) + .noundo(), + ] +} + +/// The text of a LISP file from `{path}` or `{name, data | text}`, and its name. +fn source(p: &Value) -> Result<(String, String)> { + if let Some(text) = str_param(p, "text") { + return Ok((str_param(p, "name").unwrap_or("untitled.lsp").to_string(), text.to_string())); + } + if let Some(data) = str_param(p, "data") { + let bytes = super::file::base64_decode(data).ok_or_else(|| bad("appload", "invalid base64"))?; + return Ok((str_param(p, "name").unwrap_or("untitled.lsp").to_string(), String::from_utf8_lossy(&bytes).into_owned())); + } + let path = str_param(p, "path").ok_or_else(|| bad("appload", "`path`, or `name` with `data` (base64) or `text`, is required"))?; + let text = crate::lisp::builtins::read_text_file(path).ok_or_else(|| bad("appload", format!("{path}: can't read the file")))?; + Ok((path.to_string(), text)) +} + +/// The result of a blocking LISP run as JSON, with the lines it printed. +fn report(s: &Session, from_log: usize, r: Option>) -> Value { + let output: Vec = s.log.get(from_log..).map(|l| l.to_vec()).unwrap_or_default(); + match r { + Some(Ok(v)) => json!({ "value": to_text(&v, true), "output": output }), + Some(Err(e)) => json!({ "error": e, "output": output }), + None => json!({ "output": output }), + } +} + +fn run_appload(s: &mut Session, p: &Value) -> Result { + let (name, text) = source(p)?; + let from = s.log.len(); + let r = s.lisp_load(&name, &text, true)?; + Ok(report(s, from, r)) +} + +/// A JSON input as a LISP value: numbers, strings, `[x, y(, z)]` points, null for Enter. +fn input_value(v: &Value) -> Lv { + match v { + Value::Array(a) if a.len() >= 2 && a.iter().all(Value::is_number) => Lv::point(&a.iter().filter_map(Value::as_f64).collect::>()), + other => crate::lisp::drawing_from_json(other), + } +} + +fn run_lisp(s: &mut Session, p: &Value) -> Result { + let code = str_param(p, "code").ok_or_else(|| bad("lisp", "`code` is required"))?; + let inputs = p.get("inputs").and_then(Value::as_array).map(|a| a.iter().map(input_value).collect()).unwrap_or_default(); + let from = s.log.len(); + let r = s.lisp_eval(code, false, true, inputs).map_err(|e| match e { + EngineError::Other(m) => bad("lisp", m), + e => e, + })?; + Ok(report(s, from, r)) +} + +/// APPLOAD typed or chosen from the menu: asks for the file by name. +struct ApploadM; + +impl Interactive for ApploadM { + fn name(&self) -> &'static str { + "APPLOAD" + } + fn prompt(&self, _: &Session) -> Prompt { + Prompt::new("Enter name of LISP file to load", Accept::TEXT) + } + fn input(&mut self, s: &mut Session, i: Input) -> Result { + if matches!(i, Input::Cancel | Input::Enter) { + return Ok(Step::Cancel); + } + let Input::Text(t) = i else { return Ok(Step::Continue) }; + let path = t.trim().trim_matches('"').to_string(); + if path.is_empty() { + return Ok(Step::Cancel); + } + match source(&json!({ "path": path })) { + Ok((name, text)) => { + // The routine may wait for the user: it carries on after this command ends. + if let Err(e) = s.lisp_load(&name, &text, false) { + s.echo(e.to_string()); + } + Ok(Step::Done) + } + Err(EngineError::BadParams { msg, .. }) => { + s.echo(msg); + Ok(Step::Done) + } + Err(e) => Err(e), + } + } +} diff --git a/crates/engine/src/cmd/mod.rs b/crates/engine/src/cmd/mod.rs index d6a936a..f7307f2 100644 --- a/crates/engine/src/cmd/mod.rs +++ b/crates/engine/src/cmd/mod.rs @@ -21,6 +21,7 @@ pub(crate) mod hatch; mod inquiry; mod layer; mod layout; +mod lisp; mod mleader_content; mod mleader_edit; mod modify; @@ -200,6 +201,7 @@ pub fn command_specs() -> &'static [CommandSpec] { v.extend(table::specs()); v.extend(tolerance::specs()); v.extend(constraints::specs()); + v.extend(lisp::specs()); v }) } diff --git a/crates/engine/src/guard.rs b/crates/engine/src/guard.rs index 18c7c57..1a06a7c 100644 --- a/crates/engine/src/guard.rs +++ b/crates/engine/src/guard.rs @@ -22,7 +22,7 @@ pub(crate) struct Guarded { broken: Cell>, } -fn message(p: &(dyn Any + Send)) -> String { +pub(crate) fn message(p: &(dyn Any + Send)) -> String { p.downcast_ref::<&str>().map(|s| s.to_string()).or_else(|| p.downcast_ref::().cloned()).unwrap_or_else(|| "panic".into()) } diff --git a/crates/engine/src/lib.rs b/crates/engine/src/lib.rs index 1f488b9..4697478 100644 --- a/crates/engine/src/lib.rs +++ b/crates/engine/src/lib.rs @@ -16,6 +16,7 @@ mod finite; pub mod grip_dims; pub mod grips; mod guard; +pub mod lisp; pub mod pointmod; pub mod prompt; mod recent; @@ -376,6 +377,8 @@ pub struct Settings { /// APERTURE in pixels. pub aperture: f64, pub pickfirst: bool, + /// ACADLSPASDOC: acad.lsp loads into every drawing, not once per session. + pub acadlspasdoc: bool, pub pickadd: bool, /// PICKSTYLE: bit 1 picks whole selectable groups ([`cmd::groups`]), bit 2 associative hatches /// with their boundaries (stored, not used yet). @@ -433,6 +436,7 @@ impl Default for Settings { pickbox: 3.0, aperture: 10.0, pickfirst: true, + acadlspasdoc: false, pickadd: true, pickstyle: 1, gripsize: 5.0, @@ -611,6 +615,10 @@ pub struct Session { pub clipboard_source: Option, /// The window last picked with PLOTWINDOW (the Plot dialog's "Window <"). pub plot_window: Option, + /// AutoLISP: each drawing's symbols and the routine running ([`lisp`]). + lisp: lisp::LispState, + /// How the last LISP run ended (its value or error message). + lisp_last: Option>, /// What the last HATCHPICK kept (the Hatch and Gradient dialog's picks). pub hatch_picks: Option, } @@ -658,6 +666,8 @@ impl Session { last_used: LastUsed::default(), clipboard_source: None, plot_window: None, + lisp: lisp::LispState::default(), + lisp_last: None, hatch_picks: None, } } @@ -831,12 +841,16 @@ impl Session { (Ok(v), Some((doc, sel, uid))) if spec.undoable => self.refuse_non_finite(Some(*uid), doc, sel, spec.id).map(|()| v), (r, _) => r, }; + let grouped = self.lisp_groups_undo(); if spec.undoable && let Some((doc, sel, uid)) = before && let Some(st) = self.docs.iter_mut().find(|d| d.uid == uid) && !Arc::ptr_eq(&doc, &st.doc) { - st.push_undo(Snapshot { label: spec.label.to_string(), doc, selection: sel }); + // Inside a LISP routine the routine's single undo step records it. + if !grouped { + st.push_undo(Snapshot { label: spec.label.to_string(), doc, selection: sel }); + } st.revision += 1; } result @@ -864,6 +878,15 @@ impl Session { let dashed = cmd::resolve_alias(&name.trim_start_matches(['_', '.']).to_ascii_lowercase()); let id = if find_command(&dashed).is_some() { dashed } else { cmd::resolve_alias(&lower) }; let Some(spec) = find_command(&id) else { + // A command defined in LISP: (defun c:NAME …). + if !transparent && let Some(f) = self.lisp_command(&lower) { + if self.running.is_some() { + self.cancel(); + } + self.last_command = Some(lower.clone()); + self.echo(format!("Command: {}", lower.to_ascii_uppercase())); + return self.lisp_run_command(&lower, f); + } // A bare system variable name (ORTHOMODE, GRIDMODE…) acts as SETVAR on that variable. let var = lower.to_ascii_uppercase(); if !name.starts_with(['_', '.', '-']) && sysvars::get(self, &var).is_some() { @@ -943,8 +966,18 @@ impl Session { } /// Give an input to the running command. With no command running, `Enter` repeats the last - /// command (as in AutoCAD) and points do nothing. + /// command (as in AutoCAD) and points do nothing. A LISP routine waiting in a `get…` + /// function takes the input instead; one paused in `command` carries on after it. pub fn input(&mut self, input: Input) -> Result<()> { + if self.lisp_input(input.clone()) { + return Ok(()); + } + let r = self.input_to_command(input); + self.lisp_after_command_input(); + r + } + + fn input_to_command(&mut self, input: Input) -> Result<()> { if self.running.is_none() { if input == Input::Enter && let Some(last) = self.last_command.clone() @@ -1181,8 +1214,9 @@ impl Session { self.echo(m); } self.after_command(Some(&run.before), None, true); - if self.suspended.is_some() { - // A transparent command's changes belong to the undo step of the command it ran inside. + // A transparent command's changes belong to the command it ran inside, and a command a + // LISP routine ran belongs to the routine's single undo step. + if self.suspended.is_some() || self.lisp_groups_undo() { if let Ok(st) = self.state_mut() && !Arc::ptr_eq(&run.before, &st.doc) { @@ -1223,6 +1257,15 @@ impl Session { /// transparent command, cancels it and the command it interrupted. pub fn cancel(&mut self) { self.point_mods.clear(); + // Esc stops a LISP routine waiting for input, and the command it paused in. + if self.lisp_waiting() { + if self.running.is_some() { + let _ = self.feed(Some(Input::Cancel)); + } + self.echo("*Cancel*"); + self.lisp_abort("Function cancelled"); + return; + } if self.running.is_some() { if self.suspended.is_some() { if let Some(nested) = self.running.take() { @@ -1238,6 +1281,9 @@ impl Session { } pub fn current_prompt(&self) -> Option { + if let Some(p) = self.lisp_prompt() { + return Some(p); + } self.running.as_ref().map(|r| { let p = r.machine.prompt(self); match &self.select_mode { @@ -1259,6 +1305,9 @@ impl Session { /// The text shown on the command line: the active prompt, or "Command:". pub fn prompt_text(&self) -> String { + if let Some(p) = self.lisp_prompt() { + return p.display(); + } match &self.running { Some(r) if self.suspended.is_some() => format!(">>{} {}", r.id.to_ascii_uppercase(), r.machine.prompt(self).display()), Some(r) => format!("{} {}", r.id.to_ascii_uppercase(), r.machine.prompt(self).display()), @@ -1268,9 +1317,13 @@ impl Session { /// Rubber-band preview entities for the cursor. pub fn preview(&self, cursor: Vec2) -> Vec { - let Some(r) = &self.running else { return Vec::new() }; let common = self.current_common(); - r.machine.preview(self, cursor).into_iter().map(|k| Entity { handle: Handle(0), common: common.clone(), kind: k }).collect() + let kinds = match (self.lisp_preview(cursor), &self.running) { + (Some(k), _) => k, + (None, Some(r)) => r.machine.preview(self, cursor), + (None, None) => Vec::new(), + }; + kinds.into_iter().map(|k| Entity { handle: Handle(0), common: common.clone(), kind: k }).collect() } /// The active command's preview as a transform of existing objects (see @@ -1328,14 +1381,17 @@ impl Session { return self.typed(rest); } first = false; - let (tok, more) = match rest.split_once([' ', '\t']) { - Some((tok, more)) => (tok, Some(more)), - None => (rest, None), - }; - if self.running.is_some() { + let (tok, more) = next_token(rest); + if self.running.is_some() || self.lisp_prompt().is_some() { self.typed(tok)?; } else if tok.trim().is_empty() { self.input(Input::Enter)?; + } else if lisp_expression(tok) { + // `(expression)` or `!variable` at Command: evaluates LISP and shows the value. + let src = tok.trim().strip_prefix('!').unwrap_or(tok.trim()).to_string(); + if let Err(e) = self.lisp_eval(&src, true, false, Vec::new()) { + self.echo(e.to_string()); + } } else { self.start(tok)?; } @@ -1361,11 +1417,40 @@ impl Session { if tt.starts_with('\'') { return self.start(tt); } + // A LISP expression typed at a command's prompt: its value is the answer. + // Not at a free-text prompt: there the text is the answer (CAL takes "(3+4)*2"). + if lisp_expression(tt) && !prompt.accept.text && self.lisp_prompt().is_none() && !self.lisp_groups_undo() { + let src = tt.strip_prefix('!').unwrap_or(tt).to_string(); + let v = match self.lisp_eval(&src, false, true, Vec::new()) { + Ok(Some(Ok(v))) => v, + Ok(_) => return Ok(()), + Err(e) => { + self.echo(e.to_string()); + return Ok(()); + } + }; + return match v { + lisp::value::Value::Nil => Ok(()), + lisp::value::Value::Int(i) => self.typed(&i.to_string()), + lisp::value::Value::Real(r) => self.typed(&format!("{r}")), + lisp::value::Value::Str(s) => self.typed(&s), + other => match other.as_point() { + Some(p) => self.input(Input::Point(Vec2::new(p[0], p[1]))), + None => { + self.echo(format!("Invalid input: {}", lisp::value::to_text(&other, true))); + Ok(()) + } + }, + }; + } // At "Select objects" prompts the selection modes (Previous, Last, ALL) win over a command // keyword sharing the letter (HATCH's "picK internal point" against `P`). let selection_mode = prompt.accept.select && matches!(tt.to_ascii_lowercase().as_str(), "all" | "l" | "last" | "p" | "previous"); + // A leading underscore asks for a keyword by its English name, whatever the interface + // language (`_M`, `_Yes`): scripts and LISP routines write them that way. (Snap + // overrides such as `_cen` were taken above.) if !selection_mode - && let Some(k) = prompt.match_keyword(tt) + && let Some(k) = prompt.match_keyword(tt).or_else(|| tt.strip_prefix('_').and_then(|r| prompt.match_keyword(r))) && !(prompt.accept.number && tt.parse::().is_ok()) { return self.input(Input::Keyword(k)); @@ -1576,5 +1661,51 @@ impl Session { } } +/// Typed text that is LISP: `(expression)` or `!variable`. +fn lisp_expression(t: &str) -> bool { + let t = t.trim(); + t.starts_with('(') || (t.starts_with('!') && t.len() > 1) +} + +/// The next command-line input in `rest` and what follows it: up to a space or tab, except that +/// a LISP expression runs to its closing parenthesis (spaces and quoted strings inside it). +fn next_token(rest: &str) -> (&str, Option<&str>) { + let lead = rest.len() - rest.trim_start_matches('!').len(); + if rest.get(lead..).is_some_and(|r| r.starts_with('(')) { + let (mut depth, mut in_str, mut escaped) = (0i32, false, false); + for (i, c) in rest.char_indices().skip(lead) { + if in_str { + match (escaped, c) { + (true, _) => escaped = false, + (false, '\\') => escaped = true, + (false, '"') => in_str = false, + _ => {} + } + continue; + } + match c { + '"' => in_str = true, + '(' => depth += 1, + ')' => { + depth -= 1; + if depth == 0 { + let end = i + 1; + // As after any input, a space ends it and a trailing one is Enter. + let more = rest.get(end..).filter(|m| !m.is_empty()).map(|m| m.strip_prefix([' ', '\t']).unwrap_or(m)); + return (&rest[..end], more); + } + } + _ => {} + } + } + // Unbalanced: all of it (the reader reports the error). + return (rest, None); + } + match rest.split_once([' ', '\t']) { + Some((tok, more)) => (tok, Some(more)), + None => (rest, None), + } +} + #[cfg(test)] mod tests; diff --git a/crates/engine/src/lisp/builtins.rs b/crates/engine/src/lisp/builtins.rs new file mode 100644 index 0000000..f553514 --- /dev/null +++ b/crates/engine/src/lisp/builtins.rs @@ -0,0 +1,1486 @@ +//! The built-in functions: special forms, numbers, lists, strings, geometry, output, files and +//! the functions that call functions (`apply`, `mapcar`, `eval`, `load`, `vl-sort`…). Drawing +//! access (`command`, `entget`, `ssget`, `getvar`…) is in `drawing.rs`, user input in `input.rs`. +//! +//! Errors use AutoLISP's wording (`bad argument type: numberp: nil`, `too few arguments`, +//! `divide by zero`), since routines and their `*error*` handlers match on it. + +use std::sync::Arc; + +use super::eval::{Ctx, Flow, Special}; +use super::value::{Builtin, BuiltinKind, Sym, Value, charge_bytes, check_string_len, eq, equal, real_text, to_text}; +use super::{Env, LispError, drawing, input, read}; + +type R = Result; + +/// `too few arguments` / `too many arguments`. +pub fn args_err(few: bool) -> LispError { + LispError::new(if few { "too few arguments" } else { "too many arguments" }) +} + +fn arity(a: &[Value], min: usize, max: usize) -> Result<(), LispError> { + if a.len() < min { + return Err(args_err(true)); + } + if a.len() > max { + return Err(args_err(false)); + } + Ok(()) +} + +fn num(v: &Value) -> Result { + v.as_number().ok_or_else(|| LispError::bad_arg("numberp", v)) +} + +fn int(v: &Value) -> Result { + match v { + Value::Int(i) => Ok(*i), + other => Err(LispError::bad_arg("fixnump", other)), + } +} + +fn string(v: &Value) -> Result, LispError> { + match v { + Value::Str(s) => Ok(s.clone()), + other => Err(LispError::bad_arg("stringp", other)), + } +} + +fn list_arg(v: &Value) -> Result, LispError> { + if v.is_list() { Ok(v.to_vec()) } else { Err(LispError::bad_arg("listp", v)) } +} + +fn point(v: &Value) -> Result<[f64; 3], LispError> { + v.as_point().ok_or_else(|| LispError::bad_arg("2D/3D point", v)) +} + +fn real_or_int(r: f64, all_int: bool) -> Value { + if all_int { Value::Int(r as i32) } else { Value::Real(r) } +} + +// ---------------- numbers ---------------- + +/// Integer arithmetic wraps at 32 bits, as AutoLISP's does; any real makes the result real. +fn arith(a: &[Value], op: char) -> R { + let all_int = a.iter().all(|v| matches!(v, Value::Int(_))); + let mut it = a.iter(); + let Some(first) = it.next() else { + return Ok(Value::Int(if op == '*' { 1 } else { 0 })); + }; + if all_int { + let mut acc = int(first)?; + if a.len() == 1 { + return Ok(Value::Int(match op { + '-' => acc.wrapping_neg(), + _ => acc, + })); + } + for v in it { + let x = int(v)?; + acc = match op { + '+' => acc.wrapping_add(x), + '-' => acc.wrapping_sub(x), + '*' => acc.wrapping_mul(x), + _ => { + if x == 0 { + return Err(LispError::new("divide by zero")); + } + acc.wrapping_div(x) + } + }; + } + return Ok(Value::Int(acc)); + } + let mut acc = num(first)?; + if a.len() == 1 { + return Ok(Value::Real(if op == '-' { -acc } else { acc })); + } + for v in it { + let x = num(v)?; + acc = match op { + '+' => acc + x, + '-' => acc - x, + '*' => acc * x, + _ => { + if x == 0.0 { + return Err(LispError::new("divide by zero")); + } + acc / x + } + }; + } + Ok(Value::Real(acc)) +} + +fn add(a: &[Value]) -> R { + arith(a, '+') +} +fn sub(a: &[Value]) -> R { + arith(a, '-') +} +fn mul(a: &[Value]) -> R { + arith(a, '*') +} +fn div(a: &[Value]) -> R { + arity(a, 1, usize::MAX)?; + arith(a, '/') +} + +fn rem(a: &[Value]) -> R { + arity(a, 1, usize::MAX)?; + if a.iter().all(|v| matches!(v, Value::Int(_))) { + let mut it = a.iter(); + let mut acc = int(it.next().unwrap_or(&Value::Int(0)))?; + for v in it { + let x = int(v)?; + if x == 0 { + return Err(LispError::new("divide by zero")); + } + acc = acc.wrapping_rem(x); + } + return Ok(Value::Int(acc)); + } + let mut it = a.iter(); + let mut acc = num(it.next().unwrap_or(&Value::Int(0)))?; + for v in it { + let x = num(v)?; + if x == 0.0 { + return Err(LispError::new("divide by zero")); + } + acc %= x; + } + Ok(Value::Real(acc)) +} + +fn one_plus(a: &[Value]) -> R { + arity(a, 1, 1)?; + arith(&[a[0].clone(), Value::Int(1)], '+') +} +fn one_minus(a: &[Value]) -> R { + arity(a, 1, 1)?; + arith(&[a[0].clone(), Value::Int(1)], '-') +} + +fn abs(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(match &a[0] { + Value::Int(i) => Value::Int(i.wrapping_abs()), + v => Value::Real(num(v)?.abs()), + }) +} + +fn min_max(a: &[Value], max: bool) -> R { + arity(a, 1, usize::MAX)?; + let all_int = a.iter().all(|v| matches!(v, Value::Int(_))); + let mut best = num(&a[0])?; + for v in &a[1..] { + let x = num(v)?; + if (max && x > best) || (!max && x < best) { + best = x; + } + } + Ok(real_or_int(best, all_int)) +} +fn min(a: &[Value]) -> R { + min_max(a, false) +} +fn max(a: &[Value]) -> R { + min_max(a, true) +} + +fn unary(a: &[Value], f: fn(f64) -> f64) -> R { + arity(a, 1, 1)?; + let r = f(num(&a[0])?); + if r.is_finite() { Ok(Value::Real(r)) } else { Err(LispError::new("function undefined for argument")) } +} +fn sqrt(a: &[Value]) -> R { + if num(a.first().unwrap_or(&Value::Nil))? < 0.0 { + return Err(LispError::new("function undefined for argument")); + } + unary(a, f64::sqrt) +} +fn exp(a: &[Value]) -> R { + unary(a, f64::exp) +} +fn log(a: &[Value]) -> R { + if num(a.first().unwrap_or(&Value::Nil))? <= 0.0 { + return Err(LispError::new("function undefined for argument")); + } + unary(a, f64::ln) +} +fn sin(a: &[Value]) -> R { + unary(a, f64::sin) +} +fn cos(a: &[Value]) -> R { + unary(a, f64::cos) +} +fn atan(a: &[Value]) -> R { + arity(a, 1, 2)?; + let y = num(&a[0])?; + Ok(Value::Real(match a.get(1) { + Some(x) => y.atan2(num(x)?), + None => y.atan(), + })) +} + +fn expt(a: &[Value]) -> R { + arity(a, 2, 2)?; + match (&a[0], &a[1]) { + (Value::Int(b), Value::Int(e)) if *e >= 0 => Ok(Value::Int(b.wrapping_pow(u32::try_from(*e).unwrap_or(0)))), + (b, e) => { + let r = num(b)?.powf(num(e)?); + if r.is_finite() { Ok(Value::Real(r)) } else { Err(LispError::new("function undefined for argument")) } + } + } +} + +fn fix(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(match &a[0] { + Value::Int(i) => Value::Int(*i), + v => { + let r = num(v)?.trunc(); + if r.is_finite() && r >= f64::from(i32::MIN) && r <= f64::from(i32::MAX) { Value::Int(r as i32) } else { Value::Real(r) } + } + }) +} + +fn float(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::Real(num(&a[0])?)) +} + +fn gcd(a: &[Value]) -> R { + arity(a, 2, 2)?; + let (mut x, mut y) = (i64::from(int(&a[0])?).abs(), i64::from(int(&a[1])?).abs()); + if x == 0 && y == 0 { + return Err(LispError::new("bad argument value: 0")); + } + while y != 0 { + let t = x % y; + x = y; + y = t; + } + Ok(Value::Int(i32::try_from(x).unwrap_or(i32::MAX))) +} + +fn logand(a: &[Value]) -> R { + a.iter().try_fold(-1i32, |acc, v| Ok(acc & int(v)?)).map(|r| Value::Int(if a.is_empty() { 0 } else { r })) +} +fn logior(a: &[Value]) -> R { + a.iter().try_fold(0i32, |acc, v| Ok(acc | int(v)?)).map(Value::Int) +} +fn lsh(a: &[Value]) -> R { + arity(a, 0, 2)?; + let x = a.first().map(int).transpose()?.unwrap_or(0); + let n = a.get(1).map(int).transpose()?.unwrap_or(0); + let r = if n >= 32 || n <= -32 { + 0 + } else if n >= 0 { + x.wrapping_shl(n as u32) + } else { + ((x as u32) >> ((-n) as u32)) as i32 + }; + Ok(Value::Int(r)) +} +fn lognot(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::Int(!int(&a[0])?)) +} + +/// Numbers compare by value; strings by text. +fn compare(a: &Value, b: &Value) -> Result { + match (a, b) { + (Value::Str(x), Value::Str(y)) => Ok(x.cmp(y)), + _ => num(a)?.partial_cmp(&num(b)?).ok_or_else(|| LispError::new("bad argument value")), + } +} + +fn chain(a: &[Value], ok: fn(std::cmp::Ordering) -> bool) -> R { + arity(a, 1, usize::MAX)?; + for w in a.windows(2) { + if let [x, y] = w + && !ok(compare(x, y)?) + { + return Ok(Value::Nil); + } + } + Ok(Value::t()) +} +fn num_eq(a: &[Value]) -> R { + chain(a, |o| o.is_eq()) +} +fn num_ne(a: &[Value]) -> R { + chain(a, |o| o.is_ne()) +} +fn lt(a: &[Value]) -> R { + chain(a, |o| o.is_lt()) +} +fn gt(a: &[Value]) -> R { + chain(a, |o| o.is_gt()) +} +fn le(a: &[Value]) -> R { + chain(a, |o| o.is_le()) +} +fn ge(a: &[Value]) -> R { + chain(a, |o| o.is_ge()) +} + +fn zerop(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::bool(num(&a[0])? == 0.0)) +} +fn minusp(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::bool(num(&a[0])? < 0.0)) +} +fn numberp(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::bool(a[0].as_number().is_some())) +} + +// ---------------- predicates and lists ---------------- + +fn atom(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::bool(!matches!(a[0], Value::Cons(_)))) +} +fn listp(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::bool(matches!(a[0], Value::Cons(_) | Value::Nil))) +} +fn consp(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::bool(matches!(a[0], Value::Cons(_)))) +} +fn null(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::bool(a[0].is_nil())) +} +fn type_of(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(a[0].type_name().map(Value::sym).unwrap_or_default()) +} +fn eq_fn(a: &[Value]) -> R { + arity(a, 2, 2)?; + Ok(Value::bool(eq(&a[0], &a[1]))) +} +fn equal_fn(a: &[Value]) -> R { + arity(a, 2, 3)?; + let fuzz = a.get(2).map(num).transpose()?.unwrap_or(0.0); + Ok(Value::bool(equal(&a[0], &a[1], fuzz))) +} + +fn cxr(a: &[Value], path: &str) -> R { + arity(a, 1, 1)?; + let mut v = a[0].clone(); + // The path is read right to left: cadr = car of cdr. + for c in path.chars().rev() { + if !matches!(v, Value::Cons(_) | Value::Nil) { + return Err(LispError::bad_arg("consp", &v)); + } + v = if c == 'a' { v.car() } else { v.cdr() }; + } + Ok(v) +} + +macro_rules! cxrs { + ($($name:ident $path:literal),*) => { + $(fn $name(a: &[Value]) -> R { cxr(a, $path) })* + }; +} +cxrs!(car "a", cdr "d", caar "aa", cadr "ad", cdar "da", cddr "dd", caaar "aaa", caadr "aad", cadar "ada", caddr "add", + cdaar "daa", cdadr "dad", cddar "dda", cdddr "ddd", cadddr "addd", cddddr "dddd"); + +fn cons(a: &[Value]) -> R { + arity(a, 2, 2)?; + Ok(Value::cons(a[0].clone(), a[1].clone())) +} +fn list(a: &[Value]) -> R { + Ok(Value::list(a.to_vec())) +} +fn append(a: &[Value]) -> R { + let mut items = Vec::new(); + for v in a { + items.extend(list_arg(v)?); + } + Ok(Value::list(items)) +} +fn reverse(a: &[Value]) -> R { + arity(a, 1, 1)?; + let mut v = list_arg(&a[0])?; + v.reverse(); + Ok(Value::list(v)) +} +fn length(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::Int(i32::try_from(list_arg(&a[0])?.len()).unwrap_or(i32::MAX))) +} +fn nth(a: &[Value]) -> R { + arity(a, 2, 2)?; + let n = int(&a[0])?; + if n < 0 { + return Ok(Value::Nil); + } + Ok(a[1].iter().nth(n as usize).unwrap_or_default()) +} +fn last(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(list_arg(&a[0])?.pop().unwrap_or_default()) +} +fn member(a: &[Value]) -> R { + arity(a, 2, 2)?; + let mut v = a[1].clone(); + while let Value::Cons(c) = &v { + if equal(&c.car, &a[0], 0.0) { + return Ok(v); + } + let next = c.cdr.clone(); + v = next; + } + Ok(Value::Nil) +} +fn assoc(a: &[Value]) -> R { + arity(a, 2, 2)?; + Ok(a[1].iter().find(|item| matches!(item, Value::Cons(_)) && equal(&item.car(), &a[0], 0.0)).unwrap_or_default()) +} +fn subst(a: &[Value]) -> R { + arity(a, 3, 3)?; + let (new, old) = (&a[0], &a[1]); + if !a[2].is_list() { + return Ok(if equal(&a[2], old, 0.0) { new.clone() } else { a[2].clone() }); + } + Ok(Value::list(a[2].iter().map(|v| if equal(&v, old, 0.0) { new.clone() } else { v }).collect::>())) +} +fn vl_position(a: &[Value]) -> R { + arity(a, 2, 2)?; + Ok(a[1].iter().position(|v| equal(&v, &a[0], 0.0)).map(|i| Value::Int(i32::try_from(i).unwrap_or(i32::MAX))).unwrap_or_default()) +} +fn vl_remove(a: &[Value]) -> R { + arity(a, 2, 2)?; + Ok(Value::list(list_arg(&a[1])?.into_iter().filter(|v| !equal(v, &a[0], 0.0)).collect::>())) +} +fn vl_list_length(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(if a[0].is_list() { Value::Int(i32::try_from(a[0].to_vec().len()).unwrap_or(i32::MAX)) } else { Value::Nil }) +} +fn acad_strlsort(a: &[Value]) -> R { + arity(a, 1, 1)?; + let mut v = list_arg(&a[0])?.iter().map(string).collect::, _>>()?; + v.sort_by_key(|s| s.to_lowercase()); + Ok(Value::list(v.into_iter().map(Value::Str).collect::>())) +} + +// ---------------- strings ---------------- + +fn strcat(a: &[Value]) -> R { + let parts = a.iter().map(string).collect::, _>>()?; + // Check the length before joining: many long arguments could join to more than memory. + check_string_len(parts.iter().fold(0usize, |n, p| n.saturating_add(p.len())))?; + Ok(Value::str(&parts.concat())) +} +fn strlen(a: &[Value]) -> R { + let mut n = 0usize; + for v in a { + n += string(v)?.chars().count(); + } + Ok(Value::Int(i32::try_from(n).unwrap_or(i32::MAX))) +} +fn substr(a: &[Value]) -> R { + arity(a, 2, 3)?; + let s = string(&a[0])?; + let start = int(&a[1])?; + if start < 1 { + return Err(LispError::new(format!("bad argument value: positive {start}"))); + } + let chars = s.chars().skip(start as usize - 1); + let out: String = match a.get(2) { + Some(n) => { + let n = int(n)?; + if n < 0 { + return Err(LispError::new(format!("bad argument value: non-negative {n}"))); + } + chars.take(n as usize).collect() + } + None => chars.collect(), + }; + Ok(Value::str(&out)) +} +fn strcase(a: &[Value]) -> R { + arity(a, 1, 2)?; + let s = string(&a[0])?; + let lower = a.get(1).is_some_and(|v| !v.is_nil()); + Ok(Value::str(&if lower { s.to_lowercase() } else { s.to_uppercase() })) +} +fn itoa(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::str(&int(&a[0])?.to_string())) +} +/// C's `atoi`: leading blanks, a sign, digits; 0 when there are none. +fn atoi(a: &[Value]) -> R { + arity(a, 1, 1)?; + let s = string(&a[0])?; + let t = s.trim_start(); + let end = t.char_indices().take_while(|(i, c)| c.is_ascii_digit() || (*i == 0 && (*c == '-' || *c == '+'))).count(); + Ok(Value::Int(t.get(..end).and_then(|n| n.parse::().ok()).map(|n| n as i32).unwrap_or(0))) +} +/// C's `atof`: the longest number at the start; 0.0 when there is none. +fn atof(a: &[Value]) -> R { + arity(a, 1, 1)?; + let s = string(&a[0])?; + // The longest prefix (of the first 64 characters) that reads as a finite number. + let t: String = s.trim_start().chars().take(64).collect(); + let ends: Vec = t.char_indices().map(|(i, _)| i).skip(1).chain(std::iter::once(t.len())).collect(); + let v = ends.iter().rev().find_map(|&e| t.get(..e).and_then(|p| p.parse::().ok()).filter(|v| v.is_finite() && !p_is_word(&t[..e]))); + Ok(Value::Real(v.unwrap_or(0.0))) +} +/// Words Rust reads as numbers that C's `atof` doesn't ("inf", "nan", "infinity"). +fn p_is_word(p: &str) -> bool { + p.chars().any(|c| c.is_ascii_alphabetic() && !matches!(c, 'e' | 'E')) +} + +fn chr(a: &[Value]) -> R { + arity(a, 1, 1)?; + let c = u32::try_from(int(&a[0])?).ok().and_then(char::from_u32).map(String::from).unwrap_or_default(); + Ok(Value::str(&c)) +} +fn ascii(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::Int(string(&a[0])?.chars().next().map(|c| c as i32).unwrap_or(0))) +} +fn read_fn(a: &[Value]) -> R { + arity(a, 0, 1)?; + match a.first() { + None | Some(Value::Nil) => Ok(Value::Nil), + Some(v) => read::read_one(&string(v)?), + } +} +fn vl_prin1_to_string(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::str(&to_text(&a[0], true))) +} +fn vl_princ_to_string(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::str(&to_text(&a[0], false))) +} +fn vl_symbol_name(a: &[Value]) -> R { + arity(a, 1, 1)?; + match &a[0] { + Value::Sym(s) => Ok(Value::str(s.name())), + other => Err(LispError::bad_arg("symbolp", other)), + } +} +fn vl_symbolp(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::bool(matches!(a[0], Value::Sym(_)))) +} +fn vl_string_search(a: &[Value]) -> R { + arity(a, 2, 3)?; + let (pat, s) = (string(&a[0])?, string(&a[1])?); + let start = a.get(2).map(int).transpose()?.unwrap_or(0).max(0) as usize; + let chars: Vec = s.chars().collect(); + let tail: String = chars.iter().skip(start).collect(); + Ok(tail.find(&*pat).map(|b| Value::Int((start + tail[..b].chars().count()) as i32)).unwrap_or_default()) +} +fn vl_string_subst(a: &[Value]) -> R { + arity(a, 3, 4)?; + let (new, pat, s) = (string(&a[0])?, string(&a[1])?, string(&a[2])?); + let start = a.get(3).map(int).transpose()?.unwrap_or(0).max(0) as usize; + let byte_start = s.char_indices().nth(start).map(|(b, _)| b).unwrap_or(s.len()); + let out = match s.get(byte_start..).and_then(|t| t.find(&*pat)) { + Some(i) if !pat.is_empty() => format!("{}{}{}", &s[..byte_start + i], new, &s[byte_start + i + pat.len()..]), + _ => s.to_string(), + }; + Ok(Value::str(&out)) +} +fn trim_fn(a: &[Value], left: bool, right: bool) -> R { + arity(a, 2, 2)?; + let (set, s) = (string(&a[0])?, string(&a[1])?); + let is = |c: char| set.contains(c); + let mut t: &str = &s; + if left { + t = t.trim_start_matches(is); + } + if right { + t = t.trim_end_matches(is); + } + Ok(Value::str(t)) +} +fn vl_string_trim(a: &[Value]) -> R { + trim_fn(a, true, true) +} +fn vl_string_left_trim(a: &[Value]) -> R { + trim_fn(a, true, false) +} +fn vl_string_right_trim(a: &[Value]) -> R { + trim_fn(a, false, true) +} +fn vl_string_translate(a: &[Value]) -> R { + arity(a, 3, 3)?; + let (from, to, s) = (string(&a[0])?, string(&a[1])?, string(&a[2])?); + let to: Vec = to.chars().collect(); + let out: String = s.chars().map(|c| from.chars().position(|f| f == c).and_then(|i| to.get(i).or(to.last()).copied()).unwrap_or(c)).collect(); + Ok(Value::str(&out)) +} +fn vl_string_to_list(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::list(string(&a[0])?.chars().map(|c| Value::Int(c as i32)).collect::>())) +} +fn vl_list_to_string(a: &[Value]) -> R { + arity(a, 1, 1)?; + let mut s = String::new(); + for v in list_arg(&a[0])? { + s.extend(u32::try_from(int(&v)?).ok().and_then(char::from_u32)); + } + Ok(Value::str(&s)) +} +fn vl_filename_base(a: &[Value]) -> R { + arity(a, 1, 1)?; + let s = string(&a[0])?; + Ok(Value::str(std::path::Path::new(&*s.replace('\\', "/")).file_stem().and_then(|x| x.to_str()).unwrap_or(""))) +} +fn vl_filename_extension(a: &[Value]) -> R { + arity(a, 1, 1)?; + let s = string(&a[0])?; + Ok(std::path::Path::new(&*s.replace('\\', "/")).extension().and_then(|x| x.to_str()).map(|e| Value::str(&format!(".{e}"))).unwrap_or_default()) +} +fn vl_filename_directory(a: &[Value]) -> R { + arity(a, 1, 1)?; + let s = string(&a[0])?; + let cut = s.rfind(['/', '\\']).unwrap_or(0); + Ok(Value::str(&s[..cut])) +} + +/// `wcmatch`: `#` a digit, `@` a letter, `.` neither, `*` any run, `?` any character, `~` (first) +/// not, `[…]` a set (`[~…]` not in it, ranges `a-z`), `` ` `` the next character as is, `,` +/// between alternative patterns. Letters compare case-sensitively. +fn wcmatch(a: &[Value]) -> R { + arity(a, 2, 2)?; + let (s, pat) = (string(&a[0])?, string(&a[1])?); + let text: Vec = s.chars().collect(); + Ok(Value::bool(split_patterns(&pat).iter().any(|p| match_pattern(&text, p)))) +} + +fn split_patterns(pat: &str) -> Vec> { + let mut out = vec![Vec::new()]; + let mut chars = pat.chars().peekable(); + let mut in_set = false; + while let Some(c) = chars.next() { + match c { + '`' => { + if let Some(cur) = out.last_mut() { + cur.push('`'); + cur.extend(chars.next()); + } + } + '[' => { + in_set = true; + if let Some(cur) = out.last_mut() { + cur.push(c); + } + } + ']' => { + in_set = false; + if let Some(cur) = out.last_mut() { + cur.push(c); + } + } + ',' if !in_set => out.push(Vec::new()), + c => { + if let Some(cur) = out.last_mut() { + cur.push(c); + } + } + } + } + out +} + +fn match_pattern(text: &[char], pat: &[char]) -> bool { + if let Some(('~', rest)) = pat.split_first().map(|(c, r)| (*c, r)) + && !rest.is_empty() + { + return !glob(text, rest, 0); + } + glob(text, pat, 0) +} + +/// Iterative-enough glob with `*` backtracking; `depth` bounds the recursion on `*`. +fn glob(text: &[char], pat: &[char], depth: usize) -> bool { + if depth > 64 { + return false; + } + let (mut t, mut p) = (0usize, 0usize); + while p < pat.len() { + match pat[p] { + '*' => { + let rest = &pat[p + 1..]; + return (t..=text.len()).any(|i| glob(&text[i..], rest, depth + 1)); + } + '`' => { + let Some(&lit) = pat.get(p + 1) else { return false }; + if text.get(t) != Some(&lit) { + return false; + } + t += 1; + p += 2; + } + '[' => { + let Some(close) = pat[p..].iter().position(|c| *c == ']').map(|i| p + i) else { return false }; + let Some(&c) = text.get(t) else { return false }; + let set = &pat[p + 1..close]; + let (neg, set) = match set.split_first() { + Some(('~', r)) if !r.is_empty() => (true, r), + _ => (false, set), + }; + let mut hit = false; + let mut i = 0; + while i < set.len() { + if set.get(i + 1) == Some(&'-') && i + 2 < set.len() { + if set[i] <= c && c <= set[i + 2] { + hit = true; + } + i += 3; + } else { + if set[i] == c { + hit = true; + } + i += 1; + } + } + if hit == neg { + return false; + } + t += 1; + p = close + 1; + } + pc => { + let Some(&c) = text.get(t) else { return false }; + let ok = match pc { + '#' => c.is_ascii_digit(), + '@' => c.is_alphabetic(), + '.' => !c.is_alphanumeric(), + '?' => true, + other => other == c, + }; + if !ok { + return false; + } + t += 1; + p += 1; + } + } + } + t == text.len() +} + +// ---------------- geometry ---------------- + +fn polar(a: &[Value]) -> R { + arity(a, 3, 3)?; + let p = point(&a[0])?; + let (ang, d) = (num(&a[1])?, num(&a[2])?); + let out = [p[0] + d * ang.cos(), p[1] + d * ang.sin(), p[2]]; + Ok(if a[0].iter().count() == 2 { Value::point(&out[..2]) } else { Value::point(&out) }) +} +fn distance(a: &[Value]) -> R { + arity(a, 2, 2)?; + let (p, q) = (point(&a[0])?, point(&a[1])?); + // Two 2D points, or one: a 2D distance. + let dz = if a[0].iter().count() == 2 || a[1].iter().count() == 2 { 0.0 } else { q[2] - p[2] }; + Ok(Value::Real(((q[0] - p[0]).powi(2) + (q[1] - p[1]).powi(2) + dz * dz).sqrt())) +} +fn angle(a: &[Value]) -> R { + arity(a, 2, 2)?; + let (p, q) = (point(&a[0])?, point(&a[1])?); + Ok(Value::Real((q[1] - p[1]).atan2(q[0] - p[0]).rem_euclid(std::f64::consts::TAU))) +} +/// `(inters p1 p2 p3 p4 [onseg])`: where lines p1-p2 and p3-p4 cross; with `onseg` (the default) +/// only within both segments. +fn inters(a: &[Value]) -> R { + arity(a, 4, 5)?; + let (p1, p2, p3, p4) = (point(&a[0])?, point(&a[1])?, point(&a[2])?, point(&a[3])?); + let onseg = a.get(4).is_none_or(|v| !v.is_nil()); + let (d1x, d1y, d2x, d2y) = (p2[0] - p1[0], p2[1] - p1[1], p4[0] - p3[0], p4[1] - p3[1]); + let den = d1x * d2y - d1y * d2x; + if den.abs() < 1e-12 { + return Ok(Value::Nil); + } + let t = ((p3[0] - p1[0]) * d2y - (p3[1] - p1[1]) * d2x) / den; + let u = ((p3[0] - p1[0]) * d1y - (p3[1] - p1[1]) * d1x) / den; + let eps = 1e-10; + if onseg && (t < -eps || t > 1.0 + eps || u < -eps || u > 1.0 + eps) { + return Ok(Value::Nil); + } + let z = p1[2] + t * (p2[2] - p1[2]); + let x = [p1[0] + t * d1x, p1[1] + t * d1y, z]; + let two_d = a.iter().take(4).any(|p| p.iter().count() == 2); + Ok(if two_d { Value::point(&x[..2]) } else { Value::point(&x) }) +} + +// ---------------- output ---------------- + +/// Text printed to a file (an open file argument) or the command line. +fn emit(ctx: &mut Ctx<'_>, text: &str, file: Option<&Value>) -> Result<(), LispError> { + charge_bytes(text.len())?; + match file { + None | Some(Value::Nil) => { + ctx.env.print(text); + Ok(()) + } + Some(Value::File(id)) => match ctx.env.files.get_mut(id) { + Some(f) if f.writing => { + f.text.push_str(text); + Ok(()) + } + _ => Err(LispError::bad_arg("streamp", &Value::File(*id))), + }, + Some(other) => Err(LispError::bad_arg("streamp", other)), + } +} + +/// `(princ)` with no argument: a symbol that prints as nothing, ending a routine quietly. +pub fn null_symbol() -> Value { + Value::Sym(Sym(Arc::from(""))) +} +pub fn is_null_symbol(v: &Value) -> bool { + matches!(v, Value::Sym(s) if s.name().is_empty()) +} + +fn princ(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 0, 2)?; + let Some(v) = a.first() else { return Ok(Flow::Value(null_symbol())) }; + emit(ctx, &to_text(v, false), a.get(1))?; + Ok(Flow::Value(v.clone())) +} +fn prin1(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 0, 2)?; + let Some(v) = a.first() else { return Ok(Flow::Value(null_symbol())) }; + emit(ctx, &to_text(v, true), a.get(1))?; + Ok(Flow::Value(v.clone())) +} +fn print(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 0, 2)?; + let Some(v) = a.first() else { return Ok(Flow::Value(null_symbol())) }; + emit(ctx, &format!("\n{} ", to_text(v, true)), a.get(1))?; + Ok(Flow::Value(v.clone())) +} +fn prompt(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + let text = string(&a[0])?; + charge_bytes(text.len())?; + ctx.env.print(&text); + Ok(Flow::Value(Value::Nil)) +} +fn terpri(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 0, 1)?; + emit(ctx, "\n", a.first())?; + Ok(Flow::Value(Value::Nil)) +} +fn alert(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + // No dialog from LISP: the message goes to the command line. + let msg = string(&a[0])?; + charge_bytes(msg.len())?; + let out = std::mem::take(&mut ctx.env.out); + if !out.is_empty() { + ctx.s.echo(out); + } + for l in msg.lines() { + ctx.s.echo(l.to_string()); + } + Ok(Flow::Value(Value::Nil)) +} + +// ---------------- files ---------------- + +/// A file opened by `open`: read files are read whole; written ones are written at `close`. +pub struct LispFile { + pub path: String, + pub writing: bool, + pub append: bool, + pub lines: std::collections::VecDeque, + pub text: String, +} + +fn open(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 3)?; + let path = string(&a[0])?.to_string(); + let mode = string(&a[1])?.to_ascii_lowercase(); + let (writing, append) = match mode.as_str() { + "r" => (false, false), + "w" => (true, false), + "a" => (true, true), + _ => return Err(LispError::new(format!("bad argument value: file mode {mode}"))), + }; + let mut f = LispFile { path: path.clone(), writing, append, lines: Default::default(), text: String::new() }; + if !writing { + match read_text_file(&path) { + Some(t) => { + charge_bytes(t.len())?; + f.lines = t.lines().map(str::to_string).collect(); + } + None => return Ok(Flow::Value(Value::Nil)), + } + } else if !can_write(&path) { + return Ok(Flow::Value(Value::Nil)); + } + let id = ctx.env.next_file; + ctx.env.next_file = ctx.env.next_file.wrapping_add(1); + ctx.env.files.insert(id, f); + Ok(Flow::Value(Value::File(id))) +} + +fn close(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + let Value::File(id) = a[0] else { return Err(LispError::bad_arg("streamp", &a[0])) }; + let Some(f) = ctx.env.files.remove(&id) else { return Err(LispError::bad_arg("streamp", &a[0])) }; + if f.writing { + write_text_file(&f.path, &f.text, f.append); + } + Ok(Flow::Value(Value::Nil)) +} + +fn read_line(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 0, 1)?; + let Some(Value::File(id)) = a.first() else { return Ok(Flow::Value(Value::Nil)) }; + let line = ctx.env.files.get_mut(id).filter(|f| !f.writing).and_then(|f| f.lines.pop_front()); + Ok(Flow::Value(line.map(|l| Value::str(&l)).unwrap_or_default())) +} + +fn write_line(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 2)?; + let s = string(&a[0])?; + emit(ctx, &format!("{s}\n"), a.get(1))?; + Ok(Flow::Value(Value::Str(s))) +} + +fn findfile(a: &[Value]) -> R { + arity(a, 1, 1)?; + let p = string(&a[0])?; + Ok(if file_exists(&p) { Value::Str(p) } else { Value::Nil }) +} + +#[cfg(not(target_arch = "wasm32"))] +pub fn read_text_file(path: &str) -> Option { + let bytes = std::fs::read(path).ok()?; + // Cap what a routine can pull into memory. + if bytes.len() > 64 * 1024 * 1024 { + return None; + } + Some(String::from_utf8_lossy(&bytes).into_owned()) +} +#[cfg(target_arch = "wasm32")] +pub fn read_text_file(_path: &str) -> Option { + None +} +#[cfg(not(target_arch = "wasm32"))] +fn can_write(path: &str) -> bool { + std::path::Path::new(path).parent().is_none_or(|d| d.as_os_str().is_empty() || d.exists()) +} +#[cfg(target_arch = "wasm32")] +fn can_write(_path: &str) -> bool { + false +} +#[cfg(not(target_arch = "wasm32"))] +fn write_text_file(path: &str, text: &str, append: bool) { + use std::io::Write; + let f = std::fs::OpenOptions::new().create(true).write(true).append(append).truncate(!append).open(path); + if let Ok(mut f) = f { + let _ = f.write_all(text.as_bytes()); + } +} +#[cfg(target_arch = "wasm32")] +fn write_text_file(_path: &str, _text: &str, _append: bool) {} +#[cfg(not(target_arch = "wasm32"))] +fn file_exists(path: &str) -> bool { + std::path::Path::new(path).is_file() +} +#[cfg(target_arch = "wasm32")] +fn file_exists(_path: &str) -> bool { + false +} + +// ---------------- functions of functions ---------------- + +/// A function argument: a function, or a symbol naming one (`'car`, `'1+`). +fn callable(ctx: &Ctx<'_>, f: &Value) -> Result { + match f { + Value::Sym(s) => { + let v = super::eval::lookup(ctx.env, s); + if matches!(v, Value::Subr(_) | Value::Func(_)) { Ok(v) } else { Err(LispError::new(format!("no function definition: {}", s.name()))) } + } + Value::Subr(_) | Value::Func(_) => Ok(f.clone()), + // A quoted lambda expression: '(lambda (x) …). + Value::Cons(c) if c.car.as_sym().is_some_and(|s| s.name() == "LAMBDA") => { + let def = c.cdr.clone(); + let arglist = def.car(); + if !arglist.is_list() { + return Err(LispError::bad_arg("listp", &arglist)); + } + let (mut params, mut locals, mut slash) = (Vec::new(), Vec::new(), false); + for p in arglist.iter() { + let Value::Sym(s) = p else { return Err(LispError::bad_arg("symbolp", &p)) }; + if s.name() == "/" { + slash = true; + } else if slash { + locals.push(s); + } else { + params.push(s); + } + } + Ok(Value::Func(Arc::new(super::value::Func { name: None, params, locals, body: def.cdr() }))) + } + other => Err(LispError::new(format!("bad function: {}", to_text(other, true)))), + } +} + +fn apply(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 2)?; + let f = callable(ctx, &a[0])?; + Ok(Flow::Call(f, list_arg(&a[1])?)) +} + +fn mapcar(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, usize::MAX)?; + let f = callable(ctx, &a[0])?; + for l in &a[1..] { + list_arg(l)?; + } + Ok(Flow::Map(f, a[1..].to_vec())) +} + +fn eval_fn(_ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + Ok(Flow::Eval(a[0].clone())) +} + +fn set(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 2)?; + let Value::Sym(s) = &a[0] else { return Err(LispError::bad_arg("symbolp", &a[0])) }; + ctx.env.set(s, a[1].clone()); + Ok(Flow::Value(a[1].clone())) +} + +fn boundp(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + let Value::Sym(s) = &a[0] else { return Err(LispError::bad_arg("symbolp", &a[0])) }; + Ok(Flow::Value(Value::bool(ctx.env.globals.contains_key(s)))) +} + +fn vl_symbol_value(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + let Value::Sym(s) = &a[0] else { return Err(LispError::bad_arg("symbolp", &a[0])) }; + Ok(Flow::Value(super::eval::lookup(ctx.env, s))) +} + +fn vl_sort(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 2)?; + let f = callable(ctx, &a[1])?; + let mut items = list_arg(&a[0])?; + // A merge sort that calls back into LISP for each comparison. + let mut err = None; + merge_sort(&mut items, &mut |x, y| { + if err.is_some() { + return false; + } + match ctx.call_sync(&f, vec![x.clone(), y.clone()]) { + Ok(v) => !v.is_nil(), + Err(e) => { + err = Some(e); + false + } + } + }); + if let Some(e) = err { + return Err(e); + } + Ok(Flow::Value(Value::list(items))) +} + +/// A stable sort with a fallible-free comparison (`less`). +fn merge_sort(v: &mut Vec, less: &mut dyn FnMut(&Value, &Value) -> bool) { + if v.len() <= 1 { + return; + } + let mut right = v.split_off(v.len() / 2); + merge_sort(v, less); + merge_sort(&mut right, less); + let left = std::mem::take(v); + let (mut l, mut r) = (left.into_iter().peekable(), right.into_iter().peekable()); + while let (Some(x), Some(y)) = (l.peek(), r.peek()) { + if less(y, x) { + v.extend(r.next()); + } else { + v.extend(l.next()); + } + } + v.extend(l); + v.extend(r); +} + +fn filter(ctx: &mut Ctx<'_>, a: Vec, keep_true: bool) -> Result { + arity(&a, 2, 2)?; + let f = callable(ctx, &a[0])?; + let mut out = Vec::new(); + for v in list_arg(&a[1])? { + let r = ctx.call_sync(&f, vec![v.clone()])?; + if r.is_nil() != keep_true { + out.push(v); + } + } + Ok(Flow::Value(Value::list(out))) +} +fn vl_remove_if(ctx: &mut Ctx<'_>, a: Vec) -> Result { + filter(ctx, a, false) +} +fn vl_remove_if_not(ctx: &mut Ctx<'_>, a: Vec) -> Result { + filter(ctx, a, true) +} +fn vl_member_if(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 2)?; + let f = callable(ctx, &a[0])?; + let mut v = a[1].clone(); + while let Value::Cons(c) = v.clone() { + if !ctx.call_sync(&f, vec![c.car.clone()])?.is_nil() { + return Ok(Flow::Value(v)); + } + v = c.cdr.clone(); + } + Ok(Flow::Value(Value::Nil)) +} +fn every_some(ctx: &mut Ctx<'_>, a: Vec, every: bool) -> Result { + arity(&a, 2, usize::MAX)?; + let f = callable(ctx, &a[0])?; + let mut lists: Vec = a[1..].to_vec(); + loop { + if lists.iter().any(|l| !matches!(l, Value::Cons(_))) { + return Ok(Flow::Value(Value::bool(every))); + } + let r = ctx.call_sync(&f, lists.iter().map(Value::car).collect())?; + if every && r.is_nil() { + return Ok(Flow::Value(Value::Nil)); + } + if !every && !r.is_nil() { + return Ok(Flow::Value(r)); + } + lists = lists.iter().map(Value::cdr).collect(); + } +} +fn vl_every(ctx: &mut Ctx<'_>, a: Vec) -> Result { + every_some(ctx, a, true) +} +fn vl_some(ctx: &mut Ctx<'_>, a: Vec) -> Result { + every_some(ctx, a, false) +} + +/// The value `vl-catch-all-apply` returns for an error. +pub fn catch_all_error(msg: &str) -> Value { + Value::cons(Value::sym("*VL-CATCH-ALL-APPLY-ERROR*"), Value::str(msg)) +} +fn catch_all_message(v: &Value) -> Option { + (v.car().as_sym().is_some_and(|s| s.name() == "*VL-CATCH-ALL-APPLY-ERROR*")).then(|| v.cdr()) +} +fn vl_catch_all_apply(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 2)?; + let f = callable(ctx, &a[0])?; + Ok(Flow::Catch(f, list_arg(&a[1])?)) +} +fn vl_catch_all_error_p(a: &[Value]) -> R { + arity(a, 1, 1)?; + Ok(Value::bool(catch_all_message(&a[0]).is_some())) +} +fn vl_catch_all_error_message(a: &[Value]) -> R { + arity(a, 1, 1)?; + catch_all_message(&a[0]).ok_or_else(|| LispError::bad_arg("vl-catch-all-apply-error-p", &a[0])) +} + +fn exit(_ctx: &mut Ctx<'_>, _a: Vec) -> Result { + Err(LispError::quit("quit / exit abort")) +} + +/// `(load file [onfailure])`: evaluate a file's forms; its last value is the result. +fn load(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 2)?; + let name = string(&a[0])?.to_string(); + let text = super::load_source(ctx.s, &name); + match text { + Some(t) => Ok(Flow::Forms(read::read_all(&t)?)), + None => match a.get(1) { + Some(v) => Ok(Flow::Value(v.clone())), + None => Err(LispError::new(format!("LOAD failed: \"{name}\""))), + }, + } +} + +/// `(autoload file '("CMD" …))`: each command loads `file` the first time it is typed, then runs +/// the definition the file gave it. Startup files register commands this way without loading +/// every routine up front. +fn autoload(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 2)?; + let file = string(&a[0])?; + for cmd in list_arg(&a[1])? { + let name = string(&cmd)?.to_ascii_uppercase(); + if name.is_empty() || !name.chars().all(|c| c.is_ascii_alphanumeric() || matches!(c, '_' | '-')) { + return Err(LispError::bad_arg("command name", &cmd)); + } + // The stub forgets itself, loads the file and calls what it defined. + let file_lit = to_text(&Value::Str(file.clone()), true); + let src = format!( + "(lambda () (setq C:{name} nil) (load {file_lit}) (if C:{name} (C:{name}) (princ \"\\n; error: {} did not define {name}\")) (princ))", + file.replace(['"', '\\'], "/") + ); + let stub = callable(ctx, &read::read_one(&src)?)?; + ctx.env.set(&Sym::new(&format!("C:{name}")), stub); + } + Ok(Flow::Value(Value::Nil)) +} + +fn noop(_a: &[Value]) -> R { + Ok(Value::Nil) +} +fn ver(_a: &[Value]) -> R { + Ok(Value::str("Visual LISP 2026 (en)")) +} + +// ---------------- the table ---------------- + +macro_rules! pure { + ($name:literal, $f:path) => { + Builtin { name: $name, kind: BuiltinKind::Pure($f) } + }; +} +macro_rules! ctx { + ($name:literal, $f:path) => { + Builtin { name: $name, kind: BuiltinKind::Ctx($f) } + }; +} +macro_rules! special { + ($name:literal, $s:expr) => { + Builtin { name: $name, kind: BuiltinKind::Special($s) } + }; +} + +static BUILTINS: &[Builtin] = &[ + special!("QUOTE", Special::Quote), + special!("FUNCTION", Special::Function), + special!("SETQ", Special::Setq), + special!("IF", Special::If), + special!("COND", Special::Cond), + special!("WHILE", Special::While), + special!("REPEAT", Special::Repeat), + special!("FOREACH", Special::Foreach), + special!("PROGN", Special::Progn), + special!("AND", Special::And), + special!("OR", Special::Or), + special!("DEFUN", Special::Defun), + special!("DEFUN-Q", Special::Defun), + special!("LAMBDA", Special::Lambda), + pure!("+", add), + pure!("-", sub), + pure!("*", mul), + pure!("/", div), + pure!("REM", rem), + pure!("1+", one_plus), + pure!("1-", one_minus), + pure!("ABS", abs), + pure!("MIN", min), + pure!("MAX", max), + pure!("SQRT", sqrt), + pure!("EXP", exp), + pure!("LOG", log), + pure!("SIN", sin), + pure!("COS", cos), + pure!("ATAN", atan), + pure!("EXPT", expt), + pure!("FIX", fix), + pure!("FLOAT", float), + pure!("GCD", gcd), + pure!("LOGAND", logand), + pure!("LOGIOR", logior), + pure!("LSH", lsh), + pure!("~", lognot), + pure!("=", num_eq), + pure!("/=", num_ne), + pure!("<", lt), + pure!(">", gt), + pure!("<=", le), + pure!(">=", ge), + pure!("ZEROP", zerop), + pure!("MINUSP", minusp), + pure!("NUMBERP", numberp), + pure!("ATOM", atom), + pure!("LISTP", listp), + pure!("VL-CONSP", consp), + pure!("NULL", null), + pure!("NOT", null), + pure!("TYPE", type_of), + pure!("EQ", eq_fn), + pure!("EQUAL", equal_fn), + pure!("CAR", car), + pure!("CDR", cdr), + pure!("CAAR", caar), + pure!("CADR", cadr), + pure!("CDAR", cdar), + pure!("CDDR", cddr), + pure!("CAAAR", caaar), + pure!("CAADR", caadr), + pure!("CADAR", cadar), + pure!("CADDR", caddr), + pure!("CDAAR", cdaar), + pure!("CDADR", cdadr), + pure!("CDDAR", cddar), + pure!("CDDDR", cdddr), + pure!("CADDDR", cadddr), + pure!("CDDDDR", cddddr), + pure!("CONS", cons), + pure!("LIST", list), + pure!("APPEND", append), + pure!("REVERSE", reverse), + pure!("LENGTH", length), + pure!("NTH", nth), + pure!("LAST", last), + pure!("MEMBER", member), + pure!("ASSOC", assoc), + pure!("SUBST", subst), + pure!("VL-POSITION", vl_position), + pure!("VL-REMOVE", vl_remove), + pure!("VL-LIST-LENGTH", vl_list_length), + pure!("ACAD_STRLSORT", acad_strlsort), + pure!("STRCAT", strcat), + pure!("STRLEN", strlen), + pure!("SUBSTR", substr), + pure!("STRCASE", strcase), + pure!("ITOA", itoa), + pure!("ATOI", atoi), + pure!("ATOF", atof), + pure!("CHR", chr), + pure!("ASCII", ascii), + pure!("READ", read_fn), + pure!("WCMATCH", wcmatch), + pure!("VL-PRIN1-TO-STRING", vl_prin1_to_string), + pure!("VL-PRINC-TO-STRING", vl_princ_to_string), + pure!("VL-SYMBOL-NAME", vl_symbol_name), + pure!("VL-SYMBOLP", vl_symbolp), + pure!("VL-STRING-SEARCH", vl_string_search), + pure!("VL-STRING-SUBST", vl_string_subst), + pure!("VL-STRING-TRIM", vl_string_trim), + pure!("VL-STRING-LEFT-TRIM", vl_string_left_trim), + pure!("VL-STRING-RIGHT-TRIM", vl_string_right_trim), + pure!("VL-STRING-TRANSLATE", vl_string_translate), + pure!("VL-STRING->LIST", vl_string_to_list), + pure!("VL-LIST->STRING", vl_list_to_string), + pure!("VL-FILENAME-BASE", vl_filename_base), + pure!("VL-FILENAME-EXTENSION", vl_filename_extension), + pure!("VL-FILENAME-DIRECTORY", vl_filename_directory), + pure!("POLAR", polar), + pure!("DISTANCE", distance), + pure!("ANGLE", angle), + pure!("INTERS", inters), + pure!("FINDFILE", findfile), + pure!("VL-CATCH-ALL-ERROR-P", vl_catch_all_error_p), + pure!("VL-CATCH-ALL-ERROR-MESSAGE", vl_catch_all_error_message), + pure!("VL-LOAD-COM", noop), + pure!("GC", noop), + pure!("REDRAW", noop), + pure!("VER", ver), + ctx!("PRINC", princ), + ctx!("PRIN1", prin1), + ctx!("PRINT", print), + ctx!("PROMPT", prompt), + ctx!("TERPRI", terpri), + ctx!("ALERT", alert), + ctx!("OPEN", open), + ctx!("CLOSE", close), + ctx!("READ-LINE", read_line), + ctx!("WRITE-LINE", write_line), + ctx!("APPLY", apply), + ctx!("MAPCAR", mapcar), + ctx!("EVAL", eval_fn), + ctx!("SET", set), + ctx!("BOUNDP", boundp), + ctx!("VL-SYMBOL-VALUE", vl_symbol_value), + ctx!("VL-SORT", vl_sort), + ctx!("VL-REMOVE-IF", vl_remove_if), + ctx!("VL-REMOVE-IF-NOT", vl_remove_if_not), + ctx!("VL-MEMBER-IF", vl_member_if), + ctx!("VL-EVERY", vl_every), + ctx!("VL-SOME", vl_some), + ctx!("VL-CATCH-ALL-APPLY", vl_catch_all_apply), + ctx!("EXIT", exit), + ctx!("QUIT", exit), + ctx!("LOAD", load), + ctx!("AUTOLOAD", autoload), + ctx!("INITGET", input::initget), + ctx!("GETPOINT", input::getpoint), + ctx!("GETCORNER", input::getcorner), + ctx!("GETDIST", input::getdist), + ctx!("GETANGLE", input::getangle), + ctx!("GETORIENT", input::getorient), + ctx!("GETREAL", input::getreal), + ctx!("GETINT", input::getint), + ctx!("GETSTRING", input::getstring), + ctx!("GETKWORD", input::getkword), + ctx!("ENTSEL", input::entsel), + ctx!("NENTSEL", input::entsel), + ctx!("COMMAND", drawing::command), + ctx!("COMMAND-S", drawing::command), + ctx!("VL-CMDF", drawing::command), + ctx!("GETVAR", drawing::getvar), + ctx!("SETVAR", drawing::setvar), + ctx!("ENTGET", drawing::entget), + ctx!("ENTMAKE", drawing::entmake), + ctx!("ENTMOD", drawing::entmod), + ctx!("ENTDEL", drawing::entdel), + ctx!("ENTLAST", drawing::entlast), + ctx!("ENTNEXT", drawing::entnext), + ctx!("ENTUPD", drawing::entupd), + ctx!("HANDENT", drawing::handent), + ctx!("SSGET", drawing::ssget), + ctx!("SSADD", drawing::ssadd), + ctx!("SSDEL", drawing::ssdel), + ctx!("SSLENGTH", drawing::sslength), + ctx!("SSNAME", drawing::ssname), + ctx!("SSMEMB", drawing::ssmemb), + ctx!("SSSETFIRST", drawing::sssetfirst), + ctx!("SSGETFIRST", drawing::ssgetfirst), + ctx!("TBLSEARCH", drawing::tblsearch), + ctx!("TBLNEXT", drawing::tblnext), + ctx!("RTOS", drawing::rtos), + ctx!("ANGTOS", drawing::angtos), + ctx!("DISTOF", drawing::distof), + ctx!("ANGTOF", drawing::angtof), + ctx!("TRANS", drawing::trans), +]; + +/// Bind the builtins and constants in a new environment. +pub fn install(env: &mut Env) { + for b in BUILTINS { + env.globals.insert(Sym::new(b.name), Value::Subr(b)); + } + env.globals.insert(Sym::new("T"), Value::t()); + env.globals.insert(Sym::new("PI"), Value::Real(std::f64::consts::PI)); + env.globals.insert(Sym::new("PAUSE"), Value::str("\\")); + #[cfg(test)] + env.globals.insert(Sym::new(TEST_PANIC.name), Value::Subr(&TEST_PANIC)); +} + +/// Tests only: a built-in that panics, to prove the guards around the machine. +#[cfg(test)] +static TEST_PANIC: Builtin = Builtin { name: "CADCRAFT-TEST-PANIC", kind: BuiltinKind::Pure(test_panic) }; +#[cfg(test)] +#[allow(clippy::panic)] +fn test_panic(_a: &[Value]) -> R { + panic!("test panic") +} + +/// A real as `princ` shows it (for messages). +pub fn real(r: f64) -> String { + real_text(r) +} + +/// `wcmatch` for other callers (`ssget` filters). +pub fn wild_match(text: &str, pattern: &str) -> bool { + let t: Vec = text.chars().collect(); + split_patterns(pattern).iter().any(|p| match_pattern(&t, p)) +} diff --git a/crates/engine/src/lisp/drawing.rs b/crates/engine/src/lisp/drawing.rs new file mode 100644 index 0000000..6892218 --- /dev/null +++ b/crates/engine/src/lisp/drawing.rs @@ -0,0 +1,962 @@ +//! Drawing access from LISP: `command`, system variables, entity lists (`entget`, `entmake`, +//! `entmod`, `entdel`, `entlast`, `entnext`, `handent`), selection sets (`ssget` and friends), +//! symbol tables (`tblsearch`, `tblnext`) and unit conversions (`rtos`, `angtos`, `distof`, +//! `angtof`). +//! +//! Entity lists use the DXF groups the file reader and writer use (through +//! [`crate::cmd::file::entity_codec`]), so what `entget` shows is what a DXF file holds. + +use std::sync::{Arc, Mutex}; + +use cadcraft_doc::{Entity, Handle, Space}; +use cadcraft_dxf::Tag; +use cadcraft_geom::Vec2; + +use super::LispError; +use super::builtins::args_err; +use super::eval::{Ctx, Flow, Need}; +use super::value::{PickSet, Value, to_text}; +use crate::{Input, Session}; + +fn arity(a: &[Value], min: usize, max: usize) -> Result<(), LispError> { + if a.len() < min { + return Err(args_err(true)); + } + if a.len() > max { + return Err(args_err(false)); + } + Ok(()) +} + +fn ename(v: &Value) -> Result { + match v { + Value::Ename(h) => Ok(*h), + other => Err(LispError::bad_arg("lentityp", other)), + } +} + +fn string(v: &Value) -> Result { + match v { + Value::Str(s) => Ok(s.to_string()), + other => Err(LispError::bad_arg("stringp", other)), + } +} + +fn pickset(v: &Value) -> Result { + match v { + Value::PickSet(p) => Ok(p.clone()), + other => Err(LispError::bad_arg("lselsetp", other)), + } +} + +fn new_pickset(ctx: &mut Ctx<'_>, items: Vec) -> Value { + let id = ctx.env.next_pickset; + ctx.env.next_pickset = ctx.env.next_pickset.wrapping_add(1); + Value::PickSet(PickSet { id, items: Arc::new(Mutex::new(items)) }) +} + +fn items(p: &PickSet) -> Vec { + p.items.lock().map(|v| v.clone()).unwrap_or_default() +} + +// ---------------- command ---------------- + +/// `(command arg…)`: arguments go to the command line as typed input: a string starts a command +/// or answers a prompt ("" is Enter), a number or a point is entered, an entity name or a +/// selection set picks objects, and `pause` waits for the user. A command not finished by the +/// arguments stays active for the next `command` call. No arguments: cancel the active command. +pub fn command(ctx: &mut Ctx<'_>, a: Vec) -> Result { + if a.is_empty() { + if ctx.s.running.is_some() { + ctx.s.cancel(); + } + return Ok(Flow::Value(Value::Nil)); + } + for (i, arg) in a.iter().enumerate() { + match arg { + Value::Nil => {} + Value::Str(s) if &**s == "\\" => { + // `pause`: the user answers this prompt, then the rest goes in. + if ctx.s.running.is_some() { + let rest = a[i + 1..].to_vec(); + let f = super::eval::lookup(ctx.env, &super::value::Sym::new("COMMAND")); + return Ok(if rest.is_empty() { Flow::Wait(Need::Pause) } else { Flow::WaitThen(Need::Pause, f, rest) }); + } + } + Value::Str(s) => { + let r = if ctx.s.running.is_none() { + if s.trim().is_empty() { Ok(()) } else { ctx.s.start(s) } + } else if s.is_empty() { + ctx.s.input(Input::Enter) + } else { + ctx.s.typed(s) + }; + if let Err(e) = r { + ctx.s.echo(e.to_string()); + } + } + Value::Int(_) | Value::Real(_) => { + if ctx.s.running.is_some() { + let text = match arg { + Value::Int(n) => n.to_string(), + Value::Real(r) => format!("{r}"), + _ => String::new(), + }; + if let Err(e) = ctx.s.typed(&text) { + ctx.s.echo(e.to_string()); + } + } + } + Value::Ename(h) => feed(ctx.s, Input::Pick(vec![*h])), + Value::PickSet(p) => feed(ctx.s, Input::Pick(items(p))), + Value::Cons(_) => { + if let Some(p) = arg.as_point() { + feed(ctx.s, Input::Point(Vec2::new(p[0], p[1]))); + } else if let Value::Ename(h) = arg.car() { + // An `entsel` result: (ename point). + feed(ctx.s, Input::Pick(vec![h])); + } else { + return Err(LispError::bad_arg("command argument", arg)); + } + } + other => return Err(LispError::bad_arg("command argument", other)), + } + } + Ok(Flow::Value(Value::Nil)) +} + +fn feed(s: &mut Session, input: Input) { + if s.running.is_some() + && let Err(e) = s.input(input) + { + s.echo(e.to_string()); + } +} + +// ---------------- system variables ---------------- + +/// A JSON value as LISP: integers, reals, strings, lists (points). +pub fn from_json(v: &serde_json::Value) -> Value { + match v { + serde_json::Value::Null => Value::Nil, + serde_json::Value::Bool(b) => Value::Int(i32::from(*b)), + serde_json::Value::Number(n) => match n.as_i64().and_then(|i| i32::try_from(i).ok()) { + Some(i) => Value::Int(i), + None => Value::Real(n.as_f64().unwrap_or(0.0)), + }, + serde_json::Value::String(s) => Value::str(s), + serde_json::Value::Array(items) => Value::list(items.iter().map(from_json).collect::>()), + serde_json::Value::Object(_) => Value::str(&v.to_string()), + } +} + +/// A LISP value as JSON (for `setvar`). +pub fn to_json(v: &Value) -> serde_json::Value { + match v { + Value::Nil => serde_json::Value::Null, + Value::Int(i) => serde_json::json!(i), + Value::Real(r) => serde_json::json!(r), + Value::Str(s) => serde_json::json!(&**s), + Value::Cons(_) => serde_json::Value::Array(v.iter().map(|x| to_json(&x)).collect()), + other => serde_json::json!(to_text(other, false)), + } +} + +pub fn getvar(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + let name = string(&a[0])?; + Ok(Flow::Value(crate::sysvars::get(ctx.s, &name).map(|v| from_json(&v)).unwrap_or_default())) +} + +pub fn setvar(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 2)?; + let name = string(&a[0])?; + match crate::sysvars::set(ctx.s, &name, &to_json(&a[1])) { + Ok(()) => Ok(Flow::Value(a[1].clone())), + Err(_) => Err(LispError::new(format!("AutoCAD variable setting rejected: {} {}", to_text(&a[0], true), to_text(&a[1], true)))), + } +} + +// ---------------- entity lists ---------------- + +/// Groups whose value is a point: 10–18, 110–112, 210, 1010–1013 (x), with y and z 10 and 20 +/// higher. +fn point_group(code: i32) -> bool { + (10..=18).contains(&code) || (110..=112).contains(&code) || code == 210 || (1010..=1013).contains(&code) +} + +fn tag_value(t: &Tag) -> Value { + match &t.value { + cadcraft_dxf::Value::Str(s) | cadcraft_dxf::Value::Hex(s) => Value::str(s), + cadcraft_dxf::Value::Real(r) => Value::Real(*r), + cadcraft_dxf::Value::Int(i) => Value::Int(i32::try_from(*i).unwrap_or(if *i < 0 { i32::MIN } else { i32::MAX })), + cadcraft_dxf::Value::Bool(b) => Value::Int(i32::from(*b)), + } +} + +/// DXF groups as an association list: points combined into lists `(10 x y z)`. +fn groups_to_list(tags: &[Tag]) -> Vec { + let mut out = Vec::new(); + let mut i = 0; + while let Some(t) = tags.get(i) { + if point_group(t.code) { + let x = tag_value(t).as_number().unwrap_or(0.0); + let y = tags.get(i + 1).filter(|n| n.code == t.code + 10).and_then(|n| tag_value(n).as_number()); + let z = tags.get(i + 2).filter(|n| n.code == t.code + 20 && y.is_some()).and_then(|n| tag_value(n).as_number()); + match (y, z) { + (Some(y), Some(z)) => { + out.push(Value::list(vec![Value::Int(t.code), Value::Real(x), Value::Real(y), Value::Real(z)])); + i += 3; + } + (Some(y), None) => { + out.push(Value::list(vec![Value::Int(t.code), Value::Real(x), Value::Real(y)])); + i += 2; + } + _ => { + out.push(Value::cons(Value::Int(t.code), Value::Real(x))); + i += 1; + } + } + continue; + } + out.push(Value::cons(Value::Int(t.code), tag_value(t))); + i += 1; + } + out +} + +/// An association list back to DXF groups (points split into x, y, z groups). The type +/// (`0`), the entity name (`-1`), the handle (`5`), the owner (`330`) and the layout (`410`) are +/// left out: they aren't the entity's to set. +fn list_to_groups(list: &Value) -> Result<(String, Vec), LispError> { + let mut kind = None; + let mut tags = Vec::new(); + for item in list.iter() { + let Value::Cons(c) = &item else { return Err(LispError::bad_arg("listp", &item)) }; + let Value::Int(code) = c.car else { return Err(LispError::bad_arg("fixnump", &c.car)) }; + let v = c.cdr.clone(); + match code { + 0 => { + kind = Some(match &v { + Value::Str(s) => s.to_ascii_uppercase(), + other => return Err(LispError::bad_arg("stringp", other)), + }) + } + -1 | 5 | 330 | 360 | 410 | 102 => {} + _ if point_group(code) && matches!(v, Value::Cons(_)) => { + let p = v.as_point().ok_or_else(|| LispError::bad_arg("2D/3D point", &v))?; + tags.push(Tag::f(code, p[0])); + tags.push(Tag::f(code + 10, p[1])); + tags.push(Tag::f(code + 20, p[2])); + } + _ => tags.push(match &v { + Value::Int(i) => Tag::i(code, i64::from(*i)), + Value::Real(r) => Tag::f(code, *r), + Value::Str(s) => Tag::s(code, &**s), + Value::Ename(h) => Tag::s(code, h.hex()), + other => return Err(LispError::bad_arg("DXF group value", other)), + }), + } + } + Ok((kind.ok_or_else(|| LispError::new("bad DXF group: no entity type (0)"))?, tags)) +} + +fn codec() -> Result<&'static crate::cmd::file::EntityCodec, LispError> { + crate::cmd::file::entity_codec().ok_or_else(|| LispError::new("entity lists are not available in this build")) +} + +fn space_of(d: &cadcraft_doc::Drawing, h: Handle) -> Option { + d.space_of(h) +} + +pub fn entget(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 2)?; + let h = ename(&a[0])?; + let Ok(d) = ctx.s.doc() else { return Ok(Flow::Value(Value::Nil)) }; + let Some(e) = d.entity(h) else { return Ok(Flow::Value(Value::Nil)) }; + let (kind, tags) = (codec()?.groups)(d, e); + let layout = match space_of(d, h) { + Some(Space::Paper(name)) => name, + _ => "Model".into(), + }; + let mut items = vec![Value::cons(Value::Int(-1), Value::Ename(h)), Value::cons(Value::Int(0), Value::str(&kind))]; + let mut placed_layout = false; + for v in groups_to_list(&tags) { + // The layout name follows the AcDbEntity marker, as AutoCAD lists it. + let after_marker = !placed_layout && v.car().as_number() == Some(100.0) && matches!(v.cdr(), Value::Str(ref s) if &**s == "AcDbEntity"); + items.push(v); + if after_marker { + items.push(Value::cons(Value::Int(410), Value::str(&layout))); + placed_layout = true; + } + } + Ok(Flow::Value(Value::list(items))) +} + +/// The entity a list describes, as the reader makes it; a missing layer (8) is the current one. +fn entity_from_list(ctx: &Ctx<'_>, list: &Value) -> Result<(String, cadcraft_doc::Common, cadcraft_doc::EntityKind), LispError> { + let (kind, mut tags) = list_to_groups(list)?; + if !tags.iter().any(|t| t.code == 8) { + let layer = crate::sysvars::get(ctx.s, "CLAYER").and_then(|v| v.as_str().map(str::to_string)).unwrap_or_else(|| "0".into()); + tags.insert(0, Tag::s(8, layer)); + } + match (codec()?.entity)(&kind, &tags) { + // A type the reader only carries through (an unknown or invalid name) isn't made. + Some((_, cadcraft_doc::EntityKind::Unknown(_))) | None => Err(LispError::new(format!("bad DXF group: {kind} can't be made from this list"))), + Some((common, k)) => Ok((kind, common, k)), + } +} + +pub fn entmake(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 0, 1)?; + let Some(list) = a.first().filter(|v| !v.is_nil()) else { return Ok(Flow::Value(Value::Nil)) }; + let (_, common, kind) = match entity_from_list(ctx, list) { + Ok(x) => x, + Err(_) => return Ok(Flow::Value(Value::Nil)), + }; + let space = ctx.s.space(); + let Ok(d) = ctx.s.doc_mut() else { return Ok(Flow::Value(Value::Nil)) }; + // A layer entmake names that doesn't exist yet is created. + d.ensure_layer(&common.layer); + match d.add(&space, common, kind) { + Ok(_) => { + ctx.s.touch(); + Ok(Flow::Value(list.clone())) + } + Err(_) => Ok(Flow::Value(Value::Nil)), + } +} + +pub fn entmod(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + let list = &a[0]; + let Some(Value::Ename(h)) = list.iter().find(|v| v.car().as_number() == Some(-1.0)).map(|v| v.cdr()) else { + return Err(LispError::bad_arg("lentityp", &Value::Nil)); + }; + let Some(old) = ctx.s.doc().ok().and_then(|d| d.entity(h)).cloned() else { return Ok(Flow::Value(Value::Nil)) }; + let (kind_name, common, kind) = match entity_from_list(ctx, list) { + Ok(x) => x, + Err(_) => return Ok(Flow::Value(Value::Nil)), + }; + // entmod changes an entity, never its type. + if !kind_name.eq_ignore_ascii_case(old.kind.dxf_name()) { + return Ok(Flow::Value(Value::Nil)); + } + let Ok(d) = ctx.s.doc_mut() else { return Ok(Flow::Value(Value::Nil)) }; + d.ensure_layer(&common.layer); + let ok = d + .modify_entity(h, |e| { + e.common = common; + e.kind = kind; + }) + .is_ok(); + if ok { + ctx.s.touch(); + } + Ok(Flow::Value(if ok { list.clone() } else { Value::Nil })) +} + +/// `(entupd ename)`: redraw an entity (the canvas redraws on its own). +pub fn entupd(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + let h = ename(&a[0])?; + ctx.s.touch(); + Ok(Flow::Value(if ctx.s.doc().is_ok_and(|d| d.entity(h).is_some()) { Value::Ename(h) } else { Value::Nil })) +} + +/// `(entdel ename)`: delete an entity, or bring back one this routine's drawing deleted. +pub fn entdel(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + let h = ename(&a[0])?; + let Ok(d) = ctx.s.doc_mut() else { return Ok(Flow::Value(Value::Nil)) }; + if let Some(space) = d.space_of(h) { + if let Some(e) = d.remove_entity(h) { + ctx.env.deleted.insert(h, (space, e)); + ctx.s.touch(); + return Ok(Flow::Value(Value::Ename(h))); + } + return Ok(Flow::Value(Value::Nil)); + } + match ctx.env.deleted.remove(&h) { + Some((space, e)) => { + let restored = d.space_mut(&space).map(|store| store.push(Entity::clone(&e))).is_some(); + ctx.s.touch(); + Ok(Flow::Value(if restored { Value::Ename(h) } else { Value::Nil })) + } + None => Ok(Flow::Value(Value::Nil)), + } +} + +/// Every entity's handle in creation order (model space and layouts), cached per drawing. +fn handles_in_order(ctx: &mut Ctx<'_>) -> Arc> { + let Ok(st) = ctx.s.state() else { return Arc::default() }; + let key = Arc::as_ptr(&st.doc) as usize; + if let Some((k, v)) = &ctx.env.order + && *k == key + { + return v.clone(); + } + let d = &st.doc; + let mut v: Vec = d.model.handles(); + for l in &d.layouts { + v.extend(l.entities.handles()); + } + v.sort_unstable(); + let v = Arc::new(v); + ctx.env.order = Some((key, v.clone())); + v +} + +pub fn entlast(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 0, 0)?; + Ok(Flow::Value(handles_in_order(ctx).last().map(|h| Value::Ename(*h)).unwrap_or_default())) +} + +pub fn entnext(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 0, 1)?; + let order = handles_in_order(ctx); + let next = match a.first() { + None | Some(Value::Nil) => order.first().copied(), + Some(v) => { + let h = ename(v)?; + let i = order.partition_point(|x| *x <= h); + order.get(i).copied() + } + }; + Ok(Flow::Value(next.map(Value::Ename).unwrap_or_default())) +} + +pub fn handent(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + let s = string(&a[0])?; + let h = Handle::parse_hex(&s).filter(|h| ctx.s.doc().is_ok_and(|d| d.entity(*h).is_some())); + Ok(Flow::Value(h.map(Value::Ename).unwrap_or_default())) +} + +// ---------------- selection sets ---------------- + +/// `(ssget [mode] [pt1 [pt2]] [filter])`. Modes: "X" every entity, "L" the last, "P" the +/// previous selection, "I" the implied (pickfirst) one, "W"/"C" window and crossing with two +/// points, "F" fence, "WP"/"CP" polygons with a point list. With no mode the pickfirst +/// selection, or the user selects objects. The filter is a list of DXF groups (`-4` operators, +/// wildcards). nil when nothing matches. +pub fn ssget(ctx: &mut Ctx<'_>, a: Vec) -> Result { + let mut args = a.into_iter().peekable(); + let mode = match args.peek() { + Some(Value::Str(s)) => { + let m = s.trim_start_matches(['_', '+', '.', ':']).to_ascii_uppercase(); + args.next(); + Some(m) + } + _ => None, + }; + let rest: Vec = args.collect(); + // A trailing list of dotted pairs is the filter. + let (pts, filter) = match rest.last() { + Some(f @ Value::Cons(_)) if f.car().car().as_number().is_some() && f.car().as_point().is_none() => { + (rest[..rest.len() - 1].to_vec(), Some(f.clone())) + } + _ => (rest, None), + }; + let point = |i: usize| -> Result { + let v = pts.get(i).ok_or_else(|| args_err(true))?; + let p = v.as_point().ok_or_else(|| LispError::bad_arg("2D/3D point", v))?; + Ok(Vec2::new(p[0], p[1])) + }; + let s = &mut *ctx.s; + let all = |s: &Session, all_spaces: bool| -> Vec { + let Ok(d) = s.doc() else { return Vec::new() }; + if all_spaces { + let mut v = d.model.handles(); + for l in &d.layouts { + v.extend(l.entities.handles()); + } + v + } else { + d.space(&s.state().map(|st| st.edit_space()).unwrap_or(Space::Model)).map(|st| st.handles()).unwrap_or_default() + } + }; + let space = s.state().map(|st| st.edit_space()).unwrap_or(Space::Model); + let mut found: Vec = match mode.as_deref() { + Some("X") => all(s, true), + Some("L") => { + let order = handles_in_order(ctx); + order.last().copied().into_iter().collect() + } + Some("P") => ctx.s.state().map(|st| st.previous_selection.clone()).unwrap_or_default(), + Some("I") => ctx.s.selection(), + Some("W") | Some("C") => { + let (p1, p2) = (point(0)?, point(1)?); + let s = &*ctx.s; + let Ok(d) = s.doc() else { return Ok(Flow::Value(Value::Nil)) }; + crate::select::select_window(d, &space, cadcraft_geom::Bounds2::from_points([p1, p2]), mode.as_deref() == Some("C")) + } + Some("F") | Some("WP") | Some("CP") => { + let poly: Vec = + pts.first().map(|l| l.iter().filter_map(|p| p.as_point().map(|q| Vec2::new(q[0], q[1]))).collect()).unwrap_or_default(); + let s = &*ctx.s; + let Ok(d) = s.doc() else { return Ok(Flow::Value(Value::Nil)) }; + match mode.as_deref() { + Some("F") => crate::select::select_fence(d, &space, &poly), + m => crate::select::select_polygon(d, &space, &poly, m == Some("CP")), + } + } + Some(":S") | Some("A") | None => { + let implied = ctx.s.selection(); + if !implied.is_empty() { + implied + } else if pts.is_empty() { + // The user selects objects; the result arrives when SELECT ends. + return Ok(Flow::Value(Value::Nil)).and_then(|_| interactive_ssget(ctx, filter)); + } else { + // A point: the object there. + let p = point(0)?; + let s = &*ctx.s; + let ap = s.settings.pickbox.max(1.0) * s.pixel_size(); + let Ok(d) = s.doc() else { return Ok(Flow::Value(Value::Nil)) }; + crate::select::pick(d, &space, p, ap).into_iter().collect() + } + } + Some(m) => return Err(LispError::new(format!("bad argument value: ssget mode {m}"))), + }; + if let Some(f) = &filter { + let d = ctx.s.doc().map_err(|e| LispError::new(e.to_string()))?; + let f = parse_filter(f)?; + found.retain(|h| d.entity(*h).is_some_and(|e| matches_filter(d, e, &f))); + } + if found.is_empty() { + return Ok(Flow::Value(Value::Nil)); + } + Ok(Flow::Value(new_pickset(ctx, found))) +} + +/// `ssget` asking the user: the SELECT command collects the objects. +fn interactive_ssget(ctx: &mut Ctx<'_>, filter: Option) -> Result { + if ctx.s.running.is_some() { + return Ok(Flow::Value(Value::Nil)); + } + if let Err(e) = ctx.s.start("select") { + return Err(LispError::new(e.to_string())); + } + let f = super::eval::lookup(ctx.env, &super::value::Sym::new("SSGET")); + // When SELECT ends, its objects are the previous selection: (ssget "P" [filter]). + let mut args = vec![Value::str("P")]; + args.extend(filter); + Ok(Flow::WaitThen(Need::Pause, f, args)) +} + +/// A parsed `ssget` filter. +enum Filter { + /// One group to test, with the relational operator of a preceding `(-4 . "op")`. + Group { + code: i32, + value: Value, + op: String, + }, + And(Vec), + Or(Vec), + Xor(Vec), + Not(Box), +} + +fn parse_filter(list: &Value) -> Result { + let items = list.to_vec(); + let mut i = 0; + let mut out = Vec::new(); + while i < items.len() { + out.push(parse_filter_item(&items, &mut i, 0)?); + } + Ok(Filter::And(out)) +} + +fn parse_filter_item(items: &[Value], i: &mut usize, depth: usize) -> Result { + if depth > 64 { + return Err(LispError::new("bad ssget filter: nested too deeply")); + } + let Some(item) = items.get(*i) else { return Err(LispError::new("bad ssget filter")) }; + *i += 1; + let code = item.car().as_number().map(|c| c as i32).ok_or_else(|| LispError::bad_arg("ssget filter", item))?; + let value = item.cdr(); + if code != -4 { + return Ok(Filter::Group { code, value, op: "=".into() }); + } + let op = match &value { + Value::Str(s) => s.to_ascii_uppercase(), + other => return Err(LispError::bad_arg("stringp", other)), + }; + let group = |items: &[Value], i: &mut usize, depth: usize, end: &str| -> Result, LispError> { + let mut v = Vec::new(); + loop { + let Some(next) = items.get(*i) else { return Err(LispError::new(format!("bad ssget filter: no {end}"))) }; + if next.car().as_number() == Some(-4.0) && matches!(next.cdr(), Value::Str(ref s) if s.eq_ignore_ascii_case(end)) { + *i += 1; + return Ok(v); + } + v.push(parse_filter_item(items, i, depth + 1)?); + } + }; + Ok(match op.as_str() { + " Filter::And(group(items, i, depth, "AND>")?), + " Filter::Or(group(items, i, depth, "OR>")?), + " Filter::Xor(group(items, i, depth, "XOR>")?), + " { + let mut v = group(items, i, depth, "NOT>")?; + Filter::Not(Box::new(if v.len() == 1 { v.remove(0) } else { Filter::And(v) })) + } + _ => { + // A relational operator applies to the next group. + let Some(next) = items.get(*i) else { return Err(LispError::new("bad ssget filter")) }; + *i += 1; + let code = next.car().as_number().map(|c| c as i32).ok_or_else(|| LispError::bad_arg("ssget filter", next))?; + Filter::Group { code, value: next.cdr(), op } + } + }) +} + +fn matches_filter(d: &cadcraft_doc::Drawing, e: &Entity, f: &Filter) -> bool { + let groups = || match crate::cmd::file::entity_codec() { + Some(c) => { + let (kind, tags) = (c.groups)(d, e); + let mut l = vec![Value::cons(Value::Int(0), Value::str(&kind))]; + l.extend(groups_to_list(&tags)); + l + } + None => vec![Value::cons(Value::Int(0), Value::str(e.kind.dxf_name())), Value::cons(Value::Int(8), Value::str(&e.common.layer))], + }; + let groups = groups(); + eval_filter(&groups, f) +} + +fn eval_filter(groups: &[Value], f: &Filter) -> bool { + match f { + Filter::And(v) => v.iter().all(|x| eval_filter(groups, x)), + Filter::Or(v) => v.iter().any(|x| eval_filter(groups, x)), + Filter::Xor(v) => v.iter().filter(|x| eval_filter(groups, x)).count() == 1, + Filter::Not(x) => !eval_filter(groups, x), + Filter::Group { code, value, op } => { + let found: Vec = groups.iter().filter(|g| g.car().as_number() == Some(f64::from(*code))).map(Value::cdr).collect(); + if found.is_empty() { + // A group the entity doesn't have: layer 0 / colour BYLAYER defaults count. + return match (code, value) { + (62, Value::Int(256)) => op == "=", + _ => false, + }; + } + found.iter().any(|have| group_matches(have, value, op)) + } + } +} + +fn group_matches(have: &Value, want: &Value, op: &str) -> bool { + if op == "*" { + return true; + } + match (have, want) { + (Value::Str(h), Value::Str(w)) => { + // Strings match as wildcards, case-insensitively (type and layer names). + let hit = super::builtins::wild_match(&h.to_uppercase(), &w.to_uppercase()); + if op == "!=" || op == "/=" || op == "<>" { !hit } else { hit } + } + _ => { + if let (Some(h), Some(w)) = (have.as_number(), want.as_number()) { + return compare(h, w, op); + } + if let (Some(h), Some(w)) = (have.as_point(), want.as_point()) { + // Points: an operator per coordinate ("<,>,*") or one for all. + let ops: Vec<&str> = op.split(',').map(str::trim).collect(); + return (0..3).all(|i| compare(h[i], w[i], ops.get(i).or(ops.first()).copied().unwrap_or("="))); + } + super::value::equal(have, want, 0.0) + } + } +} + +fn compare(h: f64, w: f64, op: &str) -> bool { + match op { + "=" => h == w, + "!=" | "/=" | "<>" => h != w, + "<" => h < w, + "<=" => h <= w, + ">" => h > w, + ">=" => h >= w, + "&" => (h as i64) & (w as i64) != 0, + "&=" => (h as i64) & (w as i64) == (w as i64), + "*" => true, + _ => h == w, + } +} + +pub fn ssadd(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 0, 2)?; + match (a.first(), a.get(1)) { + (None, _) => Ok(Flow::Value(new_pickset(ctx, Vec::new()))), + (Some(e), None) => { + let h = ename(e)?; + Ok(Flow::Value(new_pickset(ctx, vec![h]))) + } + (Some(e), Some(ss)) => { + let h = ename(e)?; + let p = pickset(ss)?; + if let Ok(mut v) = p.items.lock() + && !v.contains(&h) + { + v.push(h); + } + Ok(Flow::Value(ss.clone())) + } + } +} + +pub fn ssdel(_ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 2)?; + let h = ename(&a[0])?; + let p = pickset(&a[1])?; + let removed = p.items.lock().map(|mut v| { + let n = v.len(); + v.retain(|x| *x != h); + n != v.len() + }); + Ok(Flow::Value(if removed.unwrap_or(false) { a[1].clone() } else { Value::Nil })) +} + +pub fn sslength(_ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 1)?; + Ok(Flow::Value(Value::Int(i32::try_from(items(&pickset(&a[0])?).len()).unwrap_or(i32::MAX)))) +} + +pub fn ssname(_ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 2)?; + let p = pickset(&a[0])?; + let i = a[1].as_number().ok_or_else(|| LispError::bad_arg("numberp", &a[1]))?; + if i < 0.0 { + return Ok(Flow::Value(Value::Nil)); + } + Ok(Flow::Value(items(&p).get(i as usize).map(|h| Value::Ename(*h)).unwrap_or_default())) +} + +pub fn ssmemb(_ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 2)?; + let h = ename(&a[0])?; + Ok(Flow::Value(if items(&pickset(&a[1])?).contains(&h) { Value::Ename(h) } else { Value::Nil })) +} + +pub fn sssetfirst(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 2)?; + let sel = match a.get(1) { + Some(Value::PickSet(p)) => items(p), + _ => Vec::new(), + }; + ctx.s.set_selection(sel); + Ok(Flow::Value(Value::list(a))) +} + +pub fn ssgetfirst(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 0, 0)?; + let sel = ctx.s.selection(); + let ss = if sel.is_empty() { Value::Nil } else { new_pickset(ctx, sel) }; + Ok(Flow::Value(Value::list(vec![Value::Nil, ss]))) +} + +// ---------------- symbol tables ---------------- + +fn color_index(c: cadcraft_color::Color) -> i32 { + match c { + cadcraft_color::Color::Index(i) => i32::from(i), + cadcraft_color::Color::ByBlock => 0, + cadcraft_color::Color::ByLayer => 256, + cadcraft_color::Color::True(_) => 7, + } +} + +/// The records of a symbol table, as `tblsearch` lists them. +fn table_records(d: &cadcraft_doc::Drawing, table: &str) -> Vec { + let pair = |c: i32, v: Value| Value::cons(Value::Int(c), v); + match table { + "LAYER" => d + .layers + .iter() + .map(|l| { + let flags = i32::from(l.frozen) | (i32::from(l.locked) << 2); + let color = color_index(l.color); + Value::list(vec![ + pair(0, Value::str("LAYER")), + pair(2, Value::str(&l.name)), + pair(70, Value::Int(flags)), + pair(62, Value::Int(if l.on { color } else { -color })), + pair(6, Value::str(&l.linetype)), + ]) + }) + .collect(), + "LTYPE" => d + .linetypes + .iter() + .map(|l| { + Value::list(vec![ + pair(0, Value::str("LTYPE")), + pair(2, Value::str(&l.name)), + pair(70, Value::Int(0)), + pair(3, Value::str(&l.description)), + ]) + }) + .collect(), + "STYLE" => d + .text_styles + .iter() + .map(|s| { + Value::list(vec![ + pair(0, Value::str("STYLE")), + pair(2, Value::str(&s.name)), + pair(70, Value::Int(0)), + pair(40, Value::Real(s.height)), + pair(41, Value::Real(s.width_factor)), + pair(3, Value::str(&s.font)), + ]) + }) + .collect(), + "BLOCK" => d + .blocks + .values() + .map(|b| { + Value::list(vec![ + pair(0, Value::str("BLOCK")), + pair(2, Value::str(&b.name)), + pair(70, Value::Int(0)), + Value::list(vec![Value::Int(10), Value::Real(b.base.x), Value::Real(b.base.y), Value::Real(b.base.z)]), + ]) + }) + .collect(), + "DIMSTYLE" => d + .dim_styles + .iter() + .map(|s| Value::list(vec![pair(0, Value::str("DIMSTYLE")), pair(2, Value::str(&s.name)), pair(70, Value::Int(0))])) + .collect(), + "APPID" => vec![Value::list(vec![pair(0, Value::str("APPID")), pair(2, Value::str("ACAD")), pair(70, Value::Int(0))])], + _ => Vec::new(), + } +} + +fn record_name(r: &Value) -> String { + r.iter().find(|p| p.car().as_number() == Some(2.0)).map(|p| to_text(&p.cdr(), false)).unwrap_or_default() +} + +pub fn tblsearch(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 2, 3)?; + let table = string(&a[0])?.to_ascii_uppercase(); + let name = string(&a[1])?; + let Ok(d) = ctx.s.doc() else { return Ok(Flow::Value(Value::Nil)) }; + let records = table_records(d, &table); + let found = records.iter().position(|r| record_name(r).eq_ignore_ascii_case(&name)); + if let Some(i) = found + && a.get(2).is_some_and(|v| !v.is_nil()) + { + ctx.env.tblnext.insert(table.clone(), i + 1); + } + Ok(Flow::Value(found.and_then(|i| records.get(i).cloned()).unwrap_or_default())) +} + +pub fn tblnext(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 2)?; + let table = string(&a[0])?.to_ascii_uppercase(); + let rewind = a.get(1).is_some_and(|v| !v.is_nil()); + let Ok(d) = ctx.s.doc() else { return Ok(Flow::Value(Value::Nil)) }; + let records = table_records(d, &table); + let i = if rewind { 0 } else { ctx.env.tblnext.get(&table).copied().unwrap_or(0) }; + ctx.env.tblnext.insert(table, i + 1); + Ok(Flow::Value(records.get(i).cloned().unwrap_or_default())) +} + +// ---------------- units ---------------- + +fn int_var(s: &Session, name: &str, default: i64) -> i64 { + crate::sysvars::get(s, name).and_then(|v| v.as_i64()).unwrap_or(default) +} + +/// `(rtos number [mode [precision]])`: as LUNITS/LUPREC by default; decimal results honour +/// DIMZIN's zero suppression (4 leading, 8 trailing). +pub fn rtos(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 3)?; + let v = a[0].as_number().ok_or_else(|| LispError::bad_arg("numberp", &a[0]))?; + let mode = match a.get(1) { + Some(Value::Int(m)) => i64::from(*m), + _ => int_var(ctx.s, "LUNITS", 2), + }; + let prec = match a.get(2) { + Some(Value::Int(p)) => i64::from(*p), + _ => int_var(ctx.s, "LUPREC", 4), + }; + if !(1..=5).contains(&mode) { + return Err(LispError::new(format!("bad argument value: rtos mode {mode}"))); + } + let text = if mode == 2 { + let dimzin = int_var(ctx.s, "DIMZIN", 0); + decimal(v, prec.clamp(0, 8) as usize, dimzin) + } else { + crate::units::format_distance(v, mode, prec) + }; + Ok(Flow::Value(Value::str(&text))) +} + +fn decimal(v: f64, prec: usize, dimzin: i64) -> String { + let mut s = format!("{v:.prec$}"); + if s.starts_with("-0") && s.trim_start_matches(['-', '0', '.']).is_empty() { + s = s.trim_start_matches('-').to_string(); + } + if dimzin & 8 != 0 && s.contains('.') { + s = s.trim_end_matches('0').trim_end_matches('.').to_string(); + } + if dimzin & 4 != 0 { + if let Some(r) = s.strip_prefix("0.") { + s = format!(".{r}"); + } else if let Some(r) = s.strip_prefix("-0.") { + s = format!("-.{r}"); + } + } + s +} + +pub fn angtos(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 3)?; + let v = a[0].as_number().ok_or_else(|| LispError::bad_arg("numberp", &a[0]))?; + let mode = match a.get(1) { + Some(Value::Int(m)) => i64::from(*m), + _ => int_var(ctx.s, "AUNITS", 0), + }; + let prec = match a.get(2) { + Some(Value::Int(p)) => i64::from(*p), + _ => int_var(ctx.s, "AUPREC", 0), + }; + Ok(Flow::Value(Value::str(&crate::units::format_angle(v, mode, prec)))) +} + +pub fn distof(_ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 2)?; + let s = string(&a[0])?; + Ok(Flow::Value(crate::units::parse_distance(&s).map(Value::Real).unwrap_or_default())) +} + +pub fn angtof(ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 1, 2)?; + let s = string(&a[0])?; + Ok(Flow::Value(ctx.s.angle_settings().direction(&s).map(Value::Real).unwrap_or_default())) +} + +/// `(trans pt from to [disp])`: points are in the world system throughout (no UCS yet). +pub fn trans(_ctx: &mut Ctx<'_>, a: Vec) -> Result { + arity(&a, 3, 4)?; + let p = a[0].as_point().ok_or_else(|| LispError::bad_arg("2D/3D point", &a[0]))?; + Ok(Flow::Value(Value::point(&p))) +} + +/// What `(load name)` reads: a file loaded through APPLOAD (the web), or one on disk, with +/// `.lsp` added when the name has no extension. +pub fn load_source(s: &Session, name: &str) -> Option { + if let Some(t) = s.lisp_file(name) { + return Some(t); + } + let candidates = + if std::path::Path::new(name).extension().is_none() { vec![format!("{name}.lsp"), name.to_string()] } else { vec![name.to_string()] }; + // As given (a path, or relative to the working folder), then in the support folder. + let support = + s.lisp_support_dir().map(|d| candidates.iter().map(|c| d.join(c).to_string_lossy().into_owned()).collect::>()).unwrap_or_default(); + candidates.iter().chain(&support).find_map(|c| super::builtins::read_text_file(c)) +} diff --git a/crates/engine/src/lisp/eval.rs b/crates/engine/src/lisp/eval.rs new file mode 100644 index 0000000..e25798f --- /dev/null +++ b/crates/engine/src/lisp/eval.rs @@ -0,0 +1,656 @@ +//! The evaluator: an explicit-stack machine. Nothing recurses on the Rust stack, so a routine +//! can stop in the middle (a `getpoint` waiting for a click, a `pause` inside `command`) and +//! carry on when the input arrives, on one thread (the web build has no others). Deep recursion +//! in LISP is an error ("internal stack limit reached"), never a crash. +//! +//! Variables are dynamically scoped, as in AutoLISP: a function's arguments and locals are bound +//! on entry and restored when it returns, or when an error unwinds through it. + +use super::value::{BuiltinKind, Func, Sym, Value, to_text}; +use super::{Env, LispError}; +use crate::Session; + +/// Frames on the machine's stack: what to do with the value of the expression just evaluated. +pub enum Frame { + /// Evaluating a call's arguments: `f` gets `done` and then the values of `rest`. + Args { + f: Value, + rest: Value, + done: Vec, + }, + /// The head of a form was itself a form (`((lambda (x) …) 1)`): call its value with `args`. + Head { + args: Value, + }, + Progn { + rest: Value, + }, + If { + then: Value, + els: Value, + }, + /// A `cond` clause's test was evaluated: its body runs when true, else the next clauses. + Cond { + body: Value, + rest: Value, + }, + And { + rest: Value, + }, + Or { + rest: Value, + }, + Setq { + sym: Sym, + rest: Value, + }, + WhileTest { + test: Value, + body: Value, + last: Value, + }, + WhileBody { + test: Value, + body: Value, + }, + /// `repeat`'s count was evaluated. + RepeatCount { + body: Value, + }, + Repeat { + left: i64, + body: Value, + }, + /// `foreach`'s list was evaluated. + ForeachList { + var: Sym, + body: Value, + }, + Foreach { + var: Sym, + items: Value, + body: Value, + saved: Option, + }, + /// A function call ends: restore the bindings its arguments and locals hid. + Unbind { + saved: Vec<(Sym, Option)>, + }, + /// `mapcar`: `f` is called with the heads of `lists` in turn. + Mapcar { + f: Value, + lists: Vec, + acc: Vec, + }, + /// Top-level forms of a loaded file or a command line, evaluated in turn. + Forms { + rest: Vec, + }, + /// `vl-catch-all-apply`: an error below this frame becomes its value. + Catch, + /// After a wait, call `f` with `args` (the rest of a `command` after a `pause`). + Resume { + f: Value, + args: Vec, + }, +} + +/// Special forms: their arguments are not evaluated first. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum Special { + Quote, + Function, + Setq, + If, + Cond, + While, + Repeat, + Foreach, + Progn, + And, + Or, + Defun, + Lambda, +} + +/// What a built-in asks of the machine. +pub enum Flow { + Value(Value), + /// Call a function with these arguments (`apply`). + Call(Value, Vec), + /// Evaluate an expression (`eval`). + Eval(Value), + /// Evaluate forms in order; the value is the last one's (`load`). + Forms(Vec), + /// `mapcar`. + Map(Value, Vec), + /// `vl-catch-all-apply`: call the function, turning an error into a value. + Catch(Value, Vec), + /// Stop until the session supplies a value (see [`Need`]). + Wait(Need), + /// Stop, then call the function with these arguments. + WaitThen(Need, Value, Vec), +} + +/// Why the machine stopped before finishing. +#[derive(Clone, Debug)] +pub enum Need { + /// A `get…` function waits for the user. + Get(super::input::GetRequest), + /// `pause` inside `command`: the running command takes one input from the user. + Pause, + /// The step budget ran out: let the interface draw a frame, then carry on. + Yield, +} + +/// How a run ended. +pub enum Outcome { + Done(Value), + Wait(Need), + Error(LispError), +} + +/// What builtins get: the session and the LISP environment. +pub struct Ctx<'a> { + pub s: &'a mut Session, + pub env: &'a mut Env, + /// Nesting depth of [`Ctx::call_sync`]. + pub depth: usize, +} + +/// Deepest stack the machine allows, in frames: well above real routines, well below memory +/// trouble. +pub const MAX_STACK: usize = 100_000; +/// Nesting depth of synchronous callbacks (`vl-sort` comparing with a LISP function, …). +const MAX_SYNC_DEPTH: usize = 32; + +enum State { + Eval(Value), + Ret(Value), + Call(Value, Vec), +} + +pub struct Machine { + stack: Vec, + state: State, + need: Option, +} + +impl Machine { + /// A machine evaluating `forms` in turn. + pub fn forms(forms: Vec) -> Machine { + Machine { stack: vec![Frame::Forms { rest: forms.into_iter().rev().collect() }], state: State::Ret(Value::Nil), need: None } + } + + /// A machine calling `f` with `args`. + pub fn calling(f: Value, args: Vec) -> Machine { + Machine { stack: Vec::new(), state: State::Call(f, args), need: None } + } + + /// Give the value a [`Need`] waited for, and carry on. + pub fn resume(&mut self, v: Value) { + self.state = State::Ret(v); + } + + /// Run until done, waiting, or `budget` steps. + pub fn run(&mut self, ctx: &mut Ctx<'_>, budget: u64) -> Outcome { + let mut n = 0u64; + loop { + n += 1; + if n > budget { + return Outcome::Wait(Need::Yield); + } + let r = match std::mem::replace(&mut self.state, State::Ret(Value::Nil)) { + State::Eval(expr) => self.eval(ctx, expr), + State::Call(f, args) => self.call(ctx, f, args), + State::Ret(v) => match self.stack.pop() { + None => return Outcome::Done(v), + Some(frame) => self.ret(ctx, frame, v), + }, + }; + // A runaway routine stops before it takes all memory. + let r = r.and_then(|()| super::value::check_cells()); + if let Err(e) = r { + self.need = None; + if let Some(o) = self.unwind(ctx, e) { + return o; + } + } else if self.stack.len() > MAX_STACK { + if let Some(o) = self.unwind(ctx, LispError::new("internal stack limit reached")) { + return o; + } + } else if let Some(need) = self.need.take() { + return Outcome::Wait(need); + } + } + } + + /// An error: pop frames back to a `vl-catch-all-apply` (its value becomes the error), or out + /// of the run. Bindings are restored on the way. + fn unwind(&mut self, ctx: &mut Ctx<'_>, e: LispError) -> Option { + while let Some(frame) = self.stack.pop() { + match frame { + Frame::Unbind { saved } => restore(ctx.env, saved), + Frame::Foreach { var, saved, .. } => restore(ctx.env, vec![(var, saved)]), + Frame::Catch if !e.quit => { + self.state = State::Ret(super::builtins::catch_all_error(&e.msg)); + return None; + } + _ => {} + } + } + Some(Outcome::Error(e)) + } + + fn eval(&mut self, ctx: &mut Ctx<'_>, expr: Value) -> Result<(), LispError> { + match expr { + Value::Sym(s) => self.state = State::Ret(lookup(ctx.env, &s)), + Value::Cons(c) => { + let (head, args) = (c.car.clone(), c.cdr.clone()); + let f = match &head { + Value::Sym(s) => { + let f = lookup(ctx.env, s); + if f.is_nil() { + return Err(LispError::new(format!("no function definition: {}", s.name()))); + } + f + } + Value::Cons(_) => { + self.stack.push(Frame::Head { args }); + self.state = State::Eval(head); + return Ok(()); + } + other => other.clone(), + }; + return self.apply_form(ctx, f, args); + } + atom => self.state = State::Ret(atom), + } + Ok(()) + } + + /// A form whose head evaluated to `f`: a special form, or a call with `args` to evaluate. + fn apply_form(&mut self, ctx: &mut Ctx<'_>, f: Value, args: Value) -> Result<(), LispError> { + if let Value::Subr(b) = &f + && let BuiltinKind::Special(sp) = b.kind + { + return self.special(ctx, sp, args); + } + if !matches!(f, Value::Subr(_) | Value::Func(_)) { + return Err(LispError::new(format!("bad function: {}", to_text(&f, true)))); + } + match args { + Value::Cons(c) => { + self.stack.push(Frame::Args { f, rest: c.cdr.clone(), done: Vec::new() }); + self.state = State::Eval(c.car.clone()); + } + _ => self.state = State::Call(f, Vec::new()), + } + Ok(()) + } + + fn ret(&mut self, ctx: &mut Ctx<'_>, frame: Frame, v: Value) -> Result<(), LispError> { + match frame { + Frame::Args { f, rest, mut done } => { + done.push(v); + match rest { + Value::Cons(c) => { + self.stack.push(Frame::Args { f, rest: c.cdr.clone(), done }); + self.state = State::Eval(c.car.clone()); + } + _ => self.state = State::Call(f, done), + } + } + Frame::Head { args } => return self.apply_form(ctx, v, args), + Frame::Progn { rest } => self.progn(rest, v), + Frame::If { then, els } => self.state = State::Eval(if v.is_nil() { els } else { then }), + Frame::Cond { body, rest } => { + if v.is_nil() { + self.cond(rest); + } else if body.is_nil() { + self.state = State::Ret(v); + } else { + self.progn(body, Value::Nil); + } + } + Frame::And { rest } => { + if v.is_nil() { + self.state = State::Ret(Value::Nil); + } else { + self.and_or(rest, true); + } + } + Frame::Or { rest } => { + if v.is_nil() { + self.and_or(rest, false); + } else { + self.state = State::Ret(Value::t()); + } + } + Frame::Setq { sym, rest } => { + ctx.env.set(&sym, v.clone()); + self.setq(rest, v)?; + } + Frame::WhileTest { test, body, last } => { + if v.is_nil() { + self.state = State::Ret(last); + } else { + self.stack.push(Frame::WhileBody { test, body: body.clone() }); + self.progn(body, Value::Nil); + } + } + Frame::WhileBody { test, body } => { + self.stack.push(Frame::WhileTest { test: test.clone(), body, last: v }); + self.state = State::Eval(test); + } + Frame::RepeatCount { body } => { + let Value::Int(n) = v else { return Err(LispError::bad_arg("fixnump", &v)) }; + self.repeat(i64::from(n), body, Value::Nil); + } + Frame::Repeat { left, body } => self.repeat(left, body, v), + Frame::ForeachList { var, body } => { + if !v.is_list() { + return Err(LispError::bad_arg("listp", &v)); + } + let saved = ctx.env.globals.get(&var).cloned(); + self.foreach(ctx, var, v, body, saved, Value::Nil); + } + Frame::Foreach { var, items, body, saved } => self.foreach(ctx, var, items, body, saved, v), + Frame::Unbind { saved } => { + restore(ctx.env, saved); + self.state = State::Ret(v); + } + Frame::Mapcar { f, lists, mut acc } => { + acc.push(v); + let lists: Vec = lists.iter().map(Value::cdr).collect(); + if lists.iter().any(|l| !matches!(l, Value::Cons(_))) { + self.state = State::Ret(Value::list(acc)); + } else { + let args = lists.iter().map(Value::car).collect(); + self.stack.push(Frame::Mapcar { f: f.clone(), lists, acc }); + self.state = State::Call(f, args); + } + } + Frame::Forms { mut rest } => match rest.pop() { + Some(next) => { + self.stack.push(Frame::Forms { rest }); + self.state = State::Eval(next); + } + None => self.state = State::Ret(v), + }, + Frame::Catch => self.state = State::Ret(v), + Frame::Resume { f, args } => self.state = State::Call(f, args), + } + Ok(()) + } + + /// Evaluate the forms of `body` in turn; `last` is the value when there are none. + fn progn(&mut self, body: Value, last: Value) { + match body { + Value::Cons(c) => { + if !c.cdr.is_nil() { + self.stack.push(Frame::Progn { rest: c.cdr.clone() }); + } + self.state = State::Eval(c.car.clone()); + } + _ => self.state = State::Ret(last), + } + } + + fn cond(&mut self, clauses: Value) { + match clauses { + Value::Cons(c) => { + let clause = c.car.clone(); + self.stack.push(Frame::Cond { body: clause.cdr(), rest: c.cdr.clone() }); + self.state = State::Eval(clause.car()); + } + _ => self.state = State::Ret(Value::Nil), + } + } + + /// The next operand of `and` (`and_`) or `or`. + fn and_or(&mut self, rest: Value, and_: bool) { + match rest { + Value::Cons(c) => { + self.stack.push(if and_ { Frame::And { rest: c.cdr.clone() } } else { Frame::Or { rest: c.cdr.clone() } }); + self.state = State::Eval(c.car.clone()); + } + _ => self.state = State::Ret(Value::bool(and_)), + } + } + + fn setq(&mut self, pairs: Value, last: Value) -> Result<(), LispError> { + match pairs { + Value::Cons(c) => { + let Value::Sym(sym) = c.car.clone() else { + return Err(LispError::bad_arg("symbolp", &c.car)); + }; + let Value::Cons(rest) = c.cdr.clone() else { return Err(LispError::new("too few arguments")) }; + self.stack.push(Frame::Setq { sym, rest: rest.cdr.clone() }); + self.state = State::Eval(rest.car.clone()); + } + _ => self.state = State::Ret(last), + } + Ok(()) + } + + fn repeat(&mut self, left: i64, body: Value, last: Value) { + if left <= 0 || body.is_nil() { + self.state = State::Ret(last); + } else { + self.stack.push(Frame::Repeat { left: left - 1, body: body.clone() }); + self.progn(body, Value::Nil); + } + } + + fn foreach(&mut self, ctx: &mut Ctx<'_>, var: Sym, items: Value, body: Value, saved: Option, last: Value) { + match items { + Value::Cons(c) => { + ctx.env.set(&var, c.car.clone()); + self.stack.push(Frame::Foreach { var, items: c.cdr.clone(), body: body.clone(), saved }); + self.progn(body, Value::Nil); + } + _ => { + restore(ctx.env, vec![(var, saved)]); + self.state = State::Ret(last); + } + } + } + + fn special(&mut self, ctx: &mut Ctx<'_>, sp: Special, args: Value) -> Result<(), LispError> { + match sp { + Special::Quote => self.state = State::Ret(args.car()), + Special::Function => { + let a = args.car(); + self.state = State::Ret(if a.car().as_sym().is_some_and(|s| s.name() == "LAMBDA") { make_func(None, a.cdr())? } else { a }); + } + Special::Setq => { + if args.is_nil() { + return Err(LispError::new("too few arguments")); + } + self.setq(args, Value::Nil)?; + } + Special::If => { + let v = args.to_vec(); + if v.len() < 2 { + return Err(LispError::new("too few arguments")); + } + if v.len() > 3 { + return Err(LispError::new("too many arguments")); + } + let mut it = v.into_iter(); + let test = it.next().unwrap_or_default(); + let then = it.next().unwrap_or_default(); + let els = it.next().unwrap_or_default(); + self.stack.push(Frame::If { then, els }); + self.state = State::Eval(test); + } + Special::Cond => self.cond(args), + Special::While => { + let test = args.car(); + self.stack.push(Frame::WhileTest { test: test.clone(), body: args.cdr(), last: Value::Nil }); + self.state = State::Eval(test); + } + Special::Repeat => { + self.stack.push(Frame::RepeatCount { body: args.cdr() }); + self.state = State::Eval(args.car()); + } + Special::Foreach => { + let Value::Sym(var) = args.car() else { return Err(LispError::bad_arg("symbolp", &args.car())) }; + self.stack.push(Frame::ForeachList { var, body: args.cdr().cdr() }); + self.state = State::Eval(args.cdr().car()); + } + Special::Progn => self.progn(args, Value::Nil), + Special::And => self.and_or(args, true), + Special::Or => self.and_or(args, false), + Special::Defun => { + let Value::Sym(name) = args.car() else { return Err(LispError::bad_arg("symbolp", &args.car())) }; + let f = make_func(Some(name.clone()), args.cdr())?; + ctx.env.set(&name, f); + self.state = State::Ret(Value::Sym(name)); + } + Special::Lambda => self.state = State::Ret(make_func(None, args)?), + } + Ok(()) + } + + /// Call `f` with evaluated `args`. + fn call(&mut self, ctx: &mut Ctx<'_>, f: Value, args: Vec) -> Result<(), LispError> { + match &f { + Value::Subr(b) => match b.kind { + BuiltinKind::Pure(func) => { + let v = func(&args)?; + super::value::charge_result(&v)?; + self.state = State::Ret(v); + } + BuiltinKind::Ctx(func) => { + let flow = func(ctx, args)?; + if let Flow::Value(v) = &flow { + super::value::charge_result(v)?; + } + self.flow(flow); + } + BuiltinKind::Special(_) => return Err(LispError::new(format!("bad function: {}", b.name))), + }, + Value::Func(func) => { + if args.len() < func.params.len() { + return Err(LispError::new("too few arguments")); + } + if args.len() > func.params.len() { + return Err(LispError::new("too many arguments")); + } + let mut saved = Vec::with_capacity(func.params.len() + func.locals.len()); + for (p, a) in func.params.iter().zip(args) { + saved.push((p.clone(), ctx.env.globals.get(p).cloned())); + ctx.env.set(p, a); + } + for l in &func.locals { + saved.push((l.clone(), ctx.env.globals.get(l).cloned())); + ctx.env.set(l, Value::Nil); + } + self.stack.push(Frame::Unbind { saved }); + self.progn(func.body.clone(), Value::Nil); + } + other => return Err(LispError::new(format!("bad function: {}", to_text(other, true)))), + } + Ok(()) + } + + fn flow(&mut self, flow: Flow) { + match flow { + Flow::Value(v) => self.state = State::Ret(v), + Flow::Call(f, args) => self.state = State::Call(f, args), + Flow::Eval(e) => self.state = State::Eval(e), + Flow::Forms(forms) => { + self.stack.push(Frame::Forms { rest: forms.into_iter().rev().collect() }); + self.state = State::Ret(Value::Nil); + } + Flow::Map(f, lists) => { + if lists.is_empty() || lists.iter().any(|l| !matches!(l, Value::Cons(_))) { + self.state = State::Ret(Value::Nil); + } else { + let args = lists.iter().map(Value::car).collect(); + self.stack.push(Frame::Mapcar { f: f.clone(), lists, acc: Vec::new() }); + self.state = State::Call(f, args); + } + } + Flow::Catch(f, args) => { + self.stack.push(Frame::Catch); + self.state = State::Call(f, args); + } + Flow::WaitThen(need, f, args) => { + self.stack.push(Frame::Resume { f, args }); + self.state = State::Ret(Value::Nil); + self.need = Some(need); + } + Flow::Wait(need) => { + // The value the session supplies replaces this call's. + self.state = State::Ret(Value::Nil); + self.need = Some(need); + } + } + } +} + +/// A variable's value (nil when unbound). +pub fn lookup(env: &Env, s: &Sym) -> Value { + env.globals.get(s).cloned().unwrap_or(Value::Nil) +} + +fn restore(env: &mut Env, saved: Vec<(Sym, Option)>) { + for (s, v) in saved.into_iter().rev() { + match v { + Some(v) => { + env.globals.insert(s, v); + } + None => { + env.globals.remove(&s); + } + } + } +} + +/// A function from `((params / locals) body…)`. +fn make_func(name: Option, def: Value) -> Result { + let arglist = def.car(); + if !arglist.is_list() { + return Err(LispError::bad_arg("listp", &arglist)); + } + let (mut params, mut locals) = (Vec::new(), Vec::new()); + let mut after_slash = false; + for a in arglist.iter() { + let Value::Sym(s) = a else { return Err(LispError::bad_arg("symbolp", &a)) }; + if s.name() == "/" { + after_slash = true; + } else if after_slash { + locals.push(s); + } else { + params.push(s); + } + } + Ok(Value::Func(std::sync::Arc::new(Func { name, params, locals, body: def.cdr() }))) +} + +impl Ctx<'_> { + /// Call `f` to completion here (a comparison for `vl-sort`, a test for `vl-remove-if`…). + /// It may not wait for input. + pub fn call_sync(&mut self, f: &Value, args: Vec) -> Result { + if self.depth >= MAX_SYNC_DEPTH { + return Err(LispError::new("internal stack limit reached")); + } + if let Value::Subr(b) = f + && let BuiltinKind::Pure(func) = b.kind + { + let v = func(&args)?; + super::value::charge_result(&v)?; + return Ok(v); + } + let mut m = Machine::calling(f.clone(), args); + let mut sub = Ctx { s: &mut *self.s, env: &mut *self.env, depth: self.depth + 1 }; + match m.run(&mut sub, u64::MAX) { + Outcome::Done(v) => Ok(v), + Outcome::Error(e) => Err(e), + Outcome::Wait(_) => Err(LispError::new("this function can't ask for input here")), + } + } +} diff --git a/crates/engine/src/lisp/input.rs b/crates/engine/src/lisp/input.rs new file mode 100644 index 0000000..fca32e5 --- /dev/null +++ b/crates/engine/src/lisp/input.rs @@ -0,0 +1,383 @@ +//! User input from LISP: `getpoint`, `getcorner`, `getdist`, `getangle`, `getorient`, +//! `getreal`, `getint`, `getstring`, `getkword`, `entsel`, `nentsel`, and `initget`, which sets +//! what the next one accepts (bits: 1 no Enter, 2 no zero, 4 no negatives, 128 any text; and +//! keywords). + +use cadcraft_geom::Vec2; + +use super::eval::{Ctx, Flow, Need}; +use super::value::Value; +use super::{LispError, builtins::args_err}; +use crate::{Accept, Input, Prompt, Session}; + +/// `initget` settings. +#[derive(Clone, Debug, Default)] +pub struct Initget { + pub bits: i32, + pub keywords: Vec, +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum GetKind { + Point, + Corner, + Dist, + /// `getangle` (relative to ANGBASE) or `getorient` (absolute). + Angle { + orient: bool, + }, + Real, + Int, + /// `getstring`; `spaces`: a space is part of the text (non-nil first argument). + String { + spaces: bool, + }, + Kword, + /// `entsel` / `nentsel`: an object picked. + EntSel, +} + +/// A `get…` call waiting for the user. +#[derive(Clone, Debug)] +pub struct GetRequest { + pub kind: GetKind, + pub message: String, + pub base: Option<[f64; 3]>, + pub initget: Initget, + /// `getdist`/`getangle` without a base point: the first point given, the second to come. + pub first: Option<[f64; 3]>, +} + +impl GetRequest { + /// The prompt the command line shows. + pub fn prompt(&self) -> Prompt { + let any = self.initget.bits & 128 != 0 || !self.initget.keywords.is_empty(); + let accept = match self.kind { + GetKind::Point | GetKind::Corner | GetKind::EntSel => Accept { text: any, ..Accept::POINT }, + GetKind::Dist | GetKind::Angle { .. } => Accept { text: any, ..Accept::POINT_OR_NUMBER }, + GetKind::Real | GetKind::Int => Accept { text: any, ..Accept::NUMBER }, + GetKind::String { .. } | GetKind::Kword => Accept::TEXT, + }; + let message = match (&self.first, self.message.is_empty()) { + (Some(_), _) => "Specify second point: ".to_string(), + (None, true) => default_message(self.kind).to_string(), + (None, false) => self.message.clone(), + }; + let base = self.first.or(self.base).map(|p| Vec2::new(p[0], p[1])); + let mut p = Prompt::new(message, accept).base_opt(base); + p.keywords = self.initget.keywords.clone(); + p.raw = true; + p + } + + /// What an input gives: a value, a reason to ask again, or (for a distance or an angle + /// without a base point) the first of two points. + pub fn answer(&self, s: &mut Session, input: Input) -> Answer { + match self.answer_value(s, input) { + Ok(v) => Answer::Value(v), + Err(Again::Second(p)) => Answer::Second(p), + Err(Again::Msg(m)) => Answer::Again(m), + } + } + + fn answer_value(&self, s: &mut Session, input: Input) -> Result { + let ig = &self.initget; + let no_null = ig.bits & 1 != 0; + match input { + Input::Enter => { + if matches!(self.kind, GetKind::String { .. }) { + return Ok(Value::str("")); + } + if no_null { + return Err(match self.kind { + GetKind::Int => "Requires an integer value.", + GetKind::Real | GetKind::Dist | GetKind::Angle { .. } => "Requires numeric value.", + GetKind::Kword => "Invalid option keyword.", + _ => "Invalid point.", + } + .into()); + } + Ok(Value::Nil) + } + Input::Keyword(k) => Ok(Value::str(&k)), + Input::Point(p) => self.point(s, [p.x, p.y, 0.0]), + // A deferred tangent/perpendicular snap is the point it was picked at here. + Input::Deferred(d) => self.point(s, [d.at.x, d.at.y, 0.0]), + Input::Pick(hs) => match (self.kind, hs.first()) { + (GetKind::EntSel, Some(h)) => Ok(Value::list(vec![Value::Ename(*h), Value::point(&[s.last_point.x, s.last_point.y, 0.0])])), + _ => Err("Invalid point.".into()), + }, + Input::Text(t) => self.text(s, &t), + Input::Cancel => Err("*Cancel*".into()), + } + } + + fn point(&self, s: &mut Session, p: [f64; 3]) -> Result { + match self.kind { + GetKind::Point | GetKind::Corner => Ok(Value::point(&p)), + GetKind::Dist | GetKind::Angle { .. } => { + let Some(base) = self.first.or(self.base) else { + // The first of two points: ask for the second. + return Err(Again::Second(p)); + }; + let (dx, dy) = (p[0] - base[0], p[1] - base[1]); + if let GetKind::Angle { orient } = self.kind { + let mut a = dy.atan2(dx); + if !orient { + a -= s.lisp_angbase(); + } + return self.check_number(a.rem_euclid(std::f64::consts::TAU), false); + } + let d = if self.initget.bits & 64 != 0 { (dx * dx + dy * dy).sqrt() } else { (dx * dx + dy * dy + (p[2] - base[2]).powi(2)).sqrt() }; + self.check_number(d, false) + } + GetKind::EntSel => { + let ap = s.settings.pickbox.max(1.0) * s.pixel_size(); + let space = s.state().map(|st| st.edit_space()).map_err(|e| Again::Msg(e.to_string()))?; + let d = s.doc().map_err(|e| Again::Msg(e.to_string()))?; + match crate::select::pick(d, &space, Vec2::new(p[0], p[1]), ap) { + Some(h) => Ok(Value::list(vec![Value::Ename(h), Value::point(&p)])), + None => Err("Missed, try again.".into()), + } + } + _ => Err(match self.kind { + GetKind::Int => "Requires an integer value.", + GetKind::Kword => "Invalid option keyword.", + GetKind::String { .. } => "Requires a string.", + _ => "Requires numeric value.", + } + .into()), + } + } + + fn text(&self, s: &mut Session, t: &str) -> Result { + let ig = &self.initget; + if let Some(k) = keyword(&ig.keywords, t) { + return Ok(Value::str(&k)); + } + let any = ig.bits & 128 != 0; + match self.kind { + GetKind::String { spaces } => { + let t = if spaces { t } else { t.split(' ').next().unwrap_or("") }; + Ok(Value::str(t)) + } + GetKind::Kword => Err("Invalid option keyword.".into()), + GetKind::Int => match t.trim().parse::() { + Ok(i) if (-32768..=32767).contains(&i) => self.check_number(f64::from(i), true), + Ok(_) => Err("Value must be between -32768 and 32767.".into()), + Err(_) if any => Ok(Value::str(t)), + Err(_) => Err("Requires an integer value.".into()), + }, + GetKind::Real => match t.trim().parse::() { + Ok(v) if v.is_finite() => self.check_number(v, false), + _ if any => Ok(Value::str(t)), + _ => Err("Requires numeric value.".into()), + }, + GetKind::Dist => match crate::units::parse_distance(t) { + Some(v) => self.check_number(v, false), + None if any => Ok(Value::str(t)), + None => Err("Requires numeric distance or two points.".into()), + }, + GetKind::Angle { orient } => match s.angle_settings().direction(t) { + Some(a) => { + let a = if orient { a } else { a - s.lisp_angbase() }; + self.check_number(a.rem_euclid(std::f64::consts::TAU), false) + } + None if any => Ok(Value::str(t)), + None => Err("Requires valid numeric angle or second point.".into()), + }, + GetKind::Point | GetKind::Corner | GetKind::EntSel => { + if any { + Ok(Value::str(t)) + } else { + Err("Invalid point.".into()) + } + } + } + } + + fn check_number(&self, v: f64, int: bool) -> Result { + let bits = self.initget.bits; + if bits & 2 != 0 && v == 0.0 { + return Err("Value must be nonzero.".into()); + } + if bits & 4 != 0 && v < 0.0 { + return Err("Value must be positive.".into()); + } + Ok(if int { Value::Int(v as i32) } else { Value::Real(v) }) + } +} + +/// What an input to a `get…` prompt gives. +pub enum Answer { + Value(Value), + /// Not an answer here: the message says why, and the prompt asks again. + Again(String), + /// `getdist`/`getangle` without a base point got its first point: ask for the second. + Second([f64; 3]), +} + +enum Again { + Msg(String), + Second([f64; 3]), +} + +impl From for Again { + fn from(m: String) -> Again { + Again::Msg(m) + } +} + +impl From<&str> for Again { + fn from(m: &str) -> Again { + Again::Msg(m.to_string()) + } +} + +fn default_message(kind: GetKind) -> &'static str { + match kind { + GetKind::EntSel => "Select object: ", + _ => "", + } +} + +/// A keyword typed, matched as the command line matches them: the whole word or its capitals. +fn keyword(keywords: &[String], t: &str) -> Option { + if keywords.is_empty() { + return None; + } + let mut p = Prompt::new("", Accept::TEXT); + p.keywords = keywords.to_vec(); + p.match_keyword(t).or_else(|| t.strip_prefix('_').and_then(|r| p.match_keyword(r))) +} + +impl Session { + /// ANGBASE (radians). + fn lisp_angbase(&self) -> f64 { + crate::sysvars::get(self, "ANGBASE").and_then(|v| v.as_f64()).unwrap_or(0.0) + } +} + +// ---------------- the builtins ---------------- + +/// `(initget [bits] [keywords])`. +pub fn initget(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let mut ig = Initget::default(); + for a in &args { + match a { + Value::Int(b) => ig.bits = *b, + Value::Str(k) => ig.keywords = k.split_whitespace().map(|w| w.split(',').next().unwrap_or(w).to_string()).collect(), + Value::Nil => {} + other => return Err(LispError::bad_arg("stringp", other)), + } + } + ctx.env.initget = Some(ig); + Ok(Flow::Value(Value::Nil)) +} + +/// Optional point then optional message, in that order (`getpoint`, `getdist`, `getangle`…). +fn point_and_message(args: &[Value], name: &str) -> Result<(Option<[f64; 3]>, String), LispError> { + let (mut base, mut msg) = (None, String::new()); + for a in args { + match a { + Value::Str(s) => msg = s.to_string(), + Value::Cons(_) => base = Some(a.as_point().ok_or_else(|| LispError::bad_arg("2D/3D point", a))?), + Value::Nil => {} + other => return Err(LispError::bad_arg(if name == "getcorner" { "2D/3D point" } else { "stringp" }, other)), + } + } + if args.len() > 2 { + return Err(args_err(false)); + } + Ok((base, msg)) +} + +fn wait(ctx: &mut Ctx<'_>, kind: GetKind, message: String, base: Option<[f64; 3]>) -> Result { + let initget = ctx.env.initget.take().unwrap_or_default(); + // Text printed so far shows before the prompt. + let printed = std::mem::take(&mut ctx.env.out); + if !printed.is_empty() { + for l in printed.split('\n').filter(|l| !l.is_empty()) { + ctx.s.echo(l.to_string()); + ctx.env.printed_at = Some(ctx.s.log.len()); + } + } + Ok(Flow::Wait(Need::Get(GetRequest { kind, message, base, initget, first: None }))) +} + +pub fn getpoint(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let (base, msg) = point_and_message(&args, "getpoint")?; + wait(ctx, GetKind::Point, msg, base) +} + +pub fn getcorner(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let (base, msg) = point_and_message(&args, "getcorner")?; + if base.is_none() { + return Err(args_err(true)); + } + wait(ctx, GetKind::Corner, msg, base) +} + +pub fn getdist(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let (base, msg) = point_and_message(&args, "getdist")?; + wait(ctx, GetKind::Dist, msg, base) +} + +pub fn getangle(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let (base, msg) = point_and_message(&args, "getangle")?; + wait(ctx, GetKind::Angle { orient: false }, msg, base) +} + +pub fn getorient(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let (base, msg) = point_and_message(&args, "getorient")?; + wait(ctx, GetKind::Angle { orient: true }, msg, base) +} + +fn message_only(args: &[Value]) -> Result { + match args { + [] | [Value::Nil] => Ok(String::new()), + [Value::Str(s)] => Ok(s.to_string()), + [other] => Err(LispError::bad_arg("stringp", other)), + _ => Err(args_err(false)), + } +} + +pub fn getreal(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let m = message_only(&args)?; + wait(ctx, GetKind::Real, m, None) +} + +pub fn getint(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let m = message_only(&args)?; + wait(ctx, GetKind::Int, m, None) +} + +pub fn getkword(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let m = message_only(&args)?; + wait(ctx, GetKind::Kword, m, None) +} + +/// `(getstring [cr] [msg])`. +pub fn getstring(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let (spaces, msg) = match args.as_slice() { + [] => (false, String::new()), + [Value::Str(m)] => (false, m.to_string()), + [cr] => (!cr.is_nil(), String::new()), + [cr, Value::Str(m)] => (!cr.is_nil(), m.to_string()), + [_, Value::Nil] => (!args[0].is_nil(), String::new()), + [_, other] => return Err(LispError::bad_arg("stringp", other)), + _ => return Err(args_err(false)), + }; + wait(ctx, GetKind::String { spaces }, msg, None) +} + +/// `(entsel [msg])` and `(nentsel [msg])`. +pub fn entsel(ctx: &mut Ctx<'_>, args: Vec) -> Result { + let m = message_only(&args)?; + wait(ctx, GetKind::EntSel, m, None) +} + +/// A second point after the first of `getdist`/`getangle` without a base. +pub fn with_first(req: &GetRequest, p: [f64; 3]) -> GetRequest { + GetRequest { first: Some(p), ..req.clone() } +} diff --git a/crates/engine/src/lisp/mod.rs b/crates/engine/src/lisp/mod.rs new file mode 100644 index 0000000..d9fdc9a --- /dev/null +++ b/crates/engine/src/lisp/mod.rs @@ -0,0 +1,613 @@ +//! AutoLISP: load `.lsp` files, evaluate expressions typed at the command line, and run +//! commands defined with `(defun c:NAME …)`. +//! +//! The language runs on an explicit-stack machine ([`eval`]) that can stop for input +//! (`getpoint`, `pause`) and carry on later, so the interface keeps drawing while a routine +//! waits. Each drawing has its own symbols, as in AutoCAD. A run is one undo step. + +pub mod builtins; +mod drawing; +pub mod eval; +pub mod input; +pub mod read; +mod startup; +pub mod value; + +use std::collections::HashMap; +use std::sync::Arc; + +use cadcraft_doc::{Drawing, Handle}; + +use crate::{Input, Prompt, Session}; +use eval::{Ctx, Machine, Need, Outcome}; +use value::{Sym, Value}; + +/// A LISP error: the message `*error*` receives (`bad argument type: numberp: nil`…). +#[derive(Clone, Debug)] +pub struct LispError { + pub msg: String, + /// `exit`/`quit`, or a cancelled input: not caught by `vl-catch-all-apply`. + pub quit: bool, +} + +impl LispError { + pub fn new(msg: impl Into) -> LispError { + LispError { msg: msg.into(), quit: false } + } + pub fn bad_arg(pred: &str, v: &Value) -> LispError { + LispError::new(format!("bad argument type: {pred}: {}", value::to_text(v, true))) + } + pub fn quit(msg: impl Into) -> LispError { + LispError { msg: msg.into(), quit: true } + } +} + +/// One drawing's LISP environment. +pub struct Env { + pub globals: HashMap, + /// Printed text not yet ended by a newline. + pub out: String, + /// `initget` settings for the next `get…` call. + pub initget: Option, + pub next_pickset: u32, + pub files: HashMap, + pub next_file: u32, + /// Entities `entdel` deleted (it brings them back when called again), with their space. + pub deleted: HashMap)>, + /// Every entity's handle in creation order, for the drawing it was taken from (`entnext`). + pub order: Option<(usize, Arc>)>, + /// `tblnext`'s place in each table. + pub tblnext: HashMap, + /// The command history's length after LISP last printed a line: when something else wrote since + /// (a prompt, a command's echo), a leading newline only ends that line. + pub printed_at: Option, +} + +impl Default for Env { + fn default() -> Self { + let mut e = Env { + globals: HashMap::new(), + out: String::new(), + initget: None, + next_pickset: 1, + files: HashMap::new(), + next_file: 1, + deleted: HashMap::new(), + order: None, + tblnext: HashMap::new(), + printed_at: None, + }; + builtins::install(&mut e); + e + } +} + +impl Env { + /// Set a variable (nil unbinds it). + pub fn set(&mut self, s: &Sym, v: Value) { + if v.is_nil() { + self.globals.remove(s); + } else { + self.globals.insert(s.clone(), v); + } + } + pub fn get(&self, name: &str) -> Value { + eval::lookup(self, &Sym::new(name)) + } + /// Text printed by `princ` and friends. + pub fn print(&mut self, text: &str) { + self.out.push_str(text); + } +} + +/// The session's LISP: each drawing's environment and the routine running, if any. +#[derive(Default)] +pub struct LispState { + envs: HashMap, + run: Option>, + /// A routine runs, from its start to its end (also while its machine is out of `run`). + active: bool, + /// Files loaded by APPLOAD, by name, for `(load name)` where there is no file system. + files: HashMap, + /// Where startup files are read from (see `startup.rs`). + support_dir: Option, + /// Drawings that had their startup files. + autoloaded: std::collections::HashSet, + /// `acad.lsp` was loaded this session. + acad_loaded: bool, + /// Memory caps (lowered by tests). + pub(crate) limits: Limits, +} + +/// What a run may use (see [`value`]'s memory notes). +#[derive(Clone, Copy, Debug)] +pub(crate) struct Limits { + /// Live cons cells (all sessions). + pub cells: usize, + /// Bytes of strings, printed text and files read per run. + pub string_bytes: u64, +} + +impl Default for Limits { + fn default() -> Self { + Limits { cells: value::MAX_CELLS, string_bytes: value::STRING_BUDGET } + } +} + +impl std::fmt::Debug for LispState { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + write!(f, "LispState {{ drawings: {}, running: {} }}", self.envs.len(), self.run.is_some()) + } +} + +/// A routine on its way: the machine, what it waits for, and its undo step. +struct Run { + machine: Machine, + /// The drawing it runs in. + uid: u64, + waiting: Option, + /// A command-line expression: its value is printed at the end. + print: bool, + /// Undo label: the command (`c:` function) or "LISP". + label: String, + /// The drawing and selection before the run (one undo step for the whole run). + before: Option<(Arc, Vec)>, + /// Inputs given up front (`lisp {code, inputs}`): what `get…` calls answer. + inputs: std::collections::VecDeque, + /// Run to the end without waiting (programmatic calls): `get…` without an input gets nil. + blocking: bool, + /// Steps taken, for the cap on blocking runs. + steps: u64, + /// The `*error*` handler is the one running. + handler: bool, + /// Bytes of strings and printed text the run has made ([`value::charge_bytes`]). + string_bytes: u64, + /// Cons cells alive when the run started: cells the drawing's variables already hold don't + /// stop a run (it can still set them to nil) unless it adds more. + cells_at_start: usize, +} + +/// Steps per slice before the interface gets a frame. +const SLICE: u64 = 400_000; +/// Steps a blocking run (a programmatic call) may take before it is stopped. +const BLOCKING_CAP: u64 = 500_000_000; + +impl Session { + /// The LISP environment of the active drawing. + fn lisp_env_take(&mut self) -> Env { + let uid = self.state().map(|s| s.uid).unwrap_or(0); + self.lisp.envs.remove(&uid).unwrap_or_default() + } + + fn lisp_env_put(&mut self, uid: u64, env: Env) { + self.lisp.envs.insert(uid, env); + } + + /// A routine is running (possibly waiting for input). + pub fn lisp_running(&self) -> bool { + self.lisp.active + } + + /// A prompt waits for input: a command's, or a LISP routine's `get…` function. Clicks and + /// typing answer it; with none, the interface is idle (clicks select, Delete erases). + pub fn prompting(&self) -> bool { + self.running.is_some() || self.lisp_prompt().is_some() + } + + /// A routine is stopped, waiting for input or for a frame. + pub(crate) fn lisp_waiting(&self) -> bool { + self.lisp.run.is_some() + } + + /// The value of a LISP variable in the active drawing (nil when unbound). + pub fn lisp_var(&self, name: &str) -> Value { + let uid = self.state().map(|s| s.uid).unwrap_or(0); + self.lisp.envs.get(&uid).map(|e| e.get(name)).unwrap_or_default() + } + + /// Evaluate LISP source (a command-line expression or a file's contents). `print`: show the + /// value on the command line. `blocking`: run to the end, answering `get…` calls from + /// `inputs` (nil when they run out), as programmatic calls must; otherwise the routine may + /// wait for the user. + pub fn lisp_eval( + &mut self, + src: &str, + print: bool, + blocking: bool, + inputs: Vec, + ) -> crate::Result>> { + let forms = read::read_all(src).map_err(|e| crate::EngineError::Other(format!("; error: {}", e.msg)))?; + self.lisp_start(Machine::forms(forms), print, blocking, inputs, "LISP".into()) + } + + /// Call a LISP function (`c:` commands typed at the command line). + fn lisp_call(&mut self, f: Value, label: String) -> crate::Result>> { + self.lisp_start(Machine::calling(f, Vec::new()), false, false, Vec::new(), label) + } + + fn lisp_start( + &mut self, + machine: Machine, + print: bool, + blocking: bool, + inputs: Vec, + label: String, + ) -> crate::Result>> { + if self.lisp.active { + return Err(crate::EngineError::Other("a LISP routine is already running".into())); + } + self.lisp.active = true; + let st = self.state()?; + let before = Some((st.doc.clone(), st.selection.clone())); + let uid = st.uid; + self.lisp.run = Some(Box::new(Run { + machine, + uid, + waiting: None, + print, + label, + before, + inputs: inputs.into(), + blocking, + steps: 0, + handler: false, + string_bytes: 0, + cells_at_start: value::live_cells(), + })); + self.lisp_drive(); + if blocking { + // A blocking run that waits for a command's input (`pause`) can't get it: cancel. + if self.lisp.run.is_some() { + self.lisp_abort("Function cancelled"); + } + } + Ok(self.lisp_last.take()) + } + + /// Call once per frame: loads the startup files into a drawing seen for the first time, and + /// carries on a routine that gave the interface a frame. + pub fn lisp_tick(&mut self) { + // Called every frame, outside any command: a panic in it ends the routine with an error + // instead of taking down the app. + if let Err(p) = std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| self.lisp_tick_unguarded())) { + self.lisp_internal_error(&crate::guard::message(&*p)); + } + } + + fn lisp_tick_unguarded(&mut self) { + // A drawing seen for the first time gets its startup files. + self.lisp_autoload(); + if self.lisp.run.as_ref().is_some_and(|r| matches!(r.waiting, Some(Need::Yield))) { + if let Some(r) = self.lisp.run.as_mut() { + r.waiting = None; + } + self.lisp_drive(); + } + } + + /// Whether the routine needs ticks ([`Session::lisp_tick`]) to go on. + pub fn lisp_busy(&self) -> bool { + self.lisp.run.as_ref().is_some_and(|r| matches!(r.waiting, Some(Need::Yield))) + } + + /// Run the machine until it finishes or waits. + fn lisp_drive(&mut self) { + loop { + let Some(mut run) = self.lisp.run.take() else { return }; + if run.waiting.is_some() { + self.lisp.run = Some(run); + return; + } + // The routine belongs to its drawing; another one became active: stop it. + if self.state().map(|s| s.uid).ok() != Some(run.uid) { + self.lisp.run = Some(run); + self.lisp_abort("Function cancelled"); + return; + } + let mut env = self.lisp_env_take(); + value::set_string_budget(run.string_bytes, self.lisp.limits.string_bytes); + value::set_cell_limit(self.lisp.limits.cells.max(run.cells_at_start)); + let outcome = { + let machine = &mut run.machine; + let mut ctx = Ctx { s: self, env: &mut env, depth: 0 }; + std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| machine.run(&mut ctx, SLICE))) + }; + run.string_bytes = value::string_bytes_used(); + let outcome = match outcome { + Ok(o) => o, + Err(p) => { + // A panic inside a built-in: put the drawing back as the routine found it. + if let Some((doc, sel)) = &run.before + && let Some(st) = self.docs.iter_mut().find(|d| d.uid == run.uid) + { + st.doc = doc.clone(); + st.selection = sel.clone(); + } + run.handler = true; + Outcome::Error(LispError::quit(format!("internal error: {}", crate::guard::message(&*p)))) + } + }; + let uid = run.uid; + self.lisp_flush(&mut env, false); + self.lisp_env_put(uid, env); + match outcome { + Outcome::Done(v) => { + self.lisp.run = Some(run); + self.lisp_end(Ok(v)); + return; + } + Outcome::Error(e) => { + self.lisp.run = Some(run); + self.lisp_error(e); + return; + } + Outcome::Wait(Need::Yield) => { + run.steps = run.steps.saturating_add(SLICE); + if run.blocking { + if run.steps > BLOCKING_CAP { + self.lisp.run = Some(run); + self.lisp_error(LispError::quit(format!("routine stopped after {BLOCKING_CAP} steps"))); + return; + } + self.lisp.run = Some(run); + continue; + } + run.waiting = Some(Need::Yield); + self.lisp.run = Some(run); + return; + } + Outcome::Wait(Need::Pause) => { + // The command `command` left running takes the next input; with none + // running there is nothing to wait for. + if self.running.is_none() || run.blocking { + run.machine.resume(Value::Nil); + if run.blocking && self.running.is_some() { + self.cancel(); + } + self.lisp.run = Some(run); + continue; + } + run.waiting = Some(Need::Pause); + self.lisp.run = Some(run); + return; + } + Outcome::Wait(Need::Get(req)) => { + if let Some(v) = run.inputs.pop_front() { + run.machine.resume(v); + self.lisp.run = Some(run); + continue; + } + if run.blocking { + run.machine.resume(Value::Nil); + self.lisp.run = Some(run); + continue; + } + run.waiting = Some(Need::Get(req)); + self.lisp.run = Some(run); + return; + } + } + } + } + + /// Move printed text to the command history: complete lines, and with `all` the rest too. + fn lisp_flush(&mut self, env: &mut Env, all: bool) { + while let Some(i) = env.out.find('\n') { + let line: String = env.out.drain(..=i).collect(); + let line = line.trim_end_matches(['\n', '\r']).to_string(); + // `(princ "\nText")` after a prompt or a command's echo ends that line instead of + // leaving an empty one; after LISP's own line it does print an empty line. + if line.is_empty() && env.printed_at != Some(self.log.len()) { + env.printed_at = Some(self.log.len()); + continue; + } + self.echo(line); + env.printed_at = Some(self.log.len()); + } + if all && !env.out.is_empty() { + let line = std::mem::take(&mut env.out); + self.echo(line); + env.printed_at = Some(self.log.len()); + } + } + + /// The routine finished: print its value (command-line expressions), record its undo step. + fn lisp_end(&mut self, result: std::result::Result) { + let Some(run) = self.lisp.run.take() else { return }; + self.lisp.active = false; + let mut env = self.lisp.envs.remove(&run.uid).unwrap_or_default(); + self.lisp_flush(&mut env, true); + self.lisp.envs.insert(run.uid, env); + if let (Ok(v), true) = (&result, run.print) { + let text = value::to_text(v, true); + if !builtins::is_null_symbol(v) { + self.echo(text); + } + } + if let Some((doc, sel)) = run.before + && let Some(st) = self.docs.iter_mut().find(|d| d.uid == run.uid) + && !Arc::ptr_eq(&doc, &st.doc) + { + st.push_undo(crate::Snapshot { label: run.label.clone(), doc, selection: sel }); + st.revision += 1; + } + self.lisp_last = Some(result); + } + + /// A LISP error: run `*error*` when the routine defined one, else print it. + fn lisp_error(&mut self, e: LispError) { + let Some(mut run) = self.lisp.run.take() else { return }; + // The command a failed routine left running is cancelled. + if self.running.is_some() { + self.cancel(); + } + let handler = self.lisp.envs.get(&run.uid).map(|env| env.get("*ERROR*")).unwrap_or_default(); + if !run.handler && matches!(handler, Value::Func(_) | Value::Subr(_)) { + run.handler = true; + run.waiting = None; + run.print = false; + run.machine = Machine::calling(handler, vec![Value::str(&e.msg)]); + self.lisp.run = Some(run); + self.lisp_drive(); + // The routine failed whatever its handler returned. + if let Some(Ok(_)) = &self.lisp_last { + self.lisp_last = Some(Err(e.msg)); + } + return; + } + self.lisp.run = Some(run); + let mut env = self.lisp_env_take(); + self.lisp_flush(&mut env, true); + let uid = self.state().map(|s| s.uid).unwrap_or(0); + self.lisp_env_put(uid, env); + self.echo(format!("; error: {}", e.msg)); + self.lisp_end(Err(e.msg)); + } + + /// A panic escaped the LISP machinery outside a routine's steps: end the routine, if any, + /// with an error, so the session stays usable. + fn lisp_internal_error(&mut self, msg: &str) { + let msg = format!("internal error: {msg}"); + if self.lisp.run.is_some() { + if let Some(r) = self.lisp.run.as_mut() { + // Don't run the routine's own `*error*` after an internal failure. + r.handler = true; + } + self.lisp_error(LispError::quit(msg)); + } else if self.lisp.active { + self.lisp.active = false; + self.echo(format!("; error: {msg}")); + self.lisp_last = Some(Err(msg)); + } else { + self.echo(format!("; error: {msg}")); + } + } + + /// Stop the routine (Esc while it waits, its drawing closed) with `msg` as its error. + pub fn lisp_abort(&mut self, msg: &str) { + if self.lisp.run.is_some() { + self.lisp_error(LispError::quit(msg)); + } + } + + /// A routine waits for the user's answer to a `get…` function: its prompt. + pub(crate) fn lisp_prompt(&self) -> Option { + match self.lisp.run.as_ref()?.waiting.as_ref()? { + Need::Get(req) => Some(req.prompt()), + _ => None, + } + } + + /// The rubber band of a waiting `get…` function: a rectangle from `getcorner`'s corner, a + /// line from the base point of the others. `None` when no routine waits for input. + pub(crate) fn lisp_preview(&self, cursor: cadcraft_geom::Vec2) -> Option> { + let Need::Get(req) = self.lisp.run.as_ref()?.waiting.as_ref()? else { return None }; + let line = + |a: cadcraft_geom::Vec2, b: cadcraft_geom::Vec2| cadcraft_doc::EntityKind::Line(cadcraft_doc::Line { a: a.to3(0.0), b: b.to3(0.0) }); + let Some(b) = req.first.or(req.base).map(|p| cadcraft_geom::Vec2::new(p[0], p[1])) else { return Some(Vec::new()) }; + Some(match req.kind { + input::GetKind::Corner => { + let (c1, c2) = (cadcraft_geom::Vec2::new(cursor.x, b.y), cadcraft_geom::Vec2::new(b.x, cursor.y)); + vec![line(b, c1), line(c1, cursor), line(cursor, c2), line(c2, b)] + } + input::GetKind::Point | input::GetKind::Dist | input::GetKind::Angle { .. } => vec![line(b, cursor)], + _ => Vec::new(), + }) + } + + /// Give an input to a waiting routine. `true` when the routine took it. + pub(crate) fn lisp_input(&mut self, input: Input) -> bool { + let Some(req) = self.lisp.run.as_ref().and_then(|r| match &r.waiting { + Some(Need::Get(req)) => Some(req.clone()), + _ => None, + }) else { + return false; + }; + if input == Input::Cancel { + self.echo("*Cancel*"); + self.lisp_abort("Function cancelled"); + return true; + } + match req.answer(self, input) { + input::Answer::Value(v) => { + if let Some(r) = self.lisp.run.as_mut() { + r.waiting = None; + r.machine.resume(v); + } + self.lisp_drive(); + } + // Not an answer this prompt takes: say why and ask again. + input::Answer::Again(msg) => self.echo(msg), + // The first of two points: the prompt asks for the second. + input::Answer::Second(p) => { + if let Some(r) = self.lisp.run.as_mut() { + r.waiting = Some(Need::Get(input::with_first(&req, p))); + } + } + } + true + } + + /// After the running command took an input: a routine paused for it carries on. + pub(crate) fn lisp_after_command_input(&mut self) { + if self.lisp.run.as_ref().is_some_and(|r| matches!(r.waiting, Some(Need::Pause))) { + if let Some(r) = self.lisp.run.as_mut() { + r.waiting = None; + r.machine.resume(Value::Nil); + } + self.lisp_drive(); + } + } + + /// Whether commands' undo steps go into a running routine's (one step per routine). + pub(crate) fn lisp_groups_undo(&self) -> bool { + self.lisp.active + } + + /// A `c:` function for a command name typed at the command line. + pub(crate) fn lisp_command(&self, name: &str) -> Option { + if self.lisp.active { + return None; + } + let uid = self.state().ok()?.uid; + let f = self.lisp.envs.get(&uid)?.get(&format!("C:{name}")); + matches!(f, Value::Func(_) | Value::Subr(_)).then_some(f) + } + + /// Run a `c:` command. + pub(crate) fn lisp_run_command(&mut self, name: &str, f: Value) -> crate::Result<()> { + self.lisp_call(f, name.to_ascii_uppercase()).map(|_| ()) + } +} + +pub(crate) use drawing::from_json as drawing_from_json; +pub(crate) use drawing::load_source; + +impl Session { + /// A file APPLOAD loaded, by its name (with or without `.lsp`, any case). + pub(crate) fn lisp_file(&self, name: &str) -> Option { + let key = file_key(name); + self.lisp.files.get(&key).cloned() + } + + /// Load a LISP file (APPLOAD, a dropped `.lsp` file): its forms run in the active drawing, + /// and `(load name)` finds it later even where there is no file system. `blocking`: run to + /// the end (programmatic calls). + pub fn lisp_load(&mut self, name: &str, text: &str, blocking: bool) -> crate::Result>> { + self.lisp.files.insert(file_key(name), text.to_string()); + let r = self.lisp_eval(text, false, blocking, Vec::new())?; + if !matches!(r, Some(Err(_))) { + let shown = std::path::Path::new(name).file_name().and_then(|n| n.to_str()).unwrap_or(name).to_string(); + self.echo(format!("{shown} successfully loaded.")); + } + Ok(r) + } +} + +fn file_key(name: &str) -> String { + let base = std::path::Path::new(&name.replace('\\', "/")).file_name().and_then(|n| n.to_str()).unwrap_or(name).to_ascii_lowercase(); + base.strip_suffix(".lsp").map(str::to_string).unwrap_or(base) +} + +#[cfg(test)] +mod tests; diff --git a/crates/engine/src/lisp/read.rs b/crates/engine/src/lisp/read.rs new file mode 100644 index 0000000..19ab726 --- /dev/null +++ b/crates/engine/src/lisp/read.rs @@ -0,0 +1,249 @@ +//! The reader: AutoLISP source text to values. Lists, dotted pairs, `'x` quoting, strings with +//! backslash escapes, integers (a literal beyond 32 bits reads as a real), reals, symbols +//! (upper-cased), `;` line comments and `;| … |;` block comments. +//! +//! It keeps its own stack instead of recursing, so deeply nested input can't overflow it. + +use super::LispError; +use super::value::{MAX_DEPTH, Value}; + +enum Open { + List { items: Vec, tail: Option, dot: bool }, + Quote, +} + +/// Every top-level form in `src`. +pub fn read_all(src: &str) -> Result, LispError> { + let mut r = Reader { chars: src.chars().collect(), pos: 0 }; + let mut out = Vec::new(); + while let Some(v) = r.datum()? { + out.push(v); + } + Ok(out) +} + +/// The first form in `src` (`read`), nil when there is none. +pub fn read_one(src: &str) -> Result { + let mut r = Reader { chars: src.chars().collect(), pos: 0 }; + Ok(r.datum()?.unwrap_or(Value::Nil)) +} + +struct Reader { + chars: Vec, + pos: usize, +} + +impl Reader { + fn peek(&self) -> Option { + self.chars.get(self.pos).copied() + } + + fn skip_space(&mut self) { + while let Some(c) = self.peek() { + if c.is_whitespace() { + self.pos += 1; + } else if c == ';' { + if self.chars.get(self.pos + 1) == Some(&'|') { + // Block comment up to |; + self.pos += 2; + while self.pos < self.chars.len() && !(self.chars[self.pos] == '|' && self.chars.get(self.pos + 1) == Some(&';')) { + self.pos += 1; + } + self.pos = (self.pos + 2).min(self.chars.len()); + } else { + while let Some(c) = self.peek() { + self.pos += 1; + if c == '\n' { + break; + } + } + } + } else { + break; + } + } + } + + /// The next complete datum; `None` at the end of the input. + fn datum(&mut self) -> Result, LispError> { + let mut stack: Vec = Vec::new(); + loop { + self.skip_space(); + let Some(c) = self.peek() else { + if stack.iter().any(|o| matches!(o, Open::List { .. })) { + return Err(LispError::new("malformed list on input")); + } + if !stack.is_empty() { + return Err(LispError::new("malformed quote on input")); + } + return Ok(None); + }; + let done = match c { + '(' => { + self.pos += 1; + if stack.len() >= MAX_DEPTH { + return Err(LispError::new("too deeply nested input")); + } + stack.push(Open::List { items: Vec::new(), tail: None, dot: false }); + continue; + } + ')' => { + self.pos += 1; + match stack.pop() { + Some(Open::List { items, tail, dot }) => { + if dot && tail.is_none() { + return Err(LispError::new("misplaced dot on input")); + } + Value::list_with_tail(items, tail.unwrap_or(Value::Nil)) + } + Some(Open::Quote) => return Err(LispError::new("malformed quote on input")), + // A stray closing parenthesis at top level is ignored, as AutoCAD does. + None => continue, + } + } + '\'' => { + self.pos += 1; + if stack.len() >= MAX_DEPTH { + return Err(LispError::new("too deeply nested input")); + } + stack.push(Open::Quote); + continue; + } + '"' => { + self.pos += 1; + self.string()? + } + _ => { + let tok = self.token(); + if tok == "." && matches!(stack.last(), Some(Open::List { items, dot: false, .. }) if !items.is_empty()) { + if let Some(Open::List { dot, .. }) = stack.last_mut() { + *dot = true; + } + continue; + } + atom(&tok) + } + }; + // A finished datum: wrap pending quotes, then hand it to the enclosing list. + let mut v = done; + loop { + match stack.last_mut() { + Some(Open::Quote) => { + stack.pop(); + v = Value::list(vec![Value::sym("QUOTE"), v]); + } + Some(Open::List { items, tail, dot }) => { + if *dot { + if tail.is_some() { + return Err(LispError::new("misplaced dot on input")); + } + *tail = Some(v); + } else { + items.push(v); + } + break; + } + None => return Ok(Some(v)), + } + } + } + } + + fn string(&mut self) -> Result { + let mut s = String::new(); + loop { + let Some(c) = self.peek() else { return Err(LispError::new("malformed string on input")) }; + self.pos += 1; + match c { + '"' => return Ok(Value::str(&s)), + '\\' => { + let Some(e) = self.peek() else { return Err(LispError::new("malformed string on input")) }; + self.pos += 1; + match e { + 'n' => s.push('\n'), + 'r' => s.push('\r'), + 't' => s.push('\t'), + 'e' => s.push('\u{1b}'), + '0'..='7' => { + // \nnn: an octal character code. + let mut code = e.to_digit(8).unwrap_or(0); + for _ in 0..2 { + match self.peek().and_then(|d| d.to_digit(8)) { + Some(d) => { + code = code * 8 + d; + self.pos += 1; + } + None => break, + } + } + s.extend(char::from_u32(code)); + } + other => s.push(other), + } + } + c => s.push(c), + } + } + } + + fn token(&mut self) -> String { + let start = self.pos; + while let Some(c) = self.peek() { + if c.is_whitespace() || matches!(c, '(' | ')' | '\'' | '"' | ';') { + break; + } + self.pos += 1; + } + self.chars[start..self.pos].iter().collect() + } +} + +/// A number or a symbol. +fn atom(tok: &str) -> Value { + if let Ok(i) = tok.parse::() { + return match i32::try_from(i) { + Ok(i) => Value::Int(i), + Err(_) => Value::Real(i as f64), + }; + } + let numeric = tok.chars().next().is_some_and(|c| c.is_ascii_digit() || matches!(c, '.' | '-' | '+')) + && tok.chars().any(|c| c.is_ascii_digit()) + && tok.chars().all(|c| c.is_ascii_digit() || matches!(c, '.' | '-' | '+' | 'e' | 'E')); + if numeric && let Ok(r) = tok.parse::() { + return Value::Real(r); + } + if tok.eq_ignore_ascii_case("nil") { + return Value::Nil; + } + Value::sym(tok) +} + +#[cfg(test)] +mod tests { + use super::super::value::to_text; + use super::*; + + fn show(src: &str) -> Vec { + read_all(src).unwrap().iter().map(|v| to_text(v, true)).collect() + } + + #[test] + fn reads_forms_atoms_and_comments() { + assert_eq!(show("(defun c:hi () (princ \"hi\\n\")) ; c\n;| block\n |; 'x"), ["(DEFUN C:HI nil (PRINC \"hi\\n\"))", "'X"]); + assert_eq!(show("(8 . \"0\") (1 2 . 3) (a .b)"), ["(8 . \"0\")", "(1 2 . 3)", "(A .B)"]); + assert_eq!(show("1 -2 3.5 .5 1e3 4294967296 nil T"), ["1", "-2", "3.5", "0.5", "1000.0", "4.29497e+009", "nil", "T"]); + assert_eq!(show("\"a\\\\b\\\"c\\101\""), ["\"a\\\\b\\\"cA\""]); + } + + #[test] + fn malformed_and_hostile_input_is_an_error_not_a_crash() { + assert!(read_all("(1 2").is_err()); + assert!(read_all("\"open").is_err()); + assert!(read_all("(1 . )").is_err()); + assert!(read_all("'").is_err()); + assert!(read_all(&"(".repeat(100_000)).is_err()); + assert!(read_all(&"'".repeat(100_000)).is_err()); + // A stray ) at top level is skipped. + assert_eq!(show(") 1"), ["1"]); + } +} diff --git a/crates/engine/src/lisp/startup.rs b/crates/engine/src/lisp/startup.rs new file mode 100644 index 0000000..118f4e7 --- /dev/null +++ b/crates/engine/src/lisp/startup.rs @@ -0,0 +1,59 @@ +//! LISP loaded at startup, from CADCraft's support folder (the app sets it: `/support`): +//! +//! - `acad.lsp` once per session, in the first drawing (every drawing with ACADLSPASDOC on); +//! - `acaddoc.lsp` in every drawing opened or created; +//! - then `S::STARTUP`, when they define it. +//! +//! Never from a drawing's own folder: an `acaddoc.lsp` that came along with a downloaded drawing +//! would run on opening it, the way LISP viruses spread. + +use std::path::PathBuf; + +use super::value::Value; +use crate::Session; + +/// The startup files, in load order: (name, once per session unless ACADLSPASDOC). +const FILES: [(&str, bool); 2] = [("acad.lsp", true), ("acaddoc.lsp", false)]; + +impl Session { + /// The folder startup LISP files are read from (`None`: no startup files, the default; the + /// app sets it). + pub fn set_lisp_support_dir(&mut self, dir: Option) { + self.lisp.support_dir = dir; + } + + /// The folder startup LISP files are read from. + pub fn lisp_support_dir(&self) -> Option<&std::path::Path> { + self.lisp.support_dir.as_deref() + } + + /// Load the startup files into the active drawing, once (from [`Session::lisp_tick`]). + pub(crate) fn lisp_autoload(&mut self) { + let Some(dir) = self.lisp.support_dir.clone() else { return }; + if self.lisp.active { + return; + } + let Ok(uid) = self.state().map(|s| s.uid) else { return }; + if !self.lisp.autoloaded.insert(uid) { + return; + } + let per_drawing = self.settings.acadlspasdoc; + for (name, once) in FILES { + if once && self.lisp.acad_loaded && !per_drawing { + continue; + } + let Some(text) = super::builtins::read_text_file(&dir.join(name).to_string_lossy()) else { continue }; + if once { + self.lisp.acad_loaded = true; + } + self.lisp.files.insert(name.trim_end_matches(".lsp").to_string(), text.clone()); + // Startup files don't ask for input: they run to the end. Errors are shown. + if let Err(e) = self.lisp_eval(&text, false, true, Vec::new()) { + self.echo(format!("{name}: {e}")); + } + } + if matches!(self.lisp_var("S::STARTUP"), Value::Func(_) | Value::Subr(_)) { + let _ = self.lisp_eval("(S::STARTUP)", false, true, Vec::new()); + } + } +} diff --git a/crates/engine/src/lisp/tests.rs b/crates/engine/src/lisp/tests.rs new file mode 100644 index 0000000..f56f02a --- /dev/null +++ b/crates/engine/src/lisp/tests.rs @@ -0,0 +1,553 @@ +#![allow(clippy::unwrap_used)] + +use super::value::{Value, to_text}; +use crate::Session; +use crate::cmd::file::{EntityCodec, set_entity_codec}; + +fn session() -> Session { + set_entity_codec(EntityCodec { groups: cadcraft_io::entity_groups, entity: cadcraft_io::entity_from_groups }); + Session::new() +} + +/// Evaluate `code` to the end; its value as `prin1` shows it, or the error message. +fn eval(s: &mut Session, code: &str) -> Result { + eval_with(s, code, Vec::new()) +} + +fn eval_with(s: &mut Session, code: &str, inputs: Vec) -> Result { + match s.lisp_eval(code, false, true, inputs) { + Ok(Some(Ok(v))) => Ok(to_text(&v, true)), + Ok(Some(Err(e))) => Err(e), + Ok(None) => Err("did not finish".into()), + Err(e) => Err(e.to_string()), + } +} + +fn ok(s: &mut Session, code: &str) -> String { + match eval(s, code) { + Ok(v) => v, + Err(e) => panic!("{code}: {e}"), + } +} + +#[test] +fn arithmetic_follows_autolisp() { + let mut s = session(); + assert_eq!(ok(&mut s, "(+ 1 2 3)"), "6"); + assert_eq!(ok(&mut s, "(+ 1 2.0)"), "3.0"); + assert_eq!(ok(&mut s, "(/ 7 2)"), "3"); + assert_eq!(ok(&mut s, "(/ 7 2.0)"), "3.5"); + assert_eq!(ok(&mut s, "(- 5)"), "-5"); + assert_eq!(ok(&mut s, "(rem 7 3)"), "1"); + assert_eq!(ok(&mut s, "(1+ 41)"), "42"); + assert_eq!(ok(&mut s, "(fix 3.7)"), "3"); + assert_eq!(ok(&mut s, "(float 3)"), "3.0"); + assert_eq!(ok(&mut s, "(expt 2 10)"), "1024"); + assert_eq!(ok(&mut s, "(sqrt 16)"), "4.0"); + assert_eq!(ok(&mut s, "(max 1 5 3)"), "5"); + assert_eq!(ok(&mut s, "(min 1 5.0 3)"), "1.0"); + assert_eq!(ok(&mut s, "(abs -4)"), "4"); + assert_eq!(ok(&mut s, "(logand 12 10)"), "8"); + assert_eq!(ok(&mut s, "(lsh 1 4)"), "16"); + assert_eq!(ok(&mut s, "(+ 2147483647 1)"), "-2147483648", "32-bit integers wrap"); + assert_eq!(ok(&mut s, "(< 1 2 3)"), "T"); + assert_eq!(ok(&mut s, "(= 1 1.0)"), "T"); + assert_eq!(ok(&mut s, "(= \"a\" \"a\")"), "T"); + assert_eq!(eval(&mut s, "(/ 1 0)"), Err("divide by zero".into())); + assert_eq!(eval(&mut s, "(+ 1 nil)"), Err("bad argument type: numberp: nil".into())); +} + +#[test] +fn lists_and_strings() { + let mut s = session(); + assert_eq!(ok(&mut s, "(cons 1 '(2 3))"), "(1 2 3)"); + assert_eq!(ok(&mut s, "(cons 8 \"0\")"), "(8 . \"0\")"); + assert_eq!(ok(&mut s, "(cadr '(1 2 3))"), "2"); + assert_eq!(ok(&mut s, "(cdr (assoc 40 '((10 1.0 2.0 0.0) (40 . 2.5))))"), "2.5"); + assert_eq!(ok(&mut s, "(subst '(40 . 5.0) '(40 . 2.5) '((8 . \"0\") (40 . 2.5)))"), "((8 . \"0\") (40 . 5.0))"); + assert_eq!(ok(&mut s, "(append '(1) '(2 3) nil '(4))"), "(1 2 3 4)"); + assert_eq!(ok(&mut s, "(reverse '(1 2 3))"), "(3 2 1)"); + assert_eq!(ok(&mut s, "(nth 1 '(a b c))"), "B"); + assert_eq!(ok(&mut s, "(member 2 '(1 2 3))"), "(2 3)"); + assert_eq!(ok(&mut s, "(length '(1 2 3))"), "3"); + assert_eq!(ok(&mut s, "(last '(1 2 3))"), "3"); + assert_eq!(ok(&mut s, "(mapcar '+ '(1 2 3) '(10 20 30))"), "(11 22 33)"); + assert_eq!(ok(&mut s, "(mapcar '(lambda (x) (* x x)) '(1 2 3))"), "(1 4 9)"); + assert_eq!(ok(&mut s, "(apply 'max '(3 9 2))"), "9"); + assert_eq!(ok(&mut s, "(vl-sort '(3 1 2) '<)"), "(1 2 3)"); + assert_eq!(ok(&mut s, "(vl-sort '(3 1 2) (function (lambda (a b) (> a b))))"), "(3 2 1)"); + assert_eq!(ok(&mut s, "(vl-remove-if 'minusp '(1 -2 3))"), "(1 3)"); + assert_eq!(ok(&mut s, "(strcat \"a\" \"b\" \"c\")"), "\"abc\""); + assert_eq!(ok(&mut s, "(substr \"Hello\" 2 3)"), "\"ell\""); + assert_eq!(ok(&mut s, "(strcase \"abc\")"), "\"ABC\""); + assert_eq!(ok(&mut s, "(strlen \"abc\" \"de\")"), "5"); + assert_eq!(ok(&mut s, "(itoa 42)"), "\"42\""); + assert_eq!(ok(&mut s, "(atoi \"12abc\")"), "12"); + assert_eq!(ok(&mut s, "(atof \"2.5mm\")"), "2.5"); + assert_eq!(ok(&mut s, "(atof \"x\")"), "0.0"); + assert_eq!(ok(&mut s, "(wcmatch \"Name\" \"N*\")"), "T"); + assert_eq!(ok(&mut s, "(wcmatch \"A12\" \"@##\")"), "T"); + assert_eq!(ok(&mut s, "(wcmatch \"abc\" \"x*,a?c\")"), "T"); + assert_eq!(ok(&mut s, "(wcmatch \"abc\" \"~a*\")"), "nil"); + assert_eq!(ok(&mut s, "(wcmatch \"b\" \"[a-c]\")"), "T"); + assert_eq!(ok(&mut s, "(vl-string-subst \"X\" \"b\" \"abcb\")"), "\"aXcb\""); + assert_eq!(ok(&mut s, "(vl-string-search \"c\" \"abc\")"), "2"); + assert_eq!(ok(&mut s, "(read \"(1 2)\")"), "(1 2)"); + assert_eq!(ok(&mut s, "(type \"x\")"), "STR"); + assert_eq!(ok(&mut s, "(type 'x)"), "SYM"); + assert_eq!(ok(&mut s, "(equal '(1 2.0) '(1 2.0000001) 1e-3)"), "T"); +} + +#[test] +fn geometry() { + let mut s = session(); + assert_eq!(ok(&mut s, "(polar '(0 0) 0 5)"), "(5.0 0.0)"); + assert_eq!(ok(&mut s, "(distance '(0 0) '(3 4))"), "5.0"); + assert_eq!(ok(&mut s, "(angle '(0 0) '(0 1))"), "1.5708"); + assert_eq!(ok(&mut s, "(inters '(0 0) '(10 10) '(0 10) '(10 0))"), "(5.0 5.0)"); + assert_eq!(ok(&mut s, "(inters '(0 0) '(1 1) '(0 10) '(10 0))"), "nil"); + assert_eq!(ok(&mut s, "(inters '(0 0) '(1 1) '(0 10) '(10 0) nil)"), "(5.0 5.0)"); +} + +#[test] +fn functions_scope_and_control() { + let mut s = session(); + ok(&mut s, "(defun sq (x) (* x x))"); + assert_eq!(ok(&mut s, "(sq 7)"), "49"); + ok(&mut s, "(defun fact (n) (if (< n 2) 1 (* n (fact (1- n)))))"); + assert_eq!(ok(&mut s, "(fact 10)"), "3628800"); + // Dynamic scope: arguments and locals hide globals while the function runs. + ok(&mut s, "(setq x 1 y 2)"); + ok(&mut s, "(defun f (x / y) (setq y 5) (g))"); + ok(&mut s, "(defun g () (list x y))"); + assert_eq!(ok(&mut s, "(f 9)"), "(9 5)"); + assert_eq!(ok(&mut s, "(list x y)"), "(1 2)", "restored after the call"); + assert_eq!(ok(&mut s, "(progn (setq i 0 acc nil) (while (< i 3) (setq acc (cons i acc) i (1+ i))) acc)"), "(2 1 0)"); + assert_eq!(ok(&mut s, "(progn (setq n 0) (repeat 4 (setq n (+ n 2))) n)"), "8"); + assert_eq!(ok(&mut s, "(progn (setq tot 0) (foreach v '(1 2 3) (setq tot (+ tot v))) tot)"), "6"); + assert_eq!(ok(&mut s, "(cond ((= 1 2) 'a) ((= 1 1) 'b) (t 'c))"), "B"); + assert_eq!(ok(&mut s, "(and 1 2)"), "T"); + assert_eq!(ok(&mut s, "(or nil nil)"), "nil"); + assert_eq!(ok(&mut s, "((lambda (a b) (+ a b)) 1 2)"), "3"); + assert_eq!(ok(&mut s, "(eval '(+ 1 2))"), "3"); + assert_eq!(eval(&mut s, "(sq)"), Err("too few arguments".into())); + assert_eq!(eval(&mut s, "(sq 1 2)"), Err("too many arguments".into())); + assert_eq!(eval(&mut s, "(nosuchfunction 1)"), Err("no function definition: NOSUCHFUNCTION".into())); +} + +#[test] +fn errors_unwind_bindings_and_reach_the_handler() { + let mut s = session(); + ok(&mut s, "(setq v 'outer)"); + ok(&mut s, "(defun boom (v) (/ 1 0))"); + assert!(eval(&mut s, "(boom 'inner)").is_err()); + assert_eq!(ok(&mut s, "v"), "OUTER", "the error restored the binding"); + // *error* runs with the message. + ok(&mut s, "(defun *error* (msg) (setq caught msg))"); + assert!(eval(&mut s, "(boom 1)").is_err()); + assert_eq!(ok(&mut s, "caught"), "\"divide by zero\""); + ok(&mut s, "(setq *error* nil)"); + // vl-catch-all-apply turns an error into a value. + assert_eq!(ok(&mut s, "(vl-catch-all-error-message (vl-catch-all-apply '/ '(1 0)))"), "\"divide by zero\""); + assert_eq!(ok(&mut s, "(vl-catch-all-apply '+ '(1 2))"), "3"); + assert!(eval(&mut s, "(exit)").is_err()); +} + +#[test] +fn runaway_routines_are_errors_not_crashes() { + let mut s = session(); + ok(&mut s, "(defun deep (n) (+ 1 (deep (1+ n))))"); + assert_eq!(eval(&mut s, "(deep 0)"), Err("internal stack limit reached".into())); + // A deeply nested source text. + let nested = format!("{}1{}", "(+ ".repeat(50_000), ")".repeat(50_000)); + assert!(eval(&mut s, &nested).is_err()); + // Hostile values. + assert!(eval(&mut s, "(substr \"abc\" 0)").is_err()); + assert!(eval(&mut s, "(nth -1 '(1))").is_ok()); + assert!(eval(&mut s, "(chr -5)").is_ok()); + assert!(eval(&mut s, "(expt 2.0 99999)").is_err()); + assert!(eval(&mut s, "(gcd 0 0)").is_err()); + assert!(eval(&mut s, "(wcmatch \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaab\" \"*a*a*a*a*a*a*a*a*a*c\")").is_ok()); + assert!(eval(&mut s, "(fix 1e300)").is_ok()); + assert!(eval(&mut s, "(lsh 1 99)").is_ok()); + // An endless loop in a blocking run stops at the step cap. + let r = eval(&mut s, "(setq n 0) (while (< n 3000000) (setq n (1+ n))) n"); + assert_eq!(r, Ok("3000000".into())); +} + +#[test] +fn printing() { + let mut s = session(); + let before = s.log.len(); + ok(&mut s, "(princ \"Hello\") (princ \" world\\n\") (prin1 \"q\") (terpri) (print 3) (princ)"); + let out: Vec<_> = s.log[before..].to_vec(); + assert_eq!(out, ["Hello world", "\"q\"", "", "3 "]); + assert_eq!(ok(&mut s, "(vl-prin1-to-string '(1 \"a\"))"), "\"(1 \\\"a\\\")\""); + assert_eq!(ok(&mut s, "(rtos 12.5 2 2)"), "\"12.50\""); +} + +#[test] +fn command_draws_and_one_routine_is_one_undo_step() { + let mut s = session(); + let n = |s: &Session| s.doc().unwrap().model.handles().len(); + let undo_before = s.state().unwrap().undo.len(); + ok(&mut s, "(command \"_.LINE\" '(0 0) '(10 0) \"\") (command \"_.CIRCLE\" '(5 5) 2)"); + assert_eq!(n(&s), 2); + assert_eq!(s.state().unwrap().undo.len(), undo_before + 1, "the whole routine undoes at once"); + // A command left open carries on in the next call. + ok(&mut s, "(command \"_.LINE\" '(0 10) '(10 10)) (command '(10 20) \"\")"); + assert_eq!(n(&s), 4); + assert!(s.running.is_none()); + // (defun c:…) makes a command. + ok(&mut s, "(defun c:twolines () (command \"_.LINE\" '(0 0) '(0 5) '(5 5) \"\") (princ))"); + s.cmdline("TWOLINES").unwrap(); + assert_eq!(n(&s), 6); + // An expression typed at Command: shows its value. + s.cmdline("(+ 40 2)").unwrap(); + assert_eq!(s.log.last().map(String::as_str), Some("42")); + s.cmdline("(setq dist 7.5)").unwrap(); + s.cmdline("!dist").unwrap(); + assert_eq!(s.log.last().map(String::as_str), Some("7.5")); + // An expression at a command's prompt answers it. + s.cmdline("CIRCLE 0,0 (* 2 dist)").unwrap(); + let r = s.doc().unwrap().model.iter().find_map(|e| match &e.kind { + cadcraft_doc::EntityKind::Circle(c) if c.center.x == 0.0 && c.center.y == 0.0 => Some(c.radius), + _ => None, + }); + assert_eq!(r, Some(15.0)); +} + +#[test] +fn entity_lists_round_trip() { + let mut s = session(); + let made = ok(&mut s, "(entmake '((0 . \"CIRCLE\") (8 . \"WALLS\") (10 1.0 2.0 0.0) (40 . 3.0)))"); + assert!(made.contains("CIRCLE")); + assert!(s.doc().unwrap().layer("WALLS").is_some(), "entmake creates the layer"); + assert_eq!(ok(&mut s, "(cdr (assoc 0 (entget (entlast))))"), "\"CIRCLE\""); + assert_eq!(ok(&mut s, "(cdr (assoc 8 (entget (entlast))))"), "\"WALLS\""); + assert_eq!(ok(&mut s, "(cdr (assoc 10 (entget (entlast))))"), "(1.0 2.0 0.0)"); + assert_eq!(ok(&mut s, "(cdr (assoc 410 (entget (entlast))))"), "\"Model\""); + // entmod changes it in place. + ok(&mut s, "(setq d (entget (entlast))) (entmod (subst (cons 40 9.0) (assoc 40 d) d))"); + assert_eq!(ok(&mut s, "(cdr (assoc 40 (entget (entlast))))"), "9.0"); + // A list without a layer uses the current one. + ok(&mut s, "(setvar \"CLAYER\" \"WALLS\") (entmake '((0 . \"LINE\") (10 0 0 0) (11 5 0 0)))"); + assert_eq!(ok(&mut s, "(cdr (assoc 8 (entget (entlast))))"), "\"WALLS\""); + // entnext walks in creation order; entdel deletes and brings back. + assert_eq!(ok(&mut s, "(cdr (assoc 0 (entget (entnext))))"), "\"CIRCLE\""); + assert_eq!(ok(&mut s, "(entnext (entlast))"), "nil"); + ok(&mut s, "(setq e (entlast)) (entdel e)"); + assert_eq!(ok(&mut s, "(entget e)"), "nil"); + ok(&mut s, "(entdel e)"); + assert_eq!(ok(&mut s, "(cdr (assoc 0 (entget e)))"), "\"LINE\""); + assert_eq!(ok(&mut s, "(entmake '((0 . \"NOSUCHTHING\")))"), "nil"); + assert_eq!(ok(&mut s, "(handent \"ZZZZZZ\")"), "nil"); +} + +#[test] +fn selection_sets_and_filters() { + let mut s = session(); + ok(&mut s, "(command \"_.CIRCLE\" '(0 0) 1) (command \"_.CIRCLE\" '(10 0) 2) (command \"_.LINE\" '(0 5) '(20 5) \"\")"); + assert_eq!(ok(&mut s, "(sslength (ssget \"_X\" '((0 . \"CIRCLE\"))))"), "2"); + assert_eq!(ok(&mut s, "(sslength (ssget \"X\" '((0 . \"CIRCLE,LINE\"))))"), "3"); + assert_eq!(ok(&mut s, "(sslength (ssget \"X\" '((-4 . \"\"))))"), "2"); + assert_eq!(ok(&mut s, "(sslength (ssget \"X\" '((0 . \"CIRCLE\") (-4 . \">\") (40 . 1.5))))"), "1"); + assert_eq!(ok(&mut s, "(ssget \"X\" '((0 . \"ARC\")))"), "nil"); + assert_eq!(ok(&mut s, "(sslength (ssget \"_W\" '(-5 -5) '(5 5)))"), "1"); + assert_eq!(ok(&mut s, "(sslength (ssget \"_C\" '(-5 -5) '(5 6)))"), "2"); + assert_eq!(ok(&mut s, "(setq ss (ssadd)) (ssadd (entlast) ss) (sslength ss)"), "1"); + assert_eq!(ok(&mut s, "(ssdel (entlast) ss) (sslength ss)"), "0"); + assert_eq!(ok(&mut s, "(ssname (ssget \"X\") 99)"), "nil"); +} + +#[test] +fn tables_and_variables() { + let mut s = session(); + ok(&mut s, "(command \"_.-LAYER\" \"_M\" \"DOORS\" \"_C\" \"1\" \"\" \"\")"); + assert_eq!(ok(&mut s, "(cdr (assoc 2 (tblsearch \"LAYER\" \"doors\")))"), "\"DOORS\""); + assert_eq!(ok(&mut s, "(tblsearch \"LAYER\" \"nope\")"), "nil"); + assert_eq!(ok(&mut s, "(cdr (assoc 0 (tblnext \"LAYER\" t)))"), "\"LAYER\""); + assert_eq!(ok(&mut s, "(getvar \"CLAYER\")"), "\"DOORS\""); + assert_eq!(ok(&mut s, "(setvar \"OSMODE\" 0)"), "0"); + assert_eq!(ok(&mut s, "(getvar \"OSMODE\")"), "0"); + assert_eq!(ok(&mut s, "(getvar \"NOSUCHVAR\")"), "nil"); +} + +#[test] +fn input_functions_take_supplied_answers() { + let mut s = session(); + let r = eval_with( + &mut s, + "(list (getpoint \"\\nPick: \") (getreal) (getstring) (getint))", + vec![Value::point(&[1.0, 2.0]), Value::Real(2.5), Value::str("hi"), Value::Int(3)], + ); + assert_eq!(r, Ok("((1.0 2.0) 2.5 \"hi\" 3)".into())); + // No answer in a programmatic run: nil. + assert_eq!(eval(&mut s, "(getpoint)"), Ok("nil".into())); +} + +#[test] +fn interactive_routine_waits_for_the_user() { + let mut s = session(); + s.cmdline("(defun c:pt () (setq p (getpoint \"\\nWhere: \")) (command \"_.CIRCLE\" p 1) (princ))").unwrap(); + s.cmdline("PT").unwrap(); + assert!(s.lisp_running()); + assert_eq!(s.prompt_text(), "Where: "); + s.input(crate::Input::Point(cadcraft_geom::Vec2::new(3.0, 4.0))).unwrap(); + assert!(!s.lisp_running()); + assert!(s.doc().unwrap().model.iter().any(|e| matches!(&e.kind, cadcraft_doc::EntityKind::Circle(c) if c.center.x == 3.0 && c.center.y == 4.0))); + // Typed answers and keywords. + s.cmdline("(progn (initget 1 \"Yes No\") (setq ans (getkword \"\\nSure? [Yes/No]: \")))").unwrap(); + s.cmdline("n").unwrap(); + assert_eq!(to_text(&s.lisp_var("ANS"), true), "\"No\""); + s.cmdline("(setq d (getdist '(0 0)))").unwrap(); + s.cmdline("3,4").unwrap(); + assert_eq!(to_text(&s.lisp_var("D"), true), "5.0"); + // Esc cancels the routine. + s.cmdline("(setq z (getint))").unwrap(); + s.cancel(); + assert!(!s.lisp_running()); + // `pause` lets the user answer one prompt of a command. + s.cmdline("(command \"_.CIRCLE\" pause 2)").unwrap(); + assert!(s.lisp_running()); + s.input(crate::Input::Point(cadcraft_geom::Vec2::new(50.0, 50.0))).unwrap(); + assert!(!s.lisp_running()); + assert!(s.doc().unwrap().model.iter().any(|e| matches!(&e.kind, cadcraft_doc::EntityKind::Circle(c) if c.center.x == 50.0 && c.radius == 2.0))); +} + +#[test] +fn appload_and_load() { + let mut s = session(); + let r = + s.execute("appload", &serde_json::json!({"name": "tools.lsp", "text": "(defun c:hi () (princ \"hi\") (princ)) (setq loaded 1)"})).unwrap(); + assert!(r.get("error").is_none(), "{r}"); + assert!(s.log.iter().any(|l| l == "tools.lsp successfully loaded.")); + s.cmdline("HI").unwrap(); + assert_eq!(s.log.last().map(String::as_str), Some("hi")); + // (load) finds a file APPLOAD loaded, by name. + assert_eq!(ok(&mut s, "(setq loaded 0) (load \"tools\") loaded"), "1"); + assert!(eval(&mut s, "(load \"no-such-file-anywhere\")").is_err()); + assert_eq!(ok(&mut s, "(load \"no-such-file-anywhere\" 'missing)"), "MISSING"); + let r = s.execute("lisp", &serde_json::json!({"code": "(princ \"x\") (* 6 7)"})).unwrap(); + assert_eq!(r["value"], "42"); + assert_eq!(r["output"][0], "x"); + let r = s.execute("lisp", &serde_json::json!({"code": "(car 1)"})).unwrap(); + assert!(r["error"].as_str().is_some_and(|e| e.contains("bad argument type"))); +} + +#[test] +fn hostile_lisp_never_panics() { + let mut s = session(); + for code in [ + "(", + ")", + "'", + "\"", + "(1 . 2 3)", + "(quote)", + "(setq)", + "(setq 1 2)", + "(if)", + "(defun)", + "(defun f)", + "(lambda)", + "(repeat 1.5)", + "(repeat -3 1)", + "(foreach 1 2)", + "(mapcar)", + "(mapcar 'car 1)", + "(apply 'car 1)", + "(entget 1)", + "(entmake '(1 2))", + "(entmod nil)", + "(ssget \"Q\")", + "(ssget \"X\" '((-4 . \"().unwrap() <= super::value::MAX_STRING + 64, "{t}"); + ok(&mut s, "(setq x nil s nil)"); + // Many strings, each short, add up to the run's budget. + s.lisp.limits.string_bytes = 1_000_000; + let e = eval(&mut s, "(setq a \"0123456789\") (repeat 20000 (setq b (strcat a a a a a a a a a a)))").unwrap_err(); + assert!(e.contains("too much text"), "{e}"); + let e = eval(&mut s, "(repeat 200000 (princ \"0123456789\"))").unwrap_err(); + assert!(e.contains("too much text"), "{e}"); + // The budget is per run: the next one starts afresh. + assert_eq!(ok(&mut s, "(strcat \"a\" \"b\")"), "\"ab\""); +} + +#[test] +fn a_panic_inside_a_routine_ends_it_with_an_error() { + let mut s = session(); + let n = |s: &Session| s.doc().unwrap().model.handles().len(); + let before = n(&s); + let e = eval(&mut s, "(entmake '((0 . \"LINE\") (10 0 0 0) (11 5 0 0))) (cadcraft-test-panic)").unwrap_err(); + assert!(e.contains("internal error"), "{e}"); + assert_eq!(n(&s), before, "the drawing is put back"); + assert_eq!(ok(&mut s, "(+ 1 2)"), "3"); + + // A routine carried on by the per-frame tick. + let r = s.lisp_eval("(repeat 500000 (setq i 1)) (cadcraft-test-panic)", false, false, Vec::new()).unwrap(); + assert!(r.is_none(), "the routine gave the interface a frame"); + assert!(s.lisp_busy()); + for _ in 0..100 { + if !s.lisp_busy() { + break; + } + s.lisp_tick(); + } + assert!(!s.lisp_running()); + assert!(s.log.iter().any(|l| l.contains("internal error")), "{:?}", s.log); + assert_eq!(ok(&mut s, "(+ 1 2)"), "3"); +} diff --git a/crates/engine/src/lisp/value.rs b/crates/engine/src/lisp/value.rs new file mode 100644 index 0000000..3b283b4 --- /dev/null +++ b/crates/engine/src/lisp/value.rs @@ -0,0 +1,562 @@ +//! AutoLISP values: integers (32-bit, wrapping as AutoLISP's do), reals, strings, symbols, +//! lists built of cons cells, entity names, selection sets, files and functions. +//! +//! Values are shared (`Arc`) so a session stays `Send`. Cons cells (and functions) are dropped +//! iteratively: a list a million long, or nested a million deep, would otherwise overflow the +//! stack when it goes away. +//! +//! Memory is bounded so a runaway routine fails with a LISP error instead of the process running +//! out of memory (which no panic guard can catch): live cons cells are counted ([`live_cells`], +//! checked by the evaluator at every step), no string a built-in makes may be longer than +//! [`MAX_STRING`], and the strings and printed text a run makes share a byte budget +//! ([`charge_bytes`]). + +use std::cell::Cell; +use std::sync::atomic::{AtomicUsize, Ordering}; +use std::sync::{Arc, Mutex}; + +use cadcraft_doc::Handle; + +use super::LispError; + +/// A symbol: its name in upper case (AutoLISP symbols are case-insensitive). +#[derive(Clone, Debug, PartialEq, Eq, Hash, PartialOrd, Ord)] +pub struct Sym(pub Arc); + +impl Sym { + pub fn new(name: &str) -> Sym { + Sym(Arc::from(name.to_ascii_uppercase().as_str())) + } + pub fn name(&self) -> &str { + &self.0 + } +} + +/// A cons cell. +#[derive(Debug)] +pub struct Cons { + pub car: Value, + pub cdr: Value, +} + +/// Most cons cells alive at once (about 64 bytes each): far above real routines (a list of +/// every entity of a large drawing, its `entget` lists), well below memory trouble. +pub const MAX_CELLS: usize = 5_000_000; +/// Longest string a built-in may make, in bytes. +pub const MAX_STRING: usize = 8 << 20; +/// Bytes of new strings, printed text and files read one run may make in all. +pub const STRING_BUDGET: u64 = 2 << 30; + +/// Cons cells alive in the process. +static LIVE_CELLS: AtomicUsize = AtomicUsize::new(0); + +/// Tests that make or cap many cells run one at a time: the count is shared by the process. +#[cfg(test)] +pub(crate) static HEAVY_CELLS: Mutex<()> = Mutex::new(()); + +/// Cons cells alive now (all sessions). +pub fn live_cells() -> usize { + LIVE_CELLS.load(Ordering::Relaxed) +} + +thread_local! { + /// The running slice's string budget: bytes made so far and the most allowed. + static STRING_BYTES: Cell<(u64, u64)> = const { Cell::new((0, STRING_BUDGET)) }; + /// The running slice's cap on live cons cells. + static CELL_LIMIT: Cell = const { Cell::new(MAX_CELLS) }; +} + +/// Start a slice of a run on this thread: it fails when more than `limit` cells are alive. +pub fn set_cell_limit(limit: usize) { + CELL_LIMIT.with(|c| c.set(limit)); +} + +/// Too many cons cells are alive: the error that stops the run. +pub fn check_cells() -> Result<(), LispError> { + if live_cells() > CELL_LIMIT.with(Cell::get) { Err(LispError::quit("out of memory: too many list cells")) } else { Ok(()) } +} + +/// Start a slice of a run on this thread: it has made `used` bytes of its `budget`. +pub fn set_string_budget(used: u64, budget: u64) { + STRING_BYTES.with(|c| c.set((used, budget))); +} + +/// The bytes the run has made so far on this thread. +pub fn string_bytes_used() -> u64 { + STRING_BYTES.with(|c| c.get().0) +} + +/// Count `n` new bytes (a string, printed text, a file read) against the run's budget. +pub fn charge_bytes(n: usize) -> Result<(), LispError> { + STRING_BYTES.with(|c| { + let (used, budget) = c.get(); + let used = used.saturating_add(u64::try_from(n).unwrap_or(u64::MAX)); + c.set((used, budget)); + if used > budget { Err(LispError::quit("out of memory: the routine made too much text")) } else { Ok(()) } + }) +} + +/// A string of `len` bytes may be made. +pub fn check_string_len(len: usize) -> Result<(), LispError> { + if len > MAX_STRING { Err(LispError::quit(format!("out of memory: string longer than {MAX_STRING} bytes"))) } else { Ok(()) } +} + +/// A built-in's result: a new string (one nothing else holds) is checked and charged. +pub fn charge_result(v: &Value) -> Result<(), LispError> { + if let Value::Str(s) = v + && Arc::strong_count(s) == 1 + { + check_string_len(s.len())?; + charge_bytes(s.len())?; + } + Ok(()) +} + +impl Drop for Cons { + fn drop(&mut self) { + // Cells are only made by `Value::cons`, which counts them; never wrap below zero. + if LIVE_CELLS.fetch_sub(1, Ordering::Relaxed) == 0 { + LIVE_CELLS.fetch_add(1, Ordering::Relaxed); + } + // Unlink everything this cell alone holds (the rest of the list, nested lists in its + // car, function bodies) one cell at a time, so nothing recurses on the stack. + let mut work = Vec::new(); + keep_for_drop(&mut work, std::mem::take(&mut self.car)); + keep_for_drop(&mut work, std::mem::take(&mut self.cdr)); + while let Some(v) = work.pop() { + match v { + Value::Cons(c) => { + if let Ok(mut cell) = Arc::try_unwrap(c) { + keep_for_drop(&mut work, std::mem::take(&mut cell.car)); + keep_for_drop(&mut work, std::mem::take(&mut cell.cdr)); + } + } + Value::Func(f) => { + if let Ok(mut func) = Arc::try_unwrap(f) { + keep_for_drop(&mut work, std::mem::take(&mut func.body)); + } + } + _ => {} + } + } + } +} + +/// Values that can hold others go on the work list; atoms are dropped here. +fn keep_for_drop(work: &mut Vec, v: Value) { + if matches!(v, Value::Cons(_) | Value::Func(_)) { + work.push(v); + } +} + +/// A selection set: the entities it holds, in order. `ssadd` and `ssdel` change it in place. +#[derive(Clone, Debug)] +pub struct PickSet { + pub id: u32, + pub items: Arc>>, +} + +/// A function defined in LISP (`defun`, `lambda`). +#[derive(Debug)] +pub struct Func { + pub name: Option, + pub params: Vec, + /// Local variables (after the `/` in the argument list): bound to nil during a call. + pub locals: Vec, + /// The body forms, as a list. + pub body: Value, +} + +/// A built-in function. `special` forms get their arguments unevaluated. +pub struct Builtin { + pub name: &'static str, + pub kind: BuiltinKind, +} + +impl std::fmt::Debug for Builtin { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + write!(f, "", self.name) + } +} + +#[derive(Clone, Copy)] +pub enum BuiltinKind { + /// Evaluated arguments to a value. + Pure(fn(&[Value]) -> Result), + /// Evaluated arguments, with the interpreter (and its session) at hand. + Ctx(fn(&mut super::eval::Ctx<'_>, Vec) -> Result), + /// A special form, handled by the evaluator itself. + Special(super::eval::Special), +} + +#[derive(Clone, Debug, Default)] +pub enum Value { + #[default] + Nil, + Int(i32), + Real(f64), + Str(Arc), + Sym(Sym), + Cons(Arc), + Ename(Handle), + PickSet(PickSet), + File(u32), + Subr(&'static Builtin), + Func(Arc), +} + +impl Value { + pub fn t() -> Value { + Value::Sym(Sym::new("T")) + } + pub fn bool(b: bool) -> Value { + if b { Value::t() } else { Value::Nil } + } + pub fn str(s: &str) -> Value { + Value::Str(Arc::from(s)) + } + pub fn sym(s: &str) -> Value { + Value::Sym(Sym::new(s)) + } + pub fn cons(car: Value, cdr: Value) -> Value { + LIVE_CELLS.fetch_add(1, Ordering::Relaxed); + Value::Cons(Arc::new(Cons { car, cdr })) + } + pub fn is_nil(&self) -> bool { + matches!(self, Value::Nil) + } + /// A proper list of `items`. + pub fn list(items: impl IntoIterator) -> Value { + items.into_iter().rev().fold(Value::Nil, |acc, v| Value::cons(v, acc)) + } + /// `items` followed by `tail` (a dotted list when `tail` is an atom). + pub fn list_with_tail(items: Vec, tail: Value) -> Value { + items.into_iter().rev().fold(tail, |acc, v| Value::cons(v, acc)) + } + /// A point as a list of reals. + pub fn point(p: &[f64]) -> Value { + Value::list(p.iter().map(|v| Value::Real(*v)).collect::>()) + } + pub fn car(&self) -> Value { + match self { + Value::Cons(c) => c.car.clone(), + _ => Value::Nil, + } + } + pub fn cdr(&self) -> Value { + match self { + Value::Cons(c) => c.cdr.clone(), + _ => Value::Nil, + } + } + /// The elements of a list (a dotted tail is left out). + pub fn iter(&self) -> ListIter { + ListIter { next: self.clone() } + } + pub fn to_vec(&self) -> Vec { + self.iter().collect() + } + /// A proper list (nil or cons cells ending in nil). + pub fn is_list(&self) -> bool { + let mut v = self.clone(); + loop { + match v { + Value::Nil => return true, + Value::Cons(c) => v = c.cdr.clone(), + _ => return false, + } + } + } + pub fn as_number(&self) -> Option { + match self { + Value::Int(i) => Some(f64::from(*i)), + Value::Real(r) => Some(*r), + _ => None, + } + } + pub fn as_sym(&self) -> Option<&Sym> { + match self { + Value::Sym(s) => Some(s), + _ => None, + } + } + /// The type name `type` returns (nil for nil). + pub fn type_name(&self) -> Option<&'static str> { + Some(match self { + Value::Nil => return None, + Value::Int(_) => "INT", + Value::Real(_) => "REAL", + Value::Str(_) => "STR", + Value::Sym(_) => "SYM", + Value::Cons(_) => "LIST", + Value::Ename(_) => "ENAME", + Value::PickSet(_) => "PICKSET", + Value::File(_) => "FILE", + Value::Subr(_) => "SUBR", + Value::Func(_) => "USUBR", + }) + } + /// A 2D or 3D point given as a list of two or three numbers. + pub fn as_point(&self) -> Option<[f64; 3]> { + let mut it = self.iter(); + let x = it.next()?.as_number()?; + let y = it.next()?.as_number()?; + let z = match it.next() { + Some(v) => v.as_number()?, + None => 0.0, + }; + (it.next().is_none() && self.is_list()).then_some([x, y, z]) + } +} + +pub struct ListIter { + next: Value, +} + +impl Iterator for ListIter { + type Item = Value; + fn next(&mut self) -> Option { + match std::mem::take(&mut self.next) { + Value::Cons(c) => { + self.next = c.cdr.clone(); + Some(c.car.clone()) + } + _ => None, + } + } +} + +/// Deepest nesting `equal`, printing and reading follow before giving up (hostile input). +pub const MAX_DEPTH: usize = 2_000; + +/// `eq`: the same atom or the same cons cell. +pub fn eq(a: &Value, b: &Value) -> bool { + match (a, b) { + (Value::Cons(x), Value::Cons(y)) => Arc::ptr_eq(x, y), + (Value::Str(x), Value::Str(y)) => Arc::ptr_eq(x, y) || x == y, + (Value::PickSet(x), Value::PickSet(y)) => x.id == y.id, + (Value::Func(x), Value::Func(y)) => Arc::ptr_eq(x, y), + (Value::Subr(x), Value::Subr(y)) => std::ptr::eq(*x, *y), + _ => atom_equal(a, b, 0.0), + } +} + +/// `equal`: the same structure, numbers within `fuzz`. +pub fn equal(a: &Value, b: &Value, fuzz: f64) -> bool { + equal_depth(a, b, fuzz, 0) +} + +fn equal_depth(a: &Value, b: &Value, fuzz: f64, depth: usize) -> bool { + if depth > MAX_DEPTH { + return false; + } + let (mut a, mut b) = (a.clone(), b.clone()); + loop { + match (&a, &b) { + (Value::Cons(x), Value::Cons(y)) => { + if !equal_depth(&x.car, &y.car, fuzz, depth + 1) { + return false; + } + let (na, nb) = (x.cdr.clone(), y.cdr.clone()); + a = na; + b = nb; + } + _ => return atom_equal(&a, &b, fuzz), + } + } +} + +fn atom_equal(a: &Value, b: &Value, fuzz: f64) -> bool { + match (a, b) { + (Value::Nil, Value::Nil) => true, + (Value::Int(x), Value::Int(y)) => x == y, + (Value::Str(x), Value::Str(y)) => x == y, + (Value::Sym(x), Value::Sym(y)) => x == y, + (Value::Ename(x), Value::Ename(y)) => x == y, + (Value::File(x), Value::File(y)) => x == y, + (Value::PickSet(x), Value::PickSet(y)) => x.id == y.id, + (Value::Subr(x), Value::Subr(y)) => std::ptr::eq(*x, *y), + (Value::Func(x), Value::Func(y)) => Arc::ptr_eq(x, y), + (x, y) => match (x.as_number(), y.as_number()) { + (Some(p), Some(q)) if matches!(x, Value::Real(_)) || matches!(y, Value::Real(_)) || fuzz > 0.0 => (p - q).abs() <= fuzz, + _ => false, + }, + } +} + +/// A real as AutoLISP prints it: six significant digits, always with a decimal point. +pub fn real_text(r: f64) -> String { + if !r.is_finite() { + return if r.is_nan() { + "-1.#IND".into() + } else if r > 0.0 { + "1.#INF".into() + } else { + "-1.#INF".into() + }; + } + if r == 0.0 { + return "0.0".into(); + } + let exp = r.abs().log10().floor() as i32; + // As C's %g with six digits: exponent form outside 1e-5 ..< 1e6. + if !(-5..6).contains(&exp) { + // Exponent form: d.ddddde+NNN + let m = r / 10f64.powi(exp); + let mut s = trim_fraction(&format!("{m:.5}")); + if !s.contains('.') { + s.push_str(".0"); + } + return format!("{s}e{}{:03}", if exp < 0 { '-' } else { '+' }, exp.abs()); + } + let decimals = (5 - exp).max(0) as usize; + let mut s = trim_fraction(&format!("{r:.decimals$}")); + if !s.contains('.') { + s.push_str(".0"); + } + s +} + +fn trim_fraction(s: &str) -> String { + if s.contains('.') { + let t = s.trim_end_matches('0'); + t.strip_suffix('.').map_or(t.to_string(), |u| format!("{u}.0")) + } else { + s.to_string() + } +} + +/// `prin1`/`print` text (`escape`: strings quoted with their escapes) or `princ` text. +pub fn to_text(v: &Value, escape: bool) -> String { + let mut out = String::new(); + write_value(&mut out, v, escape, 0); + if out.len() > MAX_STRING { + let mut end = MAX_STRING; + while !out.is_char_boundary(end) { + end -= 1; + } + out.truncate(end); + } + out +} + +fn write_value(out: &mut String, v: &Value, escape: bool, depth: usize) { + // Text past the string cap is cut (a list sharing its parts can print exponentially long). + if out.len() > MAX_STRING { + return; + } + if depth > MAX_DEPTH { + out.push_str("..."); + return; + } + match v { + Value::Nil => out.push_str("nil"), + Value::Int(i) => out.push_str(&i.to_string()), + Value::Real(r) => out.push_str(&real_text(*r)), + Value::Str(s) => { + if escape { + out.push('"'); + for c in s.chars() { + match c { + '"' => out.push_str("\\\""), + '\\' => out.push_str("\\\\"), + '\n' => out.push_str("\\n"), + '\t' => out.push_str("\\t"), + '\r' => out.push_str("\\r"), + '\u{1b}' => out.push_str("\\e"), + c => out.push(c), + } + } + out.push('"'); + } else { + out.push_str(s); + } + } + Value::Sym(s) => out.push_str(s.name()), + Value::Cons(_) => { + // (quote x) prints as 'x. + if let (Value::Sym(s), Value::Cons(rest)) = (v.car(), v.cdr()) + && s.name() == "QUOTE" + && rest.cdr.is_nil() + { + out.push('\''); + write_value(out, &rest.car, escape, depth + 1); + return; + } + out.push('('); + let mut cur = v.clone(); + let mut first = true; + let mut count = 0usize; + loop { + match cur { + Value::Cons(c) => { + if !first { + out.push(' '); + } + first = false; + write_value(out, &c.car, escape, depth + 1); + cur = c.cdr.clone(); + count += 1; + if count > 1_000_000 || out.len() > MAX_STRING { + out.push_str(" ..."); + break; + } + } + Value::Nil => break, + other => { + out.push_str(" . "); + write_value(out, &other, escape, depth + 1); + break; + } + } + } + out.push(')'); + } + Value::Ename(h) => out.push_str(&format!("", h.0)), + Value::PickSet(p) => out.push_str(&format!("", p.id)), + Value::File(f) => out.push_str(&format!("#")), + Value::Subr(b) => out.push_str(&format!("#", "0", b.name)), + Value::Func(f) => out.push_str(&format!("#", f.name.as_ref().map_or("-lambda-", |s| s.name()))), + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn reals_print_with_six_significant_digits() { + assert_eq!(real_text(1.0), "1.0"); + assert_eq!(real_text(std::f64::consts::PI), "3.14159"); + assert_eq!(real_text(1.23456789), "1.23457"); + assert_eq!(real_text(0.1), "0.1"); + assert_eq!(real_text(12.5), "12.5"); + assert_eq!(real_text(-2.0), "-2.0"); + assert_eq!(real_text(100000.0), "100000.0"); + assert_eq!(real_text(123456.7), "123457.0"); + assert_eq!(real_text(0.0001), "0.0001"); + assert_eq!(real_text(1_000_000.0), "1.0e+006"); + assert_eq!(real_text(0.000001), "1.0e-006"); + } + + #[test] + fn a_long_list_drops_without_overflowing_the_stack() { + let _heavy = HEAVY_CELLS.lock().unwrap_or_else(|e| e.into_inner()); + let mut l = Value::Nil; + for i in 0..2_000_000 { + l = Value::cons(Value::Int(i), l); + } + drop(l); + } + + #[test] + fn printing_and_equality() { + let l = Value::list(vec![Value::Int(1), Value::str("a\"b"), Value::cons(Value::Int(8), Value::str("0"))]); + assert_eq!(to_text(&l, true), "(1 \"a\\\"b\" (8 . \"0\"))"); + assert_eq!(to_text(&l, false), "(1 a\"b (8 . 0))"); + assert!(equal(&l, &l.clone(), 0.0)); + assert!(equal(&Value::Real(1.0), &Value::Real(1.0000001), 1e-3)); + assert!(!equal(&Value::Real(1.0), &Value::Real(1.1), 1e-3)); + assert!(eq(&Value::sym("a"), &Value::sym("A"))); + } +} diff --git a/crates/engine/src/prompt.rs b/crates/engine/src/prompt.rs index 597fe05..20388ad 100644 --- a/crates/engine/src/prompt.rs +++ b/crates/engine/src/prompt.rs @@ -53,6 +53,10 @@ pub struct Prompt { /// [`Input::Text`]. #[serde(skip_serializing_if = "Option::is_none")] pub picker: Option, + /// Shown as written, without keywords, a default or a colon added: an AutoLISP `get…` + /// prompt (the routine writes all of it). + #[serde(skip_serializing_if = "std::ops::Not::not")] + pub raw: bool, } /// Parse `@distance:". pub fn display(&self) -> String { + if self.raw { + return self.message.trim_matches(['\n', '\r']).to_string(); + } let mut s = self.message.clone(); if !self.keywords.is_empty() { // A question offers its answers ("Fix any errors detected? [Yes/No]"); anything else diff --git a/crates/engine/src/sysvars.rs b/crates/engine/src/sysvars.rs index 2914f61..7949599 100644 --- a/crates/engine/src/sysvars.rs +++ b/crates/engine/src/sysvars.rs @@ -40,6 +40,7 @@ const SESSION_VARS: &[&str] = &[ "PICKBOX", "APERTURE", "PICKFIRST", + "ACADLSPASDOC", "PICKADD", "PICKSTYLE", "GRIPSIZE", @@ -95,6 +96,7 @@ pub fn get(s: &Session, name: &str) -> Option { "PICKBOX" => json!(st.pickbox), "APERTURE" => json!(st.aperture), "PICKFIRST" => json!(i32::from(st.pickfirst)), + "ACADLSPASDOC" => json!(i32::from(st.acadlspasdoc)), "PICKADD" => json!(i32::from(st.pickadd)), "PICKSTYLE" => json!(st.pickstyle), "GRIPSIZE" => json!(st.gripsize), @@ -241,6 +243,7 @@ pub fn set(s: &mut Session, name: &str, v: &Value) -> Result<()> { "PICKBOX" => st.pickbox = as_f64(v).ok_or_else(bad)?.clamp(0.0, 50.0), "APERTURE" => st.aperture = as_f64(v).ok_or_else(bad)?.clamp(1.0, 50.0), "PICKFIRST" => st.pickfirst = as_bool(v).ok_or_else(bad)?, + "ACADLSPASDOC" => st.acadlspasdoc = as_bool(v).ok_or_else(bad)?, "PICKADD" => st.pickadd = as_bool(v).ok_or_else(bad)?, "PICKSTYLE" => st.pickstyle = as_i(v).filter(|b| (0..=3).contains(b)).and_then(|b| u8::try_from(b).ok()).ok_or_else(bad)?, "GRIPSIZE" => st.gripsize = as_f64(v).ok_or_else(bad)?.clamp(1.0, 255.0), diff --git a/crates/engine/tests/lisp_corpus.rs b/crates/engine/tests/lisp_corpus.rs new file mode 100644 index 0000000..09f9ea0 --- /dev/null +++ b/crates/engine/tests/lisp_corpus.rs @@ -0,0 +1,239 @@ +//! The AutoLISP conformance corpus (#648): each case's routine runs in a new drawing and must +//! leave exactly the expected entities, layers and printed text. The corpus lives in its own +//! repository; point `CADCRAFT_LISP_CORPUS` at its `cases` directory (or the repository) to run +//! it. Without it the test only says so. +#![allow(clippy::unwrap_used, clippy::expect_used, clippy::panic)] + +use std::path::{Path, PathBuf}; + +use cadcraft_engine::Session; +use cadcraft_engine::cmd::file::{EntityCodec, set_entity_codec}; +use cadcraft_engine::doc::Entity; +use serde_json::{Value, json}; + +fn cases_dir() -> Option { + let root = PathBuf::from(std::env::var_os("CADCRAFT_LISP_CORPUS")?); + let cases = root.join("cases"); + Some(if cases.is_dir() { cases } else { root }) +} + +/// An entity's DXF groups as (code, value) pairs. +fn groups(d: &cadcraft_engine::doc::Drawing, e: &Entity) -> (String, Vec<(i32, Value)>) { + let (kind, tags) = cadcraft_io::entity_groups(d, e); + let v = tags + .into_iter() + .map(|t| { + let v = match t.value { + cadcraft_dxf::Value::Str(s) | cadcraft_dxf::Value::Hex(s) => json!(s), + cadcraft_dxf::Value::Real(r) => json!(r), + cadcraft_dxf::Value::Int(i) => json!(i), + cadcraft_dxf::Value::Bool(b) => json!(i32::from(b)), + }; + (t.code, v) + }) + .collect(); + (kind, v) +} + +fn num(g: &[(i32, Value)], code: i32) -> Option { + g.iter().find(|(c, _)| *c == code).and_then(|(_, v)| v.as_f64()) +} + +fn point(g: &[(i32, Value)], code: i32) -> Value { + json!([num(g, code).unwrap_or(0.0), num(g, code + 10).unwrap_or(0.0), num(g, code + 20).unwrap_or(0.0)]) +} + +/// The fields the corpus checks, read from an entity's groups. +fn actual(d: &cadcraft_engine::doc::Drawing, e: &Entity) -> Value { + let (kind, g) = groups(d, e); + let s = |code: i32| g.iter().find(|(c, _)| *c == code).and_then(|(_, v)| v.as_str().map(str::to_string)).unwrap_or_default(); + let mut o = json!({ "type": kind, "layer": s(8) }); + let m = o.as_object_mut().unwrap(); + match kind.as_str() { + "LINE" => { + m.insert("start".into(), point(&g, 10)); + m.insert("end".into(), point(&g, 11)); + } + "CIRCLE" | "ARC" => { + m.insert("center".into(), point(&g, 10)); + m.insert("radius".into(), json!(num(&g, 40).unwrap_or(0.0))); + if kind == "ARC" { + m.insert("start_angle".into(), json!(num(&g, 50).unwrap_or(0.0))); + m.insert("end_angle".into(), json!(num(&g, 51).unwrap_or(0.0))); + } + } + "POINT" => { + m.insert("location".into(), point(&g, 10)); + } + "LWPOLYLINE" => { + let xs: Vec = g.iter().filter(|(c, _)| *c == 10).filter_map(|(_, v)| v.as_f64()).collect(); + let ys: Vec = g.iter().filter(|(c, _)| *c == 20).filter_map(|(_, v)| v.as_f64()).collect(); + let verts: Vec = xs.iter().zip(&ys).map(|(x, y)| json!([x, y])).collect(); + m.insert("closed".into(), json!(num(&g, 70).unwrap_or(0.0) as i64 & 1 == 1)); + m.insert("vertices".into(), json!(verts)); + } + "TEXT" => { + m.insert("insert".into(), point(&g, 10)); + m.insert("height".into(), json!(num(&g, 40).unwrap_or(0.0))); + m.insert("rotation".into(), json!(num(&g, 50).unwrap_or(0.0))); + m.insert("text".into(), json!(s(1))); + } + "DIMENSION" => { + let k = num(&g, 70).unwrap_or(0.0) as i64 & 7; + m.insert( + "kind".into(), + json!(if k == 0 { + "linear" + } else if k == 1 { + "aligned" + } else { + "other" + }), + ); + m.insert("xline1".into(), point(&g, 13)); + m.insert("xline2".into(), point(&g, 14)); + m.insert("rotation".into(), json!(num(&g, 50).unwrap_or(0.0))); + m.insert("measurement".into(), json!(num(&g, 42).unwrap_or(0.0))); + } + _ => {} + } + o +} + +fn close(a: &Value, b: &Value, tol: f64) -> bool { + match (a, b) { + (Value::Number(x), Value::Number(y)) => (x.as_f64().unwrap_or(f64::NAN) - y.as_f64().unwrap_or(f64::NAN)).abs() <= tol, + (Value::Array(x), Value::Array(y)) => { + // A 2D point compares with z = 0. + let pad = |v: &Vec| -> Vec { + let mut v = v.clone(); + if v.len() == 2 && v.iter().all(Value::is_number) { + v.push(json!(0.0)); + } + v + }; + let (x, y) = (pad(x), pad(y)); + x.len() == y.len() && x.iter().zip(&y).all(|(p, q)| close(p, q, tol)) + } + _ => a == b, + } +} + +/// Closed polylines match as the same cyclic sequence in either direction. +fn same_ring(have: &[Value], want: &[Value], tol: f64) -> bool { + let n = want.len(); + if have.len() != n { + return false; + } + if n == 0 { + return true; + } + for start in 0..n { + for dir in [1isize, -1] { + let ok = (0..n).all(|i| { + let j = (start as isize + dir * i as isize).rem_euclid(n as isize) as usize; + close(&have[j], &want[i], tol) + }); + if ok { + return true; + } + } + } + false +} + +fn matches(have: &Value, want: &Value, tol: f64) -> bool { + let Some(w) = want.as_object() else { return false }; + w.iter().all(|(k, v)| { + let h = have.get(k).unwrap_or(&Value::Null); + if k == "vertices" && have.get("closed") == Some(&json!(true)) { + return match (h, v) { + (Value::Array(h), Value::Array(v)) => same_ring(h, v, tol), + _ => false, + }; + } + close(h, v, tol) + }) +} + +fn run_case(dir: &Path) -> Result<(), String> { + let routine = std::fs::read_to_string(dir.join("routine.lsp")).map_err(|e| e.to_string())?; + let expected: Value = + serde_json::from_str(&std::fs::read_to_string(dir.join("expected.json")).map_err(|e| e.to_string())?).map_err(|e| e.to_string())?; + let mut s = Session::new(); + if let Some(vars) = expected["preconditions"]["sysvars"].as_object() { + for (k, v) in vars { + cadcraft_engine::sysvars::set(&mut s, k, v).map_err(|e| format!("setvar {k}: {e}"))?; + } + } + let from = s.log.len(); + match s.lisp_load("routine.lsp", &routine, true) { + Ok(Some(Err(e))) => return Err(format!("LISP error: {e}\n{:#?}", &s.log[from..])), + Err(e) => return Err(e.to_string()), + _ => {} + } + let exp = &expected["expect"]; + let tol = exp["tolerance"].as_f64().unwrap_or(1e-9); + let d = s.doc().map_err(|e| e.to_string())?; + let mut have: Vec = d.model.iter().map(|e| actual(d, e)).collect(); + let want = exp["entities"].as_array().cloned().unwrap_or_default(); + let mut missing = Vec::new(); + for w in &want { + match have.iter().position(|h| matches(h, w, tol)) { + Some(i) => { + have.remove(i); + } + None => missing.push(w.clone()), + } + } + if !missing.is_empty() || !have.is_empty() { + return Err(format!( + "missing {}:\n{}\nunexpected {}:\n{}\nlog:\n{}", + missing.len(), + serde_json::to_string_pretty(&missing).unwrap_or_default(), + have.len(), + serde_json::to_string_pretty(&have).unwrap_or_default(), + s.log[from..].join("\n") + )); + } + for l in exp["layers"].as_array().cloned().unwrap_or_default() { + let name = l["name"].as_str().unwrap_or(""); + let layer = d.layer(name).ok_or_else(|| format!("layer {name} missing"))?; + if let Some(c) = l["color"].as_i64() { + let have = match layer.color { + cadcraft_color::Color::Index(i) => i64::from(i), + _ => -1, + }; + if have != c { + return Err(format!("layer {name}: colour {have}, expected {c}")); + } + } + } + if let Some(p) = exp["printed"].as_str() { + let out = s.log[from..].join("\n"); + if !out.contains(p.trim_start_matches('\n')) { + return Err(format!("printed {p:?} not found in:\n{out}")); + } + } + Ok(()) +} + +#[test] +fn autolisp_corpus() { + set_entity_codec(EntityCodec { groups: cadcraft_io::entity_groups, entity: cadcraft_io::entity_from_groups }); + let Some(dir) = cases_dir() else { + eprintln!("CADCRAFT_LISP_CORPUS is not set: the AutoLISP corpus is skipped"); + return; + }; + let mut cases: Vec = + std::fs::read_dir(&dir).unwrap().filter_map(|e| e.ok().map(|e| e.path())).filter(|p| p.join("routine.lsp").is_file()).collect(); + cases.sort(); + assert!(!cases.is_empty(), "no cases in {}", dir.display()); + let mut failed = Vec::new(); + for c in &cases { + if let Err(e) = run_case(c) { + failed.push(format!("== {}\n{e}", c.file_name().and_then(|n| n.to_str()).unwrap_or("?"))); + } + } + assert!(failed.is_empty(), "{} of {} cases failed:\n{}", failed.len(), cases.len(), failed.join("\n\n")); +} diff --git a/crates/io/src/dxf_read.rs b/crates/io/src/dxf_read.rs index 375246b..7998cc8 100644 --- a/crates/io/src/dxf_read.rs +++ b/crates/io/src/dxf_read.rs @@ -2232,3 +2232,9 @@ fn helix(tags: &[Tag]) -> Helix { } .sanitized() } + +/// An entity from the groups of a DXF record of type `kind` (without its `0` group), as the +/// reader makes it. AutoLISP's `entmake` and `entmod` are built on it. +pub fn entity_from_groups(kind: &str, tags: &[Tag]) -> Option<(Common, EntityKind)> { + entity(&kind.to_ascii_uppercase(), tags) +} diff --git a/crates/io/src/dxf_write.rs b/crates/io/src/dxf_write.rs index 91e863a..1177f74 100644 --- a/crates/io/src/dxf_write.rs +++ b/crates/io/src/dxf_write.rs @@ -759,6 +759,8 @@ fn entity(w: &mut W, d: &Drawing, e: &Entity, owner: &str, paper: bool, cx: &Ctx DimKind::ArcLength => 1, }; w.i(70, ty | 32 | if dm.user_text_pos { 128 } else { 0 }); + // The actual measurement (read-only in DXF): AutoLISP's entget shows it. + w.f(42, g.measurement); if !dm.text.is_empty() { w.s(1, &dm.text); } @@ -2591,3 +2593,23 @@ fn scale_list(w: &mut W, scales: &[(&cadcraft_doc::AnnoScale, String)], dict: &s fn cadcraft_fonts_name() -> &'static str { "CADCraft Stroke" } + +/// One entity's DXF groups, as the writer stores them, without its `0` group: its type name +/// and the groups of its record (an entity written as several records, a POLYLINE and its +/// VERTEXes, gives its first). Handles of objects outside the entity (owner, styles) are left +/// out. AutoLISP's `entget` is built on it. +pub fn entity_groups(d: &Drawing, e: &Entity) -> (String, Vec) { + let mut w = W { + t: Vec::new(), + next: d.handseed.max(0x100).saturating_add(0x1000), + pstyles: HashMap::new(), + layers: HashMap::new(), + reactors: HashMap::new(), + }; + let cx = Ctx { target: Version::R2018, ..Ctx::default() }; + let paper = d.space_of(e.handle).is_some_and(|s| !matches!(s, cadcraft_doc::Space::Model)); + entity(&mut w, d, e, "0", paper, &cx); + let mut tags = w.t.into_iter(); + let kind = tags.next().filter(|t| t.code == 0).map(|t| t.value.as_str()).unwrap_or_default(); + (kind, tags.take_while(|t| t.code != 0).filter(|t| t.code != 330).collect()) +} diff --git a/crates/io/src/lib.rs b/crates/io/src/lib.rs index d6faadc..a662a4e 100644 --- a/crates/io/src/lib.rs +++ b/crates/io/src/lib.rs @@ -24,6 +24,8 @@ use cadcraft_doc::{Drawing, Space}; use cadcraft_geom::Bounds2; pub use cadcraft_dxf::Version; +pub use dxf_read::entity_from_groups; +pub use dxf_write::entity_groups; pub use pdf::{PdfOptions, pdf, plot}; /// How a drawing is saved as DXF or DWG. diff --git a/crates/render/src/dim.rs b/crates/render/src/dim.rs index f1bff46..a57142b 100644 --- a/crates/render/src/dim.rs +++ b/crates/render/src/dim.rs @@ -39,6 +39,8 @@ pub struct DimGeometry { /// The font glyphs of `text_glyphs` (outline indices into it). pub text_runs: Vec, pub text_pos: Vec2, + /// The measured value (DXF group 42): a length, or the angle in radians. + pub measurement: f64, pub text_angle: f64, pub text_height: f64, /// Plain text of the dimension. @@ -527,6 +529,7 @@ pub fn dimension_geometry_with(d: &Dimension, st: &DimStyle, dimscale: f64, font // The measurement is along the dimension direction whatever the extension lines do. let meas = (p2 - p1).dot(dir).abs(); g.mtext = linear_text(meas, d, st, ""); + g.measurement = meas; // From here on: the length drawn between the extension lines. let meas = f1.dist(f2); if !st.suppress_ext1 { @@ -739,6 +742,7 @@ pub fn dimension_geometry_with(d: &Dimension, st: &DimStyle, dimscale: f64, font let (center, r) = if radius { (a, a.dist(b)) } else { (a.mid(b), a.dist(b) / 2.0) }; let meas = if radius { r } else { 2.0 * r }; g.mtext = linear_text(meas, d, st, if radius { "R" } else { "%%c" }); + g.measurement = meas; let (tw, tht) = measure(&g.mtext); let u = (b - center).normalized(); let u = if u == Vec2::ZERO || !u.is_finite() { Vec2::X } else { u }; @@ -818,6 +822,7 @@ pub fn dimension_geometry_with(d: &Dimension, st: &DimStyle, dimscale: f64, font let arc = if cadcraft_geom::angle_in_sweep(vertex.angle_to(arc_pt), s, e) { Arc::new(vertex, r, s, e) } else { Arc::new(vertex, r, e, s) }; let sweep = ccw_sweep(arc.start, arc.end); + g.measurement = sweep; // DIMAZIN 1 / 2 suppress leading / trailing zeros (DIMZIN's bits 4 / 8). let azin = (st.angular_zero_suppression & 3) * 4; let txt = format_angle(sweep, st.angular_unit, st.angular_decimals, azin); @@ -858,6 +863,7 @@ pub fn dimension_geometry_with(d: &Dimension, st: &DimStyle, dimscale: f64, font let origin = d.defpt.xy(); let meas = if x_type { (feature.x - origin.x).abs() } else { (feature.y - origin.y).abs() }; g.mtext = linear_text(meas, d, st, ""); + g.measurement = meas; let (tw, _) = measure(&g.mtext); g.dim(vec![feature, leader_end]); if x_type { @@ -876,6 +882,7 @@ pub fn dimension_geometry_with(d: &Dimension, st: &DimStyle, dimscale: f64, font let meas = r * arc.sweep(); // DIMARCSYM: the arc symbol before the text (0), over it (1) or none (2). g.mtext = linear_text(meas, d, st, if st.arc_symbol == 0 { "⌒" } else { "" }); + g.measurement = meas; let mut pts = Vec::new(); arc.tessellate(arc.radius * 1e-3, &mut pts); g.dim(pts); @@ -1010,6 +1017,7 @@ mod tests { fn horizontal_measures_dx() { let g = dimension_geometry(&lin((0.0, 0.0), (10.0, 3.0), (0.0, 5.0), 0.0), &DimStyle::default(), 1.0); assert_eq!(g.value, "10.0000"); + assert_eq!(g.measurement, 10.0); assert!(!g.text.is_empty()); assert_eq!(g.fills.len(), 2); assert_eq!(g.lines_of(LineRole::Ext).count(), 2); @@ -1019,6 +1027,7 @@ mod tests { fn vertical_measures_dy() { let g = dimension_geometry(&lin((0.0, 0.0), (10.0, 3.0), (15.0, 0.0), std::f64::consts::FRAC_PI_2), &DimStyle::default(), 1.0); assert_eq!(g.value, "3.0000"); + assert!((g.measurement - 3.0).abs() < 1e-12, "{}", g.measurement); } #[test] diff --git a/crates/ui-egui/src/canvas.rs b/crates/ui-egui/src/canvas.rs index 251ed5b..9ce943e 100644 --- a/crates/ui-egui/src/canvas.rs +++ b/crates/ui-egui/src/canvas.rs @@ -1191,7 +1191,7 @@ pub fn show(app: &mut CadApp, ui: &mut egui::Ui) { // Double-click a viewport to work inside it; double-click the sheet outside it to return. if inside && dbl_primary - && app.session.running.is_none() + && !app.session.prompting() && matches!(app.session.layout_space(), cadcraft_doc::Space::Paper(_)) && let Some(hp) = hover_pos { @@ -1321,7 +1321,7 @@ pub fn show(app: &mut CadApp, ui: &mut egui::Ui) { && !middle_down && let Some(p) = app.canvas.cursor { - if app.session.running.is_some() { + if app.session.prompting() { // Ctrl held while picking the point of a grip edit makes copies (the Copy option). if mods.ctrl && app.session.running.as_ref().is_some_and(|r| r.id == "grip") { let _ = app.session.input(Input::Keyword("Copy".into())); @@ -1364,7 +1364,7 @@ pub fn show(app: &mut CadApp, ui: &mut egui::Ui) { && let Some(end) = ui.input(|i| i.pointer.interact_pos()) { let end = xf.to_world(end); - let done = if app.session.running.is_some() { app.session.input(Input::Point(end)) } else { app.session.idle_click(end, mods.shift) }; + let done = if app.session.prompting() { app.session.input(Input::Point(end)) } else { app.session.idle_click(end, mods.shift) }; if let Err(e) = done { app.session.echo(e.to_string()); } @@ -1373,7 +1373,7 @@ pub fn show(app: &mut CadApp, ui: &mut egui::Ui) { // Right-click acts as Enter while a command runs (the classic CAD default; held, it opens the // command menu); otherwise it opens the shortcut menu (Repeat, Clipboard, …). // Shift/Ctrl+right-click opens the object snap menu. - let idle = app.session.running.is_none(); + let idle = !app.session.prompting(); if inside && pressed_secondary { app.canvas.snap_menu = mods.shift || mods.ctrl; } @@ -1545,11 +1545,11 @@ pub fn show(app: &mut CadApp, ui: &mut egui::Ui) { } // Grips on selected objects (when idle or editing grips). let grip_edit = app.session.running.as_ref().is_some_and(|r| r.id == "grip"); - if (!grip_edit && (app.canvas.grip_editing || app.session.running.is_some())) || sel.is_empty() { + if (!grip_edit && (app.canvas.grip_editing || app.session.prompting())) || sel.is_empty() { app.canvas.hot_grips.clear(); } app.canvas.grip_editing = grip_edit; - if (app.session.running.is_none() || grip_edit) + if (!app.session.prompting() || grip_edit) && let Ok(st) = app.session.state() { let gs = app.session.settings.gripsize as f32; @@ -1595,7 +1595,7 @@ pub fn show(app: &mut CadApp, ui: &mut egui::Ui) { ); draw_list(&painter, &xf, &list, bg, false); } - } else if let (Some(c), true) = (app.canvas.cursor, app.session.running.is_some()) { + } else if let (Some(c), true) = (app.canvas.cursor, app.session.prompting()) { let ents = app.session.preview(c); if !ents.is_empty() && let Ok(st) = app.session.state() diff --git a/crates/ui-egui/src/cmdline.rs b/crates/ui-egui/src/cmdline.rs index 6974a19..c136b70 100644 --- a/crates/ui-egui/src/cmdline.rs +++ b/crates/ui-egui/src/cmdline.rs @@ -312,7 +312,7 @@ pub fn keyboard(app: &mut CadApp, ctx: &egui::Context) { mac, press, &app.cmd.buffer, - app.session.running.is_some(), + app.session.prompting(), !app.session.selection().is_empty(), app.cmd.typed_since_selection, ); @@ -345,7 +345,7 @@ pub fn keyboard(app: &mut CadApp, ctx: &egui::Context) { } } Key::Tab => tab(app), - Key::Delete if app.cmd.buffer.is_empty() && app.session.running.is_none() => { + Key::Delete if app.cmd.buffer.is_empty() && !app.session.prompting() => { let _ = app.run("erase.selection", serde_json::json!({})); } _ => {} @@ -374,7 +374,7 @@ pub fn submit(app: &mut CadApp) { let text = std::mem::take(&mut app.cmd.buffer); app.cmd.locked_second = None; app.cmd.history_pos = None; - if !text.trim().is_empty() && app.session.running.is_none() { + if !text.trim().is_empty() && !app.session.prompting() { app.cmd.history.push(text.clone()); if app.cmd.history.len() > 200 { app.cmd.history.remove(0); @@ -428,11 +428,13 @@ pub fn show(app: &mut CadApp, ui: &mut egui::Ui, canvas: Rect) { let gw = g.size().x; p.galley(pos2(x, bar.center().y - g.size().y / 2.0), g, t.text_faint); x += gw; - let g = p.layout_no_wrap(crate::i18n::t(&pr.message).to_string(), font.clone(), t.text); + // A LISP `get…` prompt shows as the routine wrote it (no keywords, default or colon added). + let message = if pr.raw { pr.display() } else { crate::i18n::t(&pr.message).to_string() }; + let g = p.layout_no_wrap(message, font.clone(), t.text); let gw = g.size().x; p.galley(pos2(x, bar.center().y - g.size().y / 2.0), g, t.text); x += gw; - if !pr.keywords.is_empty() { + if !pr.raw && !pr.keywords.is_empty() { let g = p.layout_no_wrap(if pr.message.is_empty() { " [".into() } else { crate::tl!(" or [").into() }, font.clone(), t.text); let gw = g.size().x; p.galley(pos2(x, bar.center().y - g.size().y / 2.0), g, t.text); @@ -463,16 +465,20 @@ pub fn show(app: &mut CadApp, ui: &mut egui::Ui, canvas: Rect) { p.galley(pos2(x, bar.center().y - g.size().y / 2.0), g, t.text); x += gw; } - if let Some(d) = &pr.default { + if let Some(d) = pr.default.as_ref().filter(|_| !pr.raw) { let g = p.layout_no_wrap(format!(" <{d}>"), font.clone(), t.text); let gw = g.size().x; p.galley(pos2(x, bar.center().y - g.size().y / 2.0), g, t.text); x += gw; } - let g = p.layout_no_wrap(": ".into(), font.clone(), t.text); - let gw = g.size().x; - p.galley(pos2(x, bar.center().y - g.size().y / 2.0), g, t.text); - x += gw; + if !pr.raw { + let g = p.layout_no_wrap(": ".into(), font.clone(), t.text); + let gw = g.size().x; + p.galley(pos2(x, bar.center().y - g.size().y / 2.0), g, t.text); + x += gw; + } else if !pr.message.ends_with(' ') { + x += 4.0; + } } None => { if app.cmd.buffer.is_empty() { @@ -502,7 +508,7 @@ pub fn show(app: &mut CadApp, ui: &mut egui::Ui, canvas: Rect) { false, ); // AutoComplete list. - if app.session.running.is_none() { + if !app.session.prompting() { let sug = suggestions(&app.cmd.buffer); if !sug.is_empty() { let rh = 20.0; @@ -564,7 +570,7 @@ fn zones(app: &CadApp, canvas: Rect, bar: Rect) -> Zones { let top = window.or(lines).map_or(bar.top(), |r| r.top()); let grip = Rect::from_min_max(pos2(bar.left(), top - 3.0), pos2(bar.right(), top + 3.0)); let mut all = bar.union(grip); - if app.session.running.is_none() { + if !app.session.prompting() { let k = suggestions(&app.cmd.buffer).len(); if k > 0 { let above = if n == 0 { 0.0 } else { LINE_H * n as f32 + 6.0 }; diff --git a/crates/ui-egui/src/context_menu.rs b/crates/ui-egui/src/context_menu.rs index 5a8ef8f..8c53a13 100644 --- a/crates/ui-egui/src/context_menu.rs +++ b/crates/ui-egui/src/context_menu.rs @@ -218,7 +218,7 @@ pub fn choose(app: &mut CadApp, id: &str) { /// prompts; command names are the history's). pub fn note_input(app: &mut CadApp, text: &str) { let t = text.trim(); - if app.session.running.is_none() || t.is_empty() { + if !app.session.prompting() || t.is_empty() { return; } let recent = &mut app.cmd.recent_input; @@ -320,7 +320,7 @@ pub fn in_command(app: &mut CadApp, ui: &egui::Ui, inside: bool, right_clicked: { ctx.data_mut(|d| d.insert_temp(press_id, Press(now, p))); } - let running = app.session.running.is_some() && !app.canvas.snap_menu; + let running = app.session.prompting() && !app.canvas.snap_menu; let mut open = false; if released && let Some(Press(t0, p0)) = ctx.data_mut(|d| d.remove_temp::(press_id)) { // A drag isn't a click; a click held long enough asks for the menu. diff --git a/crates/ui-egui/src/control.rs b/crates/ui-egui/src/control.rs index 48f9a2b..616ddec 100644 --- a/crates/ui-egui/src/control.rs +++ b/crates/ui-egui/src/control.rs @@ -373,7 +373,7 @@ pub fn handle(app: &mut CadApp, ctx: &egui::Context, req: &ControlRequest) -> Ou } let r = match s("button").unwrap_or("left") { "right" => app.session.input(Input::Enter), - _ if app.session.running.is_some() => app.session.input(Input::Point(wp)), + _ if app.session.prompting() => app.session.input(Input::Point(wp)), _ => app.session.idle_click(wp, p.get("shift").and_then(Value::as_bool).unwrap_or(false)), }; match r { diff --git a/crates/ui-egui/src/i18n/uk.tsv b/crates/ui-egui/src/i18n/uk.tsv index 667bfb3..a8722a1 100644 --- a/crates/ui-egui/src/i18n/uk.tsv +++ b/crates/ui-egui/src/i18n/uk.tsv @@ -321,6 +321,7 @@ Equal Рівність Erase Стерти Evaluate Обчислити + Evaluate LISP Обчислити LISP Exclude from new selection set Виключити з нового набору вибраних об'єктів Explode Розчленувати Export Експортувати @@ -500,6 +501,7 @@ List Text Styles Список текстових стилів Load all Завантажити всі Load... Завантажити... + Load Application... Завантажити застосунок... Loaded linetypes Завантажені типи ліній Lock Заблокувати Lock Layer Заблокувати шар diff --git a/crates/ui-egui/src/lib.rs b/crates/ui-egui/src/lib.rs index 1e914c0..33839e2 100644 --- a/crates/ui-egui/src/lib.rs +++ b/crates/ui-egui/src/lib.rs @@ -318,7 +318,7 @@ impl CadApp { /// Submit a line of command-line text. A refused line is echoed to the history; the error is /// also returned. pub fn cmdline(&mut self, text: &str) -> Option { - if self.session.running.is_none() { + if !self.session.prompting() { let first = text.split_whitespace().next().unwrap_or(""); // `cmd {json}` is a programmatic call: the engine runs it with those parameters. let json_form = text.trim_start().get(first.len()..).is_some_and(|rest| rest.trim_start().starts_with('{')); @@ -384,6 +384,14 @@ impl CadApp { /// "Opening ..." card shows ([`opening`]); [`Self::finish_opening`] adds it when ready. On the /// web it opens at once. pub fn open_path(&mut self, path: &str) { + // A LISP file (dropped on the window): loaded as APPLOAD loads it. + if is_lisp_file(path) { + match cadcraft_engine::lisp::builtins::read_text_file(path) { + Some(text) => self.load_lisp(path, &text), + None => self.open_failed(format!("APPLOAD: can't read {path}")), + } + return; + } #[cfg(not(target_arch = "wasm32"))] { self.opening.start(path); @@ -410,6 +418,14 @@ impl CadApp { } } + /// Load a LISP file: its routine runs and may wait for the user (APPLOAD typed or from the + /// menu runs this way too). + fn load_lisp(&mut self, name: &str, text: &str) { + if let Err(e) = self.session.lisp_load(name, text, false) { + self.session.echo(e.to_string()); + } + } + /// The largest file [`Self::open_bytes`] opens. A drawing opened from its contents (the /// browser, where files have no path) is held in memory several times over while it is decoded, /// so it is capped below the DWG reader's own limit instead of running out of memory. @@ -433,6 +449,9 @@ impl CadApp { if let Some(e) = Self::open_size_error(name, bytes.len() as u64) { return self.open_failed(e); } + if is_lisp_file(name) { + return self.load_lisp(name, &String::from_utf8_lossy(bytes)); + } let data = cadcraft_engine::cmd::file::base64_encode(bytes); let r = self.run("open", json!({ "data": data, "name": name })); self.opened(r); @@ -475,6 +494,11 @@ impl CadApp { /// Per-frame logic before layout. pub fn logic(&mut self, ctx: &egui::Context) { + // A long LISP routine runs a slice per frame, so the window stays live (and Esc stops it). + self.session.lisp_tick(); + if self.session.lisp_busy() { + ctx.request_repaint(); + } // Closing the window (title bar, File ▸ Exit, Cmd+Q) with unsaved changes asks first. if ctx.input(|i| i.viewport().close_requested()) && self.request_quit() { ctx.send_viewport_cmd(egui::ViewportCommand::CancelClose); @@ -664,6 +688,11 @@ pub fn now_ms() -> f64 { } } +/// A LISP source file, by its name. +fn is_lisp_file(name: &str) -> bool { + std::path::Path::new(name).extension().is_some_and(|e| e.eq_ignore_ascii_case("lsp")) +} + #[cfg(test)] mod tests { use super::*; diff --git a/crates/ui-egui/tests/lisp_files.rs b/crates/ui-egui/tests/lisp_files.rs new file mode 100644 index 0000000..abd7f6a --- /dev/null +++ b/crates/ui-egui/tests/lisp_files.rs @@ -0,0 +1,66 @@ +//! AutoLISP in the app (#758): a dropped `.lsp` file loads (its `c:` functions become +//! commands), and a long routine runs a slice per frame so the window stays live. + +use cadcraft_engine::Session; +use cadcraft_ui_egui::{CadApp, Services}; + +#[test] +fn a_dropped_lisp_file_loads_and_defines_its_commands() { + let mut app = CadApp::new(Session::new(), Services::default()); + app.open_bytes("Hello.LSP", b"(defun c:hello () (princ \"hi from lisp\") (princ))"); + assert!(app.session.log.iter().any(|l| l == "Hello.LSP successfully loaded."), "{:?}", app.session.log); + // Still the same drawing: a LISP file isn't opened as one. + assert_eq!(app.session.docs.len(), 1); + app.session.cmdline("HELLO").unwrap(); + assert_eq!(app.session.log.last().map(String::as_str), Some("hi from lisp")); +} + +#[test] +fn a_long_routine_runs_across_frames() { + let mut app = CadApp::new(Session::new(), Services::default()); + app.open_bytes("loop.lsp", b"(setq i 0) (while (< i 2000000) (setq i (1+ i))) (princ \"done\")"); + assert!(app.session.lisp_busy(), "a slice per frame"); + let ctx = egui::Context::default(); + let mut frames = 0; + while app.session.lisp_running() && frames < 1000 { + let mut out = ctx.run_ui(egui::RawInput::default(), |ui| app.logic(ui.ctx())); + out.textures_delta.clear(); // no renderer here + frames += 1; + } + assert!(!app.session.lisp_running()); + assert!(frames > 1, "it took more than one frame"); + assert_eq!(app.session.log.last().map(String::as_str), Some("done")); +} + +/// A click on the canvas answers a routine's `getpoint`. No command runs while a routine waits, +/// and clicks used to go to object selection instead (found running the app by hand). +#[test] +fn a_canvas_click_answers_a_routine_waiting_for_a_point() { + use cadcraft_engine::geom::Vec2; + use egui::{Event, Modifiers, PointerButton, vec2}; + let mut app = CadApp::new(Session::new(), Services::default()); + app.canvas.zoom_pending = false; + let mut h = egui_kittest::Harness::builder().with_size(vec2(1600.0, 1000.0)).build_ui_state( + |ui, app: &mut CadApp| { + app.logic(ui.ctx()); + app.ui(ui); + }, + app, + ); + h.run_steps(3); + h.state_mut().session.cmdline("(setq p (getpoint \"\nPick: \"))").unwrap(); + h.run_steps(2); + let target = Vec2::new(1.0, 2.0); + let pos = h.state().canvas.xf.unwrap().to_screen(target); + h.event(Event::PointerMoved(pos)); + h.run_steps(2); + for pressed in [true, false] { + h.event(Event::PointerButton { pos, button: PointerButton::Primary, pressed, modifiers: Modifiers::NONE }); + h.run_steps(2); + } + let app = h.state(); + assert!(!app.session.lisp_running(), "the click answered the prompt"); + let p = app.session.lisp_var("P").as_point().expect("a point"); + assert!((p[0] - target.x).abs() < 0.05 && (p[1] - target.y).abs() < 0.05, "{p:?}"); + assert!(app.session.selection().is_empty(), "the click selected nothing"); +} diff --git a/docs/autolisp.md b/docs/autolisp.md new file mode 100644 index 0000000..b75ad7e --- /dev/null +++ b/docs/autolisp.md @@ -0,0 +1,87 @@ +# AutoLISP + +CADCraft runs AutoLISP routines (`.lsp` files). What is here and what is not yet: +[gaps.md](gaps.md) (E1). + +## Loading and running + +- **APPLOAD** (Tools > Load Application…, alias `AP`) asks for a `.lsp` file and runs it. Dropping + a `.lsp` file on the window does the same. +- **`(load "name")`** loads a file by path, with `.lsp` added when the name has none. A file + APPLOAD loaded is found again by its name, also on the web where there is no file system. +- **`(defun c:NAME …)`** defines a command: type `NAME` at the command line. Built-in commands + keep their names. +- **At the command line**, `(expression)` evaluates and shows the value, and `!variable` shows a + variable. Typed at a command's prompt (not a free-text one), an expression's value answers it: + `CIRCLE 0,0 (* 2 r)`. +- **Programmatically** (scripts, the control channel, MCP, the CLI): `lisp {code, inputs?}` and + `appload {path} | {name, text | data}` run to the end and return `{value, output, error?}`. + `inputs` answer `get…` calls in order (numbers, strings, `[x, y]` points); a call with none left + gets nil. + +### At startup + +CADCraft loads LISP from its **support folder**, `support` in the settings folder (on Windows +`%APPDATA%\CADCraft\support`, on macOS `~/Library/Application Support/CADCraft/support`, on +Linux `~/.config/cadcraft/support`; created at first start): + +- `acad.lsp` once per session, into the first drawing; with `ACADLSPASDOC` set to 1, into every + drawing; +- `acaddoc.lsp` into every drawing opened or created; +- then `S::STARTUP`, when they define it. + +`(autoload "file" '("CMD1" "CMD2"))` in a startup file makes `CMD1` and `CMD2` commands that load +`file` (from the support folder too) the first time they are typed. Startup files run to the end +without asking for input. A drawing's own folder is never searched: an `acaddoc.lsp` that came +with a downloaded drawing does not run. + +Each drawing has its own variables and functions. A routine is one undo step, whatever commands +it runs. A routine that waits for input (`getpoint`, `pause`) lets the window work meanwhile; +Esc stops it with "Function cancelled", which `*error*` receives. A long loop runs a slice per +frame, so the window stays live and Esc stops it too. + +## The language + +Integers are 32-bit and wrap as AutoLISP's do; any real makes arithmetic real. Variables are +dynamically scoped: a function's arguments and its locals (after `/`) are bound while it runs. +Symbols are case-insensitive. Reals print with six significant digits. + +Nothing a routine does can crash the program: deep recursion is the error "internal stack limit +reached", malformed source is a reader error, and every built-in checks its arguments. + +## Built-in functions + +- **Forms:** `quote` `'` `function` `setq` `set` `if` `cond` `while` `repeat` `foreach` `progn` + `and` `or` `defun` `defun-q` `lambda` `eval` `apply` `mapcar` `load` `autoload` `exit` `quit` +- **Numbers:** `+ - * / rem 1+ 1- abs min max sqrt exp log sin cos atan expt fix float gcd + logand logior lsh ~ = /= < > <= >= zerop minusp numberp` +- **Lists:** `car cdr` and the `c…r` combinations up to four levels, `cons list append reverse + length nth last member assoc subst acad_strlsort`, `vl-position vl-remove vl-sort + vl-remove-if vl-remove-if-not vl-member-if vl-every vl-some vl-list-length vl-consp` +- **Predicates:** `atom listp null not type eq equal boundp vl-symbolp` +- **Strings:** `strcat strlen substr strcase itoa atoi atof chr ascii read wcmatch`, + `vl-string-search vl-string-subst vl-string-trim vl-string-left-trim vl-string-right-trim + vl-string-translate vl-string->list vl-list->string vl-prin1-to-string vl-princ-to-string + vl-symbol-name vl-symbol-value vl-filename-base vl-filename-extension vl-filename-directory` +- **Geometry:** `polar distance angle inters trans` (`trans` returns the point: no UCS yet) +- **Output and files:** `princ prin1 print prompt terpri alert open close read-line write-line + findfile` +- **Errors:** `*error*`, `vl-catch-all-apply vl-catch-all-error-p vl-catch-all-error-message` +- **Drawing:** `command` (also `command-s`, `vl-cmdf`) with `pause`, a command left open for the + next call, and `(command)` to cancel; `getvar setvar`; `entget entmake entmod entdel entlast + entnext entupd handent`; `ssget` (modes X, L, P, I, W, C, F, WP, CP, a point, or the user + selecting; filters with wildcards and `-4` operators) `ssadd ssdel sslength ssname ssmemb + sssetfirst ssgetfirst`; `tblsearch tblnext` (LAYER, LTYPE, STYLE, BLOCK, DIMSTYLE, APPID) +- **Input:** `initget getpoint getcorner getdist getangle getorient getreal getint getstring + getkword entsel nentsel` +- **Units:** `rtos angtos distof angtof` +- **No-ops:** `vl-load-com gc redraw`; `ver` + +Entity lists use the DXF group codes of CADCraft's DXF files: what `entget` returns is what a +DXF file holds for the object, plus `-1` (its name) and `410` (its layout). + +## Testing against the corpus + +The AutoLISP conformance corpus (#648) lives in its own repository. Point `CADCRAFT_LISP_CORPUS` +at it and run `cargo test -p cadcraft-engine --test lisp_corpus`; without the variable the test +says it was skipped. diff --git a/docs/file-format-parity.md b/docs/file-format-parity.md index 74e850d..c15fd6c 100644 --- a/docs/file-format-parity.md +++ b/docs/file-format-parity.md @@ -117,7 +117,7 @@ early (#175), but the throughput problem remains. **DWG ≈ 30% read, ≈ 15% wr | Scripts (`.scr`) | SCRIPT | script text through the CLI, MCP and control channel; no SCRIPT command reading a `.scr` file | 1–2 | | Aliases (`.pgp`), CUI(x), workspaces | yes | user alias files and ALIASEDIT (#552); no CUI(x) or workspaces | 4–8 | | SVG import (`.svg`, `.svgz`) | yes (via scripts) | OPEN reads shapes, paths, groups and Inkscape layers into entities (#636); no CSS classes, `use`, fills, text or images | 2–4 | -| AutoLISP (`.lsp`, `.fas`, `.vlx`), `.dll`/`.arx` plug-ins | yes | no | see [gaps.md](gaps.md) (M12) | +| AutoLISP (`.lsp`, `.fas`, `.vlx`), `.dll`/`.arx` plug-ins | yes | `.lsp` loads (APPLOAD, `(load)`, a dropped file; #758); no Visual LISP ActiveX (`vlax-`), DCL dialogs or reactors; `.fas`/`.vlx` are compiled and undocumented; no `.dll`/`.arx` | see [gaps.md](gaps.md) (E1) | | Data extraction (`.csv`, `.xls`) and data links | yes | DATAEXTRACTION/EATTEXT to CSV or a table (#433); table data links read CSV (#534); no `.xls`, no `.dxe` templates | 3–5 | | eTransmit (`.zip` packages) | yes | no | 4–6 | diff --git a/docs/gaps.md b/docs/gaps.md index ace91fe..24b1ee5 100644 --- a/docs/gaps.md +++ b/docs/gaps.md @@ -128,7 +128,7 @@ Detail: [localization-parity.md](localization-parity.md). | # | Gap | Est. | |---|---|---| -| E1 | AutoLISP interpreter (safe subset first: `defun`, `command`, `entget`/`entmod`, selection sets, `getpoint` …), APPLOAD, `acad.lsp` startup | 60–100 | +| E1 | AutoLISP beyond the core (#758 landed the language, `command`, entity lists, selection sets, `get…` input, APPLOAD, `(load)`, `c:` commands and `acad.lsp`/`acaddoc.lsp` at startup): Visual LISP ActiveX (`vlax-`, `vla-`), DCL dialogs, reactors, an APPLOAD dialog with a Startup Suite, UCS-aware `trans` | 30–50 | | E3 | Express Tools equivalents (TXT2MTXT, BREAKLINE, BURST, NCOPY exists, SUPERHATCH, Move/Copy/Rotate) | 30–50 | | E4 | Plug-in API (owner decision: Rust/WASM plug-ins rather than ObjectARX/.NET) | 30–50 | | E5 | CUI customisation and alias (`.pgp`) editor | 15–25 | diff --git a/docs/roadmap.md b/docs/roadmap.md index e7556c8..82470c8 100644 --- a/docs/roadmap.md +++ b/docs/roadmap.md @@ -57,7 +57,7 @@ remaining gaps are known bugs and edge features (≈ 75% ready for real work). | Xrefs, block editor, dynamic blocks, groups, attribute tools | not started | 90–135 | | Plot styles, plot preview, PUBLISH, non-rectangular viewports | partial | 30–45 | | Autosave, recovery, AUDIT/RECOVER, Options dialog, templates, SHX, user `.lin`/`.pat` | partial | 40–60 | -| AutoLISP core subset and SCRIPT | not started | 40–70 | +| AutoLISP core subset and SCRIPT | done (AutoLISP #758, SCRIPT #693); Visual LISP, DCL and reactors to come | 30–50 | | Catalog plus AutoCAD for Mac's languages | not started | 30–45 | | Stability: CI gate, issue backlog, command smoke sweep, geometry fuzzing | partial | 30–50 | | Platforms: web open/save, Windows/Linux runtime checks; performance at 1M entities and large DWG | partial | 20–35 |