HGamer3D-Wire 0.3.0 → 0.3.1
raw patch · 2 files changed
+131/−88 lines, 2 files
Files
- HGamer3D-Wire.cabal +2/−2
- HGamer3D/Wire/GUI.hs +129/−86
HGamer3D-Wire.cabal view
@@ -1,10 +1,10 @@ Name: HGamer3D-Wire-Version: 0.3.0+Version: 0.3.1 Synopsis: Wire Functionality for HGamer3D Description: HGamer3D is a game engine for developing 3D games in the programming language Haskell. This package provides wiring functionality, - based on the package HGamer3D and netwire. HGamer3D-Wire+ based on the packages HGamer3D and netwire. HGamer3D-Wire is available on Windows and Linux. License: OtherLicense
HGamer3D/Wire/GUI.hs view
@@ -26,6 +26,8 @@ -- * fundamental and simple Wires guiEventW, guiPropertyW,+ guiSetPropertyW,+ guiGetPropertyW, buttonW, staticTextW,@@ -77,7 +79,11 @@ writeIORef ref xs return $ Event x -guiEventW :: WireSystem -> String -> String -> IO (GameWire a (Event a))+-- | A wire, which which delivers the input value as an event, when GUI event occurs+guiEventW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> String -- ^ name of event+ -> IO (GameWire a (Event a)) -- ^ resulting wire guiEventW ws widgetname eventname = do let guis = wsGui ws let un = wsUniqueName ws@@ -93,17 +99,19 @@ NoEvent -> return (Right NoEvent) ) return wire -buttonW :: WireSystem- -> String -- ^ GUI element (which should be a button)- -> IO (GameWire a (Event a)) -- ^ event wire+-- | A wire, which delivers input value as event on button click+buttonW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> IO (GameWire a (Event a)) -- ^ resulting wire buttonW ws widgetname = do wire <- guiEventW ws widgetname "Clicked" return wire -guiPropertyW :: WireSystem- -> String- -> String -- ^ property name- -> IO (GameWire (Event a, Event String) (Event String))+-- | A property wire, you can set a property and query a property with this wire+guiPropertyW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> String -- ^ name of property+ -> IO (GameWire (Event a, Event String) (Event String)) -- ^ resulting wire, input of left event queries property, right event sets the property guiPropertyW ws widgetname propname = do widget <- getGuiWidget ws widgetname let wire = mkGen_ (\(evtL, evtR) -> do@@ -123,128 +131,163 @@ r <- rVal return r) return wire--_createGUIValueW :: WireSystem -> String -> String -> String -> IO (GameWire (Event a, Event String) (Event String))-_createGUIValueW ws widgetname propname eventchangename = do- widget <- getGuiWidget ws widgetname+ +-- | A wire, which sets a property upon event+guiSetPropertyW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> String -- ^ name of property+ -> IO (GameWire (Event String) (Event String)) -- ^ resulting wire, input sets property and is routed through unchanged+guiSetPropertyW ws widgetname propname = do+ wire <- guiPropertyW ws widgetname propname+ let wire' = proc inval -> do+ wire . (never &&& id) -< inval+ returnA -< inval+ return wire'+ +-- | A wire, which queries a property upon event+guiGetPropertyW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> String -- ^ name of property+ -> IO (GameWire (Event a) (Event String)) -- ^ resulting wire, gets current value of property upon in-event+guiGetPropertyW ws widgetname propname = do+ wire <- guiPropertyW ws widgetname propname+ let wire' = proc inval -> do+ outval <- wire . (id &&& never) -< inval+ returnA -< outval+ return wire'+ +_createGUIValueW :: WireSystem -> String -> String -> String -> String -> IO (GameWire (Event String) (Event String, String))+_createGUIValueW ws widgetname propname eventchangename startv = do propW <- guiPropertyW ws widgetname propname eventW <- guiEventW ws widgetname eventchangename- let wire = proc (evtL, evtR) -> do- changeEvent <- eventW -< ()- let evtLN = fmap (\x -> ()) evtL- inhibitFlag <- pure False . holdFor 0.5 <|> pure True -< evtR- evtL' <- arr (\(l, c, p) -> mergeL l (if p then c else NoEvent) ) -< (evtLN, changeEvent, inhibitFlag)- rVal <- propW -< (evtL', evtR)- returnA -< rVal+ let wire = proc setE -> do+ changeE <- eventW -< ()+ setE' <- id &> now . pure startv -< setE+ changeE' <- propW -< (changeE, setE')+ value <- hold -< setE' `mergeL` changeE'+ inhibitFlag <- (pure False . holdFor 0.5) <|> (pure True) -< setE+ changeE'' <- arr (\(c, p) -> if p then c else NoEvent) -< (changeE', inhibitFlag)+ returnA -< (changeE'', value) return wire --- | Constructor for two wires, which in combination provide the functionality of an editable box GUI element.-editBoxW :: WireSystem - -> String -- ^ GUI element (should be an editbox)- -> IO (GameWire (Event a, Event String) (Event String) )-editBoxW ws widgetname = _createGUIValueW ws widgetname "Text" "TextChanged" +-- | An edit box wire, editable text element+editBoxW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> String -- ^ start value+ -> IO (GameWire (Event String) (Event String, String) ) -- ^ resulting wire+editBoxW ws widgetname startv = _createGUIValueW ws widgetname "Text" "TextChanged" startv -_strtd :: Double -> GameWire (Event String) (Event Double)-_strtd def = (arr . fmap) (\str -> case (reads str)::[(Double, String)] of- [(a, str)] -> a+ +_strtd :: Double -> GameWire (Event String, String) (Event Double, Double)+_strtd def = let+ convert = (\str -> case (reads str)::[(Double, String)] of+ [(a, _)] -> a _ -> def)+ in arr (\(evt, val) -> (fmap convert evt, convert val)) _dtstr :: GameWire (Event Double) (Event String) _dtstr = (arr . fmap) (\d -> show d) -doubleBoxW :: WireSystem - -> String -- ^ GUI element (should be an editbox)- -> Double -- ^ Default double in case instring does not produce a value- -> IO (GameWire (Event a, Event Double) (Event Double) )+-- | A wire, which provides an editable double value+doubleBoxW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> Double -- ^ start and default value, in case string does not translate to a double value+ -> IO (GameWire (Event Double) (Event Double, Double) ) -- ^ resulting wire doubleBoxW ws widgetname def = do- wire <- editBoxW ws widgetname- let wire' = _strtd def . wire . (second _dtstr)+ wire <- editBoxW ws widgetname (show def)+ let wire' = _strtd def . wire . _dtstr return wire' --- | Constructur for a wire, which can change a static text GUI element (a setter).-staticTextW :: WireSystem - -> String -- ^ GUI element (should be a static text, or any widget with a "Text" property.- -> IO (GameWire (Event a, Event String) (Event String)) -- ^ the returned wire-staticTextW ws widgetname = guiPropertyW ws widgetname "Text"+-- | A wire, which simply displays a text+staticTextW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> IO (GameWire (Event String) (Event String)) -- ^ resulting wire+staticTextW ws widgetname = guiSetPropertyW ws widgetname "Text" _bst = arr (\val -> fmap (\b -> if b then "True" else "False") val)-_stb = arr (\val -> fmap (\st -> if st == "True" then True else False) val)+_stb = let convert = (\st -> if st == "True" then True else False)+ in arr (\(evt, val) -> (fmap convert evt, convert val)) --- | Consructor for two wires, which deliver the checkbox GUI element functionality.-checkBoxW :: WireSystem- -> String -- ^ GUI element (should be a checkbox)- -> IO (GameWire (Event a, Event Bool) (Event Bool) )-checkBoxW ws widgetname = do- wire <- _createGUIValueW ws widgetname "Selected" "CheckStateChanged" - return $ _stb . wire . second _bst+-- | A checkbox wire+checkBoxW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> Bool -- ^ start value+ -> IO (GameWire (Event Bool) (Event Bool, Bool) ) -- ^ resulting wire+checkBoxW ws widgetname startv = do+ wire <- _createGUIValueW ws widgetname "Selected" "CheckStateChanged" (show startv)+ return $ _stb . wire . _bst --- | Constructor for two wires, which deliver the radiobuttion GUI element functionality.-radioButtonW :: WireSystem- -> String -- ^ GUI element (should be a checkbox)- -> IO (GameWire (Event a, Event Bool) (Event Bool) )-radioButtonW ws widgetname = do- wire <- _createGUIValueW ws widgetname "Selected" "SelectStateChanged"- return $ _stb . wire . second _bst+-- | A radiobutton wire+radioButtonW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> Bool -- ^ start value+ -> IO (GameWire (Event Bool) (Event Bool, Bool) ) -- ^ resulting wire+radioButtonW ws widgetname startv = do+ wire <- _createGUIValueW ws widgetname "Selected" "SelectStateChanged" (show startv)+ return $ _stb . wire . _bst --- | Constructor for two wires, which deliver the slider GUI element functionality.-sliderW :: WireSystem- -> String -- ^ GUI element (should be a slider)- -> Double -- ^ Default Double- -> IO (GameWire (Event a, Event Double) (Event Double)) -- ^ the returned wires, a value changed wire and a setter wire+-- | A slider wire+sliderW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> Double -- ^ start value+ -> IO (GameWire (Event Double) (Event Double, Double)) -- ^ resulting wire sliderW ws widgetname def = do- wire <- _createGUIValueW ws widgetname "CurrentValue" "ValueChanged"- return $ _strtd def . wire . second _dtstr+ wire <- _createGUIValueW ws widgetname "CurrentValue" "ValueChanged" (show def)+ return $ _strtd def . wire . _dtstr --- | Constructur for two wires, which deliver the spinner GUI element functionality.-spinnerW :: WireSystem- -> String -- ^ GUI element (should be a spinner)- -> Double -- ^ Default Double- -> IO (GameWire (Event a, Event Double) (Event Double)) -- ^ the returned wires, a value changed wire and a setter wire+-- | A spinner wire (rename of sliderW)+spinnerW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> Double -- ^ start value+ -> IO (GameWire (Event Double) (Event Double, Double)) -- ^ resulting wire spinnerW = sliderW -- -- LISTBOX AND COMBOBOX ----------------------- _guiPropertyListboxW :: GUIElement- -> IO (GameWire (Event a, Event [(String, Bool, b)]) (Event [(String, Bool, b)]))-_guiPropertyListboxW widget = do+ -> (a -> String)+ -> IO (GameWire (Event b, Event [(a, Bool)]) (Event [a]) )+_guiPropertyListboxW widget toStringF = do let wire slist = mkGenN (\(evtL, evtR) -> do let rVal slist' = do case evtL of Event _ -> do val <- listboxStatus widget- let val' = fmap (\( (e', s'), (e, s, n)) -> (e', s', n)) (zip val slist')+ let val' = fmap snd (filter (\( (e', s'), entry) -> s') (zip val slist')) return (Right (Event val'), wire slist') _ -> return (Right NoEvent, wire slist') case evtR of Event value -> do- let value' = fmap (\(e, s, n) -> (e, s)) value+ let value' = fmap (\(aval,s) -> (toStringF aval, s)) value+ let value'' = fmap fst value listboxInitialize widget value'- r <- rVal value+ r <- rVal value'' return r _ -> do r <- rVal slist return r) return $ wire [] -listBoxW :: WireSystem- -> String -- ^ GUI element- -> IO (GameWire (Event a, Event [(String, Bool, b)]) (Event [(String, Bool, b)])) -- ^ In: request val, set list, set choices-listBoxW ws widgetname = do+-- | A listbox wire, , output events are selection changes, output contains selected data+listBoxW :: WireSystem -- ^ the Wiresystem+ -> String -- ^ name of widget+ -> (a -> String) -- ^ function to convert data values to display string+ -> [(a, Bool)] -- ^ start values+ -> IO (GameWire (Event [(a, Bool)]) (Event [a], [a])) -- ^ resulting wire+listBoxW ws widgetname toStringF startv = do widget <- getGuiWidget ws widgetname- propW <- _guiPropertyListboxW widget+ propW <- _guiPropertyListboxW widget toStringF eventW <- guiEventW ws widgetname "ItemSelectionChanged"- let wire = proc (evtL, evtR) -> do- changeEvent <- eventW -< ()- let evtLN = fmap (\x -> ()) evtL- inhibitFlag <- pure False . holdFor 0.5 <|> pure True -< evtR- evtL' <- arr (\(l, c, p) -> mergeL l (if p then c else NoEvent) ) -< (evtLN, changeEvent, inhibitFlag)- rVal <- propW -< (evtL', evtR)- returnA -< rVal+ let wire = proc setE -> do+ changeE <- eventW -< ()+ setE' <- id &> now . pure startv -< setE+ changeE' <- propW -< (changeE, setE')+ let setE'' = fmap (fmap fst) (fmap (\l -> filter (\(e, s) -> s) l) setE')+ value <- hold -< setE'' `mergeL` changeE'+ inhibitFlag <- (pure False . holdFor 0.5) <|> (pure True) -< setE+ changeE'' <- arr (\(c, p) -> if p then c else NoEvent) -< (changeE', inhibitFlag)+ returnA -< (changeE'', value) return wire- -