Sierpinski square curve

Sierpinski square 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 square curve of at least order 3.

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 $sierpinski = 'X' but Lindenmayer( { X => 'XF-F+F-XF+F+XF-F+F-X' } );

$sierpinski++ xx 5;

my $dim = 600; my $scale = 6;

my @points = (-80, 298);

for $sierpinski.comb {

   state ($x, $y) = @points[0,1];
   state $d = $scale + 0i;
   when 'F' { @points.append: ($x += $d.re).round(1), ($y += $d.im).round(1) }
   when /< + - >/ { $d *= "{$_}1i" }
   default { }

}

my @t = @points.tail(2).clone;

my $out = './sierpinski-square-curve-perl6.svg'.IO;

$out.spurt: SVG.serialize(

   svg => [
       :width($dim), :height($dim),
       :rect[:width<100%>, :height<100%>, :fill<black>],
       :polyline[
         :points((@points, map {(@t »+=» $_).clone}, ($scale,0), (0,$scale), (-$scale,0)).join: ','),
         :fill<black>, :transform("rotate(45, 300, 300)"), :style<stroke:#61D4FF>,
       ],
       :polyline[
         :points(@points.map( -> $x,$y { $x, $dim - $y + 1 }).join: ','),
         :fill<black>, :transform("rotate(45, 300, 300)"), :style<stroke:#61D4FF>,
       ],
   ],

);</lang> See: Sierpinski-square-curve-perl6.svg (offsite SVG image)

Phix

Library: pGUI

<lang Phix>-- demo\rosetta\Sierpinski_square_curve.exw -- -- Draws curves lo to hi (simultaneously), initially {1,1}, max {8,8} -- 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 = 1, hi = 1

atom cx, cy, h

procedure lineTo(atom newX, newY)

   cdCanvasVertex(cddbuffer, newX-width/2+h, height-newY+2*h)
   cx = newX
   cy = newY

end procedure

procedure lineN() lineTo(cx,cy-2*h) end procedure procedure lineS() lineTo(cx,cy+2*h) end procedure procedure lineE() lineTo(cx+2*h,cy) end procedure procedure lineW() lineTo(cx-2*h,cy) end procedure

procedure lineNW() lineTo(cx-h,cy-h) end procedure procedure lineNE() lineTo(cx+h,cy-h) end procedure procedure lineSE() lineTo(cx+h,cy+h) end procedure procedure lineSW() lineTo(cx-h,cy+h) end procedure

procedure sierN(integer level)

  if level=1 then
     lineNE()  lineN()
     lineNW()
  else
     sierN(level-1)  lineNE()
     sierE(level-1)  lineN()
     sierW(level-1)  lineNW()
     sierN(level-1) 
  end if

end procedure

procedure sierE(integer level)

  if level=1 then
     lineSE()  lineE()
     lineNE() 
  else
     sierE(level-1)  lineSE()
     sierS(level-1)  lineE()
     sierN(level-1)  lineNE()
     sierE(level-1) 
  end if

end procedure

procedure sierS(integer level)

  if level=1 then
     lineSW()  lineS()
     lineSE() 
  else
     sierS(level-1)  lineSW()
     sierW(level-1)  lineS()
     sierE(level-1)  lineSE()
     sierS(level-1) 
  end if

end procedure

procedure sierW(integer level)

  if level=1 then
     lineNW()  lineW()
     lineSW() 
  else
     sierW(level-1)  lineNW()
     sierN(level-1)  lineW()
     sierS(level-1)  lineSW()
     sierW(level-1) 
  end if

end procedure

procedure sierpinskiCurve(integer level)

  sierN(level)     lineNE()
  sierE(level)     lineSE()
  sierS(level)     lineSW()
  sierW(level)     lineNW()

end procedure

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)

   {width, height} = IupGetIntInt(canvas, "DRAWSIZE")
   cdCanvasActivate(cddbuffer)
   for level=lo to hi do
       cx = width/2
       cy = height
       h = cx/power(2,level+1)
       cdCanvasBegin(cddbuffer, CD_CLOSED_LINES)
       sierpinskiCurve(level)
       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(8,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 square 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 square curve (1..1)")
   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>sierpinskiSquareCurve(4) : turtle(_);

fcn sierpinskiSquareCurve(n){ // Lindenmayer system --> Data of As

  var [const] A="AF-F+F-AF+F+AF-F+F-A", B="";  // Production rules
  var [const] Axiom="F+AF+F+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=4 --> 3,239 characters

}

fcn turtle(curve){ // a "square" turtle, directions are +-90*

  const D=10;
  ds,dir := T( T(D,0), T(0,-D), T(-D,0), T(0,D) ), 2; // turtle offsets
  dx,dy := ds[dir];
  img,color := PPM(650,650), 0x00ff00;  // green on black
  x,y := img.w/2, 10;
  curve.replace("A","").replace("B","");  // A & B are no-op during drawing
  foreach c in (curve){
     switch(c){

case("F"){ img.line(x,y, (x+=dx),(y+=dy), color) } // draw forward case("+"){ dir=(dir+1)%4; dx,dy = ds[dir] } // turn right 90* case("-"){ dir=(dir-1)%4; dx,dy = ds[dir] } // turn left 90*

     }
  }
  img.writeJPGFile("sierpinskiSquareCurve.zkl.jpg");

}</lang>

Output:

Offsite image at Sierpinski square curve of order 4