No examples of using DrawingArea and gtk_drawing_area_set_draw_func

[bigos]

https://docs.gtk.org/gtk4/class.DrawingArea.html

Can you please provide a simple example of creating a drawing area and drawing some lines and text?

[bohonghuang]

Since this kind of function seems not well supported by gobject-introspection, you may need to interact with CFFI directly and wrap the raw pointer to low-level objects into Lisp objects (for GIR, they are gir::object-instance or gir::struct-instance and for cl-cairo2 they could be cairo:context). Here is my Lisp version for the example from the GTK4 document:

(ql:quickload :cl-gtk4)
(ql:quickload :cl-gdk4)
(ql:quickload :cl-cairo2)

(cl:defpackage cairo-gobject
  (:use)
  (:export #:*ns*))

(cl:in-package #:cairo-gobject)

(gir-wrapper:define-gir-namespace "cairo")

(cl:defpackage gtk4-cairo.example
  (:use #:cl #:gtk4))

(cl:in-package #:gtk4-cairo.example)

(cffi:defcstruct gdk-rgba
  (red :double)
  (green :double)
  (blue :double)
  (alpha :double))

(defmacro with-gdk-rgba ((pointer color) &body body)
  `(cffi:with-foreign-object (,pointer '(:struct gdk-rgba))
     (let ((,pointer (make-instance 'gir::struct-instance
                                     :class (gir:nget gdk::*ns* "RGBA")
                                     :this ,pointer)))
       (gdk:rgba-parse ,pointer ,color)
       ,@body)))

(defun draw-func (area cr width height)
  (let ((style-context (gtk:widget-style-context area)))
    (cairo:arc (/ (coerce (the (signed-byte 32) width) 'single-float) 2.0)
               (/ (coerce (the (signed-byte 32) height) 'single-float) 2.0)
               (/ (min width height) 2.0) 0.0 (* 2.0 (coerce pi 'single-float)))

    (let ((color (gtk:style-context-color style-context)))
      (gdk:cairo-set-source-rgba cr color)
      (cairo:fill-path))
    (cairo:arc (/ (coerce (the (signed-byte 32) width) 'single-float) 2.0)
               (/ (coerce (the (signed-byte 32) height) 'single-float) 2.0)
               (/ (min width height) 4.0) 0.0 (* 2.0 (coerce pi 'single-float)))
    (with-gdk-rgba (color "#FFFFFFFF")
      (gdk:cairo-set-source-rgba cr color)
      (cairo:fill-path))))

(cffi:defcallback %draw-func :void ((area :pointer)
                                    (cr :pointer)
                                    (width :int)
                                    (height :int)
                                    (data :pointer))
  (declare (ignore data))
  (let ((cairo:*context* (make-instance 'cairo:context
                                        :pointer cr
                                        :width width
                                        :height height
                                        :pixel-based-p nil)))
    (draw-func (make-instance 'gir::object-instance
                              :class (gir:nget gtk:*ns* "DrawingArea")
                              :this area)
               (make-instance 'gir::struct-instance
                              :class (gir:nget cairo-gobject:*ns* "Context")
                              :this cr)
               width height)))

(defun main ()
  (let ((app (make-application :application-id "org.bohonghuang.cl-gtk4-cairo-example"
                               :flags gio:+application-flags-flags-none+)))
    (connect app "activate"
                             (lambda (app)
                               (let ((window (make-application-window :application app)))
                                 (setf (window-title window) "Drawing Area Test")
                                 (let ((area (gtk:make-drawing-area)))
                                   (setf (drawing-area-content-width area) 100
                                         (drawing-area-content-height area) 100
                                         (drawing-area-draw-func area) (list (cffi:callback %draw-func)
                                                                             (cffi:null-pointer)
                                                                             (cffi:null-pointer)))
                                   (setf (window-child window) area))
                                 (window-present window))))
    (gio:application-run app nil)
    (gio:application-quit app)))

(main)

where cl-gdk4 is a new system that I just added to this repo.

[bigos]

How do I install?

(ql:quickload :cl-gdk4)

[bigos]

I have figured out loading the callback for drawing-area-draw-func. I will have a break now, and later I will try to write another example based on your library. If I have success, I will share the code.

[bigos]

I had no success. I can not wrap my mind around the additional complexity introduced by gir and I do not know how to proceed on my own. Also, I could not run your example because of the missing cl-gdk4 library. Googling for it did not work.

[bigos]

https://github.com/bohonghuang/cl-gtk4/blob/fefa2f0c0d906553a7644c09adbb72fb47dfc1d7/cl-gdk4.asd is part of the repo. How do you load it?

[bohonghuang]

https://github.com/bohonghuang/cl-gtk4/blob/fefa2f0c0d906553a7644c09adbb72fb47dfc1d7/cl-gdk4.asd is part of the repo. How do you load it?

Clone the latest repo into the local-projects directory under the Quicklisp installation path, which is ~/quicklisp/local-projects by default. Then restart the Lisp session and try reloading again.

[bigos]

I confirm that loading your code now gives me a window 'Drawing Area Test'. It shows a white circle with a think black border on a grey background.

Well done! Thank you very much for your work!

[bigos]

I do not know if it will be needed. But just in case, for the removal of installed ultralisp systems while keeping the ultralisp dist I have used the following code:

(loop for cs in  (loop for s in (ql:system-list)
                       for sn = (ql-dist:name (ql-dist:dist s))
                       when (equalp "ultralisp" sn )
                         collect (ql-dist:name s))
      do (ql:uninstall cs))

[bohonghuang]

I do not know if it will be needed.

It seems unnecessary to do that when loading a repo from GitHub. If you clone the latest repo under local-projects, it gets the highest priority to be loaded.

[bigos]

https://github.com/bigos/Pyrulis/blob/master/Lisp/cl-gtk4.lisp

This is your example with some simple modifications. Thank you again for your work.