Sierpinski arrowhead curve

From Rosetta Code
Sierpinski arrowhead curve is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.


Task

Produce a graphical or ASCII-art representation of a Sierpinski arrowhead curve of at least order 3.

Go[edit]

Library: Go Graphics
Translation of: Phix

A partial translation anyway which produces a static image of a SAC of order 6, magenta on black, which can be viewed with a utility such as EOG.

package main
 
import (
"github.com/fogleman/gg"
"math"
)
 
var (
width = 770.0
height = 770.0
dc = gg.NewContext(int(width), int(height))
iy = 1.0
theta = 0
)
 
var cx, cy, h float64
 
func arrowhead(order int, length float64) {
// if order is even, we can just draw the curve
if order&1 == 0 {
curve(order, length, 60)
} else {
turn(60)
curve(order, length, -60)
}
drawLine(length) // needed to make base symmetric
}
 
func drawLine(length float64) {
dc.LineTo(cx-width/2+h, (height-cy)*iy+2*h)
rads := gg.Radians(float64(theta))
cx += length * math.Cos(rads)
cy += length * math.Sin(rads)
}
 
func turn(angle int) {
theta = (theta + angle) % 360
}
 
func curve(order int, length float64, angle int) {
if order == 0 {
drawLine(length)
} else {
curve(order-1, length/2, -angle)
turn(angle)
curve(order-1, length/2, angle)
turn(angle)
curve(order-1, length/2, -angle)
}
}
 
func main() {
dc.SetRGB(0, 0, 0) // black background
dc.Clear()
order := 6
if order&1 == 0 {
iy = -1 // apex will point upwards
}
cx, cy = width/2, height
h = cx / 2
arrowhead(order, cx)
dc.SetRGB255(255, 0, 255) // magenta curve
dc.SetLineWidth(2)
dc.Stroke()
dc.SavePNG("sierpinski_arrowhead_curve.png")
}


Julia[edit]

using Lindenmayer # https://github.com/cormullion/Lindenmayer.jl
 
scurve = LSystem(Dict("F" => "G+F+Gt", "G"=>"F-G-F"), "G")
 
drawLSystem(scurve,
forward = 3,
turn = 60,
startingy = -350,
iterations = 8,
startingorientation = π/3,
filename = "sierpinski_arrowhead_curve.png",
showpreview = true
)
 


Perl[edit]

use strict;
use warnings;
use SVG;
use List::Util qw(max min);
use constant pi => 2 * atan2(1, 0);
 
my %rules = (
X => 'YF+XF+Y',
Y => 'XF-YF-X'
);
my $S = 'Y';
$S =~ s/([XY])/$rules{$1}/eg for 1..7;
 
my (@X, @Y);
my ($x, $y) = (0, 0);
my $theta = 0;
my $r = 6;
 
for (split //, $S) {
if (/F/) {
push @X, sprintf "%.0f", $x;
push @Y, sprintf "%.0f", $y;
$x += $r * cos($theta);
$y += $r * sin($theta);
}
elsif (/\+/) { $theta += pi/3; }
elsif (/\-/) { $theta -= pi/3; }
}
 
my ($xrng, $yrng) = ( max(@X) - min(@X), max(@Y) - min(@Y));
my ($xt, $yt) = (-min(@X) + 10, -min(@Y) + 10);
 
my $svg = SVG->new(width=>$xrng+20, height=>$yrng+20);
my $points = $svg->get_path(x=>\@X, y=>\@Y, -type=>'polyline');
$svg->rect(width=>"100%", height=>"100%", style=>{'fill'=>'black'});
$svg->polyline(%$points, style=>{'stroke'=>'orange', 'stroke-width'=>1}, transform=>"translate($xt,$yt)");
 
open my $fh, '>', 'sierpinski-arrowhead-curve.svg';
print $fh $svg->xmlify(-namespace=>'svg');
close $fh;

See: sierpinski-arrowhead-curve.svg (offsite SVG image)

Phix[edit]

Library: pGUI
-- demo\rosetta\Sierpinski_arrowhead_curve.exw
--
-- Draws curves lo to hi (simultaneously), initially {6,6}, max {10,10}
-- Press +/- to change hi, shift +/- to change lo.
-- ("=_" are also mapped to "+-", for the non-numpad +/-)
--
include pGUI.e
 
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas
 
integer width, height,
lo = 6, hi = 6
atom cx, cy, h, theta
 
integer iy = +1
 
procedure draw_line(atom l)
cdCanvasVertex(cddbuffer, cx-width/2+h, (height-cy)*iy+2*h)
cx += l*cos(theta*CD_DEG2RAD)
cy += l*sin(theta*CD_DEG2RAD)
end procedure
 
procedure turn(integer angle)
theta = mod(theta+angle,360)
end procedure
 
procedure curve(integer order, atom l, integer angle)
if order=0 then
draw_line(l)
else
curve(order-1, l/2, -angle)
turn(angle)
curve(order-1, l/2, angle)
turn(angle)
curve(order-1, l/2, -angle)
end if
end procedure
 
procedure sierpinski_arrowhead_curve(integer order, atom l)
-- If order is even we can just draw the curve.
if and_bits(order,1)=0 then
curve(order, l, +60)
else -- order is odd
turn( +60)
curve(order, l, -60)
end if
draw_line(l)
end procedure
 
function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
{width, height} = IupGetIntInt(canvas, "DRAWSIZE")
cdCanvasActivate(cddbuffer)
for order=lo to hi do
cx = width/2
cy = height
h = cx/2
theta = 0
iy = iff(and_bits(order,1)?-1:+1)
cdCanvasBegin(cddbuffer, CD_OPEN_LINES)
sierpinski_arrowhead_curve(order, cx)
cdCanvasEnd(cddbuffer)
end for
cdCanvasFlush(cddbuffer)
return IUP_DEFAULT
end function
 
function map_cb(Ihandle ih)
cdcanvas = cdCreateCanvas(CD_IUP, ih)
cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
cdCanvasSetBackground(cddbuffer, CD_WHITE)
cdCanvasSetForeground(cddbuffer, CD_BLUE)
return IUP_DEFAULT
end function
 
function key_cb(Ihandle /*ih*/, atom c)
if c=K_ESC then return IUP_CLOSE end if
if find(c,"+=-_") then
bool bShift = IupGetInt(NULL,"SHIFTKEY")
if c='+' or c='=' then
if bShift then
lo = min(lo+1,hi)
else
hi = min(10,hi+1)
end if
elsif c='-' or c='_' then
if bShift then
lo = max(1,lo-1)
else
hi = max(lo,hi-1)
end if
end if
IupSetStrAttribute(dlg, "TITLE", "Sierpinski arrowhead curve (%d..%d)",{lo,hi})
cdCanvasClear(cddbuffer)
IupUpdate(canvas)
end if
return IUP_CONTINUE
end function
 
procedure main()
IupOpen()
 
canvas = IupCanvas(NULL)
IupSetAttribute(canvas, "RASTERSIZE", "770x770")
IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
 
dlg = IupDialog(canvas)
IupSetAttribute(dlg, "TITLE", "Sierpinski arrowhead curve (6..6)")
IupSetCallback(dlg, "K_ANY", Icallback("key_cb"))
 
IupMap(dlg)
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
IupMainLoop()
IupClose()
end procedure
 
main()

Raku[edit]

(formerly Perl 6)

Works with: Rakudo version 2020.02
use SVG;
 
role Lindenmayer {
has %.rules;
method succ {
self.comb.map( { %!rules{$^c} // $c } ).join but Lindenmayer(%!rules)
}
}
 
my $arrow = 'X' but Lindenmayer( { X => 'YF+XF+Y', Y => 'XF-YF-X' } );
 
$arrow++ xx 7;
 
my $w = 800;
my $h = ($w * 3**.5 / 2).round(1);
 
my $scale = 6;
my @points = (400, 15);
my $dir = pi/3;
 
for $arrow.comb {
state ($x, $y) = @points[0,1];
state $d = $dir;
when 'F' { @points.append: ($x += $scale * $d.cos).round(1), ($y += $scale * $d.sin).round(1) }
when '+' { $d += $dir }
when '-' { $d -= $dir }
default { }
}
 
my $out = './sierpinski-arrowhead-curve-perl6.svg'.IO;
 
$out.spurt: SVG.serialize(
svg => [
:width($w), :height($h),
:rect[:width<100%>, :height<100%>, :fill<black>],
:polyline[ :points(@points.join: ','), :fill<black>, :style<stroke:#FF4EA9> ],
],
);

See: Sierpinski-arrowhead-curve-perl6.svg (offsite SVG image)

Sidef[edit]

Uses the LSystem() class from Hilbert curve.

var rules = Hash(
x => 'yF+xF+y',
y => 'xF-yF-x',
)
 
var lsys = LSystem(
width: 550,
height: 500,
 
xoff: -20,
yoff: -30,
 
len: 4,
turn: -90,
angle: 60,
color: 'dark green',
)
 
lsys.execute('xF', 7, "sierpiński_arrowhead.png", rules)

Output image: Sierpiński arrowhead

zkl[edit]

Uses Image Magick and the PPM class from http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#zkl

order:=7;
sierpinskiArrowheadCurve(order) : turtle(_,order);
 
fcn sierpinskiArrowheadCurve(n){ // Lindenmayer system --> Data of As & Bs
var [const] A="BF+AF+B", B="AF-BF-A"; // Production rules
var [const] Axiom="AF";
buf1,buf2 := Data(Void,Axiom).howza(3), Data().howza(3); // characters
do(n){
buf1.pump(buf2.clear(),fcn(c){ if(c=="A") A else if(c=="B") B else c });
t:=buf1; buf1=buf2; buf2=t; // swap buffers
}
buf1 // n=7 --> 6,560 characters
}
 
fcn turtle(curve,order){ // Turtle with that can turn +-60*
const D=10.0, a60=60;
dir:=order.isOdd and a60 or 0; // start direction depends on order
img,color := PPM(1300,1200), 0x00ff00; // green on black
x,y := 10, 10;
foreach c in (curve){ // A & B are no-op during drawing
switch(c){
case("F"){ // draw forward
a,b := D.toRectangular(dir.toFloat().toRad());
img.line(x,y, (x+=a.round()),(y+=b.round()), color)
}
case("+"){ dir=(dir - a60)%360; } // turn left 60*
case("-"){ dir=(dir + a60)%360; } // turn right 60*
}
}
img.writeJPGFile("sierpinskiArrowheadCurve.zkl.jpg");
}
Output:

Offsite image at Sierpinski arrowhead curve order 7