I suspect the code is okay but there is some issue with weston-termin…

…al that causes it to segfault when using SBCL. weston-terminal works fine with CCL and everything else seems to work fine with either. It's maybe best therefore to recommend running with CCL.

compositor.lisp

@@ -72,7 +72,7 @@
   (find-if (lambda (client)
 	     (and (pointerp (waylisp:->client client)) (pointer-eq (waylisp:->client client) client-pointer)))
 	   (clients compositor)))
-|#
+
 
 (defun find-surface (surface-pointer compositor)
   (find-if (lambda (surface)
@@ -88,6 +88,7 @@
 			(and (pointerp (waylisp:->surface surface)) (pointer-eq (waylisp:->surface surface) surface-pointer)))
 		      (surfaces client)))
 	   (clients compositor)))
+|#
 
 (defun remove-client (client-pointer)
   (let ((client (get-client client-pointer)))

render.lisp

@@ -204,9 +204,9 @@
 	(array (gensym "array")))
     `(let* ((,x (x ,surface))
 	    (,y (y ,surface))
-	    (,texture (waylisp:texture ,surface))
-	    (,width (waylisp:width ,texture))
-	    (,height (waylisp:height ,texture))
+	    (,texture (texture (wl-surface ,surface)))
+	    (,width (width (wl-surface ,texture)))
+	    (,height (height (wl-surface ,texture)))
 	    (,array (cepl:make-gpu-array (list (list (cepl:v! 0 0 ,z)
 						     (cepl:v! 0 0))
 					       (list (cepl:v! ,width 0 ,z)

ulubis.asd

@@ -12,6 +12,7 @@
 	       #:cl-xkb
                #:cl-wayland
 	       #:trivial-dump-core
+	       #:trivial-backtrace
 	       #:uiop)
   :serial t
   :components ((:file "backend")

ulubis.lisp

@@ -136,7 +136,11 @@
 
 (defun initialise ()
   (unwind-protect
-       (progn
+       (block main-handler
+	 (handler-bind ((error #'(lambda (e)
+				   (format t "~%Oops! Something went wrong with ulubis...we throw ourselves at your mercy! Exiting wih error:~%")
+				   (trivial-backtrace:print-backtrace e)
+				   (return-from main-handler))))
 	 #+sbcl
 	 (sb-int:set-floating-point-modes :traps nil)
 
@@ -254,7 +258,7 @@
 	 (setf (running *compositor*) t)
 	 (if (string-equal (symbol-name backend-name) "backend-drm-gbm")
 	     (main-loop-drm (wl-display-get-event-loop (display *compositor*)))
-	     (main-loop-sdl (wl-display-get-event-loop (display *compositor*)))))
+	     (main-loop-sdl (wl-display-get-event-loop (display *compositor*))))))
     (when (display *compositor*)
       (wl-display-destroy (display *compositor*))
       (setf (display *compositor*) nil))

wl-compositor-impl.lisp

@@ -15,20 +15,4 @@
   ())
 
 (def-wl-bind compositor-bind (client (data :pointer) (version :uint32) (id :uint32))
-  (let ((compositor (make-wl-compositor client 1 id)))
-    (format t "Made compositor: ~A~%" compositor)))
-
-#|
-(defcallback compositor-bind :void ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-  ;;(make-wl-compositor client-ptr 1 id))
-  (bind-wl-compositor client-ptr 1 id))
-|#
-
-#|
-(defcallback compositor-bind :void
-    ((client :pointer) (data :pointer) (version :uint32) (id :uint32))
-  (format t "Binding compositor~%")
-  (let ((resource (wl-resource-create client wl-compositor-interface 1 id)))
-    (wl-resource-set-implementation resource wl-compositor-implementation (null-pointer) (null-pointer))
-    ))
-|#
+  (make-wl-compositor client 1 id))

wl-data-device-manager-impl.lisp

@@ -18,22 +18,4 @@
   ())
 
 (def-wl-bind device-manager-bind (client (data :pointer) (version :uint32) (id :uint32))
-  (let ((ddm (make-wl-data-device-manager client 1 id)))
-    (format t "Made data-device-manager: ~A~%" ddm)))
-
-#|
-(defcallback device-manager-bind :void ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-  (bind-wl-data-device-manager client-ptr 1 id))
-|#
-
-#|
-(defcallback device-manager-bind :void
-    ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-  (format t "Device manager bind~%")
-  (let ((device-manager (wl-resource-create client-ptr wl-data-device-manager-interface 1 id)))
-    (wl-resource-set-implementation
-     device-manager  
-     wl-data-device-manager-implementation
-     (null-pointer)
-     (null-pointer))))
-|#
+  (make-wl-data-device-manager client 1 id))

wl-output-impl.lisp

@@ -7,19 +7,4 @@
 
 (def-wl-bind output-bind (client (data :pointer) (version :uint32) (id :uint32))
   (let ((output (make-wl-output client 1 id :implementation? nil)))
-    ;;(setf (->output *compositor*) output)
-    (format t "Made output: ~A~%" output)
     (wl-output-send-geometry (->resource output) 0 0 1440 900 0 "apple" "apple" 0)))
-
-#|
-(defcallback output-bind :void ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-  (let ((output (bind-wl-output client-ptr 1 id :implementation? nil)))
-    (wl-output-send-geometry output 0 0 1440 900 0 "apple" "apple" 0)))
-|#
-
-#|
-(defcallback output-bind :void
-    ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-  (let ((output (wl-resource-create client-ptr wl-output-interface 1 id)))
-    (setf (->output *compositor*) output)))
-|#

wl-seat-impl.lisp

@@ -19,24 +19,5 @@
 
 (def-wl-bind seat-bind (client (data :pointer) (version :uint32) (id :uint32))
   (let ((seat (make-wl-seat client 4 id)))
-    (format t "Made seat: ~A~%" seat)
     (wl-seat-send-capabilities (->resource seat) 3)))
 
-#|
-(defcallback seat-bind :void ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-  (let ((seat (bind-wl-seat client-ptr 4 id)))
-    (wl-seat-send-capabilities seat 3)))
-|#
-
-#|
-(defcallback seat-bind :void
-    ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-    (format t "seat-bind called ~A~%" client-ptr)
-  (let ((seat (wl-resource-create client-ptr wl-seat-interface 4 id)))
-    (wl-resource-set-implementation
-     seat
-     wl-seat-implementation
-     (null-pointer)
-     (null-pointer))
-    (wl-seat-send-capabilities seat 3))) ;; WL_SEAT_CAPABILITY_POINTER | WL_SEAT_CAPABILITY_KEYBOARD
-|#

wl-subcompositor-impl.lisp

@@ -15,22 +15,4 @@
   ())
 
 (def-wl-bind subcompositor-bind (client (data :pointer) (version :uint32) (id :uint32))
-  (let ((sbcmp (make-wl-subcompositor client 1 id)))
-    (format t "Made wl-subcompositor: ~A~%" sbcmp)))
-
-#|
-(defcallback subcompositor-bind :void ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-  (bind-wl-subcompositor client-ptr 1 id))
-|#
-
-#|
-(defcallback subcompositor-bind :void
-    ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-  (format t "subcompositor-bind called~%")
-  (let ((subcompositor (wl-resource-create client-ptr wl-subcompositor-interface 1 id)))
-    (wl-resource-set-implementation
-     subcompositor
-     wl-subcompositor-implementation
-     (null-pointer)
-     (null-pointer))))
-|#
+  (make-wl-subcompositor client 1 id))

xdg-shell-impl.lisp

@@ -12,17 +12,10 @@
   ((:get-xdg-surface xdg-shell-get-xdg-surface))
   ())
 
-#|
-(defcallback client-delete :void ((client-ptr :pointer))
-	     (remove-client (get-client client-ptr)))
-|#
 (def-wl-delete client-delete (xdg-shell)
   (when xdg-shell
-    (format t "DELETING CLIENT~%")
     (remove-client (->client (client xdg-shell)))
-    (setf (render-needed *compositor*) t))
-  )
+    (setf (render-needed *compositor*) t)))
 
 (def-wl-bind xdg-shell-bind (client (data :pointer) (version :uint32) (id :uint32))
-  (let ((shell (make-xdg-shell client 1 id :delete-fn (callback client-delete))))
-    (format t "Made zxdg-shell: ~A~%" shell)))
+  (make-xdg-shell client 1 id :delete-fn (callback client-delete)))

zxdg-shell-v6-impl.lisp

@@ -11,34 +11,10 @@
   ((:get-xdg-surface get-xdg-surface))
   ())
 
-#|
-(defcallback client-delete :void ((client-ptr :pointer))
-	     (remove-client (get-client client-ptr)))
-|#
 (def-wl-delete client-delete (zxdg-shell)
   (when zxdg-shell
-    (format t "DELETING CLIENT~%")
     (remove-client (->client (client zxdg-shell)))
-    (setf (render-needed *compositor*) t))
-  )
+    (setf (render-needed *compositor*) t)))
 
 (def-wl-bind zxdg-shell-v6-bind (client (data :pointer) (version :uint32) (id :uint32))
-  (let ((shell (make-zxdg-shell-v6 client 1 id :delete-fn (callback client-delete))))
-    (format t "Made zxdg-shell: ~A~%" shell)))
-
-#|
-(defcallback zxdg-shell-v6-bind :void ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-  (bind-zxdg-shell-v6 client-ptr 1 id :delete-fn (callback client-delete)))
-|#
-
-#|
-(defcallback zxdg-shell-v6-bind :void
-    ((client-ptr :pointer) (data :pointer) (version :uint32) (id :uint32))
-  (format t "zxdg-shell-bind called: ~A~%" client-ptr)
-  ;;(waylisp:get-client client-ptr)
-  (wl-resource-set-implementation
-   (wl-resource-create client-ptr zxdg-shell-v6-interface 1 id)
-   zxdg-shell-v6-implementation
-   client-ptr
-   (callback client-delete)))
-|#
+  (make-zxdg-shell-v6 client 1 id :delete-fn (callback client-delete)))

zxdg-surface-v6-impl.lisp

@@ -10,15 +10,9 @@
     ;; Save the wl-surface associated with the toplevel
     (setf (wl-surface toplevel) (wl-surface zxdg-surface))
     (push toplevel (surfaces (current-view *compositor*)))
-    #|
     (with-wl-array array
       (zxdg-toplevel-v6-send-configure (->resource toplevel) 0 0 array)
       (zxdg-surface-v6-send-configure (->resource zxdg-surface) 0))))
-    |#
-    (let ((array (foreign-alloc '(:struct wl_array))))
-      (wl-array-init array)
-      (zxdg-toplevel-v6-send-configure (->resource toplevel) 0 0 array)
-      (zxdg-surface-v6-send-configure (->resource zxdg-surface) 0))))
 
 (defimplementation zxdg-surface-v6 (isurface)
   ((:get-toplevel get-toplevel))

zxdg-toplevel-v6-impl.lisp

@@ -25,8 +25,7 @@
 (defimplementation zxdg-toplevel-v6 (isurface ianimatable)
   ((:move move)
    (:destroy zxdg-toplevel-destroy)
-   ;; (:set-title set-title)
-   )
+   (:set-title set-title))
   ((zxdg-surface-v6 :accessor zxdg-surface-v6 :initarg :zxdg-surface-v6 :initform nil)))
 
 (defmethod activate ((surface zxdg-toplevel-v6) active-surface mods)