Color SVG Mandelbrot in BechML

mandelbrot_color.bml

use Core.*;

scale : int := 1000;
xMin : int := Int.sub 0 2500;
xMax : int := 1000;
yMin : int := Int.sub 0 1750;
yMax : int := 1750;

size : int := 256;
cellPx : int := 4;
maxIter : int := 50;
escapeSquared : int := 4000000;

xRange : int := Int.sub xMax xMin;
yRange : int := Int.sub yMax yMin;

squaredScaled : int -> int := \x -> Int.div (Int.mul x x) scale;

mandelbrotStep : int -> int -> int -> int -> int -> int := \cRe cIm zRe zIm iter ->
  if Int.geq iter maxIter then maxIter
  else
    (\zReSquared zImSquared ->
      (\magnitude ->
        if Int.gt magnitude escapeSquared then iter
        else
          (\newRe newIm ->
            mandelbrotStep cRe cIm newRe newIm (Int.add iter 1)
          ) (Int.add (Int.sub zReSquared zImSquared) cRe)
            (Int.add (Int.div (Int.mul (Int.mul 2 zRe) zIm) scale) cIm)
      ) (Int.add zReSquared zImSquared)
    ) (squaredScaled zRe) (squaredScaled zIm);

computePoint : int -> int -> int := \cRe cIm ->
  mandelbrotStep cRe cIm 0 0 0;

iterToColor : int -> string := \n ->
  if Int.geq n maxIter then "rgb(0,0,32)"
  else if Int.geq n 40 then "rgb(0,0,128)"
  else if Int.geq n 30 then "rgb(0,0,255)"
  else if Int.geq n 25 then "rgb(0,128,255)"
  else if Int.geq n 20 then "rgb(0,255,255)"
  else if Int.geq n 15 then "rgb(128,255,128)"
  else if Int.geq n 10 then "rgb(255,255,0)"
  else if Int.geq n 5 then "rgb(255,165,0)"
  else "rgb(255,0,0)";

posToStr : int -> string := \i ->
  if Int.eq i 0 then "0"
  else if Int.eq i 1 then "4"
  else if Int.eq i 2 then "8"
  else if Int.eq i 3 then "12"
  else if Int.eq i 4 then "16"
  else if Int.eq i 5 then "20"
  else if Int.eq i 6 then "24"
  else if Int.eq i 7 then "28"
  else if Int.eq i 8 then "32"
  else if Int.eq i 9 then "36"
  else if Int.eq i 10 then "40"
  else if Int.eq i 11 then "44"
  else if Int.eq i 12 then "48"
  else if Int.eq i 13 then "52"
  else if Int.eq i 14 then "56"
  else if Int.eq i 15 then "60"
  else if Int.eq i 16 then "64"
  else if Int.eq i 17 then "68"
  else if Int.eq i 18 then "72"
  else if Int.eq i 19 then "76"
  else if Int.eq i 20 then "80"
  else if Int.eq i 21 then "84"
  else if Int.eq i 22 then "88"
  else if Int.eq i 23 then "92"
  else if Int.eq i 24 then "96"
  else if Int.eq i 25 then "100"
  else if Int.eq i 26 then "104"
  else if Int.eq i 27 then "108"
  else if Int.eq i 28 then "112"
  else if Int.eq i 29 then "116"
  else if Int.eq i 30 then "120"
  else if Int.eq i 31 then "124"
  else if Int.eq i 32 then "128"
  else if Int.eq i 33 then "132"
  else if Int.eq i 34 then "136"
  else if Int.eq i 35 then "140"
  else if Int.eq i 36 then "144"
  else if Int.eq i 37 then "148"
  else if Int.eq i 38 then "152"
  else if Int.eq i 39 then "156"
  else if Int.eq i 40 then "160"
  else if Int.eq i 41 then "164"
  else if Int.eq i 42 then "168"
  else if Int.eq i 43 then "172"
  else if Int.eq i 44 then "176"
  else if Int.eq i 45 then "180"
  else if Int.eq i 46 then "184"
  else if Int.eq i 47 then "188"
  else if Int.eq i 48 then "192"
  else if Int.eq i 49 then "196"
  else if Int.eq i 50 then "200"
  else if Int.eq i 51 then "204"
  else if Int.eq i 52 then "208"
  else if Int.eq i 53 then "212"
  else if Int.eq i 54 then "216"
  else if Int.eq i 55 then "220"
  else if Int.eq i 56 then "224"
  else if Int.eq i 57 then "228"
  else if Int.eq i 58 then "232"
  else if Int.eq i 59 then "236"
  else if Int.eq i 60 then "240"
  else if Int.eq i 61 then "244"
  else if Int.eq i 62 then "248"
  else if Int.eq i 63 then "252"
  else if Int.eq i 64 then "256"
  else if Int.eq i 65 then "260"
  else if Int.eq i 66 then "264"
  else if Int.eq i 67 then "268"
  else if Int.eq i 68 then "272"
  else if Int.eq i 69 then "276"
  else if Int.eq i 70 then "280"
  else if Int.eq i 71 then "284"
  else if Int.eq i 72 then "288"
  else if Int.eq i 73 then "292"
  else if Int.eq i 74 then "296"
  else if Int.eq i 75 then "300"
  else if Int.eq i 76 then "304"
  else if Int.eq i 77 then "308"
  else if Int.eq i 78 then "312"
  else if Int.eq i 79 then "316"
  else if Int.eq i 80 then "320"
  else if Int.eq i 81 then "324"
  else if Int.eq i 82 then "328"
  else if Int.eq i 83 then "332"
  else if Int.eq i 84 then "336"
  else if Int.eq i 85 then "340"
  else if Int.eq i 86 then "344"
  else if Int.eq i 87 then "348"
  else if Int.eq i 88 then "352"
  else if Int.eq i 89 then "356"
  else if Int.eq i 90 then "360"
  else if Int.eq i 91 then "364"
  else if Int.eq i 92 then "368"
  else if Int.eq i 93 then "372"
  else if Int.eq i 94 then "376"
  else if Int.eq i 95 then "380"
  else if Int.eq i 96 then "384"
  else if Int.eq i 97 then "388"
  else if Int.eq i 98 then "392"
  else if Int.eq i 99 then "396"
  else if Int.eq i 100 then "400"
  else if Int.eq i 101 then "404"
  else if Int.eq i 102 then "408"
  else if Int.eq i 103 then "412"
  else if Int.eq i 104 then "416"
  else if Int.eq i 105 then "420"
  else if Int.eq i 106 then "424"
  else if Int.eq i 107 then "428"
  else if Int.eq i 108 then "432"
  else if Int.eq i 109 then "436"
  else if Int.eq i 110 then "440"
  else if Int.eq i 111 then "444"
  else if Int.eq i 112 then "448"
  else if Int.eq i 113 then "452"
  else if Int.eq i 114 then "456"
  else if Int.eq i 115 then "460"
  else if Int.eq i 116 then "464"
  else if Int.eq i 117 then "468"
  else if Int.eq i 118 then "472"
  else if Int.eq i 119 then "476"
  else if Int.eq i 120 then "480"
  else if Int.eq i 121 then "484"
  else if Int.eq i 122 then "488"
  else if Int.eq i 123 then "492"
  else if Int.eq i 124 then "496"
  else if Int.eq i 125 then "500"
  else if Int.eq i 126 then "504"
  else if Int.eq i 127 then "508"
  else if Int.eq i 128 then "512"
  else if Int.eq i 129 then "516"
  else if Int.eq i 130 then "520"
  else if Int.eq i 131 then "524"
  else if Int.eq i 132 then "528"
  else if Int.eq i 133 then "532"
  else if Int.eq i 134 then "536"
  else if Int.eq i 135 then "540"
  else if Int.eq i 136 then "544"
  else if Int.eq i 137 then "548"
  else if Int.eq i 138 then "552"
  else if Int.eq i 139 then "556"
  else if Int.eq i 140 then "560"
  else if Int.eq i 141 then "564"
  else if Int.eq i 142 then "568"
  else if Int.eq i 143 then "572"
  else if Int.eq i 144 then "576"
  else if Int.eq i 145 then "580"
  else if Int.eq i 146 then "584"
  else if Int.eq i 147 then "588"
  else if Int.eq i 148 then "592"
  else if Int.eq i 149 then "596"
  else if Int.eq i 150 then "600"
  else if Int.eq i 151 then "604"
  else if Int.eq i 152 then "608"
  else if Int.eq i 153 then "612"
  else if Int.eq i 154 then "616"
  else if Int.eq i 155 then "620"
  else if Int.eq i 156 then "624"
  else if Int.eq i 157 then "628"
  else if Int.eq i 158 then "632"
  else if Int.eq i 159 then "636"
  else if Int.eq i 160 then "640"
  else if Int.eq i 161 then "644"
  else if Int.eq i 162 then "648"
  else if Int.eq i 163 then "652"
  else if Int.eq i 164 then "656"
  else if Int.eq i 165 then "660"
  else if Int.eq i 166 then "664"
  else if Int.eq i 167 then "668"
  else if Int.eq i 168 then "672"
  else if Int.eq i 169 then "676"
  else if Int.eq i 170 then "680"
  else if Int.eq i 171 then "684"
  else if Int.eq i 172 then "688"
  else if Int.eq i 173 then "692"
  else if Int.eq i 174 then "696"
  else if Int.eq i 175 then "700"
  else if Int.eq i 176 then "704"
  else if Int.eq i 177 then "708"
  else if Int.eq i 178 then "712"
  else if Int.eq i 179 then "716"
  else if Int.eq i 180 then "720"
  else if Int.eq i 181 then "724"
  else if Int.eq i 182 then "728"
  else if Int.eq i 183 then "732"
  else if Int.eq i 184 then "736"
  else if Int.eq i 185 then "740"
  else if Int.eq i 186 then "744"
  else if Int.eq i 187 then "748"
  else if Int.eq i 188 then "752"
  else if Int.eq i 189 then "756"
  else if Int.eq i 190 then "760"
  else if Int.eq i 191 then "764"
  else if Int.eq i 192 then "768"
  else if Int.eq i 193 then "772"
  else if Int.eq i 194 then "776"
  else if Int.eq i 195 then "780"
  else if Int.eq i 196 then "784"
  else if Int.eq i 197 then "788"
  else if Int.eq i 198 then "792"
  else if Int.eq i 199 then "796"
  else if Int.eq i 200 then "800"
  else if Int.eq i 201 then "804"
  else if Int.eq i 202 then "808"
  else if Int.eq i 203 then "812"
  else if Int.eq i 204 then "816"
  else if Int.eq i 205 then "820"
  else if Int.eq i 206 then "824"
  else if Int.eq i 207 then "828"
  else if Int.eq i 208 then "832"
  else if Int.eq i 209 then "836"
  else if Int.eq i 210 then "840"
  else if Int.eq i 211 then "844"
  else if Int.eq i 212 then "848"
  else if Int.eq i 213 then "852"
  else if Int.eq i 214 then "856"
  else if Int.eq i 215 then "860"
  else if Int.eq i 216 then "864"
  else if Int.eq i 217 then "868"
  else if Int.eq i 218 then "872"
  else if Int.eq i 219 then "876"
  else if Int.eq i 220 then "880"
  else if Int.eq i 221 then "884"
  else if Int.eq i 222 then "888"
  else if Int.eq i 223 then "892"
  else if Int.eq i 224 then "896"
  else if Int.eq i 225 then "900"
  else if Int.eq i 226 then "904"
  else if Int.eq i 227 then "908"
  else if Int.eq i 228 then "912"
  else if Int.eq i 229 then "916"
  else if Int.eq i 230 then "920"
  else if Int.eq i 231 then "924"
  else if Int.eq i 232 then "928"
  else if Int.eq i 233 then "932"
  else if Int.eq i 234 then "936"
  else if Int.eq i 235 then "940"
  else if Int.eq i 236 then "944"
  else if Int.eq i 237 then "948"
  else if Int.eq i 238 then "952"
  else if Int.eq i 239 then "956"
  else if Int.eq i 240 then "960"
  else if Int.eq i 241 then "964"
  else if Int.eq i 242 then "968"
  else if Int.eq i 243 then "972"
  else if Int.eq i 244 then "976"
  else if Int.eq i 245 then "980"
  else if Int.eq i 246 then "984"
  else if Int.eq i 247 then "988"
  else if Int.eq i 248 then "992"
  else if Int.eq i 249 then "996"
  else if Int.eq i 250 then "1000"
  else if Int.eq i 251 then "1004"
  else if Int.eq i 252 then "1008"
  else if Int.eq i 253 then "1012"
  else if Int.eq i 254 then "1016"
  else "1020";

sq : string := "'";

printQuoted : string -> io () := \s ->
  IO.monad.bind (IO.print sq) (\_ ->
  IO.monad.bind (IO.print s) (\_ ->
  IO.print sq));

printRectXY : int -> int -> io () := \row col ->
  IO.monad.bind (IO.print "<rect x=") (\_ ->
  IO.monad.bind (printQuoted (posToStr col)) (\_ ->
  IO.monad.bind (IO.print " y=") (\_ ->
    printQuoted (posToStr row))));

printRectSize : io () :=
  IO.monad.bind (IO.print " width=") (\_ ->
  IO.monad.bind (printQuoted "4") (\_ ->
  IO.monad.bind (IO.print " height=") (\_ ->
    printQuoted "4")));

printRectFill : int -> io () := \iters ->
  IO.monad.bind (IO.print " fill=") (\_ ->
  IO.monad.bind (printQuoted (iterToColor iters)) (\_ ->
  IO.print "/>"));

printRectStart : int -> int -> io () := \row col ->
  IO.monad.bind (printRectXY row col) (\_ ->
  IO.monad.bind (printRectSize) (\_ ->
    IO.print " fill="));

printRectEnd : int -> io () := \iters ->
  IO.monad.bind (printQuoted (iterToColor iters)) (\_ ->
  IO.print "/>");

printRectAttrs : int -> int -> int -> io () := \row col iters ->
  IO.monad.bind (printRectStart row col) (\_ ->
    printRectEnd iters);

printOnePixel : int -> int -> io () := \row col ->
  (\cRe cIm ->
    (\iters -> printRectAttrs row col iters) (computePoint cRe cIm)
  ) (Int.add xMin (Int.div (Int.mul col xRange) size))
    (Int.add yMin (Int.div (Int.mul row yRange) size));

printRowPixels : int -> int -> io () := \row col ->
  if Int.geq col size then IO.applicative.pure ()
  else
    IO.monad.bind (printOnePixel row col) (\_ ->
      printRowPixels row (Int.add col 1));

printRows : int -> io () := \row ->
  if Int.geq row size then IO.applicative.pure ()
  else
    IO.monad.bind (printRowPixels row 0) (\_ ->
      printRows (Int.add row 1));

printSvgOpen : io () :=
  IO.monad.bind (IO.print "<svg xmlns='http://www.w3.org/2000/svg' width=") (\_ ->
  IO.monad.bind (printQuoted "1024") (\_ ->
  IO.monad.bind (IO.print " height=") (\_ ->
  IO.monad.bind (printQuoted "1024") (\_ ->
  IO.print ">"))));

printBody : io () :=
  IO.monad.bind (printSvgOpen) (\_ ->
  IO.monad.bind (printRows 0) (\_ ->
  IO.print "</svg>"));

main : io () := printBody;