Diagram.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

{- | The organisational diagram of the operations manual (Section 1.1.3), drawn
from the key positions: the CEO, the positions that report to the CEO, and
the remote pilots, who report to the chief remote pilot. Each position shows
its holder.
-}
module ReOC.Render.OperationsManual.Diagram (
  organisationalDiagramSvg,
  organisationalDiagramDescription,
  organisationalDiagramFrame,
) where

import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import ReOC.Model
import ReOC.Personnel (keyPositions, soleHolder)
import ReOC.Render.Base64 (base64)
import ReOC.Render.Text (escapeXml, get, listing)

-- A box of the diagram: its centre, its title and its holder.
type Box = (Int, Int, Text, Text)

boxWidth, boxHeight, fontSize :: Int
boxWidth = 420
boxHeight = 100
fontSize = 25

-- The boxes and lines of the diagram, in units of 0.1 mm.
layout :: ReOC -> ([Box], [(Int, Int, Int, Int)])
layout r =
  let ps = keyPositions r
      name :: Nominee -> Text
      name n = formTextText (get (person . fullName) n)
      title a t = Text.toUpper (Text.take 1 t) <> Text.drop 1 t <> " (" <> a <> ")"
      reports = [(a, t, n) | (a, t, n) <- ps, a /= "CEO"]
      count = length reports
      spacing = 1320 `div` max 1 count
      centres = [spacing * k + spacing `div` 2 | k <- [0 .. count - 1]]
      ceo = [(660, 70, title a t, name n) | (a, t, n) <- ps, a == "CEO"]
      second = [(x, 290, title a t, name n) | (x, (a, t, n)) <- zip centres reports]
      crpX = case [x | (x, (a, _, _)) <- zip centres reports, a == "CRP"] of
        x : _ -> x
        [] -> 660
      rpHolder = case get (operationsManual . pilots) r of
        CRPIsOnlyRemotePilot -> "The CRP"
        OtherRemotePilots -> "The CRP and engaged RPs"
      rp = [(crpX, 490, "Remote pilot (RP)", rpHolder)]
      half = boxHeight `div` 2
      minX = foldr min 660 centres
      maxX = foldr max 660 centres
      ls =
        [(660, 70 + half, 660, 190), (minX, 190, maxX, 190)]
          <> [(x, 190, x, 290 - half) | x <- centres]
          <> [(crpX, 290 + half, crpX, 490 - half)]
   in (ceo <> second <> rp, ls)

-- An estimate of the width of text in the diagram's font, from the widths of the form's widest font.
estimatedWidth :: Text -> Int
estimatedWidth t =
  round (maybe (fromIntegral (Text.length t) * 0.6) (* 0.1) (textWidth Wide t) * fromIntegral fontSize :: Double)

-- | The diagram, as SVG.
organisationalDiagramSvg :: ReOC -> Text
organisationalDiagramSvg r =
  let (boxes, ls) = layout r
      n = Text.pack . show
      line (x1, y1, x2, y2) =
        "<line x1=\"" <> n x1 <> "\" y1=\"" <> n y1 <> "\" x2=\"" <> n x2 <> "\" y2=\"" <> n y2 <> "\" stroke=\"#1f3864\" stroke-width=\"4\"/>"
      textAt x y weight t =
        let inner = boxWidth - 24
            widthOf = estimatedWidth t * (if weight == "bold" then 11 else 10) `div` 10
            fit = if widthOf > inner then " textLength=\"" <> n inner <> "\" lengthAdjust=\"spacingAndGlyphs\"" else ""
         in "<text x=\""
              <> n x
              <> "\" y=\""
              <> n y
              <> "\" text-anchor=\"middle\" font-family=\"Liberation Sans, Arial, Helvetica, sans-serif\" font-size=\""
              <> n fontSize
              <> "\" font-weight=\""
              <> weight
              <> "\""
              <> fit
              <> ">"
              <> escapeXml t
              <> "</text>"
      box (x, y, t, h) =
        "<rect x=\""
          <> n (x - boxWidth `div` 2)
          <> "\" y=\""
          <> n (y - boxHeight `div` 2)
          <> "\" width=\""
          <> n boxWidth
          <> "\" height=\""
          <> n boxHeight
          <> "\" rx=\"10\" fill=\"#ffffff\" stroke=\"#1f3864\" stroke-width=\"4\"/>"
          <> textAt x (y - 8) "bold" t
          <> textAt x (y + 28) "normal" h
   in "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
        <> "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"132mm\" height=\"56mm\" viewBox=\"0 0 1320 560\">"
        <> Text.concat (map line ls)
        <> Text.concat (map box boxes)
        <> "</svg>"

-- | A description of the diagram, for readers who cannot see it.
organisationalDiagramDescription :: ReOC -> Text
organisationalDiagramDescription r =
  let ps = keyPositions r
      reports = [t | (a, t, _) <- ps, a /= "CEO"]
      held =
        case soleHolder r of
          Just _ -> "All positions are held by one person."
          Nothing -> Text.unwords [formTextText (get (person . fullName) n) <> " holds the position of " <> t <> "." | (_, t, n) <- ps]
   in "Organisational diagram: CEO; " <> listing reports <> " report to the CEO; remote pilots report to the chief remote pilot. " <> held

-- | The diagram as a frame of Flat ODF text, with the SVG embedded.
organisationalDiagramFrame :: ReOC -> Text
organisationalDiagramFrame r =
  "<draw:frame text:anchor-type=\"as-char\" draw:z-index=\"0\" draw:name=\"Organisational diagram\" draw:style-name=\"gr2\" draw:text-style-name=\"P149\" svg:width=\"13.2cm\" svg:height=\"5.6cm\">"
    <> "<draw:image draw:mime-type=\"image/svg+xml\"><office:binary-data>"
    <> base64 (encodeUtf8 (organisationalDiagramSvg r))
    <> "</office:binary-data><text:p/></draw:image>"
    <> "<svg:desc>"
    <> escapeXml (organisationalDiagramDescription r)
    <> "</svg:desc></draw:frame>"