1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
-- This file is part of Qtah.
--
-- Copyright 2015-2016 Bryan Gardiner <bog@khumba.net>
--
-- 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
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Lesser General Public License for more details.
--
-- 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 #-}
-- | A notepad based on the Qt notepad example.
module Graphics.UI.Qtah.Example.Notepad (run) where
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)
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)
import qualified Graphics.UI.Qtah.Widgets.QMenu as QMenu
import qualified Graphics.UI.Qtah.Widgets.QMenuBar as QMenuBar
import qualified Graphics.UI.Qtah.Widgets.QMessageBox as QMessageBox
import qualified Graphics.UI.Qtah.Widgets.QTextEdit as QTextEdit
import Graphics.UI.Qtah.Widgets.QTextEdit (
QTextEdit,
copyAvailableSignal,
redoAvailableSignal,
textChangedSignal,
undoAvailableSignal,
)
import qualified Graphics.UI.Qtah.Widgets.QWidget as QWidget
import System.Environment (getArgs)
import System.FilePath (takeFileName)
data Notepad = Notepad
{ myWindow :: QMainWindow
, myText :: QTextEdit
, myFilePathRef :: IORef (Maybe FilePath)
, myDirtyRef :: IORef Bool
}
run :: IO ()
run = withScopedPtr (getArgs >>= QApplication.new) $ \_ -> do
mainWindow <- makeMainWindow
QWidget.show mainWindow
QCoreApplication.exec
makeMainWindow :: IO QMainWindow
makeMainWindow = do
window <- QMainWindow.new
menu <- QMenuBar.new
QMainWindow.setMenuBar window menu
menuFile <- QMenuBar.addNewMenu menu "&File"
menuFileNew <- QMenu.addNewAction menuFile "&New"
menuFileOpen <- QMenu.addNewAction menuFile "&Open..."
menuFileSave <- QMenu.addNewAction menuFile "&Save"
menuFileSaveAs <- QMenu.addNewAction menuFile "Sa&ve as..."
_ <- QMenu.addSeparator menuFile
menuFileQuit <- QMenu.addNewAction menuFile "&Quit"
menuEdit <- QMenuBar.addNewMenu menu "&Edit"
menuEditUndo <- QMenu.addNewAction menuEdit "&Undo"
menuEditRedo <- QMenu.addNewAction menuEdit "&Redo"
_ <- QMenu.addSeparator menuEdit
menuEditCut <- QMenu.addNewAction menuEdit "Cu&t"
menuEditCopy <- QMenu.addNewAction menuEdit "&Copy"
menuEditPaste <- QMenu.addNewAction menuEdit "&Paste"
_ <- QMenu.addSeparator menuEdit
menuEditSelectAll <- QMenu.addNewAction menuEdit "Select all"
forM_ [menuEditUndo, menuEditRedo, menuEditCut, menuEditCopy] $ \action ->
QAction.setEnabled action False
text <- QTextEdit.new
QMainWindow.setCentralWidget window text
QTextEdit.setUndoRedoEnabled text True
filePathRef <- newIORef Nothing
dirtyRef <- newIORef False
let me = Notepad
{ myWindow = window
, myText = text
, myFilePathRef = filePathRef
, myDirtyRef = dirtyRef
}
_ <- onEvent window $ \(event :: QCloseEvent) -> do
continue <- confirmSaveIfDirty me "Quit"
unless continue $ QEvent.ignore event
return $ not continue
connect_ menuFileNew triggeredSignal $ \_ -> fileNew me
connect_ menuFileOpen triggeredSignal $ \_ -> fileOpen me
connect_ menuFileSave triggeredSignal $ \_ -> void $ fileSave me
connect_ menuFileSaveAs triggeredSignal $ \_ -> void $ fileSaveAs me
connect_ menuFileQuit triggeredSignal $ \_ -> QWidget.close window
connect_ menuEditUndo triggeredSignal $ \_ -> QTextEdit.undo text
connect_ menuEditRedo triggeredSignal $ \_ -> QTextEdit.redo text
connect_ menuEditCut triggeredSignal $ \_ -> QTextEdit.cut text
connect_ menuEditCopy triggeredSignal $ \_ -> QTextEdit.copy text
connect_ menuEditPaste triggeredSignal $ \_ -> QTextEdit.paste text
connect_ menuEditSelectAll triggeredSignal $ \_ -> QTextEdit.selectAll text
connect_ text textChangedSignal $ setDirty me True
connect_ text undoAvailableSignal $ \b -> QAction.setEnabled menuEditUndo b
connect_ text redoAvailableSignal $ \b -> QAction.setEnabled menuEditRedo b
connect_ text copyAvailableSignal $ \b -> do
QAction.setEnabled menuEditCut b
QAction.setEnabled menuEditCopy b
updateTitle me
return window
fileNew :: Notepad -> IO ()
fileNew me = do
continue <- confirmSaveIfDirty me "New file"
when continue $ do
QTextEdit.clear $ myText me
setFilePath me Nothing
setDirty me False
fileOpen :: Notepad -> IO ()
fileOpen me = do
continue <- confirmSaveIfDirty me "Open file"
when continue $ do
path <- QFileDialog.getOpenFileName (myWindow me) "Open file" "" fileDialogFilter
unless (null path) $ do
contents <- readFile path
QTextEdit.setText (myText me) contents
setFilePath me $ Just path
setDirty me False
-- | Returns true if the save was performed.
fileSave :: Notepad -> IO Bool
fileSave me = do
pathMaybe <- readIORef $ myFilePathRef me
case pathMaybe of
Nothing -> fileSaveAs me
Just path -> do
contents <- QTextEdit.toPlainText $ myText me
writeFile path contents
setDirty me False
return True
-- | Returns true if the save was performed.
fileSaveAs :: Notepad -> IO Bool
fileSaveAs me = do
path <- QFileDialog.getSaveFileName
(myWindow me)
"Save file"
""
fileDialogFilter
if null path
then return False
else do setFilePath me $ Just path
fileSave me
-- | Returns true if the surrounding action should continue: that is, if the
-- editor was not dirty, or if the editor was dirty and the save was performed.
confirmSaveIfDirty :: Notepad -> String -> IO Bool
confirmSaveIfDirty me title = do
let dirtyRef = myDirtyRef me
dirty <- readIORef dirtyRef
if dirty
then do response <- QMessageBox.questionWithButtons
(myWindow me)
title
"There are unsaved changes. Would you like to save them?"
(QMessageBox.qMessageBoxStandardButtons_Yes .|.
QMessageBox.qMessageBoxStandardButtons_No .|.
QMessageBox.qMessageBoxStandardButtons_Cancel)
QMessageBox.QMessageBoxStandardButton_Cancel
case response of
QMessageBox.QMessageBoxStandardButton_Yes -> fileSave me
QMessageBox.QMessageBoxStandardButton_No -> return True
_ -> return False
else return True
setDirty :: Notepad -> Bool -> IO ()
setDirty me dirty = do
let ref = myDirtyRef me
dirtyOld <- readIORef ref
when (dirty /= dirtyOld) $ do
writeIORef ref dirty
updateTitle me
setFilePath :: Notepad -> Maybe FilePath -> IO ()
setFilePath me path = do
writeIORef (myFilePathRef me) path
updateTitle me
updateTitle :: Notepad -> IO ()
updateTitle me = do
dirty <- readIORef $ myDirtyRef me
file <- fmap (maybe "(Untitled)" takeFileName) $ readIORef $ myFilePathRef me
QWidget.setWindowTitle (myWindow me) $
(if dirty then ('*':) else id) $
file ++ " - Notepad"
fileDialogFilter :: String
fileDialogFilter =
"Text Files (*.txt);;Haskell sources (*.hs *.hs-boot *.lhs *.chs);;All Files (*)"
|
