Finish turtle graphics?
This commit is contained in:
parent
14862c3ba9
commit
17592149f1
|
@ -110,6 +110,10 @@ fn map {
|
||||||
fn mapper (prev, curr) -> append (prev, f (curr))
|
fn mapper (prev, curr) -> append (prev, f (curr))
|
||||||
fold (mapper, xs, [])
|
fold (mapper, xs, [])
|
||||||
}
|
}
|
||||||
|
(kw as :keyword, xs) -> {
|
||||||
|
fn mapper (prev, curr) -> append (prev, kw (curr))
|
||||||
|
fold (mapper, xs, [])
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
fn append {
|
fn append {
|
||||||
|
@ -174,7 +178,7 @@ fn deref {
|
||||||
|
|
||||||
fn make! {
|
fn make! {
|
||||||
"Sets the value of a ref."
|
"Sets the value of a ref."
|
||||||
(r as :ref, value) -> base :make! (r, value)
|
(r as :ref, value) -> base :set! (r, value)
|
||||||
}
|
}
|
||||||
|
|
||||||
fn update! {
|
fn update! {
|
||||||
|
@ -260,6 +264,11 @@ fn abs {
|
||||||
(n) -> if neg? (n) then mult (-1, n) else n
|
(n) -> if neg? (n) then mult (-1, n) else n
|
||||||
}
|
}
|
||||||
|
|
||||||
|
fn neg {
|
||||||
|
"Multiplies a number by -1, negating it."
|
||||||
|
(n as :number) -> mult (n, -1)
|
||||||
|
}
|
||||||
|
|
||||||
fn angle {
|
fn angle {
|
||||||
"Calculates the angle between two vectors."
|
"Calculates the angle between two vectors."
|
||||||
(v1, v2) -> sub (atan/2 (v2), atan/2 (v1))
|
(v1, v2) -> sub (atan/2 (v2), atan/2 (v1))
|
||||||
|
@ -458,6 +467,7 @@ fn assoc? {
|
||||||
|
|
||||||
fn get {
|
fn get {
|
||||||
"Takes a dict or struct, key, and optional default value; returns the value at key. If the value is not found, returns nil or the default value. Returns nil or default if the first argument is not a dict or struct."
|
"Takes a dict or struct, key, and optional default value; returns the value at key. If the value is not found, returns nil or the default value. Returns nil or default if the first argument is not a dict or struct."
|
||||||
|
(key as :keyword) -> get (key, _)
|
||||||
(key as :keyword, coll) -> base :get (key, coll)
|
(key as :keyword, coll) -> base :get (key, coll)
|
||||||
(key as :keyword, coll, default) -> base :get (key, coll, default)
|
(key as :keyword, coll, default) -> base :get (key, coll, default)
|
||||||
}
|
}
|
||||||
|
@ -474,11 +484,11 @@ fn dict {
|
||||||
& TODO: make this less awkward once we have tail recursion
|
& TODO: make this less awkward once we have tail recursion
|
||||||
fn each! {
|
fn each! {
|
||||||
"Takes a list and applies a function, presumably with side effects, to each element in the list. Returns nil."
|
"Takes a list and applies a function, presumably with side effects, to each element in the list. Returns nil."
|
||||||
(f as :fn, []) -> nil
|
(f! as :fn, []) -> nil
|
||||||
(f as :fn, [x]) -> { f (x); nil }
|
(f! as :fn, [x]) -> { f! (x); nil }
|
||||||
(f, [...xs]) -> loop (xs) with {
|
(f! as :fn, [...xs]) -> loop (xs) with {
|
||||||
([x]) -> { f (x); nil }
|
([x]) -> { f! (x); nil }
|
||||||
([x, ...xs]) -> { f (x); recur (xs) }
|
([x, ...xs]) -> { f! (x); recur (xs) }
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -524,6 +534,15 @@ fn tan {
|
||||||
(a as :number, :radians) -> base :tan (a)
|
(a as :number, :radians) -> base :tan (a)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
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)))
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
fn turn/deg {
|
fn turn/deg {
|
||||||
"Converts an angle in turns to an angle in degrees."
|
"Converts an angle in turns to an angle in degrees."
|
||||||
(a as :number) -> mult (a, 360)
|
(a as :number) -> mult (a, 360)
|
||||||
|
@ -636,21 +655,16 @@ let colors = @{
|
||||||
let turtle_init = #{
|
let turtle_init = #{
|
||||||
:position (0, 0) & let's call this the origin for now
|
:position (0, 0) & let's call this the origin for now
|
||||||
:heading 0 & this is straight up
|
:heading 0 & this is straight up
|
||||||
:pendown true
|
:pendown? true
|
||||||
:color colors :white
|
:color colors :white
|
||||||
:penwidth 1
|
:penwidth 1
|
||||||
:visible true
|
:visible? true
|
||||||
}
|
}
|
||||||
|
|
||||||
& turtle_commands is a list of commands, expressed as tuples
|
& turtle_commands is a list of commands, expressed as tuples
|
||||||
& the first member of each tuple is the command
|
& the first member of each tuple is the command
|
||||||
ref turtle_commands = []
|
ref turtle_commands = []
|
||||||
|
|
||||||
ref last_command = ()
|
|
||||||
|
|
||||||
& give ourselves a ref for current turtle state
|
|
||||||
ref turtle_state = turtle_init
|
|
||||||
|
|
||||||
& and a list of turtle states
|
& and a list of turtle states
|
||||||
ref turtle_states = [turtle_init]
|
ref turtle_states = [turtle_init]
|
||||||
|
|
||||||
|
@ -658,25 +672,77 @@ ref p5_calls = [
|
||||||
(:background, 0)
|
(:background, 0)
|
||||||
]
|
]
|
||||||
|
|
||||||
fn add_call! (call) -> update! (p5_calls, conj (_, call))
|
ref bgcolor = (0, 0, 0, 255)
|
||||||
|
|
||||||
|
fn add_call! (call) -> update! (p5_calls, append (_, call))
|
||||||
|
|
||||||
fn add_command! (command) -> {
|
fn add_command! (command) -> {
|
||||||
update! (turtle_commands, append (_, command))
|
update! (turtle_commands, append (_, command))
|
||||||
make! (last_command, command)
|
let prev = do turtle_states > deref > last
|
||||||
let current_state = deref (turtle_state)
|
let curr = apply_command (prev, command)
|
||||||
let new_state = apply_command (current_state, command)
|
update! (turtle_states, append (_, curr))
|
||||||
update! (turtle_states, append (_, new_state))
|
let call = state/call ()
|
||||||
make! (turtle_state, new_state)
|
if call then { add_call! (call); :ok } else :ok
|
||||||
render_command! ()
|
|
||||||
:ok
|
|
||||||
}
|
}
|
||||||
|
|
||||||
fn render_command! () -> {
|
fn make_line ((x1, y1), (x2, y2)) -> (:line, x1, y1, x2, y2)
|
||||||
let cmd = first (command)
|
|
||||||
let state = deref (turtle_state)
|
let turtle_radius = 20
|
||||||
let #{position, heading, pendown, color, penwidth, visible} = state
|
|
||||||
|
let turtle_angle = 0.375
|
||||||
|
|
||||||
|
let turtle_color = (100, 100, 100, 100)
|
||||||
|
|
||||||
|
fn render_turtle! () -> {
|
||||||
|
let state = do turtle_state > deref > last
|
||||||
|
if state :visible?
|
||||||
|
then {
|
||||||
|
add_call! ((:push))
|
||||||
|
let (r, g, b, a) = turtle_color
|
||||||
|
add_call! ((:fill, r, g, b, a))
|
||||||
|
add_call! ((:noStroke))
|
||||||
|
let #{heading, position} = state
|
||||||
|
add_call! ((:rotate, turn/deg (heading)))
|
||||||
|
add_call! ((:beginShape))
|
||||||
|
let head_unit = heading/vec (heading)
|
||||||
|
let first = mult (head_unit, turtle_radius)
|
||||||
|
let second = rotate (first, turtle_angle)
|
||||||
|
let third = rotate (first, neg (turtle_angle))
|
||||||
|
add_call! ((:vertex, first))
|
||||||
|
add_call! ((:vertex, second))
|
||||||
|
add_call! ((:vertx, third))
|
||||||
|
add_call! ((:pop))
|
||||||
|
:ok
|
||||||
|
}
|
||||||
|
else :ok
|
||||||
|
}
|
||||||
|
|
||||||
|
fn state/call () -> {
|
||||||
|
let cmd = do turtle_commands > deref > last > first
|
||||||
|
let states = deref (turtle_states)
|
||||||
|
let curr = last (states)
|
||||||
|
let prev = nth (states, sub (count (states), 2))
|
||||||
|
print! ("Curr, prev, command", curr, prev, cmd)
|
||||||
match cmd with {
|
match cmd with {
|
||||||
:forward -> :todo
|
:forward -> if curr :pendown?
|
||||||
|
then make_line (curr :position, prev :position)
|
||||||
|
else nil
|
||||||
|
:back -> if curr :pendown?
|
||||||
|
then make_line (curr :position, prev :position)
|
||||||
|
else nil
|
||||||
|
:home -> if curr :pendown?
|
||||||
|
then make_line (curr :position, prev :position)
|
||||||
|
else nil
|
||||||
|
:goto -> if curr :pendown?
|
||||||
|
then make_line (curr :position, prev :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)
|
||||||
|
else -> nil
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -740,9 +806,9 @@ let pw! = penwidth!
|
||||||
|
|
||||||
fn background! {
|
fn background! {
|
||||||
"Sets the background color behind the turtle and path. Alias: bg!"
|
"Sets the background color behind the turtle and path. Alias: bg!"
|
||||||
(gray as :number) -> background! ((gray, gray, gray, 255))
|
(gray as :number) -> make! (bgcolor, (gray, gray, gray, 255))
|
||||||
((r as :number, g as :number, b as :number)) -> background! ((r, g, b, 255))
|
((r as :number, g as :number, b as :number)) -> make! (bgcolor, (r, b, g, 255))
|
||||||
((r as :number, g as :number, b as :number, a as :number)) -> background! ((r, g, b, a))
|
((r as :number, g as :number, b as :number, a as :number)) -> make! (bgcolor, (r, g, b, a))
|
||||||
}
|
}
|
||||||
|
|
||||||
let bg! = background!
|
let bg! = background!
|
||||||
|
@ -790,24 +856,43 @@ fn apply_command {
|
||||||
let vect = mult (steps, unit)
|
let vect = mult (steps, unit)
|
||||||
update (state, :position, sub (_, vect))
|
update (state, :position, sub (_, vect))
|
||||||
}
|
}
|
||||||
(:penup) -> assoc (state, :pendown, false)
|
(:penup) -> assoc (state, :pendown?, false)
|
||||||
(:pendown) -> assoc (state, :pendown, true)
|
(:pendown) -> assoc (state, :pendown?, true)
|
||||||
(:penwidth, pixels) -> assoc (state, :penwidth, pixels)
|
(:penwidth, pixels) -> assoc (state, :penwidth, pixels)
|
||||||
(:pencolor, color) -> assoc (state, :pencolor, color)
|
(:pencolor, color) -> assoc (state, :pencolor, color)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
fn turtle/p5 {
|
fn turtle_state {
|
||||||
"Takes a list of turtle states and returns a list of p5 calls that will render the turtle states."
|
"Returns the turtle's current state."
|
||||||
() -> :todo
|
() -> do turtle_states > deref > last
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
& turtlestate () -> @{:position (x, y), :heading turns, :visible boolean, :pen penstate}
|
|
||||||
|
|
||||||
& position () -> (x, y)
|
& position () -> (x, y)
|
||||||
& heading () -> turns
|
fn position {
|
||||||
& penstate () -> @{:down :boolean, :color (r, g, b, a), :width pixels}
|
"Returns the turtle's current position."
|
||||||
|
() -> turtle_state () :position
|
||||||
|
}
|
||||||
|
|
||||||
|
fn heading {
|
||||||
|
"Returns the turtle's current heading."
|
||||||
|
() -> turtle_state () :heading
|
||||||
|
}
|
||||||
|
|
||||||
|
fn pendown? {
|
||||||
|
"Returns the turtle's pen state: true if the pen is down."
|
||||||
|
() -> turtle_state () :pendown?
|
||||||
|
}
|
||||||
|
|
||||||
|
fn pencolor {
|
||||||
|
"Returns the turtle's pen color as an (r, g, b, a) tuple."
|
||||||
|
() -> turtle_state () :pencolor
|
||||||
|
}
|
||||||
|
|
||||||
|
fn penwidth {
|
||||||
|
"Returns the turtle's pen width in pixels."
|
||||||
|
() -> turtle_state () :pencolor
|
||||||
|
}
|
||||||
|
|
||||||
ns prelude {
|
ns prelude {
|
||||||
first
|
first
|
||||||
|
@ -842,6 +927,7 @@ ns prelude {
|
||||||
div/safe
|
div/safe
|
||||||
angle
|
angle
|
||||||
abs
|
abs
|
||||||
|
neg
|
||||||
zero?
|
zero?
|
||||||
neg?
|
neg?
|
||||||
pos?
|
pos?
|
||||||
|
@ -900,9 +986,9 @@ ns prelude {
|
||||||
pencolor!, pc!
|
pencolor!, pc!
|
||||||
penwidth!, pw!
|
penwidth!, pw!
|
||||||
home!, clear!, goto!,
|
home!, clear!, goto!,
|
||||||
turtle_commands, turtle_init
|
heading, position, pendown?
|
||||||
add_command!, apply_command,
|
pencolor, penwidth
|
||||||
heading/vector
|
heading/vector
|
||||||
turtle_state
|
turtle_state
|
||||||
turtle_states
|
p5_calls, turtle_states, turtle_commands
|
||||||
}
|
}
|
Loading…
Reference in New Issue
Block a user