hsqml-demo-samples 0.3.0.0 → 0.3.2.0
raw patch · 6 files changed
+307/−5 lines, 6 filesdep +OpenGLdep +OpenGLRawdep ~hsqmldep ~textnew-component:exe:hsqml-opengl1
Dependencies added: OpenGL, OpenGLRaw
Dependency ranges changed: hsqml, text
Files
- CHANGELOG +11/−0
- hsqml-demo-samples.cabal +24/−3
- qml/factorial1.qml +1/−1
- qml/factorial2.qml +1/−1
- qml/opengl1.qml +132/−0
- src/OpenGL1.hs +138/−0
+ CHANGELOG view
@@ -0,0 +1,11 @@+HsQML Samples - Release History++release-0.3.2.0 - 2014.11.13++ * Added OpenGL sample.+ * Relaxed Cabal dependency constraint on 'text'.+ * Fixed factorial samples to use single-line edit controls. ++release-0.3.0.0 - 2014.05.04++ * Initial release.
hsqml-demo-samples.cabal view
@@ -1,5 +1,5 @@ Name: hsqml-demo-samples-Version: 0.3.0.0+Version: 0.3.2.0 Cabal-version: >= 1.10 Build-type: Simple License: BSD3@@ -13,16 +13,23 @@ Synopsis: HsQML sample programs Data-dir: qml Data-files: *.qml+Extra-source-files:+ CHANGELOG Description: HsQML sample programs +Flag OpenGL+ Description:+ Build sample programs which use OpenGL.+ Default: True+ Executable hsqml-factorial1 Default-language: Haskell2010 Hs-source-dirs: src Main-is: Factorial1.hs Build-depends: base == 4.*,- text >= 0.11 && < 1.2,+ text >= 0.11 && < 1.3, hsqml == 0.3.* GHC-options: -threaded @@ -32,9 +39,23 @@ Main-is: Factorial2.hs Build-depends: base == 4.*,- text >= 0.11 && < 1.2,+ text >= 0.11 && < 1.3, hsqml == 0.3.* GHC-options: -threaded++Executable hsqml-opengl1+ Default-language: Haskell2010+ Hs-source-dirs: src+ Main-is: OpenGL1.hs+ Build-depends:+ base == 4.*,+ text >= 0.11 && < 1.3,+ OpenGL == 2.9.*,+ OpenGLRaw == 1.5.*,+ hsqml >= 0.3.2 && < 0.4+ GHC-options: -threaded+ if !flag(OpenGL)+ Buildable: False Source-repository head type: darcs
qml/factorial1.qml view
@@ -2,7 +2,7 @@ Column { height: 300;- TextEdit {+ TextInput { id: input; width: 300; height: 30; font.pixelSize: 30; focus: true; } Rectangle {
qml/factorial2.qml view
@@ -2,7 +2,7 @@ Column { height: 300;- TextEdit {+ TextInput { id: input; width: 300; height: 30; font.pixelSize: 30; focus: true; } Rectangle {
+ qml/opengl1.qml view
@@ -0,0 +1,132 @@+import QtQuick 2.0+import QtQuick.Controls 1.0+import HsQML.Canvas 1.0++Column {+ width: 500;++ Item {+ width: 500; height: 500;++ Rectangle {+ anchors.top: parent.top; anchors.left: parent.left;+ anchors.topMargin: 50; anchors.leftMargin: 50;+ width: 100; height: 100; color: "black";+ Text {+ anchors.centerIn: parent; font.pixelSize: 30;+ text: "Below"; color: "white";+ }+ }++ HaskellCanvas {+ id: canvas;+ x: 125; y: 125;+ width: 250; height: 250;+ delegate: myDelegate;+ model: t;++ property real t; // Can't animate model directly+ SequentialAnimation on t {+ paused: modelAnimationOff.checked;+ loops: Animation.Infinite;+ NumberAnimation {+ from: 0; to: 1; duration: 2500;+ }+ NumberAnimation {+ from: 1; to: 0; duration: 2500;+ }+ }++ PathAnimation {+ target: canvas;+ running: true;+ paused: sgAnimationOff.checked;+ loops: Animation.Infinite;+ duration: 5000;+ orientation: PathAnimation.Fixed;+ anchorPoint: Qt.point(canvas.width/2, canvas.height/2);+ path: Path {+ startX: 250; startY: 250;+ PathLine { x: 200; y: 200; }+ PathLine { x: 200; y: 300; }+ PathLine { x: 300; y: 300; }+ PathLine { x: 300; y: 200; }+ PathLine { x: 250; y: 250; }+ }+ }+ }++ Rectangle {+ anchors.top: parent.top; anchors.right: parent.right;+ anchors.topMargin: 50; anchors.rightMargin: 50;+ width: 100; height: 100; color: "black";+ Text {+ anchors.centerIn: parent; font.pixelSize: 30;+ text: "Above"; color: "white";+ }+ }+ }++ GroupBox {+ title: "Display Mode";++ Row {+ ExclusiveGroup {id: displayModeGrp;}+ RadioButton {+ text: "Above";+ exclusiveGroup: displayModeGrp;+ onCheckedChanged: {+ if (checked) canvas.displayMode = HaskellCanvas.Above;}+ }+ RadioButton {+ text: "Inline";+ exclusiveGroup: displayModeGrp;+ checked: true;+ onCheckedChanged: {+ if (checked) canvas.displayMode = HaskellCanvas.Inline;}+ }+ RadioButton {+ text: "Below";+ exclusiveGroup: displayModeGrp;+ onCheckedChanged: {+ if (checked) canvas.displayMode = HaskellCanvas.Below;}+ }+ }+ }++ GroupBox {+ title: "Model Animation (Colour)";++ Row {+ ExclusiveGroup {id: modelAnimationGrp;}+ RadioButton {+ text: "On";+ exclusiveGroup: modelAnimationGrp;+ checked: true;+ }+ RadioButton {+ id: modelAnimationOff;+ text: "Off";+ exclusiveGroup: modelAnimationGrp;+ }+ }+ }++ GroupBox {+ title: "Scenegraph Animation (Position)";++ Row {+ ExclusiveGroup {id: sgAnimationGrp;}+ RadioButton {+ text: "On";+ exclusiveGroup: sgAnimationGrp;+ checked: true;+ }+ RadioButton {+ id: sgAnimationOff;+ text: "Off";+ exclusiveGroup: sgAnimationGrp;+ }+ }+ }+}
+ src/OpenGL1.hs view
@@ -0,0 +1,138 @@+module Main where++import Graphics.QML+import Graphics.QML.Canvas+import Graphics.Rendering.OpenGL.GL+import Graphics.Rendering.OpenGL.GLU.Errors+import Graphics.Rendering.OpenGL.Raw.ARB.ShaderObjects (glUniformMatrix4fv)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Foreign.C.Types+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable++import Paths_hsqml_demo_samples++shaderHead :: OpenGLType -> [String]+shaderHead OpenGLDesktop = ["#version 120", "#define highp"]+shaderHead OpenGLES = ["#version 100"]++vertShaderText :: OpenGLType -> Text+vertShaderText t = T.pack $ unlines $ shaderHead t ++ [+ "attribute highp vec4 position;",+ "attribute highp vec4 color;",+ "uniform highp mat4 matrix;",+ "uniform highp float model;",+ "varying highp vec4 vColor;",+ "void main() {",+ " gl_Position = matrix * position;",+ " vColor = mix(color, vec4(1,1,1,2) - color, model);",+ "}"]++fragShaderText :: OpenGLType -> Text+fragShaderText t = T.pack $ unlines $ shaderHead t ++ [+ "varying highp vec4 vColor;",+ "void main() {",+ " gl_FragColor = vColor;",+ "}"]++dataArray :: [CFloat]+dataArray = [+ 0.0, 1.0, 0.0, 1.0,+ -1.0, -1.0, 0.0, 1.0,+ 1.0, -1.0, 0.0, 1.0,+ 1.0, 0.0, 0.0, 1.0,+ 0.0, 1.0, 0.0, 1.0,+ 0.0, 0.0, 1.0, 1.0]++data GLData = GLData+ Program Shader Shader UniformLocation UniformLocation+ AttribLocation AttribLocation BufferObject++checkErrors :: String -> IO ()+checkErrors title = do+ errs <- get errors+ if null errs then return () else putStrLn $ title ++ ": " ++ show errs++setupGL :: OpenGLSetup -> IO GLData+setupGL setup = do+ putStrLn $ (showString "Context is " .+ shows (openGLType setup) . showString " " .+ shows (openGLMajor setup) . showString "." .+ shows (openGLMinor setup)) ""+ let ctype = openGLType setup+ vertShader <- createShader VertexShader+ shaderSourceBS vertShader $= (T.encodeUtf8 $ vertShaderText ctype)+ compileShader vertShader+ -- vsl <- get $ shaderInfoLog vertShader+ -- putStrLn $ show vsl+ fragShader <- createShader FragmentShader+ shaderSourceBS fragShader $= (T.encodeUtf8 $ fragShaderText ctype)+ compileShader fragShader+ -- fsl <- get $ shaderInfoLog fragShader+ -- putStrLn $ show fsl+ program <- createProgram+ attachShader program vertShader+ attachShader program fragShader+ linkProgram program+ -- pl <- get $ programInfoLog program+ -- putStrLn $ show pl+ matLoc <- get $ uniformLocation program "matrix"+ modelLoc <- get $ uniformLocation program "model"+ posLoc <- get $ attribLocation program "position"+ colLoc <- get $ attribLocation program "color"+ buf <- genObjectName+ bindBuffer ArrayBuffer $= Just buf+ withArrayLen dataArray $ \len ptr ->+ bufferData ArrayBuffer $=+ (fromIntegral $ len * sizeOf (head dataArray),+ ptr, StaticDraw)+ bindBuffer ArrayBuffer $= Nothing+ checkErrors "Setup"+ return $ GLData+ program vertShader fragShader matLoc modelLoc posLoc colLoc buf++paintGL :: OpenGLPaint GLData Double -> IO ()+paintGL paint = do+ let (GLData program _ _ matLoc modelLoc posLoc colLoc buf) = setupData paint+ let num = realToFrac $ modelData paint :: GLfloat+ currentProgram $= Just program+ let (UniformLocation matLocId) = matLoc+ glUniformMatrix4fv matLocId 1 0 (+ castPtr $ matrixPtr paint :: Ptr GLfloat)+ uniform modelLoc $= Index1 num+ bindBuffer ArrayBuffer $= Just buf+ vertexAttribArray posLoc $= Enabled+ vertexAttribPointer posLoc $=+ (ToFloat, VertexArrayDescriptor 4 Float 0 nullPtr)+ vertexAttribArray colLoc $= Enabled+ vertexAttribPointer colLoc $=+ (ToFloat, VertexArrayDescriptor 4 Float 0 $ plusPtr nullPtr $+ length dataArray * sizeOf (head dataArray) `quot` 2)+ drawArrays Triangles 0 3+ vertexAttribArray posLoc $= Disabled+ vertexAttribArray colLoc $= Disabled+ bindBuffer ArrayBuffer $= Nothing+ currentProgram $= Nothing+ checkErrors "Paint"++cleanupGL :: GLData -> IO ()+cleanupGL (GLData program vertShader fragShader _ _ _ _ buf) = do+ deleteObjectName buf+ deleteObjectName program+ deleteObjectName vertShader+ deleteObjectName fragShader+ checkErrors "Cleanup"++main :: IO ()+main = do+ clazz <- newClass [+ defPropertyConst' "myDelegate" (\_ ->+ newOpenGLDelegate setupGL paintGL cleanupGL)]+ ctx <- newObject clazz ()+ doc <- getDataFileName "opengl1.qml"+ runEngineLoop defaultEngineConfig {+ initialDocument = fileDocument doc,+ contextObject = Just $ anyObjRef ctx}