0 | module CyBy.Draw.PeriodicTableCanvas
  1 |
  2 | import Chem
  3 | import CyBy.Draw.Internal.CoreDims
  4 | import CyBy.Draw.Draw
  5 | import CyBy.Draw.Event
  6 | import CyBy.Draw.Internal.Settings
  7 | import Data.Finite
  8 | import Data.List
  9 | import Data.Nat
 10 | import Data.String
 11 | import Derive.Prelude
 12 | import Geom
 13 | import Text.SVG
 14 | import Text.SVG.Attribute as A
 15 |
 16 | %default total
 17 | %language ElabReflection
 18 |
 19 | ||| Dimensions of the SVG element (its `width` and `height`).
 20 | public export
 21 | record SceneDims where
 22 |   constructor SD
 23 |   swidth  : Double
 24 |   sheight : Double
 25 |
 26 | ||| Center of the SVG scene.
 27 | export
 28 | sceneCenter : SceneDims -> Point Id
 29 | sceneCenter sd = P (sd.swidth / 2.0) (sd.sheight / 2.0)
 30 |
 31 | ||| Bounds of the SVG scene.
 32 | export
 33 | sceneBounds : SceneDims -> Bounds2D Id
 34 | sceneBounds sd = BS (range 0.0 sd.swidth) (range 0.0 sd.sheight)
 35 |
 36 | --------------------------------------------------------------------------------
 37 | --          PSE Cells
 38 | --------------------------------------------------------------------------------
 39 |
 40 | public export
 41 | record Cell where
 42 |   constructor PC
 43 |   element  : Elem
 44 |   ||| 0-based x-position in the periodic table.
 45 |   posX     : Nat
 46 |
 47 |   ||| 0-based y-position in the periodic table.
 48 |   posY     : Nat
 49 |
 50 | %runElab derive "Cell" [Show,Eq]
 51 |
 52 | xRelativeTo : Elem -> Elem -> Nat
 53 | xRelativeTo x rel = cast $ conIndexElem x - conIndexElem rel
 54 |
 55 | public export
 56 | PSERows, PSEColumns : Nat
 57 | PSERows    = 10
 58 | PSEColumns = 18
 59 |
 60 | elemPosition : Elem -> (Nat,Nat)
 61 | elemPosition H  = (0,0)
 62 | elemPosition He = (17,0)
 63 | elemPosition Li = (0,1)
 64 | elemPosition Be = (1,1)
 65 | elemPosition Na = (0,2)
 66 | elemPosition Mg = (1,2)
 67 | elemPosition e  =
 68 |   if      e >= B  && e <= Ne then ((e `xRelativeTo` B) + 12,1)-- right part of 2nd period
 69 |   else if e >= Al && e <= Ar then ((e `xRelativeTo` Al) + 12,2)-- right part of 3rd period
 70 |   else if e >= K  && e <= Kr then (e  `xRelativeTo` K ,3)-- 4th period
 71 |   else if e >= Rb && e <= Xe then (e  `xRelativeTo` Rb ,4)-- 5th period
 72 |   else if e >= Cs && e <= La then (e  `xRelativeTo` Cs ,5)-- left part of 6th period
 73 |   else if e >= Ce && e <= Lu then (e  `xRelativeTo` Ba ,8)-- lanthanides
 74 |   else if e >= Hf && e <= Rn then ((e `xRelativeTo` Hf) + 3,5)-- right part of 6th period
 75 |   else if e >= Fr && e <= Ac then (e  `xRelativeTo` Fr ,6)-- left part of 7th period
 76 |   else if e >= Th && e <= Lr then (e  `xRelativeTo` Ra ,9)-- actinides
 77 |   else if e >= Rf && e <= Ts then ((e `xRelativeTo` Rf) + 3,6)-- right part of 7th period without Og
 78 |   else (17,6)-- Og
 79 |
 80 | public export
 81 | 0 Cells : Type
 82 | Cells = List Cell
 83 |
 84 | -- Generate a list of cells from the list of chemical elements
 85 | -- (plus some info about the size of the canvas)
 86 | public export
 87 | cells : Cells
 88 | cells =
 89 |   map (\e => let (x,y) := elemPosition e in PC e x y) values
 90 |
 91 | --------------------------------------------------------------------------------
 92 | --          Canvas Output
 93 | --------------------------------------------------------------------------------
 94 |
 95 | half : Double
 96 | half = 0.5
 97 |
 98 | hcell : Double
 99 | hcell = 14.0
100 |
101 | wcell : Double
102 | wcell = 21.0
103 |
104 | parameters {auto s : DrawSettings}
105 |            (sd     : SceneDims)
106 |
107 |   hcellRel : Double
108 |   hcellRel = sd.sheight / cast PSERows
109 |
110 |   wcellRel : Double
111 |   wcellRel = sd.swidth / cast PSEColumns
112 |
113 |   -- compute the position of the mouse in the PSE grid
114 |   -- this assume that the event was fired from the `HTMLCanvasElement`
115 |   -- we use for drawing the PSE
116 |   mousePos : (x,y : Double) -> (Nat,Nat)
117 |   mousePos x y = (cast $ x / wcellRel, cast $ y / hcellRel)
118 |   
119 |   export
120 |   hoveredElem : {0 t : _} -> Point t -> Maybe Elem
121 |   hoveredElem (P dx dy) =
122 |     let (x,y) := mousePos dx dy
123 |      in element <$> find (\c => c.posX == x && c.posY == y) cells
124 |   
125 |   drawCell : Maybe Elem -> Cell -> SVGNode
126 |   drawCell me (PC elem px py) =
127 |     let x      := cast px * wcell
128 |         y      := cast py * hcell
129 |         txtX   := x + half * wcell
130 |         txtY   := y + half * hcell
131 |         hovCol := if me == Just elem then s.hoverBG else s.defaultBG
132 |      in g [transform (Scale (wcellRel / wcell) (hcellRel / hcell))]
133 |           [ rect [A.x x.u, A.y y.u, width wcell.u, height hcell.u, fill hovCol, stroke black]
134 |           , text1 [A.x txtX.u, A.y txtY.u, fill (s.elemColor elem)] (show elem)
135 |           ]
136 |
137 |   export
138 |   displayPSE : Maybe Elem -> SVGNode
139 |   displayPSE me =
140 |     g
141 |       [ fontFamily s.core.font
142 |       , fontSize (cast s.pseFontSize).px
143 |       , textAnchor Middle
144 |       , dominantBaseline Central
145 |       ]
146 |       (map (drawCell me) cells)
147 |