PROGRAM MAGIC_SQUARE

!$INTEGER

PROCEDURE Magicsq(size,filename$)

LOCAL DIM sq[25,25] ! array to hold square

IF (size AND 1)=0 OR size<3 THEN
     PRINT PRINT(CHR$(7)) ! beep
     PRINT("error: size is not odd or size is smaller then 3")
     PAUSE(3)
     EXIT PROCEDURE
END IF

! filename$ <> "" then save magic square in a file
! filename$ can contain directory name
! if filename$ exist it will be overwriten, no error checking

! start in the middle of the first row
   nr=1   x=size-(size DIV 2) y=1
   max=size*size

! create format string for using
   frmt$=STRING$(LEN(STR$(max)),"#")

! main loop for creating magic square
   REPEAT
      IF sq[x,y]=0 THEN
        sq[x,y]=nr
        IF nr MOD size=0 THEN
           y=y+1
         ELSE
           x=x+1
           y=y-1
        END IF
        nr=nr+1
      END IF
      IF x>size THEN
         x=1
         WHILE sq[x,y]<>0 DO
            x=x+1
         END WHILE
      END IF
      IF y<1 THEN
         y=size
         WHILE sq[x,y]<>0 DO
            y=y-1
         END WHILE
      END IF
   UNTIL nr>max

! printing square's bigger than 19 result in a wrapping of the line
   PRINT("Odd magic square size:";size;"*";size)
   PRINT("The magic sum =";((max+1) DIV 2)*size)
   PRINT

   FOR y=1 TO size DO
      FOR x=1 TO size DO
          WRITE(frmt$;sq[x,y];)
      END FOR
      PRINT
   END FOR

  ! output magic square to a file with the name provided
  IF filename$<>"" THEN
        OPEN("O",1,filename$)
           PRINT(#1,"Odd magic square size:";size;" *";size)
           PRINT(#1,"The magic sum =";((max+1) DIV 2)*size)
           PRINT(#1,)

           FOR y=1 TO size DO
             FOR x=1 TO size DO
               WRITE(#1,frmt$;sq[x,y];)
             END FOR
             PRINT(#1,)
           END FOR
  END IF
  CLOSE(1)

END PROCEDURE

BEGIN
PRINT(CHR$(12);)  ! CLS
Magicsq(5,"")
Magicsq(11,"")
!----------------------------------------------------
! the next line will also print the square to a file
! called 'magic_square_19txt'
!----------------------------------------------------
Magicsq(19,"msq_19.txt")

END PROGRAM


USING: formatting io kernel math math.matrices math.ranges
sequences sequences.extras ;
IN: rosetta-code.magic-squares-odd

: inc-matrix ( n -- matrix )
    [ 0 ] dip dup [ 1 + dup ] make-matrix nip ;

: rotator ( n -- seq ) 2/ dup [ neg ] dip [a,b] ;

: odd-magic-square ( n -- matrix )
    [ inc-matrix ] [ rotator [ rotate ] 2map flip ] dup tri ;

: show-square ( n -- )
    dup "Order: %d\n" printf odd-magic-square dup
    [ [ "%4d" printf ] each nl ] each first sum
    "Magic number: %d\n\n" printf ;

3 5 11 [ show-square ] [email protected]


program Magic_Square
  implicit none

  integer, parameter :: order = 15
  integer :: i, j

  write(*, "(a, i0)") "Magic Square Order: ", order
  write(*, "(a)")     "----------------------"
  do i = 1, order
    do j = 1, order
      write(*, "(i4)", advance = "no") f1(order, i, j)
    end do
    write(*,*)
  end do
  write(*, "(a, i0)") "Magic number = ", f2(order)

contains

integer function f1(n, x, y)
  integer, intent(in) :: n, x, y

  f1 = n * mod(x + y - 1 + n/2, n) + mod(x + 2*y - 2, n) + 1
end function

integer function f2(n)
  integer, intent(in) :: n

  f2 = n * (1 + n * n) / 2
end function
end program


' version 23-06-2015
' compile with: fbc -s console

Sub magicsq(size As Integer, filename As String ="")

    If (size And 1) = 0 Or size < 3 Then
        Print : Beep ' alert
        Print "error: size is not odd or size is smaller then 3"
        Sleep 3000,1  'wait 3 seconds, ignore key press
        Exit Sub
    End If

    ' filename <> "" then save magic square in a file
    ' filename can contain directory name
    ' if filename exist it will be overwriten, no error checking

    Dim As Integer sq(size,size) ' array to hold square
    ' start in the middle of the first row
    Dim As Integer nr = 1, x = size - (size \ 2), y = 1
    Dim As Integer max = size * size
    ' create format string for using
    Dim As String frmt = String(Len(Str(max)) +1, "#")

    ' main loop for creating magic square
    Do
        If sq(x, y) = 0 Then
            sq(x, y) = nr
            If nr Mod size = 0 Then
                y += 1
            Else
                x += 1
                y -= 1
            End If
            nr += 1
        End If
        If x > size Then
            x = 1
            Do While sq(x,y) <> 0
                x += 1
            Loop
        End If
        If y < 1 Then
            y = size
            Do While sq(x,y) <> 0
                y -= 1
            Loop
        EndIf
    Loop Until nr > max

    ' printing square's bigger than 19 result in a wrapping of the line
    Print "Odd magic square size:"; size; " *"; size
    Print "The magic sum ="; ((max +1) \ 2) * size
    Print

    For y = 1 To size
        For x = 1 To size
            Print Using frmt; sq(x,y);
        Next
        Print
    Next
    print

    ' output magic square to a file with the name provided
    If filename <> "" Then
        nr = FreeFile
        Open filename For Output As #nr
        Print #nr, "Odd magic square size:"; size; " *"; size
        Print #nr, "The magic sum ="; ((max +1) \ 2) * size
        Print #nr,

        For y = 1 To size
            For x = 1 To size
                Print #nr, Using frmt; sq(x,y);
            Next
            Print #nr,
        Next
    End If
    Close

End Sub

' ------=< MAIN >=------

magicsq(5)
magicsq(11)
' the next line will also print the square to a file called: magic_square_19.txt
magicsq(19, "magic_square_19.txt")

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


order = length[ARGS] > 0 ? eval[[email protected]] : undef
until isInteger[order] and order mod 2 == 1
   order = eval[input["Enter order (must be odd): ", 3]]

a = new array[[order, order], undef]
x = order div 2
y = 0

for i = 1 to order^2
{
   ny = (y - 1) mod order
   nx = (x + 1) mod order
   if [email protected]@nx != undef
   {
      nx = x
      ny = (y + 1) mod order
   }
   [email protected]@x = i
   y = ny
   x = nx
}

println[formatTable[a]]
println["Magic number is " + sum[[email protected]]]


package main

import (
    "fmt"
    "log"
)

func ms(n int) (int, []int) {
    M := func(x int) int { return (x + n - 1) % n }
    if n <= 0 || n&1 == 0 {
        n = 5
        log.Println("forcing size", n)
    }
    m := make([]int, n*n)
    i, j := 0, n/2
    for k := 1; k <= n*n; k++ {
        m[i*n+j] = k
        if m[M(i)*n+M(j)] != 0 {
            i = (i + 1) % n
        } else {
            i, j = M(i), M(j)
        }
    }
    return n, m
}

func main() {
    n, m := ms(5)
    i := 2
    for j := 1; j <= n*n; j *= 10 {
        i++
    }
    f := fmt.Sprintf("%%%dd", i)
    for i := 0; i < n; i++ {
        for j := 0; j < n; j++ {
            fmt.Printf(f, m[i*n+j])
        }
        fmt.Println()
    }
}


-- as a translation from imperative code, this is probably not a "good" implementation
import Data.List

type Var = (Int, Int, Int, Int) -- sx sy sz c

magicSum :: Int -> Int
magicSum x = ((x * x + 1) `div` 2) * x

wrapInc :: Int -> Int -> Int
wrapInc max x
   | x + 1 == max    = 0
   | otherwise       = x + 1

wrapDec :: Int -> Int -> Int
wrapDec max x
   | x == 0    = max - 1
   | otherwise = x - 1

isZero :: [[Int]] -> Int -> Int -> Bool
isZero m x y = m !! x !! y == 0

setAt :: (Int,Int) -> Int -> [[Int]] -> [[Int]]
setAt (x, y) val table
   | (upper, current : lower) <- splitAt x table,
     (left, this : right) <- splitAt y current
         = upper ++ (left ++ val : right) : lower
   | otherwise = error "Outside"

create :: Int -> [[Int]]
create x = replicate x $ replicate x 0

cells :: [[Int]] -> Int
cells m = x*x where x = length m

fill :: Var -> [[Int]] -> [[Int]]
fill (sx, sy, sz, c) m
   | c < cells m =
      if isZero m sx sy
      then fill ((wrapInc sz sx), (wrapDec sz sy), sz, c + 1) (setAt (sx, sy) (c + 1) m)
      else fill ((wrapDec sz sx), (wrapInc sz(wrapInc sz sy)), sz, c) m
   | otherwise = m

magicNumber :: Int -> [[Int]]
magicNumber d = transpose $ fill (d `div` 2, 0, d, 0) (create d)

display :: [[Int]] -> String
display (x:xs)
   | null xs = vdisplay x
   | otherwise = vdisplay x ++ ('\n' : display xs)

vdisplay :: [Int] -> String
vdisplay (x:xs)
   | null xs = show x
   | otherwise = show x ++ " " ++ vdisplay xs

magicSquare x = do
   putStr "Magic Square of "
   putStr $ show x
   putStr " = "
   putStrLn $ show $ magicSum x
   putStrLn $ display $ magicNumber x


procedure main(A)
    n := integer(!A) | 3
    write("Magic number: ",n*(n*n+1)/2)
    sq := buildSquare(n)
    showSquare(sq)
end

procedure buildSquare(n)
    sq := [: |list(n)\n :]
    r := 0
    c := n/2
    every i := !(n*n) do {
        /sq[r+1,c+1] := i
        nr := (n+r-1)%n
        nc := (c+1)%n
        if /sq[nr+1,nc+1] then (r := nr,c := nc) else r := (r+1)%n
        }
    return sq
end

procedure showSquare(sq)
    n := *sq
    s := *(n*n)+2
    every r := !sq do every writes(right(!r,s)|"\n")
end


ms=: i:@<[email protected]: |."_1&|:^:2 >:@[email protected],~


public class MagicSquare {

    public static void main(String[] args) {
        int n = 5;
        for (int[] row : magicSquareOdd(n)) {
            for (int x : row)
                System.out.format("%2s ", x);
            System.out.println();
        }
        System.out.printf("\nMagic constant: %d ", (n * n + 1) * n / 2);
    }

    public static int[][] magicSquareOdd(final int base) {
        if (base % 2 == 0 || base < 3)
            throw new IllegalArgumentException("base must be odd and > 2");

        int[][] grid = new int[base][base];
        int r = 0, number = 0;
        int size = base * base;

        int c = base / 2;
        while (number++ < size) {
            grid[r][c] = number;
            if (r == 0) {
                if (c == base - 1) {
                    r++;
                } else {
                    r = base - 1;
                    c++;
                }
            } else {
                if (c == base - 1) {
                    r--;
                    c = 0;
                } else {
                    if (grid[r - 1][c + 1] == 0) {
                        r--;
                        c++;
                    } else {
                        r++;
                    }
                }
            }
        }
        return grid;
    }
}


(function () {

  // n -> [[n]]
  function magic(n) {
    return n % 2 ? rotation(
      transposed(
        rotation(
          table(n)
        )
      )
    ) : null;
  }

  // [[a]] -> [[a]]
  function rotation(lst) {
    return lst.map(function (row, i) {
      return rotated(
        row, ((row.length + 1) / 2) - (i + 1)
      );
    })
  }

  // [[a]] -> [[a]]
  function transposed(lst) {
    return lst[0].map(function (col, i) {
      return lst.map(function (row) {
        return row[i];
      })
    });
  }

  // [a] -> n -> [a]
  function rotated(lst, n) {
    var lng = lst.length,
      m = (typeof n === 'undefined') ? 1 : (
        n < 0 ? lng + n : (n > lng ? n % lng : n)
      );

    return m ? (
      lst.slice(-m).concat(lst.slice(0, lng - m))
    ) : lst;
  }

  // n -> [[n]]
  function table(n) {
    var rngTop = rng(1, n);

    return rng(0, n - 1).map(function (row) {
      return rngTop.map(function (x) {
        return row * n + x;
      });
    });
  }

  // [m..n]
  function rng(m, n) {
    return Array.apply(null, Array(n - m + 1)).map(
      function (x, i) {
        return m + i;
      });
  }

  /******************** TEST WITH 3, 5, 11 ***************************/

  // Results as right-aligned wiki tables
  function wikiTable(lstRows, blnHeaderRow, strStyle) {
    var css = strStyle ? 'style="' + strStyle + '"' : '';

    return '{| class="wikitable" ' + css + lstRows.map(
      function (lstRow, iRow) {
        var strDelim = ((blnHeaderRow && !iRow) ? '!' : '|'),
          strDbl = strDelim + strDelim;

        return '\n|-\n' + strDelim + ' ' + lstRow.join(' ' + strDbl + ' ');
      }).join('') + '\n|}';
  }

  return [3, 5, 11].map(
    function (n) {
      var w = 2.5 * n;
      return 'magic(' + n + ')\n\n' + wikiTable(
        magic(n), false, 'text-align:center;width:' + w + 'em;height:' + w + 'em;table-layout:fixed;'
      )
    }
  ).join('\n\n')
})();


def odd_magic_square:
  if type != "number" or . % 2 == 0 or . <= 0
  then error("odd_magic_square requires an odd positive integer")
  else
    . as $n
    | reduce range(1; 1 + ($n*$n)) as $i
         ( [0, (($n-1)/2), []];
 	  .[0] as $x | .[1] as $y
          | .[2]
	  | setpath([$x, $y]; $i )
          | if getpath([(($x+$n-1) % $n), (($y+$n+1) % $n)])
            then [(($x+$n+1) % $n), $y, .]
            else [ (($x+$n-1) % $n), (($y+$n+1) % $n), .]
 	    end )  | .[2]
  end ;


# v0.6.0

function magicsquareodd(base::Int)
    if base & 1 == 0 || base < 3; error("base must be odd and >3") end

    square = fill(0, base, base)
    r, number = 1, 1
    size = base * base

    c = div(base, 2) + 1
    while number ≤ size
        square[r, c] = number
        fr = r == 1 ? base : r - 1
        fc = c == base ? 1 : c + 1
        if square[fr, fc] != 0
            fr = r == base ? 1 : r + 1
            fc = c
        end
        r, c = fr, fc
        number += 1
    end

    return square
end

for n in 3:2:7
    println("Magic square with size $n - magic constant = ", div(n ^ 3 + n, 2))
    println("----------------------------------------------------")
    square = magicsquareodd(n)
    for i in 1:n
        println(square[i, :])
    end
    println()
end


// version 1.0.6

fun f(n: Int, x: Int, y: Int) = (x + y * 2 + 1) % n

fun main(args: Array<String>) {
    var n: Int
    while (true) {
        print("Enter the order of the magic square : ")
        n = readLine()!!.toInt()
        if (n < 1 || n % 2 == 0) println("Must be odd and >= 1, try again")
        else break
    }
    println()
    for (i in 0 until n) {
        for (j in 0 until n) print("%4d".format(f(n, n - j - 1, i) * n + f(n, j, i) + 1))
        println()
    }
    println("\nThe magic constant is ${(n * n + 1) / 2 * n}")
}


Dim m(1,1)

Call magicSquare 5
Call magicSquare 17

End

Sub magicSquare n
    ReDim m(n,n)
    inc = 1
    count = 1
    row = 1
    col=(n+1)/2
    While count <= n*n
        m(row,col) = count
        count = count + 1
        If inc < n Then
            inc = inc + 1
            row = row - 1
            col = col + 1
            If row <> 0 Then
                If col > n Then col = 1
            Else
                row = n
            End If
        Else
            inc = 1
            row = row + 1
        End If
    Wend
    Call printSquare n
End Sub

Sub printSquare n
    'Arbitrary limit to fit width of A4 paper
    If n < 23 Then
        Print n;" x ";n;" Magic Square --- ";
        Print "Magic constant is ";Int((n*n+1)/2*n)
        For row = 1 To n
            For col = 1 To n
                Print Using("####",m(row,col));
            Next col
            Print
            Print
        Next row
    Else
        Notice "Magic Square will not fit on one sheet of paper."
    End If
End Sub


rp[v_, pos_] := RotateRight[v, (Length[v] + 1)/2 - pos];
rho[m_] := MapIndexed[rp, m];
magic[n_] :=
  rho[Transpose[rho[Table[i*n + j, {i, 0, n - 1}, {j, 1, n}]]]];

square = magic[11] // Grid
Print["Magic number is ", Total[square[[1, 1]]]]


wrap1(i):= if i>%n% then 1 else if i<1 then %n% else i;
wrap(P):=maplist('wrap1, P);

uprigth(P):= wrap(P + [-1, 1]);
down(P):= wrap(P + [1, 0]);

magic(n):=block([%n%: n,
  M: zeromatrix (n, n),
  P: [1, (n + 1)/2],
  m: 1, Pc],
  do (
    M[P[1],P[2]]: m,
    m: m + 1,
    if m>n^2 then return(M),
    Pc: uprigth(P),
    if M[Pc[1],Pc[2]]=0 then P: Pc
    else while(M[P[1],P[2]]#0) do P: down(P)));


import strutils

proc magic(n: int) =
  let length = len($(n * n))
  for row in 1 .. n:
    for col in 1 .. n:
      let cell = (n * ((row + col - 1 + n div 2) mod n) +
                  ((row + 2 * col - 2) mod n) + 1)
      stdout.write ($cell).align(length), ' '
    echo ""
  echo "\nAll sum to magic number ", (n * n + 1) * n div 2

for n in [3, 5, 7]:
  echo "\nOrder ", n, "\n======="
  magic(n)


: magicSquare(n)
| i j wd |
   n sq log asInteger 1+ ->wd
   n loop: i [
      n loop: j [
         i j + 1- n 2 / + n mod n *
         i j + j + 2 - n mod 1 + +
         System.Out swap <<w(wd) " " << drop
         ]
      printcr
      ]
   System.Out "Magic constant is : " << n sq 1 + 2 / n * << cr ;


PROGRAM magic;
(* Magic squares of odd order *)
CONST
  n=9;
VAR
  i,j :INTEGER;
BEGIN (*magic*)
  WRITELN('The square order is: ',n);
  FOR i:=1 TO n DO
  BEGIN
    FOR j:=1 TO n DO
      WRITE((i*2-j+n-1) MOD n*n + (i*2+j-2) MOD n+1:5);
    WRITELN
  END;
  WRITELN('The magic number is: ',n*(n*n+1) DIV 2)
END (*magic*).


with javascript_semantics
function magic_square(integer n)
    if mod(n,2)!=1 or n<1 then return false end if
    sequence square = repeat(repeat(0,n),n)
    for i=1 to n do
        for j=1 to n do
            square[i,j] = n*mod(2*i-j+n-1,n) + mod(2*i+j-2,n) + 1
        end for
    end for
    return square
end function

procedure check(sequence sq)
    integer n = length(sq)
    integer magic = n*(n*n+1)/2
    integer bd=0, fd=0
    for i=1 to length(sq) do
        if sum(sq[i])!=magic then ?9/0 end if
        if sum(columnize(sq,i))!=magic then ?9/0 end if
        bd += sq[i,i]
        fd += sq[n-i+1,n-i+1]
    end for
    if bd!=magic or fd!=magic then ?9/0 end if
end procedure

for i=1 to 7 by 2 do
    sequence square = magic_square(i)
    printf(1,"maqic square of order %d, sum: %d\n", {i,sum(square[i])})
    string fmt = sprintf("%%%dd",length(sprintf("%d",i*i)))
    pp(square,{pp_Nest,1,pp_IntFmt,fmt,pp_StrFmt,3,pp_IntCh,false,pp_Pause,0})
    check(square)
end for


import util.

go =>
  foreach(N in [3,5,17])
    M=magic_square(N),
    print_matrix(M),
    check(M),
    nl
  end,
  nl.

%
% Not as nice as the J solution.
% But I like the chaining of the functions.
%
magic_square(N) = MS =>
  if N mod 2 = 0 then
     printf("N (%d) is not odd!\n", N),
     halt
  end,
  R = make_rotate_list(N), % the rotate indices
  MS = make_square(N).transpose().rotate_matrix(R).transpose().rotate_matrix(R).

%
% make a square matrix of size N (containing the numbers 1..N*N)
%
make_square(N) = [[I*N+J : J in 1..N]: I in 0..N-1].

%
% rotate list:
%   rotate_list(11) = [-5,-4,-3,-2,-1,0,1,2,3,4,5]
%
make_rotate_list(N) = [I - ceiling(N / 2) : I in 1..N].

%
% rotate the matrix M according to rotate list R
%
rotate_matrix(M, R) = [rotate_n(Row,N) : {Row,N} in zip(M,R)].

%
% Rotate the list L N steps (either positive or negative N)
%   rotate(1..10,3) -> [4,5,6,7,8,9,10,1,2,3]
%   rotate(1..10,-3) -> [8,9,10,1,2,3,4,5,6,7]
%
rotate_n(L,N) = Rot =>
  Len = L.length,
  R = cond(N < 0, Len + N, N),
  Rot = [L[I] : I in (R+1..Len) ++ 1..R].

%
% Check if M is a magic square
%
check(M) =>
  N = M.length,
  Sum = N*(N*N+1) // 2, % The correct sum.
  println(sum=Sum),
  Rows = [sum(Row) : Row in M],
  Cols = [sum(Col) : Col in M.transpose()],
  Diag1 = sum([M[I,I] : I in 1..N]),
  Diag2 = sum([M[I,N-I+1] : I in 1..N]),
  All = Rows ++ Cols ++ [Diag1, Diag2],
  OK = true,
  foreach(X in All)
    if X != Sum then
      printf("%d != %d\n", X, Sum),
      OK := false
    end
  end,
  if OK then
    println(ok)
  else
    println(not_ok)
  end,
  nl.

% Print the matrix
print_matrix(M) =>
  N = M.len,
  printf("N=%d\n",N),
  Format = to_fstring("%%%dd",max(flatten(M)).to_string().length+1),
  foreach(Row in M)
     foreach(X in Row)
       printf(Format, X)
     end,
     nl
  end,
  nl.


(load "@lib/simul.l")
(de magic (A)
   (let
      (Grid (grid A A T T)
         Sum (/ (* A (inc (** A 2))) 2))
      (println 'N A 'Sum Sum)
      # cut one important edge
      (with (last (last Grid)) (con (: 0 1)))
      (with (get Grid (inc (/ A 2)) A)
         (for N (* A A)
            (=: V N)
            (setq This
               (if
                  (with (setq @@ (north (east This)))
                     (not (: V)) )
                  @@
                  (south This) ) ) ) )
      # display
      (mapc
         '((L)
            (for This L
               (prin (align 4 (: V))) )
            (prinl) )
         Grid )
      # clean
      (mapc '((L) (mapc zap L)) Grid) ) )
(magic 5)
(prinl)
(magic 7)


magic: procedure options (main);  /* 18 April 2014 */
   declare n fixed binary;

   put skip list ('What is the order of the magic square?');
   get list (n);
   if n < 3 | iand(n, 1) = 0 then
      do; put skip list ('The value is out of range'); stop; end;
   put skip list ('The order is ' || trim(n));

   begin;
      declare m(n, n) fixed, (i, j, k) fixed binary;

      on subrg snap put data (i, j, k);
      m = 0;
      i = 1; j = (n+1)/2;

      do k = 1 to n*n;
         if m(i,j) = 0 then
            m(i,j) = k;
         else
            do;
               i = i + 2; j = j + 1;
               if i > n then i = mod(i,n);
               if j > n then j = 1;
               m(i,j) = k;
            end;
         i = i - 1; j = j - 1;
         if i < 1 then i = n;
         if j < 1 then j = n;
      end;

      do i = 1 to n;
         put skip edit (m(i, *)) (f(4));
      end;

      put skip list ('The magic number is' || sum(m(1,*)));
   end;
end magic;


#N=9
Define.i i,j

If OpenConsole("Magic squares")
  PrintN("The square order is: "+Str(#N))
  For i=1 To #N
    For j=1 To #N
      Print(RSet(Str((i*2-j+#N-1) % #N*#N + (i*2+j-2) % #N+1),5))
    Next
    PrintN("")
  Next
  PrintN("The magic number is: "+Str(#N*(#N*#N+1)/2))
EndIf
Input()


_Title "Magic Squares of Odd Order"
'$Dynamic
DefLng A-Z
Dim Shared As Long m(1, 1)

Call magicSquare(5)
Call magicSquare(15)

Sleep
System

Sub magicSquare (n As Integer)
    Dim As Integer inc, count, row, col

    If (n < 3) Or (n And 1) <> 1 Then n = 3
    ReDim m(n, n)
    inc = 1
    count = 1
    row = 1
    col = (n + 1) / 2
    While count <= n * n
        m(row, col) = count
        count = count + 1
        If inc < n Then
            inc = inc + 1
            row = row - 1
            col = col + 1
            If row <> 0 Then
                If col > n Then col = 1
            Else
                row = n
            End If
        Else
            inc = 1
            row = row + 1
        End If
    Wend
    Call printSquare(n)
End Sub

Sub printSquare (n As Integer)
    Dim As Integer row, col
    'Arbitrary limit ensures a fit within console window
    'Can be any size that fits within your computers memory limits
    If n < 21 Then
        Print "Order "; n; " Magic Square constant is "; Str$(Int((n * n + 1) / 2 * n))
        For row = 1 To n
            For col = 1 To n
                Print Using "####"; m(row, col);
            Next col
            Print
            ' Print
        Next row
    End If
End Sub


#lang racket
;; Using "helpful formulae" in:
;; http://en.wikipedia.org/wiki/Magic_square#Method_for_constructing_a_magic_square_of_odd_order
(define (squares n) n)

(define (last-no n) (sqr n))

(define (middle-no n) (/ (add1 (sqr n)) 2))

(define (M n) (* n (middle-no n)))

(define ((Ith-row-Jth-col n) I J)
  (+ (* (modulo (+ I J -1 (exact-floor (/ n 2))) n) n)
     (modulo (+ I (* 2 J) -2) n)
     1))

(define (magic-square n)
  (define IrJc (Ith-row-Jth-col n))
  (for/list ((I (in-range 1 (add1 n)))) (for/list ((J (in-range 1 (add1 n)))) (IrJc I J))))

(define (fmt-list-of-lists l-o-l width)
  (string-join
   (for/list ((row l-o-l))
     (string-join (map (λ (x) (~a #:align 'right #:width width x)) row) "  "))
   "\n"))

(define (show-magic-square n)
  (format "MAGIC SQUARE ORDER:~a~%~a~%MAGIC NUMBER:~a~%"
          n (fmt-list-of-lists (magic-square n) (+ (order-of-magnitude (last-no n)) 1)) (M n)))

(displayln (show-magic-square 3))
(displayln (show-magic-square 5))
(displayln (show-magic-square 9))


/*REXX program generates and displays magic squares (odd N will be a true magic square).*/
parse arg N .                                    /*obtain the optional argument from CL.*/
if N=='' | N==","  then N=5                      /*Not specified?  Then use the default.*/
NN=N*N;    w=length(NN)                          /*W:  width of largest number (output).*/
r=1;       c=(n+1) % 2                           /*define the initial  row  and  column.*/
@.=.                                             /*assign a default value for entire  @.*/
    do j=1  for NN                               /* [↓]  filling uses the Siamese method*/
    if r<1 & c>N then do; r=r+2;  c=c-1;  end    /*the  row   is under,  column is over.*/
    if r<1       then r=N                        /* "    "     "   "     make row=last. */
    if r>N       then r=1                        /* "    "     "  over,    "   "  first.*/
    if c>N       then c=1                        /* "  column  "  over,    "  col=first.*/
    if @.r.c\==. then do; r=min(N,r+2);  c=max(1,c-1);  end     /*at the previous cell? */
    @.r.c=j;              r=r-1;  c=c+1          /*assign # ───► cell; next row & column*/
    end   /*j*/
                                                 /* [↓]  display square with aligned #'s*/
          do   r=1  for N;  _=                   /*display  one matrix row  at a time.  */
            do c=1  for N;  _=_ right(@.r.c, w)  /*construct a row of the magic square. */
            end   /*c*/
          say substr(_, 2)                       /*display a row of the magic square.   */
          end     /*r*/
say                                              /* [↓]  If an odd square, show magic #.*/
if N//2  then say  'The magic number  (or magic constant is): '         N * (NN+1) % 2
                                                 /*stick a fork in it,  we're all done. */


n=9
see "the square order is : " + n + nl
for i=1 to n
    for j = 1 to n
        x = (i*2-j+n-1) % n*n + (i*2+j-2) % n + 1
        see "" + x + " "
    next
    see nl
next
see "the magic number is : " + n*(n*n+1) / 2 + nl


def odd_magic_square(n)
  raise ArgumentError "Need odd positive number" if n.even? || n <= 0
  n.times.map{|i| n.times.map{|j| n*((i+j+1+n/2)%n) + ((i+2*j-5)%n) + 1} }
end

[3, 5, 9].each do |n|
  puts "\nSize #{n}, magic sum #{(n*n+1)/2*n}"
  fmt = "%#{(n*n).to_s.size + 1}d" * n
  odd_magic_square(n).each{|row| puts fmt % row}
end


fn main() {
    let n = 9;
    let mut square = vec![vec![0; n]; n];
    for (i, row) in square.iter_mut().enumerate() {
        for (j, e) in row.iter_mut().enumerate() {
            *e = n * (((i + 1) + (j + 1) - 1 + (n >> 1)) % n) + (((i + 1) + (2 * (j + 1)) - 2) % n) + 1;
            print!("{:3} ", e);
        }
        println!("");
    }
    let sum = n * (((n * n) + 1) / 2);
    println!("The sum of the square is {}.", sum);
}


  def magicSquare( n:Int ) : Option[Array[Array[Int]]] = {
    require(n % 2 != 0, "n must be an odd number")

    val a = Array.ofDim[Int](n,n)

    // Make the horizontal by starting in the middle of the row and then taking a step back every n steps
    val ii = Iterator.continually(0 to n-1).flatten.drop(n/2).sliding(n,n-1).take(n*n*2).toList.flatten

    // Make the vertical component by moving up (subtracting 1) but every n-th step, step down (add 1)
    val jj = Iterator.continually(n-1 to 0 by -1).flatten.drop(n-1).sliding(n,n-2).take(n*n*2).toList.flatten

    // Combine the horizontal and vertical components to create the path
    val path = (ii zip jj) take (n*n)

    // Fill the array by following the path
    for( i<-1 to (n*n); p=path(i-1) ) { a(p._1)(p._2) = i }

    Some(a)
  }

  def output() :  Unit = {
    def printMagicSquare(n: Int): Unit = {

      val ms = magicSquare(n)
      val magicsum = (n * n + 1) / 2

      assert(
        if( ms.isDefined ) {
          val a = ms.get
          a.forall(_.sum == magicsum) &&
            a.transpose.forall(_.sum == magicsum) &&
            (for(i<-0 until n) yield { a(i)(i) }).sum == magicsum
        }
        else { false }
      )

      if( ms.isDefined ) {
        val a = ms.get
        for (y <- 0 to n * 2; x <- 0 until n) (x, y) match {
          case (0, 0) => print("╔════╤")
          case (i, 0) if i == n - 1 => print("════╗\n")
          case (i, 0) => print("════╤")

          case (0, j) if j % 2 != 0 => print("║ " + f"${ a(0)((j - 1) / 2) }%2d" + " │")
          case (i, j) if j % 2 != 0 && i == n - 1 => print(" " + f"${ a(i)((j - 1) / 2) }%2d" + " ║\n")
          case (i, j) if j % 2 != 0 => print(" " + f"${ a(i)((j - 1) / 2) }%2d" + " │")

          case (0, j) if j == (n * 2) => print("╚════╧")
          case (i, j) if j == (n * 2) && i == n - 1 => print("════╝\n")
          case (i, j) if j == (n * 2) => print("════╧")

          case (0, _) => print("╟────┼")
          case (i, _) if i == n - 1 => print("────╢\n")
          case (i, _) => print("────┼")
        }
      }
    }

    printMagicSquare(7)
  }


$ include "seed7_05.s7i";

const func integer: succ (in integer: num, in integer: max) is
  return succ(num mod max);

const func integer: pred (in integer: num, in integer: max) is
  return succ((num - 2) mod max);

const proc: main is func
  local
    var integer: size is 3;
    var array array integer: magic is 0 times 0 times 0;
    var integer: row is 1;
    var integer: column is 1;
    var integer: number is 0;
  begin
    if length(argv(PROGRAM)) >= 1 then
      size := integer parse (argv(PROGRAM)[1]);
    end if;
    magic := size times size times 0;
    column := succ(size div 2);
    for number range 1 to size ** 2 do
      magic[row][column] := number;
      if magic[pred(row, size)][succ(column, size)] = 0 then
        row := pred(row, size);
        column := succ(column, size);
      else
        row := succ(row, size);
      end if;
    end for;
    for key row range magic do
      for key column range magic[row] do
        write(magic[row][column] lpad 4);
      end for;
      writeln;
    end for;
  end func;


func magic_square(n {.is_pos && .is_odd}) {
    var i = 0
    var j = int(n/2)

    var magic_square = []
    for l in (1 .. n**2) {
        magic_square[i][j] = l

        if (magic_square[i.dec % n][j.inc % n]) {
            i = (i.inc % n)
        }
        else {
            i = (i.dec % n)
            j = (j.inc % n)
        }
    }

    return magic_square
}

func print_square(sq) {
    var f = "%#{(sq.len**2).len}d";
    for row in sq {
        say row.map{ f % _ }.join(' ')
    }
}

var(n=5) = ARGV»to_i»()...
var sq = magic_square(n)
print_square(sq)

say "\nThe magic number is: #{sq[0].sum}"


extension String: Error {}

struct Point: CustomStringConvertible {
    var x: Int
    var y: Int

    init(_ _x: Int,
         _ _y: Int) {
        self.x = _x
        self.y = _y
    }

    var description: String {
        return "(\(x), \(y))\n"
    }
}

extension Point: Equatable,Comparable {
    static func == (lhs: Point, rhs: Point) -> Bool {
        return lhs.x == rhs.x && lhs.y == rhs.y
    }
    static func < (lhs: Point, rhs: Point) -> Bool {
        return lhs.y != rhs.y ? lhs.y < rhs.y : lhs.x < rhs.x
    }
}

class MagicSquare: CustomStringConvertible {
    var grid:[Int:Point] = [:]
    var number: Int = 1
    init(base n:Int) {
        grid = [:]
        number = n
    }

    func createOdd() throws -> MagicSquare {
        guard number < 1 || number % 2 != 0 else {
            throw "Must be odd and >= 1, try again"
            return self
        }
        var x = 0
        var y = 0
        let middle = Int(number/2)
        x = middle
        grid[1] = Point(x,y)
        for i in 2 ... number*number {
            let oldXY = Point(x,y)
            x += 1
            y -= 1

            if x >= number {x -= number}
            if y < 0 {y +=  number}

            var tempCoord = Point(x,y)
            if let _ = grid.firstIndex(where: { (k,v) -> Bool in
                v == tempCoord
            })
            {
                x = oldXY.x
                y = oldXY.y + 1
                if y >= number {y -= number}
                tempCoord = Point(x,y)
            }
            grid[i] = tempCoord
        }
        print(self)
        return self
    }

    fileprivate func gridToText(_ result: inout String) {
        let sorted = sortedGrid()
        let sc = sorted.count
        var i = 0
        for c in sorted {
            result += " \(c.key)"
            if c.key < 10 && sc > 10 { result += " "}
            if c.key < 100 && sc > 100 { result += " "}
            if c.key < 1000 && sc > 1000 { result += " "}
            if i%number==(number-1) { result += "\n"}
            i += 1
        }
        result += "\nThe magic number is \(number * (number * number + 1) / 2)"
        result += "\nRows and Columns are "

        result += checkRows() == checkColumns() ? "Equal" : " Not Equal!"
        result += "\nRows and Columns and Diagonals are "
        let allEqual = (checkDiagonals() == checkColumns() && checkDiagonals() == checkRows())
        result += allEqual ? "Equal" : " Not Equal!"
        result += "\n"
    }

    var description: String {
        var result = "base \(number)\n"
        gridToText(&result)
        return result
    }
}

extension MagicSquare {
    private func sortedGrid()->[(key:Int,value:Point)] {
        return grid.sorted(by: {$0.1 < $1.1})
    }

    private func checkRows() -> (Bool, Int?)
    {
        var result = Set<Int>()
        var index = 0
        var rowtotal = 0
        for (cell, _) in sortedGrid()
        {
            rowtotal += cell
            if index%number==(number-1)
            {
                result.insert(rowtotal)
                rowtotal = 0
            }
            index += 1
        }
        return (result.count == 1, result.first ?? nil)
    }

    private func checkColumns() -> (Bool, Int?)
    {
        var result = Set<Int>()
        var sorted = sortedGrid()
        for i in 0 ..< number {
            var rowtotal = 0
            for cell in stride(from: i, to: sorted.count, by: number) {
                rowtotal += sorted[cell].key
            }
            result.insert(rowtotal)
        }
        return (result.count == 1, result.first)
    }

    private func checkDiagonals() -> (Bool, Int?)
    {
        var result = Set<Int>()
        var sorted = sortedGrid()

        var rowtotal = 0
        for cell in stride(from: 0, to: sorted.count, by: number+1) {
            rowtotal += sorted[cell].key
        }
        result.insert(rowtotal)
        rowtotal = 0
        for cell in stride(from: number-1, to: sorted.count-(number-1), by: number-1) {
            rowtotal += sorted[cell].key
        }
        result.insert(rowtotal)

        return (result.count == 1, result.first)
    }
}

try MagicSquare(base: 3).createOdd()
try MagicSquare(base: 5).createOdd()
try MagicSquare(base: 7).createOdd()


proc magicSquare {order} {
    if {!($order & 1) || $order < 0} {
	error "order must be odd and positive"
    }
    set s [lrepeat $order [lrepeat $order 0]]
    set x [expr {$order / 2}]
    set y 0
    for {set i 1} {$i <= $order**2} {incr i} {
	lset s $y $x $i
	set x [expr {($x + 1) % $order}]
	set y [expr {($y - 1) % $order}]
	if {[lindex $s $y $x]} {
	    set x [expr {($x - 1) % $order}]
	    set y [expr {($y + 2) % $order}]
	}
    }
    return $s
}


9→N
DelVar [A]:{N,N}→dim([A])
For(I,1,N)
For(J,1,N)
Remainder(I*2-J+N-1,N)*N+Remainder(I*2+J-2,N)+1→[A](I,J)
End
End
[A]


' ------=< MAIN >=------

Proc _magicsq(5)
Proc _magicsq(11)
End

_magicsq Param (1) Local (4)

    ' reset the array
    For [email protected] = 0 to 255
        @([email protected]) = 0
    Next

    If  (([email protected] % 2) = 0) + ([email protected] < 3) + ([email protected] > 15) Then
        Print "error: size is not odd or size is smaller then 3 or bigger than 15"
        Return
    EndIf

    ' start in the middle of the first row
    [email protected] = 1
    [email protected] = [email protected] - ([email protected] / 2)
    [email protected] = 1
    [email protected] = [email protected] * [email protected]

    ' main loop for creating magic square
    Do
        If @([email protected]*[email protected][email protected]) = 0 Then
            @([email protected]*[email protected][email protected]) = [email protected]
            If ([email protected] % [email protected]) = 0 Then
                [email protected] = [email protected] + 1
            Else
                [email protected] = [email protected] + 1
                [email protected] = [email protected] - 1
            EndIf
            [email protected] = [email protected] + 1
        EndIf
        If [email protected] > [email protected] Then
            [email protected] = 1
            Do While @([email protected]*[email protected][email protected]) # 0
                [email protected] = [email protected] + 1
            Loop
        EndIf
        If [email protected] < 1 Then
            [email protected] = [email protected]
            Do While @([email protected]*[email protected][email protected]) # 0
                [email protected] = [email protected] - 1
            Loop
        EndIf
    Until [email protected] > [email protected]
    Loop

    Print "Odd magic square size: "; [email protected]; " * "; [email protected]
    Print "The magic sum = "; (([email protected]+1) / 2) * [email protected]
    Print

    For [email protected] = 1 To [email protected]
        For [email protected] = 1 To [email protected]
            Print Using "____"; @([email protected]*[email protected][email protected]);
        Next
        Print
    Next
    Print
Return


Sub magicsquare()
    'Magic squares of odd order
    Const n = 9
    Dim i As Integer, j As Integer, v As Integer
    Debug.Print "The square order is: " & n
    For i = 1 To n
        For j = 1 To n
            Cells(i, j) = ((i * 2 - j + n - 1) Mod n) * n + ((i * 2 + j - 2) Mod n) + 1
        Next j
    Next i
    Debug.Print "The magic number of"; n; "x"; n; "square is:"; n * (n * n + 1) \ 2
End Sub 'magicsquare


Sub magic_square(n)
	Dim ms()
	ReDim ms(n-1,n-1)
	inc = 0
	count = 1
	row = 0
	col = Int(n/2)
	Do While count <= n*n
		ms(row,col) = count
		count = count + 1
		If inc < n-1 Then
			inc = inc + 1
			row = row - 1
			col = col + 1
			If row >= 0 Then
				If col > n-1 Then
					col = 0
				End If
			Else
				row = n-1
			End If
		Else
			inc = 0
			row = row + 1
		End If
	Loop
	For i = 0 To n-1
		For j = 0 To n-1
			If j = n-1 Then
				WScript.StdOut.Write ms(i,j)
			Else
				WScript.StdOut.Write ms(i,j) & vbTab
			End If
		Next
		WScript.StdOut.WriteLine
	Next
End Sub

magic_square(5)


Sub magicsquare()
    'Magic squares of odd order
    Const n = 9
    Dim i As Integer, j As Integer, v As Integer
    Debug.Print "The square order is: " & n
    For i = 1 To n
        For j = 1 To n
            v = ((i * 2 - j + n - 1) Mod n) * n + ((i * 2 + j - 2) Mod n) + 1
            Debug.Print Right(Space(5) & v, 5);
        Next j
        Debug.Print
    Next i
    Debug.Print "The magic number is: " & n * (n * n + 1) \ 2
End Sub 'magicsquare


Sub magicsquare()
    'Magic squares of odd order
    Const n = 9
    Dim i, j, v As Integer
    Console.WriteLine("The square order is: " & n)
    For i = 1 To n
        For j = 1 To n
            v = ((i * 2 - j + n - 1) Mod n) * n + ((i * 2 + j - 2) Mod n) + 1
            Console.Write(" " & Right(Space(5) & v, 5))
        Next j
        Console.WriteLine("")
    Next i
    Console.WriteLine("The magic number is: " & n * (n * n + 1) \ 2)
End Sub 'magicsquare


import "/fmt" for Fmt

var ms = Fn.new { |n|
    var M = Fn.new { |x| (x + n - 1) % n }
    if (n <= 0 || n&1 == 0) {
        n = 5
        System.print("forcing size %(n)")
    }
    var m = List.filled(n * n, 0)
    var i = 0
    var j = (n/2).floor
    for (k in 1..n*n) {
        m[i*n + j] = k
        if (m[M.call(i)*n + M.call(j)] != 0) {
            i = (i + 1) % n
        } else {
            i = M.call(i)
            j = M.call(j)
        }
    }
    return [n, m]
}

var res = ms.call(5)
var n = res[0]
var m = res[1]
for (i in 0...n) {
    for (j in 0...n) System.write(Fmt.d(4, m[i*n+j]))
    System.print()
}
System.print("\nMagic number : %(((n*n + 1)/2).floor * n)")


fcn rmod(n,m){ n=n%m; if (n<0) n+=m; n } // Ruby: -5%3-->1
fcn odd_magic_square(n){ //-->list of n*n numbers, row order
   if (n.isEven or n <= 0) throw(Exception.ValueError("Need odd positive number"));
   [[(i,j); n; n; '{ n*((i+j+1+n/2):rmod(_,n)) + ((i+2*j-5):rmod(_,n)) + 1 }]]
}

T(3, 5, 9).pump(Void,fcn(n){
   "\nSize %d, magic sum %d".fmt(n,(n*n+1)/2*n).println();
   fmt := "%%%dd".fmt((n*n).toString().len() + 1) * n;
   odd_magic_square(n).pump(Console.println,T(Void.Read,n-1),fmt.fmt);
});


F mandelbrot(a)
   R (0.<50).reduce(0i, (z, _) -> z * z + @a)

F step(start, step, iterations)
   R (0 .< iterations).map(i -> @start + (i * @step))

V rows = (step(1, -0.05, 41).map(y -> (step(-2.0, 0.0315, 80).map(x -> (I abs(mandelbrot(x + 1i * @y)) < 2 {‘*’} E ‘ ’)))))
print(rows.map(row -> row.join(‘’)).join("\n"))


(defun abs-sq (z)
   (+ (expt (realpart z) 2)
      (expt (imagpart z) 2)))

(defun round-decimal (x places)
   (/ (floor (* x (expt 10 places)) 1)
      (expt 10 places)))

(defun round-complex (z places)
   (complex (round-decimal (realpart z) places)
            (round-decimal (imagpart z) places)))

(defun mandel-point-r (z c limit)
   (declare (xargs :measure (nfix limit)))
   (cond ((zp limit) 0)
         ((> (abs-sq z) 4) limit)
         (t (mandel-point-r (+ (round-complex (* z z) 15) c)
                            c
                            (1- limit)))))

(defun mandel-point (z iters)
   (- 5 (floor (mandel-point-r z z iters) (/ iters 5))))

(defun draw-mandel-row (im re cols width iters)
   (declare (xargs :measure (nfix cols)))
   (if (zp cols)
       nil
       (prog2$ (cw (coerce
                    (list
                     (case (mandel-point (complex re im)
                                         iters)
                           (5 #\#)
                           (4 #\*)
                           (3 #\.)
                           (2 #\.)
                           (otherwise #\Space))) 'string))
               (draw-mandel-row im
                                (+ re (/ (/ width 3)))
                                (1- cols)
                                width iters))))

(defun draw-mandel (im rows width height iters)
   (if (zp rows)
       nil
       (progn$ (draw-mandel-row im -2 width width iters)
               (cw "~%")
               (draw-mandel (- im (/ (/ height 2)))
                            (1- rows)
                            width
                            height
                            iters))))

(defun draw-mandelbrot (width iters)
   (let ((height (floor (* 1000 width) 3333)))
        (draw-mandel 1 height width height iters)))


with Lumen.Binary;
package body Mandelbrot is
   function Create_Image (Width, Height : Natural) return Lumen.Image.Descriptor is
      use type Lumen.Binary.Byte;
      Result : Lumen.Image.Descriptor;
      X0, Y0 : Float;
      X, Y, Xtemp : Float;
      Iteration   : Float;
      Max_Iteration : constant Float := 1000.0;
      Color : Lumen.Binary.Byte;
   begin
      Result.Width := Width;
      Result.Height := Height;
      Result.Complete := True;
      Result.Values := new Lumen.Image.Pixel_Matrix (1 .. Width, 1 .. Height);
      for Screen_X in 1 .. Width loop
         for Screen_Y in 1 .. Height loop
            X0 := -2.5 + (3.5 / Float (Width) * Float (Screen_X));
            Y0 := -1.0 + (2.0 / Float (Height) * Float (Screen_Y));
            X := 0.0;
            Y := 0.0;
            Iteration := 0.0;
            while X * X + Y * Y <= 4.0 and then Iteration < Max_Iteration loop
               Xtemp := X * X - Y * Y + X0;
               Y := 2.0 * X * Y + Y0;
               X := Xtemp;
               Iteration := Iteration + 1.0;
            end loop;
            if Iteration = Max_Iteration then
               Color := 255;
            else
               Color := 0;
            end if;
            Result.Values (Screen_X, Screen_Y) := (R => Color, G => Color, B => Color, A => 0);
         end loop;
      end loop;
      return Result;
   end Create_Image;

end Mandelbrot;


INT pix = 300, max iter = 256, REAL zoom = 0.33 / pix;
[-pix : pix, -pix : pix] INT plane;
COMPL ctr = 0.05 I 0.75 # center of set #;

# Compute the length of an orbit. #
PROC iterate = (COMPL z0) INT:
  BEGIN COMPL z := 0, INT iter := 1;
        WHILE (iter +:= 1) < max iter # not converged # AND ABS z < 2 # not diverged #
        DO z := z * z + z0
        OD;
        iter
  END;

# Compute set and find maximum orbit length. #
INT max col := 0;
FOR x FROM -pix TO pix
DO FOR y FROM -pix TO pix
   DO COMPL z0 = ctr + (x * zoom) I (y * zoom);
      IF (plane [x, y] := iterate (z0)) < max iter
      THEN (plane [x, y] > max col | max col := plane [x, y])
      FI
   OD
OD;

# Make a plot. #
FILE plot;
INT num pix = 2 * pix + 1;
make device (plot, "gif", whole (num pix, 0) + "x" + whole (num pix, 0));
open (plot, "mandelbrot.gif", stand draw channel);
FOR x FROM -pix TO pix
DO FOR y FROM -pix TO pix
   DO INT col = (plane [x, y] > max col | max col | plane [x, y]);
      REAL c = sqrt (1- col / max col); # sqrt to enhance contrast #
      draw colour (plot, c, c, c);
      draw point (plot, (x + pix) / (num pix - 1), (y + pix) / (num pix  - 1))
   OD
OD;
close (plot)


begin
    % This is an integer ascii Mandelbrot generator, translated from the   %
    % Compiler/AST Interpreter Task's ASCII Mandelbrot Set example program %
    integer leftEdge, rightEdge, topEdge, bottomEdge, xStep, yStep, maxIter;
    leftEdge   := -420;
    rightEdge  :=  300;
    topEdge    :=  300;
    bottomEdge := -300;
    xStep      :=    7;
    yStep      :=   15;

    maxIter    :=  200;

    for y0 := topEdge step - yStep until bottomEdge do begin
        for x0 := leftEdge step xStep until rightEdge do begin
            integer x, y, i;
            string(1) theChar;
            y := 0;
            x := 0;
            theChar := " ";
            i := 0;
            while i < maxIter do begin
                integer x_x, y_y;
                x_x := (x * x) div 200;
                y_y := (y * y) div 200;
                if x_x + y_y > 800 then begin
                    theChar := code( decode( "0" ) + i );
                    if i > 9 then theChar := "@";
                    i := maxIter
                end;
                y := x * y div 100 + y0;
                x := x_x - y_y + x0;
                i := i + 1
            end while_i_lt_maxIter ;
            writeon( theChar );
        end for_x0 ;
        write();
    end for_y0
end.


#!/usr/bin/hopper

#include <hopper.h>

main:
ancho=500
alto=500
min real=-2
minReal=minreal
min complex=-2
max real = 2
max complex = 2

mandel=0,{ancho,alto}nanarray(mandel)

i=1,a2=0,b2=0,a=0,b=0,t1=0,t2=0
{","}toksep
tic(t1)

for(i=1,{i} le than (ancho),++i)

   for(j=1,{j} le than (alto),++j)

       {minreal} PLUS ( {max real}, minus (minReal), MUL BY ({i}minus(1)),  DIV BY ({ancho}minus(1))),mov(a)
       {min complex} PLUS ( {maxcomplex}, minus (mincomplex), MULBY ({j} minus(1)),DIVBY ({alto} minus (1)) ),mov(b)
       a2=a,b2=b,brillo=1

       k=100
       __iterador__:

            sqrdiff(a,b), plus (a2)
            {2} mulby (a), mulby (b), plus (b2)
            mov(b),mov(a)

            if( {a,b} sqr add, gthan (4))
               brillo=0, jmp(__out__)
            endif
            k--,jnz(__iterador__)

       __out__:

       [j,i]{brillo}put(mandel)
   next
next
toc(t1,t2)
{"TIME = ",t2,"\n"}print
{mandel,"mandel.dat"}save
{0}return


inMandelbrot?: function [c][
    z: to :complex [0 0]
    do.times: 50 [
        z: c + z*z
        if 4 < abs z -> return false
    ]
    return true
]

mandelbrot: function [settings][
    y: 0
    while [y < settings\height][
        Y: settings\yStart + y * settings\yStep
        x: 0
        while [x < settings\width][
            X: settings\xStart + x * settings\xStep
            if? inMandelbrot? to :complex @[X Y] -> prints "*"
            else -> prints " "
            x: x + 1
        ]
        print ""
        y: y + 1
    ]
]

mandelbrot #[ yStart: 1.0 yStep: neg 0.05
              xStart: neg 2.0 xStep: 0.0315
              height: 40 width: 80 ]


Max_Iteration := 256
Width := Height := 400

File := "MandelBrot." Width ".bmp"
Progress, b2 w400 fs9, Creating Colours ...
Gosub, CreateColours
Gosub, CreateBitmap
Progress, Off
Gui, -Caption
Gui, Margin, 0, 0
Gui, Add, Picture,, %File%
Gui, Show,, MandelBrot
Return

GuiClose:
GuiEscape:
ExitApp

;---------------------------------------------------------------------------
CreateBitmap: ; create and save a 32bit bitmap file
;---------------------------------------------------------------------------
    ; define header details
    HeaderBMP  := 14
    HeaderDIB  := 40
    DataOffset := HeaderBMP + HeaderDIB
    ImageSize  := Width * Height * 4 ; 32bit
    FileSize   := DataOffset + ImageSize
    Resolution := 3780 ; from mspaint

    ; create bitmap header
    VarSetCapacity(IMAGE, FileSize, 0)
    NumPut(Asc("B")   , IMAGE, 0x00, "Char")
    NumPut(Asc("M")   , IMAGE, 0x01, "Char")
    NumPut(FileSize   , IMAGE, 0x02, "UInt")
    NumPut(DataOffset , IMAGE, 0x0A, "UInt")
    NumPut(HeaderDIB  , IMAGE, 0x0E, "UInt")
    NumPut(Width      , IMAGE, 0x12, "UInt")
    NumPut(Height     , IMAGE, 0x16, "UInt")
    NumPut(1          , IMAGE, 0x1A, "Short") ; Planes
    NumPut(32         , IMAGE, 0x1C, "Short") ; Bits per Pixel
    NumPut(ImageSize  , IMAGE, 0x22, "UInt")
    NumPut(Resolution , IMAGE, 0x26, "UInt")
    NumPut(Resolution , IMAGE, 0x2A, "UInt")

    ; fill in Data
    Gosub, CreatePixels

    ; save Bitmap to file
    FileDelete, %File%
    Handle := DllCall("CreateFile", "Str", File, "UInt", 0x40000000
            , "UInt", 0, "UInt", 0, "UInt", 2, "UInt", 0, "UInt", 0)
    DllCall("WriteFile", "UInt", Handle, "UInt", &IMAGE, "UInt"
            , FileSize, "UInt *", Bytes, "UInt", 0)
    DllCall("CloseHandle", "UInt", Handle)

Return

;---------------------------------------------------------------------------
CreatePixels: ; create pixels for [-2 < x < 1] [-1.5 < y < 1.5]
;---------------------------------------------------------------------------
    Loop, % Height // 2 + 1 {
        yi := A_Index - 1
        y0 := -1.5 + yi / Height * 3 ; range -1.5 .. +1.5
        Progress, % 200*yi // Height, % "Current line: " 2*yi " / " Height
        Loop, %Width% {
            xi := A_Index - 1
            x0 := -2 + xi / Width * 3 ; range -2 .. +1
            Gosub, Mandelbrot
            p1 := DataOffset + 4 * (Width * yi + xi)
            NumPut(Colour, IMAGE, p1, "UInt")
            p2 := DataOffset + 4 * (Width * (Height-yi) + xi)
            NumPut(Colour, IMAGE, p2, "UInt")
        }
    }
Return

;---------------------------------------------------------------------------
Mandelbrot: ; calculate a colour for each pixel
;---------------------------------------------------------------------------
    x := y := Iteration := 0
    While, (x*x + y*y <= 4) And (Iteration < Max_Iteration) {
        xtemp := x*x - y*y + x0
        y := 2*x*y + y0
        x := xtemp
        Iteration++
    }
    Colour := Iteration = Max_Iteration ? 0 : Colour_%Iteration%

Return

;---------------------------------------------------------------------------
CreateColours: ; borrowed from PureBasic example
;---------------------------------------------------------------------------
    Loop, 64 {
        i4 := (i3 := (i2 := (i1 := A_Index - 1) + 64) + 64) + 64
        Colour_%i1% := RGB(4*i1 + 128, 4*i1, 0)
        Colour_%i2% := RGB(64, 255, 4*i1)
        Colour_%i3% := RGB(64, 255 - 4*i1, 255)
        Colour_%i4% := RGB(64, 0, 255 - 4*i1)
    }
Return

;---------------------------------------------------------------------------
RGB(r, g, b) { ; return 24bit color value
;---------------------------------------------------------------------------
    Return, (r&0xFF)<<16 | g<<8 | b
}


BEGIN {
  XSize=59; YSize=21;
  MinIm=-1.0; MaxIm=1.0;MinRe=-2.0; MaxRe=1.0;
  StepX=(MaxRe-MinRe)/XSize; StepY=(MaxIm-MinIm)/YSize;
  for(y=0;y<YSize;y++)
  {
    Im=MinIm+StepY*y;
    for(x=0;x<XSize;x++)
        {
      Re=MinRe+StepX*x; Zr=Re; Zi=Im;
      for(n=0;n<30;n++)
          {
        a=Zr*Zr; b=Zi*Zi;
        if(a+b>4.0) break;
        Zi=2*Zr*Zi+Im; Zr=a-b+Re;
      }
      printf "%c",62-n;
    }
    print "";
  }
  exit;
}


main() {
  auto cx,cy,x,y,x2,y2;
  auto iter;

  auto xmin,xmax,ymin,ymax,maxiter,dx,dy;

  xmin = -8601;
  xmax =  2867;
  ymin = -4915;
  ymax =  4915;

  maxiter = 32;

  dx = (xmax-xmin)/79;
  dy = (ymax-ymin)/24;

  cy=ymin;
  while( cy<=ymax ) {
    cx=xmin;
    while( cx<=xmax ) {
      x = 0;
      y = 0;
      x2 = 0;
      y2 = 0;
      iter=0;
      while( iter<maxiter ) {
        if( x2+y2>16384 ) break;
        y = ((x*y)>>11)+cy;
        x = x2-y2+cx;
        x2 = (x*x)>>12;
        y2 = (y*y)>>12;
        iter++;
      }
      putchar(' '+iter);
      cx =+ dx;
    }
    putchar(13);
    putchar(10);
    cy =+ dy;
  }

  return(0);
}


SCREEN 1,320,200,5,1
WINDOW 2,"Mandelbrot",,0,1

maxIteration = 100
xmin = -2
xmax = 1
ymin = -1.5
ymax = 1.5
xs = 300
ys = 180
st = .01   ' use e.g. st = .05 for a coarser but faster picture
           '   and perhaps also lower maxIteration = 10 or so
xp = xs / (xmax - xmin) * st
yp = ys / (ymax - ymin) * st

FOR x0 = xmin TO xmax STEP st
    FOR y0 = ymin TO ymax STEP st
        x = 0
        y = 0
        iteration = 0

        WHILE (x * x + y * y <= (2 * 2) AND iteration < maxIteration)
            xtemp = x * x - y * y + x0
            y = 2 * x * y + y0

            x = xtemp

            iteration = iteration + 1
        WEND

        IF iteration <> maxIteration THEN
            c = iteration
        ELSE
            c = 0
        END IF
        COLOR c MOD 32
        AREA ((x0 - xmin) * xp / st, (y0 - ymin) * yp / st)
        AREA STEP (xp, 0)
        AREA STEP (0, yp)
        AREA STEP (-xp, 0)
        AREA STEP (0, -yp)
        AREAFILL
    NEXT
NEXT

' endless loop, use Run -> Stop from the menu to stop program
WHILE (1)
WEND


#!/usr/bin/env bx
use b

Main():
	num outside = 16, ox = -0.5, oy = 0, r = 1.5
	long i, max_i = 100, rb_i = 30
	space()
	uint32_t *px = pixel()
	num d = 2*r/h, x0 = ox-d*w_2, y0 = oy+d*h_2
	for(y, 0, h):
		cmplx c = x0 + (y0-d*y)*I
		repeat(w):
			cmplx w = 0
			for i=0; i < max_i && cabs(w) < outside; ++i
				w = w*w + c
			*px++ = i < max_i ? rainbow(i*359 / rb_i % 360) : black
			c += d


 /*
 c program:
 --------------------------------
  1. draws Mandelbrot set for Fc(z)=z*z +c
  using Mandelbrot algorithm ( boolean escape time )
 -------------------------------
 2. technique of creating ppm file is  based on the code of Claudio Rocchini
 http://en.wikipedia.org/wiki/Image:Color_complex_plot.jpg
 create 24 bit color graphic file ,  portable pixmap file = PPM
 see http://en.wikipedia.org/wiki/Portable_pixmap
 to see the file use external application ( graphic viewer)
  */
 #include <stdio.h>
 #include <math.h>
 int main()
 {
          /* screen ( integer) coordinate */
        int iX,iY;
        const int iXmax = 800;
        const int iYmax = 800;
        /* world ( double) coordinate = parameter plane*/
        double Cx,Cy;
        const double CxMin=-2.5;
        const double CxMax=1.5;
        const double CyMin=-2.0;
        const double CyMax=2.0;
        /* */
        double PixelWidth=(CxMax-CxMin)/iXmax;
        double PixelHeight=(CyMax-CyMin)/iYmax;
        /* color component ( R or G or B) is coded from 0 to 255 */
        /* it is 24 bit color RGB file */
        const int MaxColorComponentValue=255;
        FILE * fp;
        char *filename="new1.ppm";
        char *comment="# ";/* comment should start with # */
        static unsigned char color[3];
        /* Z=Zx+Zy*i  ;   Z0 = 0 */
        double Zx, Zy;
        double Zx2, Zy2; /* Zx2=Zx*Zx;  Zy2=Zy*Zy  */
        /*  */
        int Iteration;
        const int IterationMax=200;
        /* bail-out value , radius of circle ;  */
        const double EscapeRadius=2;
        double ER2=EscapeRadius*EscapeRadius;
        /*create new file,give it a name and open it in binary mode  */
        fp= fopen(filename,"wb"); /* b -  binary mode */
        /*write ASCII header to the file*/
        fprintf(fp,"P6\n %s\n %d\n %d\n %d\n",comment,iXmax,iYmax,MaxColorComponentValue);
        /* compute and write image data bytes to the file*/
        for(iY=0;iY<iYmax;iY++)
        {
             Cy=CyMin + iY*PixelHeight;
             if (fabs(Cy)< PixelHeight/2) Cy=0.0; /* Main antenna */
             for(iX=0;iX<iXmax;iX++)
             {
                        Cx=CxMin + iX*PixelWidth;
                        /* initial value of orbit = critical point Z= 0 */
                        Zx=0.0;
                        Zy=0.0;
                        Zx2=Zx*Zx;
                        Zy2=Zy*Zy;
                        /* */
                        for (Iteration=0;Iteration<IterationMax && ((Zx2+Zy2)<ER2);Iteration++)
                        {
                            Zy=2*Zx*Zy + Cy;
                            Zx=Zx2-Zy2 +Cx;
                            Zx2=Zx*Zx;
                            Zy2=Zy*Zy;
                        };
                        /* compute  pixel color (24 bit = 3 bytes) */
                        if (Iteration==IterationMax)
                        { /*  interior of Mandelbrot set = black */
                           color[0]=0;
                           color[1]=0;
                           color[2]=0;
                        }
                     else
                        { /* exterior of Mandelbrot set = white */
                             color[0]=255; /* Red*/
                             color[1]=255;  /* Green */
                             color[2]=255;/* Blue */
                        };
                        /*write color to the file*/
                        fwrite(color,1,3,fp);
                }
        }
        fclose(fp);
        return 0;
 }


using System;
using System.Drawing;
using System.Drawing.Imaging;
using System.Threading;
using System.Windows.Forms;

/// <summary>
/// Generates bitmap of Mandelbrot Set and display it on the form.
/// </summary>
public class MandelbrotSetForm : Form
{
    const double MaxValueExtent = 2.0;
    Thread thread;

    static double CalcMandelbrotSetColor(ComplexNumber c)
    {
        // from http://en.wikipedia.org/w/index.php?title=Mandelbrot_set
        const int MaxIterations = 1000;
        const double MaxNorm = MaxValueExtent * MaxValueExtent;

        int iteration = 0;
        ComplexNumber z = new ComplexNumber();
        do
        {
            z = z * z + c;
            iteration++;
        } while (z.Norm() < MaxNorm && iteration < MaxIterations);
        if (iteration < MaxIterations)
            return (double)iteration / MaxIterations;
        else
            return 0; // black
    }

    static void GenerateBitmap(Bitmap bitmap)
    {
        double scale = 2 * MaxValueExtent / Math.Min(bitmap.Width, bitmap.Height);
        for (int i = 0; i < bitmap.Height; i++)
        {
            double y = (bitmap.Height / 2 - i) * scale;
            for (int j = 0; j < bitmap.Width; j++)
            {
                double x = (j - bitmap.Width / 2) * scale;
                double color = CalcMandelbrotSetColor(new ComplexNumber(x, y));
                bitmap.SetPixel(j, i, GetColor(color));
            }
        }
    }

    static Color GetColor(double value)
    {
        const double MaxColor = 256;
        const double ContrastValue = 0.2;
        return Color.FromArgb(0, 0,
            (int)(MaxColor * Math.Pow(value, ContrastValue)));
    }

    public MandelbrotSetForm()
    {
        // form creation
        this.Text = "Mandelbrot Set Drawing";
        this.BackColor = System.Drawing.Color.Black;
        this.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Stretch;
        this.MaximizeBox = false;
        this.StartPosition = FormStartPosition.CenterScreen;
        this.FormBorderStyle = FormBorderStyle.FixedDialog;
        this.ClientSize = new Size(640, 640);
        this.Load += new System.EventHandler(this.MainForm_Load);
    }

    void MainForm_Load(object sender, EventArgs e)
    {
        thread = new Thread(thread_Proc);
        thread.IsBackground = true;
        thread.Start(this.ClientSize);
    }

    void thread_Proc(object args)
    {
        // start from small image to provide instant display for user
        Size size = (Size)args;
        int width = 16;
        while (width * 2 < size.Width)
        {
            int height = width * size.Height / size.Width;
            Bitmap bitmap = new Bitmap(width, height, PixelFormat.Format24bppRgb);
            GenerateBitmap(bitmap);
            this.BeginInvoke(new SetNewBitmapDelegate(SetNewBitmap), bitmap);
            width *= 2;
            Thread.Sleep(200);
        }
        // then generate final image
        Bitmap finalBitmap = new Bitmap(size.Width, size.Height, PixelFormat.Format24bppRgb);
        GenerateBitmap(finalBitmap);
        this.BeginInvoke(new SetNewBitmapDelegate(SetNewBitmap), finalBitmap);
    }

    void SetNewBitmap(Bitmap image)
    {
        if (this.BackgroundImage != null)
            this.BackgroundImage.Dispose();
        this.BackgroundImage = image;
    }

    delegate void SetNewBitmapDelegate(Bitmap image);

    static void Main()
    {
        Application.Run(new MandelbrotSetForm());
    }
}

struct ComplexNumber
{
    public double Re;
    public double Im;

    public ComplexNumber(double re, double im)
    {
        this.Re = re;
        this.Im = im;
    }

    public static ComplexNumber operator +(ComplexNumber x, ComplexNumber y)
    {
        return new ComplexNumber(x.Re + y.Re, x.Im + y.Im);
    }

    public static ComplexNumber operator *(ComplexNumber x, ComplexNumber y)
    {
        return new ComplexNumber(x.Re * y.Re - x.Im * y.Im,
            x.Re * y.Im + x.Im * y.Re);
    }

    public double Norm()
    {
        return Re * Re + Im * Im;
    }
}


#include <cstdlib>
#include <complex>

// get dimensions for arrays
template<typename ElementType, std::size_t dim1, std::size_t dim2>
 std::size_t get_first_dimension(ElementType (&a)[dim1][dim2])
{
  return dim1;
}

template<typename ElementType, std::size_t dim1, std::size_t dim2>
 std::size_t get_second_dimension(ElementType (&a)[dim1][dim2])
{
  return dim2;
}

template<typename ColorType, typename ImageType>
 void draw_Mandelbrot(ImageType& image,                                   //where to draw the image
                      ColorType set_color, ColorType non_set_color,       //which colors to use for set/non-set points
                      double cxmin, double cxmax, double cymin, double cymax,//the rect to draw in the complex plane
                      unsigned int max_iterations)                          //the maximum number of iterations
{
  std::size_t const ixsize = get_first_dimension(image);
  std::size_t const iysize = get_first_dimension(image);
  for (std::size_t ix = 0; ix < ixsize; ++ix)
    for (std::size_t iy = 0; iy < iysize; ++iy)
    {
      std::complex<double> c(cxmin + ix/(ixsize-1.0)*(cxmax-cxmin), cymin + iy/(iysize-1.0)*(cymax-cymin));
      std::complex<double> z = 0;
      unsigned int iterations;

      for (iterations = 0; iterations < max_iterations && std::abs(z) < 2.0; ++iterations)
        z = z*z + c;

      image[ix][iy] = (iterations == max_iterations) ? set_color : non_set_color;

    }
}


module mandelbrot;

extern fn int atoi(char *s);
extern fn int printf(char *s, ...);
extern fn void putchar(int c);

fn void main(int argc, char **argv)
{
  int w = atoi(argv[1]);
  int h = w;

  const LIMIT = 2.0;
  const SQUARE_LIMIT = LIMIT * LIMIT;

  printf("P4\n%d %d\n", w, h);

  int iter = 50;
  int bit_num = 0;
  char byte_acc = 0;
  for (double y = 0; y < h; y++)
  {
    for (double x = 0; x < w; x++)
    {
      double zr;
      double zi;
      double ti;
      double tr;
      double cr = (2.0 * x / w - 1.5);
      double ci = (2.0 * y / h - 1.0);
      for (int i = 0; i < iter && (tr + ti <= SQUARE_LIMIT); i++)
      {
        zi = 2.0 * zr * zi + ci;
        zr = tr - ti + cr;
        tr = zr * zr;
        ti = zi * zi;
      }

      byte_acc <<= 1;
      if (tr + ti <= SQUARE_LIMIT) byte_acc |= 0x01;

      ++bit_num;

      if (bit_num == 8)
      {
        putchar(byte_acc);
        byte_acc = 0;
        bit_num = 0;
      }
      else if (x == w - 1)
      {
        byte_acc <<= (8 - w % 8);
        putchar(byte_acc);
        byte_acc = 0;
        bit_num = 0;
      }
    }
  }
}


use: cx;

define: max 4.0;
define: max-iter 570;

let: (max-x max-y) screen-size;
let: max-cx $max-x 2.0 /;
let: max-cy $max-y 2.0 /;
let: rows Stack<Str> new;
let: buf Buf new;
let: zoom 0 ref;

func: render()()
  $rows clear

  $max-y 2 / {
    let: y;
    $buf 0 seek

    $max-x {
      let: x;
      let: (zx zy) 0.0 ref %%;
      let: cx $x $max-cx - $zoom deref /;
      let: cy $y $max-cy - $zoom deref /;
      let: i #max-iter ref;

      {
        let: nzx $zx deref ** $zy deref ** - $cx +;
	$zy $zx deref *2 $zy deref * $cy + set
	$zx $nzx set
        $i &-- set-call
        $nzx ** $zy deref ** + #max < $i deref and
      } while

      let: c $i deref % -7 bsh bor 256 mod;
      $c {$x 256 mod $y 256 mod} {0 0} if-else $c new-rgb $buf set-bg
      @@s $buf print
    } for

    $rows $buf str push
  } for

  1 1 #out move-to
  $rows {#out print} for
  $rows riter {#out print} for;

#out hide-cursor
raw-mode

let: poll Poll new;
let: is-done #f ref;

$poll #in {
  #in read-char _
  $is-done #t set
} on-read

{
  $zoom &++ set-call
  render
  $poll 0 wait _
  $is-done deref !
} while

#out reset-style
#out clear-screen
1 1 #out move-to
#out show-cursor
normal-mode


(ns mandelbrot
  (:refer-clojure :exclude [+ * <])
  (:use (clojure.contrib complex-numbers)
        (clojure.contrib.generic [arithmetic :only [+ *]]
                                 [comparison :only [<]]
                                 [math-functions :only [abs]])))
(defn mandelbrot? [z]
  (loop [c 1
         m (iterate #(+ z (* % %)) 0)]
    (if (and (> 20 c)
             (< (abs (first m)) 2) )
      (recur (inc c)
             (rest m))
      (if (= 20 c) true false))))

(defn mandelbrot []
  (for [y (range 1 -1 -0.05)
	x (range -2 0.5 0.0315)]
    (if (mandelbrot? (complex x y)) "#" " ")))

(println (interpose \newline (map #(apply str %) (partition 80 (mandelbrot)))))


IDENTIFICATION DIVISION.
PROGRAM-ID. MANDELBROT-SET-PROGRAM.
DATA DIVISION.
WORKING-STORAGE SECTION.
01  COMPLEX-ARITHMETIC.
    05 X               PIC S9V9(9).
    05 Y               PIC S9V9(9).
    05 X-A             PIC S9V9(6).
    05 X-B             PIC S9V9(6).
    05 Y-A             PIC S9V9(6).
    05 X-A-SQUARED     PIC S9V9(6).
    05 Y-A-SQUARED     PIC S9V9(6).
    05 SUM-OF-SQUARES  PIC S9V9(6).
    05 ROOT            PIC S9V9(6).
01  LOOP-COUNTERS.
    05 I               PIC 99.
    05 J               PIC 99.
    05 K               PIC 999.
77  PLOT-CHARACTER     PIC X.
PROCEDURE DIVISION.
CONTROL-PARAGRAPH.
    PERFORM OUTER-LOOP-PARAGRAPH
    VARYING I FROM 1 BY 1 UNTIL I IS GREATER THAN 24.
    STOP RUN.
OUTER-LOOP-PARAGRAPH.
    PERFORM INNER-LOOP-PARAGRAPH
    VARYING J FROM 1 BY 1 UNTIL J IS GREATER THAN 64.
    DISPLAY ''.
INNER-LOOP-PARAGRAPH.
    MOVE SPACE TO PLOT-CHARACTER.
    MOVE ZERO  TO X-A.
    MOVE ZERO  TO Y-A.
    MULTIPLY J   BY   0.0390625   GIVING X.
    SUBTRACT 1.5 FROM X.
    MULTIPLY I   BY   0.083333333 GIVING Y.
    SUBTRACT 1 FROM Y.
    PERFORM ITERATION-PARAGRAPH VARYING K FROM 1 BY 1
    UNTIL K IS GREATER THAN 100 OR PLOT-CHARACTER IS EQUAL TO '#'.
    DISPLAY PLOT-CHARACTER WITH NO ADVANCING.
ITERATION-PARAGRAPH.
    MULTIPLY X-A BY X-A GIVING X-A-SQUARED.
    MULTIPLY Y-A BY Y-A GIVING Y-A-SQUARED.
    SUBTRACT Y-A-SQUARED FROM X-A-SQUARED GIVING X-B.
    ADD      X   TO X-B.
    MULTIPLY X-A BY Y-A GIVING Y-A.
    MULTIPLY Y-A BY 2   GIVING Y-A.
    SUBTRACT Y   FROM Y-A.
    MOVE     X-B TO   X-A.
    ADD X-A-SQUARED TO Y-A-SQUARED GIVING SUM-OF-SQUARES.
    MOVE FUNCTION SQRT (SUM-OF-SQUARES) TO ROOT.
    IF ROOT IS GREATER THAN 2 THEN MOVE '#' TO PLOT-CHARACTER.


(defpackage #:mandelbrot
  (:use #:cl))

(in-package #:mandelbrot)

(deftype pixel () '(unsigned-byte 8))
(deftype image () '(array pixel))

(defun write-pgm (image filespec)
  (declare (image image))
  (with-open-file (s filespec :direction :output :element-type 'pixel :if-exists :supersede)
    (let* ((width  (array-dimension image 1))
           (height (array-dimension image 0))
           (header (format nil "P5~A~D ~D~A255~A" #\Newline width height #\Newline #\Newline)))
      (loop for c across header
            do (write-byte (char-code c) s))
      (dotimes (row height)
        (dotimes (col width)
          (write-byte (aref image row col) s))))))

(defparameter *x-max* 800)
(defparameter *y-max* 800)
(defparameter *cx-min* -2.5)
(defparameter *cx-max* 1.5)
(defparameter *cy-min* -2.0)
(defparameter *cy-max* 2.0)
(defparameter *escape-radius* 2)
(defparameter *iteration-max* 40)

(defun mandelbrot (filespec)
  (let ((pixel-width  (/ (- *cx-max* *cx-min*) *x-max*))
        (pixel-height (/ (- *cy-max* *cy-min*) *y-max*))
        (image (make-array (list *y-max* *x-max*) :element-type 'pixel :initial-element 0)))
    (loop for y from 0 below *y-max*
          for cy from *cy-min* by pixel-height
          do (loop for x from 0 below *x-max*
                   for cx from *cx-min* by pixel-width
                   for iteration = (loop with c = (complex cx cy)
                                         for iteration from 0 below *iteration-max*
                                         for z = c then (+ (* z z) c)
                                         while (< (abs z) *escape-radius*)
                                         finally (return iteration))
                   for pixel = (round (* 255 (/ (- *iteration-max* iteration) *iteration-max*)))
                   do (setf (aref image y x) pixel)))
    (write-pgm image filespec)))


include "cowgol.coh";

const xmin := -8601;
const xmax := 2867;
const ymin := -4915;
const ymax := 4915;
const maxiter := 32;

const dx := (xmax-xmin)/79;
const dy := (ymax-ymin)/24;

var cy: int16 := ymin;
while cy <= ymax loop
    var cx: int16 := xmin;
    while cx <= xmax loop
        var x: int32 := 0;
        var y: int32 := 0;
        var x2: int32 := 0;
        var y2: int32 := 0;
        var iter: uint8 := 0;

        while iter < maxiter and x2 + y2 <= 16384 loop
            y := ((x*y)>>11)+cy as int32;
            x := x2-y2+cx as int32;
            x2 := (x*x)>>12;
            y2 := (y*y)>>12;
            iter := iter + 1;
        end loop;

        print_char(' ' + iter);
        cx := cx + dx;
    end loop;
    print_nl();
    cy := cy + dy;
end loop;


void main() {
    import std.stdio, std.complex;

    for (real y = -1.2; y < 1.2; y += 0.05) {
        for (real x = -2.05; x < 0.55; x += 0.03) {
            auto z = 0.complex;
            foreach (_; 0 .. 100)
                z = z ^^ 2 + complex(x, y);
            write(z.abs < 2 ? '#' : '.');
        }
        writeln;
    }
}


class Complex {
  double _r,_i;

  Complex(this._r,this._i);
  double get r => _r;
  double get i => _i;
  String toString() => "($r,$i)";

  Complex operator +(Complex other) => new Complex(r+other.r,i+other.i);
  Complex operator *(Complex other) =>
      new Complex(r*other.r-i*other.i,r*other.i+other.r*i);
  double abs() => r*r+i*i;
}

void main() {
  double start_x=-1.5;
  double start_y=-1.0;
  double step_x=0.03;
  double step_y=0.1;

  for(int y=0;y<20;y++) {
    String line="";
    for(int x=0;x<70;x++) {
      Complex c=new Complex(start_x+step_x*x,start_y+step_y*y);
      Complex z=new Complex(0.0, 0.0);
      for(int i=0;i<100;i++) {
        z=z*(z)+c;
        if(z.abs()>2) {
          break;
        }
      }
      line+=z.abs()>2 ? " " : "*";
    }
    print(line);
  }
}


 _2.1 sx # xmin = -2.1
  0.7 sX # xmax =  0.7

 _1.2 sy # ymin = -1.2
  1.2 sY # ymax =  1.2

   32 sM # maxiter = 32

   80 sW # image width
   25 sH # image height

    8 k  # precision

[ q ] sq # quitter helper macro

# for h from 0 to H-1
0 sh
[
  lh lH =q # quit if H reached

  # for w from 0 to W-1
  0 sw
  [
    lw lW =q # quit if W reached

    # (w,h) -> (R,I)
    #           | |
    #           | ymin + h*(ymax-ymin)/(height-1)
    #           xmin + w*(xmax-xmin)/(width-1)

    lX lx - lW 1 - / lw * lx + sR
    lY ly - lH 1 - / lh * ly + sI

    # iterate for (R,I)

    0 sr #     r:=0
    0 si #     i:=0
    0 sa #     a:=0 (r squared)
    0 sb #     b:=0 (i squared)
    0 sm #     m:=0

    # do while m!=M and a+b=<4
    [
      lm lM =q # exit if m==M
      la lb + 4<q # exit if >4

      2 lr * li * lI + si # i:=2*r*i+I
      la lb - lR + sr     # r:=a-b+R
      lm 1 + sm           # m+=1
      lr 2 ^ sa           # a:=r*r
      li 2 ^ sb           # b:=i*i

      l0 x                # loop
    ] s0
    l0 x

    lm 32 + P             # print "pixel"

    lw 1 + sw             # w+=1
    l1 x                  # loop
  ] s1
  l1 x

  A P                     # linefeed

  lh 1 + sh               # h+=1
  l2 x                    # loop
] s2
l2 x


const maxIter = 256;

var x, y, i : Integer;
for y:=-39 to 39 do begin
   for x:=-39 to 39 do begin
      var c := Complex(y/40-0.5, x/40);
      var z := Complex(0, 0);
      for i:=1 to maxIter do begin
         z := z*z + c;
         if Abs(z)>=4 then Break;
      end;
      if i>=maxIter then
         Print('#')
      else Print('.');
    end;
    PrintLn('');
end;


void drawMandelbrot(Bitmap bmp, float range, Complex center, ColorAlpha * palette, int nPalEntries, int nIterations, float scale)
{
   int x, y;
   int w = bmp.width, h = bmp.height;
   ColorAlpha * picture = (ColorAlpha *)bmp.picture;
   double logOf2 = log(2);
   Complex d
   {
      w > h ? range : range * w / h,
      h > w ? range : range * h / w
   };
   Complex C0 { center.a - d.a/2, center.b - d.b/2 };
   Complex C = C0;
   double delta = d.a / w;

   for(y = 0; y < h; y++, C.a = C0.a, C.b += delta)
   {
      for(x = 0; x < w; x++, picture++, C.a += delta)
      {
         Complex Z { };
         int i;
         double ii = 0;
         bool out = false;
         double Za2 = Z.a * Z.a, Zb2 = Z.b * Z.b;
         for(i = 0; i < nIterations; i++)
         {
            double z2;
            Z = { Za2 - Zb2, 2*Z.a*Z.b };
            Z.a += C.a;
            Z.b += C.b;
            Za2 = Z.a * Z.a, Zb2 = Z.b * Z.b;
            z2 = Za2 + Zb2;

            if(z2 >= 2*2)
            {
               ii = (double)(i + 1 - log(0.5 * log(z2)) / logOf2);
               out = true;
               break;
            }
         }
         if(out)
         {
            float si = (float)(ii * scale);
            int i0 = ((int)si) % nPalEntries;
            *picture = palette[i0];
         }
         else
            *picture = black;
      }
   }
}


(lib 'math) ;; fractal function
(lib 'plot)

;; (fractal z zc n) iterates z := z^2 + c, n times
;; 100 iterations
(define (mset z) (if (= Infinity (fractal 0 z 100)) Infinity z))

;; plot function argument inside square (-2 -2), (2,2)
(plot-z-arg mset -2 -2)

;; result here [http://www.echolalie.org/echolisp/help.html#fractal]


defmodule Mandelbrot do
  def set do
    xsize = 59
    ysize = 21
    minIm = -1.0
    maxIm = 1.0
    minRe = -2.0
    maxRe = 1.0
    stepX = (maxRe - minRe) / xsize
    stepY = (maxIm - minIm) / ysize
    Enum.each(0..ysize, fn y ->
      im = minIm + stepY * y
      Enum.map(0..xsize, fn x ->
        re = minRe + stepX * x
        62 - loop(0, re, im, re, im, re*re+im*im)
      end) |> IO.puts
    end)
  end

  defp loop(n, _, _, _, _, _) when n>=30, do: n
  defp loop(n, _, _, _, _, v) when v>4.0, do: n-1
  defp loop(n, re, im, zr, zi, _) do
    a = zr * zr
    b = zi * zi
    loop(n+1, re, im, a-b+re, 2*zr*zi+im, a+b)
  end
end

Mandelbrot.set


; === Mandelbrot ============================================

(setq mandel-size (cons 76 34))
(setq xmin -2)
(setq xmax .5)
(setq ymin -1.2)
(setq ymax 1.2)
(setq max-iter 20)

(defun mandel-iter-point (x y)
  "Run the actual iteration for each point."
  (let ((xp 0)
        (yp 0)
        (it 0)
        (xt 0))
    (while (and (< (+ (* xp xp) (* yp yp)) 4) (< it max-iter))
      (setq xt (+ (* xp xp) (* -1 yp yp) x))
      (setq yp (+ (* 2 xp yp) y))
      (setq xp xt)
      (setq it (1+ it)))
    it))

(defun mandel-iter (p)
  "Return string for point based on whether inside/outside the set."
  (let ((it (mandel-iter-point (car p) (cdr p))))
    (if (= it max-iter) "*" "-")))

(defun mandel-pos (x y)
  "Convert screen coordinates to input coordinates."
  (let ((xp (+ xmin (* (- xmax xmin) (/ (float x) (car mandel-size)))))
        (yp (+ ymin (* (- ymax ymin) (/ (float y) (cdr mandel-size))))))
       (cons xp yp)))

(defun mandel ()
  "Plot the Mandelbrot set."
  (dotimes (y (cdr mandel-size))
    (dotimes (x (car mandel-size))
      (if (= x 0)
        (insert(format "\n%s" (mandel-iter (mandel-pos x y))))
        (insert(format "%s" (mandel-iter (mandel-pos x y))))))))

(mandel)


-module(mandelbrot).

-export([test/0]).

magnitude(Z) ->
  R = complex:real(Z),
  I = complex:imaginary(Z),
  R * R + I * I.

mandelbrot(A, MaxI, Z, I) ->
    case (I < MaxI) and (magnitude(Z) < 2.0) of
        true ->
            NZ = complex:add(complex:mult(Z, Z), A),
            mandelbrot(A, MaxI, NZ, I + 1);
        false ->
            case I of
                MaxI ->
                    $*;
                _ ->
                    $
            end
    end.

test() ->
    lists:map(
        fun(S) -> io:format("~s",[S]) end,
        [
            [
                begin
                    Z = complex:make(X, Y),
                    mandelbrot(Z, 50, Z, 1)
                end
            || X <- seq_float(-2, 0.5, 0.0315)
            ] ++ "\n"
        || Y <- seq_float(-1,1, 0.05)
        ] ),
    ok.

% **************************************************
% Copied from https://gist.github.com/andruby/241489
% **************************************************

seq_float(Min, Max, Inc, Counter, Acc) when (Counter*Inc + Min) >= Max ->
  lists:reverse([Max|Acc]);
seq_float(Min, Max, Inc, Counter, Acc) ->
  seq_float(Min, Max, Inc, Counter+1, [Inc * Counter + Min|Acc]).
seq_float(Min, Max, Inc) ->
  seq_float(Min, Max, Inc, 0, []).

% **************************************************


V template = ‘<name> went for a walk in the park. <he or she>
found a <noun>. <name> decided to take it home.’

F madlibs(template)
   print("The story template is:\n"template)
   V fields = sorted(Array(Set(re:‘<[^>]+>’.find_strings(template))))
   V values = input("\nInput a comma-separated list of words to replace the following items\n  #.: ".format(fields.join(‘,’))).split(‘,’)
   V story = template
   L(f, v) zip(fields, values)
      story = story.replace(f, v)
   print("\nThe story becomes:\n\n"story)

madlibs(template)


PROGRAM MANDELBROT

!$KEY
!$INCLUDE="PC.LIB"

BEGIN

SCREEN(7)
GR_WINDOW(-2,1.5,2,-1.5)
FOR X0=-2 TO 2 STEP 0.01 DO
    FOR Y0=-1.5 TO 1.5 STEP 0.01 DO
        X=0
        Y=0

        ITERATION=0
        MAX_ITERATION=223

        WHILE (X*X+Y*Y<=(2*2) AND ITERATION<MAX_ITERATION) DO
            X_TEMP=X*X-Y*Y+X0
            Y=2*X*Y+Y0

            X=X_TEMP

            ITERATION=ITERATION+1
        END WHILE

        IF ITERATION<>MAX_ITERATION THEN
            C=ITERATION
          ELSE
            C=0
        END IF

        PSET(X0,Y0,C)
    END FOR
END FOR
END PROGRAM


with Ada.Text_IO, Ada.Command_Line, String_Helper;

procedure Madlib is

   use String_Helper;

   Text: Vector := Get_Vector(Ada.Command_Line.Argument(1));
   M, N: Natural;

begin
   -- search for templates and modify the text accordingly
   for I in Text.First_Index .. Text.Last_Index loop
      loop
         Search_Brackets(Text.Element(I), "<", ">", M, N);
      exit when M=0; -- "M=0" means "not found"
         Ada.Text_IO.Put_Line("Replacement for " & Text.Element(I)(M .. N) & "?");
         declare
            Old: String := Text.Element(I)(M .. N);
            New_Word: String := Ada.Text_IO.Get_Line;
         begin
            for J in I .. Text.Last_Index loop
               Text.Replace_Element(J, Replace(Text.Element(J), Old, New_Word));
            end loop;
         end;
      end loop;
   end loop;

   -- write the text
   for I in Text.First_Index .. Text.Last_Index loop
      Ada.Text_IO.Put_Line(Text.Element(I));
   end loop;
end Madlib;


file f;
data b;
list l;
record r;

f.stdin;

o_text("Enter the blank line terminated story:\n");

while (0 < f.b_line(b)) {
    l.append(b);
}

for (, b in l) {
    integer p, q;
    text s, t;

    while ((p = b.place('<')) ^ -1) {
        q = b.probe(p, '>');
        if (q ^ -1) {
            s = bq_string(b, p + 1, q - 1);
            b.erase(p, q);
            if (!r.key(s)) {
                o_("Replacement for `", s, "':\n");
                f.line(t);
                r.put(s, t);
            }
            b.paste(p, r[s]);
        }
    }
}

l.ucall(o_, 0, "\n");


# Mad Libs style story generation                                        #

# gets the story template from the file f. The template terminates with  #
# a blank line                                                           #
# The user is then promoted for the replacements for the <word> markers  #
# and the story is printed with the substitutions made                   #
PROC story = ( REF FILE f )VOID:
BEGIN

    # a linked list of strings, used to hold the story template          #
    MODE STRINGLIST = STRUCT( STRING text, REF STRINGLIST next );

    # a linked list of pairs of strings, used to hold the replacements   #
    MODE REPLACEMENTLIST = STRUCT( STRING word
                                 , STRING replacement
                                 , REF REPLACEMENTLIST next
                                 );

    # NIL reference for marking the end of a STRINGLIST                  #
    REF STRINGLIST      nil stringlist      = NIL;

    # NIL reference for marking the end of a REPLACEMENTLIST             #
    REF REPLACEMENTLIST nil replacementlist = NIL;

    # returns "text" with trailing spaces removed                        #
    OP RTRIM = ( STRING text )STRING:
    BEGIN
        INT trim pos := UPB text;
        FOR text pos FROM UPB text BY -1 TO LWB text WHILE text[ text pos ] = " "
        DO
            trim pos := text pos - 1
        OD;

        text[ LWB text : trim pos ]
    END; # RTRIM #

    # looks for word in the dictionary. If it is found, replacement is   #
    # set to its replacement and TRUE is returned. If word not present,  #
    # FALSE is returned - uses recursion                                 #
    PROC find replacement = ( STRING word
                            , REF STRING replacement
                            , REF REPLACEMENTLIST dictionary
                            )BOOL:
        IF   dictionary IS nil replacementlist
        THEN
            FALSE
        ELIF word OF dictionary = word
        THEN
            replacement := replacement OF dictionary;
            TRUE
        ELSE
            find replacement( word, replacement, next OF dictionary )
        FI; # find replacement #

    # read the story template                                            #

    # the result has a dummy element so "next OF next" is always valid   #
    REF STRINGLIST     story := HEAP STRINGLIST := ( "dummy", nil stringlist );
    REF REF STRINGLIST next  := story;

    # read the story template, terminates with a blank line              #

    WHILE
        STRING text;
        get( f, ( text, newline ) );
        text := RTRIM text;
        text /= ""
    DO
        # add the line to the end of the list #
        next := ( next OF next ) := HEAP STRINGLIST := ( text, nil stringlist )
    OD;

    # find the <word> markers in the story and replace them with the     #
    # user's chosen text - we ignore the dummy element at the start      #

    REF REPLACEMENTLIST dictionary := nil replacementlist;
    REF STRINGLIST      line       := story;

    WHILE line := next OF line;
          line ISNT nil stringlist
    DO
        # have a line of text - replace all the <word> markers in it     #
        STRING word, replacement;
        INT start pos, end pos;
        WHILE char in string( "<", start pos, text OF line )
          AND char in string( ">", end pos,   text OF line )
        DO
            # have a marker, get it from the line                        #
            word := ( text OF line )[ start pos : end pos ];
            # get its replacement                                        #
            IF NOT find replacement( word, replacement, dictionary )
            THEN
                # we don't already have a replacement for word           #
                # get one from the user and add it to the dictionary     #
                print( ( "What should replace ", word, "? " ) );
                read( ( replacement, newline ) );
                dictionary := HEAP REPLACEMENTLIST := ( word, replacement, dictionary )
            FI;
            # replace <word> with the replacement                        #
            text OF line := ( text OF line )[ : start pos - 1 ]
                          + replacement
                          + ( text OF line )[ end pos + 1 : ]
        OD
    OD;

    # print the story, ignoring the dummy element at the start           #

    line := story;

    WHILE line := next OF line;
          line ISNT nil stringlist
    DO
        print( ( text OF line, newline ) )
    OD

END; # story #

main:(

    # we read the template from stand in (the keyboard unless it's been  #
    # redirected) we could prompt the user for a template file name,     #
    # open it and read that instead...                                   #
    print( ( "Please Enter the story template terminated by a blank line", newline ) );
    story( stand in )

)


open System.Drawing
open System.Windows.Forms
type Complex =
    {
        re : float;
        im : float
    }
let cplus (x:Complex) (y:Complex) : Complex =
    {
        re = x.re + y.re;
        im = x.im + y.im
    }
let cmult (x:Complex) (y:Complex) : Complex =
    {
        re = x.re * y.re - x.im * y.im;
        im = x.re * y.im + x.im * y.re;
    }

let norm (x:Complex) : float =
    x.re*x.re + x.im*x.im

type Mandel = class
    inherit Form
    static member xPixels = 500
    static member yPixels = 500
    val mutable bmp : Bitmap
    member x.mandelbrot xMin xMax yMin yMax maxIter =
        let rec mandelbrotIterator z c n =
            if (norm z) > 2.0 then false else
                match n with
                    | 0 -> true
                    | n -> let z' = cplus ( cmult z z ) c in
                            mandelbrotIterator z' c (n-1)
        let dx = (xMax - xMin) / (float (Mandel.xPixels))
        let dy = (yMax - yMin) / (float (Mandel.yPixels))
        in
        for xi = 0 to Mandel.xPixels-1 do
            for yi = 0 to Mandel.yPixels-1 do
                let c = {re = xMin + (dx * float(xi) ) ;
                         im = yMin + (dy * float(yi) )} in
                if (mandelbrotIterator {re=0.;im=0.;} c maxIter) then
                    x.bmp.SetPixel(xi,yi,Color.Azure)
                else
                    x.bmp.SetPixel(xi,yi,Color.Black)
            done
        done

    member public x.generate () = x.mandelbrot (-1.5) 0.5 (-1.0) 1.0 200 ; x.Refresh()

    new() as x = {bmp = new Bitmap(Mandel.xPixels , Mandel.yPixels)} then
        x.Text <- "Mandelbrot set" ;
        x.Width <- Mandel.xPixels ;
        x.Height <- Mandel.yPixels ;
        x.BackgroundImage <- x.bmp;
        x.generate();
        x.Show();
end

let f = new Mandel()
do Application.Run(f)


set theNoun to the text returned of (display dialog "What is your noun?" default answer "")

set thePerson to the text returned of (display dialog "What is the person's name?" default answer "")

set theGender to the text returned of (display dialog "He or she? Please capitalize." default answer "")

display dialog thePerson & " went for a walk in the park. " & theGender & " found a " & theNoun & ".  " & thePerson & " decided to take it home."


 100  DIM L$(100),W$(50),T$(50)
 110  LET M$ =  CHR$ (13)
 120  FOR L = 1 TO 1E9
 130      READ L$(L)
 140      IF  LEN (L$(L)) THEN  NEXT L
 150  FOR I = 1 TO L
 160      LET M = 0
 170      LET N$(0) = ""
 180      FOR J = 1 TO  LEN (L$(I))
 190          LET C$ =  MID$ (L$(I),J,1)
 200          IF C$ = "<" AND  NOT M THEN M = 1:C$ = "":N$(M) = ""
 210          IF C$ = ">" AND M THEN  GOSUB 300:M = 0:C$ = W$(Z)
 220      LET N$(M) = N$(M) + C$
 230      NEXT J
 240      LET L$(I) = N$(0)
 250  NEXT I
 260  FOR I = 1 TO L
 270      PRINT M$L$(I);
 280  NEXT
 290  END
 300  FOR Z = 0 TO T
 310      IF T$(Z) = N$(M) THEN  RETURN
 320  NEXT Z
 330  LET T = Z
 340  LET T$(Z) = N$(M)
 350  PRINT M$"ENTER A "T$(Z);
 360  INPUT "? ";W$(Z)
 370  RETURN
 380  DATA "<NAME> WENT FOR A WALK IN THE PARK. <HE OR SHE>"
 390  DATA "FOUND A <NOUN>. <NAME> DECIDED TO TAKE IT HOME."
 990  DATA


! with ("::") or without (":") generalizations:
! : [a..b] ( steps a b -- a..b ) 2dup swap - 4 nrot 1 - / <range> ;
::  [a..b] ( steps a b -- a..b ) a b b a - steps 1 - / <range> ;

: >char ( n -- c )
    dup -1 = [ drop 32 ] [ 26 mod CHAR: a + ] if ;

! iterates z' = z^2 + c, Factor does complex numbers!
: iter ( c z -- z' ) dup * + ;

: unbound ( c -- ? ) absq 4 > ;

:: mz ( c max i z -- n )
  {
    { [ i max >= ] [ -1 ] }
    { [ z unbound ] [ i ] }
    [ c max i 1 + c z iter mz ]
  } cond ;

: mandelzahl ( c max -- n ) 0 0 mz ;

:: mandel ( w h max -- )
    h -1. 1. [a..b] ! range over y
    [   w -2. 1. [a..b] ! range over x
        [ dupd swap rect> max mandelzahl >char ] map
        >string print
        drop ! old y
    ] each
    ;

70 25 1000 mandel


#!/usr/bin/env fennel

(fn mandelzahl [cr ci max i tr ti tr2 ti2]
  "Calculates the Mandelbrot escape number of a complex point c"
  (if (>= i max)         -1
      (>= (+ tr2 ti2) 4)  i
      (let [(tr ti) (values (+ (- tr2 ti2) cr)
                            (+ (* tr ti 2) ci))]
        (mandelzahl cr ci max (+ i 1)
                    tr ti (* tr tr) (* ti ti)))))

(fn mandel [w h max]
  "Entry point, generate a 'graphical' representation of the Mandelbrot set"
  (for [y -1.0 1.0 (/ 2.0 h)]
    (var line {})
    (for [x -2.0 1.0 (/ 3.0 w)]
      (let [mz (mandelzahl x y max 0 0 0 0 0)]
        (tset line (+ (length line) 1)
              (or (and (< mz 0) " ")
                  (string.char (+ (string.byte :a) (% mz 26)))))))
    (print (table.concat line))))

(fn arg-def [pos default]
  "A helper fn to extract command line parameter with defaults"
  (or (tonumber (and arg (. arg pos))) default))

(let [width  (arg-def 1 140)
      height (arg-def 2 50)
      max    (arg-def 3 1e5)]
  (mandel width height max))


story: strip input "Enter a story: "
vars: unique map match story {/\|([^\|]+)\|/} 'v -> replace v "|" ""

i: 0
while [i < size vars].import [
    let vars\[i] input ~"Enter value for <|vars\[i]|>: "
    i: i + 1
]

print ~story


FileSelectFile, filename, , %A_ScriptDir%, Select a Mad Libs template, *.txt
If ErrorLevel
	ExitApp ; the user canceled the file selection
FileRead, contents, %filename%
pos := match := 0
While pos := RegExMatch(contents, "<[^>]+>", match, pos+strLen(match))
{
	InputBox, repl, Mad Libs, Enter a replacement for %match%:
	If ErrorLevel ; cancelled inputbox
		ExitApp
	StringReplace, contents, contents, %match%, %repl%, All
}
MsgBox % contents


# syntax: GAWK -f MAD_LIBS.AWK
BEGIN {
    print("enter story:")
}
{   story_arr[++nr] = $0
    if ($0 ~ /^ *$/) {
      exit
    }
    while ($0 ~ /[<>]/) {
      L = index($0,"<")
      R = index($0,">")
      changes_arr[substr($0,L,R-L+1)] = ""
      sub(/</,"",$0)
      sub(/>/,"",$0)
    }
}
END {
    PROCINFO["sorted_in"] = "@ind_str_asc"
    print("enter values for:")
    for (i in changes_arr) { # prompt for replacement values
      printf("%s ",i)
      getline rec
      sub(/ +$/,"",rec)
      changes_arr[i] = rec
    }
    printf("\nrevised story:\n")
    for (i=1; i<=nr; i++) { # print the story
      for (j in changes_arr) {
        gsub(j,changes_arr[j],story_arr[i])
      }
      printf("%s\n",story_arr[i])
    }
    exit(0)
}


500 value max-iter

: mandel ( gmp  F: imin imax rmin rmax -- )
  0e 0e { F: imin F: imax F: rmin F: rmax F: Zr F: Zi }
  dup bheight 0 do
    i s>f dup bheight s>f f/ imax imin f- f* imin f+ TO Zi
    dup bwidth 0 do
      i s>f dup bwidth s>f f/ rmax rmin f- f* rmin f+ TO Zr
      Zr Zi max-iter
      begin  1- dup
      while  fover fdup f* fover fdup f*
             fover fover f+ 4e f<
      while  f- Zr f+
             frot frot f* 2e f* Zi f+
      repeat fdrop fdrop
             drop 0        \ for a pretty grayscale image, replace with: 255 max-iter */
      else   drop 255
      then   fdrop fdrop
      over i j rot g!
    loop
  loop    drop ;

80 24 graymap
dup -1e 1e -2e 1e mandel


cadena = "<name> went for a walk in the park. <he or she> found a <noun>. <name> decided to take it home."
k = instr(cadena, "<")

print "La historia: " : print cadena : print
while k
	reemplaza = mid(cadena, k, instr(cadena, ">") - k + 1)
	print "What should replace "; reemplaza; : input " ", con
	while k
		cadena = left(cadena, k-1) + con + mid(cadena, k + length(reemplaza), length(cadena))
		k = instr(cadena, reemplaza, k)
	end while
	k = instr(cadena, "<", length(reemplaza))
end while
print : print "La historia final: " : print cadena
end


#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define err(...) fprintf(stderr, ## __VA_ARGS__), exit(1)

/* We create a dynamic string with a few functions which make modifying
 * the string and growing a bit easier */
typedef struct {
    char *data;
    size_t alloc;
    size_t length;
} dstr;

inline int dstr_space(dstr *s, size_t grow_amount)
{
    return s->length + grow_amount < s->alloc;
}

int dstr_grow(dstr *s)
{
    s->alloc *= 2;
    char *attempt = realloc(s->data, s->alloc);

    if (!attempt) return 0;
    else s->data = attempt;

    return 1;
}

dstr* dstr_init(const size_t to_allocate)
{
    dstr *s = malloc(sizeof(dstr));
    if (!s) goto failure;

    s->length = 0;
    s->alloc  = to_allocate;
    s->data   = malloc(s->alloc);

    if (!s->data) goto failure;

    return s;

failure:
    if (s->data) free(s->data);
    if (s) free(s);
    return NULL;
}

void dstr_delete(dstr *s)
{
    if (s->data) free(s->data);
    if (s) free(s);
}

dstr* readinput(FILE *fd)
{
    static const size_t buffer_size = 4096;
    char buffer[buffer_size];

    dstr *s = dstr_init(buffer_size);
    if (!s) goto failure;

    while (fgets(buffer, buffer_size, fd)) {
        while (!dstr_space(s, buffer_size))
            if (!dstr_grow(s)) goto failure;

        strncpy(s->data + s->length, buffer, buffer_size);
        s->length += strlen(buffer);
    }

    return s;

failure:
    dstr_delete(s);
    return NULL;
}

void dstr_replace_all(dstr *story, const char *replace, const char *insert)
{
    const size_t replace_l = strlen(replace);
    const size_t insert_l  = strlen(insert);
    char *start = story->data;

    while ((start = strstr(start, replace))) {
        if (!dstr_space(story, insert_l - replace_l))
            if (!dstr_grow(story)) err("Failed to allocate memory");

        if (insert_l != replace_l) {
            memmove(start + insert_l, start + replace_l, story->length -
                    (start + replace_l - story->data));

            /* Remember to null terminate the data so we can utilize it
             * as we normally would */
            story->length += insert_l - replace_l;
            story->data[story->length] = 0;
        }

        memmove(start, insert, insert_l);
    }
}

void madlibs(dstr *story)
{
    static const size_t buffer_size = 128;
    char insert[buffer_size];
    char replace[buffer_size];

    char *start,
         *end = story->data;

    while (start = strchr(end, '<')) {
        if (!(end = strchr(start, '>'))) err("Malformed brackets in input");

        /* One extra for current char and another for nul byte */
        strncpy(replace, start, end - start + 1);
        replace[end - start + 1] = '\0';

        printf("Enter value for field %s: ", replace);

        fgets(insert, buffer_size, stdin);
        const size_t il = strlen(insert) - 1;
        if (insert[il] == '\n')
            insert[il] = '\0';

        dstr_replace_all(story, replace, insert);
    }
    printf("\n");
}

int main(int argc, char *argv[])
{
    if (argc < 2) return 0;

    FILE *fd = fopen(argv[1], "r");
    if (!fd) err("Could not open file: '%s\n", argv[1]);

    dstr *story = readinput(fd); fclose(fd);
    if (!story) err("Failed to allocate memory");

    madlibs(story);
    printf("%s\n", story->data);
    dstr_delete(story);
    return 0;
}


program mandelbrot

  implicit none
  integer  , parameter :: rk       = selected_real_kind (9, 99)
  integer  , parameter :: i_max    =  800
  integer  , parameter :: j_max    =  600
  integer  , parameter :: n_max    =  100
  real (rk), parameter :: x_centre = -0.5_rk
  real (rk), parameter :: y_centre =  0.0_rk
  real (rk), parameter :: width    =  4.0_rk
  real (rk), parameter :: height   =  3.0_rk
  real (rk), parameter :: dx_di    =   width / i_max
  real (rk), parameter :: dy_dj    = -height / j_max
  real (rk), parameter :: x_offset = x_centre - 0.5_rk * (i_max + 1) * dx_di
  real (rk), parameter :: y_offset = y_centre - 0.5_rk * (j_max + 1) * dy_dj
  integer, dimension (i_max, j_max) :: image
  integer   :: i
  integer   :: j
  integer   :: n
  real (rk) :: x
  real (rk) :: y
  real (rk) :: x_0
  real (rk) :: y_0
  real (rk) :: x_sqr
  real (rk) :: y_sqr

  do j = 1, j_max
    y_0 = y_offset + dy_dj * j
    do i = 1, i_max
      x_0 = x_offset + dx_di * i
      x = 0.0_rk
      y = 0.0_rk
      n = 0
      do
        x_sqr = x ** 2
        y_sqr = y ** 2
        if (x_sqr + y_sqr > 4.0_rk) then
          image (i, j) = 255
          exit
        end if
        if (n == n_max) then
          image (i, j) = 0
          exit
        end if
        y = y_0 + 2.0_rk * x * y
        x = x_0 + x_sqr - y_sqr
        n = n + 1
      end do
    end do
  end do
  open  (10, file = 'out.pgm')
  write (10, '(a/ i0, 1x, i0/ i0)') 'P2', i_max, j_max, 255
  write (10, '(i0)') image
  close (10)

end program mandelbrot


#include <iostream>
#include <string>
using namespace std;

int main()
{
  string story, input;

  //Loop
  while(true)
  {
    //Get a line from the user
    getline(cin, input);

    //If it's blank, break this loop
    if(input == "\r")
      break;

    //Add the line to the story
    story += input;
  }

  //While there is a '<' in the story
  int begin;
  while((begin = story.find("<")) != string::npos)
  {
    //Get the category from between '<' and '>'
    int end = story.find(">");
    string cat = story.substr(begin + 1, end - begin - 1);

    //Ask the user for a replacement
    cout << "Give me a " << cat << ": ";
    cin >> input;

    //While there's a matching category
    //in the story
    while((begin = story.find("<" + cat + ">")) != string::npos)
    {
      //Replace it with the user's replacement
      story.replace(begin, cat.length()+2, input);
    }
  }

  //Output the final story
  cout << endl << story;

  return 0;
}