sordina/html_hilbert.hs

## html_hilbert.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE FlexibleInstances #-}

import Text.InterpolatedString.Perl6
import Text.Printf

type Coord = (Integer, Integer)

main :: IO ()
main = putStrLn $ document $ zip [0..] $ scanl (+>) (0,0) (iterate build base !! 6)

document :: [(Int,Coord)] -> String
document pairs = [qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
  <html>
    <head> <title>Hilbert Index</title> </head>
    <body>
        <h1>Hilbert Index</h1>
        <svg width="650" height="650" viewBox="0 0 600 600" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
          $paths
        </svg> </body></html> |] where paths = unlines (map (path (length pairs)) pairs)

path :: Int -> (Int, Coord) -> String
path len (index, (x1,y1)) = [qq| <rect x="{x1 * 4}" width="4" y="{y1 * 4}" height="4" fill="rgba(0,0,0,{c})" /> |]
  where c :: String
        c = printf "%0.8f" (f index/ f len)

(+>) :: (Num t, Num t1) => (t, t1) -> (t, t1) -> (t, t1)
(a,b) +> (c,d) = (a+c, b+d)

base :: [Coord]
base = [(0,1),(1,0),(0,-1)]

build :: [Coord] -> [Coord]
build x = l $ n x ++ o ++ r (r (l (x ++ o ++ x) ++ o ++ n x))

o :: [Coord]
o = [(1,0)]

l, r, n :: [Coord] -> [Coord]
l = map anticlockwise
r = map clockwise
n = reverse

anticlockwise :: (Eq t1, Eq t, Num t1, Num t) => (t1, t) -> (t, t1)
anticlockwise  (0,y) = (-y,0)
anticlockwise  (x,0) = (0, x)
anticlockwise  _     = error "Should only match zero cases"

clockwise :: (Eq t1, Eq t, Num t1, Num t) => (t1, t) -> (t, t1)
clockwise (0,y) = (y, 0)
clockwise (x,0) = (0,-x)
clockwise  _    = error "Should only match zero cases"

-- Specialised conversion
f :: Int -> Double
f = fromIntegral

	{-# LANGUAGE TemplateHaskell #-}
	{-# LANGUAGE QuasiQuotes #-}
	{-# LANGUAGE FlexibleInstances #-}

	import Text.InterpolatedString.Perl6
	import Text.Printf

	type Coord = (Integer, Integer)

	main :: IO ()
	main = putStrLn $ document $ zip [0..] $ scanl (+>) (0,0) (iterate build base !! 6)

	document :: [(Int,Coord)] -> String
	document pairs = [qq\|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
	<html>
	<head> <title>Hilbert Index</title> </head>
	<body>
	<h1>Hilbert Index</h1>
	<svg width="650" height="650" viewBox="0 0 600 600" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
	$paths
	</svg> </body></html> \|] where paths = unlines (map (path (length pairs)) pairs)

	path :: Int -> (Int, Coord) -> String
	path len (index, (x1,y1)) = [qq\| <rect x="{x1 * 4}" width="4" y="{y1 * 4}" height="4" fill="rgba(0,0,0,{c})" /> \|]
	where c :: String
	c = printf "%0.8f" (f index/ f len)

	(+>) :: (Num t, Num t1) => (t, t1) -> (t, t1) -> (t, t1)
	(a,b) +> (c,d) = (a+c, b+d)

	base :: [Coord]
	base = [(0,1),(1,0),(0,-1)]

	build :: [Coord] -> [Coord]
	build x = l $ n x ++ o ++ r (r (l (x ++ o ++ x) ++ o ++ n x))

	o :: [Coord]
	o = [(1,0)]

	l, r, n :: [Coord] -> [Coord]
	l = map anticlockwise
	r = map clockwise
	n = reverse

	anticlockwise :: (Eq t1, Eq t, Num t1, Num t) => (t1, t) -> (t, t1)
	anticlockwise (0,y) = (-y,0)
	anticlockwise (x,0) = (0, x)
	anticlockwise _ = error "Should only match zero cases"

	clockwise :: (Eq t1, Eq t, Num t1, Num t) => (t1, t) -> (t, t1)
	clockwise (0,y) = (y, 0)
	clockwise (x,0) = (0,-x)
	clockwise _ = error "Should only match zero cases"

	-- Specialised conversion
	f :: Int -> Double
	f = fromIntegral