summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Setup.hs24
-rw-r--r--qtah-examples.cabal11
-rw-r--r--src/Graphics/UI/Qtah/Example/Notepad.hs16
-rw-r--r--src/Main.hs142
4 files changed, 158 insertions, 35 deletions
diff --git a/Setup.hs b/Setup.hs
index 5d851a9..3a3b9b7 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -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
diff --git a/qtah-examples.cabal b/qtah-examples.cabal
index 7339cb4..3ad7337 100644
--- a/qtah-examples.cabal
+++ b/qtah-examples.cabal
@@ -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 @@ executable qtah-examples
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
diff --git a/src/Graphics/UI/Qtah/Example/Notepad.hs b/src/Graphics/UI/Qtah/Example/Notepad.hs
index 7676e27..daf93a0 100644
--- a/src/Graphics/UI/Qtah/Example/Notepad.hs
+++ b/src/Graphics/UI/Qtah/Example/Notepad.hs
@@ -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 Control.Monad (forM_, unless, when)
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 Graphics.UI.Qtah.Signal (connect_)
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 @@ import Graphics.UI.Qtah.Widgets.QTextEdit (
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 @@ data Notepad = Notepad
}
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 @@ makeMainWindow = do
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 @@ makeMainWindow = do
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
diff --git a/src/Main.hs b/src/Main.hs
index d7db97a..08ebff2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -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