mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-18 20:36:08 +00:00
Added media widgets
This commit is contained in:
David Davó
parent
f3bbe00b58
commit
cc718f3e5b
@ -1,117 +0,0 @@
|
||||
{
|
||||
"cells": [
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"### The `Image` Widget"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"This widget can be used to display images given in the form of base64 encoded `Text`. The widget has a `B64Value` field, which can be changed to display images to it. It also has an `ImageFormat` field, which is set to `PNG` by default."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": null,
|
||||
"metadata": {
|
||||
"collapsed": true
|
||||
},
|
||||
"outputs": [],
|
||||
"source": [
|
||||
"{-# LANGUAGE OverloadedStrings #-}\n",
|
||||
"import IHaskell.Display.Widgets\n",
|
||||
"import IHaskell.Display (base64, encode64)"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"The `base64` and `encode64` functions are useful with `ImageWidget`."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": null,
|
||||
"metadata": {
|
||||
"collapsed": false
|
||||
},
|
||||
"outputs": [],
|
||||
"source": [
|
||||
":t base64\n",
|
||||
":t encode64"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"The following example downloads an xkcd comic and displays it in an image widget. The example below requires the HTTP package. If you don't have it then you can either install it and restart the ihaskell kernel, or just skip to the next example."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": null,
|
||||
"metadata": {
|
||||
"collapsed": false
|
||||
},
|
||||
"outputs": [],
|
||||
"source": [
|
||||
"import Network.HTTP\n",
|
||||
"import IHaskell.Display (encode64)\n",
|
||||
"\n",
|
||||
"get url = simpleHTTP (getRequest url) >>= getResponseBody\n",
|
||||
"jpg <- get \"http://imgs.xkcd.com/comics/functional.png\"\n",
|
||||
"\n",
|
||||
"img <- mkImageWidget\n",
|
||||
"setField img B64Value (encode64 jpg)\n",
|
||||
"img"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"Replace the call to undefined by the path to an image, and it will be displayed in an image widget."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": null,
|
||||
"metadata": {
|
||||
"collapsed": false
|
||||
},
|
||||
"outputs": [],
|
||||
"source": [
|
||||
"imgpath = undefined\n",
|
||||
"\n",
|
||||
"import qualified Data.ByteString as B\n",
|
||||
"import IHaskell.Display (base64)\n",
|
||||
"\n",
|
||||
"i <- mkImageWidget\n",
|
||||
"B.readFile imgpath >>= setField i B64Value . base64\n",
|
||||
"\n",
|
||||
"i"
|
||||
]
|
||||
}
|
||||
],
|
||||
"metadata": {
|
||||
"kernelspec": {
|
||||
"display_name": "Haskell",
|
||||
"language": "haskell",
|
||||
"name": "haskell"
|
||||
},
|
||||
"language_info": {
|
||||
"codemirror_mode": "ihaskell",
|
||||
"file_extension": ".hs",
|
||||
"name": "haskell",
|
||||
"version": "7.10.2"
|
||||
}
|
||||
},
|
||||
"nbformat": 4,
|
||||
"nbformat_minor": 0
|
||||
}
|
||||
316
ihaskell-display/ihaskell-widgets/Examples/Media Widgets.ipynb
Normal file
316
ihaskell-display/ihaskell-widgets/Examples/Media Widgets.ipynb
Normal file
@ -0,0 +1,316 @@
|
||||
{
|
||||
"cells": [
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"## The `Media` Widgets\n",
|
||||
"All the media widgets have a `BSValue`. It's a ByteStream value with the data to display."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"### The `Image` Widget\n",
|
||||
"\n",
|
||||
"This widget can be used to display images, with `ImageFormat` we can set the format of the image. If we set `ImageFormat` to `IURL` and `BSValue` to the utf8-encoded URL, the online image will be displayed automatically."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 1,
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"data": {
|
||||
"text/html": [
|
||||
"<style>/* Styles used for the Hoogle display in the pager */\n",
|
||||
".hoogle-doc {\n",
|
||||
"display: block;\n",
|
||||
"padding-bottom: 1.3em;\n",
|
||||
"padding-left: 0.4em;\n",
|
||||
"}\n",
|
||||
".hoogle-code {\n",
|
||||
"display: block;\n",
|
||||
"font-family: monospace;\n",
|
||||
"white-space: pre;\n",
|
||||
"}\n",
|
||||
".hoogle-text {\n",
|
||||
"display: block;\n",
|
||||
"}\n",
|
||||
".hoogle-name {\n",
|
||||
"color: green;\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".hoogle-head {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".hoogle-sub {\n",
|
||||
"display: block;\n",
|
||||
"margin-left: 0.4em;\n",
|
||||
"}\n",
|
||||
".hoogle-package {\n",
|
||||
"font-weight: bold;\n",
|
||||
"font-style: italic;\n",
|
||||
"}\n",
|
||||
".hoogle-module {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".hoogle-class {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".get-type {\n",
|
||||
"color: green;\n",
|
||||
"font-weight: bold;\n",
|
||||
"font-family: monospace;\n",
|
||||
"display: block;\n",
|
||||
"white-space: pre-wrap;\n",
|
||||
"}\n",
|
||||
".show-type {\n",
|
||||
"color: green;\n",
|
||||
"font-weight: bold;\n",
|
||||
"font-family: monospace;\n",
|
||||
"margin-left: 1em;\n",
|
||||
"}\n",
|
||||
".mono {\n",
|
||||
"font-family: monospace;\n",
|
||||
"display: block;\n",
|
||||
"}\n",
|
||||
".err-msg {\n",
|
||||
"color: red;\n",
|
||||
"font-style: italic;\n",
|
||||
"font-family: monospace;\n",
|
||||
"white-space: pre;\n",
|
||||
"display: block;\n",
|
||||
"}\n",
|
||||
"#unshowable {\n",
|
||||
"color: red;\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".err-msg.in.collapse {\n",
|
||||
"padding-top: 0.7em;\n",
|
||||
"}\n",
|
||||
".highlight-code {\n",
|
||||
"white-space: pre;\n",
|
||||
"font-family: monospace;\n",
|
||||
"}\n",
|
||||
".suggestion-warning { \n",
|
||||
"font-weight: bold;\n",
|
||||
"color: rgb(200, 130, 0);\n",
|
||||
"}\n",
|
||||
".suggestion-error { \n",
|
||||
"font-weight: bold;\n",
|
||||
"color: red;\n",
|
||||
"}\n",
|
||||
".suggestion-name {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
"</style><div class=\"suggestion-name\" style=\"clear:both;\">Unused LANGUAGE pragma</div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Found:</div><div class=\"highlight-code\" id=\"haskell\">{-# LANGUAGE OverloadedStrings #-}</div></div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Why Not:</div><div class=\"highlight-code\" id=\"haskell\"></div></div>"
|
||||
],
|
||||
"text/plain": [
|
||||
"Line 1: Unused LANGUAGE pragma\n",
|
||||
"Found:\n",
|
||||
"{-# LANGUAGE OverloadedStrings #-}\n",
|
||||
"Why not:"
|
||||
]
|
||||
},
|
||||
"metadata": {},
|
||||
"output_type": "display_data"
|
||||
}
|
||||
],
|
||||
"source": [
|
||||
"{-# LANGUAGE OverloadedStrings #-}\n",
|
||||
"import IHaskell.Display.Widgets"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"First, let's create a function to download data. You'll need to install `http-conduit`."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 2,
|
||||
"metadata": {},
|
||||
"outputs": [],
|
||||
"source": [
|
||||
"import Data.Functor ((<&>))\n",
|
||||
"import Network.HTTP.Simple\n",
|
||||
"\n",
|
||||
"get url = httpBS url <&> getResponseBody"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"Now, let's display a XKCD comic (of course). It's a PNG so we set the image format to PNG."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 3,
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"data": {
|
||||
"application/vnd.jupyter.widget-view+json": {
|
||||
"model_id": "b82b6c13-f47c-43cf-a801-8dc2f6abcc24",
|
||||
"version_major": 2,
|
||||
"version_minor": 0
|
||||
}
|
||||
},
|
||||
"metadata": {},
|
||||
"output_type": "display_data"
|
||||
}
|
||||
],
|
||||
"source": [
|
||||
"png <- get \"https://imgs.xkcd.com/comics/haskell.png\"\n",
|
||||
"img <- mkImageWidget\n",
|
||||
"setField img ImageFormat PNG\n",
|
||||
"setField img BSValue png\n",
|
||||
"img"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"Let's display another image, but this time setting `ImageFormat` to `IURL`."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 7,
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"data": {
|
||||
"application/vnd.jupyter.widget-view+json": {
|
||||
"model_id": "cb2129d6-418d-4c05-873b-34befb693555",
|
||||
"version_major": 2,
|
||||
"version_minor": 0
|
||||
}
|
||||
},
|
||||
"metadata": {},
|
||||
"output_type": "display_data"
|
||||
}
|
||||
],
|
||||
"source": [
|
||||
"imgurl <- mkImageWidget\n",
|
||||
"setField imgurl ImageFormat IURL\n",
|
||||
"setField imgurl BSValue \"https://imgs.xkcd.com/comics/functional.png\"\n",
|
||||
"imgurl"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"### The `Video` widget\n",
|
||||
"\n",
|
||||
"With this widget, we can display video. We are going to display an mp4 file with the first 60 seconds of Big Buck Bunny."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 5,
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"data": {
|
||||
"application/vnd.jupyter.widget-view+json": {
|
||||
"model_id": "b88a1b8c-a022-47fa-b417-27e63640f3f1",
|
||||
"version_major": 2,
|
||||
"version_minor": 0
|
||||
}
|
||||
},
|
||||
"metadata": {},
|
||||
"output_type": "display_data"
|
||||
}
|
||||
],
|
||||
"source": [
|
||||
"video <- mkVideoWidget\n",
|
||||
"mp4 <- get \"http://clips.vorwaerts-gmbh.de/big_buck_bunny.mp4\"\n",
|
||||
"setField video BSValue mp4\n",
|
||||
"video"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"This widget has some more attributes, they are:\n",
|
||||
"+ `AutoPlay`: Whether to start playing when the video is displayed\n",
|
||||
"+ `Loop`: Whether to start again the video when it finishes\n",
|
||||
"+ `Controls`: Whether to display the control overlay on the video\n",
|
||||
"\n",
|
||||
"If we wanted to display it directly given the URL, we would need to set the format to `VURL`."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 6,
|
||||
"metadata": {},
|
||||
"outputs": [],
|
||||
"source": [
|
||||
"setField video Controls False\n",
|
||||
"setField video Loop False"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"### The `Audio` Widget\n",
|
||||
"Let's do the same, but now with an audio file. It has the same 3 attributes of the video, so we can disable looping and autoplay."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 12,
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"data": {
|
||||
"application/vnd.jupyter.widget-view+json": {
|
||||
"model_id": "0baa58f4-b663-489d-b18e-af51da067342",
|
||||
"version_major": 2,
|
||||
"version_minor": 0
|
||||
}
|
||||
},
|
||||
"metadata": {},
|
||||
"output_type": "display_data"
|
||||
}
|
||||
],
|
||||
"source": [
|
||||
"audio <- mkAudioWidget\n",
|
||||
"setField audio BSValue \"https://file-examples-com.github.io/uploads/2017/11/file_example_MP3_700KB.mp3\"\n",
|
||||
"setField audio AudioFormat AURL\n",
|
||||
"setField audio Loop False\n",
|
||||
"setField audio AutoPlay False\n",
|
||||
"audio"
|
||||
]
|
||||
}
|
||||
],
|
||||
"metadata": {
|
||||
"kernelspec": {
|
||||
"display_name": "Haskell",
|
||||
"language": "haskell",
|
||||
"name": "haskell"
|
||||
},
|
||||
"language_info": {
|
||||
"codemirror_mode": "ihaskell",
|
||||
"file_extension": ".hs",
|
||||
"mimetype": "text/x-haskell",
|
||||
"name": "haskell",
|
||||
"pygments_lexer": "Haskell",
|
||||
"version": "8.10.4"
|
||||
}
|
||||
},
|
||||
"nbformat": 4,
|
||||
"nbformat_minor": 4
|
||||
}
|
||||
@ -78,7 +78,9 @@ library
|
||||
IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider
|
||||
IHaskell.Display.Widgets.Float.BoundedFloat.FloatLogSlider
|
||||
IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider
|
||||
IHaskell.Display.Widgets.Image
|
||||
IHaskell.Display.Widgets.Media.Audio
|
||||
IHaskell.Display.Widgets.Media.Image
|
||||
IHaskell.Display.Widgets.Media.Video
|
||||
IHaskell.Display.Widgets.Output
|
||||
IHaskell.Display.Widgets.Selection.Dropdown
|
||||
IHaskell.Display.Widgets.Selection.RadioButtons
|
||||
@ -102,6 +104,7 @@ library
|
||||
|
||||
build-depends: aeson >=0.7
|
||||
, base >=4.9 && <5
|
||||
, bytestring
|
||||
, containers >= 0.5
|
||||
, ipython-kernel >= 0.6.1.2
|
||||
, text >= 0.11
|
||||
|
||||
@ -23,7 +23,9 @@ import IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider as X
|
||||
import IHaskell.Display.Widgets.Float.BoundedFloat.FloatLogSlider as X
|
||||
import IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider as X
|
||||
|
||||
import IHaskell.Display.Widgets.Image as X
|
||||
import IHaskell.Display.Widgets.Media.Audio as X
|
||||
import IHaskell.Display.Widgets.Media.Image as X
|
||||
import IHaskell.Display.Widgets.Media.Video as X
|
||||
|
||||
import IHaskell.Display.Widgets.Output as X
|
||||
|
||||
|
||||
@ -44,7 +44,7 @@ pattern Placeholder = S.SPlaceholder
|
||||
pattern Tooltip = S.STooltip
|
||||
pattern Icon = S.SIcon
|
||||
pattern ButtonStyle = S.SButtonStyle
|
||||
pattern B64Value = S.SB64Value
|
||||
pattern BSValue = S.SBSValue
|
||||
pattern ImageFormat = S.SImageFormat
|
||||
pattern BoolValue = S.SBoolValue
|
||||
pattern Options = S.SOptions
|
||||
@ -90,6 +90,11 @@ pattern Selector = S.SSelector
|
||||
pattern ContinuousUpdate = S.SContinuousUpdate
|
||||
pattern Tabbable = S.STabbable
|
||||
pattern Rows = S.SRows
|
||||
pattern AudioFormat = S.SAudioFormat
|
||||
pattern VideoFormat = S.SVideoFormat
|
||||
pattern AutoPlay = S.SAutoPlay
|
||||
pattern Loop = S.SLoop
|
||||
pattern Controls = S.SControls
|
||||
|
||||
-- | Close a widget's comm
|
||||
closeWidget :: IHaskellWidget w => w -> IO ()
|
||||
@ -195,20 +200,52 @@ instance ToJSON BarStyleValue where
|
||||
toJSON DangerBar = "danger"
|
||||
toJSON DefaultBar = ""
|
||||
|
||||
-- | Audio formats for AudioWidget
|
||||
data AudioFormatValue = MP3
|
||||
| OGG
|
||||
| WAV
|
||||
| AURL
|
||||
deriving (Eq, Typeable)
|
||||
|
||||
instance Show AudioFormatValue where
|
||||
show MP3 = "mp3"
|
||||
show OGG = "ogg"
|
||||
show WAV = "wav"
|
||||
show AURL = "url"
|
||||
|
||||
instance ToJSON AudioFormatValue where
|
||||
toJSON = toJSON . pack . show
|
||||
|
||||
-- | Image formats for ImageWidget
|
||||
data ImageFormatValue = PNG
|
||||
| SVG
|
||||
| JPG
|
||||
| IURL
|
||||
deriving (Eq, Typeable)
|
||||
|
||||
instance Show ImageFormatValue where
|
||||
show PNG = "png"
|
||||
show SVG = "svg"
|
||||
show JPG = "jpg"
|
||||
show IURL = "url"
|
||||
|
||||
instance ToJSON ImageFormatValue where
|
||||
toJSON = toJSON . pack . show
|
||||
|
||||
-- | Video formats for VideoWidget
|
||||
data VideoFormatValue = MP4
|
||||
| WEBM
|
||||
| VURL
|
||||
deriving (Eq, Typeable)
|
||||
|
||||
instance Show VideoFormatValue where
|
||||
show MP4 = "mp4"
|
||||
show WEBM = "webm"
|
||||
show VURL = "url"
|
||||
|
||||
instance ToJSON VideoFormatValue where
|
||||
toJSON = toJSON . pack . show
|
||||
|
||||
-- | Options for selection widgets.
|
||||
data SelectionOptions = OptionLabels [Text]
|
||||
| OptionDict [(Text, Text)]
|
||||
|
||||
@ -0,0 +1,59 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module IHaskell.Display.Widgets.Media.Audio
|
||||
( -- * The Audio Widget
|
||||
AudioWidget
|
||||
-- * Constructor
|
||||
, mkAudioWidget
|
||||
) where
|
||||
|
||||
-- To keep `cabal repl` happy when running from the ihaskell repo
|
||||
import Prelude
|
||||
|
||||
import Data.Aeson
|
||||
import Data.IORef (newIORef)
|
||||
import Data.Monoid (mempty)
|
||||
import Data.Vinyl (Rec(..), (<+>))
|
||||
|
||||
import IHaskell.Display
|
||||
import IHaskell.Eval.Widgets
|
||||
import IHaskell.IPython.Message.UUID as U
|
||||
|
||||
import IHaskell.Display.Widgets.Types
|
||||
import IHaskell.Display.Widgets.Common
|
||||
|
||||
-- | An 'AudioWidget' represents a Audio widget from IPython.html.widgets.
|
||||
type AudioWidget = IPythonWidget 'AudioType
|
||||
|
||||
-- | Create a new audio widget
|
||||
mkAudioWidget :: IO AudioWidget
|
||||
mkAudioWidget = do
|
||||
-- Default properties, with a random uuid
|
||||
wid <- U.random
|
||||
|
||||
let mediaAttrs = defaultMediaWidget "AudioView" "AudioModel"
|
||||
audioAttrs = (AudioFormat =:: MP3)
|
||||
:& (AutoPlay =:: True)
|
||||
:& (Loop =:: True)
|
||||
:& (Controls =:: True)
|
||||
:& RNil
|
||||
widgetState = WidgetState (mediaAttrs <+> audioAttrs)
|
||||
|
||||
stateIO <- newIORef widgetState
|
||||
|
||||
let widget = IPythonWidget wid stateIO
|
||||
|
||||
-- Open a comm for this widget, and store it in the kernel state
|
||||
widgetSendOpen widget $ toJSON widgetState
|
||||
|
||||
-- Return the audio widget
|
||||
return widget
|
||||
|
||||
instance IHaskellWidget AudioWidget where
|
||||
getCommUUID = uuid
|
||||
getBufferPaths _ = [["value"]]
|
||||
@ -5,7 +5,7 @@
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module IHaskell.Display.Widgets.Image
|
||||
module IHaskell.Display.Widgets.Media.Image
|
||||
( -- * The Image Widget
|
||||
ImageWidget
|
||||
-- * Constructor
|
||||
@ -36,13 +36,12 @@ mkImageWidget = do
|
||||
-- Default properties, with a random uuid
|
||||
wid <- U.random
|
||||
|
||||
let dom = defaultDOMWidget "ImageView" "ImageModel"
|
||||
img = (ImageFormat =:: PNG)
|
||||
:& (Width =:+ 0)
|
||||
:& (Height =:+ 0)
|
||||
:& (B64Value =:: mempty)
|
||||
:& RNil
|
||||
widgetState = WidgetState (dom <+> img)
|
||||
let mediaAttrs = defaultMediaWidget "ImageView" "ImageModel"
|
||||
imageAttrs = (ImageFormat =:: PNG)
|
||||
:& (Width =:+ 0)
|
||||
:& (Height =:+ 0)
|
||||
:& RNil
|
||||
widgetState = WidgetState (mediaAttrs <+> imageAttrs)
|
||||
|
||||
stateIO <- newIORef widgetState
|
||||
|
||||
@ -56,3 +55,4 @@ mkImageWidget = do
|
||||
|
||||
instance IHaskellWidget ImageWidget where
|
||||
getCommUUID = uuid
|
||||
getBufferPaths _ = [["value"]]
|
||||
@ -0,0 +1,61 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module IHaskell.Display.Widgets.Media.Video
|
||||
( -- * The Video Widget
|
||||
VideoWidget
|
||||
-- * Constructor
|
||||
, mkVideoWidget
|
||||
) where
|
||||
|
||||
-- To keep `cabal repl` happy when running from the ihaskell repo
|
||||
import Prelude
|
||||
|
||||
import Data.Aeson
|
||||
import Data.IORef (newIORef)
|
||||
import Data.Monoid (mempty)
|
||||
import Data.Vinyl (Rec(..), (<+>))
|
||||
|
||||
import IHaskell.Display
|
||||
import IHaskell.Eval.Widgets
|
||||
import IHaskell.IPython.Message.UUID as U
|
||||
|
||||
import IHaskell.Display.Widgets.Types
|
||||
import IHaskell.Display.Widgets.Common
|
||||
|
||||
-- | An 'VideoWidget' represents a video widget from IPython.html.widgets.
|
||||
type VideoWidget = IPythonWidget 'VideoType
|
||||
|
||||
-- | Create a new video widget
|
||||
mkVideoWidget :: IO VideoWidget
|
||||
mkVideoWidget = do
|
||||
-- Default properties, with a random uuid
|
||||
wid <- U.random
|
||||
|
||||
let mediaAttrs = defaultMediaWidget "VideoView" "VideoModel"
|
||||
videoAttrs = (VideoFormat =:: MP4)
|
||||
:& (Width =:+ 0)
|
||||
:& (Height =:+ 0)
|
||||
:& (AutoPlay =:: True)
|
||||
:& (Loop =:: True)
|
||||
:& (Controls =:: True)
|
||||
:& RNil
|
||||
widgetState = WidgetState (mediaAttrs <+> videoAttrs)
|
||||
|
||||
stateIO <- newIORef widgetState
|
||||
|
||||
let widget = IPythonWidget wid stateIO
|
||||
|
||||
-- Open a comm for this widget, and store it in the kernel state
|
||||
widgetSendOpen widget $ toJSON widgetState
|
||||
|
||||
-- Return the video widget
|
||||
return widget
|
||||
|
||||
instance IHaskellWidget VideoWidget where
|
||||
getCommUUID = uuid
|
||||
getBufferPaths _ = [["value"]]
|
||||
@ -50,7 +50,7 @@ singletons
|
||||
| Tooltip
|
||||
| Icon
|
||||
| ButtonStyle
|
||||
| B64Value
|
||||
| BSValue
|
||||
| ImageFormat
|
||||
| BoolValue
|
||||
| Options
|
||||
@ -96,5 +96,10 @@ singletons
|
||||
| ContinuousUpdate
|
||||
| Tabbable
|
||||
| Rows
|
||||
| AudioFormat
|
||||
| VideoFormat
|
||||
| AutoPlay
|
||||
| Loop
|
||||
| Controls
|
||||
deriving (Eq, Ord, Show)
|
||||
|]
|
||||
|
||||
@ -75,6 +75,7 @@ import Text.Printf (printf)
|
||||
|
||||
import Data.Aeson hiding (pairs)
|
||||
import Data.Aeson.Types (Pair)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Int (Int16)
|
||||
#if MIN_VERSION_vinyl(0,9,0)
|
||||
import Data.Vinyl (Rec(..), Dict(..))
|
||||
@ -106,7 +107,7 @@ import Data.Text.Lazy.Encoding
|
||||
import GHC.IO.Exception
|
||||
|
||||
import IHaskell.Eval.Widgets (widgetSendUpdate, widgetSendView)
|
||||
import IHaskell.Display (Base64, IHaskellWidget(..), IHaskellDisplay(..), Display(..), widgetdisplay)
|
||||
import IHaskell.Display (Base64, IHaskellWidget(..), IHaskellDisplay(..), Display(..), widgetdisplay, base64)
|
||||
import IHaskell.IPython.Message.UUID
|
||||
|
||||
import IHaskell.Display.Widgets.Singletons (Field, SField)
|
||||
@ -162,6 +163,8 @@ type BoxClass = DOMWidgetClass :++ ['S.Children, 'S.OverflowX, 'S.OverflowY, 'S.
|
||||
|
||||
type SelectionContainerClass = BoxClass :++ ['S.Titles, 'S.SelectedIndex, 'S.ChangeHandler]
|
||||
|
||||
type MediaClass = CoreWidgetClass :++ DOMWidgetClass :++ '[ 'S.BSValue ]
|
||||
|
||||
-- Types associated with Fields.
|
||||
|
||||
type family FieldType (f :: Field) :: * where
|
||||
@ -184,7 +187,7 @@ type family FieldType (f :: Field) :: * where
|
||||
FieldType 'S.Tooltip = Maybe Text
|
||||
FieldType 'S.Icon = Text
|
||||
FieldType 'S.ButtonStyle = ButtonStyleValue
|
||||
FieldType 'S.B64Value = Base64
|
||||
FieldType 'S.BSValue = ByteString
|
||||
FieldType 'S.ImageFormat = ImageFormatValue
|
||||
FieldType 'S.BoolValue = Bool
|
||||
FieldType 'S.Options = SelectionOptions
|
||||
@ -230,6 +233,11 @@ type family FieldType (f :: Field) :: * where
|
||||
FieldType 'S.ContinuousUpdate = Bool
|
||||
FieldType 'S.Tabbable = Maybe Bool
|
||||
FieldType 'S.Rows = Maybe Integer
|
||||
FieldType 'S.AudioFormat = AudioFormatValue
|
||||
FieldType 'S.VideoFormat = VideoFormatValue
|
||||
FieldType 'S.AutoPlay = Bool
|
||||
FieldType 'S.Loop = Bool
|
||||
FieldType 'S.Controls = Bool
|
||||
|
||||
-- | Can be used to put different widgets in a list. Useful for dealing with children widgets.
|
||||
data ChildWidget = forall w. RecAll Attr (WidgetFields w) ToPairs => ChildWidget (IPythonWidget w)
|
||||
@ -258,7 +266,9 @@ instance CustomBounded Double where
|
||||
|
||||
-- Different types of widgets. Every widget in IPython has a corresponding WidgetType
|
||||
data WidgetType = ButtonType
|
||||
| AudioType
|
||||
| ImageType
|
||||
| VideoType
|
||||
| OutputType
|
||||
| HTMLType
|
||||
| HTMLMathType
|
||||
@ -296,8 +306,14 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
|
||||
WidgetFields 'ButtonType =
|
||||
DescriptionWidgetClass :++
|
||||
['S.Disabled, 'S.Icon, 'S.ButtonStyle ,'S.ClickHandler]
|
||||
|
||||
WidgetFields 'AudioType =
|
||||
MediaClass :++ ['S.AudioFormat, 'S.AutoPlay, 'S.Loop, 'S.Controls]
|
||||
WidgetFields 'ImageType =
|
||||
DOMWidgetClass :++ ['S.ImageFormat, 'S.Width, 'S.Height, 'S.B64Value]
|
||||
MediaClass :++ ['S.ImageFormat, 'S.Width, 'S.Height]
|
||||
WidgetFields 'VideoType =
|
||||
MediaClass :++ ['S.VideoFormat, 'S.Width, 'S.Height, 'S.AutoPlay, 'S.Loop, 'S.Controls]
|
||||
|
||||
WidgetFields 'OutputType = DOMWidgetClass
|
||||
WidgetFields 'HTMLType = StringClass
|
||||
WidgetFields 'HTMLMathType = StringClass
|
||||
@ -438,12 +454,21 @@ instance ToPairs (Attr 'S.Icon) where
|
||||
instance ToPairs (Attr 'S.ButtonStyle) where
|
||||
toPairs x = ["button_style" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.B64Value) where
|
||||
toPairs x = ["_b64value" .= toJSON x]
|
||||
instance ToJSON ByteString where
|
||||
toJSON = toJSON . base64
|
||||
|
||||
instance ToPairs (Attr 'S.BSValue) where
|
||||
toPairs x = ["value" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.ImageFormat) where
|
||||
toPairs x = ["format" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.AudioFormat) where
|
||||
toPairs x = ["format" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.VideoFormat) where
|
||||
toPairs x = ["format" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.BoolValue) where
|
||||
toPairs x = ["value" .= toJSON x]
|
||||
|
||||
@ -582,6 +607,15 @@ instance ToPairs (Attr 'S.Tabbable) where
|
||||
instance ToPairs (Attr 'S.Rows) where
|
||||
toPairs x = ["rows" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.AutoPlay) where
|
||||
toPairs x = ["autoplay" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.Loop) where
|
||||
toPairs x = ["loop" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.Controls) where
|
||||
toPairs x = ["controls" .= toJSON x]
|
||||
|
||||
-- | Store the value for a field, as an object parametrized by the Field. No verification is done
|
||||
-- for these values.
|
||||
(=::) :: (SingI f, Typeable (FieldType f)) => Sing f -> FieldType f -> Attr f
|
||||
@ -793,6 +827,13 @@ defaultSelectionContainerWidget viewName modelName = defaultBoxWidget viewName m
|
||||
:& (ChangeHandler =:: return ())
|
||||
:& RNil
|
||||
|
||||
-- | A record representing a widget of the _Media class from IPython
|
||||
defaultMediaWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr MediaClass
|
||||
defaultMediaWidget viewName modelName = defaultCoreWidget <+> defaultDOMWidget viewName modelName <+> mediaAttrs
|
||||
where
|
||||
mediaAttrs = (BSValue =:: "")
|
||||
:& RNil
|
||||
|
||||
newtype WidgetState w = WidgetState { _getState :: Rec Attr (WidgetFields w) }
|
||||
|
||||
-- All records with ToPair instances for their Attrs will automatically have a toJSON instance now.
|
||||
|
||||
@ -20,6 +20,7 @@ import Control.Monad (foldM)
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (emptyArray)
|
||||
import Data.ByteString.Lazy (toStrict)
|
||||
import Data.ByteString.Base64 as B64 (decodeLenient)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.HashMap.Strict as HM (lookup,insert,delete)
|
||||
@ -204,7 +205,7 @@ handleMessage send replyHeader state msg = do
|
||||
f :: (Value, [ByteString], [BufferPath]) -> BufferPath -> (Value, [ByteString], [BufferPath])
|
||||
f r@(v,bs,bps) bp =
|
||||
case nestedLookupRemove bp v of
|
||||
(newv, Just (String b)) -> (newv, encodeUtf8 b : bs, bp:bps)
|
||||
(newv, Just (String b)) -> (newv, B64.decodeLenient (encodeUtf8 b) : bs, bp:bps)
|
||||
_ -> r
|
||||
|
||||
-- Override toJSON for PublishDisplayData for sending Display messages through [method .= custom]
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user