Clickable workspaces - haskell

I'm using XMonad in combination with two xmobar instances, and I'm using IndependentScreens because I have a dual monitor setup. I'm having an issue with clickable workspaces ever since I introduced the second monitor. The thing is, IndependentScreens labels workspaces as 0_1, 1_1, 0_2, 1_2, ..., and the code I had worked only based on WorkspaceId, not ScreenId. I've compiled xmonad and xmonad-contrib from source so that I can use XMonad.Util.ClickableWorkspaces, however, the documentation is obscure and I couldn't find an example of proper usage anywhere. I've tried various things not worth mentioning, IMO.
This is my config:
import System.IO
import XMonad
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ServerMode
import XMonad.Hooks.SetWMName
import XMonad.Layout.IndependentScreens
import XMonad.Layout.Gaps
import XMonad.Layout.Spacing
import XMonad.Util.EZConfig (additionalKeysP)
import XMonad.Util.Run (spawnPipe)
import Data.Ord
import qualified XMonad.StackSet as W
import qualified Data.Map as M
import XMonad.Util.WorkspaceCompare
import XMonad.Util.ClickableWorkspaces
myLayout = gaps [(U, 10), (R, 10), (L, 10), (D, 10)] $ spacingRaw True (Border 0 10 10 10) True (Border 10 10 10 10) True $
layoutHook def
myWorkspaces =
[ (xK_1, "1")
, (xK_2, "2")
, (xK_3, "3")
, (xK_4, "4")
, (xK_5, "5")
, (xK_6, "6")
, (xK_7, "7")
, (xK_8, "8")
, (xK_9, "9")
, (xK_0, "10")
, (xK_minus, "11")
, (xK_equal, "12")
]
myKeys conf#(XConfig {XMonad.modMask = modMask}) = M.fromList $
[ ((modMask, key), windows $ onCurrentScreen W.greedyView ws)
| (key, ws) <- myWorkspaces
]
++
[ ((modMask .|. shiftMask, key), windows $ onCurrentScreen W.shift ws)
| (key, ws) <- myWorkspaces
]
++
[
-- Spawn the terminal
((modMask .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf)
-- Spawn dmenu
, ((modMask, xK_p), spawn "dmenu_run")
-- Close focused window
, ((modMask .|. shiftMask, xK_c), kill)
-- Rotate through the available layout algorithms
, ((modMask, xK_space ), sendMessage NextLayout)
-- Reset the layouts on the current workspace to default
, ((modMask .|. shiftMask, xK_space), setLayout $ XMonad.layoutHook conf)
-- Resize viewed windows to the correct size
, ((modMask, xK_n), refresh)
-- Move focus to the next window
, ((modMask, xK_Tab), windows W.focusDown)
-- Move focus to the next window
, ((modMask, xK_j), windows W.focusDown)
-- Move focus to the previous window
, ((modMask, xK_k), windows W.focusUp)
-- Move focus to the master window
, ((modMask, xK_m), windows W.focusMaster)
-- Swap the focused window and the master window
, ((modMask, xK_Return), windows W.swapMaster)
-- Swap the focused window with the next window
, ((modMask .|. shiftMask, xK_j), windows W.swapDown)
-- Swap the focused window with the previous window
, ((modMask .|. shiftMask, xK_k), windows W.swapUp)
-- Shrink the master area
, ((modMask, xK_h), sendMessage Shrink)
-- Expand the master area
, ((modMask, xK_l), sendMessage Expand)
-- Push window back into tiling
, ((modMask, xK_t), withFocused $ windows . W.sink)
-- Increment the number of windows in the master area
, ((modMask, xK_comma), sendMessage (IncMasterN 1))
-- Deincrement the number of windows in the master area
, ((modMask, xK_period), sendMessage (IncMasterN (-1)))
-- toggle the status bar gap
, ((modMask, xK_b), sendMessage ToggleStruts)
-- Restart xmonad
, ((modMask, xK_q), broadcastMessage ReleaseResources >> restart "xmonad" True)
]
myAdditionalKeysP =
[
("M-<F2>", spawn "thunar")
, ("M-<F3>", spawn "firefox")
, ("M-<F4>", spawn "code")
, ("M-<F5>", spawn "thunderbird")
, ("M-<Escape>", spawn "xfce4-appfinder")
, ("M4-<Print>", spawn "xfce4-screenshooter")
, ("M4-<KP_Add>", spawn "amixer -D pulse sset Master 5%+")
, ("M4-<KP_Subtract>", spawn "amixer -D pulse sset Master 5%-")
, ("M-C-p", spawn "passmenu")
, ("M-C-c", spawn "clipmenu")
, ("M-C-m", spawn "mailwatch_restart")
, ("M-C-x", spawn "xfce4-panel -r")
, ("M-C-<Left>", spawn "playerctl previous")
, ("M-C-<Right>", spawn "playerctl next")
, ("M-C-<Space>", spawn "playerctl play-pause")
]
clickable' :: WorkspaceId -> String
clickable' w = xmobarAction ("xmonadctl view\\\"" ++ w ++ "\\\"") "1" w
compareNumbers = comparing (read :: String -> Int)
pp h s = marshallPP s def
{ ppOutput = hPutStrLn h
, ppCurrent = xmobarColor "blue" "" . wrap "[" "]"
, ppHiddenNoWindows = xmobarColor "grey" "" . clickable'
, ppVisible = wrap "(" ")"
, ppUrgent = xmobarColor "red" "yellow"
, ppOrder = \(ws:_:_:_) -> [pad ws]
, ppHidden = clickable'
, ppSort = mkWsSort $ return compareNumbers
}
main = do
xmprocs <- mapM (\i -> spawnPipe $ "xmobar ~/.config/xmobar/xmobarrc-" ++ show i ++ " -x" ++ show i) [0..1]
xmonad $ docks def
{
workspaces = withScreens 2 (map show [1..12])
, keys = myKeys
, borderWidth = 2
, focusedBorderColor = "#226fa5"
, normalBorderColor = "#191919"
, handleEventHook = serverModeEventHookCmd
<+> serverModeEventHook
<+> serverModeEventHookF "XMONAD_PRINT" (io . putStrLn)
, layoutHook = avoidStruts myLayout
, logHook = mapM_ dynamicLogWithPP $ zipWith pp xmprocs [0..1]
, startupHook = setWMName "LG3D"
, manageHook = manageDocks
} `additionalKeysP` myAdditionalKeysP
How can I properly use clickablePP with my setup, or whatever is needed to make the workspaces clickable?

This guy has this in his xmonad.hs
myClickableWorkspaces :: [String]
myClickableWorkspaces = clickable . (map xmobarEscape)
-- $ [" 1 ", " 2 ", " 3 ", " 4 ", " 5 ", " 6 ", " 7 ", " 8 ", " 9 "]
$ [" dev ", " www ", " sys ", " doc ", " vbox ", " chat ", " mus ", " vid ", " gfx "]
where
clickable l = [ "<action=xdotool key super+" ++ show (n) ++ ">" ++ ws ++ "</action>" |
(i,ws) <- zip [1..9] l,
let n = i ]
and in his xmobarrc
, commands = [
...
-- The workspaces are 'clickable' in my configs.
, Run UnsafeStdinReader
]
, template = " <action=`xdotool key control+alt+g`>...
and it looks that works, at least for him. You'll need 'xdotool' to make this work, in arch you can find it in the community repo, or clone it from here.

Something like this should work, I think:
clickable' :: ScreenId -> VirtualWorkspace -> String
clickable' s w = xmobarAction ("xmonadctl view\\\"" ++ marshall s w ++ "\\\"") "1" w
pp h s = marshallPP s def
{ ppHiddenNoWindows = xmobarColor "grey" "" . clickable' s
, -- and the other stuff
}
I haven't tested it, though...

Related

Move and resize XMonad window - RationalRect call compiler error

to send the focused window to the center of the screen I have the following configuration
main = do
xmonad $ docks def
{ manageHook = myManageHook <+> manageHook def
, layoutHook = avoidStruts $ layoutHook def
, logHook = dynamicLogWithPP xmobarPP
, terminal = myTerminal
} `additionalKeys`
[ ((myModkey , xK_space), spawn myTerminal )
, ((myModkey , xK_0), withFocused (keysMoveWindowTo (512,384) (0, 0)))
]
I would remove the call to keysMoveWindowTo because it does not allow to set the window size (...) but only specify dx and dy; than I would like to use:
((myModkey , xK_0), withFocused (doRectFloat (RationalRect (1 % 4) (1 % 4) (1 % 2) (1 % 2))))
but the compiler says:
xmonad.hs:87:58: error:
Data constructor not in scope:
RationalRect
:: Ratio a0
87 |, ((myModkey , xK_0), withFocused (doRectFloat (RationalRect (1 % 4) (1 % 4) (1 % 2) (1 % 2))))
What is the correct way to bind keys with doRectFloat function?
Thanks
Nello
doRectFloat does not provide an X operation needed by withFocused.
Enhancing your previous solution, you could add keysResizeWindow to do the resizing, e.g.
, ((myModkey , xK_0), withFocused (
keysMoveWindowTo (512,384) (1%2, 1%2) >> keysResizeWindow (512, 384) (1%2, 1%2)
))

xmonad NamedScratchpad not working as expected

I added NamedScratchpad configs but calling the scratchpad with key bindings is not displaying workspace and the syslog shows
Aug 28 20:20:52 username /usr/libexec/gdm-x-session[2206]: Prelude.head: empty list
my xmonad configs are:
myScratchPads :: [NamedScratchpad]
myScratchPads = [ NS "terminal" spawnTerm findTerm manageTerm
, NS "mocp" spawnMocp findMocp manageMocp
, NS "qalculate-qt" spawnCalc findCalc manageCalc
]
where
spawnTerm = myTerminal ++ " -n scratchpad"
findTerm = resource =? "scratchpad"
manageTerm = customFloating $ W.RationalRect l t w h
where
h = 0.9
w = 0.9
t = 0.95 -h
l = 0.95 -w
spawnMocp = myTerminal ++ " -n mocp 'mocp'"
findMocp = resource =? "mocp"
manageMocp = customFloating $ W.RationalRect l t w h
where
h = 0.9
w = 0.9
t = 0.95 -h
l = 0.95 -w
-- spawnCalc = "qalculate-gtk"
spawnCalc = "qalculate-qt"
-- findCalc = className =? "Qalculate-gtk"
findCalc = className =? "qalculate-qt"
manageCalc = customFloating $ W.RationalRect l t w h
where
h = 0.5
w = 0.4
t = 0.75 -h
l = 0.70 -w
myManageHook :: XMonad.Query (Data.Monoid.Endo WindowSet)
myManageHook =
def
<+> manageSmart
<+> manageDialog
<+> manageScratchPad
<+> manageWindows
where
manageSmart = placeHook simpleSmart
manageDialog = composeOne [ isDialog -?> doCenterFloat ]
manageScratchPad = namedScratchpadManageHook myScratchPads
manageWindows = composeAll
[ className =? "Google-chrome" --> doShift ( myWorkspaces !! 1 )
, className =? "Cypress" --> doShift ( myWorkspaces !! 1)
, className =? "Gimp" --> doShift ( myWorkspaces !! 8 )
, className =? "Gimp" --> doFloat
, title =? "Oracle VM VirtualBox Manager" --> doFloat
, className =? "VirtualBox Manager" --> doShift ( myWorkspaces !! 4 )
]
.....
--- shortcut keys
, ("M-t t", namedScratchpadAction myScratchPads "terminal")
, ("M-t m", namedScratchpadAction myScratchPads "mocp")
, ("M-t c", namedScratchpadAction myScratchPads "qalculate-qt")
I am using Debian 11 OS and everything else in xmonad configs is working fine.

drawing the game board in Haskell - problem

I'm trying to build the board for the Peg Solitaire game but I'm stuck. I hope you can help me. The following code runs and generates a square of 3 on 3 circles. How could I make 3 more such squares but put them in other positions? I use the Gloss library
module Main(main) where
import Graphics.Gloss
import Graphics.Gloss.Data.ViewPort
import Graphics.Gloss.Interface.Pure.Game
import Data.List
width, height, offset :: Int
width = 400
height = 400
offset = 100
window :: Display
window = InWindow "Peg Solitaire" (width, height) (offset, offset)
background :: Color
background = white
drawing :: Picture
drawing = Pictures [ (translate (x * 40) (y * 40) $ circleSolid 12)| x<-[-1..1], y<-[2..4] ]
main = display window background drawing
I am not familiar with your graphic library, but apparently you can use a list comprehension and pass it to the Pictures constructor.
So it is just a matter of writing the appropriate list comprehension expression.
The expression you give can be rewritten as:
drawing1 = let circles1 = [ (translate (x1 * 40) (y1 * 40) $ circleSolid 12) |
x1 <- [-1..1], y1 <- [2..4] ] in Pictures circles1
If you would like to arrange your 3+1=4 circle groups into a regular grid, you can introduce extra loop levels, say with variables x0 and y0, like this:
drawing2 = let circles2 = [ (translate (x0*200 + x1*40) (y0*200 + y1*40)
$ circleSolid 12) |
x0 <- [0,1] , y0 <- [0,1],
x1 <- [-1..1], y1 <- [2..4] ]
in Pictures circles2
If you prefer to arrange the circle groups in arbitrary fashion, you can introduce one extra loop variable, say cg which is to run over the main coordinates of the circle groups:
circleGroups = [ (0,0), (0,200), (200,0), (200,200) ] -- list of (x,y) pairs
drawing3 = let circles3 = [
translate ((fst cg)*200 + x1*40) ((snd cg)*200 + y1*40)
$ circleSolid 12 |
cg <- circleGroups,
x1 <- [-1..1], y1 <- [2..4] ]
in Pictures circles3
Note: Please please limit your source code to about 80 characters per line, so we don't have to use the horizontal slider. This is really a massive hindrance to code readability. Thanks.

Fix arrowShaft (Diagrams Library)

I've made a data storage symbol using B.difference and B.union. The one with the red dot in the middle.
dataStorage :: Diagram B
dataStorage = (strokePath $ B.difference Winding combined block1) # translateX (-0.3)
where block1 = (circle 0.5) # scaleX 0.5 # translateX (-1)
block2 = rect 2 1
block3 = (circle 0.5) # translateX (1)
combined = B.union Winding $ block2 <> block3
I've been trying for hours now but can't make an arrow straight between Previous Estimate written inside that symbol and Signal Decomposition (SSA). The goal is to draw the arrow starting at the center right outside of the symbol. Any help is welcome. Thank you very much.
EDIT 1: Added wanted result.
Here's the complete code.
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module FlowChartTR where
import System.Process
--import Graphics.SVGFonts
import Diagrams.Backend.SVG.CmdLine
import Diagrams.Prelude
import Diagrams.TwoD.Arrow
import qualified Diagrams.TwoD.Path.Boolean as B
oneLineText txt = text txt
twoLineText txt1 txt2 = center $ (text txt1) === strutY 0.2 === (text txt2)
threeLineText txt1 txt2 txt3 = center $
(text txt1) === strutY 0.2 === (text txt2) === strutY 0.2 === (text txt3)
terminal writeText w h r = (writeText <> roundedRect w h r) # lwL 0.02 # fontSize (local 0.2)
--terminalInput = (text "Input Data" <> roundedRect 1 0.3 0.3) # lwL 0.02 # fontSize (local 0.2)
--process txt w h = (text txt <> rect w h) # lwL 0.02 # fontSize (local 0.2)
process writeText w h = (writeText <> rect w h) # lwL 0.02 # fontSize (local 0.2)
dataStorage :: Diagram B
dataStorage = (strokePath $ B.difference Winding combined block1) # translateX (-0.3)
where block1 = (circle 0.5) # scaleX 0.5 # translateX (-1)
block2 = rect 2 1
block3 = (circle 0.5) # translateX (1)
combined = B.union Winding $ block2 <> block3
--decision :: Diagram B
--decision = (text "BPM" <> rect 0.4 0.3) # lwL 0.02 # fontSize (local 0.2)
input = (terminal (oneLineText "Input Data") 1.2 0.3 0.3) # named "terminalInput"
bandpass = (process (twoLineText "Bandpass" "Filtering") 1.5 0.5) # named "bandpass"
ssa = (process (threeLineText "Signal" "Decomposition" "(SSA)") 1.5 1) # translateY (-0.3) # named "ssa" # showOrigin
td = (process (twoLineText "Temporal" "Difference") 1 0.5) # named "td"
focuss = (process (threeLineText "Sparse Signal" "Reconstruction" "(FOCUSS)") 1.5 0.8) # named "focuss"
outputBPM = (terminal (oneLineText "Output BPM") 1.2 0.3 0.3) # named "terminalOutput"
spt = (process (threeLineText "Spectral Peak" "Tracking" "Select & Verif") 1.5 0.8) # named "spt"
prior = (oneLineText "Previous Estimate" <> dataStorage) # fontSize (local 0.2) # named "prior" #showOrigin # translateY 1
arrowStyle = (with & arrowHead .~ dart & headLength .~ large & tailLength .~ veryLarge)
ushaft = trailFromVertices (map p2 [(0, 0), (0.5, 0), (0.5, 1), (1, 1)])
arrowStyleU = (with & arrowHead .~ dart & headLength .~ large & tailLength .~ veryLarge & arrowShaft .~ ushaft)
decision :: Diagram B
decision = square 5 # rotate (45 ## deg) # scaleY 0.5
placeBlocks :: Diagram B
placeBlocks = atPoints [ P (V2 0 0), -- input
P (V2 4 0), -- bandpass
P (V2 8 0), -- ssa
P (V2 8 (-2)), -- td
P (V2 8 (-4)), -- focuss
P (V2 4 (-4)), -- spt
P (V2 0 (-4)), -- outputBPM
P (V2 4 (-2)) -- prior
] [input, bandpass,ssa, td, focuss, spt, outputBPM, prior]
flowChart :: Diagram B
flowChart = placeBlocks # connectOutside' arrowStyle "terminalInput" "bandpass"
# connectOutside' arrowStyle "bandpass" "ssa"
# connectOutside' arrowStyle "ssa" "td"
# connectOutside' arrowStyle "td" "focuss"
# connectOutside' arrowStyle "focuss" "spt"
# connectOutside' arrowStyle "spt" "terminalOutput"
# connectOutside' arrowStyle "prior" "spt"
# connectOutside' arrowStyleU "prior" "ssa"
# pad 1.1
flowChartTR :: IO ()
flowChartTR = mainWith flowChart
I got it. After I scaled down the symbol It becomes easier to adjust the connection.
Here's the changes.
...
[input, bandpass,ssa, td, focuss, spt, outputBPM, (prior # scale 0.7)]
...
# connectPerim' arrowStyleU "prior" "ssa" (0 ## deg) (205 ## deg)
...
NOTE:
- Adding arrowTail .~ lineTail is critical.

Ordered Probit in Jags Using scaled inverse wishart

I am trying to use the following code (adapted from the code given in Gelman and Hill's Book) to estimate a varying coefficient/intercept ordered probit model in Jags. However, it is giving me a "Observed node inconsistent with unobserved parents at initialization.Try setting appropriate initial values". Where am I going wrong? Could somebody please help me? Thanks in advance !!
rm(list=ls(all=TRUE));
options(warn=-1)
library(mvtnorm)
library(arm)
library(foreign)
library("R2jags")
library(MCMCpack)
set.seed(1)
standardizeCols = function( dataMat ) {
zDataMat = dataMat
for ( colIdx in 1:NCOL( dataMat ) ) {
mCol = mean( dataMat[,colIdx] )
sdCol = sd( dataMat[,colIdx] )
zDataMat[,colIdx] = ( dataMat[,colIdx] - mCol ) / sdCol
}
return( zDataMat )
}
keep<-1
nobs = 150;
nis<-sample(1:40,nobs,replace=T) # number obs per subject
id<-rep(1:nobs,nis)
N<-length(id)
corr_beta = 0.6;
Sigma_beta = matrix(c(1, corr_beta, corr_beta, corr_beta,
corr_beta, 1, corr_beta, corr_beta,
corr_beta, corr_beta, 1, corr_beta,
corr_beta, corr_beta, corr_beta, 1), ncol=4);
betas <- rmvnorm(n=N, mean=c(-1.45, 0.90, 0.25, -2.3), sigma=Sigma_beta);
#Generate the data
x3 = matrix(0, nrow=N,ncol=3);
y3 = matrix(0, nrow=N,ncol=1);
for (i in 1:N) {
error_v = rnorm(1,0,1);
x3[i,1] = rnorm(1,0,1);
x3[i,2] = rnorm(1,0,1);
x3[i,3] = rnorm(1,0,1);
y3[i,1] = betas[id[i], 1] + betas[id[i], 2]*x3[i,1] + betas[id[i], 3]*x3[i,2] + betas[id[i], 4]*x3[i,3] + error_v;
}
cutoff=c(-100, 0, 1.5, 2.4, 100)
k=length(cutoff)-1;
Y3<-cut(y3, br = cutoff, right=TRUE, include.lowest = TRUE, labels = FALSE)
Y3=Y3
X3=x3
m1=max(Y3)
y = as.vector( Y3 )
n = length(y)
J<-length(unique(id))
X = cbind(1, standardizeCols( X3 ))
nPred = NCOL(X)
subjects<-as.vector(as.numeric(id))
K=nPred
W <- diag (K)
# MCMC settings
ni <- 5000; nb <- 2500; nt <- 6; nc <- 3
tau1u=c(0,1,2)
jags_data <- list ("n", "J", "K", "y", "subjects", "X", "W", "m1")
inits <- function (){
list (B.raw=array(rnorm(J*K),c(J,K)), mu.raw=rnorm(K), sigma.y=runif(1), Tau.B.raw=rwish(K+1,diag(K)), xi=runif(K))
}
params <- c ("B", "mu", "sigma.B", "rho.B", "tau1u")
cat("model {
for (i in 1:n){
y.hat[i] <- inprod(B[subjects[i],],X[i,])
y[i] ~ dcat(p[i,])
estar[i]~dnorm (y.hat[i], tau.y);
for (j in 1:(m1-1)) {
Q1[i,j]<-pnorm(tau1[j]-estar[i],0,1)
}
p[i,1] <- Q1[i,1]
for(j in 2:(m1-1)) {
p[i,j] <- Q1[i,j] - Q1[i,j-1]
}
p[i,m1] <- 1 - Q1[i,m1-1]
}
tau.y <- pow(sigma.y, -2)
sigma.y ~ dunif (0, 100)
# thresholds (unordered priors)
for(j in 1:(m1-1)){
tau1u[j] ~ dnorm(0,.01)
}
# ordered thresholds
tau1 <- sort(tau1u)
for (j in 1:J){
for (k in 1:K){
B[j,k] <- xi[k]*B.raw[j,k]
}
B.raw[j,1:K] ~ dmnorm (mu.raw[], Tau.B.raw[,])
}
for (k in 1:K){
mu[k] <- xi[k]*mu.raw[k]
mu.raw[k] ~ dnorm (0, .0001)
xi[k] ~ dunif (0, 100)
}
Tau.B.raw[1:K,1:K] ~ dwish (W[,], df)
df <- K+1
Sigma.B.raw[1:K,1:K] <- inverse(Tau.B.raw[,])
for (k in 1:K){
for (k.prime in 1:K){
rho.B[k,k.prime] <- Sigma.B.raw[k,k.prime]/sqrt(Sigma.B.raw[k,k]*Sigma.B.raw[k.prime,k.prime])
}
sigma.B[k] <- abs(xi[k])*sqrt(Sigma.B.raw[k,k])
}
}", fill=TRUE, file="wishart2.txt")
# Start Gibbs sampler
outj <- jags(jags_data, inits=inits, parameters.to.save=params, model.file="wishart2.txt", n.thin=nt, n.chains=nc, n.burnin=nb, n.iter=ni)
Your initial values function returns random numbers from normal and uniform distributions, which it appears are not close enough to sensible values to allow a non-0 posterior value to be calculated. I think you need to choose your initial values more carefully, and perhaps based on the values generated in the data, to ensure that the model compiles. Do Gelman and Hill give initial values for their model that you could start with?
Update: you could also try removing your 'inits=inits' argument to allow JAGS to select its own initial values, which works for most (although not all) models. I dont use R2JAGS though so I'm not sure if this is allowed for the jags function (but it is for rjags and runjags).

Resources