Sierpinski arrowhead curve

From Rosetta Code
Revision as of 02:31, 3 March 2020 by SqrtNegInf (talk | contribs) (Added Perl example)
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

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. <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

Works with: Rakudo version 2020.02

<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

Library: pGUI

<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