module Example(main) where
import qualified Graphics.UI.LUI.Run as Run
import qualified Graphics.UI.LUI.Image as Image
import qualified Graphics.UI.LUI.Widgets.TextEdit as TextEdit
import qualified Graphics.UI.LUI.Widgets.TextView as TextView
import qualified Graphics.UI.LUI.Widgets.Scroll as Scroll
import qualified Graphics.UI.LUI.Widgets.Grid as Grid
import qualified Graphics.UI.LUI.Widgets.Box as Box
import qualified Graphics.UI.LUI.Widgets.Space as Space
import qualified Graphics.UI.LUI.Widgets.KeysTable as KeysTable
import qualified Graphics.UI.LUI.Widgets.Adapter as Adapter
import Graphics.UI.LUI.Widget(Widget)
import Graphics.UI.LUI.Accessor(Accessor, accessor, aMapValue, (^>), (^.))
import qualified Graphics.UI.HaskGame.Font as Font
import qualified Graphics.UI.HaskGame as HaskGame
import Graphics.UI.HaskGame.Vector2(Vector2(..))
import Graphics.UI.HaskGame.Font(Font)
import Graphics.UI.HaskGame.Color(Color(..))
import Graphics.UI.HaskGame.Rect(Rect(..))
import qualified Data.Map as Map
import Data.Maybe(listToMaybe)
import Control.Monad(mapM)
isSorted :: (Ord a) => [a] -> Bool
isSorted xs = and $ zipWith (<=) xs (tail xs)
simpleRead :: Read a => String -> Maybe a
simpleRead = listToMaybe . map fst . filter (null . snd) . reads
main :: IO ()
main = HaskGame.withInit $ do
gui <- makeGui
resultModel <- Run.mainLoop gui guiModel
print $ gridModel resultModel ^. Grid.aDelegatedMutableCursor
return ()
data Model = Model
{
vboxModel :: Box.DelegatedMutable
, textEditModels :: Map.Map Grid.Cursor TextEdit.DelegatedMutable
, gridModel :: Grid.DelegatedMutable
, scrollModel :: Scroll.Mutable
}
data Fonts = Fonts
{
defaultFont, textViewFont, keysFont, descFont :: Font
}
avboxModel :: Accessor Model Box.DelegatedMutable
avboxModel = accessor vboxModel (\new x -> x{vboxModel=new})
scrollerModel :: Accessor Model Scroll.Mutable
scrollerModel = accessor scrollModel (\new x -> x{scrollModel=new})
atextEditModels :: Accessor Model (Map.Map Grid.Cursor TextEdit.DelegatedMutable)
atextEditModels = accessor textEditModels (\new x -> x{textEditModels=new})
agridModel :: Accessor Model Grid.DelegatedMutable
agridModel = accessor gridModel (\new x -> x{gridModel=new})
texts :: [String]
texts =
[
"Hello"
,"World"
,"Blah"
,"Bleh"
]
guiModel :: Model
guiModel =
Model
{
vboxModel = Box.delegatedMutable False 0
, textEditModels =
Map.fromList [((x, y),
TextEdit.delegatedMutable False (texts!!(y*2+x)) 5)
| x <- [0..1]
, y <- [0..1]]
, gridModel = Grid.delegatedMutable False (0, 0)
, scrollModel = Scroll.Mutable $ Vector2 0 0
}
textEditCursorColor, textViewColor, textEditColor, textEditingColor :: Color
textEditingColor = Color 30 20 100
textEditColor = Color 255 255 255
textViewColor = Color 255 100 255
textEditCursorColor = Color 255 0 0
textEdit :: Grid.Cursor -> Fonts -> Widget Model
textEdit cursor fonts =
TextEdit.newDelegated textEditingColor
textEditCursorColor
(defaultFont fonts)
textEditColor $
atextEditModels ^> aMapValue cursor
gridSize :: Grid.Cursor
gridSize = (2, 2)
grid :: Fonts -> Widget Model
grid fonts =
Grid.newDelegated gridSize items agridModel
where
items = Map.fromList
[((x, y), Grid.Item (textEdit (x, y) fonts) (0.5, 1))
| x <- [0..1], y <- [0..1]]
proxy1 :: Fonts -> Widget Model
proxy1 fonts model =
textEdit (model ^. agridModel ^. Grid.aDelegatedMutableCursor) fonts model
readCursor :: String -> Maybe Grid.Cursor
readCursor text =
let (xCount, yCount) = gridSize
verifyCursor cursor@(x, y) =
if isSorted [0, x, xCount1] &&
isSorted [0, y, yCount1]
then Just cursor
else Nothing
in verifyCursor =<< simpleRead text
textView :: String -> Font -> Widget Model
textView text font =
TextView.new textViewColor font text
proxy2 :: Fonts -> Widget Model
proxy2 fonts model =
let cursor = model ^. agridModel ^. Grid.aDelegatedMutableCursor
text = model ^. atextEditModels ^. aMapValue cursor ^.
TextEdit.aDelegatedMutableText
in maybe (textView ("Invalid cursor position selected: " ++ text)
(textViewFont fonts) model)
(\cur -> textEdit cur fonts model) $
readCursor text
scrollBox :: Fonts -> Widget Model
scrollBox fonts = Scroll.new (Vector2 200 200) box scrollerModel
where
font = defaultFont fonts
box = Box.new Box.Vertical items $ Box.noAcc 0
items = [Box.Item (Adapter.adaptImage
(Image.cropRect $ Rect i 0 (wii) h) $
textView text font) 0.5
| i <- [0,20..250]
, let text = "THIS IS A TRUNCATED VIEW: " ++ show i
Vector2 w h = Image.textSize font text]
vbox :: Fonts -> Widget Model
vbox fonts = Box.newDelegated Box.Vertical items avboxModel
where
items = [Box.Item (grid fonts) 1
,Box.Item (Space.newH 100) 0.5
,Box.Item (proxy1 fonts) 0.5
,Box.Item (proxy2 fonts) 0.5
,Box.Item (scrollBox fonts) 0.5
]
withKeysTable :: Fonts -> Widget Model
withKeysTable fonts = KeysTable.newBoxedWidget Box.Horizontal 50 (keysFont fonts) (descFont fonts) (vbox fonts)
makeGui :: IO (Widget Model)
makeGui = do
[f15, f25, f30] <- mapM Font.defaultFont [15, 25, 30]
return . withKeysTable $ Fonts f30 f15 f25 f25