diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2014, Robin KAY + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Robin KAY nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,15 @@ +hsqml-demo-notes +================ + +This sticky notes program using HsQML was introduced in my November 2014 talk +to the London Haskell User Group. The 'hsqml-notes' executable can be passed +an argument to specify which QML front-end to use: + +notes - Stardard UI (default) +notes-pro - Alternative UI using Qt Quick Controls +notes-flip - Standard UI with flipable double-sided notes +notes-dual - Standard and alternate UI displayed simultaneously + +Home Page: http://www.gekkou.co.uk/software/hsqml/ +Darcs Repository: http://hub.darcs.net/komadori/hsqml-demo-notes/ +Issue Tracker: http://trac.gekkou.co.uk/hsqml/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hsqml-demo-notes.cabal b/hsqml-demo-notes.cabal new file mode 100644 --- /dev/null +++ b/hsqml-demo-notes.cabal @@ -0,0 +1,34 @@ +Name: hsqml-demo-notes +Version: 0.3.2.0 +Cabal-version: >= 1.10 +Build-type: Simple +License: BSD3 +License-file: LICENSE +Copyright: (c) 2014 Robin KAY +Author: Robin KAY +Maintainer: komadori@gekkou.co.uk +Stability: experimental +Homepage: http://www.gekkou.co.uk/software/hsqml/ +Category: Graphics +Synopsis: Sticky notes example program implemented in HsQML +Data-dir: qml +Data-files: *.qml *.png +Extra-source-files: + README +Description: + Sticky notes example program implemented in HsQML + +Executable hsqml-notes + Default-language: Haskell2010 + Hs-source-dirs: src + Main-is: NotesSlow.hs + Build-depends: + base == 4.*, + text >= 0.11 && < 1.3, + sqlite-simple >= 0.4.8 && < 0.5, + hsqml >= 0.3.2.1 && < 0.4 + GHC-options: -threaded + +Source-repository head + type: darcs + location: http://hub.darcs.net/komadori/hsqml-demo-notes diff --git a/qml/minus.png b/qml/minus.png new file mode 100644 Binary files /dev/null and b/qml/minus.png differ diff --git a/qml/notes-dual.qml b/qml/notes-dual.qml new file mode 100644 --- /dev/null +++ b/qml/notes-dual.qml @@ -0,0 +1,13 @@ +import QtQuick 2.0 +import QtQuick.Window 2.0 + +Window { + Loader { + source: 'notes.qml'; + onLoaded: item.closing.connect(Qt.quit); + } + Loader { + source: 'notes-pro.qml'; + onLoaded: item.closing.connect(Qt.quit); + } +} diff --git a/qml/notes-flip.qml b/qml/notes-flip.qml new file mode 100644 --- /dev/null +++ b/qml/notes-flip.qml @@ -0,0 +1,116 @@ +import QtQuick 2.0 +import QtQuick.Window 2.0 + +Window { + width: 800; height: 600; + title: 'HsQML Notes'; + visible: true; + + MouseArea { + anchors.fill: parent; + onDoubleClicked: insertNote(mouse.x, mouse.y, 'New Note'); + } + + Component { + id: noteFace; + + Rectangle { + id: noteView; color: faceColour; + width: 100; height: header.height + frontView.contentHeight; + + MouseArea { + id: header; height: 20; + anchors.top: parent.top; + anchors.left: parent.left; anchors.right: parent.right; + hoverEnabled: true; + drag.target: parentView; + + Rectangle { + anchors.fill: parent; + color: Qt.darker(noteView.color, + parent.containsMouse ? 1.2 : 1.1); + } + + Text { + anchors.left: parent.left; + anchors.leftMargin: 5; + anchors.verticalCenter: parent.verticalCenter; + font.pixelSize: parent.height; + text: faceName == 'front' ? '\u293E' : '\u293F'; + color: flipArea.containsMouse ? 'blue' : 'black'; + + MouseArea { + id: flipArea; + anchors.fill: parent; + hoverEnabled: true; + onClicked: note.reverse = !note.reverse; + } + } + + Text { + anchors.right: parent.right; + anchors.rightMargin: 5; + anchors.verticalCenter: parent.verticalCenter; + font.pixelSize: parent.height; + text: '\u2716'; + color: closeArea.containsMouse ? 'red' : 'black'; + + MouseArea { + id: closeArea; + anchors.fill: parent; + hoverEnabled: true; + onClicked: deleteNote(note); + } + } + } + + TextEdit { + id: frontView; + anchors.top: header.bottom; + anchors.left: parent.left; anchors.right: parent.right; + textMargin: 2; + wrapMode: TextEdit.Wrap; + + text: note[faceName]; + onTextChanged: note[faceName] = frontView.text; + } + } + } + + Repeater { + model: notes; + + Flipable { + id: flipper; + x: modelData.x; y: modelData.y; + onXChanged: modelData.x = x; onYChanged: modelData.y = y; + + front: Loader { + sourceComponent: noteFace; + enabled: !modelData.reverse; + property var note: modelData; + property var parentView: flipper; + property string faceName: 'front'; + property string faceColour: 'yellow'; + } + back: Loader { + sourceComponent: noteFace; + enabled: modelData.reverse; + property var note: modelData; + property var parentView: flipper; + property string faceName: 'back'; + property string faceColour: 'pink'; + } + transform: Rotation { + origin.x: 50; origin.y: 0; + axis.x: 0; axis.y: -1; axis.z: 0; + angle: modelData.reverse ? 180 : 0; + Behavior on angle { + NumberAnimation { + duration: 250; + } + } + } + } + } +} diff --git a/qml/notes-pro.qml b/qml/notes-pro.qml new file mode 100644 --- /dev/null +++ b/qml/notes-pro.qml @@ -0,0 +1,110 @@ +import QtQuick 2.0 +import QtQuick.Controls 1.1 +import QtQuick.Layouts 1.1 + +ApplicationWindow { + id: view; + width: 800; height: 600; + title: 'HsQML Notes Professional'; + visible: true; + + property var hasNote: + notesView.model[notesView.currentIndex] !== undefined; + property var note: hasNote ? + notesView.model[notesView.currentIndex] : {x:0,y:0,front:''}; + + menuBar: MenuBar { + Menu { + title: 'File'; + MenuItem { + text: 'Quit'; + onTriggered: Qt.quit(); + } + } + } + + toolBar: ToolBar { + RowLayout { + ToolButton { + iconSource: 'plus.png'; + onClicked: insertNote(0, 0, 'New Note'); + } + ToolButton { + iconSource: 'minus.png'; + onClicked: deleteNote(view.note); + enabled: view.hasNote; + } + Item { + Layout.fillWidth: true; + } + } + } + + SplitView { + anchors.fill: parent; + + ScrollView { + ListView { + id: notesView; + model: notes; + focus: true; + highlightMoveDuration: 0; + highlightResizeDuration: 0; + delegate: Text { + width: parent.width; + maximumLineCount: 1; + elide: Text.ElideRight; + text: modelData.front; + MouseArea { + anchors.fill: parent; + onClicked: notesView.currentIndex = index; + } + } + highlight: Rectangle { + color: 'lightsteelblue'; + } + } + } + + GridLayout { + columns: 2; + + Label { + text: 'X Position'; + Layout.alignment: Qt.AlignRight | Qt.AlignTop; + } + TextField { + Layout.fillWidth: true; + validator: IntValidator {} + text: view.note.x; + onEditingFinished: view.note.x = parseInt(text); + enabled: view.hasNote; + } + + Label { + text: 'Y Position'; + Layout.alignment: Qt.AlignRight | Qt.AlignTop; + } + TextField { + Layout.fillWidth: true; + validator: IntValidator {} + text: view.note.y; + onEditingFinished: view.note.y = parseInt(text); + enabled: view.hasNote; + } + + Label { + text: 'Front Text'; + Layout.alignment: Qt.AlignRight | Qt.AlignTop; + } + TextArea { + id: frontView; + Layout.fillWidth: true; + Layout.fillHeight: true; + text: view.note.front; + onTextChanged: view.note.front = text; + enabled: view.hasNote; + } + } + } +} diff --git a/qml/notes.qml b/qml/notes.qml new file mode 100644 --- /dev/null +++ b/qml/notes.qml @@ -0,0 +1,65 @@ +import QtQuick 2.0 +import QtQuick.Window 2.0 + +Window { + width: 800; height: 600; + title: 'HsQML Notes'; + visible: true; + + MouseArea { + anchors.fill: parent; + onDoubleClicked: insertNote(mouse.x, mouse.y, 'New Note'); + } + + Repeater { + model: notes; + + Rectangle { + id: noteView; color: 'yellow'; + width: 100; height: header.height + frontView.contentHeight; + x: modelData.x; y: modelData.y; + onXChanged: modelData.x = x; onYChanged: modelData.y = y; + + MouseArea { + id: header; height: 20; + anchors.top: parent.top; + anchors.left: parent.left; anchors.right: parent.right; + hoverEnabled: true; + drag.target: noteView; + + Rectangle { + anchors.fill: parent; + color: Qt.darker(noteView.color, + parent.containsMouse ? 1.2 : 1.1); + } + + Text { + anchors.right: parent.right; + anchors.rightMargin: 5; + anchors.verticalCenter: parent.verticalCenter; + font.pixelSize: parent.height; + text: '\u2716'; + color: closeArea.containsMouse ? 'red' : 'black'; + + MouseArea { + id: closeArea; + anchors.fill: parent; + hoverEnabled: true; + onClicked: deleteNote(modelData); + } + } + } + + TextEdit { + id: frontView; + anchors.top: header.bottom; + anchors.left: parent.left; anchors.right: parent.right; + textMargin: 2; + wrapMode: TextEdit.Wrap; + + text: modelData.front; + onTextChanged: modelData.front = frontView.text; + } + } + } +} diff --git a/qml/plus.png b/qml/plus.png new file mode 100644 Binary files /dev/null and b/qml/plus.png differ diff --git a/src/NotesSlow.hs b/src/NotesSlow.hs new file mode 100644 --- /dev/null +++ b/src/NotesSlow.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Main where + +import System.Environment (getArgs) + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Typeable (Typeable) + +import qualified Database.SQLite.Simple as S +import qualified Database.SQLite.Simple.FromField as S +import qualified Database.SQLite.Simple.ToField as S + +import Graphics.QML + +import Paths_hsqml_demo_notes + +newtype Note = Note {noteId :: Int} deriving (Eq, Ord, Typeable) + +createTable :: S.Connection -> IO () +createTable conn = + S.execute_ conn . S.Query . T.pack $ + "CREATE TABLE IF NOT EXISTS notes (" ++ + "id INTEGER PRIMARY KEY AUTOINCREMENT, " ++ + "x INTEGER, y INTEGER, reverse BOOLEAN, front TEXT, back TEXT)" + +selectNotes :: S.Connection -> a -> (a -> Note -> IO a) -> IO a +selectNotes conn zero func = + let query = S.Query $ T.pack "SELECT id FROM notes ORDER BY id DESC" + in S.fold_ conn query zero (\acc (S.Only i) -> func acc $ Note i) + +insertNote :: S.Connection -> Int -> Int -> Text -> IO () +insertNote conn x y front = + S.execute conn (S.Query $ T.pack + "INSERT INTO notes (x,y,reverse,front,back) VALUES (?, ?, 0, ?, '')") + (x, y, front) + +deleteNote :: S.Connection -> Note -> IO () +deleteNote conn = + let query = S.Query $ T.pack "DELETE FROM notes WHERE id = ?" + in S.execute conn query . S.Only . noteId + +readNoteAttrib :: (S.FromField a) => + S.Connection -> String -> ObjRef Note -> IO a +readNoteAttrib conn attrib note = do + let query = S.Query . T.pack $ + "SELECT " ++ attrib ++ " FROM notes WHERE id = ?" + [S.Only value] <- S.query conn query (S.Only . noteId $ fromObjRef note) + return value + +writeNoteAttrib :: (S.ToField a) => + S.Connection -> String -> SignalKey (IO ()) -> ObjRef Note -> a -> IO () +writeNoteAttrib conn attrib changeKey note value = do + let query = S.Query . T.pack $ + "UPDATE notes SET " ++ attrib ++ " = ? WHERE id = ?" + S.execute conn query (value, noteId $ fromObjRef note) + fireSignal changeKey note + +createContext :: S.Connection -> IO (ObjRef ()) +createContext conn = do + changeKey <- newSignalKey + noteClass <- newClass [ + defPropertySigRW "x" changeKey + (readNoteAttrib conn "x" :: ObjRef Note -> IO Int) + (writeNoteAttrib conn "x" changeKey), + defPropertySigRW "y" changeKey + (readNoteAttrib conn "y" :: ObjRef Note -> IO Int) + (writeNoteAttrib conn "y" changeKey), + defPropertySigRW "reverse" changeKey + (readNoteAttrib conn "reverse" :: ObjRef Note -> IO Bool) + (writeNoteAttrib conn "reverse" changeKey), + defPropertySigRW "front" changeKey + (readNoteAttrib conn "front" :: ObjRef Note -> IO Text) + (writeNoteAttrib conn "front" changeKey), + defPropertySigRW "back" changeKey + (readNoteAttrib conn "back" :: ObjRef Note -> IO Text) + (writeNoteAttrib conn "back" changeKey)] + notePool <- newFactoryPool (newObject noteClass) + rootClass <- newClass [ + defPropertySigRO' "notes" changeKey (\_ -> + selectNotes conn [] (\objs note -> do + object <- getPoolObject notePool note + return $ object:objs)), + defMethod' "insertNote" (\this x y front -> do + insertNote conn x y front + fireSignal changeKey this), + defMethod' "deleteNote" (\this note -> do + deleteNote conn $ fromObjRef note + fireSignal changeKey this)] + newObject rootClass () + +main :: IO () +main = S.withConnection "notes.db" $ \conn -> do + createTable conn + ctx <- createContext conn + args <- getArgs + path <- case args of + ("local":p:_) -> return $ p ++ ".qml" + (p:_) -> getDataFileName $ p ++ ".qml" + _ -> getDataFileName "notes.qml" + runEngineLoop defaultEngineConfig { + initialDocument = fileDocument path, + contextObject = Just $ anyObjRef ctx}