lui-0.0.4: src/Example.hs

{-# OPTIONS_GHC -Wall -O2 #-}

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)

main :: IO ()
main = HaskGame.withInit $ do
    gui <- makeGui
    resultModel <- Run.mainLoop gui guiModel
    -- Prove that we have the new model here:
    print $ gridModel resultModel ^. Grid.aDelegatedMutableCursor
    return ()

-- Model:
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
    }

-- TODO: Replace with TH auto-gen
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
    }


-- Widgets

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

textView :: String -> Font -> Widget Model
textView text font =
    TextView.new textViewColor font text

gridSize :: Grid.Cursor
gridSize = (2, 2)

grid, scrollBox, vbox, withKeysTable, proxy1, proxy2 :: 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]]

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 (w-i-i) 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 = 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 = KeysTable.newBoxedWidget Box.Horizontal 50 (keysFont fonts) (descFont fonts) (vbox fonts)

proxy1 fonts model =
    textEdit (model ^. agridModel ^. Grid.aDelegatedMutableCursor) fonts model

simpleRead :: Read a => String -> Maybe a
simpleRead = listToMaybe . map fst . filter (null . snd) . reads

readCursor :: String -> Maybe Grid.Cursor
readCursor text =
    let (xCount, yCount) = gridSize
        verifyCursor cursor@(x, y) =
            if isSorted [0, x, xCount-1] &&
               isSorted [0, y, yCount-1]
            then Just cursor
            else Nothing
    in verifyCursor =<< simpleRead text

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

makeGui :: IO (Widget Model)
makeGui = do
  [f15, f25, f30] <- mapM Font.defaultFont [15, 25, 30]
  return . withKeysTable $ Fonts f30 f15 f25 f25