Rebol3 Code Examplex


Sierpinski arrowhead curve

A recursive fractal curve that follows a simple turning rule and converges to the Sierpiński triangle pattern.

Rebol [
    title: "Rosetta code: Sierpinski arrowhead curve"
    file:  %Sierpinski_arrowhead_curve.r3
    url:   https://rosettacode.org/wiki/Sierpinski_arrowhead_curve
    needs: blend2d
]

sierpinski-arrowhead: function/with [
    "Draw the Sierpinski arrowhead curve into a window using the L-system turtle method."
    size  [pair!]    "canvas dimensions in pixels (width x height)"
    order [integer!] "recursion depth; 0 = single segment, higher = finer fractal"
][
    width:  size/x
    height: size/y

    theta: 0.0          ;; turtle heading in degrees
    cx:    0.0          ;; turtle position: start centred horizontally
    cy:    height       ;; at the bottom edge

    prev: as-pair cx height

    draw-cmds: clear []

    ;; parity of order determines initial heading so the curve fills the triangle correctly
    either zero? order & 1 [
        curve draw-cmds order width 60
    ][
        turn 60
        curve draw-cmds order width -60
    ]
    ;; emit the final segment after the recursion unwinds
    line draw-cmds cx
    draw-cmds
][
    ;; --- persistent (with-block) locals ---
    theta: cx: cy: draw-cmds: curr: prev: _

    ;; emit one line segment from `prev` to the current turtle position,
    ;; then advance the turtle by `length` in direction `theta`
    line: func [cmds length] [
        curr: as-pair cx cy
        append cmds reduce ['line prev curr]
        cx: cx + (length * cosine theta)
        cy: cy + (length * sine   theta)
        prev: curr
    ]

    turn: func [angle] [ theta: (theta + angle) % 360 ]

    ;; recursive L-system expansion:
    ;;   ord 0 — base case: draw one segment of `length`
    ;;   ord N — split into three half-length sub-curves with alternating turn signs,
    ;;            matching the arrowhead substitution rule A→B-A-B, B→A+B+A
    curve: func [cmds ord length angle] [
        either ord = 0 [
            line cmds length
        ][
            ord: ord - 1 length: length / 2
            curve cmds ord length negate angle
            turn angle
            curve cmds ord length angle
            turn angle
            curve cmds ord length negate angle
        ]
    ]
]

canvas: make image! [770x770 0.0.0]
foreach [order color][
    4 255.100.0
    6 100.255.0
    8 0.100.255
][
    cmds: compose [pen (color) line-width (10 - order)]
    append cmds sierpinski-arrowhead 770x700 order
    draw canvas cmds
]

browse save %Sierpinski_arrowhead_curve.png canvas