add setheading! and turtle pen tip draws in pencolor

This commit is contained in:
Scott Richmond 2024-06-18 18:47:56 -04:00
parent b8af13106a
commit 27b1bb4e50

View File

@ -1062,7 +1062,7 @@ 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 :pencolor colors :white
:penwidth 1 :penwidth 1
:visible? true :visible? true
} }
@ -1112,7 +1112,10 @@ fn render_turtle! () -> {
then { then {
let (r, g, b, a) = turtle_color let (r, g, b, a) = turtle_color
add_call! ((:fill, r, g, b, a)) add_call! ((:fill, r, g, b, a))
let #{heading, :position (x, y), ...} = state let #{heading
:pencolor (pen_r, pen_g, pen_b, pen_a)
:position (x, y)
...} = state
let first = mult ((0, 1), turtle_radius) let first = mult ((0, 1), turtle_radius)
let (x1, y1) = first let (x1, y1) = first
let (x2, y2) = rotate (first, turtle_angle) let (x2, y2) = rotate (first, turtle_angle)
@ -1127,7 +1130,7 @@ fn render_turtle! () -> {
add_call! ((:vertex, x3, y3)) add_call! ((:vertex, x3, y3))
add_call! ((:endShape)) 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? & 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, 0)) add_call! ((:stroke, pen_r, pen_g, pen_b, pen_a))
add_call! ((:line, 0, 0, x1, y1)) add_call! ((:line, 0, 0, x1, y1))
add_call! ((:pop)) add_call! ((:pop))
:ok :ok
@ -1246,6 +1249,11 @@ fn goto! {
((x, y)) -> goto! (x, y) ((x, y)) -> goto! (x, y)
} }
fn setheading! {
"Sets the turtle's heading. The angle is specified in turns, with 0 pointing up. Increasing values rotate the turtle counter-clockwise."
(heading as :number) -> add_command! ((:setheading, heading))
}
fn heading/vector { fn heading/vector {
"Takes a turtle heading, and returns a unit vector of that heading." "Takes a turtle heading, and returns a unit vector of that heading."
(heading) -> { (heading) -> {
@ -1258,8 +1266,10 @@ fn heading/vector {
fn apply_command { fn apply_command {
"Takes a turtle state and a command and calculates a new state." "Takes a turtle state and a command and calculates a new state."
(state, command) -> match command with { (state, command) -> match command with {
(:goto, (x, y)) -> assoc (state, :position, (neg (x), y)) (:goto, (x, y)) -> assoc (state, :position, (x, y))
(:home) -> assoc (state, :position, (0, 0)) (:home) -> do state >
assoc (_, :position, (0, 0)) >
assoc (_, :heading, 0)
(:clear) -> assoc (state, :position, (0, 0)) (:clear) -> assoc (state, :position, (0, 0))
(:right, turns) -> update (state, :heading, add (_, turns)) (:right, turns) -> update (state, :heading, add (_, turns))
(:left, turns) -> update (state, :heading, sub (_, turns)) (:left, turns) -> update (state, :heading, sub (_, turns))
@ -1279,6 +1289,7 @@ fn apply_command {
(: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)
(:setheading, heading) -> assoc (state, :heading, heading)
} }
} }
@ -1454,6 +1465,7 @@ pkg Prelude {
sentence & lists strings sentence & lists strings
set & sets set & sets
set? & sets set? & sets
setheading! & turtles
show & strings show & strings
sin & math sin & math
slice & lists tuples strings slice & lists tuples strings