Sierpinski arrowhead curve
- Task
Produce a graphical or ASCII-art representation of a Sierpinski arrowhead curve of at least order 3.
Go
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. <lang go>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")
}</lang>
Perl
<lang perl>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;</lang> See: sierpinski-arrowhead-curve.svg (offsite SVG image)
Perl 6
<lang perl6>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.cis.re).round(1), ($y += $scale * $d.cis.im).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> ], ],
);</lang> See: Sierpinski-arrowhead-curve-perl6.svg (offsite SVG image)
Phix
<lang Phix>-- 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()</lang>
zkl
Uses Image Magick and the PPM class from http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#zkl <lang 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");
}</lang>
- Output:
Offsite image at Sierpinski arrowhead curve order 7