with javascript_semantics
constant pentominoes = split("""
......I................................................................
......I.....L......N.........................................Y.........
.FF...I.....L.....NN....PP....TTT...........V.....W....X....YY.....ZZ..
FF....I.....L.....N.....PP.....T....U.U.....V....WW...XXX....Y.....Z...
.F....I.....LL....N.....P......T....UUU...VVV...WW.....X.....Y....ZZ...""",'\n')
----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----

function get_shapes()
    sequence res = {}
    for offset=0 to length(pentominoes[1]) by 6 do
        --
        -- scan left/right, and up/down, both ways, to give 8 orientations
        --      (computes the equivalent of those hard-coded tables in
        --       other examples, albeit in a slightly different order.)
        --
        sequence shapes = {}
        integer letter
        for orientation=0 to 7 do
            sequence shape = {}
            bool found = false
            integer fr, fc
            for r=1 to 5 do
                for c=1 to 5 do
                    integer rr = iff(and_bits(orientation,#01)?6-r:r),
                            cc = iff(and_bits(orientation,#02)?6-c:c)
                    if and_bits(orientation,#04) then {rr,cc} = {cc,rr} end if
                    integer ch = pentominoes[rr,offset+cc]
                    if ch!='.' then
                        if not found then
                            {found,fr,fc,letter} = {true,r,c,ch}
                        else
                            shape &= {r-fr,c-fc}
                        end if
                    end if
                end for
            end for
            if not find(shape,shapes) then
                shapes = append(shapes,shape)
            end if
        end for
        res = append(res,{letter&"",shapes})
    end for
    return res
end function

constant shapes = get_shapes(),
         nRows = 8,
         nCols = 8

sequence grid = repeat(repeat(' ',nCols),nRows),
         placed = repeat(false,length(shapes))

procedure re_place(sequence o, integer r, c, ch=' ')
    grid[r][c] = ch
    for i=1 to length(o) by 2 do
        grid[r+o[i]][c+o[i+1]] = ch
    end for
end procedure

function can_place(sequence o, integer r, c, ch)
    for i=1 to length(o) by 2 do
        integer x := c + o[i+1],
                y := r + o[i]
        if x<1 or x>nCols
        or y<1 or y>nRows
        or grid[y][x]!=' ' then
            return false
        end if
    end for
    re_place(o,r,c,ch)
    return true
end function

function solve(integer pos=0, numPlaced=0)
    if numPlaced == length(shapes) then
        return true
    end if
    integer row = floor(pos/8)+1,
            col = mod(pos,8)+1
    if grid[row][col]!=' ' then
        return solve(pos+1, numPlaced)
    end if
    for i=1 to length(shapes) do
        if not placed[i] then
            integer ch = shapes[i][1][1]
            for j=1 to length(shapes[i][2]) do
                sequence o = shapes[i][2][j]
                if can_place(o, row, col, ch) then
                    placed[i] = true
                    if solve(pos+1, numPlaced+1) then
                        return true
                    end if
                    re_place(o, row, col)
                    placed[i] = false
                end if
            end for
        end if
    end for
    return false
end function

function unsolveable()
--
-- The only unsolvable grids seen have
--  -.- or -..- or -... at edge/corner,
--   -      --      ---           -
--  or somewhere in the middle a -.-
--                                -
--
-- Simply place all shapes at all positions/orientations,
--  all the while checking for any untouchable cells.
--
    sequence griddled = deep_copy(grid)
    for r=1 to 8 do
        for c=1 to 8 do
            if grid[r][c]=' ' then
                for i=1 to length(shapes) do
                    integer ch = shapes[i][1][1]
                    for j=1 to length(shapes[i][2]) do
                        sequence o = shapes[i][2][j]
                        if can_place(o, r, c, ch) then
                            grid[r][c] = ' '
                            griddled[r][c] = '-'
                            for k=1 to length(o) by 2 do
                                grid[r+o[k]][c+o[k+1]] = ' '
                                griddled[r+o[k]][c+o[k+1]] = '-'
                            end for
                        end if
                    end for
                end for
                if griddled[r][c]!='-' then return true end if
            end if
        end for
    end for
    return false
end function

procedure add_four_randomly()
    integer count = 0
    while count<4 do
        integer r = rand(8),
                c = rand(8)
        if grid[r][c]=' ' then
            grid[r][c] = '-'
            count += 1
        end if
    end while
end procedure

procedure main()
    add_four_randomly()
    if unsolveable() then
        puts(1,"No solution\n")
    else
        if not solve() then ?9/0 end if
    end if
    puts(1,join(grid,"\n")&"\n")
end procedure
main()


'Permutations - sb
  n=4
  printem = "True"
  For i = 1 To n
    p[i] = i
  EndFor
  count = 0
  Last = "False"
  While Last = "False"
    If printem Then
      For t = 1 To n
        TextWindow.Write(p[t])
      EndFor
      TextWindow.WriteLine("")
    EndIf
    count = count + 1
    Last = "True"
    i = n - 1
    While i > 0
      If p[i] < p[i + 1] Then
        Last = "False"
        Goto exitwhile
      EndIf
      i = i - 1
    EndWhile
    exitwhile:
    j = i + 1
    k = n
    While j < k
      t = p[j]
      p[j] = p[k]
      p[k] = t
      j = j + 1
      k = k - 1
    EndWhile
    j = n
    While p[j] > p[i]
      j = j - 1
    EndWhile
    j = j + 1
    t = p[i]
    p[i] = p[j]
    p[j] = t
  EndWhile
  TextWindow.WriteLine("Number of permutations: "+count)


MODULE 	Permute;

FROM	Terminal
IMPORT	Read, Write, WriteLn;

FROM	Terminal2
IMPORT	WriteString;

CONST	MAXIDX = 6;
	MINIDX = 1;

TYPE	TInpCh = ['a'..'z'];
	TChr   = SET OF TInpCh;

VAR	n,
	nl:	INTEGER;
	ch:	CHAR;
	a:	ARRAY[MINIDX..MAXIDX] OF CHAR;
	kt:     TChr = TChr{'a'..'f'};

PROCEDURE output;
VAR	i:	INTEGER;
BEGIN
	FOR i := MINIDX TO n DO Write(a[i]) END;
	WriteString(" | ");
END output;

PROCEDURE exchange(VAR x, y : CHAR);
VAR	z:	CHAR;
BEGIN z := x; x := y; y := z
END exchange;

PROCEDURE permute(k: INTEGER);
VAR	i:	INTEGER;
BEGIN
	IF k = 1 THEN
		output;
		INC(nl);
		IF (nl MOD 8 = 1) THEN WriteLn END;
	ELSE
		permute(k-1);
		FOR i := MINIDX TO k-1 DO
			exchange(a[i], a[k]);
			permute(k-1);
			exchange(a[i], a[k]);
		END
	END
END permute;

BEGIN
	n := 0;	nl := 1; WriteString("Input {a,b,c,d,e,f} >");
	REPEAT
		Read(ch);
		IF ch IN kt THEN INC(n); a[n] := ch; Write(ch) END
	UNTIL (ch <= " ") OR (n > MAXIDX);

	WriteLn;
	IF n > 0 THEN permute(n) END;
	(*Wait*)
END Permute.


#lang racket

(require racket/hash)

(module+ main (Pentomino-tiling))

(define n-rows 8)
(define n-cols 8)
(define blank '-)

(define (build-grid)
  (for/fold ((grid (for*/hash ((r n-rows) (c n-cols)) (values (cons r c) #f)))) ((_ 4))
    (hash-set grid (cons (random n-rows) (random n-cols)) blank)))

(define (make-shapes-map)
  (hash 'F (F) 'I (I) 'L (L) 'N (N) 'P (P) 'T (T) 'U (U) 'V (V) 'W (W) 'X (X) 'Y (Y) 'Z (Z)))

(define (print-grid grid)
  (for ((r n-rows) #:when (when (positive? r) (newline)) (c n-cols))
    (write (hash-ref grid (cons r c))))
  (newline))

(define (Pentomino-tiling (grid (build-grid)))
  (define solution (solve 0 grid (make-shapes-map)))
  (if solution (print-grid solution) (displayln "no solution")))

(define (solve p grid shapes (failed-shapes (hash)))
  (define-values (r c) (quotient/remainder p n-cols))
  (cond [(not grid) #f]
        [(hash-empty? shapes) (and (hash-empty? failed-shapes) grid)]
        [(hash-ref grid (cons r c) #f) (solve (add1 p) grid shapes failed-shapes)]
        [else
         (define s (car (hash-keys shapes)))
         (define os (hash-ref shapes s))
         (define shapes-s (hash-remove shapes s))
         (define (try-place-orientation o)
           (and (for/and ((dy.dx o))
                  (let ((y (+ r (car dy.dx))) (x (+ c (cdr dy.dx))))
                    (and (>= x 0) (>= y 0) (< x n-cols) (< y n-rows) (not (hash-ref grid (cons y x))))))
                (for/fold ((grid (hash-set grid (cons r c) s))) ((dy.dx o))
                  (hash-set grid (cons (+ r (car dy.dx)) (+ c (cdr dy.dx))) s))))
         (or (for*/first
                 ((o os)
                  (solution (in-value (solve (add1 p)
                                             (try-place-orientation o)
                                             (hash-union shapes-s failed-shapes))))
                  #:when solution)
               solution)
             (solve p grid shapes-s (hash-set failed-shapes s os)))]))

(define (F) '(((1 . -1) (1 . 0) (1 . 1) (2 . 1))
              ((0 . 1) (1 . -1) (1 . 0) (2 . 0))
              ((1 . 0) (1 . 1) (1 . 2) (2 . 1))
              ((1 . 0) (1 . 1) (2 . -1) (2 . 0))
              ((1 . -2) (1 . -1) (1 . 0) (2 . -1))
              ((0 . 1) (1 . 1) (1 . 2) (2 . 1))
              ((1 . -1) (1 . 0) (1 . 1) (2 . -1))
              ((1 . -1) (1 . 0) (2 . 0) (2 . 1))))

(define (I) '(((0 . 1) (0 . 2) (0 . 3) (0 . 4))
              ((1 . 0) (2 . 0) (3 . 0) (4 . 0))))

(define (L) '(((1 . 0) (1 . 1) (1 . 2) (1 . 3))
              ((1 . 0) (2 . 0) (3 . -1) (3 . 0))
              ((0 . 1) (0 . 2) (0 . 3) (1 . 3))
              ((0 . 1) (1 . 0) (2 . 0) (3 . 0))
              ((0 . 1) (1 . 1) (2 . 1) (3 . 1))
              ((0 . 1) (0 . 2) (0 . 3) (1 . 0))
              ((1 . 0) (2 . 0) (3 . 0) (3 . 1))
              ((1 . -3) (1 . -2) (1 . -1) (1 . 0))))

(define (N) '(((0 . 1) (1 . -2) (1 . -1) (1 . 0))
              ((1 . 0) (1 . 1) (2 . 1) (3 . 1))
              ((0 . 1) (0 . 2) (1 . -1) (1 . 0))
              ((1 . 0) (2 . 0) (2 . 1) (3 . 1))
              ((0 . 1) (1 . 1) (1 . 2) (1 . 3))
              ((1 . 0) (2 . -1) (2 . 0) (3 . -1))
              ((0 . 1) (0 . 2) (1 . 2) (1 . 3))
              ((1 . -1) (1 . 0) (2 . -1) (3 . -1))))

(define (P) '(((0 . 1) (1 . 0) (1 . 1) (2 . 1))
              ((0 . 1) (0 . 2) (1 . 0) (1 . 1))
              ((1 . 0) (1 . 1) (2 . 0) (2 . 1))
              ((0 . 1) (1 . -1) (1 . 0) (1 . 1))
              ((0 . 1) (1 . 0) (1 . 1) (1 . 2))
              ((1 . -1) (1 . 0) (2 . -1) (2 . 0))
              ((0 . 1) (0 . 2) (1 . 1) (1 . 2))
              ((0 . 1) (1 . 0) (1 . 1) (2 . 0))))

(define (T) '(((0 . 1) (0 . 2) (1 . 1) (2 . 1))
              ((1 . -2) (1 . -1) (1 . 0) (2 . 0))
              ((1 . 0) (2 . -1) (2 . 0) (2 . 1))
              ((1 . 0) (1 . 1) (1 . 2) (2 . 0))))

(define (U) '(((0 . 1) (0 . 2) (1 . 0) (1 . 2))
              ((0 . 1) (1 . 1) (2 . 0) (2 . 1))
              ((0 . 2) (1 . 0) (1 . 1) (1 . 2))
              ((0 . 1) (1 . 0) (2 . 0) (2 . 1))))

(define (V) '(((1 . 0) (2 . 0) (2 . 1) (2 . 2))
              ((0 . 1) (0 . 2) (1 . 0) (2 . 0))
              ((1 . 0) (2 . -2) (2 . -1) (2 . 0))
              ((0 . 1) (0 . 2) (1 . 2) (2 . 2))))

(define (W) '(((1 . 0) (1 . 1) (2 . 1) (2 . 2))
              ((1 . -1) (1 . 0) (2 . -2) (2 . -1))
              ((0 . 1) (1 . 1) (1 . 2) (2 . 2))
              ((0 . 1) (1 . -1) (1 . 0) (2 . -1))))

(define (X) '(((1 . -1) (1 . 0) (1 . 1) (2 . 0))))

(define (Y) '(((1 . -2) (1 . -1) (1 . 0) (1 . 1))
              ((1 . -1) (1 . 0) (2 . 0) (3 . 0))
              ((0 . 1) (0 . 2) (0 . 3) (1 . 1))
              ((1 . 0) (2 . 0) (2 . 1) (3 . 0))
              ((0 . 1) (0 . 2) (0 . 3) (1 . 2))
              ((1 . 0) (1 . 1) (2 . 0) (3 . 0))
              ((1 . -1) (1 . 0) (1 . 1) (1 . 2))
              ((1 . 0) (2 . -1) (2 . 0) (3 . 0))))

(define (Z) '(((0 . 1) (1 . 0) (2 . -1) (2 . 0))
              ((1 . 0) (1 . 1) (1 . 2) (2 . 2))
              ((0 . 1) (1 . 1) (2 . 1) (2 . 2))
              ((1 . -2) (1 . -1) (1 . 0) (2 . -2))))


MODULE Permutations EXPORTS Main;

IMPORT IO, IntSeq;

CONST n = 3;

TYPE Domain = SET OF [ 1.. n ];

VAR

  chosen: IntSeq.T;
  values := Domain { };

PROCEDURE GeneratePermutations(VAR chosen: IntSeq.T; remaining: Domain) =
(*
  Recursively generates all the permutations of elements
  in the union of "chosen" and "values".
  Values in "chosen" have already been chosen;
  values in "remaining" can still be chosen.
  If "remaining" is empty, it prints the sequence and returns.
  Otherwise, it picks each element in "remaining", removes it,
  adds it to "chosen", recursively calls itself,
  then removes the last element of "chosen" and adds it back to "remaining".
*)
BEGIN
  FOR i := 1 TO n DO
    (* check if each element is in "remaining" *)
    IF i IN remaining THEN
      (* if so, remove from "remaining" and add to "chosen" *)
      remaining := remaining - Domain { i };
      chosen.addhi(i);
      IF remaining # Domain { } THEN
        (* still something to process? do it *)
        GeneratePermutations(chosen, remaining);
      ELSE
        (* otherwise, print what we've chosen *)
        FOR j := 0 TO chosen.size() - 2 DO
          IO.PutInt(chosen.get(j)); IO.Put(", ");
        END;
        IO.PutInt(chosen.gethi());
        IO.PutChar('\n');
      END;
      (* add "i" back to "remaining" and remove from "chosen" *)
      remaining := remaining + Domain { i };
      EVAL chosen.remhi();
    END;
  END;
END GeneratePermutations;

BEGIN

  (* initial setup *)
  chosen := NEW(IntSeq.T).init(n);
  FOR i := 1 TO n DO values := values + Domain { i }; END;

  GeneratePermutations(chosen, values);

END Permutations.


Module Module1

    Dim symbols As Char() = "XYPFTVNLUZWI█".ToCharArray(),
        nRows As Integer = 8, nCols As Integer = 8,
        target As Integer = 12, blank As Integer = 12,
        grid As Integer()() = New Integer(nRows - 1)() {},
        placed As Boolean() = New Boolean(target - 1) {},
        pens As List(Of List(Of Integer())), rand As Random,
        seeds As Integer() = {291, 292, 293, 295, 297, 329, 330, 332, 333, 335, 378, 586}

    Sub Main()
        Unpack(seeds) : rand = New Random() : ShuffleShapes(2)
        For r As Integer = 0 To nRows - 1
            grid(r) = Enumerable.Repeat(-1, nCols).ToArray() : Next
        For i As Integer = 0 To 3
            Dim rRow, rCol As Integer : Do : rRow = rand.Next(nRows) : rCol = rand.Next(nCols)
            Loop While grid(rRow)(rCol) = blank : grid(rRow)(rCol) = blank
        Next
        If Solve(0, 0) Then
            PrintResult()
        Else
            Console.WriteLine("no solution for this configuration:") : PrintResult()
        End If
        If System.Diagnostics.Debugger.IsAttached Then Console.ReadKey()
    End Sub

    Sub ShuffleShapes(count As Integer) ' changes order of the pieces for a more random solution
        For i As Integer = 0 To count : For j = 0 To pens.Count - 1
                Dim r As Integer : Do : r = rand.Next(pens.Count) : Loop Until r <> j
                Dim tmp As List(Of Integer()) = pens(r) : pens(r) = pens(j) : pens(j) = tmp
                Dim ch As Char = symbols(r) : symbols(r) = symbols(j) : symbols(j) = ch
            Next : Next
    End Sub

    Sub PrintResult() ' display results
        For Each r As Integer() In grid : For Each i As Integer In r
                Console.Write("{0} ", If(i < 0, ".", symbols(i)))
            Next : Console.WriteLine() : Next
    End Sub

    ' returns first found solution only
    Function Solve(ByVal pos As Integer, ByVal numPlaced As Integer) As Boolean
        If numPlaced = target Then Return True
        Dim row As Integer = pos \ nCols, col As Integer = pos Mod nCols
        If grid(row)(col) <> -1 Then Return Solve(pos + 1, numPlaced)
        For i As Integer = 0 To pens.Count - 1 : If Not placed(i) Then
                For Each orientation As Integer() In pens(i)
                    If Not TPO(orientation, row, col, i) Then Continue For
                    placed(i) = True : If Solve(pos + 1, numPlaced + 1) Then Return True
                    RmvO(orientation, row, col) : placed(i) = False
                Next : End If : Next : Return False
    End Function

    ' removes a placed orientation
    Sub RmvO(ByVal ori As Integer(), ByVal row As Integer, ByVal col As Integer)
        grid(row)(col) = -1 : For i As Integer = 0 To ori.Length - 1 Step 2
            grid(row + ori(i))(col + ori(i + 1)) = -1 : Next
    End Sub

    ' checks an orientation, if possible it is placed, else returns false
    Function TPO(ByVal ori As Integer(), ByVal row As Integer, ByVal col As Integer,
                 ByVal sIdx As Integer) As Boolean
        For i As Integer = 0 To ori.Length - 1 Step 2
            Dim x As Integer = col + ori(i + 1), y As Integer = row + ori(i)
            If x < 0 OrElse x >= nCols OrElse y < 0 OrElse y >= nRows OrElse
                grid(y)(x) <> -1 Then Return False
        Next : grid(row)(col) = sIdx
        For i As Integer = 0 To ori.Length - 1 Step 2
            grid(row + ori(i))(col + ori(i + 1)) = sIdx
        Next : Return True
    End Function

    '!' the following routines expand the seed values into the 63 orientation arrays.
    '   source code space savings comparison:
    '      around 2000 chars for the expansion code, verses about 3000 chars for the integer array defs.
    '   perhaps not worth the savings?

    Sub Unpack(sv As Integer()) ' unpacks a list of seed values into a set of 63 rotated pentominoes
        pens = New List(Of List(Of Integer())) : For Each item In sv
            Dim Gen As New List(Of Integer()), exi As List(Of Integer) = Expand(item),
                fx As Integer() = ToP(exi) : Gen.Add(fx) : For i As Integer = 1 To 7
                If i = 4 Then Mir(exi) Else Rot(exi)
                fx = ToP(exi) : If Not Gen.Exists(Function(Red) TheSame(Red, fx)) Then Gen.Add(ToP(exi))
            Next : pens.Add(Gen) : Next
    End Sub

    ' expands an integer into a set of directions
    Function Expand(i As Integer) As List(Of Integer)
        Expand = {0}.ToList() : For j As Integer = 0 To 3 : Expand.Insert(1, i And 15) : i >>= 4 : Next
    End Function

    ' converts a set of directions to an array of y, x pairs
    Function ToP(p As List(Of Integer)) As Integer()
        Dim tmp As List(Of Integer) = {0}.ToList() : For Each item As Integer In p.Skip(1)
            tmp.Add(tmp.Item(item >> 2) + {1, 8, -1, -8}(item And 3)) : Next
        tmp.Sort() : For i As Integer = tmp.Count - 1 To 0 Step -1 : tmp.Item(i) -= tmp.Item(0) : Next
        Dim res As New List(Of Integer) : For Each item In tmp.Skip(1)
            Dim adj = If((item And 7) > 4, 8, 0)
            res.Add((adj + item) \ 8) : res.Add((item And 7) - adj)
        Next : Return res.ToArray()
    End Function

    ' compares integer arrays for equivalency
    Function TheSame(a As Integer(), b As Integer()) As Boolean
        For i As Integer = 0 To a.Count - 1 : If a(i) <> b(i) Then Return False
        Next : Return True
    End Function

    Sub Rot(ByRef p As List(Of Integer)) ' rotates a set of directions by 90 degrees
        For i As Integer = 0 To p.Count - 1 : p(i) = (p(i) And -4) Or ((p(i) + 1) And 3) : Next
    End Sub

    Sub Mir(ByRef p As List(Of Integer)) ' mirrors a set of directions
        For i As Integer = 0 To p.Count - 1 : p(i) = (p(i) And -4) Or (((p(i) Xor 1) + 1) And 3) : Next
    End Sub

End Module


/* NetRexx */
options replace format comments java crossref symbols nobinary

import java.util.List
import java.util.ArrayList

-- =============================================================================
/**
 * Permutation Iterator
 *

 *

 * Algorithm by E. W. Dijkstra, "A Discipline of Programming", Prentice-Hall, 1976, p.71
 */
class RPermutationIterator implements Iterator

  -- ---------------------------------------------------------------------------
  properties indirect
    perms = List
    permOrders = int[]
    maxN
    currentN
    first = boolean

  -- ---------------------------------------------------------------------------
  properties constant
    isTrue  = boolean (1 == 1)
    isFalse = boolean (1 \= 1)

  -- ---------------------------------------------------------------------------
  method RPermutationIterator(initial = List) public
    setUp(initial)
    return

  -- ---------------------------------------------------------------------------
  method RPermutationIterator(initial = Object[]) public
    init = ArrayList(initial.length)
    loop elmt over initial
      init.add(elmt)
      end elmt
    setUp(init)
    return

  -- ---------------------------------------------------------------------------
  method RPermutationIterator(initial = Rexx[]) public
    init = ArrayList(initial.length)
    loop elmt over initial
      init.add(elmt)
      end elmt
    setUp(init)
    return

  -- ---------------------------------------------------------------------------
  method setUp(initial = List) private
    setFirst(isTrue)
    setPerms(initial)
    setPermOrders(int[getPerms().size()])
    setMaxN(getPermOrders().length)
    setCurrentN(0)
    po = getPermOrders()
    loop i_ = 0 while i_ < po.length
      po[i_] = i_
      end i_
    return

  -- ---------------------------------------------------------------------------
  method hasNext() public returns boolean
    status = isTrue
    if getCurrentN() == factorial(getMaxN()) then status = isFalse
    setCurrentN(getCurrentN() + 1)
    return status

  -- ---------------------------------------------------------------------------
  method next() public returns Object
    if isFirst() then setFirst(isFalse)
    else do
      po = getPermOrders()
      i_ = getMaxN() - 1
      loop while po[i_ - 1] >= po[i_]
        i_ = i_ - 1
        end

      j_ = getMaxN()
      loop while po[j_ - 1] <= po[i_ - 1]
        j_ = j_ - 1
        end

      swap(i_ - 1, j_ - 1)

      i_ = i_ + 1
      j_ = getMaxN()
      loop while i_ < j_
        swap(i_ - 1, j_ - 1)
        i_ = i_ + 1
        j_ = j_ - 1
        end
      end
    return reorder()

  -- ---------------------------------------------------------------------------
  method remove() public signals UnsupportedOperationException
    signal UnsupportedOperationException()

  -- ---------------------------------------------------------------------------
  method swap(i_, j_) private
    po = getPermOrders()
    save   = po[i_]
    po[i_] = po[j_]
    po[j_] = save
    return

  -- ---------------------------------------------------------------------------
  method reorder() private returns List
    result = ArrayList(getPerms().size())
    loop ix over getPermOrders()
      result.add(getPerms().get(ix))
      end ix
    return result

  -- ---------------------------------------------------------------------------
  /**
   * Calculate n factorial: {@code n! = 1 * 2 * 3 .. * n}
   * @param n
   * @return n!
   */
  method factorial(n) public static
    fact = 1
    if n > 1 then loop i = 1 while i <= n
      fact = fact * i
      end i
    return fact

  -- ---------------------------------------------------------------------------
  method main(args = String[]) public static
    thing02 = RPermutationIterator(['alpha', 'omega'])
    thing03 = RPermutationIterator([String 'one', 'two', 'three'])
    thing04 = RPermutationIterator(Arrays.asList([Integer(1), Integer(2), Integer(3), Integer(4)]))
    things = [thing02, thing03, thing04]
    loop thing over things
      N = thing.getMaxN()
      say 'Permutations:' N'! =' factorial(N)
      loop lineCount = 1 while thing.hasNext()
        prm = thing.next()
        say lineCount.right(8)':' prm.toString()
        end lineCount
      say 'Permutations:' N'! =' factorial(N)
      say
      end thing
    return


import algorithm
var v = [1, 2, 3] # List has to start sorted
echo v
while v.nextPermutation():
  echo v


(* Iterative, though loops are implemented as auxiliary recursive functions.
   Translation of Ada version. *)
let next_perm p =
	let n = Array.length p in
	let i = let rec aux i =
		if (i < 0) || (p.(i) < p.(i+1)) then i
		else aux (i - 1) in aux (n - 2) in
	let rec aux j k = if j < k then
		let t = p.(j) in
			p.(j) <- p.(k);
			p.(k) <- t;
			aux (j + 1) (k - 1)
	else () in aux (i + 1) (n - 1);
	if i < 0 then false else
		let j = let rec aux j =
			if p.(j) > p.(i) then j
			else aux (j + 1) in aux (i + 1) in
		let t = p.(i) in
			p.(i) <- p.(j);
			p.(j) <- t;
			true;;

let print_perm p =
	let n = Array.length p in
	for i = 0 to n - 2 do
		print_int p.(i);
		print_string " "
	done;
	print_int p.(n - 1);
	print_newline ();;

let print_all_perm n =
	let p = Array.init n (function i -> i + 1) in
	print_perm p;
	while next_perm p do
		print_perm p
	done;;

print_all_perm 3;;
(* 1 2 3
   1 3 2
   2 1 3
   2 3 1
   3 1 2
   3 2 1 *)


fcn printResult
   { foreach row in (grid){ row.apply(symbols.get).concat(" ").println() } }
fcn tryPlaceOrientation(o, R,C, shapeIndex){
   foreach ro,co in (o){ r,c:=R+ro, C+co;
      if(r<0 or r>=nRows or c<0 or c>=nCols or grid[r][c]!=-1) return(False);
   }
   grid[R][C]=shapeIndex; foreach ro,co in (o){ grid[R+ro][C+co]=shapeIndex }
   True
}
fcn removeOrientation(o, r,c)
  { grid[r][c]=-1; foreach ro,co in (o){ grid[r+ro][c+co]=-1 } }
fcn solve(pos,numPlaced){
   if(numPlaced==target) return(True);

   row,col:=pos.divr(nCols);
   if(grid[row][col]!=-1) return(solve(pos+1,numPlaced));

   foreach i in (shapes.len()){
      if(not placed[i]){
	 foreach orientation in (shapes[i]){
	    if(not tryPlaceOrientation(orientation, row,col, i)) continue;
	    placed[i]=True;
	    if(solve(pos+1,numPlaced+1)) return(True);
	    removeOrientation(orientation, row,col);
	    placed[i]=False;
	 }
      }
   }
   False
}


/* REXX Compute bunch permutations of things elements */
Parse Arg bunch things
If bunch='?' Then
  Call help
If bunch=='' Then bunch=3
If datatype(bunch)<>'NUM' Then Call help 'bunch ('bunch') must be numeric'
thing.=''
Select
  When things='' Then things=bunch
  When datatype(things)='NUM' Then Nop
  Otherwise Do
    data=things
    things=words(things)
    Do i=1 To things
      Parse Var data thing.i data
      End
    End
  End
If things<bunch Then Call help 'things ('things') must be >= bunch ('bunch')'

perms =0
Call time 'R'
Call permSets things, bunch
Say  perms  'Permutations'
Say time('E') 'seconds'
Exit

/*--------------------------------------------------------------------------------------*/
first_word: return word(Arg(1),1)
/*--------------------------------------------------------------------------------------*/
permSets: Procedure Expose perms thing.
  Parse Arg things,bunch
  aa.=''
  sep=''
  perm_elements='123456789ABCDEF'
  Do k=1 To things
    perm=first_word(first_word(substr(perm_elements,k,1) k))
    dd.k=perm
    End
  Call .permSet 1
  Return

.permSet: Procedure Expose dd. aa. things bunch perms thing.
  Parse Arg iteration
  If iteration>bunch  Then do
    perm= aa.1
    Do j=2 For bunch-1
      perm= perm aa.j
      End
    perms+=1
    If thing.1<>'' Then Do
      ol=''
      Do pi=1 To words(perm)
        z=word(perm,pi)
        If datatype(z)<>'NUM' Then
          z=9+pos(z,'ABCDEF')
        ol=ol thing.z
        End
      Say strip(ol)
      End
    Else
      Say perm
    End
  Else Do
    Do q=1 for things
      Do k=1 for iteration-1
        If aa.k==dd.q  Then
          iterate q
        End
      aa.iteration= dd.q
      Call .permSet iteration+1
      End
    End
  Return

help:
  Parse Arg msg
  If msg<>'' Then Do
    Say 'ERROR:' msg
    Say ''
    End
  Say 'rexx perm            -> Permutations of 1 2 3                 '
  Say 'rexx perm 2          -> Permutations of 1 2                   '
  Say 'rexx perm 2 4        -> Permutations of 1 2 3 4 in 2 positions'
  Say 'rexx perm 2 a b c d  -> Permutations of a b c d in 2 positions'
  Exit


DEFINE VARIABLE charArray AS CHARACTER EXTENT 3 INITIAL ["A","B","C"].
DEFINE VARIABLE sizeofArray AS INTEGER.

sizeOfArray = EXTENT(charArray).

RUN GetPermutations(1).

PROCEDURE GetPermutations:
    DEFINE INPUT PARAMETER n AS INTEGER.

    DEFINE VARIABLE i AS INTEGER.
    DEFINE VARIABLE j AS INTEGER.
    DEFINE VARIABLE currentPermutation AS CHARACTER.

    REPEAT i = n TO sizeOfArray:
        RUN swapValues(i,n).
        RUN GetPermutations(n + 1).
        RUN swapValues(i,n).
    END.
    IF n = sizeOfArray THEN DO:
        DO j = 1 TO EXTENT(charArray):
            currentPermutation = currentPermutation + charArray[j].
        END.
        DISPLAY currentPermutation WITH FRAME A DOWN.
    END.
END PROCEDURE.

PROCEDURE swapValues:
    DEFINE INPUT PARAMETER a AS INTEGER.
    DEFINE INPUT PARAMETER b AS INTEGER.
    DEFINE VARIABLE temp AS CHARACTER.
    temp = charArray[a].
    charArray[a] = charArray[b].
    charArray[b] = temp.
END PROCEDURE.


program perm;

var
	p: array[1 .. 12] of integer;
	is_last: boolean;
	n: integer;

procedure next;
var i, j, k, t: integer;
begin
is_last := true;
i := n - 1;
while i > 0 do
	begin
	if p[i] < p[i + 1] then
		begin
		is_last := false;
		break;
		end;
	i := i - 1;
	end;

if not is_last then
	begin
	j := i + 1;
	k := n;
	while j < k do
		begin
		t := p[j];
		p[j] := p[k];
		p[k] := t;
		j := j + 1;
		k := k - 1;
		end;

	j := n;
	while p[j] > p[i] do j := j - 1;
	j := j + 1;

	t := p[i];
	p[i] := p[j];
	p[j] := t;
	end;
end;

procedure print;
var i: integer;
begin
for i := 1 to n do write(p[i], ' ');
writeln;
end;

procedure init;
var i: integer;
begin
n := 0;
while (n < 1) or (n > 10) do
	begin
	write('Enter n (1 <= n <= 10): ');
	readln(n);
	end;
for i := 1 to n do p[i] := i;
end;

begin
init;
repeat
	print;
	next;
until is_last;
end.


sub permutation {
	my ($perm,@set) = @_;
	print "$perm\n" || return unless (@set);
	permutation($perm.$set[$_],@set[0..$_-1],@set[$_+1..$#set]) foreach (0..$#set);
}
my @input = (qw/a b c d/);
permutation('',@input);


with javascript_semantics
requires("1.0.2")
?shorten(permutes("abcd"),"elements",5)


include ..\Utilitys.pmt

def save
    over over chain ps> swap 0 put >ps
enddef

def permute /# l l -- #/
    len 2 > if
        len for drop
            pop swap rot swap 1 put swap permute
        endfor
    else
        save rotate save rotate
    endif
    swap len if
        pop rot rot 0 put
    else
        drop drop
    endif
enddef

( ) >ps
( ) ( 1 2 3 4 ) permute
ps> sort print


permutation_rec1([X|Y],Z) :-
  permutation_rec1(Y,W),
  select(X,Z,W).
permutation_rec1([],[]).

permutation_rec2([], []).
permutation_rec2([X], [X]) :-!.
permutation_rec2([T|H], X) :-
  permutation_rec2(H, H1),
  append(L1, L2, H1),
  append(L1, [T], X1),
  append(X1, L2, X).


(load "@lib/simul.l")

(permute (1 2 3))


  #COMPILE EXE
  #DIM ALL
  GLOBAL a, i, j, k, n  AS INTEGER
  GLOBAL d, ns, s AS STRING 'dynamic string
  FUNCTION PBMAIN () AS LONG
  ns = INPUTBOX$("   n =",, "3") 'input n
  n = VAL(ns)
  DIM a(1 TO n) AS INTEGER
  FOR i = 1 TO n: a(i)= i: NEXT
  DO
    s = " "
    FOR i = 1 TO n
      d = STR$(a(i))
      s = BUILD$(s, d) '  s & d concatenate
    NEXT
    ? s  'print and pause
    i = n
    DO
     DECR i
    LOOP UNTIL i = 0 OR a(i) < a(i+1)
    j = i+1
    k = n
    DO WHILE j < k
      SWAP a(j), a(k)
      INCR j
      DECR k
    LOOP
    IF i > 0 THEN
      j = i+1
      DO WHILE a(j) < a(i)
        INCR j
      LOOP
      SWAP a(i), a(j)
    END IF
  LOOP UNTIL i = 0
  END FUNCTION


function permutation ($array) {
    function generate($n, $array, $A) {
        if($n -eq 1) {
            $array[$A] -join ' '
        }
        else{
            for( $i = 0; $i -lt ($n - 1); $i += 1) {
                generate ($n - 1) $array $A
                if($n % 2 -eq 0){
                    $i1, $i2 = $i, ($n-1)
                    $A[$i1], $A[$i2] = $A[$i2], $A[$i1]
                }
                else{
                    $i1, $i2 = 0, ($n-1)
                    $A[$i1], $A[$i2] = $A[$i2], $A[$i1]
                }
            }
            generate ($n - 1) $array $A
        }
    }
    $n = $array.Count
    if($n -gt 0) {
        (generate $n $array (0..($n-1)))
    } else {$array}
}
permutation @('A','B','C')


:- use_module(library(clpfd)).

permut_clpfd(L, N) :-
    length(L, N),
    L ins 1..N,
    all_different(L),
    label(L).


Macro reverse(firstIndex, lastIndex)
  first = firstIndex
  last = lastIndex
  While first < last
    Swap cur(first), cur(last)
    first + 1
    last - 1
  Wend
EndMacro

Procedure nextPermutation(Array cur(1))
  Protected first, last, elementCount = ArraySize(cur())
  If elementCount < 1
    ProcedureReturn #False ;nothing to permute
  EndIf

  ;Find the lowest position pos such that [pos] < [pos+1]
  Protected pos = elementCount - 1
  While cur(pos) >= cur(pos + 1)
    pos - 1
    If pos < 0
      reverse(0, elementCount)
      ProcedureReturn #False ;no higher lexicographic permutations left, return lowest one instead
    EndIf
  Wend

  ;Swap [pos] with the highest positional value that is larger than [pos]
  last = elementCount
  While cur(last) <= cur(pos)
    last - 1
  Wend
  Swap cur(pos), cur(last)

  ;Reverse the order of the elements in the higher positions
  reverse(pos + 1, elementCount)
  ProcedureReturn #True ;next lexicographic permutation found
EndProcedure

Procedure display(Array a(1))
  Protected i, fin = ArraySize(a())
  For i = 0 To fin
    Print(Str(a(i)))
    If i = fin: Continue: EndIf
    Print(", ")
  Next
  PrintN("")
EndProcedure

If OpenConsole()
  Dim a(2)
  a(0) = 1: a(1) = 2: a(2) =  3
  display(a())
  While nextPermutation(a()): display(a()): Wend

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


import itertools
for values in itertools.permutations([1,2,3]):
    print (values)


SUB perms (n)
    DIM a(0 TO n - 1), c(0 TO n - 1)

    FOR j = 0 TO n - 1
        a(j) = j + 1
        PRINT a(j);
    NEXT j
    PRINT

    i = 0
    WHILE i < n
        IF c(i) < i THEN
            IF (i AND 1) = 0 THEN
                SWAP a(0), a(i)
            ELSE
                SWAP a(c(i)), a(i)
            END IF
            FOR j = 0 TO n - 1
                PRINT a(j);
            NEXT j
            PRINT
            c(i) = c(i) + 1
            i = 0
        ELSE
            c(i) = 0
            i = i + 1
        END IF
    WEND
END SUB

perms(4)


(define insert
  L      0 E -> [E|L]
  [L|Ls] N E -> [L|(insert Ls (- N 1) E)])

(define seq
  Start Start -> [Start]
  Start End   -> [Start|(seq (+ Start 1) End)])

(define append-lists
  []    -> []
  [A|B] -> (append A (append-lists B)))

(define permutate
  []    -> [[]]
  [H|T] -> (append-lists (map (/. P
                                  (map (/. N
                                           (insert P N H))
                                       (seq 0 (length P))))
                              (permute T))))


  [ stack ]                     is perms.min    (       --> [ )

  [ stack ]                     is perms.max    (       --> [ )

                        forward is (perms)

  [ over size
    perms.min share > if
      [ over temp take
        swap nested join
        temp put ]
    over size
    perms.max share < if
      [ dup size times
         [ 2dup i^ pluck
           rot swap nested join
           swap (perms) ] ]
    2drop ]               resolves (perms)      (   [ [ -->    )

  [ perms.max put
    1 - perms.min put
    [] temp put
    [] swap (perms)
    temp take
    perms.min release
    perms.max release ]         is perms        ( [ a b --> [ )

  [ dup size dup perms ]        is permutations (     [ --> [ )

  ' [ 1 2 3 ] permutations echo cr
  $ "quack" permutations 60 wrap$
  $ "quack" 3 4 perms 46 wrap$


next.perm <- function(a) {
  n <- length(a)
  i <- n
  while (i > 1 && a[i - 1] >= a[i]) i <- i - 1
  if (i == 1) {
    NULL
  } else {
    j <- i
    k <- n
    while (j < k) {
      s <- a[j]
      a[j] <- a[k]
      a[k] <- s
      j <- j + 1
      k <- k - 1
    }
    s <- a[i - 1]
    j <- i
    while (a[j] <= s) j <- j + 1
    a[i - 1] <- a[j]
    a[j] <- s
    a
  }
}

perm <- function(n) {
  e <- NULL
  a <- 1:n
  repeat {
    e <- cbind(e, a)
    a <- next.perm(a)
    if (is.null(a)) break
  }
  unname(e)
}


#lang racket

;; using a builtin
(permutations '(A B C))
;; -> '((A B C) (B A C) (A C B) (C A B) (B C A) (C B A))

;; a random simple version (which is actually pretty good for a simple version)
(define (perms l)
  (let loop ([l l] [tail '()])
    (if (null? l) (list tail)
        (append-map (λ(x) (loop (remq x l) (cons x tail))) l))))
(perms '(A B C))
;; -> '((C B A) (B C A) (C A B) (A C B) (B A C) (A B C))

;; permutations in lexicographic order
(define (lperms s)
  (cond [(empty? s) '()]
        [(empty? (cdr s)) (list s)]
        [else
         (let splice ([l '()][m (car s)][r (cdr s)])
           (append
            (map (lambda (x) (cons m x)) (lperms (append l r)))
            (if (empty? r) '()
                (splice (append l (list m)) (car r) (cdr r)))))]))
(display (lperms '(A B C)))
;; -> ((A B C) (A C B) (B A C) (B C A) (C A B) (C B A))

;; permutations in lexicographical order using generators
(require racket/generator)
(define (splice s)
  (generator ()
             (let outer-loop ([l '()][m (car s)][r (cdr s)])
               (let ([permuter (lperm (append l r))])
                 (let inner-loop ([p (permuter)])
                   (when (not (void? p))
                     (let ([q (cons m p)])
                       (yield q)
                       (inner-loop (permuter))))))
               (if (not (empty? r))
                   (outer-loop (append l (list m)) (car r) (cdr r))
                   (void)))))
(define (lperm s)
  (generator ()
             (cond [(empty? s) (yield '())]
                   [(empty? (cdr s)) (yield s)]
                   [else
                    (let ([splicer (splice s)])
                      (let loop ([q (splicer)])
                        (when (not (void? q))
                          (begin
                            (yield q)
                            (loop (splicer))))))])
             (void)))
(let ([permuter (lperm '(A B C))])
  (let next-perm ([p (permuter)])
    (when (not (void? p))
      (begin
        (display p)
        (next-perm (permuter))))))
;; -> (A B C)(A C B)(B A C)(B C A)(C A B)(C B A)


# Heap’s algorithm for generating permutations. Algorithm 2 in
# Robert Sedgewick, 1977. Permutation generation methods. ACM
# Comput. Surv. 9, 2 (June 1977), 137-164.

define(n, 3)
define(n_minus_1, 2)

implicit none

integer a(1:n)

integer c(1:n)
integer i, k
integer tmp

10000 format ('(', I1, n_minus_1(' ', I1), ')')

# Initialize the data to be permuted.
do i = 1, n {
   a(i) = i
}

# What follows is a non-recursive Heap’s algorithm as presented by
# Sedgewick. Sedgewick neglects to fully initialize c, so I have
# corrected for that. Also I compute k without branching, by instead
# doing a little arithmetic.
do i = 1, n {
   c(i) = 1
}
i = 2
write (*, 10000) a
while (i <= n) {
   if (c(i) < i) {
      k = mod (i, 2) + ((1 - mod (i, 2)) * c(i))
      tmp = a(i)
      a(i) = a(k)
      a(k) = tmp
      c(i) = c(i) + 1
      i = 2
      write (*, 10000) a
   } else {
      c(i) = 1
      i = i + 1
   }
}

end


/*REXX pgm generates/displays all permutations of N different objects taken M at a time.*/
parse arg things bunch inbetweenChars names      /*obtain optional arguments from the CL*/
if things=='' | things==","  then things= 3      /*Not specified?  Then use the default.*/
if  bunch=='' |  bunch==","  then  bunch= things /* "      "         "   "   "     "    */
                  /* ╔════════════════════════════════════════════════════════════════╗ */
                  /* ║  inBetweenChars  (optional)   defaults to a  [null].           ║ */
                  /* ║           names  (optional)   defaults to digits (and letters).║ */
                  /* ╚════════════════════════════════════════════════════════════════╝ */
call permSets things, bunch, inBetweenChars, names
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
p:        return word( arg(1), 1)                /*P  function (Pick first arg of many).*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
permSets: procedure; parse arg x,y,between,uSyms /*X    things taken    Y    at a time. */
          @.=;       sep=                        /*X  can't be  >  length(@0abcs).      */
          @abc  = 'abcdefghijklmnopqrstuvwxyz';     @abcU=  @abc;          upper @abcU
          @abcS = @abcU || @abc;                    @0abcS= 123456789  ||  @abcS

            do k=1  for x                        /*build a list of permutation symbols. */
            _= p(word(uSyms, k)  p(substr(@0abcS, k, 1) k) )    /*get/generate a symbol.*/
            if length(_)\==1  then sep= '_'      /*if not 1st character,  then use sep. */
            $.k= _                               /*append the character to symbol list. */
            end   /*k*/

          if between==''  then between= sep      /*use the appropriate separator chars. */
          call .permSet 1                        /*start with the  first  permutation.  */
          return                                 /* [↓]  this is a recursive subroutine.*/
.permSet: procedure expose $. @. between x y;       parse arg ?
          if ?>y  then do;  _= @.1;      do j=2  for y-1
                                         _= _  ||  between  ||  @.j
                                         end   /*j*/
                            say _
                       end
                  else do q=1  for x             /*build the  permutation  recursively. */
                         do k=1 for ?-1;  if @.k==$.q  then iterate q
                         end   /*k*/
                       @.?= $.q;         call .permSet ?+1
                       end     /*q*/
          return


load "stdlib.ring"

list = 1:4
lenList = len(list)
permut = []
for perm = 1 to factorial(len(list))
    for i = 1 to len(list)
        add(permut,list[i])
    next
    perm(list)
next
for n = 1 to len(permut)/lenList
    for m = (n-1)*lenList+1 to n*lenList
        see "" + permut[m]
        if m < n*lenList
           see ","
        ok
    next
    see nl
next

func perm a
     elementcount = len(a)
     if elementcount < 1 then return ok
     pos = elementcount-1
     while a[pos] >= a[pos+1]
           pos -= 1
           if pos <= 0 permutationReverse(a, 1, elementcount)
              return ok
     end
     last = elementcount
     while a[last] <= a[pos]
           last -= 1
     end
     temp = a[pos]
     a[pos] = a[last]
     a[last] = temp
     permReverse(a, pos+1, elementcount)

 func permReverse a, first, last
      while first < last
            temp = a[first]
            a[first] = a[last]
            a[last] = temp
            first += 1
            last -= 1
      end


Another Solution

// Permutations -- Bert Mariani  2020-07-12
// Ask User for number of digits to permutate

   ? "Enter permutations number : "  Give n
   n = number(n)
   x = 1:n                            // array

    ? "Permutations are : "
   count = 0

    nPermutation(1,n)                  //===>>>  START

    ? " "                              // ? = print
    ? "Exiting of the program... "
    ? "Enter to Exit : "  Give m       // To Exit CMD window

//======================
// Returns true only if uniq number on row

Func Place(k,i)

     for j=1 to k-1
          if x[j] = i                  // Two numbers in same row
             return 0
          ok
     next

return 1

//======================
Func nPermutation(k, n)

     for i = 1 to n
          if( Place(k,i))              //===>>> Call
               x[k] = i
               if(k=n)
                  See nl
                     for i= 1 to n
                  See " "+ x[i]
                     next
                  See "    "+ (count++)
               else
                    nPermutation(k+1,n)   //===>>>  Call RECURSION
               ok
          ok
     next
return


list$ = "h,e,l,l,o"		' supply list seperated with comma's

while word$(list$,d+1,",") <> ""  'Count how many in the list
d = d + 1
wend

dim theList$(d)			' place list in array
for i = 1 to d
  theList$(i) = word$(list$,i,",")
next i

for i = 1 to d			' print the Permutations
 for j = 2 to d
   perm$ = ""
   for k = 1 to d
    perm$ = perm$ + theList$(k)
   next k
   if instr(perm2$,perm$+",") = 0 then print perm$ ' only list 1 time
   perm2$ 	 = perm2$ + perm$ + ","
   h$		 = theList$(j)
   theList$(j)	 = theList$(j - 1)
   theList$(j - 1) = h$
  next j
next i
end


pub fn permutations(size: usize) -> Permutations {
    Permutations { idxs: (0..size).collect(), swaps: vec![0; size], i: 0 }
}

pub struct Permutations {
    idxs: Vec<usize>,
    swaps: Vec<usize>,
    i: usize,
}

impl Iterator for Permutations {
    type Item = Vec<usize>;

    fn next(&mut self) -> Option<Self::Item> {
        if self.i > 0 {
            loop {
                if self.i >= self.swaps.len() { return None; }
                if self.swaps[self.i] < self.i { break; }
                self.swaps[self.i] = 0;
                self.i += 1;
            }
            self.idxs.swap(self.i, (self.i & 1) * self.swaps[self.i]);
            self.swaps[self.i] += 1;
        }
        self.i = 1;
        Some(self.idxs.clone())
    }
}

fn main() {
    let perms = permutations(3).collect::<Vec<_>>();
    assert_eq!(perms, vec![
        vec![0, 1, 2],
        vec![1, 0, 2],
        vec![2, 0, 1],
        vec![0, 2, 1],
        vec![1, 2, 0],
        vec![2, 1, 0],
    ]);
}


/* Store permutations in a SAS dataset. Translation of Fortran 77 */
data perm;
  n=6;
  array a{6} p1-p6;
  do i=1 to n;
    a(i)=i;
  end;
L1:
  output;
  link L2;
  if next then goto L1;
  stop;
L2:
  next=0;
  i=n-1;
L10:
  if a(i)<a(i+1) then goto L20;
  i=i-1;
  if i=0 then goto L20;
  goto L10;
  L20:
  j=i+1;
  k=n;
L30:
  t=a(j);
  a(j)=a(k);
  a(k)=t;
  j=j+1;
  k=k-1;
  if j<k then goto L30;
  j=i;
  if j=0 then return;
L40:
  j=j+1;
  if a(j)<a(i) then goto L40;
  t=a(i);
  a(i)=a(j);
  a(j)=t;
  next=1;
  return;
  keep p1-p6;
run;


(define (insert l n e)
  (if (= 0 n)
      (cons e l)
      (cons (car l)
            (insert (cdr l) (- n 1) e))))

(define (seq start end)
  (if (= start end)
      (list end)
      (cons start (seq (+ start 1) end))))

(define (permute l)
  (if (null? l)
      '(())
      (apply append (map (lambda (p)
                           (map (lambda (n)
                                  (insert p n (car l)))
                                (seq 0 (length p))))
                         (permute (cdr l))))))


$ include "seed7_05.s7i";

const type: permutations is array array integer;

const func permutations: permutations (in array integer: items) is func
  result
    var permutations: permsList is 0 times 0 times 0;
  local
    const proc: perms (in array integer: sequence, in array integer: prefix) is func
      local
        var integer: element is 0;
        var integer: index is 0;
      begin
        if length(sequence) <> 0 then
          for element key index range sequence do
            perms(sequence[.. pred(index)] & sequence[succ(index) ..], prefix & [] (element));
          end for;
        else
          permsList &:= prefix;
        end if;
      end func;
  begin
    perms(items, 0 times 0);
  end func;

const proc: main is func
  local
    var array integer: perm is 0 times 0;
    var integer: element is 0;
  begin
    for perm range permutations([] (1, 2, 3)) do
      for element range perm do
        write(element <& " ");
      end for;
      writeln;
    end for;
  end func;


DEFINE MAXSIZE="12"

INT ARRAY
  angleStack(MAXSIZE)
BYTE ARRAY
  depthStack(MAXSIZE),stageStack(MAXSIZE)
BYTE stacksize=[0]

BYTE FUNC IsEmpty()
  IF stacksize=0 THEN RETURN (1) FI
RETURN (0)

BYTE FUNC IsFull()
  IF stacksize=MAXSIZE THEN RETURN (1) FI
RETURN (0)

PROC Push(INT angle BYTE depth,stage)
  IF IsFull() THEN Break() FI
  angleStack(stacksize)=angle
  depthStack(stacksize)=depth
  stageStack(stackSize)=stage
  stacksize==+1
RETURN

PROC Pop(INT POINTER angle BYTE POINTER depth,stage)
  IF IsEmpty() THEN Break() FI
  stacksize==-1
  angle^=angleStack(stacksize)
  depth^=depthStack(stacksize)
  stage^=stageStack(stacksize)
RETURN

INT FUNC Sin(INT a)
  WHILE a<0 DO a==+360 OD
  WHILE a>360 DO a==-360 OD
  IF a=90 THEN
    RETURN (1)
  ELSEIF a=270 THEN
    RETURN (-1)
  FI
RETURN (0)

INT FUNC Cos(INT a)
RETURN (Sin(a-90))

PROC DrawPeano(INT x BYTE y,len BYTE depth)
  BYTE stage
  INT angle=[90],a

  Plot(x,y)
  Push(90,depth,0)

  WHILE IsEmpty()=0
  DO
    Pop(@a,@depth,@stage)
    IF stage<3 THEN
      Push(a,depth,stage+1)
    FI
    IF stage=0 THEN
      angle==+a
      IF depth>1 THEN
        Push(-a,depth-1,0)
      FI
    ELSEIF stage=1 THEN
      x==+len*Cos(angle)
      y==-len*Sin(angle)
      DrawTo(x,y)
      IF depth>1 THEN
        Push(a,depth-1,0)
      FI
    ELSEIF stage=2 THEN
      x==+len*Cos(angle)
      y==-len*Sin(angle)
      DrawTo(x,y)
      IF depth>1 THEN
        Push(-a,depth-1,0)
      FI
    ELSEIF stage=3 THEN
      angle==-a
    FI
  OD
RETURN

PROC Main()
  BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6

  Graphics(8+16)
  Color=1
  COLOR1=$0C
  COLOR2=$02

  DrawPeano(69,186,7,6)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


(define permute
[] -> []
[X] -> [[X]]
X -> (permute-helper [] X))

(define permute-helper
_ [] -> []
Done [X|Rest] -> (append (prepend-all X (permute (append Done Rest))) (permute-helper [X|Done] Rest))
)

(define prepend-all
_ [] -> []
X [Next|Rest] -> [[X|Next]|(prepend-all X Rest)]
)

(set *maximum-print-sequence-size* 50)

(permute [a b c d])


gdip1()
PeanoX := A_ScreenWidth/2 - 100, PeanoY := A_ScreenHeight/2 - 100
Peano(PeanoX, PeanoY, 3**3, 5, 5, Arr:=[])
xmin := xmax := ymin := ymax := 0
for i, point in Arr
{
	xmin := A_Index = 1 ? point.x : xmin < point.x ? xmin : point.x
	xmax := point.x > xmax ? point.x : xmax
	ymin := A_Index = 1 ? point.y : ymin < point.y ? ymin : point.y
	ymax := point.y > ymax ? point.y : ymax
}
for i, point in Arr
	points .= point.x - xmin + PeanoX "," point.y - ymin + PeanoY "|"
points := Trim(points, "|")
Gdip_DrawLines(G, pPen, Points)
UpdateLayeredWindow(hwnd1, hdc, 0, 0, Width, Height)
return
; ---------------------------------------------------------------
Peano(x, y, lg, i1, i2, Arr) {
	if (lg =1 )
	{
		Arr[Arr.count()+1, "x"] := x
		Arr[Arr.count(), "y"] := y
		return
	}
	lg := lg/3
	Peano(x+(2*i1*lg)	, y+(2*i1*lg)		, lg	, i1	, i2	, Arr)
	Peano(x+((i1-i2+1)*lg)	, y+((i1+i2)*lg)	, lg	, i1	, 1-i2	, Arr)
	Peano(x+lg		, y+lg			, lg	, i1	, 1-i2	, Arr)
	Peano(x+((i1+i2)*lg)	, y+((i1-i2+1)*lg)	, lg	, 1-i1	, 1-i2	, Arr)
	Peano(x+(2*i2*lg)	, y+(2*(1-i2)*lg)	, lg	, i1	, i2	, Arr)
	Peano(x+((1+i2-i1)*lg)	, y+((2-i1-i2)*lg)	, lg	, i1	, i2	, Arr)
	Peano(x+(2*(1-i1)*lg)	, y+(2*(1-i1)*lg)	, lg	, i1	, i2	, Arr)
	Peano(x+((2-i1-i2)*lg)	, y+((1+i2-i1)*lg)	, lg	, 1-i1	, i2	, Arr)
	Peano(x+(2*(1-i2)*lg)	, y+(2*i2*lg)		, lg	, 1-i1	, i2	, Arr)
}
; ---------------------------------------------------------------
gdip1(){
	global
	If !pToken := Gdip_Startup()
	{
		MsgBox, 48, gdiplus error!, Gdiplus failed to start. Please ensure you have gdiplus on your system
		ExitApp
	}
	OnExit, Exit
	Width := A_ScreenWidth, Height := A_ScreenHeight
	Gui, 1: -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop
	Gui, 1: Show, NA
	hwnd1 := WinExist()
	hbm := CreateDIBSection(Width, Height)
	hdc := CreateCompatibleDC()
	obm := SelectObject(hdc, hbm)
	G := Gdip_GraphicsFromHDC(hdc)
	Gdip_SetSmoothingMode(G, 4)
	pPen := Gdip_CreatePen(0xFFFF0000, 2)
}
; ---------------------------------------------------------------
gdip2(){
	global
	Gdip_DeleteBrush(pBrush)
	Gdip_DeletePen(pPen)
	SelectObject(hdc, obm)
	DeleteObject(hbm)
	DeleteDC(hdc)
	Gdip_DeleteGraphics(G)
}
; ---------------------------------------------------------------
Exit:
gdip2()
Gdip_Shutdown(pToken)
ExitApp
Return


(1 to: 4) permutationsDo: [ :x |
	Transcript show: x printString; cr ].


func perms<T>(var ar: [T]) -> [[T]] {
  return heaps(&ar, ar.count)
}

func heaps<T>(inout ar: [T], n: Int) -> [[T]] {
  return n == 1 ? [ar] :
    Swift.reduce(0..<n, [[T]]()) {
      (var shuffles, i) in
      shuffles.extend(heaps(&ar, n - 1))
      swap(&ar[n % 2 == 0 ? i : 0], &ar[n - 1])
      return shuffles
  }
}

perms([1, 2, 3]) // [[1, 2, 3], [2, 1, 3], [3, 1, 2], [1, 3, 2], [2, 3, 1], [3, 2, 1]]


templates permutations
  when <=1> do [1] !
  otherwise
    def n: $;
    templates expand
      def p: $;
      1..$n -> \(def k: $;
        [$p(1..$k-1)..., $n, $p($k..last)...] !\) !
    end expand
    $n - 1 -> permutations -> expand !
end permutations

def alpha: ['ABCD'...];
[ $alpha::length -> permutations -> '$alpha($)...;' ] -> !OUT::write


#include <cmath>
#include <fstream>
#include <iostream>
#include <string>

class peano_curve {
public:
    void write(std::ostream& out, int size, int length, int order);
private:
    static std::string rewrite(const std::string& s);
    void line(std::ostream& out);
    void execute(std::ostream& out, const std::string& s);
    double x_;
    double y_;
    int angle_;
    int length_;
};

void peano_curve::write(std::ostream& out, int size, int length, int order) {
    length_ = length;
    x_ = length;
    y_ = length;
    angle_ = 90;
    out << "<svg xmlns='http://www.w3.org/2000/svg' width='"
        << size << "' height='" << size << "'>\n";
    out << "<rect width='100%' height='100%' fill='white'/>\n";
    out << "<path stroke-width='1' stroke='black' fill='none' d='";
    std::string s = "L";
    for (int i = 0; i < order; ++i)
        s = rewrite(s);
    execute(out, s);
    out << "'/>\n</svg>\n";
}

std::string peano_curve::rewrite(const std::string& s) {
    std::string t;
    for (char c : s) {
        switch (c) {
        case 'L':
            t += "LFRFL-F-RFLFR+F+LFRFL";
            break;
        case 'R':
            t += "RFLFR+F+LFRFL-F-RFLFR";
            break;
        default:
            t += c;
            break;
        }
    }
    return t;
}

void peano_curve::line(std::ostream& out) {
    double theta = (3.14159265359 * angle_)/180.0;
    x_ += length_ * std::cos(theta);
    y_ += length_ * std::sin(theta);
    out << " L" << x_ << ',' << y_;
}

void peano_curve::execute(std::ostream& out, const std::string& s) {
    out << 'M' << x_ << ',' << y_;
    for (char c : s) {
        switch (c) {
        case 'F':
            line(out);
            break;
        case '+':
            angle_ = (angle_ + 90) % 360;
            break;
        case '-':
            angle_ = (angle_ - 90) % 360;
            break;
        }
    }
}

int main() {
    std::ofstream out("peano_curve.svg");
    if (!out) {
        std::cerr << "Cannot open output file\n";
        return 1;
    }
    peano_curve pc;
    pc.write(out, 656, 8, 4);
    return 0;
}


package require struct::list

# Make the sequence of digits to be permuted
set n [lindex $argv 0]
for {set i 1} {$i <= $n} {incr i} {lappend sequence $i}

# Iterate over the permutations, printing as we go
struct::list foreachperm p $sequence {
    puts $p
}


SUB SWAP(vb1, vb2)
    LET temp = vb1
    LET vb1 = vb2
    LET vb2 = temp
END SUB

LET n = 4
DIM a(4)
DIM c(4)

FOR i = 1 TO n
    LET a(i) = i
NEXT i
PRINT

DO
   FOR i = 1 TO n
       PRINT a(i);
   NEXT i
   PRINT
   LET i = n
   DO
      LET i = i - 1
   LOOP UNTIL (i = 0) OR (a(i) < a(i + 1))
   LET j = i + 1
   LET k = n
   DO WHILE j < k
      CALL SWAP (a(j), a(k))
      LET j = j + 1
      LET k = k - 1
   LOOP
   IF i > 0 THEN
      LET j = i + 1
      DO WHILE a(j) < a(i)
         LET j = j + 1
      LOOP
      CALL SWAP (a(i), a(j))
   END IF
LOOP UNTIL i = 0
END


USING: accessors L-system ui ;

: peano ( L-system -- L-system )
    L-parser-dialect >>commands
    [ 90 >>angle ] >>turtle-values
    "L" >>axiom
    {
        { "L" "LFRFL-F-RFLFR+F+LFRFL" }
        { "R" "RFLFR+F+LFRFL-F-RFLFR" }
    } >>rules ;

[ <L-system> peano "Peano curve" open-window ] with-ui


Const anchura = 243 'una potencia de 3 para una curva uniformemente espaciada

Screenres 700,700

Sub Peano(x As Integer, y As Integer, lg As Integer, i1 As Integer, i2 As Integer)
    If lg = 1 Then
        Line - (x * 3, y * 3)
        Return
    End If
    lg /= 3
    Peano(x + (2 * i1 * lg), y + (2 * i1 * lg), lg, i1, i2)
    Peano(x + ((i1 - i2 + 1) * lg), y + ((i1 + i2) * lg), lg, i1, 1 - i2)
    Peano(x + lg, y + lg, lg, i1, 1 - i2)
    Peano(x + ((i1 + i2) * lg), y + ((i1 - i2 + 1) * lg), lg, 1 - i1, 1 - i2)
    Peano(x + (2 * i2 * lg), y + (2 * (1 - i2) * lg), lg, i1, i2)
    Peano(x + ((1 + i2 - i1) * lg), y + ((2 - i1 - i2) * lg), lg, i1, i2)
    Peano(x + (2 * (1 - i1) * lg), y + (2 * (1 - i1) * lg), lg, i1, i2)
    Peano(x + ((2 - i1 - i2) * lg), y + ((1 + i2 - i1) * lg), lg, 1 - i1, i2)
    Peano(x + (2 * (1 - i2) * lg), y + (2 * i2 * lg), lg, 1 - i1, i2)
End Sub

Peano(0, 0, anchura, 0, 0)

Sleep


#import std

permutations =

~&itB^?a(                     # are both the input argument list and its tail non-empty?
   @ahPfatPRD *= refer ^C(      # yes, recursively generate all permutations of the tail, and for each one
      ~&a,                        # insert the head at the first position
      ~&ar&& ~&arh2falrtPXPRD),   # if the rest is non-empty, recursively insert at all subsequent positions
   ~&aNC)                       # no, return the singleton list of the argument


Public Sub Permute(n As Integer, Optional printem As Boolean = True)
'Generate, count and print (if printem is not false) all permutations of first n integers

Dim P() As Integer
Dim t As Integer, i As Integer, j As Integer, k As Integer
Dim count As Long
Dim Last As Boolean

If n <= 1 Then

  Debug.Print "Please give a number greater than 1"
  Exit Sub

End If

'Initialize
ReDim P(n)

For i = 1 To n
  P(i) = i
Next

count = 0
Last = False

Do While Not Last
   'print?
   If printem Then

      For t = 1 To n
        Debug.Print P(t);
      Next

      Debug.Print

   End If

count = count + 1

Last = True
i = n - 1

   Do While i > 0

     If P(i) < P(i + 1) Then

       Last = False
       Exit Do

     End If

     i = i - 1
   Loop

  j = i + 1
  k = n

  While j < k
    ' Swap p(j) and p(k)
    t = P(j)
    P(j) = P(k)
    P(k) = t
    j = j + 1
    k = k - 1
  Wend

  j = n

  While P(j) > P(i)
    j = j - 1
  Wend

  j = j + 1
  'Swap p(i) and p(j)
  t = P(i)
  P(i) = P(j)
  P(j) = t
Loop 'While not last

Debug.Print "Number of permutations: "; count

End Sub


package main

import "github.com/fogleman/gg"

var points []gg.Point

const width = 81

func peano(x, y, lg, i1, i2 int) {
    if lg == 1 {
        px := float64(width-x) * 10
        py := float64(width-y) * 10
        points = append(points, gg.Point{px, py})
        return
    }
    lg /= 3
    peano(x+2*i1*lg, y+2*i1*lg, lg, i1, i2)
    peano(x+(i1-i2+1)*lg, y+(i1+i2)*lg, lg, i1, 1-i2)
    peano(x+lg, y+lg, lg, i1, 1-i2)
    peano(x+(i1+i2)*lg, y+(i1-i2+1)*lg, lg, 1-i1, 1-i2)
    peano(x+2*i2*lg, y+2*(1-i2)*lg, lg, i1, i2)
    peano(x+(1+i2-i1)*lg, y+(2-i1-i2)*lg, lg, i1, i2)
    peano(x+2*(1-i1)*lg, y+2*(1-i1)*lg, lg, i1, i2)
    peano(x+(2-i1-i2)*lg, y+(1+i2-i1)*lg, lg, 1-i1, i2)
    peano(x+2*(1-i2)*lg, y+2*i2*lg, lg, 1-i1, i2)
}

func main() {
    peano(0, 0, width, 0, 0)
    dc := gg.NewContext(820, 820)
    dc.SetRGB(1, 1, 1) // White background
    dc.Clear()
    for _, p := range points {
        dc.LineTo(p.X, p.Y)
    }
    dc.SetRGB(1, 0, 1) // Magenta curve
    dc.SetLineWidth(1)
    dc.Stroke()
    dc.SavePNG("peano.png")
}


'permutation ,recursive
a=array("Hello",1,True,3.141592)
cnt=0
perm a,0
wscript.echo vbcrlf &"Count " & cnt

sub print(a)
  s=""
  for i=0  to ubound(a):
    s=s &" " & a(i):
  next:
  wscript.echo s :
  cnt=cnt+1 :
end sub
sub swap(a,b) t=a: a=b :b=t:  end sub

sub perm(byval a,i)
   if i=ubound(a) then print a: exit sub
   for j= i to ubound(a)
      swap a(i),a(j)
      perm a,i+1
     swap a(i),a(j)
   next
end sub


var permute // recursive
permute = Fn.new { |input|
    if (input.count == 1) return [input]
    var perms = []
    var toInsert = input[0]
    for (perm in permute.call(input[1..-1])) {
        for (i in 0..perm.count) {
            var newPerm = perm.toList
            newPerm.insert(i, toInsert)
            perms.add(newPerm)
        }
    }
    return perms
}

var input = [1, 2, 3]
var perms = permute.call(input)
System.print("There are %(perms.count) permutations of %(input), namely:\n")
perms.each { |perm| System.print(perm) }


100 PROGRAM "PeanoC.bas"
110 OPTION ANGLE DEGREES
120 SET VIDEO MODE 5:SET VIDEO COLOR 0:SET VIDEO X 40:SET VIDEO Y 27
130 OPEN #101:"video:"
140 DISPLAY #101:AT 1 FROM 1 TO 27
150 PLOT 280,240,ANGLE 90;
160 CALL PEANO(28,90,6)
170 DEF PEANO(D,A,LEV)
180   IF LEV=0 THEN EXIT DEF
190   PLOT RIGHT A;
200   CALL PEANO(D,-A,LEV-1)
210   PLOT FORWARD D;
220   CALL PEANO(D,A,LEV-1)
230   PLOT FORWARD D;
240   CALL PEANO(D,-A,LEV-1)
250   PLOT LEFT A;
260 END DEF


import java.io.*;

public class PeanoCurve {
    public static void main(final String[] args) {
        try (Writer writer = new BufferedWriter(new FileWriter("peano_curve.svg"))) {
            PeanoCurve s = new PeanoCurve(writer);
            final int length = 8;
            s.currentAngle = 90;
            s.currentX = length;
            s.currentY = length;
            s.lineLength = length;
            s.begin(656);
            s.execute(rewrite(4));
            s.end();
        } catch (final Exception ex) {
            ex.printStackTrace();
        }
    }

    private PeanoCurve(final Writer writer) {
        this.writer = writer;
    }

    private void begin(final int size) throws IOException {
        write("<svg xmlns='http://www.w3.org/2000/svg' width='%d' height='%d'>\n", size, size);
        write("<rect width='100%%' height='100%%' fill='white'/>\n");
        write("<path stroke-width='1' stroke='black' fill='none' d='");
    }

    private void end() throws IOException {
        write("'/>\n</svg>\n");
    }

    private void execute(final String s) throws IOException {
        write("M%g,%g\n", currentX, currentY);
        for (int i = 0, n = s.length(); i < n; ++i) {
            switch (s.charAt(i)) {
                case 'F':
                    line(lineLength);
                    break;
                case '+':
                    turn(ANGLE);
                    break;
                case '-':
                    turn(-ANGLE);
                    break;
            }
        }
    }

    private void line(final double length) throws IOException {
        final double theta = (Math.PI * currentAngle) / 180.0;
        currentX += length * Math.cos(theta);
        currentY += length * Math.sin(theta);
        write("L%g,%g\n", currentX, currentY);
    }

    private void turn(final int angle) {
        currentAngle = (currentAngle + angle) % 360;
    }

    private void write(final String format, final Object... args) throws IOException {
        writer.write(String.format(format, args));
    }

    private static String rewrite(final int order) {
        String s = "L";
        for (int i = 0; i < order; ++i) {
            final StringBuilder sb = new StringBuilder();
            for (int j = 0, n = s.length(); j < n; ++j) {
                final char ch = s.charAt(j);
                if (ch == 'L')
                    sb.append("LFRFL-F-RFLFR+F+LFRFL");
                else if (ch == 'R')
                    sb.append("RFLFR+F+LFRFL-F-RFLFR");
                else
                    sb.append(ch);
            }
            s = sb.toString();
        }
        return s;
    }

    private final Writer writer;
    private double lineLength;
    private double currentX;
    private double currentY;
    private int currentAngle;
    private static final int ANGLE = 90;
}


code ChOut=8, CrLf=9;
def  N=4;                       \number of objects (letters)
char S0, S1(N);

proc Permute(D);                \Display all permutations of letters in S0
int D;                          \depth of recursion
int I, J;
[if D=N then
        [for I:= 0 to N-1 do ChOut(0, S1(I));
        CrLf(0);
        return;
        ];
for I:= 0 to N-1 do
        [for J:= 0 to D-1 do    \check if object (letter) already used
                if S1(J) = S0(I) then J:=100;
        if J<100 then
                [S1(D):= S0(I); \object (letter) not used so append it
                Permute(D+1);   \recurse next level deeper
                ];
        ];
];

[S0:= "rose ";                  \N different objects (letters)
Permute(0);                     \(space char avoids MSb termination)
]


n = 4
dim a(n), c(n)

for j = 1 to n : a(j) = j : next j

repeat
  for i = 1 to n: print a(i);: next: print
  i = n
  repeat
    i = i - 1
  until (i = 0) or (a(i) < a(i+1))
  j = i + 1
  k = n
  while j < k
    tmp = a(j) : a(j) = a(k) : a(k) = tmp
    j = j + 1
    k = k - 1
  wend
  if i > 0 then
    j = i + 1
    while a(j) < a(i)
      j = j + 1
    wend
    tmp = a(j) : a(j) = a(i) : a(i) = tmp
  endif
until i = 0
end


# => =   0 degrees
# ^  =  90 degrees
# <= = 180 degrees
# v  = 270 degrees

# $start : [$x, $y]
def turtle($start):
  $start
  | if type == "array"  then "M \($start|join(","))" else "M 0,0" end
  | {svg: ., up:true, angle:0};

def turtleUp:   .up=true;
def turtleDown: .up=false;

def turtleRotate($angle): .angle = (360 + (.angle + $angle)) % 360;

def turtleForward($d):
  if .up
  then if   .angle==  0 then .svg += " m \($d),0"
       elif .angle== 90 then .svg += " m 0,-\($d)"
       elif .angle==180 then .svg += " m -\($d),0"
       elif .angle==270 then .svg += " m 0,\($d)"
       else "unsupported angle \(.angle)" | error
       end
  else if   .angle==  0 then .svg += " h \($d)"
       elif .angle== 90 then .svg += " v -\($d)"
       elif .angle==180 then .svg += " h -\($d)"
       elif .angle==270 then .svg += " v \($d)"
       else "unsupported angle \(.angle)" | error
       end
  end;

def svg($size):
  "<svg viewBox=\"0 0 \($size) \($size)\" xmlns=\"http://www.w3.org/2000/svg\">",
  .,
  "</svg>";

def path($fill; $stroke; $width):
  "<path fill=\"\($fill)\" stroke=\"\($stroke)\" stroke-width=\"\($width)\" d=\"\(.svg)\" />";

def draw:
  path("none"; "red"; "0.1") | svg(100) ;


using Gtk, Graphics, Colors

function peano(ctx, x, y, lg, i1, i2)
    if lg < 3
        line_to(ctx, x - 250, y - 250)
        stroke(ctx)
        move_to(ctx, x - 250 , y - 250)
    else
        lg = div(lg,  3)
        peano(ctx, x + (2 * i1 * lg), y + (2 * i1 * lg), lg, i1, i2)
        peano(ctx, x + ((i1 - i2 + 1) * lg), y + ((i1 + i2) * lg), lg, i1, 1 - i2)
        peano(ctx, x + lg, y + lg, lg, i1, 1 - i2)
        peano(ctx, x + ((i1 + i2) * lg), y + ((i1 - i2 + 1) * lg), lg, 1 - i1, 1 - i2)
        peano(ctx, x + (2 * i2 * lg), y + ( 2 * (1-i2) * lg), lg, i1, i2)
        peano(ctx, x + ((1 + i2 - i1) * lg), y + ((2 - i1 - i2) * lg), lg, i1, i2)
        peano(ctx, x + (2 * (1 - i1) * lg), y + (2 * (1 - i1) * lg), lg, i1, i2)
        peano(ctx, x + ((2 - i1 - i2) * lg), y + ((1 + i2 - i1) * lg), lg, 1 - i1, i2)
        peano(ctx, x + (2 * (1 - i2) * lg), y + (2 * i2 * lg), lg, 1 - i1, i2)
    end
end

const can = @GtkCanvas()
const win = GtkWindow(can, "Peano Curve", 500, 500)

@guarded draw(can) do widget
    ctx = getgc(can)
    h = height(can)
    w = width(can)
    set_source(ctx, colorant"blue")
    set_line_width(ctx, 1)
    peano(ctx, w/2, h/2, 500, 0, 0)
end

show(can)
const cond = Condition()
endit(w) = notify(cond)
signal_connect(endit, win, :destroy)
wait(cond)


local PeanoLSystem = {
  axiom = "L",
  rules = {
    L = "LFRFL-F-RFLFR+F+LFRFL",
    R = "RFLFR+F+LFRFL-F-RFLFR"
  },
  eval = function(self, n)
    local source, result = self.axiom
    for i = 1, n do
      result = ""
      for j = 1, #source do
        local ch = source:sub(j,j)
        result = result .. (self.rules[ch] and self.rules[ch] or ch)
      end
      source = result
    end
    return result
  end
}

function Bitmap:drawPath(path, x, y, dx, dy)
  self:set(x, y, "@")
  for i = 1, #path do
    local ch = path:sub(i,i)
    if (ch == "F") then
      local reps = dx==0 and 1 or 3 -- aspect correction
      for r = 1, reps do
        x, y = x+dx, y+dy
        self:set(x, y, dx==0 and "|" or "-")
      end
      x, y = x+dx, y+dy
      self:set(x, y, "+")
    elseif (ch =="-") then
      dx, dy = dy, -dx
    elseif (ch == "+") then
      dx, dy = -dy, dx
    end
  end
  self:set(x, y, "X")
end

function Bitmap:render()
  for y = 1, self.height do
    print(table.concat(self.pixels[y]))
  end
end

bitmap = Bitmap(53*2,53)
bitmap:clear(" ")
bitmap:drawPath(PeanoLSystem:eval(3), 0, 0, 0, 1)
bitmap:render()


Module Peano_curve {
Cls 1, 0
Const Center=2
Report Center, "Peano curve"
let factor=.9, k=3, wi=k^4
let wi2=min.data(scale.x*factor, scale.y*factor), n=wi2/wi
let (dx, dy)=((scale.x-wi2)/2, (scale.y-wi2)/2)
dx+=k*1.2*twipsX
dy+=k*1.2*twipsY
move dx, dy
pen 11 {
      Peano(0,0,wi,0, 0)
}

sub Peano(x, y, lg, i1, i2)
      if lg ==1  then
            draw to  x*n+dx , y*n+dy
            return
      end if
      lg/=k
      Peano(x+2*i1*lg, y+2*i1*lg, lg, i1, i2)
      Peano(x+(i1-i2+1)*lg, y+(i1+i2)*lg, lg, i1, 1-i2)
      Peano(x+lg, y+lg, lg, i1, 1-i2)
      Peano(x+(i1+i2)*lg, y+(i1-i2+1)*lg, lg, 1-i1, 1-i2)
      Peano(x+2*i2*lg, y+2*(1-i2)*lg, lg, i1, i2)
      Peano(x+(1+i2-i1)*lg, y+(2-i1-i2)*lg, lg, i1, i2)
      Peano(x+2*(1-i1)*lg, y+2*(1-i1)*lg, lg, i1, i2)
      Peano(x+(2-i1-i2)*lg, y+(1+i2-i1)*lg, lg, 1-i1, i2)
      Peano(x+2*(1-i2)*lg, y+2*i2*lg, lg, 1-i1, i2)
end sub
}
Peano_curve


import imageman

const Width = 81

proc peano(points: var seq[Point]; x, y, lg, i1, i2: int) =

  if lg == 1:
    points.add ((Width - x) * 10, (Width - y) * 10)
    return

  let lg = lg div 3
  points.peano(x + 2 * i1 * lg, y + 2 * i1 * lg, lg, i1, i2)
  points.peano(x + (i1 - i2 + 1) * lg, y + (i1 + i2) * lg, lg, i1, 1 - i2)
  points.peano(x + lg, y + lg, lg, i1, 1 - i2)
  points.peano(x + (i1 + i2) * lg, y + (i1 - i2 + 1) * lg, lg, 1 - i1, 1 - i2)
  points.peano(x + 2 * i2 * lg, y + 2 * (1-i2) * lg, lg, i1, i2)
  points.peano(x + (1 + i2 - i1) * lg, y + (2 - i1 - i2) * lg, lg, i1, i2)
  points.peano(x + 2 * (1 - i1) * lg, y + 2 * (1 - i1) * lg, lg, i1, i2)
  points.peano(x + (2 - i1 - i2) * lg, y + (1 + i2 - i1) * lg, lg, 1 - i1, i2)
  points.peano(x + 2 * (1 - i2) * lg, y + 2 * i2 * lg, lg, 1 - i1, i2)

var points: seq[Point]
points.peano(0, 0, Width, 0, 0)
var image = initImage[ColorRGBU](820, 820)
let color = ColorRGBU([byte 255, 255, 0])
for i in 1..points.high:
  image.drawLine(points[i - 1], points[i], color)
image.savePNG("peano.png", compression = 9)


use SVG;
use List::Util qw(max min);

use constant pi => 2 * atan2(1, 0);

# Compute the curve with a Lindemayer-system
my %rules = (
    L => 'LFRFL-F-RFLFR+F+LFRFL',
    R => 'RFLFR+F+LFRFL-F-RFLFR'
);
my $peano = 'L';
$peano =~ s/([LR])/$rules{$1}/eg for 1..4;

# Draw the curve in SVG
($x, $y) = (0, 0);
$theta   = pi/2;
$r       = 4;

for (split //, $peano) {
    if (/F/) {
        push @X, sprintf "%.0f", $x;
        push @Y, sprintf "%.0f", $y;
        $x += $r * cos($theta);
        $y += $r * sin($theta);
    }
    elsif (/\+/) { $theta += pi/2; }
    elsif (/\-/) { $theta -= pi/2; }
}

$max =  max(@X,@Y);
$xt  = -min(@X)+10;
$yt  = -min(@Y)+10;
$svg = SVG->new(width=>$max+20, height=>$max+20);
$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  $fh, '>', 'peano_curve.svg';
print $fh  $svg->xmlify(-namespace=>'svg');
close $fh;


--
-- demo\rosetta\peano_curve.exw
-- ============================
--
--  Draws a peano curve. Space key toggles between switchback and meander curves.
--
with javascript_semantics
include pGUI.e

Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

bool meander = false    -- space toggles (false==draw switchback curve)
constant width = 81

sequence points = {}

-- switchback peano:
--
-- There are (as per wp) four shapes to draw:
--
--  1: +-v ^     2: ^ v-+     3: v ^-+     2: +-^ v
--     | | |        | | |        | | |        | | |
--     ^ v-+        +-v ^        +-^ v        v ^-+
--
-- 1 starts bottom left, ends top right
-- 2 starts bottom right, ends top left
-- 3 starts top left, ends bottom right
-- 4 starts top right, ends bottom left
--
-- given the centre point (think {1,1}), and using {0,0} as the bottom left:
--
constant shapes = {{{-1,-1},{-1,0},{-1,+1},{0,+1},{0,0},{0,-1},{+1,-1},{+1,0},{+1,+1}},
                   {{+1,-1},{+1,0},{+1,+1},{0,+1},{0,0},{0,-1},{-1,-1},{-1,0},{-1,+1}},     -- (== sq_mul(shapes[1],{-1,0}))
                   {{-1,+1},{-1,0},{-1,-1},{0,-1},{0,0},{0,+1},{+1,+1},{+1,0},{+1,-1}},     -- (== reverse(shapes[2]))
                   {{+1,+1},{+1,0},{+1,-1},{0,-1},{0,0},{0,+1},{-1,+1},{-1,0},{-1,-1}}}     -- (== reverse(shapes[1]))

constant subshapes = {{1,2,1,3,4,3,1,2,1},
                      {2,1,2,4,3,4,2,1,2},      -- == sq_sub({3,3,3,7,7,7,3,3,3},subshapes[1])
                      {3,4,3,1,2,1,3,4,3},      -- == sq_sub(5,subshapes[2])
                      {4,3,4,2,1,2,4,3,4}}      -- == sq_sub(5,subshapes[1])

-- As noted, it should theoretically be possible to simplify/shorten/remove/inline those tables

procedure switchback_peano(integer x, y, level, shape)
-- (written from scratch, with a nod to the meander algorithm [below])
    if level<=1 then
        points = append(points, {x*10, y*10})
        return
    end if
    level /= 3
    for i=1 to 9 do
        integer {dx,dy} = shapes[shape][i]
        switchback_peano(x+dx*level,y+dy*level,level,subshapes[shape][i])
    end for
end procedure

procedure meander_peano(integer x, y, lg, i1, i2)
-- (translated from Go)
    if lg=1 then
        integer px := (width-x) * 10,
                py := (width-y) * 10
        points = append(points, {px, py})
        return
    end if
    lg /= 3
    meander_peano(x+2*i1*lg, y+2*i1*lg, lg, i1, i2)
    meander_peano(x+(i1-i2+1)*lg, y+(i1+i2)*lg, lg, i1, 1-i2)
    meander_peano(x+lg, y+lg, lg, i1, 1-i2)
    meander_peano(x+(i1+i2)*lg, y+(i1-i2+1)*lg, lg, 1-i1, 1-i2)
    meander_peano(x+2*i2*lg, y+2*(1-i2)*lg, lg, i1, i2)
    meander_peano(x+(1+i2-i1)*lg, y+(2-i1-i2)*lg, lg, i1, i2)
    meander_peano(x+2*(1-i1)*lg, y+2*(1-i1)*lg, lg, i1, i2)
    meander_peano(x+(2-i1-i2)*lg, y+(1+i2-i1)*lg, lg, 1-i1, i2)
    meander_peano(x+2*(1-i2)*lg, y+2*i2*lg, lg, 1-i1, i2)
end procedure

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
    if length(points)=0 then
        if meander then
            meander_peano(0, 0, width, 0, 0)
        else
            switchback_peano(41, 41, width, 1)
        end if
    end if
    cdCanvasActivate(cddbuffer)
    cdCanvasBegin(cddbuffer, CD_OPEN_LINES)
    for i=1 to length(points) do
        integer {x,y} = points[i]
        cdCanvasVertex(cddbuffer, x, y)
    end for
    cdCanvasEnd(cddbuffer)
    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_MAGENTA)
    return IUP_DEFAULT
end function

function key_cb(Ihandle /*ih*/, atom c)
    if c=K_ESC then return IUP_CLOSE end if
    if c=' ' then
        meander = not meander
        points = {}
        cdCanvasClear(cddbuffer)
        IupUpdate(canvas)
    end if
    return IUP_CONTINUE
end function

procedure main()
    IupOpen()
    canvas = IupCanvas("RASTERSIZE=822x822")
    IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),
                             "ACTION", Icallback("redraw_cb")})
    dlg = IupDialog(canvas,`TITLE="Peano Curve"`)
    IupSetAttribute(dlg, "DIALOGFRAME", "YES")  -- no resize here
    IupSetCallback(dlg, "KEY_CB", Icallback("key_cb"))
    IupShow(dlg)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


main:-
    write_peano_curve('peano_curve.svg', 656, 4).

write_peano_curve(File, Size, Order):-
    open(File, write, Stream),
    format(Stream,
           "<svg xmlns='http://www.w3.org/2000/svg' width='~d' height='~d'>\n",
           [Size, Size]),
    write(Stream, "<rect width='100%' height='100%' fill='white'/>\n"),
    peano_curve(Stream, "L", 8, 8, 8, 90, Order),
    write(Stream, "</svg>\n"),
    close(Stream).

peano_curve(Stream, Axiom, X, Y, Length, Angle, Order):-
    write(Stream, "<path stroke-width='1' stroke='black' fill='none' d='"),
    format(Stream, 'M~g,~g\n', [X, Y]),
    rewrite(Axiom, Order, S),
    string_chars(S, Chars),
    execute(Stream, X, Y, Length, Angle, Chars),
    write(Stream, "'/>\n").

rewrite(S, 0, S):-!.
rewrite(S0, N, S):-
    string_chars(S0, Chars0),
    rewrite1(Chars0, '', S1),
    N1 is N - 1,
    rewrite(S1, N1, S).

rewrite1([], S, S):-!.
rewrite1([C|Chars], T, S):-
    rewrite2(C, X),
    string_concat(T, X, T1),
    rewrite1(Chars, T1, S).

rewrite2('L', "LFRFL-F-RFLFR+F+LFRFL"):-!.
rewrite2('R', "RFLFR+F+LFRFL-F-RFLFR"):-!.
rewrite2(X, X).

execute(_, _, _, _, _, []):-!.
execute(Stream, X, Y, Length, Angle, ['F'|Chars]):-
    !,
    Theta is (pi * Angle) / 180.0,
    X1 is X + Length * cos(Theta),
    Y1 is Y + Length * sin(Theta),
    format(Stream, 'L~g,~g\n', [X1, Y1]),
    execute(Stream, X1, Y1, Length, Angle, Chars).
execute(Stream, X, Y, Length, Angle, ['+'|Chars]):-
    !,
    Angle1 is (Angle + 90) mod 360,
    execute(Stream, X, Y, Length, Angle1, Chars).
execute(Stream, X, Y, Length, Angle, ['-'|Chars]):-
    !,
    Angle1 is (Angle - 90) mod 360,
    execute(Stream, X, Y, Length, Angle1, Chars).
execute(Stream, X, Y, Length, Angle, [_|Chars]):-
    execute(Stream, X, Y, Length, Angle, Chars).


import turtle as tt
import inspect

stack = [] # Mark the current stacks in run.
def peano(iterations=1):
    global stack

    # The turtle Ivan:
    ivan = tt.Turtle(shape = "classic", visible = True)

    # The app window:
    screen = tt.Screen()
    screen.title("Desenhin do Peano")
    screen.bgcolor("#232323")
    screen.delay(0) # Speed on drawing (if higher, more slow)
    screen.setup(width=0.95, height=0.9)

    # The size of each step walked (here, named simply "walk"). It's not a pixel scale. This may stay still:
    walk = 1

    def screenlength(k):
        # A function to make the image good to see (without it would result in a partial image).
        # This will guarantee that we can see the the voids and it's steps.
        if k != 0:
            length = screenlength(k-1)
            return 2*length + 1
        else: return 0

    kkkj = screenlength(iterations)
    screen.setworldcoordinates(-1, -1, kkkj + 1, kkkj + 1)
    ivan.color("#EEFFFF", "#FFFFFF")

    # The magic  \(^-^)/:
    def step1(k):
        global stack
        stack.append(len(inspect.stack()))
        if k != 0:
            ivan.left(90)
            step2(k - 1)
            ivan.forward(walk)
            ivan.right(90)
            step1(k - 1)
            ivan.forward(walk)
            step1(k - 1)
            ivan.right(90)
            ivan.forward(walk)
            step2(k - 1)
            ivan.left(90)
    def step2(k):
        global stack
        stack.append(len(inspect.stack()))
        if k != 0:
            ivan.right(90)
            step1(k - 1)
            ivan.forward(walk)
            ivan.left(90)
            step2(k - 1)
            ivan.forward(walk)
            step2(k - 1)
            ivan.left(90)
            ivan.forward(walk)
            step1(k - 1)
            ivan.right(90)

    # Making the program work:
    ivan.left(90)
    step2(iterations)

    tt.done()

if __name__ == "__main__":
    peano(4)
    import pylab as P # This plot, after closing the drawing window, the "stack" graphic.
    P.plot(stack)
    P.show()


  [ $ "turtleduck.qky" loadfile ] now!

  [ stack ]                      is switch.arg (   --> [ )

  [ switch.arg put ]             is switch     ( x -->   )

  [ switch.arg release ]         is otherwise  (   -->   )

  [ switch.arg share
    != iff ]else[ done
    otherwise ]'[ do ]done[ ]    is case       ( x -->   )

  [ $ "" swap witheach
      [ nested quackery join ] ] is expand     ( $ --> $ )

  [ $ "F" ]                      is F          ( $ --> $ )

  [ $ "L" ]                      is L          ( $ --> $ )

  [ $ "R" ]                      is R          ( $ --> $ )

  [ $ "AFBFARFRBFAFBLFLAFBFA" ]  is A          ( $ --> $ )

  [ $ "BFAFBLFLAFBFARFRBFAFB" ]  is B          ( $ --> $ )

  $ "A"

  4 times expand

  turtle
  witheach
    [ switch
        [ char F case [  4 1 walk ]
          char L case [ -1 4 turn ]
          char R case [  1 4 turn ]
          otherwise ( ignore ) ] ]


#to install hilbercurve library, biocmanager needs to be installed first
install.packages("BiocManager")
BiocManager::install("HilbertCurve")
#loading library and setting seed for random numbers
library(HilbertCurve)
library(circlize)
set.seed(123)

#4th order peano curve is generated
for(i in 1:512) {
  peano = HilbertCurve(1, 512, level = 4, reference = TRUE, arrow = FALSE)
  hc_points(peano, x1 = i, np = NULL, pch = 16, size = unit(3, "mm"))
}


/* Jens Axel Søgaard, 27th December 2018*/
#lang racket
(require metapict metapict/mat)

;;; Turtle State
(define p (pt 0 0))  ; current position
(define d (vec 0 1)) ; current direction
(define c '())       ; line segments drawn so far

;;; Turtle Operations
(define (jump q)    (set! p q))
(define (move q)    (set! c (cons (curve p -- q) c)) (set! p q))
(define (forward x) (move (pt+ p (vec* x d))))
(define (left  a)   (set! d (rot a d)))
(define (right a)   (left (- a)))

;;; Peano
(define (peano n a h)
  (unless (= n 0)
    (right a)
    (peano (- n 1) (- a) h)
    (forward h)
    (peano (- n 1) a h)
    (forward h)
    (peano (- n 1) (- a) h)
    (left a)))

;;; Produce image
(set-curve-pict-size 400 400)
(with-window (window -1 81 -1 82)
  (peano 6 90 3)
  (draw* c))


use SVG;

role Lindenmayer {
    has %.rules;
    method succ {
        self.comb.map( { %!rules{$^c} // $c } ).join but Lindenmayer(%!rules)
    }
}

my $peano = 'L' but Lindenmayer( { 'L' => 'LFRFL-F-RFLFR+F+LFRFL', 'R' => 'RFLFR+F+LFRFL-F-RFLFR' } );

$peano++ xx 4;
my @points = (10, 10);

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

say SVG.serialize(
    svg => [
        :660width, :660height, :style<stroke:lime>,
        :rect[:width<100%>, :height<100%>, :fill<black>],
        :polyline[ :points(@points.join: ','), :fill<black> ],
    ],
);


load_library :grammar

# Peano class
class Peano
  include Processing::Proxy
  attr_reader :draw_length, :vec, :theta, :axiom, :grammar
  DELTA = 60 # degrees
  def initialize(vec)
    @axiom = 'XF' # Axiom
    rules = {
      'X' => 'X+YF++YF-FX--FXFX-YF+', # LSystem Rules
      'Y' => '-FX+YFYF++YF+FX--FX-Y'
    }
    @grammar = Grammar.new(axiom, rules)
    @theta   = 0
    @draw_length = 100
    @vec = vec
  end

  def generate(gen)
    @draw_length = draw_length * 0.6**gen
    grammar.generate gen
  end

  def translate_rules(prod)
    coss = ->(orig, alpha, len) { orig + len * DegLut.cos(alpha) }
    sinn = ->(orig, alpha, len) { orig - len * DegLut.sin(alpha) }
    [].tap do |pts| # An array to store line vertices as Vec2D
      prod.scan(/./) do |ch|
        case ch
        when 'F'
          pts << vec.copy
          @vec = Vec2D.new(
            coss.call(vec.x, theta, draw_length),
            sinn.call(vec.y, theta, draw_length)
          )
          pts << vec
        when '+'
          @theta += DELTA
        when '-'
          @theta -= DELTA
        when 'X', 'Y'
        else
          puts("character #{ch} not in grammar")
        end
      end
    end
  end
end

attr_reader :points

def setup
  sketch_title 'Peano'
  peano = Peano.new(Vec2D.new(width * 0.65, height * 0.9))
  production = peano.generate 4 # 4 generations looks OK
  @points = peano.translate_rules(production)
  no_loop
end

def draw
  background(0)
  render points
end

def render(points)
  no_fill
  stroke 200.0
  stroke_weight 3
  begin_shape
  points.each_slice(2) do |v0, v1|
    v0.to_vertex(renderer)
    v1.to_vertex(renderer)
  end
  end_shape
end

def renderer
  @renderer ||= GfxRender.new(g)
end

def settings
  size(800, 800)
end


// [dependencies]
// svg = "0.8.0"

use svg::node::element::path::Data;
use svg::node::element::Path;

struct PeanoCurve {
    current_x: f64,
    current_y: f64,
    current_angle: i32,
    line_length: f64,
}

impl PeanoCurve {
    fn new(x: f64, y: f64, length: f64, angle: i32) -> PeanoCurve {
        PeanoCurve {
            current_x: x,
            current_y: y,
            current_angle: angle,
            line_length: length,
        }
    }
    fn rewrite(order: usize) -> String {
        let mut str = String::from("L");
        for _ in 0..order {
            let mut tmp = String::new();
            for ch in str.chars() {
                match ch {
                    'L' => tmp.push_str("LFRFL-F-RFLFR+F+LFRFL"),
                    'R' => tmp.push_str("RFLFR+F+LFRFL-F-RFLFR"),
                    _ => tmp.push(ch),
                }
            }
            str = tmp;
        }
        str
    }
    fn execute(&mut self, order: usize) -> Path {
        let mut data = Data::new().move_to((self.current_x, self.current_y));
        for ch in PeanoCurve::rewrite(order).chars() {
            match ch {
                'F' => data = self.draw_line(data),
                '+' => self.turn(90),
                '-' => self.turn(-90),
                _ => {}
            }
        }
        Path::new()
            .set("fill", "none")
            .set("stroke", "black")
            .set("stroke-width", "1")
            .set("d", data)
    }
    fn draw_line(&mut self, data: Data) -> Data {
        let theta = (self.current_angle as f64).to_radians();
        self.current_x += self.line_length * theta.cos();
        self.current_y += self.line_length * theta.sin();
        data.line_to((self.current_x, self.current_y))
    }
    fn turn(&mut self, angle: i32) {
        self.current_angle = (self.current_angle + angle) % 360;
    }
    fn save(file: &str, size: usize, order: usize) -> std::io::Result<()> {
        use svg::node::element::Rectangle;
        let rect = Rectangle::new()
            .set("width", "100%")
            .set("height", "100%")
            .set("fill", "white");
        let mut p = PeanoCurve::new(8.0, 8.0, 8.0, 90);
        let document = svg::Document::new()
            .set("width", size)
            .set("height", size)
            .add(rect)
            .add(p.execute(order));
        svg::save(file, &document)
    }
}

fn main() {
    PeanoCurve::save("peano_curve.svg", 656, 4).unwrap();
}


var rules = Hash(
    l => 'lFrFl-F-rFlFr+F+lFrFl',
    r => 'rFlFr+F+lFrFl-F-rFlFr',
)

var lsys = LSystem(
    width:  500,
    height: 500,

    xoff: -50,
    yoff: -50,

    len:   5,
    angle: 90,
    color: 'dark green',
)

lsys.execute('l', 4, "peano_curve.png", rules)


Const WIDTH = 243 'a power of 3 for a evenly spaced curve
Dim n As Long
Dim points() As Single
Dim flag As Boolean
'Store the coordinate pairs (x, y) generated by Peano into
'a SafeArrayOfPoints with lineto. The number of points
'generated depend on WIDTH. Peano is called twice. Once
'to count the number of points, and twice to generate
'the points after the dynamic array has been
'redimensionalised.
'VBA doesn't have a lineto method. Instead of AddLine, which
'requires four parameters, including the begin pair of
'coordinates, the method AddPolyline is used, which is
'called from main after all the points are generated.
'This creates a single object, whereas AddLine would
'create thousands of small unconnected line objects.
Private Sub lineto(x As Integer, y As Integer)
    If flag Then
        points(n, 1) = x
        points(n, 2) = y
    End If
    n = n + 1
End Sub
Private Sub Peano(ByVal x As Integer, ByVal y As Integer, ByVal lg As Integer, _
    ByVal i1 As Integer, ByVal i2 As Integer)
    If (lg = 1) Then
        Call lineto(x * 3, y * 3)
        Exit Sub
    End If
    lg = lg / 3
    Call Peano(x + (2 * i1 * lg), y + (2 * i1 * lg), lg, i1, i2)
    Call Peano(x + ((i1 - i2 + 1) * lg), y + ((i1 + i2) * lg), lg, i1, 1 - i2)
    Call Peano(x + lg, y + lg, lg, i1, 1 - i2)
    Call Peano(x + ((i1 + i2) * lg), y + ((i1 - i2 + 1) * lg), lg, 1 - i1, 1 - i2)
    Call Peano(x + (2 * i2 * lg), y + (2 * (1 - i2) * lg), lg, i1, i2)
    Call Peano(x + ((1 + i2 - i1) * lg), y + ((2 - i1 - i2) * lg), lg, i1, i2)
    Call Peano(x + (2 * (1 - i1) * lg), y + (2 * (1 - i1) * lg), lg, i1, i2)
    Call Peano(x + ((2 - i1 - i2) * lg), y + ((1 + i2 - i1) * lg), lg, 1 - i1, i2)
    Call Peano(x + (2 * (1 - i2) * lg), y + (2 * i2 * lg), lg, 1 - i1, i2)
End Sub
Sub main()
    n = 1: flag = False
    Call Peano(0, 0, WIDTH, 0, 0) 'Start Peano recursion to count number of points
    ReDim points(1 To n - 1, 1 To 2)
    n = 1: flag = True
    Call Peano(0, 0, WIDTH, 0, 0) 'Start Peano recursion to generate and store points
    ActiveSheet.Shapes.AddPolyline points 'Excel assumed
End Sub


import "graphics" for Canvas, Color, Point
import "dome" for Window

class Game {
    static init() {
        Window.title = "Peano curve"
        Canvas.resize(820, 820)
        Window.resize(820, 820)
        Canvas.cls(Color.white) // white background
        __points = []
        __width = 81
        peano(0, 0, __width, 0, 0)
        var col = Color.rgb(255, 0, 255) // magenta
        var prev = __points[0]
        for (p in __points.skip(1)) {
            var curr = p
            Canvas.line(prev.x, prev.y, curr.x, curr.y, col)
            prev = curr
        }
    }

    static peano(x, y, lg, i1, i2) {
        if (lg == 1) {
            var px = (__width - x) * 10
            var py = (__width - y) * 10
            __points.add(Point.new(px, py))
            return
        }
        lg = (lg/3).floor
        peano(x+2*i1*lg, y+2*i1*lg, lg, i1, i2)
        peano(x+(i1-i2+1)*lg, y+(i1+i2)*lg, lg, i1, 1-i2)
        peano(x+lg, y+lg, lg, i1, 1-i2)
        peano(x+(i1+i2)*lg, y+(i1-i2+1)*lg, lg, 1-i1, 1-i2)
        peano(x+2*i2*lg, y+2*(1-i2)*lg, lg, i1, i2)
        peano(x+(1+i2-i1)*lg, y+(2-i1-i2)*lg, lg, i1, i2)
        peano(x+2*(1-i1)*lg, y+2*(1-i1)*lg, lg, i1, i2)
        peano(x+(2-i1-i2)*lg, y+(1+i2-i1)*lg, lg, 1-i1, i2)
        peano(x+2*(1-i2)*lg, y+2*i2*lg, lg, 1-i1, i2)
    }

    static update() {}

    static draw(dt) {}
}


lsystem("L",					// axiom
  Dictionary("L","LFRFL-F-RFLFR+F+LFRFL", "R","RFLFR+F+LFRFL-F-RFLFR"), # rules
  "+-F", 4)				  	// constants, order
: turtle(_);

fcn lsystem(axiom,rules,consts,n){	// Lindenmayer system --> string
   foreach k in (consts){ rules.add(k,k) }
   buf1,buf2 := Data(Void,axiom).howza(3), Data().howza(3);  // characters
   do(n){
      buf1.pump(buf2.clear(), rules.get);
      t:=buf1; buf1=buf2; buf2=t;	// swap buffers
   }
   buf1.text		// n=4 --> 16,401  characters
}


V first = random:choice([1B, 0B])

V you = ‘’
V me = ‘’
V ht = ‘HT’ // to get round ‘bug in MSVC 2017’[https://developercommunity.visualstudio.com/t/bug-with-operator-in-c/565417]
I first
   me = random:sample(Array(‘HT’ * 3), 3).join(‘’)
   print(‘I choose first and will win on first seeing #. in the list of tosses’.format(me))
   L you.len != 3 | any(you.map(ch -> ch !C :ht)) | you == me
      you = input(‘What sequence of three Heads/Tails will you win with: ’)
E
   L you.len != 3 | any(you.map(ch -> ch !C :ht))
      you = input(‘After you: What sequence of three Heads/Tails will you win with: ’)
   me = (I you[1] == ‘T’ {‘H’} E ‘T’)‘’you[0.<2]
   print(‘I win on first seeing #. in the list of tosses’.format(me))

print("Rolling:\n  ", end' ‘’)
V rolled = ‘’
L
   rolled ‘’= random:choice(‘HT’)
   print(rolled.last, end' ‘’)
   I rolled.ends_with(you)
      print("\n  You win!")
      L.break
   I rolled.ends_with(me)
      print("\n  I win!")
      L.break
   sleep(1)


Gui, font, s12
Gui, add, text, w90, Computer:
loop, 3
	Gui, add, button, x+10 h30 w30 vCB%A_Index%
Gui, add, edit, xs w240 R3 vSequence
Gui, add, text, w90, Human:
loop, 3
	Gui, add, button, x+10 h30 w30 vHB%A_Index% gHumButton, H
Gui, add, button, xm gToss, toss
Gui, add, button, x+10 gReset, Reset
Gui, show,, Penney's game
CompSeq := HumSeq := Seq := GameEnd := ""

RandomStart:
Random, WhoStarts, 1, 2
if (WhoStarts=1)
	gosub, CompButton
return
;-----------------------------------------------
CompButton:
if CompSeq
	return
Loop, 3
{
	Random, coin, 1, 2
	GuiControl,, CB%A_Index%, % coin=1?"H":"T"
	CompSeq .= coin=1?"H":"T"
}
return
;-----------------------------------------------
HumButton:
if HumSeq
	return
GuiControlGet, B,, % A_GuiControl
GuiControl,, % A_GuiControl, % B="H"?"T":"H"
return
;-----------------------------------------------
Toss:
if GameEnd
	return
if !HumSeq
{
	loop 3
	{
		GuiControlGet, B,, HB%A_Index%
		HumSeq .= B
	}
	if (CompSeq = HumSeq)
	{
		MsgBox, 262160, Penney's game, Human's Selection Has to be different From Computer's Selection`nTry Again
		HumSeq := ""
		return
	}
}
if !CompSeq
{
	CompSeq := (SubStr(HumSeq,2,1)="H"?"T":"H") . SubStr(HumSeq,1,2)
	loop, Parse, CompSeq
		GuiControl,, CB%A_Index%, % A_LoopField
}

Random, coin, 1, 2
Seq .= coin=1?"H":"T"
GuiControl,, Sequence, % seq
if (SubStr(Seq, -2) = HumSeq)
	MsgBox % GameEnd := "Human Wins"
else if (SubStr(Seq, -2) = CompSeq)
	MsgBox % GameEnd := "Computer Wins"
return
;-----------------------------------------------
Reset:
loop, 3
{
	GuiControl,, CB%A_Index%
	GuiControl,, HB%A_Index%, H
}
GuiControl,, Sequence
CompSeq := HumSeq := Seq := GameEnd := ""
gosub, RandomStart
return
;-----------------------------------------------


global jugador, computador, secuencia
jugador = "" : computador = ""

function SecuenciaJugador(secuencia)
	do
		valido = TRUE
		print chr(10) + "Ingresa una secuencia de 3 opciones, cada una de ellas H o T:";
		input " > ", secuencia
		secuencia = upper(secuencia)
		if length(secuencia) <> 3 then valido = FALSE
		if secuencia = computador then print "Pero no la misma que yo..."+ chr(10): valido = FALSE
		if valido then
			for i = 1 to 3
				opcion = mid(secuencia, i, 1)
				if opcion <> "H" and opcion <> "T" then valido = FALSE
			next i
		end if
	until valido
	SecuenciaJugador = secuencia
end function

function LanzamientoCPU()
	secuencia = ""
	computador =""
	for i = 1 to 3
		opcion = rand
		if opcion < .5 then secuencia += "H" else secuencia += "T"
	next i
	LanzamientoCPU = secuencia
end function

do
	cls
	print "*** Penney's Game ***" + chr(10)
	if rand < .5 then
		print "Empiezas... ";
		jugador = SecuenciaJugador(jugador)
		computador = LanzamientoCPU()
		if jugador = computador then computador = LanzamientoCPU()
		print "Yo gano al ver "; computador; " por primera vez en la lista de lanzamientos..."
	else
		computador = LanzamientoCPU()
		print "Elijo primero y gano al ver "; computador; " por primera vez en la lista de lanzamientos..."
		jugador = SecuenciaJugador(jugador)
	end if
print: print "Lanzamientos..."
	secuencia = ""
	winner = FALSE
	do
		pause 1
		if rand <= .5 then
			secuencia += "H"
			print "H  ";
		else
			print "T  ";
			secuencia += "T"
		end if
		if right(secuencia, 3) = jugador then print: print "¡Felicidades! ¡Ganaste!": winner = TRUE
		if right(secuencia, 3) = computador then print: print "¡Yo gano!": winner = TRUE
	until winner
	do
		valido = FALSE
		print
		input "¿Otra partida? (S/N) ", otra
		if instr("SsNn", otra) then valido = TRUE
	until valido
until upper(otra) = "N"
print "¡Gracias por jugar!"
end


::
::Penney's Game Task from Rosetta Code Wiki
::Batch File Implementation
::
::Please Directly Open the Batch File to play...
::

@echo off
setlocal enabledelayedexpansion
title The Penney's Game Batch File

set cpu=0&set you=0
cls
echo.
echo Penney's Game
echo Batch File Implementation

:main
set you_bet=&set cpu_bet=
echo.&echo --------------------------------------------------------&echo.
echo CPU's Score: %cpu% Your Score: %you%
echo.
<nul set /p "dummy=Heads I start, Tails you start..."
set /a startrnd=%random%%%2
set firsttoss=Tails&set func=optimal
if %startrnd%==1 (set firsttoss=Heads&set func=rndbet)
ping -n 3 localhost >nul
<nul set /p "dummy=.   %firsttoss%^!"
echo.&echo.
goto %func%

:rndbet
set /a "seq1=%random%%%2","seq2=%random%%%2","seq3=%random%%%2"
set binary=%seq1%%seq2%%seq3%
set cpu_bet=%binary:1=H%
set cpu_bet=%cpu_bet:0=T%
echo I will bet first. So, my bet sequence will be %cpu_bet%.
:again1
set /p "you_bet=What will be your bet sequence? "
call :validate again1
echo.&echo So, you're feeling lucky on %you_bet%. We'll see...
goto succesivetossing

:optimal
echo Ok. You will bet first.
:again2
set /p "you_bet=What will be your bet sequence? "
call :validate again2
set seq1=%you_bet:~0,1%&set seq2=%you_bet:~1,1%
set new_seq1=T
if /i %seq2%==T set new_seq1=H
set cpu_bet=%new_seq1%%seq1%%seq2%
echo.&echo Hmm... My bet will be %cpu_bet%. We'll see who's lucky...

:succesivetossing
set toses=&set cnt=0
echo.
<nul set /p "dummy=Tosses:    "
:tossloop
call :tossgen
<nul set /p dummy=%toss%
ping -n 2 localhost >nul
set /a newline=%cnt%%%60
if %newline%==59 (
echo.
<nul set /p "dummy=.          "
)
if "%toses:~-3,3%"=="%cpu_bet%" goto iwin
if "%toses:~-3,3%"=="%you_bet%" goto uwin
set /a cnt+=1&goto tossloop

:tossgen
set /a rand=%random%%%2
set toss=T
if %rand%==0 set toss=H
set toses=%toses%%toss%
goto :EOF

:iwin
set /a cpu+=1&set newgame=
echo.&echo.
echo I Win^^! Better Luck Next Time...
echo.
set /p "newgame=[Type Y if U Wanna Beat Me, or Else, Exit...] "
if /i "!newgame!"=="Y" goto :main
exit

:uwin
set /a you+=1&set newgame=
echo.&echo.
echo Argh, You Win^^! ...But One Time I'll Beat You.
echo.
set /p "newgame=[Type Y for Another Game, or Else, Exit...] "
if /i "!newgame!"=="Y" goto :main
exit

:validate
echo "!you_bet!"|findstr /r /c:"^\"[hHtT][hHtT][hHtT]\"$">nul || (
	echo [Invalid Input...]&echo.&goto %1
)
if /i "!you_bet!"=="%cpu_bet%" (echo [Bet something different...]&echo.&goto %1)
for %%i in ("t=T" "h=H") do set "you_bet=!you_bet:%%~i!"
goto :EOF