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 |