module Graphics.UI.FLTK.Widget (Attr(..), Prop(..), set, get,
Value_FC(..), Widget, Widget_C(..),
changed, label, When, when, tooltip,
labelSize, redraw, redrawLabel,
wNever, wChanged, wRelease, wReleaseAllways,
wEnter, wEnterAllways, wEnterChanged, wNotChanged,
Act, destroy, wait,
Color, black, red, green, yellow, blue, magenta, cyan, white,
rgb, color, labelColor, selectionColor,
CFlag(..), Align, align, coords,
aBottom, aCenter, aClip, aInside, aLeft,
aRight, aTextOverImage, aTop, aWrap
) where
import Foreign.C.String
import Foreign
import Foreign.StablePtr
infixr 5 :=
data Attr c a = Attr (c -> IO a) (c -> a -> IO ())
data Prop c = forall a. Attr c a := a
| forall a. Attr c a ::= IO a
| forall a. Attr c a :=> (a -> a)
| forall a. Attr c a ::=> (a -> IO a)
set :: c -> [Prop c] -> IO ()
set c = mapM_ app
where app (Attr _ s := v) = s c v
app (Attr g s ::= m) = m >>= s c
app (Attr g s :=> f) = g c >>= \v -> s c (f v)
app (Attr g s ::=> m)= g c >>= m >>= s c
get :: c -> Attr c a -> IO a
get c (Attr g _) = g c
class Value_FC c v | c -> v where value :: Attr c v
newtype Widget = Widget (Ptr Widget)
class Widget_C a where
_widget :: a -> Ptr Widget
action :: Attr a (Act a)
action = Attr actionG actionS
instance Widget_C Widget where
_widget (Widget p) = p
foreign import ccall "fl_Widget_redraw" _redraw :: Ptr Widget -> IO ()
foreign import ccall "fl_Widget_redraw_label" _redrawLabel :: Ptr Widget -> IO ()
redraw :: Widget_C w => w -> IO ()
redraw = _redraw._widget
redrawLabel :: Widget_C w => w -> IO ()
redrawLabel = _redrawLabel._widget
foreign import ccall "fl_Widget_changed_AG" fl_Widget_changed_AG :: Ptr Widget -> IO Bool
foreign import ccall "fl_Widget_changed_AS" fl_Widget_changed_AS :: Ptr Widget -> Bool -> IO ()
changed :: Widget_C c => Attr c Bool
changed = Attr (fl_Widget_changed_AG._widget) (\c v -> fl_Widget_changed_AS (_widget c) v)
foreign import ccall "fl_Widget_label_AG" fl_Widget_label_AG :: Ptr Widget -> IO CString
foreign import ccall "fl_Widget_label_AS" fl_Widget_label_AS :: Ptr Widget -> CString -> IO ()
label :: Widget_C c => Attr c String
label = Attr (\w -> fl_Widget_label_AG (_widget w) >>= peekCString)
(\c v -> newCString v >>= fl_Widget_label_AS (_widget c))
foreign import ccall "fl_Widget_labelsize_AG" fl_Widget_labelsize_AG :: Ptr Widget -> IO Int
foreign import ccall "fl_Widget_labelsize_AS" fl_Widget_labelsize_AS :: Ptr Widget -> Int -> IO ()
labelSize :: Widget_C c => Attr c Int
labelSize = Attr (fl_Widget_labelsize_AG._widget) (\c v -> fl_Widget_labelsize_AS (_widget c) v)
foreign import ccall "fl_Widget_tooltip_AG" fl_Widget_tooltip_AG :: Ptr Widget -> IO CString
foreign import ccall "fl_Widget_tooltip_AS" fl_Widget_tooltip_AS :: Ptr Widget -> CString -> IO ()
tooltip :: Widget_C c => Attr c String
tooltip = Attr (\w -> fl_Widget_tooltip_AG (_widget w) >>= peekCString)
(\c v -> newCString v >>= fl_Widget_tooltip_AS (_widget c))
newtype When = When Int
wNever = When 0
wChanged = When 1
wRelease = When 4
wReleaseAllways = When 6
wEnter = When 8
wEnterAllways = When 10
wEnterChanged = When 11
wNotChanged = When 2
foreign import ccall "fl_Widget_when_AG" fl_Widget_when_AG:: Ptr Widget -> IO When
foreign import ccall "fl_Widget_when_AS" fl_Widget_when_AS:: Ptr Widget -> When ->IO()
when :: Widget_C c => Attr c When
when = Attr (fl_Widget_when_AG._widget) (\w v -> fl_Widget_when_AS (_widget w) v)
type Act t = t -> IO ()
foreign import ccall "fl_Widget_action_AG" fl_Widget_action_AG
:: Ptr a -> IO (StablePtr (Act b))
foreign import ccall "fl_Widget_action_AS" fl_Widget_action_AS
:: Ptr a -> StablePtr (Act b) ->IO()
foreign export ccall "mhf_callback_handler" callbackHandler
:: Widget -> StablePtr (Act Widget) -> IO ()
callbackHandler w sp =
if castStablePtrToPtr sp == nullPtr
then return ()
else deRefStablePtr sp >>= \h -> h w
actionG :: Widget_C c => c -> IO (Act c)
actionG w = fl_Widget_action_AG (_widget w) >>= deRefStablePtr
actionS :: Widget_C c => c -> Act c -> IO ()
actionS w v = newStablePtr v >>= fl_Widget_action_AS (_widget w)
nothing _ = return ()
foreign import ccall "fl_Widget_delete" _delete :: Ptr Widget -> IO ()
destroy :: Widget_C w => w -> IO ()
destroy w = _delete (_widget w)
newtype Color = Color Int
black = Color 56
red = Color 88
green = Color 63
yellow = Color 95
blue = Color 216
magenta = Color 248
cyan = Color 223
white = Color 255
foreign import ccall "fl_rgb" rgb :: Int -> Int -> Int -> Color
foreign import ccall "fl_Widget_color_AG" fl_Widget_color_AG:: Ptr Widget -> IO Color
foreign import ccall "fl_Widget_color_AS" fl_Widget_color_AS:: Ptr Widget -> Color ->IO()
color :: Widget_C c => Attr c Color
color = Attr (fl_Widget_color_AG._widget) (\w v -> fl_Widget_color_AS (_widget w) v)
foreign import ccall "fl_Widget_labelcolor_AG" fl_Widget_labelcolor_AG:: Ptr Widget -> IO Color
foreign import ccall "fl_Widget_labelcolor_AS" fl_Widget_labelcolor_AS:: Ptr Widget -> Color ->IO()
labelColor :: Widget_C c => Attr c Color
labelColor = Attr (fl_Widget_labelcolor_AG._widget) (\w v -> fl_Widget_labelcolor_AS (_widget w) v)
foreign import ccall "fl_Widget_selection_color_AG" fl_Widget_selection_color_AG:: Ptr Widget -> IO Color
foreign import ccall "fl_Widget_selection_color_AS" fl_Widget_selection_color_AS:: Ptr Widget -> Color ->IO()
selectionColor :: Widget_C c => Attr c Color
selectionColor = Attr (fl_Widget_selection_color_AG._widget) (\w v -> fl_Widget_selection_color_AS (_widget w) v)
class CFlag a where (+|+) :: a -> a -> a
newtype Align = A Int
instance CFlag Align where (A a) +|+ (A b) = A $ a + b
aBottom, aCenter, aClip, aInside, aLeft, aRight, aTextOverImage, aTop, aWrap :: Align
aBottom = A 2
aCenter = A 0
aClip = A 64
aInside = A 16
aLeft = A 4
aRight = A 8
aTextOverImage = A 32
aTop = A 1
aWrap = A 128
foreign import ccall "fl_Widget_align_AG" fl_Widget_align_AG:: Ptr Widget -> IO Align
foreign import ccall "fl_Widget_align_AS" fl_Widget_align_AS:: Ptr Widget -> Align ->IO()
align :: Widget_C c => Attr c Align
align = Attr (fl_Widget_align_AG._widget) (\w v -> fl_Widget_align_AS (_widget w) v)
foreign import ccall "fl_Widget_Coords_AG" coordsAG :: Ptr Widget -> Ptr Int -> IO ()
foreign import ccall "fl_Widget_Coords_AS" coordsAS :: Ptr Widget -> Int->Int->Int->Int -> IO ()
coords :: Widget_C c => Attr c (Int,Int,Int,Int)
coords = Attr (\w -> allocaArray 4 $ getCoords $ _widget w)
(\p (x,y,w,h) -> coordsAS (_widget p) x y w h)
getCoords w p = do coordsAG w p
[x,y,w,h] <- peekArray 4 p
return (x,y,w,h)
foreign import ccall "fl_wait" wait :: IO ()