hsqml-demo-notes (empty) → 0.3.2.0
raw patch · 11 files changed
+488/−0 lines, 11 filesdep +basedep +hsqmldep +sqlite-simplesetup-changedbinary-added
Dependencies added: base, hsqml, sqlite-simple, text
Files
- LICENSE +30/−0
- README +15/−0
- Setup.hs +2/−0
- hsqml-demo-notes.cabal +34/−0
- qml/minus.png binary
- qml/notes-dual.qml +13/−0
- qml/notes-flip.qml +116/−0
- qml/notes-pro.qml +110/−0
- qml/notes.qml +65/−0
- qml/plus.png binary
- src/NotesSlow.hs +103/−0
+ LICENSE view
@@ -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.
+ README view
@@ -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/
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hsqml-demo-notes.cabal view
@@ -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
+ qml/minus.png view
binary file changed (absent → 176 bytes)
+ qml/notes-dual.qml view
@@ -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);+ }+}
+ qml/notes-flip.qml view
@@ -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;+ }+ }+ }+ }+ }+}
+ qml/notes-pro.qml view
@@ -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;+ }+ }+ }+}
+ qml/notes.qml view
@@ -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;+ }+ }+ }+}
+ qml/plus.png view
binary file changed (absent → 315 bytes)
+ src/NotesSlow.hs view
@@ -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}