% first line Data.PcSets.Svg

% This file is part of gpcsets: Pitch Class Sets for Haskell
% Copyright 2009 by Bruce H. McCosar.
% Distributed under a BSD3 license; see the file 'LICENSE' for details.

\chapter{Data.PcSets.Svg}

\section{Introduction}

\subsection{The Module Export List}

\begin{code}
{-|
  This module produces simple representations of Pitch Class Sets
  suitable for use in Scalable Vector Graphics.  By default it
  does not generate the files -- instead, it generates a printable
  string, which can be captured to standard output or directed to
  a file at your discretion.
-}
module Data.PcSets.Svg
  (
    -- * Simple Usage
      pcSvg
    , pcSvgAx
    -- * Advanced Usage
    , pcSvg'
    , pcSvgAx'
    -- * Rendering Style
    , Rendering (Rendering, pxSize, lnColor, psColor, csColor,
                 axColor, relMain, relElem, relAxis)
    -- ** Default Rendering Values
    , stdRen
  )
where
\end{code}

\subsection{The Module Import List}

\begin{code}
import qualified Data.PcSets as P
\end{code}

\section{Simple Usage}

\begin{code}
-- | The basic idea: generate SVG data for an input pitch class set.
pcSvg :: (P.PcSet a) => a -> String
pcSvg = pcSvg' stdRen
\end{code}

\begin{code}
-- | Same as 'pcSvg', but includes an /invertXY/ style axis.
pcSvgAx :: (P.PcSet a) => a -> (Int,Int) -> String
pcSvgAx = pcSvgAx' stdRen
\end{code}

\section{Advanced Usage}

\begin{code}
-- | Same as 'pcSvg' but allows a custom 'Rendering'.
pcSvg' :: (P.PcSet a) => Rendering -> a -> String
pcSvg' ren ps = svgHeader ++ show (toSvg ren ps parts)
  where parts = [psFrame,psCircle]
\end{code}

\begin{code}
-- | Same as 'pcSvgAx', but allows a custom 'Rendering'.
pcSvgAx' :: (P.PcSet a) => Rendering -> a -> (Int,Int) -> String
pcSvgAx' ren ps invAx = svgHeader ++ show (toSvg ren ps parts)
  where parts = [psFrame, psAxis invAx ps, psCircle]
\end{code}

\subsection{Rendering Style}

\subsubsection{Rendering Data Structure}

\begin{code}
-- | Stores the rendering information for the SVG file.
data Rendering = Rendering
  {
    pxSize  :: Int,    -- ^ sets the (square) image dimensions
    lnColor :: String, -- ^ line color for the main structures
    psColor :: String, -- ^ pitch class set color
    csColor :: String, -- ^ complementary set color
    axColor :: String, -- ^ axis color
    relMain :: Float,  -- ^ proportion of main circle compared to image
    relElem :: Float,  -- ^ proportion of elements compared to main circle
    relAxis :: Float   -- ^ proportion of axis (if any) compared to image
  }
\end{code}

\subsubsection{Default Rendering}

\begin{code}
{-|
  The Standard 'Rendering' is a 500x500 image using black lines, with
  elements of the set in red, the complement in black, and any axis in
  blue.  The pitch class set circle is 80% of the frame, each element
  is 10% of the main circle's size, and any axis is 95% frame size.
-}
stdRen :: Rendering
stdRen = Rendering
  {
    pxSize = 500,
    lnColor = "black",
    psColor = "red",
    csColor = "black",
    axColor = "blue",
    relMain = 0.80,
    relElem = 0.10,
    relAxis = 0.95
  }
\end{code}

\section{Not Exported}

\subsection{XML functions}

\subsubsection{Attributes}

\begin{code}
data Attr = Attr String String

instance Show Attr where
  show (Attr n v) = n ++ "=\"" ++ v ++ "\""
\end{code}

\begin{code}
attrs :: [Attr] -> String
attrs as = unwords [show a | a <- as]
\end{code}

\begin{code}
nattr :: String -> Int -> Attr
nattr s = Attr s . show -- 'numerical attributes'
\end{code}

\subsubsection{Tags}

\begin{code}
data Tag = Tag String [Attr]

instance Show Tag where
  show (Tag n as) = "<" ++ n ++ " " ++ attrs as ++ "/>"
\end{code}

\subsubsection{Parent Tags}

\begin{code}
data PTag = PTag String [Attr] [Tag]

instance Show PTag where
  show (PTag n as ts) = "<" ++ n ++ " " ++ attrs as
      ++ ">\n" ++ tags ++ "</" ++ n ++ ">"
    where tags = unlines [show t | t <- ts]
\end{code}

\subsection{SVG functions}

\subsubsection{SVG Elements}

\begin{code}
circle :: (Int,Int) -> Int -> String -> Int -> String -> Tag
circle (cx,cy) r s sw f =
  Tag "circle" [nattr "cx" cx, nattr "cy" cy, nattr "r" r,
    Attr "stroke" s, nattr "stroke-width" sw, Attr "fill" f]
\end{code}

\begin{code}
line :: (Int,Int) -> (Int,Int) -> String -> Int -> String -> Tag
line (x1,y1) (x2,y2) s sw sd =
  Tag "line" [nattr "x1" x1, nattr "y1" y1,
             nattr "x2" x2, nattr "y2" y2,
             Attr "stroke" s, nattr "stroke-width" sw,
             Attr "stroke-dasharray" sd]
\end{code}

\begin{code}
rect :: (Int,Int) -> (Int,Int) -> String -> Int -> String -> Tag
rect (x,y) (w,h) s sw f =
  Tag "rect" [nattr "x" x, nattr "y" y,
             nattr "width" w, nattr "height" h,
             Attr "stroke" s, nattr "stroke-width" sw,
             Attr "fill" f]
\end{code}

\subsubsection{SVG Toplevel}

\begin{code}
svgHeader :: String
svgHeader = "<?xml version=\"1.0\" standalone=\"no\"?>\n" ++
            "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\" " ++
            "\"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">\n"
\end{code}

\begin{code}
svg :: (Int,Int) -> [Tag] -> PTag
svg (w,h) ts =
  PTag "svg" stdatt ts
    where
      stdatt = [nattr "width" w,
               nattr "height" h,
               Attr "version" "1.1",
               Attr "xmlns" "http://www.w3.org/2000/svg"]
\end{code}

\subsection{Convenient Rendering Data Shortcuts}

\subsubsection{Centering}

\begin{code}
ctr :: Rendering -> Int
ctr ren = pxSize ren `div` 2
\end{code}

\begin{code}
ctrxy :: Rendering -> (Int,Int)
ctrxy ren = (ctr ren, ctr ren)
\end{code}

\subsubsection{Framing}

\begin{code}
frameSize :: Rendering -> (Int,Int)
frameSize ren = (p,p)
  where p = pxSize ren
\end{code}

\subsubsection{Radii}

{\bf Main Circle:}

\begin{code}
mainRad :: Rendering -> Float
mainRad ren = relMain ren * fromIntegral (pxSize ren) / 2
\end{code}

{\bf Inversion Axes:}

\begin{code}
axisRad :: Rendering -> Float
axisRad ren = relAxis ren * fromIntegral (pxSize ren) / 2
\end{code}

{\bf Pitch Class Elements:}

\begin{code}
elemRad :: Rendering -> Float
elemRad ren = relElem ren * mainRad ren
\end{code}

\subsection{Element Placement}

\begin{code}
phase :: Int -> Int -> Float
phase t m = 2 * pi * fromIntegral t / fromIntegral m
\end{code}

\begin{code}
pos :: Int -> Int -> Rendering -> (Rendering -> Float) -> (Int,Int)
pos t m ren radf = (x,y)
  where
    r = radf ren
    x = ctr ren + round (r * sin (phase t m))
    y = ctr ren - round (r * cos (phase t m))
\end{code}

\subsection{Builder Functions}

\begin{code}
psFrame :: Rendering -> Tag
psFrame ren = rect (1,1) (frameSize ren) "none" 1 "none"
\end{code}

\begin{code}
psCircle :: Rendering -> Tag
psCircle ren = circle (ctrxy ren) (round r) (lnColor ren) 2 "none"
  where r = mainRad ren
\end{code}

\begin{code}
psElements :: (P.PcSet a) => a -> Rendering -> [Tag]
psElements ps ren = if m == 0 then [] else map f [0..(m-1)]
  where
    m = P.modulus ps
    es = P.elements ps
    f t = circle (p t) (round r) (lnColor ren) 1 (onOff t ren)
    p t = pos t m ren mainRad
    r = elemRad ren
    onOff t = if t `elem` es then psColor else csColor
\end{code}

\begin{code}
psAxis :: (P.PcSet a) => (Int,Int) -> a -> Rendering -> Tag
psAxis (x,y) ps ren =
    line (p t1) (p t2) (axColor ren) 1 "9, 3, 3, 3"
  where
    m = P.modulus ps
    p t = pos t (m * 2) ren axisRad
    t1 = x + y
    t2 = x + y + m
\end{code}

This is the big one.

\begin{code}
toSvg :: (P.PcSet a) => Rendering -> a -> [(Rendering -> Tag)] -> PTag
toSvg ren ps parts = svg (frameSize ren) tags
  where
    tags = map ($ ren) parts ++ psElements ps ren
\end{code}

% last line Data.PcSets