0 | module CyBy.Draw.MoleculeCanvas

  2 | import Chem.Util

  3 | import CyBy.Draw.Draw

  4 | import CyBy.Draw.Event

  5 | import CyBy.Draw.Internal.Abbreviations

  6 | import CyBy.Draw.Internal.Atom

  7 | import CyBy.Draw.Internal.CoreDims

  8 | import CyBy.Draw.Internal.Graph

  9 | import CyBy.Draw.Internal.Label

 10 | import CyBy.Draw.Internal.Ring

 11 | import CyBy.Draw.Internal.Role

 12 | import CyBy.Draw.Internal.Settings

 13 | import CyBy.Draw.PeriodicTableCanvas

 14 | import Derive.Prelude

 15 | import Geom

 16 | import Text.Molfile

 17 | import Text.SVG

 18 | import CyBy.Draw.Internal.Navigation

 20 | %default total

 21 | %language ElabReflection

 22 | %hide Language.Reflection.TTImp.Mode

 25 | public export

 26 | record DepNode where

 27 |   constructor DN

 28 |   graph : CDGraph

 29 |   node  : Fin graph.order

 31 | %runElab derive "DepNode" [Show]

 34 | Eq DepNode where

 35 |   (==) (DN g1 n1) (DN g2 n2) = g1 == g2 && finToNat n1 == finToNat n2

 41 | public export

 42 | data Mode : Type where

 43 |   Select      : Mode

 44 |   Erase       : Mode

 45 |   Draw        : Mode

 46 |   SetAtom     : Isotope -> Mode

 47 |   SetAbbr     : Abbreviation -> Mode

 48 |   SetTempl    : CDGraph -> Mode

 49 |   RotTempl    : (start : Point Mol) -> (t : CDGraph) -> Mode

 50 |   RotTemplAtm : DepNode -> CDGraph -> Mode

 51 |   RotTemplOvp : (g,t : DepNode) -> (initPoint : Point Mol) -> Mode

 52 |   Selecting   : (start : Point Id) -> Mode

 53 |   Erasing     : (start : Point Id) -> Mode

 54 |   Dragging    : (start : Point Mol) -> Mode

 55 |   Rotating    : (start : Point Mol) -> Mode

 56 |   Translating : (prev : Mode) -> Mode

 57 |   Drawing     : Maybe Abbreviation -> Mode

 58 |   PTable      : (hovered : Maybe Elem) -> Mode

 60 | %runElab derive "CyBy.Draw.MoleculeCanvas.Mode" [Show,Eq]

 62 | endTranslate : Mode -> Mode

 63 | endTranslate (Translating m) = m

 64 | endTranslate m               = m

 70 | sameAtom : Isotope -> CDAtom -> Bool

 71 | sameAtom i a = elem a.atom == i && not (inAnyGroup a) && a.atom.charge == 0

 73 | hoverAtom : Mode -> CDAtom -> Bool

 74 | hoverAtom Select       _ = True

 75 | hoverAtom Erase        _ = True

 76 | hoverAtom Draw         y = not (inAnyGroup y)

 77 | hoverAtom (SetAtom x)  y = not (sameAtom x y)

 78 | hoverAtom (SetAbbr x)  y = map lbl (group y) /= Just x.label

 79 | hoverAtom (SetTempl x) y = not (inAnyGroup y)

 80 | hoverAtom _            _ = False

 82 | hoverDrawing : MolBond -> MolBond -> Bool -> Bool

 83 | hoverDrawing (MkBond _ Single NoBondStereo) _ a = not a

 84 | hoverDrawing (MkBond _ Single Either)       b _ = b.stereo /= Either

 85 | hoverDrawing (MkBond _ Single _)            _ _ = True

 86 | hoverDrawing (MkBond _ x      _)            b a = not a && b.type /= x

 88 | hoverBond : Mode -> MolBond -> CDBond -> (inAbbreviation : Bool) -> Bool

 89 | hoverBond Select       _  _ _ = True

 90 | hoverBond Erase        _  _ _ = True

 91 | hoverBond Draw         mb b a = hoverDrawing mb b.molBond a

 92 | hoverBond (SetTempl x) _  _ b = not b

 93 | hoverBond _            _  _ _ = False

 99 | public export

100 | record DrawState where

101 |   [noHints]

102 |   constructor ST

103 |   dims       : SceneDims

104 |   transform  : AffineTransformation

105 |   curPos     : Point transform

106 |   mol        : CDGraph

107 |   undos      : List (CDGraph)

108 |   redos      : List (CDGraph)

109 |   mode       : Mode

110 |   modifier   : Modifier

111 |   bond       : MolBond

112 |   isActive   : Bool

113 |   ptable     : Maybe Elem

115 |   ||| Current SVG scene rendered to a string

118 |   curSVG     : String

120 |   ||| Previous SVG scene rendered to a string

121 |   prevSVG    : String

123 | export %inline

124 | toMol : DrawState -> MolfileAT

125 | toMol ds = toMolfile ds.mol

127 | export %inline

128 | toMolStr : DrawState -> (comment : String) -> String

129 | toMolStr s c =

130 |   case toMol s of

131 |     (MkMolfile n i _ g d) =>

132 |       let molFile := MkMolfile n i (MkMolLine c) g d

133 |        in writeMolfile molFile

135 | export %inline

136 | (.imol) : (s : DrawState) -> CDIGraph s.mol.order

137 | s.imol = s.mol.graph

140 | export %inline

141 | emptyGraph : DrawState -> Bool

142 | emptyGraph s = order s.mol == 0

153 | public export

154 | data ScaleMode : Type where

155 |   ||| Scale mode used when initializing a scene for drawing

156 |   Init  : ScaleMode

158 |   ||| Scale mode used when centering the molecule (by pressing the "reset" button)

159 |   Reset : ScaleMode

161 |   ||| Scale mode used when displaying a molecule so that it fills the whole

163 |   Fill  : ScaleMode

165 | setTransform : AffineTransformation -> DrawState -> DrawState

166 | setTransform tr = {transform := tr, curPos $= convert}

168 | scaleTrans :

169 |      {auto ds : DrawSettings}

170 |   -> Point Id

171 |   -> Scale

172 |   -> AffineTransformation

173 |   -> AffineTransformation

174 | scaleTrans p sc t =

175 |   let v := p - origin

176 |    in translate v <+> scaling (validScale t sc) <+> translate (negate v) <+> t

178 | parameters {auto ds : DrawSettings}

180 |   export

181 |   scaleAt : Point Id -> Scale -> DrawState -> DrawState

182 |   scaleAt p sc s = setTransform (scaleTrans p sc s.transform) s

184 |   ||| Scales the molecule at the current mouse position.

185 |   export

186 |   scaleAtPos : Scale -> DrawState -> DrawState

187 |   scaleAtPos sc s = let P x y := s.curPos in scaleAt (P x y) sc s

189 |   ||| Scales the molecule at the center of the scene

190 |   export

191 |   scaleAtCenter : Scale -> DrawState -> DrawState

192 |   scaleAtCenter sc s = scaleAt (sceneCenter s.dims) sc s

194 |   scaleFromBounds : (scene,mol : Bounds2D Id) -> Scale

195 |   scaleFromBounds c m     =

196 |     min (factor (width c) (width m)) (factor (height c) (height m))

197 |     where

198 |       factor : Double -> Double -> Scale

199 |       factor x y = scale $ (x / (y + 4.0 * cast ds.core.fontSize))

201 |   iniTrans : SceneDims -> ScaleMode -> CDGraph -> AffineTransformation

202 |   iniTrans sd sm (G _ g) =

203 |     let (bs,sc) := scaleToBounds

204 |      in scaleTrans (sceneCenter sd) sc $

205 |           translate (sceneCenter sd - convert (center bs))

206 |     where

207 |       scaleToBounds : (Bounds2D Id, Scale)

208 |       scaleToBounds =

209 |         case sm of

210 |           Init  =>

211 |             let bs := foldMap bounds (Draw.labels g)

212 |              in (bs,1.0)

213 |           Reset =>

214 |            let bs := foldMap bounds (Draw.labels g)

215 |             in (bs, min 1.0 (scaleFromBounds (sceneBounds sd) bs))

216 |           Fill =>

217 |            let bs = foldMap bounds (Draw.labels g)

218 |             in (bs, scaleFromBounds (sceneBounds sd) bs)

220 |   initAbbr : Maybe Abbreviation

221 |   initAbbr = case ds.abbreviations of {a :: _ => Just a; [] => Nothing}

224 | (.posId) : DrawState -> Point Id

225 | s.posId = convert s.curPos

228 | (.posMol) : DrawState -> Point Mol

229 | s.posMol = convert s.curPos

241 | nextMol : DrawSettings => DrawState -> CDGraph

242 | nextMol s =

243 |   case s.isActive of

244 |     False => s.mol

245 |     True  => case s.mode of

246 |       Select           => s.mol

247 |       Erase            => s.mol

248 |       Draw             => s.mol

249 |       PTable _         => s.mol

250 |       SetAtom x        => addAtom s.imol x s.curPos

251 |       SetAbbr _        => s.mol

252 |       Erasing p        => select p s.posId s.mol

253 |       Translating _    => s.mol

254 |       Selecting p      => select p s.posId s.mol

255 |       Dragging p       => moveSelected p s.posMol s.mol

256 |       Rotating p       => rotateSelected (s.modifier == Shift) p s.posMol s.mol

257 |       SetTempl t       => addTemplate s.posMol t s.mol

258 |       RotTempl p t     => addTemplate p (rotateTempl False p s.posMol t) s.mol

259 |       RotTemplOvp g t p =>

260 |         addTemplateRot s.posMol (Right (g.node,t.node,p)) t.graph.graph g.graph.graph

261 |       RotTemplAtm g t => addTemplateRot s.posMol (Left g.node) t.graph g.graph.graph

262 |       Drawing Nothing  => addBond (s.modifier == Shift) (Just s.posMol) s.bond s.imol

263 |       Drawing (Just $ A l _ g) => setAbbreviation (s.modifier == Shift) l s.posId g s.mol

270 | updateMol : (CDGraph -> CDGraph) -> DrawState -> DrawState

271 | updateMol f s =

272 |   let G o g := cleanup $ f s.mol

273 |       cm    := clear s.mol

274 |    in if clear (G o g) == cm then s else

275 |         { mol := G o $ adjAtomTypes g

276 |         , undos $= (cm ::), redos := []

277 |         } s

281 | modAtomWhere :

282 |      (CDAtom -> Bool)

283 |   -> (MolAtomAT -> MolAtomAT)

284 |   -> DrawState

285 |   -> DrawState

286 | modAtomWhere p f =

287 |   updateMol $ \(G o g) =>

288 |     let ns := filter (p . lab g) (nodes g)

289 |      in delNodes (groupNodes g ns) $ mapIf p {atom $= adj} g

290 |   where

291 |     adj : MolAtomAT -> MolAtomAT

292 |     adj = f . {label := Nothing}

296 | modAtom : (MolAtomAT -> MolAtomAT) -> DrawState -> DrawState

297 | modAtom = modAtomWhere (is Hover)

300 | setMol : CDGraph -> DrawState -> DrawState

301 | setMol = updateMol . const

305 | delete : DrawState -> DrawState

306 | delete = updateMol (clear . deleteSelected)

314 | drawSelection : (se : DrawSettings) => DrawState -> List SVGNode

315 | drawSelection s = case s.mode of

316 |   Erasing p    => [fillRect se.selectFG p s.posId]

317 |   RotTempl p _ => rotateTemplScene p s.posMol

318 |   Selecting p  => [fillRect se.selectFG p s.posId]

319 |   _           =>

320 |     -- tests if any atoms are selected and if that's the case, whether

321 |     -- the mouse is currently in the dragging zone.

322 |     case selectionCorners (nextMol s) of

323 |       Nothing      => []

324 |       Just (p1,p2) =>

325 |         let SZ d1 d2 r1 r2 := selectZones (convert p1) (convert p2)

326 |          in if inRectangle s.posId d1 d2

327 |                then [outlineRect se.hoverBG d1 d2]

328 |                else [outlineRectD se.hoverBG r1 r2]

334 | resizeCorner : (s : DrawState) -> Point s.transform

335 | resizeCorner s = let SD h w := s.dims in P h w

337 | maybeResizing : DrawSettings => DrawState -> Bool

338 | maybeResizing @{x} s =

339 |   distance s.curPos (resizeCorner s) <= x.resizeCornerRad

341 | reset : DrawSettings => DrawState -> DrawState

342 | reset s = {transform := iniTrans s.dims Reset s.mol, curPos := origin} s

344 | initST : DrawSettings => SceneDims -> ScaleMode -> CDGraph -> DrawState

345 | initST sd sm g =

346 |   ST

347 |     { dims       = sd

348 |     , curPos     = P (sd.swidth / 2.0) (sd.sheight / 2.0)

349 |     , transform  = iniTrans sd sm g

350 |     , mol        = g

351 |     , undos      = []

352 |     , redos      = []

353 |     , mode       = Draw

354 |     , modifier   = NoMod

355 |     , bond       = MkBond False Single NoBondStereo

356 |     , isActive   = False

357 |     , ptable     = Nothing

358 |     , curSVG     = ""

359 |     , prevSVG    = ""

360 |     }

362 | undo : DrawState -> DrawState

363 | undo s = case s.undos of

364 |   []     => s

365 |   (h::t) => {redos $= (clear s.mol ::), mol := h, undos := t} s

367 | redo : DrawState -> DrawState

368 | redo s = case s.redos of

369 |   []     => s

370 |   (h::t) => {undos $= (clear s.mol ::), mol := h, redos := t} s

372 | changeSelMode : DrawState -> DrawState

373 | changeSelMode s =

374 |   let mode := if s.modifier == Shift then Many else One

375 |    in case hoveredItem s.imol of

376 |         None => {mode := Selecting s.posId, mol $= selectHovered Ignore Ignore} s

377 |         N _  => {mode := Dragging s.posMol, mol $= selectHovered Ignore mode} s

378 |         E _  => {mode := Dragging s.posMol, mol $= selectHovered mode Ignore} s

380 | parameters {auto ds : DrawSettings}

381 |   -- Elaborates the current mode and elevates the fitting argument to a return

382 |   -- value

383 |   export

384 |   applyWhenSel :

385 |        {0 a : Type}

386 |     -> DrawState

387 |     -> (dragging : Lazy a)

388 |     -> (rotating : Lazy a)

389 |     -> (nothing : Lazy a)

390 |     -> a

391 |   applyWhenSel s d r n =

392 |     let pid := s.posId

393 |     in case hoveredItem s.imol of

394 |          None => case selectionCorners s.mol of

395 |            Nothing      => n

396 |            Just (p1,p2) =>

397 |              let SZ d1 d2 r1 r2 := selectZones (convert p1) (convert p2)

398 |               in case inRectangle pid d1 d2 of

399 |                    False => case inRectangle pid r1 r2 of

400 |                      False => n

401 |                      True  => r

402 |                    True  => d

403 |          _ => n

405 |   -- When we move the mouse, we must adjust the current mouse position

406 |   -- in the application state. If the middle mouse button is pressed,

407 |   -- we also translate the drawing area, otherwise we adjust the hovering

408 |   -- state of atoms.

409 |   move : (s : DrawState) -> Point s.transform -> DrawState

410 |   move s p =

411 |     case s.mode of

412 |       Translating _ =>

413 |         let V x y := p - s.curPos

414 |             v     := vid x y

415 |          in setTransform (translate v <+> s.transform) s

416 |       PTable m      => {mode := PTable (hoveredElem s.dims p)} s

417 |       m             =>

418 |         let G o g := s.mol

419 |             gh    := hover (hoverBond m s.bond) (hoverAtom m) (convert p) g

420 |          in { mol := G o gh, curPos := p} s

422 |   -- Pressing the left button typically begins an editing step

423 |   -- If this step depends on the start and end position of the mouse,

424 |   -- we enter a new mode and finish editing on the `leftUp` event.

425 |   -- Otherwise (for instance, when setting the label of an atom at

426 |   -- the mouse position),

427 |   -- the modification happens immediately.

428 |   leftDown : DrawState -> DrawState

429 |   leftDown s =

430 |     if maybeResizing s then s else

431 |       let pid := s.posId

432 |        in case s.mode of

433 |             Select      =>

434 |               applyWhenSel

435 |                 s

436 |                 (updateMode s (Dragging s.posMol))

437 |                 (updateMode s (Rotating s.posMol))

438 |                 (changeSelMode s)

440 |             Erase       =>

441 |               case hoveredItem s.imol of

442 |                 None => {mode := Erasing s.posId} s

443 |                 N _  => delete $ {mol $= selectHovered Ignore One} s

444 |                 E _  => delete $ {mol $= selectHovered One Ignore} s

446 |             Draw        =>

447 |               case hoveredItem s.imol of

448 |                 None => setMol (G _ $ insElemAt s.imol C pid HoverNew) s 

449 |                 N x  =>

450 |                   if isJust (groupNr s.imol (fst x))

451 |                      then s

452 |                      else {mode := Drawing Nothing, mol $= ifHover Origin} s

453 |                 E (E x y $ CB r b)  => 

454 |                   let b2 := newBond s.bond.type s.bond.stereo b

455 |                    in setMol (G _ $ insEdge (E x y $ CB r b2) s.imol) s

457 |             SetAtom   i => setMol (nextMol s) s

458 |             SetAbbr a   => {mode := Drawing (Just a), mol $= ifHover Origin} s

459 |             SetTempl  t =>

460 |                 case hoveredItem s.imol of

461 |                   -- adding template at hovered atom

462 |                   N (f,_)  => {mode := RotTemplAtm (DN s.mol f) t} s

463 |                   _        =>

464 |                    let t' := graph $ translateTemplate s.posMol t

465 |                     in case nodesToMerge s.imol t' of

466 |                          -- exactly one overlap -> rotating around it possible

467 |                          [(fm, ft)] =>

468 |                            {mode := RotTemplOvp

469 |                                       (DN (G _ s.imol) fm)

470 |                                       (DN (G _ t') ft)

471 |                                       (convert s.curPos)} s

472 |                          _          =>

473 |                            setMol (nextMol s) $ {mode := SetTempl t} s

474 |             _ => s

475 |     where updateMode : DrawState -> Mode -> DrawState

476 |           updateMode s m = {mode := m} s

478 |   -- When the left mouse button is lifted, this ends an ongoing editing

479 |   -- or selection process. We typically overwrite the current molecule with

480 |   -- the freshly edited one, adjust the drawing roles of atoms and bonds, and

481 |   -- determine the currently hovered atom anew.

482 |   leftUp : DrawState -> DrawState

483 |   leftUp s =

484 |     case s.mode of

485 |       Selecting _ => {mode := Select, mol := cleanup (nextMol s)} s

486 |       Erasing   _ => delete $ {mode := Erase, mol := cleanup (nextMol s)} s

487 |       Dragging  _ => setMol (nextMol s) $ {mode := Select} s

488 |       Rotating  _ => setMol (nextMol s) $ {mode := Select} s

489 |       RotTemplAtm _ t => setMol (nextMol s) $ {mode := SetTempl t} s

490 |       RotTemplOvp _ t _ => setMol (nextMol s) $ {mode := SetTempl t.graph} s

491 |       Drawing (Just a) => setMol (nextMol s) $ {mode := SetAbbr a} s

492 |       Drawing Nothing  => setMol (nextMol s) $ {mode := Draw} s

493 |       PTable (Just el) => {mode := SetAtom (cast el)} s

494 |       PTable Nothing   => s

495 |       _           => {mol $= cleanup} s

497 |   %inline

498 |   zoomOut, zoomIn : (atPos : Bool) -> DrawState -> DrawState

499 |   zoomOut True  = scaleAtPos 0.8

500 |   zoomOut False = scaleAtCenter 0.8

502 |   zoomIn True  = scaleAtPos 1.25

503 |   zoomIn False = scaleAtCenter 1.25

505 | ifCtrl : (f,g : Lazy (DrawState -> DrawState)) -> DrawState -> DrawState

506 | ifCtrl f g s = if s.modifier == Ctrl then f s else g s

508 | setElemStr : String -> DrawState -> DrawState

509 | setElemStr s = modAtom {elem $= updateIsotope s, charge := 0}

511 | startTemplRot : DrawState -> Mode -> Mode

512 | startTemplRot s (SetTempl g) = RotTempl s.posMol g

513 | startTemplRot s m           = m

515 | stopTemplRot : DrawSettings => DrawState -> Mode -> Mode

516 | stopTemplRot s (RotTempl p g) = SetTempl (rotateTempl False p s.posMol g)

517 | stopTemplRot s m              = m

523 | addBondShortcut :

524 |      {auto cd : CoreDims}

525 |   -> Bool

526 |   -> BondOrder

527 |   -> BondStereo

528 |   -> DrawState

529 |   -> DrawState

530 | addBondShortcut bol bo bs s =

531 |   case hoveredItem s.imol of

532 |     N x => case inAbbreviation s.imol (fst x) of

533 |       True  => s

534 |       False =>

535 |        let bnd   := MkBond bol bo bs

536 |            G _ g := ifHover Origin s.mol

537 |         in setMol (hoverIfNew (addBond {t = Id} False Nothing bnd g)) s

538 |     E (E x y $ CB r b) =>

539 |       if bs == NoBondStereo then

540 |           setMol (G _ $ insEdge (E x y $ CB r (cast bo)) s.imol) s

541 |       else s

542 |     _ => s  -- If not hovering over a valid atom or Edge, do nothing

546 | addGroupShortcut :

547 |         {auto cd : CoreDims}

548 |      -> CDGraph -- For example 'phenyl', '(readMolfile ac)' or '(ring 5)'

549 |      -> DrawState

550 |      -> Bool -- To determine if anything should happen on an edge

551 |      -> DrawState

552 | addGroupShortcut g s bol =

553 |   case hoveredItem s.imol of

554 |     N x => case inAbbreviation s.imol (fst x) of 

555 |       True  => s 

556 |       False =>  

557 |            setMol (mergeGraphs s.posId s.mol g) s

558 |     E e => if bol then 

559 |                   setMol (mergeGraphs s.posId s.mol g) s

560 |             else s

561 |     _ => s 

565 | addAbbrShortcut :

566 |      {auto cd : CoreDims}

567 |   -> String

568 |   -> CDGraph

569 |   -> DrawState

570 |   -> DrawState

571 | addAbbrShortcut l g s =

572 |   case hoveredItem s.imol of

573 |     N x => case inAbbreviation s.imol (fst x) of

574 |       True  => s

575 |       False =>

576 |         let s := {mol $= ifHover Origin} s  -- First set the Origin flag 

577 |         in 

578 |         setMol (setAbbreviation False l s.posId g s.mol) s

579 |     _   => s  -- If not hovering over a valid atom, do nothing

585 | navigate : Direction -> DrawState -> DrawState

586 | navigate d = {mol $= moveActive d}

588 | onKeyDown, onKeyUp : DrawSettings => String -> DrawState -> DrawState

589 | onKeyDown "Escape"     s = {mode := Select, mol $= clear} s

590 | onKeyDown "Delete"     s = delete s

591 | onKeyDown "Shift"      s = {modifier := Shift} s

592 | onKeyDown "Control"    s = {modifier := Ctrl, mode $= startTemplRot s} s

593 | onKeyDown "Meta"       s = {modifier := Ctrl, mode $= startTemplRot s} s

594 | onKeyDown "ArrowUp"    s = ifCtrl (modAtom {elem $= incIso}) (navigate N) s

595 | onKeyDown "ArrowDown"  s = ifCtrl (modAtom {elem $= decIso}) (navigate S) s

596 | onKeyDown "ArrowRight" s = navigate E s

597 | onKeyDown "ArrowLeft"  s = navigate W s

598 | onKeyDown "+"          s = ifCtrl (zoomIn True) (modAtom {charge $= incCharge}) s

599 | onKeyDown "-"          s = ifCtrl (zoomOut True) (modAtom {charge $= decCharge}) s

600 | onKeyDown "c"          s = ifCtrl id (setElemStr "C") s

601 | onKeyDown "x"          s = ifCtrl delete (setElemStr "X") s

602 | onKeyDown "z"          s = ifCtrl undo (setElemStr "Z") s

603 | onKeyDown "y"          s = ifCtrl redo (setElemStr "Y") s

604 | onKeyDown "0"          s = addAbbrShortcut "Ph" phenyl s

605 | onKeyDown "1"          s = addBondShortcut False Single NoBondStereo s

606 | onKeyDown "2"          s = addBondShortcut False Dbl NoBondStereo s

607 | onKeyDown "3"          s = addBondShortcut False Triple NoBondStereo s

608 | onKeyDown "4"          s = addGroupShortcut phenyl s True

609 | onKeyDown "5"          s = addGroupShortcut (ring 5) s True

610 | onKeyDown "6"          s = addGroupShortcut (readMolfile cy) s True

611 | onKeyDown "7"          s = addBondShortcut True Single Up s 

612 | onKeyDown "8"          s = addBondShortcut True Single Down s

613 | onKeyDown "9"          s = addGroupShortcut (readMolfile ac) s False

614 | onKeyDown x            s = setElemStr (toUpper x) s

616 | onKeyUp "Shift"        s = {modifier $= reset Shift} s

617 | onKeyUp "Control"      s = {modifier $= reset Ctrl, mode $= stopTemplRot s} s

618 | onKeyUp "Meta"         s = {modifier $= reset Ctrl, mode $= stopTemplRot s} s

619 | onKeyUp _              s = s

621 | setMassNr : Maybe MassNr -> MolAtomAT -> MolAtomAT

622 | setMassNr m a = let MkI e _ := a.elem in {elem := MkI e m} a

624 | erase : DrawState -> DrawState

625 | erase s =

626 |   case selectedItems s.imol of

627 |     None => {mode := Erase} s

628 |     _    => delete s

630 | endResize : (h,w : Double) -> DrawState -> DrawState

631 | endResize h w s =

632 |   case h > 0 && w > 0 of

633 |     False => s

634 |     True  => {dims := SD {sheight = h, swidth = w}} s

636 | upd : DrawSettings => DrawEvent -> DrawState -> DrawState

637 | upd (ZoomIn b)    s = zoomIn b s

638 | upd (ZoomOut b)   s = zoomOut b s

639 | upd LeftDown      s = leftDown s

640 | upd LeftUp        s = leftUp s

641 | upd (Move x y)    s = move s (P x y)

642 | upd MiddleDown    s = {mode $= Translating} s

643 | upd MiddleUp      s = {mode $= endTranslate} s

644 | upd Undo          s = undo s

645 | upd Redo          s = redo s

646 | upd (SetElem e)   s = {mode := SetAtom (cast e), mol $= clear} s

647 | upd (ChgElem v)   s = modAtomWhere (is Selected) {elem := cast v, charge := 0} s

648 | upd (ChgCharge v) s = modAtomWhere (is Selected) {charge := v} s

649 | upd (ChgMass v)   s = modAtomWhere (is Selected) (setMassNr v) s

650 | upd (SetTempl e)  s = {mode := SetTempl e, mol $= clear} s

651 | upd (Load e)      s = initST s.dims Reset e

652 | upd (SetBond b)   s = {bond := b, mode := Draw, mol $= clear} s

653 | upd SelectMode    s = {mode := Select} s

654 | upd (KeyDown x)   s = onKeyDown x s

655 | upd (KeyUp x)     s = onKeyUp x s

656 | upd EraseMode     s = erase s

657 | upd Focus         s = {isActive := True} s

658 | upd Blur          s = {isActive := False} s

659 | upd Clear         s = setMol (G 0 empty) s

660 | upd Expand        s = updateMol expand s

661 | upd Center        s = reset s

662 | upd (SelAbbr a)   s = {mode := SetAbbr a, mol $= clear} s

663 | upd (Resize h w)  s = endResize h w s

664 | upd StartPSE      s = {mode := PTable Nothing} s

665 | upd SVG           s = s

666 | upd SVGimp        s = s

667 | upd Redraw        s = s

672 | toTransform : AffineTransformation -> Transform

673 | toTransform (AT (LT s r) (V x y)) =

674 |   let co  := s.value * cos r.value

675 |       si  := s.value * sin r.value

676 |    in Matrix co si (negate si) co x y

678 | scene : DrawSettings => (exp : Bool) -> DrawState -> SVGNode

679 | scene exp s =

680 |   case s.mode of

681 |     PTable me => displayPSE s.dims me

682 |     _         =>

683 |       let m := nextMol s

684 |        in g

685 |             [transform $ toTransform s.transform]

686 |             (if exp

687 |                then drawMolecule $ clear m

688 |                else drawMolecule m ++ drawSelection s)

693 | metadata : DrawSettings => DrawState -> (comment : String) -> SVGNode

694 | metadata s c =

695 |   let m := nextMol s

696 |    in El "metadata" [] [Txt $ toMolStr s c]

698 | display :

699 |      {auto _ : DrawSettings}

700 |   -> DrawState

701 |   -> (metadata : Bool)

702 |   -> (comment : String)

703 |   -> SVGNode

704 | display s m c =

705 |   svg

706 |     [ xmlns_2000

707 |     , viewBox 0.u 0.u s.dims.swidth.u s.dims.sheight.u

708 |     ] $ if m then [scene True s, metadata s c] else [scene False s]

711 | update : DrawSettings => DrawEvent -> DrawState -> DrawState

712 | update e s =

713 |   let s2 := upd e s

714 |    in {prevSVG := s.curSVG, curSVG := render (display s2 False "")} s2

720 | parameters {auto ds : DrawSettings}

722 |   ||| Initializes the drawing state for the given mol graph.

728 |   export

729 |   initMol :

730 |        SceneDims

731 |     -> ScaleMode

732 |     -> (metadata : Bool)

733 |     -> (comment : String)

734 |     -> CDGraph

735 |     -> DrawState

736 |   initMol sd sm metadata c g =

737 |     let s := initST sd sm g

738 |      in {curSVG := render (display s metadata c)} s

739 |   

740 |   export %inline

741 |   init : SceneDims -> ScaleMode -> String -> DrawState

742 |   init sd sm = initMol sd sm False "" . readMolfile

743 |   

744 |   export %inline

745 |   fromMol : SceneDims -> ScaleMode -> MolGraphAT -> DrawState

746 |   fromMol sd sm = initMol sd sm False "" . initGraph

748 |   ||| Generates a string holding the SVG-encoded molecular structur

754 |   export

755 |   exportSVGPair :

756 |        (metadata : Bool)

757 |     -> (comment : String)

758 |     -> DrawState

759 |     -> (SceneDims, String)

760 |   exportSVGPair b c s =

761 |     let Just (p1,p2) := corners $ bounds s.mol | Nothing => (SD 0 0, "")

762 |         (SZ _ _ r1 r2) := selectZones (convert p1) (convert p2)

763 |         sd             := SD (r2-r1).x (r2-r1).y

764 |      in (sd, curSVG $ initMol sd Init b c s.mol)

766 |   ||| Generates an SVG string out of the current DrawState. The

770 |   export

771 |   exportSVG : DrawState -> String

772 |   exportSVG = snd . exportSVGPair True ""