
   0 | module NCurses.Core.Attribute
   1 | 
   2 | import NCurses.Core
   3 | import NCurses.Core.Color
   4 | 
   5 | %default total
   6 | 
   7 | %foreign libncurses "wchgat"
   8 | prim__changeAtWindow : AnyPtr -> Int -> Int -> Int -> AnyPtr -> PrimIO ()
   9 | 
  10 | %foreign libncurses "mvchgat"
  11 | prim__mvChangeAt : Int -> Int -> Int -> Int -> Int -> AnyPtr -> PrimIO ()
  12 | 
  13 | %foreign libncurses "mvwchgat"
  14 | prim__mvChangeAtWindow : AnyPtr -> Int -> Int -> Int -> Int -> Int -> AnyPtr -> PrimIO ()
  15 | 
  16 | %foreign libncurses "attrset"
  17 | prim__setAttr : Int -> PrimIO ()
  18 | 
  19 | %foreign libncurses "wattrset"
  20 | prim__setAttrWindow : AnyPtr -> Int -> PrimIO ()
  21 | 
  22 | %foreign libncurses "attroff"
  23 | prim__disableAttr : Int -> PrimIO ()
  24 | 
  25 | %foreign libncurses "wattroff"
  26 | prim__disableAttrWindow : AnyPtr -> Int -> PrimIO ()
  27 | 
  28 | %foreign libncurses "attron"
  29 | prim__enableAttr : Int -> PrimIO ()
  30 | 
  31 | %foreign libncurses "wattron"
  32 | prim__enableAttrWindow : AnyPtr -> Int -> PrimIO ()
  33 | 
  34 | %foreign libhelper "normal_attr"
  35 | prim__normalAttr : PrimIO Int
  36 | 
  37 | %foreign libhelper "underline_attr"
  38 | prim__underlineAttr : PrimIO Int
  39 | 
  40 | %foreign libhelper "standout_attr"
  41 | prim__standoutAttr : PrimIO Int
  42 | 
  43 | %foreign libhelper "reverse_attr"
  44 | prim__reverseAttr : PrimIO Int
  45 | 
  46 | %foreign libhelper "blink_attr"
  47 | prim__blinkAttr : PrimIO Int
  48 | 
  49 | %foreign libhelper "dim_attr"
  50 | prim__dimAttr : PrimIO Int
  51 | 
  52 | %foreign libhelper "bold_attr"
  53 | prim__boldAttr : PrimIO Int
  54 | 
  55 | %foreign libhelper "protected_attr"
  56 | prim__protectedAttr : PrimIO Int
  57 | 
  58 | %foreign libhelper "invisible_attr"
  59 | prim__invisibleAttr : PrimIO Int
  60 | 
  61 | %foreign libhelper "color_pair_attr"
  62 | prim__colorPairAttr : Int -> PrimIO Int
  63 | 
  64 | %foreign libncurses "bkgd"
  65 | prim__setBackground : Int -> PrimIO ()
  66 | 
  67 | %foreign libncurses "wbkgd"
  68 | prim__setBackgroundWindow : AnyPtr -> Int -> PrimIO ()
  69 | 
  70 | ||| Attributes that can be given to text within an ncurses window.
  71 | public export
  72 | data Attribute = Normal
  73 |                | Underline
  74 |                | Standout
  75 |                | Reverse
  76 |                | Blink
  77 |                | Dim
  78 |                | Bold
  79 |                | Protected
  80 |                | Invisible
  81 |                | CP ColorPair
  82 | 
  83 | export
  84 | Eq Attribute where
  85 |   Normal    == Normal    = True
  86 |   Underline == Underline = True
  87 |   Standout  == Standout  = True
  88 |   Reverse   == Reverse   = True
  89 |   Blink     == Blink     = True
  90 |   Dim       == Dim       = True
  91 |   Bold      == Bold      = True
  92 |   Protected == Protected = True
  93 |   Invisible == Invisible = True
  94 |   (CP c1)   == (CP c2)   = c1 == c2
  95 |   _ == _ = False
  96 | 
  97 | export
  98 | Show Attribute where
  99 |   show Normal = "Normal"
 100 |   show Underline = "Underline"
 101 |   show Standout = "Standout"
 102 |   show Reverse = "Reverse"
 103 |   show Blink = "Blink"
 104 |   show Dim = "Dim"
 105 |   show Bold = "Bold"
 106 |   show Protected = "Protected"
 107 |   show Invisible = "Invisible"
 108 |   show (CP c) = "Color (\{show c})"
 109 | 
 110 | ||| Get the Int representation ncurses cares about for a
 111 | ||| particular @Attribute@.
 112 | getAttribute : HasIO io => Attribute -> io Int
 113 | getAttribute attr = case attr of
 114 |                          Normal    => primIO $ prim__normalAttr
 115 |                          Underline => primIO $ prim__underlineAttr
 116 |                          Standout  => primIO $ prim__standoutAttr
 117 |                          Reverse   => primIO $ prim__reverseAttr
 118 |                          Blink     => primIO $ prim__blinkAttr
 119 |                          Dim       => primIO $ prim__dimAttr
 120 |                          Bold      => primIO $ prim__boldAttr
 121 |                          Protected => primIO $ prim__protectedAttr
 122 |                          Invisible => primIO $ prim__invisibleAttr
 123 |                          (CP cp) => primIO $ prim__colorPairAttr (cast cp.idx)
 124 | 
 125 | ||| Set an attribute to be applied in the standard window
 126 | ||| until it is cleared or overwritten.
 127 | |||
 128 | ||| In ncurses terminology, "attrset"
 129 | |||
 130 | ||| See @nSetAttr'@ for a version that works on
 131 | ||| any given window.
 132 | export
 133 | nSetAttr : HasIO io => Attribute -> io ()
 134 | nSetAttr attr = do attribute <- getAttribute attr
 135 |                    primIO $ prim__setAttr attribute
 136 | 
 137 | ||| Set an attribute to be applied in the given window
 138 | ||| until it is cleared or overwritten.
 139 | |||
 140 | ||| In ncurses terminology, "wattrset"
 141 | export
 142 | nSetAttr' : HasIO io => Window -> Attribute -> io ()
 143 | nSetAttr' (Win win) attr = do attribute <- getAttribute attr
 144 |                               primIO $ prim__setAttrWindow win attribute
 145 | 
 146 | ||| Set the given attribute in the standard window
 147 | ||| until it is set again. This has no impact
 148 | ||| on any other attributes that are set.
 149 | |||
 150 | ||| In ncurses terminology, "attron"
 151 | |||
 152 | ||| See @nEnableAttr'@ for a version that works on
 153 | ||| any given window.
 154 | export
 155 | nEnableAttr : HasIO io => Attribute -> io ()
 156 | nEnableAttr attr = do attribute <- getAttribute attr
 157 |                       primIO $ prim__enableAttr attribute
 158 | 
 159 | ||| Set the given attribute in the given window
 160 | ||| until it is set again. This has no impact
 161 | ||| on any other attributes that are set.
 162 | |||
 163 | ||| In ncurses terminology, "wattron"
 164 | export
 165 | nEnableAttr' : HasIO io => Window -> Attribute -> io ()
 166 | nEnableAttr' (Win win) attr = do attribute <- getAttribute attr
 167 |                                  primIO $ prim__enableAttrWindow win attribute
 168 | 
 169 | ||| Unset the given attribute in the standard window
 170 | ||| until it is set again. This has no impact
 171 | ||| on any other attributes that are set.
 172 | |||
 173 | ||| In ncurses terminology, "attroff"
 174 | |||
 175 | ||| See @nDisableAttr'@ for a version that works on
 176 | ||| any given window.
 177 | export
 178 | nDisableAttr : HasIO io => Attribute -> io ()
 179 | nDisableAttr attr = do attribute <- getAttribute attr
 180 |                        primIO $ prim__disableAttr attribute
 181 | 
 182 | ||| Unset the given attribute in the given window
 183 | ||| until it is set again. This has no impact
 184 | ||| on any other attributes that are set.
 185 | |||
 186 | ||| In ncurses terminology, "wattroff"
 187 | export
 188 | nDisableAttr' : HasIO io => Window -> Attribute -> io ()
 189 | nDisableAttr' (Win win) attr = do attribute <- getAttribute attr
 190 |                                   primIO $ prim__disableAttrWindow win attribute
 191 | 
 192 | ||| Change the attributes at the given position in the standard window.
 193 | ||| A len of Nothing means "the whole line."
 194 | ||| A color pair of @defaultColorPair@ offers a sane default.
 195 | |||
 196 | ||| See @nChangeAttr'@ to change attributes in another window.
 197 | export
 198 | nChangeAttrAt : HasIO io 
 199 |             => (row : Nat) 
 200 |             -> (col : Nat) 
 201 |             -> (len : Maybe Nat) 
 202 |             -> Attribute 
 203 |             -> ColorPair
 204 |             -> io ()
 205 | nChangeAttrAt row col len attr cp = 
 206 |   let length = the Int (maybe (-1) cast len)
 207 |   in  
 208 |       do attribute <- getAttribute attr
 209 |          primIO $ 
 210 |            prim__mvChangeAt (cast row) (cast col) length attribute (cast cp.idx) prim__getNullAnyPtr
 211 | 
 212 | ||| Change the attributes in the given window for the next @len@ characters.
 213 | ||| A len of Nothing means "the whole line."
 214 | ||| A color pair of @defaultColorPair@ offers a sane default.
 215 | export
 216 | nChangeAttr' : HasIO io 
 217 |             => Window
 218 |             -> (len : Maybe Nat) 
 219 |             -> Attribute 
 220 |             -> ColorPair
 221 |             -> io ()
 222 | nChangeAttr' (Win win) len attr cp = 
 223 |   let length = the Int (maybe (-1) cast len)
 224 |   in  
 225 |       do attribute <- getAttribute attr
 226 |          primIO $ 
 227 |            prim__changeAtWindow win length attribute (cast cp.idx) prim__getNullAnyPtr
 228 | 
 229 | ||| Change the attributes at the given position in the given window.
 230 | ||| A len of Nothing means "the whole line."
 231 | ||| A color pair of @defaultColorPair@ offers a sane default.
 232 | export
 233 | nChangeAttrAt' : HasIO io 
 234 |               => Window
 235 |               -> (row : Nat) 
 236 |               -> (col : Nat) 
 237 |               -> (len : Maybe Nat) 
 238 |               -> Attribute 
 239 |               -> ColorPair
 240 |               -> io ()
 241 | nChangeAttrAt' (Win win) row col len attr cp = 
 242 |   let length = the Int (maybe (-1) cast len)
 243 |   in  
 244 |       do attribute <- getAttribute attr
 245 |          primIO $ 
 246 |            prim__mvChangeAtWindow win (cast row) (cast col) length attribute (cast cp.idx) prim__getNullAnyPtr
 247 | 
 248 | ||| Set the background color of the standard window.
 249 | export
 250 | setBackground : HasIO io => ColorPair -> io ()
 251 | setBackground cp = do
 252 |   cp <- primIO $ prim__colorPairAttr (cast cp.idx)
 253 |   primIO $ prim__setBackground cp
 254 | 
 255 | ||| Set the background color of the given window.
 256 | export
 257 | setBackground' : HasIO io => Window -> ColorPair -> io ()
 258 | setBackground' (Win win) cp = do
 259 |   cp <- primIO $ prim__colorPairAttr (cast cp.idx)
 260 |   primIO $ prim__setBackgroundWindow win cp
 261 | 
 262 |