qtah-examples 0.2.1 → 0.3.0
raw patch · 4 files changed
+158/−35 lines, 4 filesdep +containersdep ~qtah-qt5setup-changed
Dependencies added: containers
Dependency ranges changed: qtah-qt5
Files
- Setup.hs +3/−21
- qtah-examples.cabal +7/−4
- src/Graphics/UI/Qtah/Example/Notepad.hs +8/−8
- src/Main.hs +140/−2
Setup.hs view
@@ -1,6 +1,6 @@ -- This file is part of Qtah. ----- Copyright 2016-2017 Bryan Gardiner <bog@khumba.net>+-- Copyright 2015-2017 The Qtah Authors. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU Lesser General Public License as published by@@ -15,25 +15,7 @@ -- You should have received a copy of the GNU Lesser General Public License -- along with this program. If not, see <http://www.gnu.org/licenses/>. -import Control.Monad (unless)-import Distribution.Simple (defaultMainWithHooks, simpleUserHooks)-import Distribution.Simple.Setup (ConfigFlags, configDynExe, configVerbosity, fromFlagOrDefault)-import Distribution.Simple.UserHooks (UserHooks (postConf))-import Distribution.Simple.Utils (warn)-import Distribution.Verbosity (normal)+import Distribution.Simple (defaultMain) main :: IO ()-main = defaultMainWithHooks qtahHooks--qtahHooks :: UserHooks-qtahHooks = simpleUserHooks- { postConf = \_ cf _ _ -> warnAboutDynExe cf- }--warnAboutDynExe :: ConfigFlags -> IO ()-warnAboutDynExe configFlags = do- let verbosity = fromFlagOrDefault normal $ configVerbosity configFlags- unless (fromFlagOrDefault False $ configDynExe configFlags) $- warn verbosity $- "qtah-examples needs to be a dynamically linked executable; " ++- "please pass --enable-executable-dynamic to 'cabal install'."+main = defaultMain
qtah-examples.cabal view
@@ -1,12 +1,12 @@ name: qtah-examples-version: 0.2.1+version: 0.3.0 synopsis: Example programs for Qtah Qt bindings homepage: http://khumba.net/projects/qtah license: LGPL-3 license-files: LICENSE.GPL, LICENSE.LGPL author: Bryan Gardiner <bog@khumba.net> maintainer: Bryan Gardiner <bog@khumba.net>-copyright: Copyright 2015-2017 Bryan Gardiner+copyright: Copyright 2015-2017 The Qtah Authors. category: Graphics build-type: Custom cabal-version: >=1.10@@ -19,12 +19,15 @@ main-is: Main.hs other-modules: Graphics.UI.Qtah.Example.Notepad+ other-extensions:+ ScopedTypeVariables build-depends: base >=4 && <5 , binary >=0.7 && <0.9 , bytestring >=0.10 && <0.11+ , containers <0.6 , filepath >=1.0 && <1.5 , hoppy-runtime >=0.3 && <0.4- , qtah-qt5 >=0.2 && <0.3- ghc-options: -W -fwarn-incomplete-patterns -fwarn-unused-do-bind+ , qtah-qt5 >=0.3 && <0.4+ ghc-options: -W -fwarn-incomplete-patterns -fwarn-unused-do-bind -dynamic default-language: Haskell2010
src/Graphics/UI/Qtah/Example/Notepad.hs view
@@ -1,6 +1,6 @@ -- This file is part of Qtah. ----- Copyright 2015-2017 Bryan Gardiner <bog@khumba.net>+-- Copyright 2015-2017 The Qtah Authors. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU Lesser General Public License as published by@@ -24,7 +24,6 @@ import Data.Bits ((.|.)) import Data.Functor (void) import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Foreign.Hoppy.Runtime (withScopedPtr) import qualified Graphics.UI.Qtah.Core.QCoreApplication as QCoreApplication import Graphics.UI.Qtah.Event import Graphics.UI.Qtah.Gui.QCloseEvent (QCloseEvent)@@ -32,7 +31,6 @@ import qualified Graphics.UI.Qtah.Core.QEvent as QEvent import qualified Graphics.UI.Qtah.Widgets.QAction as QAction import Graphics.UI.Qtah.Widgets.QAction (triggeredSignal)-import qualified Graphics.UI.Qtah.Widgets.QApplication as QApplication import qualified Graphics.UI.Qtah.Widgets.QFileDialog as QFileDialog import qualified Graphics.UI.Qtah.Widgets.QMainWindow as QMainWindow import Graphics.UI.Qtah.Widgets.QMainWindow (QMainWindow)@@ -48,7 +46,6 @@ undoAvailableSignal, ) import qualified Graphics.UI.Qtah.Widgets.QWidget as QWidget-import System.Environment (getArgs) import System.FilePath (takeFileName) data Notepad = Notepad@@ -59,10 +56,9 @@ } run :: IO ()-run = withScopedPtr (getArgs >>= QApplication.new) $ \_ -> do+run = do mainWindow <- makeMainWindow QWidget.show mainWindow- QCoreApplication.exec makeMainWindow :: IO QMainWindow makeMainWindow = do@@ -78,7 +74,8 @@ menuFileSave <- QMenu.addNewAction menuFile "&Save" menuFileSaveAs <- QMenu.addNewAction menuFile "Sa&ve as..." _ <- QMenu.addSeparator menuFile- menuFileQuit <- QMenu.addNewAction menuFile "&Quit"+ menuFileClose <- QMenu.addNewAction menuFile "&Close"+ menuFileQuit <- QMenu.addNewAction menuFile "&Quit Examples" menuEdit <- QMenuBar.addNewMenu menu "&Edit" menuEditUndo <- QMenu.addNewAction menuEdit "&Undo"@@ -115,7 +112,10 @@ connect_ menuFileOpen triggeredSignal $ \_ -> fileOpen me connect_ menuFileSave triggeredSignal $ \_ -> void $ fileSave me connect_ menuFileSaveAs triggeredSignal $ \_ -> void $ fileSaveAs me- connect_ menuFileQuit triggeredSignal $ \_ -> QWidget.close window+ connect_ menuFileClose triggeredSignal $ \_ -> void $ QWidget.close window+ connect_ menuFileQuit triggeredSignal $ \_ -> do+ closed <- QWidget.close window+ when closed QCoreApplication.quit connect_ menuEditUndo triggeredSignal $ \_ -> QTextEdit.undo text connect_ menuEditRedo triggeredSignal $ \_ -> QTextEdit.redo text
src/Main.hs view
@@ -1,6 +1,6 @@ -- This file is part of Qtah. ----- Copyright 2015-2017 Bryan Gardiner <bog@khumba.net>+-- Copyright 2015-2017 The Qtah Authors. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU Lesser General Public License as published by@@ -15,9 +15,147 @@ -- You should have received a copy of the GNU Lesser General Public License -- along with this program. If not, see <http://www.gnu.org/licenses/>. +{-# LANGUAGE ScopedTypeVariables #-}+ module Main where +import Control.Arrow ((&&&))+import Control.Monad (forM_)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import qualified Data.Map as M+import Foreign.Hoppy.Runtime (withScopedPtr)+import qualified Graphics.UI.Qtah.Core.QCoreApplication as QCoreApplication+import qualified Graphics.UI.Qtah.Core.QItemSelectionModel as QItemSelectionModel+import qualified Graphics.UI.Qtah.Core.QModelIndex as QModelIndex+import qualified Graphics.UI.Qtah.Core.QStringListModel as QStringListModel+import qualified Graphics.UI.Qtah.Core.QVariant as QVariant+import Graphics.UI.Qtah.Event (onEvent) import qualified Graphics.UI.Qtah.Example.Notepad as Notepad+import qualified Graphics.UI.Qtah.Gui.QCloseEvent as QCloseEvent+import qualified Graphics.UI.Qtah.Gui.QFont as QFont+import qualified Graphics.UI.Qtah.Widgets.QAbstractButton as QAbstractButton+import qualified Graphics.UI.Qtah.Widgets.QAbstractItemView as QAbstractItemView+import qualified Graphics.UI.Qtah.Widgets.QApplication as QApplication+import qualified Graphics.UI.Qtah.Widgets.QBoxLayout as QBoxLayout+import qualified Graphics.UI.Qtah.Widgets.QLabel as QLabel+import qualified Graphics.UI.Qtah.Widgets.QListView as QListView+import qualified Graphics.UI.Qtah.Widgets.QPushButton as QPushButton+import qualified Graphics.UI.Qtah.Widgets.QSplitter as QSplitter+import qualified Graphics.UI.Qtah.Widgets.QVBoxLayout as QVBoxLayout+import qualified Graphics.UI.Qtah.Widgets.QWidget as QWidget+import Graphics.UI.Qtah.Signal (connect_)+import System.Environment (getArgs) +data Example = Example+ { exTitle :: String+ , exDescription :: String+ , exMain :: IO ()+ }++examples :: [Example]+examples =+ [ Example+ { exTitle = "Notepad"+ , exDescription = "A notepad program for editing text files."+ , exMain = Notepad.run+ }++ ]++examplesByTitle :: M.Map String Example+examplesByTitle = M.fromList $ map (exTitle &&& id) examples++-- | State of the example chooser UI.+data UI = UI+ { uiWindow :: QWidget.QWidget+ , uiListModel :: QStringListModel.QStringListModel+ , uiCurrentExampleRef :: IORef (Maybe Example)+ , uiDescriptionLabel :: QLabel.QLabel+ }+ main :: IO ()-main = Notepad.run+main = withScopedPtr (getArgs >>= QApplication.new) $ \_ -> do+ ui <- newChooserWindow+ QWidget.show $ uiWindow ui+ QCoreApplication.exec++newChooserWindow :: IO UI+newChooserWindow = do+ -- Create and initialize widgets.++ window <- QWidget.new+ QWidget.setWindowTitle window "Qtah Examples"+ QWidget.resizeRaw window 500 350++ model <- QStringListModel.newWithContents $ M.keys examplesByTitle+ listView <- QListView.new+ QAbstractItemView.setModel listView model+ QAbstractItemView.setEditTriggers listView QAbstractItemView.noEditTriggers++ titleLabel <- QLabel.newWithText "Qtah Example Programs"+ titleFont <- QWidget.font titleLabel+ QFont.setPixelSize titleFont 25+ QWidget.setFont titleLabel titleFont++ descriptionLabel <- QLabel.new+ QLabel.setWordWrap descriptionLabel True++ runButton <- QPushButton.newWithText "&Launch"++ quitButton <- QPushButton.newWithText "&Quit"++ rightBox <- QWidget.new+ rightBoxLayout <- QVBoxLayout.new+ QWidget.setLayout rightBox rightBoxLayout+ QBoxLayout.addWidget rightBoxLayout descriptionLabel+ QBoxLayout.addStretch rightBoxLayout+ QBoxLayout.addWidget rightBoxLayout runButton+ QBoxLayout.addWidget rightBoxLayout quitButton++ splitter <- QSplitter.new+ QSplitter.addWidget splitter listView+ QSplitter.addWidget splitter rightBox+ QSplitter.setSizes splitter [200 :: Int, 300]++ layout <- QVBoxLayout.newWithParent window+ QBoxLayout.addWidget layout titleLabel+ QBoxLayout.addWidgetWithStretch layout splitter 1++ -- Set up signals.++ currentExampleRef <- newIORef Nothing++ let ui = UI { uiWindow = window+ , uiListModel = model+ , uiCurrentExampleRef = currentExampleRef+ , uiDescriptionLabel = descriptionLabel+ }++ _ <- onEvent window $ \(_ :: QCloseEvent.QCloseEvent) -> do+ QCoreApplication.quit+ return False++ selectionModel <- QAbstractItemView.selectionModel listView+ connect_ selectionModel QItemSelectionModel.currentChangedSignal $ \index _ ->+ exampleSelected ui index++ connect_ listView QAbstractItemView.activatedSignal $ \_ -> runSelectedExample ui++ connect_ runButton QAbstractButton.clickedSignal $ \_ -> runSelectedExample ui++ connect_ quitButton QAbstractButton.clickedSignal $ \_ -> QCoreApplication.quit++ return ui++exampleSelected :: UI -> QModelIndex.QModelIndex -> IO ()+exampleSelected ui index = do+ name <- QVariant.toString =<< QModelIndex.getData index+ -- If we can't find the example, then do nothing.+ forM_ (M.lookup name examplesByTitle) $ \example -> do+ writeIORef (uiCurrentExampleRef ui) $ Just example+ QLabel.setText (uiDescriptionLabel ui) $ exDescription example++runSelectedExample :: UI -> IO ()+runSelectedExample ui = do+ maybeExample <- readIORef $ uiCurrentExampleRef ui+ forM_ maybeExample $ \example -> exMain example