Compare commits

..

72 Commits
to_zig ... main

Author SHA1 Message Date
Scott Richmond
b08fac2daf to_number in doc topics 2024-11-06 17:45:56 -05:00
Scott Richmond
1f7a9ebd4c fix doc comment for to_number 2024-11-06 17:44:18 -05:00
Scott Richmond
951edccebf 0.1.36 2024-11-03 17:20:54 -05:00
Scott Richmond
49c0ee20b3 remove test svgs 2024-11-03 17:20:47 -05:00
Scott Richmond
1ead4a8c5c build 2024-11-03 17:19:11 -05:00
Scott Richmond
2f5557a552 build 2024-11-03 17:04:04 -05:00
Scott Richmond
066edb00b5 build 2024-11-03 16:45:20 -05:00
Scott Richmond
5ed314de15 update prelude docs 2024-11-01 16:23:32 -04:00
Scott Richmond
ee09b9f208 random works on tuples 2024-11-01 16:23:15 -04:00
Scott Richmond
a7fcad18a6 0.1.35 2024-11-01 14:59:51 -04:00
Scott Richmond
58dc94ce7e 0.1.34 2024-11-01 14:59:36 -04:00
Scott Richmond
7aedbc18d6 build 2024-11-01 14:59:17 -04:00
Scott Richmond
339c2095aa include to_number 2024-10-23 17:30:14 -04:00
Scott Richmond
e278d91bba 0.1.33 2024-10-23 17:29:28 -04:00
Scott Richmond
bb0aaef060 build 2024-10-23 17:27:32 -04:00
Scott Richmond
54e7597b33 0.1.32 2024-10-23 16:44:58 -04:00
Scott Richmond
13856cb8b2 fix penwidth bug 2024-10-23 16:44:51 -04:00
Scott Richmond
f0d19da532 update prelude docs 2024-10-20 15:12:29 -04:00
Scott Richmond
ab3cf98bb5 update doc topics; escape slashes in links 2024-10-20 15:12:17 -04:00
Scott Richmond
440b97d47f update prelude documentation 2024-10-20 14:50:22 -04:00
Scott Richmond
b392e3282c 0.1.31 2024-10-20 14:39:42 -04:00
Scott Richmond
12f1a85e27 fix p5 call push/pop errors 2024-10-20 14:39:36 -04:00
Scott Richmond
fd55dd9a50 0.1.30 2024-10-20 14:22:21 -04:00
Scott Richmond
8d98f3e2b4 fix p5 call snafu 2024-10-20 14:22:14 -04:00
Scott Richmond
ca1a026980 0.1.29 2024-10-20 14:17:47 -04:00
Scott Richmond
d0a5128e0e fix turtle/path rotation, add p5 canvas transformations to adapter from web frontend 2024-10-20 14:17:39 -04:00
Scott Richmond
7dfaed11e3 0.1.28 2024-10-18 15:22:46 -04:00
Scott Richmond
deaeb7b4db build 2024-10-18 15:22:40 -04:00
Scott Richmond
2686d70a49 change test case 2024-10-18 15:18:56 -04:00
Scott Richmond
e6b2ffe4c9 add ludus-extraction function from svg 2024-09-09 18:23:13 -04:00
Scott Richmond
7285e599c5 0.1.27 2024-08-02 14:56:05 -04:00
Scott Richmond
39984ac537 build 2024-08-02 14:55:46 -04:00
Scott Richmond
73b2343963 add p5 test file 2024-08-02 13:56:37 -04:00
Scott Richmond
1733de7dff build 2024-08-01 18:54:18 -04:00
Scott Richmond
be9a86a973 build 2024-08-01 18:50:09 -04:00
Scott Richmond
479e304357 fix viewBox math so we see just what is there 2024-08-01 18:35:28 -04:00
Scott Richmond
db5622bccd new random seed for every run 2024-08-01 18:00:11 -04:00
Scott Richmond
7f64164078 build 2024-08-01 17:45:09 -04:00
Scott Richmond
d9e0fd23ec build 2024-08-01 17:43:29 -04:00
Scott Richmond
ffed651b6e build 2024-08-01 17:40:54 -04:00
Scott Richmond
ea80f81c33 build 2024-08-01 17:31:36 -04:00
Scott Richmond
d477782ff6 build 2024-08-01 17:05:41 -04:00
Scott Richmond
4baabc0a20 build 2024-08-01 16:43:01 -04:00
Scott Richmond
1085c7ae44 build out svg adapter, viewBox isn't working yet 2024-07-31 19:25:22 -04:00
Scott Richmond
e72b9f91ca build 2024-07-31 12:06:42 -04:00
Scott Richmond
d8f152998e build out p5 adapter 2024-07-30 18:36:13 -04:00
Scott Richmond
af125ffbbb fix background! bugs; delete a bunch of p5 adapter code, now moved to JS 2024-07-30 18:35:55 -04:00
Scott Richmond
657ff3dedb remove print! 2024-07-30 18:32:54 -04:00
Scott Richmond
2c9f6f8279 start building out p5 adapter 2024-07-22 11:39:57 -04:00
Scott Richmond
4ca1da1240 build 2024-07-21 20:00:34 -04:00
Scott Richmond
121446c5c4 first step: Ludus speaks turtle graphics, not p5 calls 2024-07-21 19:22:42 -04:00
Scott Richmond
df85be3c1e ref->box everywhere 2024-07-21 16:31:20 -04:00
Scott Richmond
60106d10f0 consider turtle-reported vs. expected-calculated state 2024-07-21 16:26:56 -04:00
Scott Richmond
e068059362 update turtle graphics protocol doc 2024-07-20 16:54:37 -04:00
Scott Richmond
dd3867968e add description of turtle graphics protocol 2024-07-20 16:34:12 -04:00
Scott Richmond
98421a9215 allow shadowing of prelude 2024-07-20 13:51:11 -04:00
Scott Richmond
7467bc8867 disallow shadowing, remove all shadowing from Prelude. 2024-07-19 16:48:11 -04:00
Scott Richmond
2ec95c8f33 add loop & recur back into the language: we do actually need it!--just not *pedagogically* 2024-07-19 16:25:18 -04:00
Scott Richmond
7afc32d9d1 remove loop & recur from the language 2024-07-19 16:11:30 -04:00
Scott Richmond
d4adc1d912 clean up 2024-07-19 16:09:31 -04:00
Scott Richmond
4a069278b8 finally fix script, block, tuple, list, dict, etc. off by one errors for last term 2024-07-19 16:00:17 -04:00
Scott Richmond
e9fee4c0e1 make some additional comments re: off-by-one error errors 2024-07-16 20:16:28 -04:00
Scott Richmond
2027490614 improve some things 2024-07-16 20:12:21 -04:00
Scott Richmond
cb7098ac4e start fixing off-by-one errors: script, block, tuple, args, tup-patt 2024-07-16 19:40:40 -04:00
Scott Richmond
d416511b48 remove repl cruft 2024-07-14 14:42:31 -04:00
Scott Richmond
a6c899a85f Pretty-patterns shows words at ends of splatterns 2024-07-14 14:41:53 -04:00
Scott Richmond
9ddb43a30f called keywords work in pipelines 2024-07-14 14:28:09 -04:00
Scott Richmond
9e50f0cbdf Fix typo 2024-07-14 14:18:10 -04:00
Scott Richmond
2f03bbb12f mismatched arity -> wrong number of arguments 2024-07-14 13:53:32 -04:00
Scott Richmond
8cf84e63d3 add char functions to doc 2024-07-14 13:49:49 -04:00
Scott Richmond
5c32d32f24 add chars to prelude 2024-07-14 13:48:47 -04:00
Scott Richmond
32b42e0242 ignore .zig-cache 2024-07-13 18:30:45 -04:00
27 changed files with 984 additions and 385 deletions

1
.gitignore vendored
View File

@ -33,3 +33,4 @@ target/repl-port
.repl-buffer.janet
.env
src/jpm_tree
.zig-cache

Binary file not shown.

View File

@ -2,8 +2,369 @@ import init from "./out.mjs"
const mod = await init()
let res = null
let code = null
export function run (source) {
const result = mod.ludus(source).value
console.log(result)
return JSON.parse(result)
code = source
const output = mod.ludus(source).value
res = JSON.parse(output)
return res
}
export function stdout () {
if (!res) return ""
return res.io.stdout.data
}
export function turtle_commands () {
if (!res) return []
return res.io.turtle.data
}
export function result () {
return res
}
const turtle_init = {
position: [0, 0],
heading: 0,
pendown: true,
pencolor: "white",
penwidth: 1,
visible: true
}
const colors = {
black: [0, 0, 0, 255],
silver: [192, 192, 192, 255],
gray: [128, 128, 128, 255],
white: [255, 255, 255, 255],
maroon: [128, 0, 0, 255],
red: [255, 0, 0, 255],
purple: [128, 0, 128, 255],
fuchsia: [255, 0, 255, 255],
green: [0, 128, 0, 255],
lime: [0, 255, 0, 255],
olive: [128, 128, 0, 255],
yellow: [255, 255, 0, 255],
navy: [0, 0, 128, 255],
blue: [0, 0, 255, 255],
teal: [0, 128, 128, 255],
aqua: [0, 255, 25, 255],
}
function resolve_color (color) {
if (typeof color === 'string') return colors[color]
if (typeof color === 'number') return [color, color, color, 255]
if (Array.isArray(color)) return color
return [0, 0, 0, 255] // default to black?
}
let background_color = "black"
function add (v1, v2) {
const [x1, y1] = v1
const [x2, y2] = v2
return [x1 + x2, y1 + y2]
}
function mult (vector, scalar) {
const [x, y] = vector
return [x * scalar, y * scalar]
}
function unit_of (heading) {
const turns = -heading + 0.25
const radians = turn_to_rad(turns)
return [Math.cos(radians), Math.sin(radians)]
}
function command_to_state (prev_state, curr_command) {
const verb = curr_command[0]
switch (verb) {
case "goto": {
const [_, x, y] = curr_command
return {...prev_state, position: [x, y]}
}
case "home": {
return {...prev_state, position: [0, 0], heading: 0}
}
case "right": {
const [_, angle] = curr_command
const {heading} = prev_state
return {...prev_state, heading: heading + angle}
}
case "left": {
const [_, angle] = curr_command
const {heading} = prev_state
return {...prev_state, heading: heading - angle}
}
case "forward": {
const [_, steps] = curr_command
const {heading, position} = prev_state
const unit = unit_of(heading)
const move = mult(unit, steps)
return {...prev_state, position: add(position, move)}
}
case "back": {
const [_, steps] = curr_command
const {heading, position} = prev_state
const unit = unit_of(heading)
const move = mult(unit, -steps)
return {...prev_state, position: add(position, move)}
}
case "penup": {
return {...prev_state, pendown: false}
}
case "pendown": {
return {...prev_state, pendown: true}
}
case "penwidth": {
const [_, width] = curr_command
return {...prev_state, penwidth: width}
}
case "pencolor": {
const [_, color] = curr_command
return {...prev_state, pencolor: color}
}
case "setheading": {
const [_, heading] = curr_command
return {...prev_state, heading: heading}
}
case "loadstate": {
// console.log("LOADSTATE: ", curr_command)
const [_, [x, y], heading, visible, pendown, penwidth, pencolor] = curr_command
return {position: [x, y], heading, visible, pendown, penwidth, pencolor}
}
case "show": {
return {...prev_state, visible: true}
}
case "hide": {
return {...prev_state, visible: false}
}
case "background": {
background_color = curr_command[1]
return prev_state
}
}
}
function eq_vect (v1, v2) {
const [x1, y1] = v1
const [x2, y2] = v2
return (x1 === x2) && (y1 === y2)
}
function eq_color (c1, c2) {
if (c1 === c2) return true
const res1 = resolve_color(c1)
const res2 = resolve_color(c2)
for (let i = 0; i < res1.length; ++i) {
if (res1[i] !== res2[i]) return false
}
return true
}
function states_to_call (prev, curr) {
const calls = []
// whose state should we use?
// pen states will only differ on more than one property
// if we use `loadstate`
// my sense is `prev`, but that may change
if (prev.pendown && !eq_vect(prev.position, curr.position)) {
calls.push(["line", prev.position[0], prev.position[1], curr.position[0], curr.position[1]])
}
if (!eq_color(curr.pencolor, prev.pencolor)) {
calls.push(["stroke", ...resolve_color(curr.pencolor)])
}
if (curr.penwidth !== prev.penwidth) {
calls.push(["strokeWeight", curr.penwidth])
}
return calls
}
const turtle_radius = 20
const turtle_angle = 0.385
const turtle_color = [255, 255, 255, 150]
const p5_call_root = [
["background", ...resolve_color(background_color)],
["push"],
["rotate", Math.PI],
["scale", -1, 1],
["stroke", ...resolve_color(turtle_init.pencolor)],
]
function rotate (vector, heading) {
const radians = turn_to_rad(heading)
const [x, y] = vector
return [
(x * Math.cos (radians)) - (y * Math.sin (radians)),
(x * Math.sin (radians)) + (y * Math.cos (radians))
]
}
function turn_to_rad (heading) {
return (heading % 1) * 2 * Math.PI
}
function turn_to_deg (heading) {
return (heading % 1) * 360
}
function svg_render_line (prev, curr) {
if (!prev.pendown) return ""
if (eq_vect(prev.position, curr.position)) return ""
const {position: [x1, y1], pencolor, penwidth} = prev
const {position: [x2, y2]} = curr
const [r, g, b, a] = resolve_color(pencolor)
return `
<line x1="${x1}" y1="${y1}" x2="${x2}" y2="${y2}" stroke="rgb(${r} ${g} ${b})" stroke-opacity="${a/255}" stroke-width="${penwidth}"/>
`
}
function escape_svg (svg) {
return svg
.replace(/&/g, "&amp;")
.replace(/</g, "&lt;")
.replace(/>/g, "&gt;")
.replace(/"/g, "&quot;")
.replace(/'/g, "&apos;")
}
export function extract_ludus (svg) {
const code = svg.split("<ludus>")[1]?.split("</ludus>")[0] ?? ""
return code
.replace(/&amp;/g, "&")
.replace(/&lt;/g, "<")
.replace(/&gt;/g, ">")
.replace(/&quot;/g, `"`)
.replace(/&apos;/g, `'`)
}
function svg_render_path (states) {
const path = []
for (let i = 1; i < states.length; ++i) {
const prev = states[i - 1]
const curr = states[i]
path.push(svg_render_line(prev, curr))
}
return path.join("")
}
function svg_render_turtle (state) {
if (!state.visible) return ""
const [fr, fg, fb, fa] = turtle_color
const fill_alpha = fa/255
const {heading, pencolor, position: [x, y], pendown, penwidth} = state
const origin = [0, turtle_radius]
const [x1, y1] = origin
const [x2, y2] = rotate(origin, turtle_angle)
const [x3, y3] = rotate(origin, -turtle_angle)
const [pr, pg, pb, pa] = resolve_color(pencolor)
const pen_alpha = pa/255
const ink = pendown ? `<line x1="${x1}" y1="${y1}" x2="0" y2="0" stroke="rgb(${pr} ${pg} ${pb})" stroke-opacity="${pen_alpha}" stroke-width="${penwidth}" />` : ""
return `
<g transform="translate(${x}, ${y})rotate(${-turn_to_deg(heading)})">
<polygon points="${x1} ${y1} ${x2} ${y2} ${x3} ${y3}" stroke="none" fill="rgb(${fr} ${fg} ${fb})" fill-opacity="${fill_alpha}"/>
${ink}
</g>
`
}
export function svg (commands) {
// console.log(commands)
const states = [turtle_init]
commands.reduce((prev_state, command) => {
const new_state = command_to_state(prev_state, command)
states.push(new_state)
return new_state
}, turtle_init)
// console.log(states)
const {maxX, maxY, minX, minY} = states.reduce((accum, {position: [x, y]}) => {
accum.maxX = Math.max(accum.maxX, x)
accum.maxY = Math.max(accum.maxY, y)
accum.minX = Math.min(accum.minX, x)
accum.minY = Math.min(accum.minY, y)
return accum
}, {maxX: 0, maxY: 0, minX: 0, minY: 0})
const [r, g, b, a] = resolve_color(background_color)
const view_width = (maxX - minX) * 1.2
const view_height = (maxY - minY) * 1.2
const margin = Math.max(view_width, view_height) * 0.1
const x1 = minX - margin
// don't actually need these:
// const y1 = minY - margin
// const x2 = maxX + margin
const y2 = maxY + margin
const path = svg_render_path(states)
const turtle = svg_render_turtle(states[states.length - 1])
return `<?xml version="1.0" standalone="no"?>
<svg version="1.1" xmlns="http://www.w3.org/2000/svg" style="background-color:rgb(${r} ${g} ${b}); background-opacity: ${a/255}" viewBox="${x1} ${-y2} ${view_width} ${view_height}">
<g transform="scale(-1, 1) rotate(180)">
${path}
${turtle}
</g>
<ludus>
${escape_svg(code)}
</ludus>
</svg>
`
}
function p5_render_turtle (state, calls) {
if (!state.visible) return
calls.push(["push"])
const [r, g, b, a] = turtle_color
calls.push(["fill", r, g, b, a])
const {heading, pencolor, position: [x, y], pendown, penwidth} = state
const origin = [0, turtle_radius]
const [x1, y1] = origin
const [x2, y2] = rotate(origin, turtle_angle)
const [x3, y3] = rotate(origin, -turtle_angle)
calls.push(["translate", x, y])
// need negative turtle rotation with the other p5 translations
calls.push(["rotate", -turn_to_rad(heading)])
calls.push(["noStroke"])
calls.push(["beginShape"])
calls.push(["vertex", x1, y1])
calls.push(["vertex", x2, y2])
calls.push(["vertex", x3, y3])
calls.push(["endShape"])
calls.push(["strokeWeight", penwidth])
calls.push(["stroke", ...resolve_color(pencolor)])
if (pendown) calls.push(["line", 0, 0, x1, y1])
calls.push(["pop"])
return calls
}
export function p5 (commands) {
const states = [turtle_init]
commands.reduce((prev_state, command) => {
const new_state = command_to_state(prev_state, command)
states.push(new_state)
return new_state
}, turtle_init)
// console.log(states)
const p5_calls = [...p5_call_root]
for (let i = 1; i < states.length; ++i) {
const prev = states[i - 1]
const curr = states[i]
const calls = states_to_call(prev, curr)
for (const call of calls) {
p5_calls.push(call)
}
}
p5_calls[0] = ["background", ...resolve_color(background_color)]
p5_render_turtle(states[states.length - 1], p5_calls)
p5_calls.push(["pop"])
return p5_calls
}

View File

@ -6489,7 +6489,7 @@ var __emscripten_stack_alloc = (a0) => (__emscripten_stack_alloc = wasmExports['
var _emscripten_stack_get_current = () => (_emscripten_stack_get_current = wasmExports['emscripten_stack_get_current'])();
var ___cxa_is_pointer_type = createExportWrapper('__cxa_is_pointer_type', 1);
var dynCall_jiji = Module['dynCall_jiji'] = createExportWrapper('dynCall_jiji', 5);
var ___emscripten_embedded_file_data = Module['___emscripten_embedded_file_data'] = 1840592;
var ___emscripten_embedded_file_data = Module['___emscripten_embedded_file_data'] = 1819972;
function invoke_i(index) {
var sp = stackSave();
try {

Binary file not shown.

13
build/p5_test.mjs Normal file
View File

@ -0,0 +1,13 @@
import {run, p5} from "./ludus.mjs"
const code = `
print! ("Hello, world!")
pencolor! (colors :white)
fd! (50)
pw! (3)
`
const result = run(code)
console.log(result.io.stdout.data)
console.log(p5(result.io.turtle.data))

22
build/svg_test.mjs Normal file
View File

@ -0,0 +1,22 @@
import {run, svg, stdout} from "./ludus.mjs"
const code = `
let start = unbox (turtle_state)
fd! (100)
rt! (0.25)
fd! (100)
loadstate! (start)
& home! ()
rt! (0.25)
fd! (100)
lt! (0.25)
`
const result = run(code)
// console.log(stdout(result))
console.log(svg(result.io.turtle.data))

37
build/svg_test.svg Normal file
View File

@ -0,0 +1,37 @@
<?xml version="1.0" standalone="no"?>
<svg version="1.1" xmlns="http://www.w3.org/2000/svg" style="background-color:rgb(0 0 0); background-opacity: 1" viewBox="-12 -112 120 120">
<g transform="scale(-1, 1) rotate(180)">
<line x1="0" y1="0" x2="6.123233995736766e-15" y2="100" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1"/>
<line x1="6.123233995736766e-15" y1="100" x2="0" y2="0" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1"/>
<line x1="0" y1="0" x2="100" y2="0" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1"/>
<g transform="translate(100, 0)rotate(90)">
<polygon points="0 20 -13.226237306473037 -15.00222139260919 13.226237306473037 -15.00222139260919" stroke="none" fill="rgb(255 255 255)" fill-opacity="0.5882352941176471"/>
<line x1="0" y1="20" x2="0" y2="0" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1" />
</g>
</g>
<ludus>
let home = unbox (turtle_state)
fd! (100)
loadstate! (home)
rt! (0.25)
fd! (100)
do turtle_state &gt; unbox
</ludus>
</svg>

After

Width:  |  Height:  |  Size: 1.1 KiB

View File

@ -1,3 +1,9 @@
import {run} from "./ludus.mjs"
console.log(run(`let foo = 42; "{foo} bar"`))
console.log(run(`
forward! (100)
right! (0.25)
print! ("foobar")
`))

View File

@ -23,9 +23,9 @@ publish:
# build the ludus jimage
build:
rm build/out.mjs
rm build/out.wasm
rm build/ludus.jimage
rm -f build/out.mjs
rm -f build/out.wasm
rm -f build/ludus.jimage
janet -c src/ludus.janet build/ludus.jimage
cd build && just build
git commit -am "build"

4
package-lock.json generated
View File

@ -1,12 +1,12 @@
{
"name": "@ludus/ludus-js-pure",
"version": "0.1.26",
"version": "0.1.36",
"lockfileVersion": 3,
"requires": true,
"packages": {
"": {
"name": "@ludus/ludus-js-pure",
"version": "0.1.26",
"version": "0.1.36",
"license": "GPL-3.0",
"devDependencies": {
"shadow-cljs": "^2.26.0",

View File

@ -1,6 +1,6 @@
{
"name": "@ludus/ludus-js-pure",
"version": "0.1.26",
"version": "0.1.36",
"description": "A Ludus interpreter in a pure JS function.",
"type": "module",
"main": "build/ludus.mjs",

View File

@ -3,23 +3,5 @@
& the goal is to output any global state held in Ludus
& this does not have base loaded into it, only prelude: must be pure Ludus
if turtle_state () :visible? then render_turtle! () else nil
reset_turtle! ()
& let console_msgs = flush! ()
let (r, g, b, a) = unbox (bgcolor)
store! (bgcolor, colors :black)
let draw_calls = unbox (p5_calls)
store! (p5_calls, [])
#{
& :result result is provided elsewhere
& :errors [] & if we get here there are no errors
& :console console_msgs
:draw concat (
[(:background, r, g, b, a), (:stroke, 255, 255, 255, 255)]
draw_calls)
}
store! (turtle_state, turtle_init)
store! (turtle_commands, [])

View File

@ -17,7 +17,6 @@ fn mod
fn neg?
fn print!
fn some?
fn state/call
fn store!
fn string
fn turn/rad
@ -50,8 +49,8 @@ fn ordered? {
fn assoc? {
"Returns true if a value is an associative collection: a dict or a pkg."
(assoc as :dict) -> true
(assoc as :pkg) -> true
(d as :dict) -> true
(p as :pkg) -> true
(_) -> false
}
@ -280,9 +279,10 @@ fn concat {
}
fn set {
"Takes an ordered collection--list or tuple--and turns it into a set."
"Takes an ordered collection--list or tuple--and turns it into a set. Returns sets unharmed."
(xs as :list) -> fold (append, xs, ${})
(xs as :tuple) -> do xs > list > set
(xs as :set) -> xs
}
fn set? {
@ -293,8 +293,8 @@ fn set? {
fn contains? {
"Returns true if a set or list contains a value."
(value, set as :set) -> bool (base :get (set, value))
(value, list as :list) -> contains? (value, set (list))
(value, s as :set) -> bool (base :get (s, value))
(value, l as :list) -> contains? (value, set (list))
}
fn omit {
@ -345,8 +345,8 @@ fn string {
(x as :string) -> x
(x) -> show (x)
(x, ...xs) -> loop (x, xs) with {
(out, [x]) -> concat (out, show (x))
(out, [x, ...xs]) -> recur (concat (out, show (x)), xs)
(out, [y]) -> concat (out, show (y))
(out, [y, ...ys]) -> recur (concat (out, show (y)), ys)
}
}
@ -386,6 +386,19 @@ fn downcase {
(str as :string) -> base :downcase (str)
}
fn chars {
"Takes a string and returns its characters as a list. Works only for strings with only ascii characters. Panics on any non-ascii characters."
(str as :string) -> match base :chars (str) with {
(:ok, chrs) -> chrs
(:err, msg) -> panic! msg
}
}
fn chars/safe {
"Takes a string and returns its characters as a list, wrapped in a result tuple. Works only for strings with only ascii characters. Returns an error tuple on any non-ascii characters."
(str as :string) -> base :chars (str)
}
fn ws? {
"Tells if a string is a whitespace character."
(" ") -> true
@ -410,9 +423,9 @@ fn words {
(str as :string) -> {
let no_punct = strip (str)
let strs = split (no_punct, " ")
fn worder (list, str) -> if empty? (str)
then list
else append (list, str)
fn worder (l, s) -> if empty? (s)
then l
else append (l, s)
fold (worder, strs, [])
}
}
@ -422,6 +435,11 @@ fn sentence {
(strs as :list) -> join (strs, " ")
}
fn to_number {
"Takes a string that presumably contains a representation of a number, and tries to give you back the number represented. Returns a result tuple."
(num as :string) -> base :to_number (num)
}
&&& boxes: mutable state and state changes
fn box? {
@ -731,31 +749,31 @@ fn or {
fn assoc {
"Takes a dict, key, and value, and returns a new dict with the key set to value."
() -> #{}
(dict as :dict) -> dict
(dict as :dict, key as :keyword, value) -> base :assoc (dict, key, value)
(dict as :dict, (key as :keyword, value)) -> base :assoc (dict, key, value)
(d as :dict) -> d
(d as :dict, k as :keyword, val) -> base :assoc (d, k, val)
(d as :dict, (k as :keyword, val)) -> base :assoc (d, k, val)
}
fn dissoc {
"Takes a dict and a key, and returns a new dict with the key and associated value omitted."
(dict as :dict) -> dict
(dict as :dict, key as :keyword) -> base :dissoc (dict, key)
(d as :dict) -> d
(d as :dict, k as :keyword) -> base :dissoc (d, k)
}
fn update {
"Takes a dict, key, and function, and returns a new dict with the key set to the result of applying the function to original value held at the key."
(dict as :dict) -> dict
(dict as :dict, key as :keyword, updater as :fn) -> base :assoc (dict, key, updater (get (key, dict)))
(d as :dict) -> d
(d as :dict, k as :keyword, updater as :fn) -> base :assoc (d, k, updater (get (k, d)))
}
fn keys {
"Takes a dict and returns a list of keys in that dict."
(dict as :dict) -> do dict > list > map (first, _)
(d as :dict) -> do d > list > map (first, _)
}
fn values {
"Takes a dict and returns a list of values in that dict."
(dict) -> do dict > list > map (second, _)
(d as :dict) -> do d > list > map (second, _)
}
fn diff {
@ -788,28 +806,28 @@ fn diff {
& TODO: consider merging `get` and `at`
fn get {
"Takes a key, dict, and optional default value; returns the value at key. If the value is not found, returns nil or the default value."
(key as :keyword) -> get (key, _)
(key as :keyword, dict as :dict) -> get (key, dict, nil)
(key as :keyword, dict as :dict, default) -> base :get (key, dict, default)
(k as :keyword) -> get (k, _)
(k as :keyword, d as :dict) -> get (k, d, nil)
(k as :keyword, d as :dict, default) -> base :get (k, d, default)
}
& TODO: add sets to this?
fn has? {
"Takes a key and a dict, and returns true if there is a non-`nil` value stored at the key."
(key as :keyword) -> has? (key, _)
(key as :keyword, dict as :dict) -> do dict > key > nil?
(k as :keyword) -> has? (k, _)
(k as :keyword, d as :dict) -> do d> k > nil?
}
fn dict {
"Takes a list or tuple of (key, value) tuples and returns it as a dict. Returns dicts unharmed."
(dict as :dict) -> dict
(list as :list) -> fold (assoc, list)
(tup as :tuple) -> do tup > list > dict
(d as :dict) -> d
(l as :list) -> fold (assoc, l)
(t as :tuple) -> do t > list > dict
}
fn dict? {
"Returns true if a value is a dict."
(dict as :dict) -> true
(d as :dict) -> true
(_) -> false
}
@ -856,10 +874,10 @@ fn tan {
fn rotate {
"Rotates a vector by an angle. Default angle measure is turns. An optional keyword argument specifies the units of the angle passed in."
((x, y), angle) -> rotate ((x, y), angle, :turns)
((x, y), angle, units as :keyword) -> (
sub (mult (x, cos (angle, units)), mult (y, sin (angle, units)))
add (mult (x, sin (angle, units)), mult (y, cos (angle, units)))
((x, y), a) -> rotate ((x, y), a, :turns)
((x, y), a, units as :keyword) -> (
sub (mult (x, cos (a, units)), mult (y, sin (a, units)))
add (mult (x, sin (a, units)), mult (y, cos (a, units)))
)
}
@ -904,21 +922,21 @@ fn atan/2 {
}
fn mod {
"Returns the modulus of num and div. Truncates towards negative infinity. Panics if div is 0."
(num as :number, 0) -> panic! "Division by zero."
(num as :number, div as :number) -> base :mod (num, div)
"Returns the modulus of x and y. Truncates towards negative infinity. Panics if y is 0."
(x as :number, 0) -> panic! "Division by zero."
(x as :number, y as :number) -> base :mod (x, y)
}
fn mod/0 {
"Returns the modulus of num and div. Truncates towards negative infinity. Returns 0 if div is 0."
(num as :number, 0) -> 0
(num as :number, div as :number) -> base :mod (num, div)
"Returns the modulus of x and y. Truncates towards negative infinity. Returns 0 if y is 0."
(x as :number, 0) -> 0
(x as :number, y as :number) -> base :mod (x, y)
}
fn mod/safe {
"Returns the modulus of num and div in a result tuple, or an error if div is 0. Truncates towards negative infinity."
(num as :number, 0) -> (:err, "Division by zero.")
(num as :number, div as :number) -> (:ok, base :mod (num, div))
"Returns the modulus of x and y in a result tuple, or an error if y is 0. Truncates towards negative infinity."
(x as :number, 0) -> (:err, "Division by zero.")
(x as :number, y as :number) -> (:ok, base :mod (x, y))
}
fn square {
@ -955,9 +973,18 @@ fn dist {
((x, y)) -> dist (x, y)
}
fn heading/vector {
"Takes a turtle heading, and returns a unit vector of that heading."
(heading) -> {
& 0 is 90º/0.25T, 0.25 is 180º/0.5T, 0.5 is 270º/0.75T, 0.75 is 0º/0T
let a = add (neg (heading), 0.25)
(cos (a), sin (a))
}
}
&&& more number functions
fn random {
"Returns a random something. With zero arguments, returns a random number between 0 (inclusive) and 1 (exclusive). With one argument, returns a random number between 0 and n. With two arguments, returns a random number between m and n. Alternately, given a collection (list, dict, set), it returns a random member of that collection."
"Returns a random something. With zero arguments, returns a random number between 0 (inclusive) and 1 (exclusive). With one argument, returns a random number between 0 and n. With two arguments, returns a random number between m and n. Alternately, given a collection (tuple, list, dict, set), it returns a random member of that collection."
() -> base :random ()
(n as :number) -> mult (n, random ())
(m as :number, n as :number) -> add (m, random (sub (n, m)))
@ -965,6 +992,10 @@ fn random {
let i = do l > count > random > floor
at (l, i)
}
(t as :tuple) -> {
let i = do t > count > random > floor
at (t, i)
}
(d as :dict) -> {
let key = do d > keys > random
get (key, d)
@ -1075,7 +1106,7 @@ let turtle_init = #{
:position (0, 0) & let's call this the origin for now
:heading 0 & this is straight up
:pendown? true
:pencolor colors :white
:pencolor :white
:penwidth 1
:visible? true
}
@ -1083,101 +1114,14 @@ let turtle_init = #{
& turtle states: refs that get modified by calls
& turtle_commands is a list of commands, expressed as tuples
box turtle_commands = []
& and a list of turtle states
box turtle_states = [turtle_init]
fn reset_turtle! {
"Resets the turtle to its original state."
() -> store! (turtle_states, [turtle_init])
}
& and a list of calls to p5--at least for now
box p5_calls = []
& ...and finally, a background color
& we need to store this separately because, while it can be updated later,
& it must be the first call to p5.
box bgcolor = colors :black
fn add_call! (call) -> update! (p5_calls, append! (_, call))
box turtle_state = turtle_init
fn add_command! (command) -> {
update! (turtle_commands, append! (_, command))
let prev = do turtle_states > unbox > last
let prev = unbox (turtle_state)
let curr = apply_command (prev, command)
update! (turtle_states, append! (_, curr))
let call = state/call ()
if call then { add_call! (call); :ok } else :ok
}
fn make_line ((x1, y1), (x2, y2)) -> (:line, x1, y1, x2, y2)
let turtle_radius = 20
let turtle_angle = 0.385
let turtle_color = (255, 255, 255, 150)
fn render_turtle! () -> {
let state = do turtle_states > unbox > last
if state :visible?
then {
let (r, g, b, a) = turtle_color
add_call! ((:fill, r, g, b, a))
let #{heading
:pencolor (pen_r, pen_g, pen_b, pen_a)
:position (x, y)
pendown?
...} = state
let first = mult ((0, 1), turtle_radius)
let (x1, y1) = first
let (x2, y2) = rotate (first, turtle_angle)
let (x3, y3) = rotate (first, neg (turtle_angle))
add_call! ((:push))
add_call! ((:translate, x, y))
add_call! ((:rotate, turn/rad (heading)))
add_call! ((:noStroke))
add_call! ((:beginShape))
add_call! ((:vertex, x1, y1))
add_call! ((:vertex, x2, y2))
add_call! ((:vertex, x3, y3))
add_call! ((:endShape))
& there's a happy bug here: the stroke will be the same width as the pen width. Keep this for now. Consider also showing the pen colour here?
add_call! ((:stroke, pen_r, pen_g, pen_b, pen_a))
if pendown? then add_call! ((:line, 0, 0, x1, y1)) else nil
add_call! ((:pop))
store! (turtle_state, curr)
:ok
}
else :ok
}
fn state/call () -> {
let cmd = do turtle_commands > unbox > last > first
let states = unbox (turtle_states)
let curr = last (states)
let prev = at (states, sub (count (states), 2))
match cmd with {
:forward -> if curr :pendown?
then make_line (prev :position, curr :position)
else nil
:back -> if curr :pendown?
then make_line (prev :position, curr :position)
else nil
:home -> if curr :pendown?
then make_line (prev :position, curr :position)
else nil
:goto -> if curr :pendown?
then make_line (prev :position, curr :position)
else nil
:penwidth -> (:strokeWeight, curr :penwidth)
:pencolor -> {
let (r, g, b, a) = curr :pencolor
(:stroke, r, g, b, a)
}
:clear -> (:background, 0, 0, 0, 255)
_ -> nil
}
}
fn forward! {
@ -1224,6 +1168,7 @@ let pd! = pendown!
fn pencolor! {
"Changes the turtle's pen color. Takes a single grayscale value, an rgb tuple, or an rgba tuple. Alias: pc!"
(color as :keyword) -> add_command! ((:pencolor, color))
(gray as :number) -> add_command! ((:pencolor, (gray, gray, gray, 255)))
((r as :number, g as :number, b as :number)) -> add_command! ((:pencolor, (r, g, b, 255)))
((r as :number, g as :number, b as :number, a as :number)) -> add_command! ((:pencolor, (r, g, b, a)))
@ -1240,9 +1185,10 @@ let pw! = penwidth!
fn background! {
"Sets the background color behind the turtle and path. Alias: bg!"
(gray as :number) -> store! (bgcolor, (gray, gray, gray, 255))
((r as :number, g as :number, b as :number)) -> store! (bgcolor, (r, g, b, 255))
((r as :number, g as :number, b as :number, a as :number)) -> store! (bgcolor, (r, g, b, a))
(color as :keyword) -> add_command! ((:background, color))
(gray as :number) -> add_command! ((:background, (gray, gray, gray, 255)))
((r as :number, g as :number, b as :number)) -> add_command! ((:background, (r, g, b, 255)))
((r as :number, g as :number, b as :number, a as :number)) -> add_command! ((:background, (r, g, b, a)))
}
let bg! = background!
@ -1278,12 +1224,11 @@ fn hideturtle! {
() -> add_command! ((:hide))
}
fn heading/vector {
"Takes a turtle heading, and returns a unit vector of that heading."
(heading) -> {
& 0 is 90º/0.25T, 0.25 is 180º/0.5T, 0.5 is 270º/0.75T, 0.75 is 0º/0T
let angle = add (heading, 0.25)
(cos (angle), sin (angle))
fn loadstate! {
"Sets the turtle state to a previously saved state."
(state) -> {
let #{position, heading, pendown?, pencolor, penwidth, visible?} = state
add_command! ((:loadstate, position, heading, visible?, pendown?, penwidth, pencolor))
}
}
@ -1316,49 +1261,37 @@ fn apply_command {
(:penwidth, pixels) -> assoc (state, :penwidth, pixels)
(:pencolor, color) -> assoc (state, :pencolor, color)
(:setheading, heading) -> assoc (state, :heading, heading)
(:loadstate, position, heading, visible?, pendown?, penwidth, pencolor) -> #{position, heading, visible?, pendown?, penwidth, pencolor}
(:show) -> assoc (state, :visible?, true)
(:hide) -> assoc (state, :visible?, false)
}
}
fn turtle_state {
"Returns the turtle's current state."
() -> do turtle_states > unbox > last
}
fn load_turtle_state! {
"Sets the turtle state to a previously saved state. Returns the state."
(state) -> {
update! (turtle_states, append! (_, state))
let call = state/call ()
if call then { add_call! (call); :ok } else :ok
(:background, _) -> state
}
}
& position () -> (x, y)
fn position {
"Returns the turtle's current position."
() -> turtle_state () :position
() -> do turtle_state > unbox > :position
}
fn heading {
"Returns the turtle's current heading."
() -> turtle_state () :heading
() -> do turtle_state > unbox > :heading
}
fn pendown? {
"Returns the turtle's pen state: true if the pen is down."
() -> turtle_state () :pendown?
() -> do turtle_state > unbox > :pendown?
}
fn pencolor {
"Returns the turtle's pen color as an (r, g, b, a) tuple."
() -> turtle_state () :pencolor
"Returns the turtle's pen color as an (r, g, b, a) tuple or keyword."
() -> do turtle_state > unbox > :pencolor
}
fn penwidth {
"Returns the turtle's pen width in pixels."
() -> turtle_state () :penwidth
() -> do turtle_state > unbox > :penwidth
}
box state = nil
@ -1379,13 +1312,13 @@ pkg Prelude {
background! & turtles
between? & math
bg! & turtles
bgcolor & turtles
bk! & turtles
bool & bool
bool? & bool
box? & boxes
butlast & lists strings tuples
ceil & math
chars & strings
clear! & turtles
coll? & dicts lists sets tuples
colors & turtles
@ -1440,7 +1373,7 @@ pkg Prelude {
left! & turtles
list & lists
list? & lists
load_turtle_state! & turtles
loadstate! & turtles
lt! & turtles
lt? & math
lte? & math
@ -1462,7 +1395,6 @@ pkg Prelude {
omit & set
or & bool
ordered? & lists tuples strings
p5_calls & turtles
pc! & turtles
pd! & turtles
pencolor & turtles
@ -1483,9 +1415,7 @@ pkg Prelude {
random & math dicts lists tuples sets
random_int & math
range & math lists
render_turtle! & turtles
report! & environment
reset_turtle! & turtles
rest & lists tuples
right! & turtles
round & math
@ -1514,13 +1444,14 @@ pkg Prelude {
sum_of_squares & math
tan & math
tau & math
to_number & strings numbers
trim & strings
tuple? & tuples
turn/deg & math
turn/rad & math
turtle_commands & turtles
turtle_init & turtles
turtle_state & turtles
turtle_states & turtles
type & values
unbox & boxes
unwrap! & results

File diff suppressed because one or more lines are too long

View File

@ -1,6 +1,8 @@
# A base library for Ludus
# Only loaded in the prelude
(import /src/scanner :as s)
(defn bool [x] (if (= :^nil x) nil x))
(defn ludus/and [& args] (every? (map bool args)))
@ -129,7 +131,7 @@
:typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0])))
:interpolated (get-in x [:token :lexeme])
:string (get-in x [:token :lexeme])
:splat (string "..." (when (x :splatted) (show-patt (x :splatted))))
:splat (string "..." (when (x :data) (show-patt (x :data))))
(error (string "cannot show pattern of unknown type " (x :type)))))
(defn pretty-patterns [fnn]
@ -235,6 +237,33 @@
(defn mod [x y]
(% x y))
(defn- byte->ascii [c i]
(if (< c 128)
(string/from-bytes c)
(error (string "non-ASCII character at index" i))))
(defn chars [str]
(def out @[])
(try
(for i 0 (length str)
(array/push out (byte->ascii (str i) i)))
([e] (break [:err e])))
[:ok out])
(defn to_number [str]
(when (string/find "&" str)
(break [:err (string "Could not parse `" str "` as a number")]))
(def scanned (s/scan (string/trim str)))
(when (< 0 (length (scanned :errors)))
(break [:err (string "Could not parse `" str "` as a number")]))
(def tokens (scanned :tokens))
(when (< 3 (length tokens))
(break [:err (string "Could not parse `" str "` as a number")]))
(def fst (first tokens))
(when (not= :number (fst :type))
(break [:err (string "Could not parse `" str "` as a number")]))
[:ok (fst :literal)])
(def ctx {
"add" +
"and" ludus/and
@ -243,6 +272,7 @@
"atan_2" math/atan2
"bool" bool
"ceil" math/ceil
"chars" chars
"concat" concat
"conj!" conj!
"conj" conj
@ -290,6 +320,7 @@
"sub" -
"tan" math/tan
"to_list" to_list
"to_number" to_number
"trim" string/trim
"triml" string/triml
"trimr" string/trimr
@ -298,10 +329,9 @@
"upcase" string/ascii-upper
})
(def base (let [b @{}]
(def base (let [b @{:^type :dict}]
(each [k v] (pairs ctx)
(set (b (keyword k)) v))
b))
(set (base :^type) :dict)
(to_number " 123 a ")

View File

@ -12,7 +12,8 @@
(defn escape-punctuation [str] (->> str
(string/replace "?" "")
(string/replace "!" "")))
(string/replace "!" "")
(string/replace "/" "")))
(defn toc-entry [name]
(def escaped (escape-underscores name))
@ -22,18 +23,18 @@
(string/join (map toc-entry sorted-names) "&nbsp;&nbsp;&nbsp; "))
(def topics {
"math" ["abs" "add" "angle" "atan/2" "between?" "ceil" "cos" "dec" "deg/rad" "deg/turn" "dist" "div" "div/0" "div/safe" "even?" "floor" "gt?" "gte?" "heading/vector" "inc" "inv" "inv/0" "inv/safe" "lt?" "lte?" "max" "min" "mod" "mod/0" "mod/safe" "mult" "neg" "neg?" "odd?" "pi" "pos?" "rad/deg" "rad/turn" "random" "random_int" "range" "round" "sin" "sqrt" "sqrt/safe" "square" "sub" "sum_of_squares" "tan" "tau" "turn/deg" "turn/rad" "zero?"]
"math" ["abs" "add" "angle" "atan/2" "between?" "ceil" "cos" "dec" "deg/rad" "deg/turn" "dist" "div" "div/0" "div/safe" "even?" "floor" "gt?" "gte?" "heading/vector" "inc" "inv" "inv/0" "inv/safe" "lt?" "lte?" "max" "min" "mod" "mod/0" "mod/safe" "mult" "neg" "neg?" "odd?" "pi" "pos?" "rad/deg" "rad/turn" "random" "random_int" "range" "round" "sin" "sqrt" "sqrt/safe" "square" "sub" "sum_of_squares" "tan" "tau" "to_number" "turn/deg" "turn/rad" "zero?"]
"boolean" ["and" "bool" "bool?" "false?" "not" "or" "true?"]
"dicts" ["any?" "assoc" "assoc?" "coll?" "count" "dict" "dict?" "diff" "dissoc" "empty?" "get" "keys" "random" "update" "values"]
"lists" ["any?" "append" "at" "butlast" "coll?" "concat" "count" "each!" "empty?" "filter" "first" "fold" "join" "keep" "last" "list" "list?" "map" "ordered?" "random" "range" "rest" "second" "sentence" "slice"]
"sets" ["any?" "append" "coll?" "concat" "contains?" "count" "empty?" "omit" "random" "set" "set?"]
"tuples" ["any?" "at" "coll?" "count" "empty?" "first" "last" "ordered?" "rest" "second" "tuple?"]
"strings" ["any?" "concat" "count" "downcase" "empty?" "join" "sentence" "show" "slice" "split" "string" "string?" "strip" "trim" "upcase" "words"]
"strings" ["any?" "chars" "chars/safe" "concat" "count" "downcase" "empty?" "join" "sentence" "show" "slice" "split" "string" "string?" "strip" "to_number" "trim" "upcase" "words"]
"types and values" ["assoc?" "bool?" "box?" "coll?" "dict?" "eq?" "fn?" "keyword?" "list?" "neq?" "nil?" "number?" "ordered?" "set?" "show" "some" "some?" "string?" "tuple?" "type"]
"boxes and state" ["box?" "unbox" "store!" "update!"]
"results" ["err" "err?" "ok" "ok?" "unwrap!" "unwrap_or"]
"errors" ["assert!"]
"turtle graphics" ["back!" "background!" "bk!" "clear!" "colors" "fd!" "forward!" "goto!" "heading" "heading/vector" "home!" "left!" "lt!" "pc!" "pd!" "pencolor" "pencolor!" "pendown!" "pendown?" "penup!" "penwidth" "penwidth!" "position" "pu!" "pw!" "render_turtle!" "reset_turtle!" "right!" "rt!" "turtle_state"]
"turtle graphics" ["back!" "background!" "bk!" "clear!" "colors" "fd!" "forward!" "goto!" "heading" "heading/vector" "hideturtle!" "home!" "left!" "loadstate!" "lt!" "pc!" "pd!" "pencolor" "pencolor!" "pendown!" "pendown?" "penup!" "penwidth" "penwidth!" "position" "pu!" "pw!" "render_turtle!" "reset_turtle!" "right!" "rt!" "setheading!" "showturtle!" "turtle_state"]
"environment and i/o" ["doc!" "print!" "report!" "state"]
})

View File

@ -345,7 +345,7 @@
(set (the-dict key) value))))
the-dict)
(defn- ref [ast ctx]
(defn- box [ast ctx]
(def {:data value-ast :name name} ast)
(def value (interpret value-ast ctx))
(def box @{:^type :box :^value value :name name})
@ -460,6 +460,7 @@
[:function :tuple] (call-fn root-ast prev curr)
# [:applied :tuple] (call-partial root-ast prev curr)
[:keyword :args] (get (first curr) prev :^nil)
[:keyword :tuple] (get (first curr) prev :^nil)
[:dict :keyword] (get prev curr :^nil)
[:nil :keyword] :^nil
[:pkg :keyword] (get prev curr :^nil)
@ -489,9 +490,9 @@
(def last-term (last terms))
(for i 1 (-> terms length dec)
(def curr (interpret (terms i) ctx))
(set prev (call-fn (first terms) curr [prev])))
(set prev (apply-synth-term (first terms) curr [prev])))
(def last-fn (interpret last-term ctx))
(call-fn (first terms) last-fn [prev]))
(apply-synth-term (first terms) last-fn [prev]))
(defn- pkg [ast ctx]
(def members (ast :data))
@ -594,7 +595,7 @@
# named/naming forms
:word (word ast ctx)
:interpolated (interpolated ast ctx)
:ref (ref ast ctx)
:box (box ast ctx)
:pkg (pkg ast ctx)
:pkg-name (word ast ctx)

View File

@ -12,62 +12,95 @@
(import /src/json :as j)
(defn ludus [source]
# if we can't load prelude, bail
(when (= :error prelude/pkg) (error "could not load prelude"))
# get us a clean working slate
(def ctx @{:^parent prelude/ctx})
(def errors @[])
(def draw @[])
(var result @"")
(def console @"")
# capture all `print`s
(setdyn :out console)
(def out @{:errors errors :draw draw :result result :console console})
# an output table
# this will change: the shape of our output
# at the moment, there's only one stack of turtle graphics
# we will be getting more
(def out @{:errors errors :result result
:io @{
:stdout @{:proto [:text-stream "0.1.0"] :data console}
:turtle @{:proto [:turtle-graphics "0.1.0"] :data @[]}}})
### start the program
# first, scanning
(def scanned (s/scan source))
(when (any? (scanned :errors))
(each err (scanned :errors)
(e/scan-error err))
(break (-> out j/encode string)))
# then, parsing
(def parsed (p/parse scanned))
(when (any? (parsed :errors))
(each err (parsed :errors)
(e/parse-error err))
(break (-> out j/encode string)))
# then, validation
(def validated (v/valid parsed ctx))
(when (any? (validated :errors))
(each err (validated :errors)
(e/validation-error err))
(break (-> out j/encode string)))
(try
(set result (i/interpret (parsed :ast) ctx))
# and, finally, try interpreting the program
(try (do
# we need to do this every run or we get the very same sequence of "random" numbers every time we run a program
(math/seedrandom (os/cryptorand 8))
(set result (i/interpret (parsed :ast) ctx)))
([err]
(e/runtime-error err)
(break (-> out j/encode string))))
(setdyn :out stdout)
(set (out :result) (b/show result))
(var post @{})
(try
(set post (i/interpret prelude/post/ast ctx))
([err] (e/runtime-error err)))
(set (out :draw) (post :draw))
# out
(-> out j/encode string)
)
# stop capturing output
(setdyn :out stdout)
# update our output table with our output
(set (out :result) (b/show result))
(set (((out :io) :turtle) :data) (get-in prelude/pkg [:turtle_commands :^value]))
# run the "postlude": any Ludus code that needs to run after each program
# right now this is just resetting the boxes that hold turtle commands and state
(try
(i/interpret prelude/post/ast ctx)
([err] (e/runtime-error err)))
# json-encode our output table, and convert it from a buffer to a string (which we require for playing nice with WASM/C)
(-> out j/encode string))
#### REPL
(comment
# (do
(def start (os/clock))
# (def start (os/clock))
(def source `
at ("aéc", 3)
fd! (100)
rt! (0.25)
fd! (100)
lt! (0.25)
fd! (100)
setheading! (0.75)
unbox (turtle_state)
`)
(def out (-> source
ludus
j/decode
))
(def end (os/clock))
# (def end (os/clock))
(setdyn :out stdout)
(pp out)
(def console (out "console"))
(print console)
(def result (out "result"))
(print result)
(print (- end start))
# (print (- end start))
)

View File

@ -3,6 +3,9 @@
### We still need to scan some things
(import /src/scanner :as s)
# stash janet type
(def janet-type type)
(defmacro declare
"Forward-declares a function name, so that it can be called in a mutually recursive manner."
[& names]
@ -18,6 +21,26 @@
(if-not (dyn name) (error "recursive functions must be declared before they are defined"))
~(set ,name (defn- ,name ,;forms)))
### Some more human-readable formatting
(defn- pp-tok [token]
(if (not token) (break "nil"))
(def {:line line :lexeme lex :type type :start start} token)
(string "<" line "[" start "]" ": " type ": " lex ">"))
(defn- pp-ast [ast &opt indent]
(default indent 0)
(def {:token token :data data :type type} ast)
(def pretty-tok (pp-tok token))
(def data-rep (if (= :array (janet-type data))
(string "[\n"
(string/join (map (fn [x] (pp-ast x (inc indent))) data)
(string (string/repeat " " indent) "\n"))
"\n" (string/repeat " " indent) "]")
data
))
(string (string/repeat " " indent) type ": " pretty-tok " " data-rep)
)
### Next: a data structure for a parser
(defn- new-parser
"Creates a new parser data structure to pass around"
@ -75,7 +98,9 @@
(has-value? terminators ttype))
# breakers are what terminate panics
(def breaking [:break :newline :semicolon :comma :eof :then :else])
(def breaking [:break :newline :semicolon :comma :eof
# :then :else :arrow
])
(defn- breaks?
"Returns true if the current token in the parser should break a panic"
@ -89,12 +114,12 @@
[parser message]
# (print "Panic in the parser: " message)
(def origin (current parser))
(advance parser)
(def skipped @[origin])
(def skipped @[])
(while (not (breaks? parser))
(array/push skipped (current parser))
(advance parser))
(array/push skipped (current parser))
# (advance parser)
(def err {:type :error :data skipped :token origin :msg message})
(update parser :errors array/push err)
(error err))
@ -279,8 +304,10 @@
(def origin (current parser))
(advance parser) # consume the :lparen
(def ast @{:type :args :data @[] :token origin :partial false})
(while (separates? parser) (advance parser)) # consume any separators
(while (not (check parser :rparen))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed paren"})
(array/push (parser :errors) err)
@ -299,8 +326,7 @@
{:type :placeholder :token origin}))
(capture nonbinding parser)))
(array/push (ast :data) term)
(try (separators parser)
([e] (array/push (ast :data) e))))
(capture separators parser))
(advance parser)
ast)
@ -333,20 +359,26 @@
{:type :synthetic :data [;terms] :token origin})
# collections
### XXX: the current panic/capture structure in this, script, etc. is blowing up when the LAST element (line, tuple member, etc.) has an error
# it does, however, work perfectly well when there isn't one
# there's something about advancing past the breaking token, or not
# aslo, I removed the captures here around nonbinding and separators, and we got into a loop with a panic
# oy
(defn- tup [parser]
(def origin (current parser))
(advance parser) # consume the :lparen
(def ast {:type :tuple :data @[] :token origin})
(while (separates? parser) (advance parser)) # consume any separators
(while (not (check parser :rparen))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed paren"})
(array/push (parser :errors) err)
(error err))
(def term (capture nonbinding parser))
(array/push (ast :data) term)
(try (separators parser)
([e] (array/push (ast :data) e))))
(capture separators parser))
(advance parser)
ast)
@ -354,8 +386,10 @@
(def origin (current parser))
(advance parser)
(def ast {:type :list :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbracket))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed bracket"})
(array/push (parser :errors) err)
@ -369,8 +403,7 @@
)
(capture nonbinding parser)))
(array/push (ast :data) term)
(try (separators parser)
([e] (array/push (ast :data) e))))
(capture separators parser))
(advance parser)
ast)
@ -378,8 +411,10 @@
(def origin (current parser))
(advance parser)
(def ast {:type :set :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbrace))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed brace"})
(array/push (parser :errors) err)
@ -393,8 +428,7 @@
)
(capture nonbinding parser)))
(array/push (ast :data) term)
(try (separators parser)
([e] (array/push (ast :data) e))))
(capture separators parser))
(advance parser)
ast)
@ -402,8 +436,10 @@
(def origin (current parser))
(advance parser)
(def ast {:type :dict :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbrace))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed brace"})
(array/push (parser :errors) err)
@ -423,7 +459,7 @@
(try (panic parser (string "expected dict term, got " (type origin))) ([e] e))
))
(array/push (ast :data) term)
(try (separators parser) ([e] (array/push (ast :data) e))))
(capture separators parser))
(advance parser)
ast)
@ -452,8 +488,10 @@
(def origin (current parser))
(advance parser) # consume the :lparen
(def ast {:type :tuple :data @[] :token origin})
(while (separates? parser) (advance parser)) # consume any separators
(while (not (check parser :rparen))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed paren"})
(array/push (parser :errors) err)
@ -466,8 +504,7 @@
{:type :splat :data splatted :token origin})
(capture pattern parser)))
(array/push (ast :data) term)
(try (separators parser)
([e] (array/push (ast :data) e))))
(capture separators parser))
(advance parser)
ast)
@ -475,8 +512,10 @@
(def origin (current parser))
(advance parser)
(def ast {:type :list :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbracket))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed bracket"})
(array/push (parser :errors) err)
@ -489,8 +528,7 @@
{:type :splat :data splatted :token origin})
(capture pattern parser)))
(array/push (ast :data) term)
(try (separators parser)
([e] (array/push (ast :data) e))))
(capture separators parser))
(advance parser)
ast)
@ -498,8 +536,10 @@
(def origin (current parser))
(advance parser)
(def ast {:type :dict :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbrace))
(accept-many parser :newline :comma)
(when (= :break ((current parser) :type))
(break (advance parser)))
(when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed brace"})
(array/push (parser :errors) err)
@ -519,7 +559,7 @@
(try (panic parser (string "expected dict term, got " (type origin))) ([e] e))
))
(array/push (ast :data) term)
(try (separators parser) ([e] (array/push (ast :data) e))))
(capture separators parser))
(advance parser)
ast)
@ -560,22 +600,25 @@
(defn- iff [parser]
(def ast {:type :if :data @[] :token (current parser)})
(advance parser) #consume the if
(array/push (ast :data) (capture simple parser))
(array/push (ast :data) (simple parser))
(accept-many parser :newline)
(if-let [err (expect-ret parser :then)]
(array/push (ast :data) err)
(advance parser))
(array/push (ast :data) (capture nonbinding parser))
(array/push (ast :data) (nonbinding parser))
(accept-many parser :newline)
(if-let [err (expect-ret parser :else)]
(array/push (ast :data) err)
(advance parser))
(array/push (ast :data) (capture nonbinding parser))
(array/push (ast :data) (nonbinding parser))
ast)
(defn- literal-terminator? [token]
(def tok-type (token :type))
(or (= :newline tok-type) (= :semicolon tok-type)))
(defn- terminator [parser]
(if-not (terminates? parser)
# this line panics, captures the panic, advances the parser, and re-throws the error; solves an off-by-one error
(panic parser "expected terminator"))
(advance parser)
(while (terminates? parser) (advance parser)))
@ -798,13 +841,15 @@
(defn- block [parser]
(def origin (current parser))
(expect parser :lbrace) (advance parser)
(accept-many parser ;terminators)
(def data @[])
(while (not (check parser :rbrace))
(accept-many parser :newline :semicolon)
(when (= :break ((current parser) :type))
(break (advance parser)))
(if (check parser :eof)
(error {:type :error :token origin :data data :msg "unclosed brace"}))
(array/push data (capture expr parser))
(terminator parser))
(capture terminator parser))
(advance parser)
{:type :block :data data :token origin})
@ -826,16 +871,16 @@
(array/push data (capture simple parser)))
{:type :do :data data :token origin})
### refs, pkgs, nses, etc.
(defn- ref [parser]
### boxs, pkgs, nses, etc.
(defn- box [parser]
(def origin (current parser))
(expect parser :ref) (advance parser)
(expect parser :box) (advance parser)
(try
(do
(def name (-> parser word-only (get :data)))
(expect parser :equals) (advance parser)
(def value (nonbinding parser))
{:type :ref :data value :name name :token origin})
{:type :box :data value :name name :token origin})
([err] err)))
(defn- pkg-name [parser]
@ -966,7 +1011,7 @@
### expressions
# four levels of expression complexity:
# simple (atoms, collections, synthetic expressions; no conditionals or binding or blocks)
# nonbinding (excludes let, ref, named fn: what is allowed inside collections)
# nonbinding (excludes let, box, named fn: what is allowed inside collections)
# plain old exprs (anything but toplevel)
# toplevel (exprs + ns, pkg, test, import, use)
@ -1054,7 +1099,7 @@
# binding forms
:let (lett parser)
:fn (fnn parser)
:ref (ref parser)
:box (box parser)
# nonbinding forms
:nil (nill parser)
@ -1103,8 +1148,12 @@
(def origin (current parser))
(def lines @[])
(while (not (check parser :eof))
(accept-many parser :newline)
(array/push lines (capture toplevel parser))
# (print "starting script loop with " (pp-tok origin))
(accept-many parser :newline :semicolon)
(when (= :break ((current parser) :type))
(break (advance parser)))
(def term (capture toplevel parser))
(array/push lines term)
(capture terminator parser))
{:type :script :data lines :token origin})
@ -1117,10 +1166,16 @@
# (do
(comment
(def source `
let foo = :bar
{
foo bar
quux frobulate
baz
12 23 42
}
`)
(def scanned (s/scan source))
# (print "\n***NEW PARSE***\n")
(def a-parser (new-parser scanned))
(def parsed (lett a-parser))
(def parsed (parse scanned))
(pp (map (fn [err] (err :msg)) (parsed :errors)))
(print (pp-ast (parsed :ast)))
)

View File

@ -39,3 +39,4 @@
(def validation-errors (post-validated :errors))
(when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
(post-parsed :ast)))

View File

@ -1,8 +1,9 @@
(def reserved-words
"List of Ludus reserved words."
## see ludus-spec repo for more info
{"as" :as ## impl
"box" :ref
{
"as" :as ## impl
"box" :box
"do" :do ## impl
"else" :else ## impl
"false" :false ## impl -> literal word
@ -17,13 +18,13 @@
"panic!" :panic ## impl (should _not_ be a function)
"pkg" :pkg
"recur" :recur ## impl
"repeat" :repeat ## impl
"test" :test
"then" :then ## impl
"true" :true ## impl -> literal word
"use" :use ## wip
"with" :with ## impl
"when" :when ## impl, replaces cond
"repeat" :repeat ## syntax sugar over "loop": still unclear what this syntax could be
"test" :test
"with" :with ## impl
})
(def literal-words {"true" true
@ -348,8 +349,7 @@
(recur (-> scanner (scan-token) (next-token)))))
(recur (new-scanner source input)))
(comment
# (do
(def source "add 1 2 () four")
(scan source)
)
# (comment
(do
(def source " -123 ")
(length ((scan source) :tokens)))

View File

@ -102,6 +102,11 @@ Deferred until a later iteration of Ludus:
(def node (get ctx name))
(if node node (resolve-name (get ctx :^parent) name)))
(defn- resolve-name-in-script [ctx name]
(when (ctx :^toplevel) (break nil))
(def node (ctx name))
(if node node (resolve-name-in-script (ctx :^parent) name)))
(defn- word [validator]
(def ast (validator :ast))
(def name (ast :data))
@ -157,10 +162,12 @@ Deferred until a later iteration of Ludus:
(def ast (validator :ast))
(def name (ast :data))
(def ctx (validator :ctx))
(when (has-key? ctx name)
(def {:line line :input input} (get-in ctx [name :token]))
### XXX TODO: this resolution should ONLY be for userspace, NOT prelude
(def resolved (resolve-name-in-script ctx name))
(when resolved
(def {:line line :input input} resolved)
(array/push (validator :errors)
{:node ast :msg (string "name is already bound on line "
{:node ast :msg (string "name " name " is already bound on line "
line " of " input)}))
(set (ctx name) ast)
# (pp ctx)
@ -336,7 +343,7 @@ Deferred until a later iteration of Ludus:
(set (ast :arities) arities)
validator)
(defn- ref [validator]
(defn- box [validator]
(def ast (validator :ast))
(def ctx (validator :ctx))
(def expr (ast :data))
@ -435,12 +442,12 @@ Deferred until a later iteration of Ludus:
(def rest-arities (keys (arities :rest)))
(when (empty? rest-arities)
(array/push (validator :errors)
{:node ast :msg "mismatched arity"})
{:node ast :msg "wrong number of arguments"})
(break validator))
(def rest-min (min ;rest-arities))
(when (< num-args rest-min)
(array/push (validator :errors)
{:node ast :msg "mismatched arity"}))
{:node ast :msg "wrong number of arguments"}))
validator)
(defn- kw-root [validator]
@ -750,7 +757,7 @@ Deferred until a later iteration of Ludus:
:use (usee validator)
:loop (loopp validator)
:recur (recur validator)
:ref (ref validator)
:box (box validator)
(error (string "unknown node type " type)))))
(set validate validate*)
@ -758,12 +765,13 @@ Deferred until a later iteration of Ludus:
(defn- cleanup [validator]
(def declared (get-in validator [:status :declared] {}))
(when (any? declared)
(each declaration declared
(each declaration (keys declared)
(array/push (validator :errors) {:node declaration :msg "declared fn, but not defined"})))
validator)
(defn valid [ast &opt ctx]
(default ctx @{})
(set (ctx :^toplevel) true)
(def validator (new-validator ast))
(def base-ctx @{:^parent ctx})
(set (validator :ctx) base-ctx)

92
turtle-graphics.md Normal file
View File

@ -0,0 +1,92 @@
# Turtle Graphics protocol
name: "turtle-graphics"
version: 0.1.0
### Description
Turtle graphics describe the movements and drawing behaviours of screen, robot, and print "turtles."
* `proto`: `["turtle-graphics", "{version number}"]`
* `data`: an array of arrays; each array represents a turtle command; the first element of a command array is the verb; any subsequent items are the arguments to the verbs.
* Valid arguments are numbers, strings, and booleans.
* Depending on what we end up doing, we may add arrays of these, representing tuples or lists, and/or objects with string keys whose text are well-formed keywords in Ludus. For now, however, arguments must be atomic values.
* E.g., `["forward", 100]`
* Each turtle has its own stream.
* At current, this protocol describes the behaviour of turtle-like objects, all of which "live" in the same "world"; there is not yet a provision for multiple canvases/worlds. That said, an additional field for "world" in at the top level may well be added in the future to allow for multiple worlds to unfold at the same time.
### Verbs and arguments
* `forward`, steps: number
- Moves the turtle forward by the number of steps/pixels.
* `back`, steps: number
- Moves the turtle backwards by the number of steps/pixels.
* `right`, turns: number
- Turns the turtle right by the number of turns. (1 turn = 360 degrees.)
* `left`, turns: number
- Turns the turtle to the left by the number of turns. (1 turn = 360 degrees.)
* `penup`, no arguments
- "Lifts" the turtle's pen, keeping it from drawing.
* `pendown`, no arguments
- "Lowers" the turtle's pen, starting it drawing a path.
* `pencolor`, red: number, green: number, blue: number, alpha: number, OR: color: string
- Sets the turtle's pen's color to the specified RGBA color.
* `penwidth`, width: number
- Sets the width of the turtle's pen, in pixels (or some other metric).
* `home`, no arguments
- Sends the turtle back to its starting point, with a heading of 0.
* `goto`, x: number, y: number
- Sends the turtle to the specified Cartesian coordinates, where the origin is the turtle's starting position.
* `setheading`, heading: number
- Sets the turtle's heading. 0 is the turtle's starting heading, with increasing numbers turning to the right.
* `show`, no arguments
- Shows the turtle.
* `hide`, no arguments
- Hides the turtle.
* `loadstate`, x: number, y: number, heading: number, visible: boolean, pendown: boolean, width: number, color: string OR r: number, g: number, b: number, a: number
- Loads a turtle state.
* `clear`, no arguments
- Erases any paths drawn and sets the background color to the default.
* `background`, red: number, green: number, blue: number, alpha: number
- Sets the background color to the specified RGBA color, OR: color: string
These last two feel a little weird to me, since the background color is more the property of the **world** the turtle is in, not the turtle itself. Worlds with multiple turtles will be set up so that _any_ turtle will be able to change the background, and erase all paths.
That said, since we don't yet have a world abstraction/entity, then there's no other place to put them. This will likely be shifted around in later versions of the protocol.
### Other considerations
**Not all turtles will know how to do all these things.**
The idea is that this single abstraction will talk to all the turtle-like things we eventually use.
That means that some turtles won't be able to do all the things; that's fine!
They just won't do things they can't do; but warnings should go to `stderr`.
**Errors are not passed back to Ludus.**
These are fire-off commands.
Errors should be _reported_ to `stderr` or equivalent.
But Ludus sending things to its output streams should only cause Ludus panics when there's an issue in Ludus.
**Colors aren't always RGBA.**
For pen-and-paper turtles, we don't have RGBA colors.
Colors should also be specifiable with strings corresponding to CSS basic colors: black, silver, gray, white, maroon, red, purple, fuchsia, green, lime, olive, yellow, navy, blue, teal, and aqua.
**Turtles should communicate states.**
Ludus should have access to turtle states.
This is important for push/pop situations that we use for L-systems.
There are two ways to do this: Ludus does its own bookkeeping for turtle states, or it has a way to get the state from a turtle.
The latter has the value of being instantaneous, and gives us an _expected_ state of the turtle after the commands are all processed.
In particular, this will be necessary for the recursive L-systems that require pushing and popping turtle state.
The latter has the drawback of potentially allowing the turtle state and expected turtle state to fall out of synch.
The former has the value of always giving us the correct, actual state of the turtle.
It has the drawback of requiring such state reporting to be asynchronous, and perhaps wildly asynchronous, as things like moving robots and plotters will take quite some time to actually draw what Ludus tells it to.
(Being able to wait until `eq? (expected, actual)` to do anything else may well be extremely useful.)
That suggests, then, that both forms of turtle state are desirable and necessary.
Thus: turtles should communicate states (and thus there ought to be a protocol for communicating state back to Ludus) and Ludus should always do the bookkeeping of calculating the expected state.
**Turtles use Cartesian, rather than screen, coordinates.**
The starting position of the turtle is `(0, 0)`, which is the origin, and _centred_ in the field of view.
Increasing the x-coordinate moves the turtle to the right; increasing the y-coordinate moves the turtle _up_.
**Turtles use compass headings, not mathematical angles.**
Turtles start pointing vertially, at heading `0`.
Turning right _increases_ the heading; pointing due "east" is `0.25`; south `0.5`, and west, `0.75`.