mirrors/IHaskell
1
0
Fork 0
mirror of https://github.com/IHaskell/IHaskell.git synced 2025-04-19 12:56:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Update Numeric Widgets example

Browse Source
This commit is contained in:
David Davó 2021-07-14 16:55:48 +02:00
parent 7e20685cd5
commit 792ac0ef5f
6 changed files with 293 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

347
ihaskell-display/ihaskell-widgets/Examples/Numeric Widgets.ipynb
View File

@ -4,7 +4,7 @@
"cell_type": "markdown",
"metadata": {},
"source": [
"### The Numeric Widgets\n",
"# The Numeric Widgets\n",
"\n",
"#### `Int` Widgets\n",
"\n",
@ -22,15 +22,15 @@
"+ FloatSlider\n",
"+ FloatRangeSlider\n",
"\n",
"**NOTE**: Only the `Int` widgets are shown in this notebook. The `Float` widgets are the same as their `Int` counterparts, but hold `Float`s instead of `Int`s."
"----------------------\n",
"\n",
"First of all, we have to import the Widgets library. Sometimes we need some Haskell language extensions. We need `OverloadedStrings` because some widget methods receive a `Text` as an argument, instead of a `[Char]`."
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {
"collapsed": true
},
"metadata": {},
"outputs": [],
"source": [
"{-# LANGUAGE OverloadedStrings #-}\n",
@ -41,131 +41,315 @@
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `IntText` and `BoundedIntText`"
"#### `IntText` and `FloatText`\n",
"We are going to see how the `Text` family works. They create a \"Stepper\", which lets us click to increment a certain amount. We can also input the number as if it were text."
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {
"collapsed": false
},
"metadata": {},
"outputs": [],
"source": [
"int <- mkIntText\n",
"int"
"intt <- mkIntText\n",
"floatt <- mkFloatText\n",
"intt\n",
"floatt"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"For any numeric widget, we can use `getField w IntValue` and `getField w FloatValue` to obtain the value stored in the widget. Try changing the numbers in the widgets and then executing the cell bellow!"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {
"collapsed": false
},
"metadata": {},
"outputs": [],
"source": [
"getField intt IntValue\n",
"getField floatt FloatValue"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"We can also use these results for any computation. For example, let us add them together:"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"x <- getField intt IntValue\n",
"y <- getField floatt FloatValue\n",
"\n",
"(fromIntegral x) + y"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"But incrementing and decrementing one by one is a bit boring... We can change the number incremented each step if we set the `StepInt` and `StepFloat` fields."
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"setField intt StepInt 5\n",
"setField floatt StepFloat 0.5"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Try clicking on the buttons of the text field now.\n",
"\n",
"By the way, does this mean that we can change other fields with `setField`? Yes! For example, let us change the `IntValue`/`FloatValue`"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"setField intt IntValue 42\n",
"setField floatt FloatValue 3.14"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"One special field is the `ChangeHandler`. This field is an IO function that is executed everytime the value is changed. We are going to \"sync\" the two widgets using two `ChangeHandler` functions. Each time the value changes in one widget, it is changed on the other widget too."
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"setField intt ChangeHandler (getField intt IntValue >>= setField floatt FloatValue . fromIntegral)\n",
"setField floatt ChangeHandler (getField floatt FloatValue >>= setField intt IntValue . round)\n",
"\n",
"-- Let's display the widgets again so we don't have to scroll up and down\n",
"intt\n",
"floatt"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `BoundedIntText` and `BoundedFloatText`\n",
"\n",
"So, what's the difference between the Bounded family and the other two? `Bounded` widgets have the `Max` and `Min` attributes, which let you set an upper and lower bound. Let's try it"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"-- We create the two widgets\n",
"bit <- mkBoundedIntText\n",
"bit"
"bft <- mkBoundedFloatText\n",
"\n",
"setField bit MaxInt 5\n",
"setField bit MinInt (-5)\n",
"\n",
"setField bft MaxFloat 20\n",
"setField bft MinFloat 10\n",
"setField bft StepFloat 0.5\n",
"setField bft ChangeHandler (getField bft FloatValue >>= print)\n",
"setField bft FloatValue 15\n",
"\n",
"bit\n",
"bft"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Both the widgets are similar, but the second one possesses some additional properties."
"If you try clicking on the buttons or editing the text, you can't but anything that is not between the `Min` and `Max`! That's pretty neat, but, if you want to do something with bounds, maybe it's better to use an slider"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `IntSlider`, `FloatSlider`, `FloatLogSlider`, `IntRangeSlider` and `FloatRangeSlider`"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"All these widgets are sliders (duh!). `IntSlider`, `FloatSlider` and `FloatLogSlider` represent a single value, whereas `IntRangeSlider` and `FloatRangeSlider` represent a pair (range) of values. `FloatLogSlider` uses a logarithmic scale, which means that every step will multiply (instead of increment) the value!"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"setField bit MaxInt 20\n",
"setField bit MinInt 10\n",
"setField bit ChangeHandler (getField bit IntValue >>= print)"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Now, the first widget will accept arbitrary input whereas the second one wil accept input in the the 10-20 range. For example, try entering large values and hitting return/enter in the second widget."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `IntSlider` and `IntRangeSlider`"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Both these widgets are sliders (duh!). `IntSlider` represents a single value, whereas `IntRangeSlider` represents a pair (range) of values."
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"ins <- mkIntSlider\n",
"irs <- mkIntRangeSlider"
"irs <- mkIntRangeSlider\n",
"fns <- mkFloatSlider\n",
"fls <- mkFloatLogSlider\n",
"frs <- mkFloatRangeSlider\n",
"setField fns StepFloat 0.25\n",
"-- We can set the base of the logslider\n",
"setField fls BaseFloat 2\n",
"setField fls StepFloat 1"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {
"collapsed": false
},
"metadata": {},
"outputs": [],
"source": [
"ins\n",
"irs"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"getField irs IntPairValue"
"irs\n",
"fns\n",
"fls\n",
"frs"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `IntProgress`"
"They work the same as the previous widgets plus, they are a lot more confortable if you have bounds. The only difference is with the pair ones, we have to get the `IntPairValue` and `FloatPairValue` fields"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"getField irs IntPairValue\n",
"getField frs FloatPairValue"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"-- We can also set the field!\n",
"setField irs IntPairValue (32,42)"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"This widget is meant to be used as a progress bar."
"Let's create a small program using widgets that gives us the greatest common divisor of two numbers! It displays the result on a `IntText` widget"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {
"collapsed": true
},
"metadata": {},
"outputs": [],
"source": [
"gcd a 0 = a\n",
"gcd a b = gcd b $ a `mod` b\n",
"\n",
"setField irs ChangeHandler (getField irs IntPairValue >>= setField intt IntValue . uncurry gcd)\n",
"\n",
"irs\n",
"intt"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `IntProgress` and `FloatProgress`"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Finally, we have these two widgets, that we can use as progress bars."
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"fnp <- mkFloatProgress\n",
"fnp"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"setField fnp FloatValue 42.5\n",
"getField fnp FloatValue"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"We can also display them Vertically.\n",
"\n",
"*(Did you know you can also display the Sliders vertically?)*"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"setField fnp Orientation VerticalOrientation"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Now we are going to create a REAL progress bar! For example, let's create a thread that does some incredible complex calculations (sleeping) and then reports the progress to the widget"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"import Control.Concurrent\n",
"import System.IO.Unsafe\n",
"\n",
"inp <- mkIntProgress\n",
"inp"
]
@ -173,12 +357,15 @@
{
"cell_type": "code",
"execution_count": null,
"metadata": {
"collapsed": false
},
"metadata": {},
"outputs": [],
"source": [
"setField inp IntValue 42"
"f :: Integer -> IO ()\n",
"f x = do\n",
" threadDelay (5*10^4)\n",
" setField inp IntValue x\n",
" \n",
"thid <- forkIO $ mapM_ f [0..100]"
]
}
],
@ -191,10 +378,12 @@
"language_info": {
"codemirror_mode": "ihaskell",
"file_extension": ".hs",
"mimetype": "text/x-haskell",
"name": "haskell",
"version": "7.10.2"
"pygments_lexer": "Haskell",
"version": "8.10.4"
}
},
"nbformat": 4,
"nbformat_minor": 0
"nbformat_minor": 4
}

9
ihaskell-display/ihaskell-widgets/README.md
View File

@ -5,3 +5,12 @@ IHaskell. The frontend (javascript) is provided by the jupyter/ipython notebook
the backend is implemented in haskell.
To know more about the widget messaging protocol, see [MsgSpec.md](MsgSpec.md).
## Contributing examples
If you want to contribute with more Notebook examples, please do so on the `Examples/`
folder. Before commiting, please make sure they can be executed sequentialy and
then remove the output from the Nootebooks with:
```bash
jupyter nbconvert *.ipynb --to notebook --inplace --clear-output
```

5
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatLogSlider.hs
View File

@ -19,7 +19,7 @@ import Control.Monad (void)
import Data.Aeson
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Vinyl (Rec(..), (<+>))
import Data.Vinyl (Rec(..), (<+>), rput)
import IHaskell.Display
import IHaskell.Eval.Widgets
@ -44,7 +44,8 @@ mkFloatLogSlider = do
:& (SliderColor =:: "")
:& (BaseFloat =:: 10.0)
:& RNil
widgetState = WidgetState $ boundedFloatAttrs <+> sliderAttrs
widgetState = WidgetState $ rput (MaxFloat =:: 4.0)
$ boundedFloatAttrs <+> sliderAttrs
stateIO <- newIORef widgetState

6
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/FloatText.hs
View File

@ -19,6 +19,7 @@ import Control.Monad (void)
import Data.Aeson
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display
import IHaskell.Eval.Widgets
@ -36,7 +37,10 @@ mkFloatText = do
-- Default properties, with a random uuid
wid <- U.random
let widgetState = WidgetState $ defaultFloatWidget "FloatTextView" "FloatTextModel"
let floatAttrs = defaultFloatWidget "FloatTextView" "FloatTextModel"
textAttrs = (StepFloat =:+ 0.1)
:& RNil
widgetState = WidgetState $ floatAttrs <+> textAttrs
stateIO <- newIORef widgetState

6
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/IntText.hs
View File

@ -19,6 +19,7 @@ import Control.Monad (void)
import Data.Aeson
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display
import IHaskell.Eval.Widgets
@ -36,7 +37,10 @@ mkIntText = do
-- Default properties, with a random uuid
wid <- U.random
let widgetState = WidgetState $ defaultIntWidget "IntTextView" "IntTextModel"
let intAttrs = defaultIntWidget "IntTextView" "IntTextModel"
textAttrs = (StepInt =:+ 1)
:& RNil
widgetState = WidgetState $ intAttrs <+> textAttrs
stateIO <- newIORef widgetState

6
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs
View File

@ -334,7 +334,7 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
WidgetFields 'ToggleButtonsType =
SelectionClass :++ ['S.Tooltips, 'S.Icons, 'S.ButtonStyle]
WidgetFields 'SelectMultipleType = MultipleSelectionClass
WidgetFields 'IntTextType = IntClass
WidgetFields 'IntTextType = IntClass :++ '[ 'S.StepInt ]
WidgetFields 'BoundedIntTextType = BoundedIntClass
WidgetFields 'IntSliderType =
BoundedIntClass :++
@ -344,7 +344,7 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
WidgetFields 'IntRangeSliderType =
BoundedIntRangeClass :++
['S.Orientation, 'S.ShowRange, 'S.ReadOut, 'S.SliderColor]
WidgetFields 'FloatTextType = FloatClass
WidgetFields 'FloatTextType = FloatClass :++ '[ 'S.StepFloat ]
WidgetFields 'BoundedFloatTextType = BoundedFloatClass
WidgetFields 'FloatSliderType =
BoundedFloatClass :++
@ -784,7 +784,7 @@ defaultFloatWidget viewName modelName = defaultDOMWidget viewName modelName <+>
defaultBoundedFloatWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr BoundedFloatClass
defaultBoundedFloatWidget viewName modelName = defaultFloatWidget viewName modelName <+> boundedFloatAttrs
where
boundedFloatAttrs = (StepFloat =:+ 1)
boundedFloatAttrs = (StepFloat =:+ 0.1)
:& (MinFloat =:: 0)
:& (MaxFloat =:: 100)
:& RNil