How to paint a arbitrary window with Xmonad? - xmonad

{-# OPTIONS -Wno-unused-imports #-}
{-# OPTIONS -Wno-type-defaults #-}
module MyDraw where
import XMonad.Util.XUtils
import XMonad
import XMonad.Config.Prime
import XMonad.Util.Font
doStuff :: X ()
doStuff = do
let myRec = Rectangle 100 100 300 300
w <- createNewWindow myRec Nothing "blue" True
fs <- initXMF "xft:Droid Sans Mono for Powerline.otf: Droid Sans Mono for Powerline:style=Regular:size=32"
paintAndWrite w fs (fromIntegral 120) (fromIntegral 120) (fromIntegral 10)
"green" "blue" "black" "white" [AlignCenter, AlignCenter] ["Testing", "123"]
I'm trying to paint an arbitrary window using Xmonad, I'm using the above code, though it doesn't seem to do anything? How can I debug this further?
I'm invoking the above code with a keybinding. I'm fairly certain it's running as I have some print code running successfully after it. In other words:
doStuff
liftIO $ logToTmpFile "done"

I needed to showWindow w:
doStuff :: X ()
doStuff = do
let myRec = Rectangle 100 100 300 300
w <- createNewWindow myRec Nothing "blue" True
showWindow w
fs <- initXMF "xft:Droid Sans Mono for Powerline.otf: Droid Sans Mono for Powerline:style=Regular:size=32"
paintAndWrite w fs (fromIntegral 120) (fromIntegral 120) (fromIntegral 10)
"green" "blue" "black" "white" [AlignCenter, AlignCenter] ["Testing", "123"]

Related

How to adjust transparency and color of a Haskell GNUPlot

this is somewhat of a two part question.
I am trying to adjust the colour of a plot, using Haskell GNUPlot:
https://hackage.haskell.org/package/gnuplot
The code I have so far is:
import qualified Graphics.Gnuplot.Frame as Frame
import qualified Graphics.Gnuplot.Frame.OptionSet as Opts
import qualified Graphics.Gnuplot.Plot.TwoDimensional as Plot2D
import qualified Graphics.Gnuplot.Graph.TwoDimensional as Graph2D
import qualified Graphics.Gnuplot.Advanced as GP
import qualified Graphics.Gnuplot.LineSpecification as LineSpec
import qualified Graphics.Gnuplot.ColorSpecification as Color
test :: [(Double, Double, Double)] -> Frame.T (Graph2D.T Double Double)
test input =
let x = [a | (a,b,c) <- input]
lower = [b | (a,b,c) <- input]
upper = [c | (a,b,c) <- input]
inputTuple = zip x (zip lower upper)
lineSpec =
Graph2D.lineSpec $
LineSpec.title "runtimes" $
LineSpec.lineWidth 2.5 $
LineSpec.lineColor (Color.rgb 0 0 1) $
LineSpec.deflt
frameOpts =
Opts.xLabel "input size" $
Opts.yLabel "runtime (ms)" $
Opts.title ("Graph from ") $
Opts.deflt
in Frame.cons frameOpts $ fmap lineSpec $
Plot2D.list Graph2D.filledStripe inputTuple
Specifically for
LineSpec.lineColor (Color.rgb 0 0 0), this is of type Color.T but for some reason, whenever I try to run this code:
GP.plotDefault test (zip3 [1,2,3] [1,2,3] [2,3,4])
, it doesn't show anything.
However, if I switch this code to
LineSpec.lineColor (Color.blue) for example, then the code returns the wanted plot. However, Color.blue is also of type Color.T, so I am not sure as to why this works, but Color.rgb 0 0 0 doesn't...
Also, is it possible to make the plot colour transparent?
I know that it is possible for Gnuplot.Simple. but I have no managed to figure out how it is possible in Gnuplot.Advanced?

RGB Terminal Colors with Haskell and Brick

I know that the Brick and the VTY hackage do not support escape sequences. VTY only supports 240 colors.
Is there any workaround to use true RGB colors and not mess up the layout?
This is an example I made, but I can't get the border right:
module BrickTest where
import Brick (simpleMain, Widget, str)
import Brick.Widgets.Border (border)
import Text.Printf (printf)
main :: IO ()
main = simpleMain $ colorWidget (255, 0, 0)
type RGB = (Int, Int, Int)
colorWidget :: RGB -> Widget ()
colorWidget (r, g, b) = border $ str (prefix ++ "a" ++ postfix)
where
prefix = printf "\ESC[38;2;%d;%d;%dm" r g b
postfix = "\ESC[0m"
output:
┌──────────────────┐
│a│
└──────────────────┘
I found a workaround. I managed to implement a function zeroWidthStr that can print any string, and Brick handles it as if it has width 0. But I can't really explain how this is working internally, and it might have some other side effects.
module BrickTest where
import Brick (Widget, raw, simpleMain, str,
(<+>))
import Brick.Widgets.Border (border)
import Data.List (intercalate)
import Data.Text.Lazy (pack)
import Graphics.Vty (defAttr)
import Graphics.Vty.Image.Internal (Image (HorizText))
import Text.Printf (printf)
main :: IO ()
main = simpleMain $ colorWidget (255, 0, 0)
type RGB = (Int, Int, Int)
colorWidget :: RGB -> Widget ()
colorWidget (r, g, b) = border $ prefix <+> str "a" <+> postfix
where
prefix = zeroWidthStr $ printf "\ESC[38;2;%d;%d;%dm" r g b
postfix = zeroWidthStr $ "\ESC[0m"
zeroWidthStr :: String -> Widget ()
-- | workaround to print any string in terminal, and hackage Brick (vty) handles it as if it has width 0
zeroWidthStr str = raw image
where
image = HorizText defAttr (pack modStr) 0 0
modStr = str ++ repeatN "\ESC\ESCa" (length str)
repeatN :: String -> Int -> String
repeatN str n = intercalate "" $ take n $ repeat str
output:

Shininess with Haskell Opengl

I have done numerous graphics with Haskell OpenGL. They are in my repo here: opengl-examples (the gallery is not exhaustive). However I have a problem: when I use materialShininess nothing happens. It there something to enable in order to have the shininess ?
Here is an example of one of my prog. It it not complete but I hope it's enough to identify the issue.
module CompoundFiveTetrahedra2
where
import CompoundFiveTetrahedra.Data
import Control.Monad (when)
import qualified Data.ByteString as B
import Data.IORef
import Graphics.Rendering.OpenGL.Capture (capturePPM)
import Graphics.Rendering.OpenGL.GL
import Graphics.UI.GLUT
import Text.Printf
import Utils.ConvertPPM
import Utils.OpenGL (negateNormal)
import Utils.Prism
blue,red,green,yellow,purple,white,black :: Color4 GLfloat
blue = Color4 0 0 1 1
red = Color4 1 0 0 1
green = Color4 0 1 0 1
yellow = Color4 1 1 0 1
white = Color4 1 1 1 1
black = Color4 0 0 0 1
purple = Color4 0.5 0 0.5 1
display :: IORef GLfloat -> IORef GLfloat -> IORef GLfloat -> IORef GLdouble
-> IORef GLint -> IORef GLfloat -> DisplayCallback
display rot1 rot2 rot3 zoom capture angle = do
clear [ColorBuffer, DepthBuffer]
r1 <- get rot1
r2 <- get rot2
r3 <- get rot3
z <- get zoom
a <- get angle
i <- get capture
loadIdentity
(_, size) <- get viewport
resize z size
rotate a $ Vector3 1 1 1
rotate r1 $ Vector3 1 0 0
rotate r2 $ Vector3 0 1 0
rotate r3 $ Vector3 0 0 1
mapM_ (drawEdge blue) (edges!!0)
mapM_ (drawEdge red) (edges!!1)
mapM_ (drawEdge green) (edges!!2)
mapM_ (drawEdge yellow) (edges!!3)
mapM_ (drawEdge purple) (edges!!4)
mapM_ (drawVertex blue) vertices1
mapM_ (drawVertex red) vertices2
mapM_ (drawVertex green) vertices3
mapM_ (drawVertex yellow) vertices4
mapM_ (drawVertex purple) vertices5
when (i > 0) $ do
let ppm = printf "tetrahedra%04d.ppm" i
png = printf "tetrahedra%04d.png" i
(>>=) capturePPM (B.writeFile ppm)
convert ppm png True
capture $~! (+1)
swapBuffers
drawVertex :: Color4 GLfloat -> Vertex3 GLfloat -> IO ()
drawVertex col v =
preservingMatrix $ do
translate $ toVector v
materialDiffuse Front $= col
renderObject Solid $ Sphere' 0.03 30 30
where
toVector (Vertex3 x y z) = Vector3 x y z
drawEdge :: Color4 GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawEdge col (v1,v2) = do
let cylinder = prism v1 v2 30 0.03
renderPrimitive Quads $ do
materialDiffuse Front $= col
mapM_ drawQuad cylinder
where
drawQuad ((w1,w2,w3,w4),n) = do
normal $ negateNormal n
vertex w1
vertex w2
vertex w3
vertex w4
resize :: Double -> Size -> IO ()
resize zoom s#(Size w h) = do
viewport $= (Position 0 0, s)
matrixMode $= Projection
loadIdentity
perspective 45.0 (w'/h') 1.0 100.0
lookAt (Vertex3 0 0 (-3 + zoom)) (Vertex3 0 0 0) (Vector3 0 1 0)
matrixMode $= Modelview 0
where
w' = realToFrac w
h' = realToFrac h
keyboard :: IORef GLfloat -> IORef GLfloat -> IORef GLfloat -> IORef GLint
-> KeyboardCallback
keyboard rot1 rot2 rot3 capture c _ =
case c of
'r' -> rot1 $~! subtract 1
't' -> rot1 $~! (+1)
'f' -> rot2 $~! subtract 1
'g' -> rot2 $~! (+1)
'v' -> rot3 $~! subtract 1
'b' -> rot3 $~! (+1)
'c' -> capture $~! (+1)
'q' -> leaveMainLoop
_ -> return ()
mouse :: IORef GLdouble -> MouseCallback
mouse zoom button keyState _ =
case (button, keyState) of
(LeftButton, Down) -> zoom $~! (+0.1)
(RightButton, Down) -> zoom $~! subtract 0.1
_ -> return ()
idle :: IORef GLfloat -> IdleCallback
idle angle = do
angle $~! (+ 2)
postRedisplay Nothing
main :: IO ()
main = do
_ <- getArgsAndInitialize
_ <- createWindow "Five tetrahedra"
initialDisplayMode $= [RGBAMode, DoubleBuffered, WithDepthBuffer]
clearColor $= black
materialAmbient Front $= black
materialShininess Front $= 80 -- THIS DOES NOT WORK
lighting $= Enabled
light (Light 0) $= Enabled
position (Light 0) $= Vertex4 0 0 (-100) 1
ambient (Light 0) $= white
diffuse (Light 0) $= white
specular (Light 0) $= white
depthFunc $= Just Lequal
depthMask $= Enabled
shadeModel $= Smooth
rot1 <- newIORef 0.0
rot2 <- newIORef 0.0
rot3 <- newIORef 0.0
zoom <- newIORef 0.0
capture <- newIORef 0
angle <- newIORef 0.0
displayCallback $= display rot1 rot2 rot3 zoom capture angle
reshapeCallback $= Just (resize 0)
keyboardCallback $= Just (keyboard rot1 rot2 rot3 capture)
mouseCallback $= Just (mouse zoom)
idleCallback $= Just (idle angle)
mainLoop
Do I miss something to enable the shininess ?
EDIT
Here is an example with the R package rgl, which is also a wrapper to OpenGL. Look at the white part on the spheres. I cannot achieve that with Haskell.
Update: Try shininess of 1.0 to see the difference more clearly at low resolutions.
The shininess parameter affects the sharpness of specular lighting, so you need to turn this type of lighting on for your materials by giving them a specular color. (By default, the specular color is black, so the effect of the shininess parameter will not be visible.) You'll also want to reduce the shininess value for this scene, because it's too high to be very visible.
Try:
materialSpecular Front $= white
materialShininess Front $= 1.0
and you'll start to see white highlights, particularly along the curved edges of your shape. The flat faces will also reflect some white light, but only when they are nearly perpendicular to a line that's mid-angle between the viewer and the light source -- it's a little complicated.
Note that the specular color of most materials is taken to be some "multiple" of white (i.e., somewhere between black for a perfectly dull material to white for the shiniest materials in the scene). The only materials with tinted specular color would be colored metals, like gold or bronze.
Some additional notes:
You're using old-style OpenGL 2.1 shading, not "modern OpenGL", so you don't have to worry so much about the "shaders" that #user2297560 is talking about. OpenGL 2.1 comes with built-in shaders to do basic shading; with modern OpenGL, you have to build everything from scratch.
As #luqui mentioned, if you're looking for materials that actually reflect other parts of the scenes, this kind of shininess won't help you.
Here is the difference. Your original code on the left, the settings above on the right, on your "compoundfivetetrahedra" example. It'll look better if you increase the size of the window.
Note that it works better on curved surfaces. Here's your cylinder example, using:
materialShininess Front $= 5
materialSpecular Front $= white
You can see the shininess on the closer sphere.

gtk : combo of pictures in a treeview

I'm trying to make a combo box of pictures (as bellow) inside a treeview cell to make a selection.
I tried to use a cellRendererComboNew to render the combo but the options to fill the combobox cellComboTextModel := work only for String and I can't render pictures.
I tried to use a cellRendererPixbufNew. It render images but I can't perform a selection on it.
What is the correct approach to make that?
An example in Haskell, Python, or in any language would be very helpfull.
Best regards.
In PyGobject I came up with this solution. The example is fully functional but requires 2 png files in the same directory. I used two pngs with 100 x 20 pixel format.
The previous example used Gtk.ComboBox.new_with_model_and_entry() and I was missing the set_entry_text_colum() function that has to go with such kind of combobox.
#!/usr/bin/python3
from gi.repository import Gtk, Gdk, GdkPixbuf
class ComboBoxWindow(Gtk.Window):
def __init__(self):
Gtk.Window.__init__(self, title="ComboBox Pixbuf Example")
self.set_border_width(10)
store = Gtk.ListStore(str, GdkPixbuf.Pixbuf)
solid_line = GdkPixbuf.Pixbuf.new_from_file("solid_line.png")
store.append(["1", solid_line])
dashed_line = GdkPixbuf.Pixbuf.new_from_file("dashed_line.png")
store.append(["2", dashed_line])
vbox = Gtk.Box(orientation=Gtk.Orientation.VERTICAL, spacing=6)
combo = Gtk.ComboBox.new_with_model(store)
rend_int = Gtk.CellRendererText()
rend_pixbuf = Gtk.CellRendererPixbuf()
combo.pack_start(rend_int, False)
combo.add_attribute(rend_int, "text", 0)
combo.pack_start(rend_pixbuf, True)
combo.add_attribute(rend_pixbuf, "pixbuf", 1)
combo.connect("changed", self.on_combo_changed)
vbox.pack_start(combo, False, False, 0)
self.add(vbox)
def on_combo_changed(self, combo):
tree_iter = combo.get_active_iter()
if tree_iter != None:
model = combo.get_model()
row = model[tree_iter][0]
print("Selected row {0}".format(row))
win = ComboBoxWindow()
win.connect("delete-event", Gtk.main_quit)
win.show_all()
Gtk.main()
Similar question:
Show icon or color in Gtk TreeView tree
Source:
http://python-gtk-3-tutorial.readthedocs.org/en/latest/combobox.html
This is my solution in Haskell:
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Data.String
import Graphics.UI.Gtk
import qualified Data.Map as Map
import qualified Data.Text as T
import Data.Maybe
import qualified Graphics.UI.Gtk.Gdk.Pixbuf as Pixbuf
import Control.Monad
colorsRawL = [(0,0,0),(254,26,89),(255,0,0),(0,255,0),(0,0,255),(255,255,0),(0,255,255),(255,0,255),(192,192,192),(128,128,128),(128,0,0),(128,128,0),(0,128,0),(128,0,128),(0,128,128),(0,0,128)]
manufacturers = [("Sony"::String), ("LG"::String), ("Panasonic"::String), ("Toshiba"::String), ("Nokia"::String), ("Samsung"::String)]
data ListElement = ListElement { name :: String , selected::Pixbuf }
getManufacturers::IO[ListElement]
getManufacturers = mapM (\x -> do
pbn <- Pixbuf.pixbufNew ColorspaceRgb False 8 16 16
Pixbuf.pixbufFill pbn 255 255 255 1
let el = ListElement x pbn
return el
) manufacturers
pixBufListS::IO [(String,Pixbuf)]
pixBufListS = mapM (\(r,g,b)-> do
pbn <- Pixbuf.pixbufNew ColorspaceRgb False 8 16 16
Pixbuf.pixbufFill pbn r g b 1
let name::String = ("Color ("++(show r)++" "++(show g)++" "++(show b)++ ")")
return (name,pbn)
) colorsRawL
getMap::IO (Map.Map String Pixbuf)
getMap = do
list <- pixBufListS
let mp = Map.fromList list
return mp
main :: IO ()
main = do
initGUI
window <- windowNew
fixed <- fixedNew
pixList <-pixBufListS
manus <- getManufacturers
lststoreManus::(ListStore ListElement) <- listStoreNew manus
treeview <- treeViewNew
treeViewSetModel treeview lststoreManus
treeViewSetHeadersVisible treeview True
colName <- treeViewColumnNew
imgCol <- treeViewColumnNew
colCombo <- treeViewColumnNew
treeViewColumnSetTitle imgCol ("Image column"::T.Text )
treeViewColumnSetTitle colName ("String column"::T.Text )
treeViewColumnSetTitle colCombo ("Combo"::T.Text )
iconRenderer <- cellRendererPixbufNew
renderer1 <- cellRendererTextNew
comboRenderer <- cellRendererComboNew
cellLayoutPackStart imgCol iconRenderer True
cellLayoutPackStart colName renderer1 True
cellLayoutPackStart colCombo comboRenderer True
cellLayoutSetAttributes imgCol iconRenderer lststoreManus $ (\ListElement { selected = t } -> [cellPixbuf := t])
cellLayoutSetAttributes colName renderer1 lststoreManus $ \row -> [ cellText := name row ]
cellLayoutSetAttributeFunc colCombo comboRenderer lststoreManus $
(\iter -> do (tmodel, colid) <- comboTextModel
(ListElement a b) <- treeModelGetRow lststoreManus iter
set comboRenderer [ cellVisible := True
, cellComboTextModel := (tmodel, colid)
, cellTextEditable := True
, cellComboHasEntry := False
, cellText := ("Choose pixbuf"::String)])
treeViewAppendColumn treeview colName
treeViewAppendColumn treeview imgCol
treeViewAppendColumn treeview colCombo
_ <- on comboRenderer editingStarted $ \widget treepath -> do
case treepath of
[k] -> do
let comboPix::ComboBox = castToComboBox widget
lststorerep::(ListStore (String,Pixbuf)) <- listStoreNew pixList
customStoreSetColumn lststorerep (makeColumnIdString 0) fst
customStoreSetColumn lststorerep (makeColumnIdPixbuf 1) snd
comboBoxSetModel comboPix (Just lststorerep)
rendertxt <- cellRendererTextNew
renderpic <- cellRendererPixbufNew
cellLayoutPackStart comboPix rendertxt False
cellLayoutPackStart comboPix renderpic True
cellLayoutAddColumnAttribute comboPix renderpic cellPixbuf $ makeColumnIdPixbuf 1
_ <- on comboRenderer edited $ \_treePath newStringValue -> do
case _treePath of
[k] -> do
(ListElement a b) <- listStoreGetValue lststoreManus k
myMap <- getMap
let finded = fromJust ( Map.lookup newStringValue myMap )
let toStore = ListElement a finded
listStoreSetValue lststoreManus k toStore
putStrLn $ "new value: " ++ newStringValue
fixedPut fixed treeview (10,10)
widgetSetSizeRequest treeview 500 100
containerAdd window fixed
onDestroy window mainQuit
windowSetDefaultSize window 600 500
windowSetPosition window WinPosCenter
widgetShowAll window
mainGUI
comboTextModel = do store <- listStoreNew []
let column = makeColumnIdString 0 :: ColumnId String String
return (store, column)
{-
dependencies :
- base >= 4.7 && < 5
- gtk
- text
- containers
-}

Drawing concurrently in multiple windows with GLUT

When I create two windows and redraw them in two different threads (one per window), it seems like all drawing goes to first created window. It constantly switches between what should be displayed in both windows. And second one remains mostly black.
The code was working well with only one window, and then I updated it - inserted currentWindow $= Just glWindow in the beginning of the functions which set callbacks and call rendering methods.
What do you think is the cause of the problems?
EDIT:
Code skeleton:
module Chart.Window where
import Graphics.UI.GLUT hiding (Window, postRedisplay, <etc>)
import qualified Graphics.UI.GLUT as GLUT
import qualified Graphics.Rendering.OpenGL as GL
data Window = Window
{ glWindow :: GLUT.Window
, viewListRef :: IORef [Line]
}
main = do
forkOS start <params1>
forkOS start <params2>
start <params> = do
win <- new <params>
run win
mainLoop
new :: Strict -> (Int, Int) -> (Int, Int) -> IO Window
new name (posx, posy) (w, h) = do
initGLUT
glWindow <- createWindow name
currentWindow $= Just glWindow
windowSize $= Size (fromIntegral w) (fromIntegral h)
windowPosition $= Position (fromIntegral posx) (fromIntegral posy)
return Window {..}
initGLUT :: IO ()
initGLUT = do
beenInit <- get initState
unless beenInit $ void getArgsAndInitialize
initialDisplayMode $= [WithDepthBuffer, DoubleBuffered, RGBAMode]
initialWindowSize $= Size 100 100
initialWindowPosition $= Position 100 100
actionOnWindowClose $= ContinueExectuion
run :: Window -> IO ()
run win#Window{..} = do
-- this will fork (with forkIO) threads
-- which will call "repaint" when chart needs to be updated
initListeners repaint
initCallbacks win
where
repaint :: [Line] -> IO ()
repaint viewList = do
writeIORef viewListRef viewList
postRedisplay win
postRedisplay Window{..} = GLUT.postRedisplay $ Just glWindow
initCallbacks win#Window{..} = do
currentWindow $= Just glWindow
GLUT.displayCallback $= display win
GLUT.idleCallback $= Just (postRedisplay win)
display Window{..} = do
currentWindow $= Just glWindow
Size w h <- get windowSize
viewList <- readIORef viewListRef
drawChart viewList otherOptions
reshapeCallback :: Window -> GLUT.ReshapeCallback
reshapeCallback win#Window{..} size#(Size w h) = do
currentWindow $= Just glWindow
GL.viewport $= (Position 0 0, size)
GL.matrixMode $= GL.Projection
GL.loadIdentity
GL.ortho2D 0 (fromIntegral w) 0 (fromIntegral h)
GL.matrixMode $= GL.Modelview 0
GL.loadIdentity
... -- send command for listener thread to change internal state and postRedisplay
drawChart viewList otherOptions = do
...
-- chart consists of several horizontal panels. Call this for each panel:
glViewport 0 panelYPosition width winHeight
glScissor 0 panelYPosition (fromIntegral width) (fromIntegral panelHeight)
GL.clear [GL.ColorBuffer]
...
-- and then for each line=(Vertex2 v1 v2) from viewList
GL.renderPrimitive GL.Lines $ do
GL.vertex v1
GL.vertex v2
...
BTW, when I commented the line which sets reshapeCallback (and window is reshaped at the beginning) and launched charting with only one window, I got exactly the same effect as in multi-window launch. I mean, the (only) window was mostly empty as if it was secondly created.
I had a similar problem. I work with a thread that calculates the iterations of a genetic algorithm and in each iteration I call to "GL.postRedisplay (Just window)" but it didn't draw anything.
I solved my problem by calling "GL.postRedisplay (Just window)" from the idle function:
idle window = CC.threadDelay (1000*500) >> GL.postRedisplay (Just window)
Don't forget to setup your idle callback function like this:
GL.idleCallback GL.$= Just (idle window) >>
CC and GL mean:
import qualified Control.Concurrent as CC
import qualified Graphics.UI.GLUT as GL

Resources