(C) Roger Whittaker 2015
roger@disruptive.org.uk
Free software licenced under the GPL

> module Penrose ( writeall
>                , kind
>                , coordinates
>                )

> where

> import Control.Monad
> import Pgrams
> import System.IO
> import Text.Printf
> import System.Environment
> import Version
> import Data.String.Utils


> dim :: [a] -> Int
> dim g  = length g

> width :: [a] -> Int
> width g = length (bases (dim g))

> a :: [a] -> Int -> [Double]
> a g k = fst ((bases (dim g))!!(k))

> b :: [a] -> Int -> [Double]
> b g k = snd ((bases (dim g))!!(k))

> shift :: [a] -> [a]
> shift (x:xs) = xs ++ [x]

> rot :: (Eq a, Num a) => a -> [a1] -> [a1]
> rot 0 lst = lst
> rot 1 lst = shift lst
> rot n lst = shift (rot (n - 1) lst)

> range :: Int -> [Int]
> range i = [(negate i)..i]

> bitof g i k vv u v = rot ((dim g) - i `mod` (dim g)) ((map (*(negate (vv!!l))) (u))
>                      `plus` (map (*(negate (vv!!m))) (v))) where
>                             l = i `mod` (dim g)
>                             m = (i + k + 1) `mod` (dim g)

> e :: Integral b => [Double] -> Int -> Int -> Int -> [[b]]
> e g it i k = [map ceiling (g `plus` (bitof g i k g (a g k) (b g k))
>                         `plus` map (* (fromIntegral m)) (rot ((dim g) - i) (a g k))
>                         `plus` map (* (fromIntegral n)) (rot ((dim g) - i) (b g k)))| m <- range it, n <- range it]

> pgs :: [a] -> Int -> Int -> [Int] -> Pgram
> pgs g i k = \ x -> Pgram x (i `mod` (dim g), (i + k + 1) `mod` (dim g))

> times :: Num t => t -> (t, t) -> (t, t)
> times x (y,z) = (x*y, x*z)

> allinf :: [a] -> Int -> Double -> Int -> [Int] -> (Int, [Int], (Int, Int), [(Double, Double)])
> allinf g i sc k = \ x -> ( k
>                    , cords (pgs g i k x)
>                    , spans (pgs g i k x)
>                    , [ sc `times` (p0 $ tocart (pgs g i k x))
>                      , sc `times` (p1 $ tocart (pgs g i k x))
>                      , sc `times` (p2 $ tocart (pgs g i k x))
>                      , sc `times` (p3 $ tocart (pgs g i k x))]
>                    )

> outputlines :: [Double] -> Int -> Double -> Int -> Int -> [(Int, [Int], (Int, Int), [(Double, Double)])]
> outputlines g it sc i k = map (allinf g i sc k) (e g it i k)

> transform :: (PrintfArg t, PrintfArg t1) => (t, t1) -> [Char]
> transform (x, y) = printf "%.4f" x ++ "," ++ printf "%.4f" y ++ "    "

> writeout :: (Show a, Show a1, Show a2, PrintfArg t1, PrintfArg t) => (a, a1, a2, [(t, t1)]) -> [Char]
> writeout (x, a, b, lst) = show x ++ " " ++ show a ++ " " ++ show b ++ "  | " ++ (concat $ map transform lst)

> writewidth :: [Double] -> Int -> Double -> Int -> [[Char]]
> writewidth g it sc k = concat [map writeout (outputlines g it sc t k)|t <- [0..((dim g) - 1)]]

> writeall :: [Double] -> Int -> Double -> String -> ([String], [[Char]])
> writeall g it sc ver = ([show g, show it, show sc, ver], concat [(writewidth g it sc i) | i <- [0..((width g) - 1)]])

> kind :: [Char] -> String
> kind x = splitWs (split "|" x !! 0) !! 0

> coordinates :: [Char] -> [String]
> coordinates x = splitWs (strip ((split "|" x)!!1))