From 8642e32762ca60d8300c593e12569aa89b5cc4f2 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 15 May 2024 04:53:03 +0200
Subject: [PATCH] Add proxy example

---
 examples/Proxy.hs                      | 58 ++++++++++++++++++++++++++
 examples/quasar-wayland-examples.cabal | 10 +++++
 2 files changed, 68 insertions(+)
 create mode 100644 examples/Proxy.hs

diff --git a/examples/Proxy.hs b/examples/Proxy.hs
new file mode 100644
index 0000000..7c8407c
--- /dev/null
+++ b/examples/Proxy.hs
@@ -0,0 +1,58 @@
+module Main (main) where
+
+import Control.Concurrent
+import Quasar
+import Quasar.Prelude
+import Quasar.Wayland.Client
+import Quasar.Wayland.Client.XdgShell
+import Quasar.Wayland.Server
+import Quasar.Wayland.Server.DummyOutput
+import Quasar.Wayland.Server.Registry
+import Quasar.Wayland.Server.XdgShell
+import Quasar.Wayland.Shared.FnWindowManager
+import Quasar.Wayland.Shared.WindowApi (WindowProperties(..), toWindowFactory)
+import Quasar.Wayland.Shared.WindowMultiplexer
+import Quasar.Wayland.Skia
+import Quasar.Wayland.Skia.GL
+
+main :: IO ()
+main = runQuasarAndExit do
+  client <- connectWaylandClient
+  traceIO "Connected"
+
+  quasar <- askQuasar
+  liftIO $ runInBoundThread do
+
+    skia <- liftIO $ initializeSkia @GL
+
+    --clientDmabuf <- atomically $ getClientDmabufSingleton client
+    --(dmabufFormats, dmabufModifiers) <- awaitSupportedFormats clientDmabuf
+
+    wlClientWM <- atomicallyC $ getClientWindowManager @(Skia GL) client
+
+    let muxWM = WindowMultiplexerFactory [toWindowFactory (mapWindowManager wlClientWM), toWindowFactory wlClientWM]
+
+    registry <- newRegistry [
+      compositorGlobal @(Skia GL),
+      subcompositorGlobal @(Skia GL),
+      dummyOutputGlobal,
+      xdgShellGlobal muxWM,
+      skiaDmabufGlobal skia
+      ]
+    server <- newWaylandServer registry
+    runQuasarIO quasar do
+      listenAt "example.socket" server
+
+    sleepForever
+
+mapWindowManager :: IsWindowManager (Skia GL) w a => a -> FnWindowManager (Skia GL)
+mapWindowManager upstream = fnWindowManager {
+  newWindowFn = \props cfg req -> fnWindowManager.newWindowFn (mapProperties props) cfg req
+}
+  where
+    fnWindowManager = toFnWindowManager upstream
+
+mapProperties :: WindowProperties -> WindowProperties
+mapProperties properties = properties {
+  title = properties.title <> " (proxy)"
+}
diff --git a/examples/quasar-wayland-examples.cabal b/examples/quasar-wayland-examples.cabal
index a1a3a7e..cf2ddce 100644
--- a/examples/quasar-wayland-examples.cabal
+++ b/examples/quasar-wayland-examples.cabal
@@ -69,3 +69,13 @@ executable example-client
     quasar-wayland,
     quasar-wayland-skia,
   main-is: Client.hs
+
+executable example-proxy
+  import: shared-executable-properties
+  build-depends:
+    base,
+    quasar,
+    quasar-timer,
+    quasar-wayland,
+    quasar-wayland-skia,
+  main-is: Proxy.hs