Diagrams.Backend.HsQML.Tutorial

DiagramCanvas QML script

To use this backend you first need a custom Canvas object to handle signals coming from Haskell. Example script to place in your QML search path (can be next to your main QML document):

 -- DiagramCanvas.qml
import QtQuick 2.4

Canvas {
  id: canvas;
  property variant diagram;
  renderStrategy: Canvas.Threaded;
  renderTarget: Canvas.FramebufferObject;

  onDiagramChanged: {
    var context = canvas.getContext('2d');
    if(canvas.diagram && context) {
    console.log("reconnect");
    canvas.diagram.save.connect(function() {canvas.context.save()})
    canvas.diagram.restore.connect(function () {canvas.context.restore()});
    canvas.diagram.text.connect(function (text,x,y) {canvas.context.strokeText(text,x,y)});
    canvas.diagram.beginPath.connect(function () {canvas.context.beginPath()});
    canvas.diagram.closePath.connect(function () {canvas.context.closePath()});
    canvas.diagram.stroke.connect(function () {canvas.context.stroke()});
    canvas.diagram.fill.connect(function() {canvas.context.fill()});
    canvas.diagram.moveTo.connect(function (x,y) {canvas.context.moveTo(x,y)});
    canvas.diagram.lineTo.connect(function (x,y) {canvas.context.lineTo(x,y)});
    canvas.diagram.bezierCurveTo.connect(function(cp1x,cp1y,cp2x,cp2y,x,y) 
                                           {canvas.context.bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y)});
    canvas.diagram.connectLinearGradient.connect(connectLG);
    canvas.diagram.connectRadialGradient.connect(connectRG);

    canvas.diagram.setStrokeColour.connect(function(r,g,b,a) 
                                            {canvas.context.strokeStyle = Qt.rgba(r,g,b,a).toString();});
    canvas.diagram.setFillColour.connect(function(r,g,b,a) 
                                            {canvas.context.fillStyle = Qt.rgba(r,g,b,a)});
    canvas.diagram.setFont.connect(function(f) {canvas.context.font = f});
    canvas.diagram.setLineWidth.connect(function(w) {canvas.context.lineWidth = w});
    canvas.diagram.oddEvenFill.connect(function() {canvas.context.fillRule = Qt.OddEvenFill});
    canvas.diagram.windingFill.connect(function() {canvas.context.fillRule = Qt.WindingFill});
    } else {
     console.log("warning! no diagram or context object to connect");
    }
  }

  onPaint: {
    if(canvas.diagram) {
      canvas.diagram.reload();
    }
  }

  function connectLG(gradient, x0, y0, x1, y1) {
    var grad = canvas.context.createLinearGradient(x0, y0, x1, y1);
    gradient.addStop.connect( function(r,g,b,a, off) {grad.addColorStop(off, Qt.rgba(r,g,b,a))});
    canvas.diagram.setLineGradient.connect(function() {canvas.context.strokeStyle = grad;});
    canvas.diagram.setFillGradient.connect(function() {canvas.context.fillStyle = grad;});

  }

  function connectRG(gradient, x0, y0, r0, x1, y1, r1) {
    var grad = canvas.context.createRadialGradient(x0, y0, r0, x1, y1, r1);
    gradient.addStop.connect(function(r,g,b,a, off) {grad.addColorStop(off, Qt.rgba(r,g,b,a))});
    canvas.diagram.setLineGradient.connect(function() {canvas.context.strokeStyle = grad;});
    canvas.diagram.setFillGradient.connect(function() {canvas.context.fillStyle = grad;});
  }
}

Context object

You can make an ObjRef to a DiagramObj available to the QML script by placing it in a property of your context object:

 -- Main.hs
 module Main where
 import Control.Applicative
 import Control.Concurrent
 import Control.Concurrent.MVar
 import Data.Typeable
 import Diagrams.Prelude
 import Diagrams.Backend.HsQML
 import Graphics.QML

data Repaint deriving Typeable

repaint :: Proxy Repaint
repaint = Proxy

instance SignalKeyClass Repaint where
  type SignalParams Repaint = IO ()

data MainObj = MainObj 
    { diagramObj :: MVar (ObjRef (DiagramObj ()))
    }
  deriving Typeable

instance DefaultClass MainObj where
  classMembers = 
    [ defPropertySigRO' "mainDiagram" diagramChanged $ \this -> 
       case fromObjRef this of
          MainObj mvar -> readMVar mvar
    , defPropertyConst' "self" return
    , defSignal "repaint" repaint
    ]

Main window

Then, place a DiagramCanvas somewhere in your application, and connect it to the controller object:

 -- main.qml
import QtQuick 2.0
import QtQuick.Controls 1.3
import QtQuick.Window 2.2

ApplicationWindow {
  title: "test";
  width: 800;
  height: 800;
  visible: true;

  toolBar: ToolBar {
    ToolButton {
      onClicked: canvas.repaint();
    }
  }

  DiagramCanvas {
    id: canvas;
    anchors.fill: parent;
  
    function repaint() {
       canvas.diagram = self.mainDiagram;
       canvas.paint(canvas.canvasWindow);
    }

    Connections {
      target: self;
      onRepaint: canvas.repaint();
    }
  }

}

Rendering diagrams

The renderHsQML function creates an ObjRef to the controller object.

 -- Main.hs
diagram :: Diagram B R2
diagram = circle 1

main :: IO ()
main = do
  diag <- renderHsQML (mkSizeSpec (Just 800) (Just 800)) diagram
  mainObj <- MainObj <$> newMVar diag
  ctx <- newObjectDC mainObj
  runEngineLoop defaultEngineConfig
     { initialDocument = fileDocument "qml/main.qml"
     , contextObject = Just $ anyObjRef ctx
     }