0 | module CyBy.Draw.Internal.Role
  1 |
  2 | import Data.Bits
  3 | import Derive.Prelude
  4 |
  5 | %default total
  6 | %language ElabReflection
  7 |
  8 | ||| The role(s) an object (typically an atom or bond) in the
  9 | ||| drawing currently has (for instance, it is selected, or
 10 | ||| the mouse hovers over it, or it is currently being drawn).
 11 | |||
 12 | ||| We encode this as a bit pattern to facilitate adding new roles and
 13 | ||| having several roles set simultaneously.
 14 | |||
 15 | ||| `Role` is a semigroup (using bitwise "or", `(.|.)`, for append) and
 16 | ||| a monoid, with 0 as the neutral element.
 17 | public export
 18 | record Role where
 19 |   constructor R
 20 |   role : Bits8
 21 |
 22 | %runElab derive "Role" [Show,Eq,Ord]
 23 |
 24 | export %inline
 25 | Semigroup Role where
 26 |   R x <+> R y = R (x .|. y)
 27 |
 28 | export %inline
 29 | Monoid Role where neutral = R 0
 30 |
 31 | public export
 32 | None, Hover, Selected, Origin, New, Persistent, HoverNew, Highlight : Role
 33 | None       = R 0
 34 | Hover      = R 1
 35 | Selected   = R 2
 36 | Origin     = R 4
 37 | New        = R 8
 38 | Highlight  = R 16
 39 | Persistent = Hover <+> Selected
 40 | HoverNew   = Hover <+> New
 41 |
 42 | ||| Interface for objects with a `Role` we can modify
 43 | public export
 44 | interface ModRole a where
 45 |   modRole : (Role -> Role) -> a -> a
 46 |
 47 | export %inline
 48 | ModRole Role where modRole f = f
 49 |
 50 | ||| Sets the given role at an object in the drawing
 51 | export
 52 | setIf : ModRole a => Role -> Bool -> a -> a
 53 | setIf r True  = modRole (r <+>)
 54 | setIf r False = modRole $ \(R y) => R (y `xor` (r.role .&. y))
 55 |
 56 | ||| Sets the given role at an object in the drawing
 57 | export %inline
 58 | set : ModRole a => Role -> a -> a
 59 | set r = r `setIf` True
 60 |
 61 | ||| Sets the given role at an object in the drawing
 62 | export %inline
 63 | unset : ModRole a => Role -> a -> a
 64 | unset r = r `setIf` False
 65 |
 66 | ||| Keep only the given roles and unset all others
 67 | export %inline
 68 | keep : ModRole a => Role -> a -> a
 69 | keep (R x) = modRole $ \(R y) => R (x .&. y)
 70 |
 71 | ||| Completely remove all roles
 72 | export %inline
 73 | clear : ModRole a => a -> a
 74 | clear = modRole (const None)
 75 |
 76 | ||| Tests if the given role(s) is/are set at the given object
 77 | ||| in the drawing
 78 | export
 79 | is : Cast a Role => Role -> a -> Bool
 80 | is (R x) v = (x .&. role (cast v)) == x
 81 |
 82 | ||| Selection mode we are currently in.
 83 | |||
 84 | ||| `Ignore` means that we are currently not selecting this type of item.
 85 | ||| `One`    means "single-select" mode (SHIFT is not down)
 86 | ||| `Many`   means "multi-select" mode (SHIFT is down)
 87 | public export
 88 | data SelectMode = Ignore | One | Many
 89 |
 90 | ||| Selects a hovered node or edge.
 91 | |||
 92 | ||| The boolean flag indicates, if we want to keep already selected
 93 | ||| node or not (as indicated by the `Shift` key being down).
 94 | export
 95 | selectIfHovered : ModRole a => SelectMode -> a -> a
 96 | selectIfHovered Ignore = unset Selected
 97 | selectIfHovered One    = modRole (\x => setIf Selected (is Hover x) x)
 98 | selectIfHovered Many   =
 99 |   modRole (\x => setIf Selected (is Hover x || is Selected x) x)
100 |