Rebol3 Code Examplex
Sierpinski curve
A space-filling fractal curve that recursively fills a square.
Rebol [
title: "Rosetta code: Sierpinski curve"
file: %Sierpinski_curve.r3
url: https://rosettacode.org/wiki/Sierpinski_curve
needs: blend2d
]
sierpinski-curve: function/with [
"Generate draw-dialect line commands for a Sierpinski curve fractal."
x0 [ number!] "Starting x position"
y0 [ number!] "Starting y position"
step [ number!] "Base segment length (h)"
level [integer!] "Recursion depth"
][
x1: x0 y1: y0 h: step
repend cmds: clear [] ['line as-pair x1 y1]
drawN level lineNE ;; top-right corner
drawE level lineSE ;; bottom-right corner
drawS level lineSW ;; bottom-left corner
drawW level lineNW ;; top-left corner
cmds
][
;; --- persistent (with-block) locals ---
x1: y1: h: cmds: _
;; Append a line segment from current pen position to (x,y)
lineto: func [x y] [
append cmds as-pair x y
x1: x y1: y
]
;; Cardinal and diagonal single-step moves
lineN: does [lineto x1 y1 - (2 * h)]
lineS: does [lineto x1 y1 + (2 * h)]
lineE: does [lineto x1 + (2 * h) y1]
lineW: does [lineto x1 - (2 * h) y1]
lineNW: does [lineto x1 - h y1 - h]
lineNE: does [lineto x1 + h y1 - h]
lineSE: does [lineto x1 + h y1 + h]
lineSW: does [lineto x1 - h y1 + h]
;; Each drawX recurses into sub-curves, with diagonal connectors between them
drawN: func [i] [
either i = 1 [
lineNE lineN lineNW ;; base: /‾\
][
i: i - 1
drawN i lineNE ;; north sub-curve, then step NE
drawE i lineN ;; east sub-curve, then step N
drawW i lineNW ;; west sub-curve, then step NW
drawN i ;; north sub-curve again (closes arch)
]
]
drawE: func [i] [
either i = 1 [
lineSE lineE lineNE ;; base: \|/ right side
][
i: i - 1
drawE i lineSE
drawS i lineE
drawN i lineNE
drawE i
]
]
drawS: func [i] [
either i = 1 [
lineSW lineS lineSE ;; base: \_/
][
i: i - 1
drawS i lineSW
drawW i lineS
drawE i lineSE
drawS i
]
]
drawW: func [i] [
either i = 1 [
lineNW lineW lineSW ;; base: \|/ left side
][
i: i - 1
drawW i lineNW
drawN i lineW
drawS i lineSW
drawW i
]
]
]
cmds: [pen red line-width 4]
append cmds sierpinski-curve 30.0 770.0 12.0 4
append cmds [pen blue line-width 2]
append cmds sierpinski-curve 20.0 780.0 3.0 6
browse save %Sierpinski_curve.png draw 800x800 cmds