Skip to content

G
gargantext-ihaskell
Commit 2ce44db1 authored by Sumit Sahrawat's avatar Sumit Sahrawat
Browse files
Options

Prepare initial interface for plotting example

parent a8df80ad
Hide whitespace changes
Inline Side-by-side
Showing with 440 additions and 0 deletions
ihaskell-display/ihaskell-widgets/Examples/Plotting UI.ipynb 0 → 100644
View file @ 2ce44db1
{
"cells": [
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## A complete plotting example"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"This example is inspired from the [plot-gtk-ui](https://github.com/sumitsahrawat/plot-gtk-ui) package. Our goal will be to create an interface similar to the screenshot below.\n",
"\n",
"![Screenshot](https://raw.githubusercontent.com/sumitsahrawat/plot-gtk-ui/master/screenshots/sinax.png)"
]
},
{
"cell_type": "code",
"execution_count": 1,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"{-# LANGUAGE OverloadedStrings #-}\n",
"import IHaskell.Display.Widgets"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"First, we create a common structure that will hold all the information required to create a plot. This has to be done first so that we can hook widget events to modify it. The plotting logic is implemented next for the same reason."
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"import Data.IORef\n",
"import Data.Monoid (mempty)\n",
"import Data.Text (Text)\n",
"\n",
"data PlotInfo = PlotInfo {\n",
" plotTitle :: Text,\n",
" plotTitleSize :: Integer,\n",
" subTitle :: Text,\n",
" subTitleSize :: Integer,\n",
" xLabel :: Text,\n",
" xLabelSize :: Integer,\n",
" yLabel :: Text,\n",
" yLabelSize :: Integer,\n",
" showXAxis :: Bool,\n",
" showYAxis :: Bool,\n",
" xRange :: (Double, Double),\n",
" yRange :: (Double, Double)\n",
" }\n",
"\n",
"defaultPlotInfo = PlotInfo {\n",
" plotTitle = mempty,\n",
" plotTitleSize = 10,\n",
" subTitle = mempty,\n",
" subTitleSize = 10,\n",
" xLabel = mempty,\n",
" xLabelSize = 10,\n",
" yLabel = mempty,\n",
" yLabelSize = 10,\n",
" showXAxis = True,\n",
" showYAxis = True,\n",
" xRange = (-5, 5),\n",
" yRange = (-5, 5)\n",
" }\n",
"\n",
"plotData <- newIORef defaultPlotInfo"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# TODO: Plotting Implementation"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The first required element is a box, to implement a vertical division between the plotting region and the input widgets."
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"divBox <- mkFlexBox\n",
"setField divBox Orientation HorizontalOrientation\n",
"\n",
"-- Two parts: A FlexBox for the left part (plot + sliders) and an Accordion for the input elements.\n",
"plBox <- mkFlexBox\n",
"tlBox <- mkAccordion\n",
"\n",
"-- Add the widgets to the main dividing box.\n",
"setField divBox Children [ChildWidget plBox, ChildWidget tlBox]\n",
"\n",
"-- Make the orientation Vertical\n",
"setField plBox Orientation VerticalOrientation"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Now we fill in the plotting area with:\n",
"\n",
"+ A `FlexBox` to hold the sliders.\n",
"+ An `ImageWidget` to hold the plot."
]
},
{
"cell_type": "code",
"execution_count": 4,
"metadata": {
"collapsed": false,
"scrolled": true
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"slBox <- mkFlexBox\n",
"plImg <- mkImageWidget\n",
"\n",
"-- Sliders need to be laid out vertically.\n",
"setField slBox Orientation VerticalOrientation\n",
"\n",
"-- Add widgets to the plotting region.\n",
"setField plBox Children [ChildWidget slBox, ChildWidget plImg]"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Now, we fill the other half with the following:\n",
"\n",
"+ Four `FlexBox` widgets (title, sub-title, x-label, y-label), containing a `TextWidget` for title and a `BoundedIntText` for the font size.\n",
"+ A `FlexBox` with two selection widgets for toggling axis visibility. We'll go with `ToggleButton` just for fun.\n",
"+ Two more `FlexBox`, with `FloatText` widgets for deciding the plot range."
]
},
{
"cell_type": "code",
"execution_count": 5,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"-- The four FlexBox widgets.\n",
"import Control.Monad (replicateM, forM_)\n",
"import Data.List (zip4)\n",
"import Text.Printf (printf)\n",
"import Data.Text (pack)\n",
"\n",
"-- pl : plotTitle\n",
"-- sb : subTitle\n",
"-- x : xLabel\n",
"-- y : yLabel\n",
"boxes <- replicateM 4 mkFlexBox\n",
"texts@[plTxt,sbTxt,xTxt,yTxt] <- replicateM 4 mkTextWidget\n",
"inpts@[plInp,sbInp,xInp,yInp] <- replicateM 4 mkBoundedIntText\n",
"\n",
"-- Adding event handlers. This is a clumsy way to emulate first-class record fields.\n",
"let setHandler widget fieldSetter = setField widget SubmitHandler $ do\n",
" oldVal <- readIORef plotData\n",
" newStr <- getField widget StringValue\n",
" writeIORef plotData (fieldSetter oldVal newStr)\n",
" in do\n",
" setHandler plTxt $ \\struct val -> struct { plotTitle = val }\n",
" setHandler sbTxt $ \\struct val -> struct { subTitle = val }\n",
" setHandler xTxt $ \\struct val -> struct { xLabel = val }\n",
" setHandler yTxt $ \\struct val -> struct { yLabel = val }\n",
"\n",
"let boxInfo = zip4 boxes texts inpts [\"plot title\", \"sub-title\", \"X-Label\", \"Y-Label\"]\n",
"\n",
"forM_ boxInfo $ \\(box,text,input,placeholder) -> do\n",
" setField box Orientation HorizontalOrientation\n",
" setField box Children [ChildWidget text, ChildWidget input]\n",
" setField text Placeholder $ pack $ printf \"Enter %s here ...\" placeholder\n",
" setField input MinInt 1\n",
" setField input MaxInt 72\n",
" setField input IntValue 10"
]
},
{
"cell_type": "code",
"execution_count": 6,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"-- A FlexBox with ToggleButtons\n",
"buttonBox <- mkFlexBox\n",
"setField buttonBox Orientation HorizontalOrientation\n",
"tButtons@[xBut,yBut] <- replicateM 2 mkToggleButton\n",
"\n",
"let tgButtonInfo = zip tButtons [\"X-Axis\", \"Y-Axis\"]\n",
"\n",
"let setHandler widget fieldSetter = setField widget ChangeHandler $ do\n",
" oldVal <- readIORef plotData\n",
" newStr <- getField widget BoolValue\n",
" writeIORef plotData (fieldSetter oldVal newStr)\n",
" in do\n",
" setHandler xBut $ \\struct val -> struct { showXAxis = val }\n",
" setHandler yBut $ \\struct val -> struct { showYAxis = val }\n",
"\n",
"forM_ tgButtonInfo $ \\(widget, description) -> do\n",
" setField widget Description description\n",
" setField widget BoolValue True\n",
"\n",
"setField buttonBox Children (map ChildWidget tButtons)"
]
},
{
"cell_type": "code",
"execution_count": 7,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"-- Finally, the ranges\n",
"rangeBoxes <- replicateM 2 mkFlexBox\n",
"fTxts@[xLow,xHigh,yLow,yHigh] <- replicateM 4 mkFloatText\n",
"\n",
"let rangeInfo = zip rangeBoxes [(xLow,xHigh), (yLow, yHigh)]\n",
"\n",
"forM_ rangeInfo $ \\(box, (lowTxt, highTxt)) -> do\n",
" setField box Orientation HorizontalOrientation\n",
" setField box Children (map ChildWidget [lowTxt, highTxt])"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Now, to finally add these widgets to the right part of the window."
]
},
{
"cell_type": "code",
"execution_count": 8,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"setField tlBox Children $ map ChildWidget $ boxes ++ [buttonBox] ++ rangeBoxes"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"We also need to give a title to each page in the `Accordion` widget."
]
},
{
"cell_type": "code",
"execution_count": 9,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"setField tlBox Titles [\"Plot title\", \"Subtitle\", \"X-Label\", \"Y-Label\", \"Axis visibility\", \"X-range\", \"Y-range\"]"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Then we sync the values from out `plotData :: IORef PlotData` to the widgets."
]
},
{
"cell_type": "code",
"execution_count": 10,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"let syncVal widget value fieldGetter = readIORef plotData >>= setField widget value . fieldGetter\n",
" in do\n",
" syncVal plTxt StringValue plotTitle\n",
" syncVal plInp IntValue plotTitleSize\n",
" syncVal sbTxt StringValue subTitle\n",
" syncVal sbInp IntValue subTitleSize\n",
" \n",
" syncVal xTxt StringValue xLabel\n",
" syncVal xInp IntValue xLabelSize\n",
" syncVal yTxt StringValue yLabel\n",
" syncVal yInp IntValue yLabelSize\n",
"\n",
" syncVal xBut BoolValue showXAxis\n",
" syncVal yBut BoolValue showYAxis\n",
" \n",
" syncVal xLow FloatValue (fst . xRange)\n",
" syncVal xHigh FloatValue (snd . xRange)\n",
" syncVal yLow FloatValue (fst . yRange)\n",
" syncVal yHigh FloatValue (snd . yRange)"
]
},
{
"cell_type": "code",
"execution_count": 11,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"divBox"
]
}
],
"metadata": {
"kernelspec": {
"display_name": "Haskell",
"language": "haskell",
"name": "haskell"
}
},
"nbformat": 4,
"nbformat_minor": 0
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment