module Csound.Typed.Gui.Cabbage.Cabbage(
Cab, CabProp, Col(..), runCab,
button, filebutton, infobutton, checkbox, combobox, csoundoutput, encoder, gentable,
hrange, vrange, form, groupbox, image, keyboard, label, hslider, vslider,
rslider, soundfiler, signaldisplay, textbox, texteditor, xypad,
bounds, channel, text1, text2, value, colour, colour0, colour1, backgroundcolour, textcolour, trackercolour, outlinecolour,
fontcolour, fontcolour0, fontcolour1, latched, identchannel, rotate, alpha, visible, caption, widgetarray, popuptext,
active, svgfile, populate, mode, file, shape, corners, channeltype, align, sliderincr, max, min, textbox', trackerthickness,
linethickness, range, range2, size, pluginid, guirefresh, plant, child, show, middlec, keywidth, scrollbars, fontstyle,
scrubberpos, zoom, displaytype, updaterate, wrap
) where
import Prelude hiding (show, min, max)
import Data.Maybe
import Control.Monad.Trans.Writer.Strict
import Control.Applicative
import Csound.Typed.Gui.Cabbage.CabbageLang
type Cab = Cab' ()
type CabProp = CabProp' ()
newtype Cab' a = Cab' { unCab' :: Writer [Line] a }
deriving (Functor, Applicative, Monad)
runCab :: Cab -> [Line]
runCab = snd . runWriter . unCab'
newtype CabProp' a = CabProp' { unCabProp' :: Writer [Property] a }
deriving (Functor, Applicative, Monad)
runCabProp :: CabProp -> [Property]
runCabProp = snd . runWriter . unCabProp'
widget :: String -> CabProp -> Cab
widget name props = Cab' $ tell [Line name $ runCabProp props]
button, filebutton, infobutton, checkbox, combobox, csoundoutput, encoder, gentable,
hrange, vrange, form, groupbox, image, keyboard, label, hslider, vslider,
rslider, soundfiler, signaldisplay, textbox, texteditor, xypad :: CabProp -> Cab
button = widget "button"
filebutton = widget "filebutton"
infobutton = widget "infobutton"
checkbox = widget "checkbox"
combobox = widget "combobox"
csoundoutput = widget "csoundoutput"
encoder = widget "encoder"
gentable = widget "gentable"
hrange = widget "hrange"
vrange = widget "vrange"
form = widget "form"
groupbox = widget "groupbox"
image = widget "image"
keyboard = widget "keyboard"
label = widget "label"
hslider = widget "hslider"
vslider = widget "vslider"
rslider = widget "rslider"
soundfiler = widget "soundfiler"
signaldisplay = widget "signaldisplay"
textbox = widget "textbox"
texteditor = widget "texteditor"
xypad = widget "xypad"
mkProperty :: String -> [Arg] -> CabProp
mkProperty name args = CabProp' $ tell [Property name args]
data Col = Hash String | Rgb Int Int Int
colProp x = case x of
Hash a -> [StringArg a]
Rgb r g b -> fmap IntArg [r, g, b]
boolProp x = IntArg $ if x then 1 else 0
bounds :: Int -> Int -> Int -> Int -> CabProp
bounds x y w h = mkProperty "bounds" (fmap IntArg [x, y, w, h])
channel :: String -> CabProp
channel name = mkProperty "channel" [StringArg name]
text1 :: String -> CabProp
text1 name = mkProperty "text" [StringArg name]
text2 :: String -> String -> CabProp
text2 name1 name2 = mkProperty "text" [StringArg name1, StringArg name2]
value :: Float -> CabProp
value x = mkProperty "value" [FloatArg x]
colour :: Col -> CabProp
colour col = mkProperty "colour" (colProp col)
colour0 :: Col -> CabProp
colour0 col = mkProperty "colour:0" (colProp col)
colour1 :: Col -> CabProp
colour1 col = mkProperty "colour:1" (colProp col)
backgroundcolour :: Col -> CabProp
backgroundcolour col = mkProperty "backgroundcolour" (colProp col)
textcolour :: Col -> CabProp
textcolour col = mkProperty "textcolour" (colProp col)
trackercolour :: Col -> CabProp
trackercolour col = mkProperty "trackercolour" (colProp col)
outlinecolour :: Col -> CabProp
outlinecolour col = mkProperty "outlinecolour" (colProp col)
fontcolour :: Col -> CabProp
fontcolour col = mkProperty "fontcolour" (colProp col)
fontcolour0 :: Col -> CabProp
fontcolour0 col = mkProperty "fontcolour:0" (colProp col)
fontcolour1 :: Col -> CabProp
fontcolour1 col = mkProperty "fontcolour:1" (colProp col)
latched :: Bool -> CabProp
latched b = mkProperty "latched" [boolProp b]
identchannel :: String -> CabProp
identchannel s = mkProperty "identchannel" [StringArg s]
rotate :: Float -> Float -> Float -> CabProp
rotate radians pivotx pivoty = mkProperty "rotate" $ fmap FloatArg [radians, pivotx, pivoty]
alpha :: Float -> CabProp
alpha a = mkProperty "alpha" [FloatArg a]
visible :: Bool -> CabProp
visible a = mkProperty "visible" [boolProp a]
caption :: String -> CabProp
caption a = mkProperty "caption" [StringArg a]
widgetarray :: String -> Int -> CabProp
widgetarray name n = mkProperty "widgetarray" [StringArg name, IntArg n]
popuptext :: String -> CabProp
popuptext a = mkProperty "popuptext" [StringArg a]
active :: Bool -> CabProp
active a = mkProperty "active" [boolProp a]
svgfile :: String -> String -> CabProp
svgfile ty file = mkProperty "svgfile" (fmap StringArg [ty, file])
populate :: String -> String -> CabProp
populate filetype dir = mkProperty "populate" (fmap StringArg [filetype, dir])
mode :: String -> CabProp
mode a = mkProperty "mode" [StringArg a]
file :: String -> CabProp
file a = mkProperty "file" [StringArg a]
shape :: String -> CabProp
shape a = mkProperty "shape" [StringArg a]
corners :: Float -> CabProp
corners a = mkProperty "corners" [FloatArg a]
channeltype :: String -> CabProp
channeltype a = mkProperty "channeltype" [StringArg a]
align :: String -> CabProp
align a = mkProperty "align" [StringArg a]
sliderincr :: Float -> CabProp
sliderincr a = mkProperty "sliderincr" [FloatArg a]
max :: Float -> CabProp
max a = mkProperty "max" [FloatArg a]
min :: Float -> CabProp
min a = mkProperty "min" [FloatArg a]
textbox' :: Bool -> CabProp
textbox' a = mkProperty "textbox" [boolProp a]
trackerthickness :: Float -> CabProp
trackerthickness a = mkProperty "trackerthickness" [FloatArg a]
linethickness :: Float -> CabProp
linethickness a = mkProperty "linethickness" [FloatArg a]
range :: Float -> Float -> (Float, Float) -> CabProp
range min max value = range2 min max value Nothing Nothing
range2 :: Float -> Float -> (Float, Float) -> Maybe Float -> Maybe Float -> CabProp
range2 min max value mskew mincr = mkProperty "range" $ catMaybes [Just $ FloatArg min, Just $ FloatArg max, Just $ (uncurry ColonArg) value, fmap FloatArg mskew, fmap FloatArg mincr]
size :: Int -> Int -> CabProp
size w h = mkProperty "size" (fmap IntArg [w, h])
pluginid :: String -> CabProp
pluginid a = mkProperty "pluginid" [StringArg a]
guirefresh :: Int -> CabProp
guirefresh a = mkProperty "guirefresh" [IntArg a]
plant :: String -> CabProp
plant a = mkProperty "plant" [StringArg a]
child :: Bool -> CabProp
child a = mkProperty "child" [boolProp a]
show :: Bool -> CabProp
show a = mkProperty "show" [boolProp a]
middlec :: Int -> CabProp
middlec a = mkProperty "middlec" [IntArg a]
keywidth :: Int -> CabProp
keywidth a = mkProperty "keywidth" [IntArg a]
scrollbars :: Bool -> CabProp
scrollbars a = mkProperty "scrollbars" [boolProp a]
fontstyle :: String -> CabProp
fontstyle a = mkProperty "fontstyle" [StringArg a]
scrubberpos :: Int -> CabProp
scrubberpos a = mkProperty "scrubberpos" [IntArg a]
zoom :: Float -> CabProp
zoom a = mkProperty "zoom" [FloatArg a]
displaytype :: String -> CabProp
displaytype a = mkProperty "displaytype" [StringArg a]
updaterate :: Int -> CabProp
updaterate a = mkProperty "updaterate" [IntArg a]
wrap :: Bool -> CabProp
wrap a = mkProperty "wrap" [boolProp a]