bohonghuang / cl-gtk4 Goto Github PK

(connect app "open"
  (lambda (app files n-files hint)
    ;; How do I use files here?
    (format T "~a~%" files)))
    ;; This prints "#.(SB-SYS:INT-SAP #X56334FB51140)"

(defun do-level-bar (&optional application)
  (let* ((vbox (make-instance 'gtk:box
                              :orientation :vertical
                              :margin-top 12
                              :margin-bottom 12
                              :margin-start 12
                              :margin-end 12
                              :spacing 12))
         (window (make-instance 'gtk:window
                                :title "Level bar"
                                :child vbox
                                :application application
                                :default-width 420
                                :default-height 240))
         (adj (make-instance 'gtk:adjustment
                             :value 0.0
                             :lower 0.0
                             :upper 10.0
                             :step-increment 0.1))
         (scale (make-instance 'gtk:scale
                               :orientation :horizontal
                               :digits 1
                               :value-pos :top
                               :draw-value t
                               :adjustment adj))
         (levelbar1 (create-level-bar :horizontal :continuous))
         (levelbar2 (create-level-bar :horizontal :discrete)))
    ;; Bind adjustment value for the scale to the level bar values
    (g:object-bind-property adj "value" levelbar1 "value" :default)
    (g:object-bind-property adj "value" levelbar2 "value" :default)
    ;; Pack and show the widgets
    (gtk:box-append vbox (make-instance 'gtk:label
                                        :xalign 0.0
                                        :use-markup t
                                        :label "<b>Continuous mode</b>"))
    (gtk:box-append vbox levelbar1)
    (gtk:box-append vbox (make-instance 'gtk:label
                                        :xalign 0.0
                                        :use-markup t
                                        :label "<b>Discrete mode</b>"))
    (gtk:box-append vbox levelbar2)
    (gtk:box-append vbox (make-instance 'gtk:label
                                        :use-markup t
                                        :xalign 0.0
                                        :label "<b>Change value</b>"))
    (gtk:box-append vbox scale)
    (gtk:widget-show window)))

(defun main ()
    (ltk:with-ltk ()
        (let* (
               (control-frame (make-instance 'ltk:frame :width 100
                                                        :height 100))
               (text-frame (make-instance 'ltk:frame :width 100
                                                     :height 100))
               
               (speed-spinbox (make-instance 'ltk:spinbox
                                             :from 0 :to 10000
                                             :master control-frame))
               
               (text-field (make-instance 'ltk:scrolled-text :master text-frame
                                                             :width 1 
                                                             :height 1)) 
               (load-button  (make-instance 'ltk:button
                                            :text "Load"
                                            :master control-frame
                                            :command #'(lambda ()
                                                           (let* ((path-to-space-config (ltk:get-open-file :filetypes '(("S-expression" ".sxp"))))
                                                                  (space-config (if (equal path-to-space-config "")
                                                                                    nil
                                                                                    (alexandria:read-file-into-string path-to-space-config))))
                                                               (when space-config
                                                                   (setf (ltk:text text-field)
                                                                         space-config)))))) 

               (start-button (make-instance 'ltk:button
                                            :text "Start"
                                            :master control-frame
                                            :command #'(lambda ()
                                                           (visualise (parse-space-from-string (ltk:text text-field))
                                                                      :speed (parse-integer (ltk:text speed-spinbox)))))))
            (ltk:grid text-frame 0 0)
            (ltk:grid text-field 0 0)
            (ltk:grid control-frame 1 0) (ltk:grid speed-spinbox 0 0)
            (ltk:grid load-button 1 0)
            (ltk:grid start-button 1 1))))

(defsystem cl-gtk4.gstreamer
  :version "1.0.0"
  :author "Filipp Druan <[email protected]>"
  :maintainer "Bohong Huang <[email protected]>"
  :license "lgpl3"
  :description "GStreamer bindings for Common Lisp."
  :homepage "https://github.com/bohonghuang/cl-gtk4"
  :bug-tracker "https://github.com/bohonghuang/cl-gtk4/issues"
  :source-control (:git "https://github.com/bohonghuang/cl-gtk4.git")
  :serial t
  :components ((:file "gstreamer"))
  :depends-on (#:cl-gobject-introspection-wrapper #:cl-gtk4))

(uiop:register-image-restore-hook
 (lambda ()
   (let ((package (find-package :sourceview)))
     (when package
       (setf (symbol-value (find-symbol "*NS*" package))
             (uiop:symbol-call :gir :require-namespace "gstreamer"))))))

(cl:defpackage gtkgstreamer
  (:use)
  (:nicknames #:gstreamer)
  (:export #:*ns*))

(in-package #:gstreamer)

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

CL-USER> (ql:quickload :cl-gtk4.gstreamer)
To load "cl-gtk4.gstreamer":
  Load 1 ASDF system:
    cl-gtk4.gstreamer
; Loading "cl-gtk4.gstreamer"
[package gtkgstreamer]

; file: /home/iam/quicklisp/local-projects/cl-gtk4/gstreamer.lisp
; in: GOBJECT-INTROSPECTION-WRAPPER:DEFINE-GIR-NAMESPACE "gstreamer"
;     (GOBJECT-INTROSPECTION-WRAPPER:DEFINE-GIR-NAMESPACE "gstreamer")
; 
; caught COMMON-LISP:ERROR:
;   (during macroexpansion of (GOBJECT-INTROSPECTION-WRAPPER:DEFINE-GIR-NAMESPACE "gstreamer"))
;   Typelib file for namespace 'gstreamer' (any version) not found
; Debugger entered on #<UIOP/LISP-BUILD:COMPILE-FILE-ERROR {10046B53C3}>
; 
; compilation unit aborted
;   caught 1 fatal ERROR condition
;   caught 1 ERROR condition
[1] CL-USER> 
; Evaluation aborted on #<UIOP/LISP-BUILD:COMPILE-FILE-ERROR {10046B53C3}>

(gtk:define-application (:name test-menu :id "okaynoobz.org")
  (defun test-menu-menu ()
    (let ((menu (gio:make-menu)))
      (let ((submenu (gio:make-menu)))
        (gio:menu-append-item submenu (gio:make-menu-item :model menu :label "Load Excel File" 
                                                          :detailed-action "app.open"))
        (gio:menu-append-submenu menu "File" submenu))
      menu))
  (defun setup-file-dialog ()
    (let ((dialog (gtk:make-file-dialog)))
      dialog))
  (gtk:define-main-window (window (gtk:make-application-window :application gtk:*application*))
    (setf (gtk:window-title window) "Test Menu")
    (let ((action (gio:make-simple-action :name "open" :parameter-type nil)))
      (gio:action-map-add-action gtk:*application* action)
      (gtk:connect action "activate" (lambda (action param)
                                       (declare (ignore action param))
                                       (let ((dialog (gtk:make-file-dialog)))
                                         (gtk:file-dialog-open dialog window (gio:make-cancellable)
                                                               (gio:make-task ) -12932)
                                         (setf (gtk:window-transient-for dialog) window
                                               (gtk:window-modal-p dialog) t)
                                         (gtk:window-present dialog)))))
    (let ((window-box (gtk:make-box :orientation gtk:+orientation-vertical+ :spacing 0))
          (menubar (gtk:make-popover-menu-bar :model (test-menu-menu))))
      (gtk:box-append window-box menubar)
      (setf (gtk:window-child window) window-box))
    (unless (gtk:widget-visible-p window)
      (gtk:window-present window))))

(in-package #:gtk-test)

(proclaim '(optimize (safety 0) (speed 0)))

(cffi:defcallback tree-list-model-create-model-func :pointer ((item :pointer) (user-data :pointer))
  (declare (ignore user-data))
  (when item
    (let* ((uuid (string-object-string (gobj:pointer-object item 'string-object))))
      (print uuid)))
  (cffi:null-pointer))

(defstruct product-info
  name cost sale)

(define-application (:name closting :id "com.closting")
  (define-main-window (window (make-application-window :application *application*))


    (let* ((product-table (make-hash-table :test #'equal))
           (rows (loop :for (name cost sale) :in '(("HP Zbook 15" "250$" "300$")
                                                   ("Infinix S90" "40$" "60$")
                                                   ("Casio Calculator" "50$" "80$"))
                       :for product-info := (make-product-info :name name :cost cost :sale sale)
                       :for uuid := (prin1-to-string (uuid:make-v4-uuid))
                       :do (setf (gethash uuid product-table) product-info)
                       :collect uuid))
           (root-model (make-string-list :strings rows))
           (tree-list-model (make-tree-list-model :root (make-multi-selection :model root-model)
                                                  :passthrough nil
                                                  :autoexpand t
                                                  :create-func (cffi:callback tree-list-model-create-model-func)
                                                  :user-data (cffi:make-pointer (glib::put-object nil))
                                                  :user-destroy (cffi:callback glib::free-object-callback)))
           (column-view (make-column-view :model (make-multi-selection :model tree-list-model))))

      (let* ((factory (make-signal-list-item-factory))
             (col (make-column-view-column :title "Test" :factory factory)))

        (flet ((setup (factory item) (declare (ignore factory))
                 (let ((expander (make-tree-expander))
                       (label (make-label :str "")))
                   (setf (tree-expander-child expander) label
                         (list-item-child item) expander)))

               (bind (factory item) (declare (ignore factory))
                 (let* ((row (gobj:coerce (list-item-item item) 'tree-list-row))
                        (uuid (string-object-string (gobj:coerce (tree-list-row-item row) 'string-object)))
                        (expander (gobj:coerce (list-item-child item) 'tree-expander))
                        (label (gobj:coerce (tree-expander-child expander) 'label)))
                   (setf (label-text label) uuid))))

          (connect factory "setup" #'setup)
          (connect factory "bind" #'bind))

        (column-view-append-column column-view col))

      (setf (widget-vexpand-p column-view) t
            (widget-hexpand-p column-view) t
            (window-title window) "Closting"
            (window-child window) column-view)

      (unless (widget-visible-p window)
        (window-present window)))))

arithmetic error FLOATING-POINT-INVALID-OPERATION signalled
   [Condition of type FLOATING-POINT-INVALID-OPERATION]
 0: ((FLET SB-UNIX::RUN-HANDLER :IN SB-UNIX::%INSTALL-HANDLER) 8 #.(SB-SYS:INT-SAP #X66B8E750BD70) #.(SB-SYS:INT-SAP #X66B8E750BC40))
 1: ("foreign function: call_into_lisp_")
 2: ("foreign function: funcall3")
 3: ("foreign function: interrupt_handle_now_handler")
 4: ((LAMBDA (&REST GIR::ARGS-IN) :IN GIR::BUILD-FUNCTION) #.(SB-SYS:INT-SAP #X66B8E00FDB30))
 5: ((LAMBDA (GTK4::APP) :IN GTK-TEST::COM.CLOSTING.MAIN) #<unused argument>)
 6: ((LAMBDA (&REST GTK4::ARGS) :IN GTK4::ATTACH-RESTARTS) #<GIR::OBJECT-INSTANCE {10045A5D53}>)
 7: ((LAMBDA (GIR::CLOSURE RETURN GIR::N-VALUES GIR::PARAMS GIR::HINT GIR::DATA) :IN "/home/soz/quicklisp/dists/quicklisp/software/cl-gobject-introspection-20230618-git/src/signal.lisp") #.(SB-SYS:INT-SAP..
 8: ((LAMBDA (SB-ALIEN::ARGS-POINTER SB-ALIEN::RESULT-POINTER FUNCTION) :IN "/home/soz/quicklisp/dists/quicklisp/software/cl-gobject-introspection-20230618-git/src/signal.lisp") #<unavailable argument> #<..
 9: ("foreign function: funcall_alien_callback")
10: ("foreign function: #x50000DEB")
11: ((LAMBDA (&REST GIR::ARGS-IN) :IN GIR::BUILD-FUNCTION) #.(SB-SYS:INT-SAP #X66B8E0016930) NIL)
12: (GIO:APPLICATION-RUN #<GIR::OBJECT-INSTANCE {1002411A93}> NIL)
13: (SB-INT:SIMPLE-EVAL-IN-LEXENV (GTK-TEST::CLOSTING) #<NULL-LEXENV>)
14: (EVAL (GTK-TEST::CLOSTING))
15: ((LAMBDA NIL :IN SLYNK-MREPL::MREPL-EVAL-1))

CL-USER> (ql:quickload :cl-gtk4.webkit2/example)
To load "cl-gtk4.webkit2/example":
  Load 1 ASDF system:
    cl-gtk4.webkit2/example
; Loading "cl-gtk4.webkit2/example"
[package webkit2]

; file: /home/iam/quicklisp/dists/ultralisp/software/bohonghuang-cl-gtk4-20231015170944/webkit2.lisp
; in: GOBJECT-INTROSPECTION-WRAPPER:DEFINE-GIR-NAMESPACE "WebKit2"
;     (GOBJECT-INTROSPECTION-WRAPPER:DEFINE-GIR-NAMESPACE "WebKit2" "5.0")
; 
; caught COMMON-LISP:ERROR:
;   (during macroexpansion of (GOBJECT-INTROSPECTION-WRAPPER:DEFINE-GIR-NAMESPACE "WebKit2" ...))
;   Typelib file for namespace 'WebKit2', version '5.0' not found
; Debugger entered on #<UIOP/LISP-BUILD:COMPILE-FILE-ERROR {1005F712F3}>

(define-application (:name recycle-app
                     :id "org.recycle-app")
  (define-main-window
      (window (make-application-window :application *application*))
    (setf (window-title window) "recycle-app")
    (let ((box (make-box :orientation +orientation-vertical+
                         :spacing 4))
          (grid-input (make-grid-layout))
          (label-postalcode (make-label :str "Postal code:"))
          ;(label-streetname (make-label :str "Streetname:"))
          ;(label-housenumber (make-label :str "Housenumber:"))
          (button-collect (make-button :label "get collections")))
      (setf (grid-column-spacing grid-input) 8)
      (setf (grid-row-spacing grid-input) 4)
      (grid-attach grid-input label-postalcode 0 0 1 1)
      (box-append box grid-input)
      (box-append box button-collect)
      (setf (window-child window) box))
    (unless (widget-visible-p window)
      (window-present window))))``

(define-application (:name main
                     :id   "qwertyuiop")
  (define-main-window (main-window (make-application-window :application
                                                            *application*))
    (setf (window-title main-window)
          "Share-files")

    (let ((main-box (make-box :orientation +orientation-vertical+
                              :spacing     0)))
      (setf (window-child main-window)
            main-box)
    
      (window-present main-window))))

Backtrace:
 0: (GIR::G-SIGNAL-CONNECT-CLOSURE NIL "activate" #.(SB-SYS:INT-SAP #X7FF90EB56AF0) NIL)
 1: (GIR:CONNECT NIL "activate" #<FUNCTION (LAMBDA (&REST GTK4::ARGS) :IN GTK4::ATTACH-RESTARTS) {10074D8B1B}> :AFTER NIL :SWAPPED NIL)
      Locals:
        #:.DEFAULTING-TEMP. = NIL
        #:.DEFAULTING-TEMP.#1 = NIL
        AFTER = NIL
        C-HANDLER = #<FUNCTION (LAMBDA (&REST GTK4::ARGS) :IN GTK4::ATTACH-RESTARTS) {10074D8B1B}>
        C-HANDLER#1 = #<FUNCTION (LAMBDA (&REST GTK4::ARGS) :IN GTK4::ATTACH-RESTARTS) {10074D8B1B}>
        FLAGS = 0
        G-OBJECT = NIL
        #:G0 = #<FUNCTION (LAMBDA (&REST GTK4::ARGS) :IN GTK4::ATTACH-RESTARTS) {10074D8B1B}>
        OBJECT-PTR = NIL
        SIGNAL = "activate"
        STR-SIGNAL = "activate"
        SWAPPED = NIL
 2: (QWERTYUIOP.MAIN NIL)
      Locals:
        GTK4::ARGV = NIL
 3: (SB-INT:SIMPLE-EVAL-IN-LEXENV (MAIN) #<NULL-LEXENV>)
 4: (EVAL (MAIN))
 5: ((LAMBDA NIL :IN SLYNK-MREPL::MREPL-EVAL-1))
 --more--

	(let* ((model (gtk:make-list-store :types `(,(gobject:type-from-name "GtkLabel"))))
		   (selmodel (gtk:make-single-selection :model model))
		   (factory (gtk:make-signal-list-item-factory))
		   (view (gtk:make-list-view :model selmodel :factory factory))
		   (item1 (gtk:make-label :str "BRUHSEIDh")))
	  (gtk::list-box-append model 6)
	  (setf (gtk:window-child window) view))

(gtk:connect dialog "response"
                      (lambda (response) (format t "I'm in the response!")))

(ql:quickload '(:cl-gtk4 :cl-glib :bordeaux-threads))

(defun wait-trigger-gc ()
  (sleep 5)
  (sb-ext:gc))

(defvar *shortcuts* nil)
(defvar *window* nil)

(defun start (app)
  (let ((window (gtk4:make-application-window :application app))
        (shortcuts (gtk4:make-shortcut-controller)))

    (setf (gtk4:window-title window) "Test")
    (gtk4:widget-add-controller window shortcuts)
    ;; (setf *shortcuts* shortcuts)
    ;; (setf *window* window)

    (unless (gtk4:widget-visible-p window)
      (gtk4:window-present window))))

(defun run-app ()
  (let ((app (gtk4:make-application
              :application-id "org.rationalis-petra.test"
              :flags gio:+application-flags-flags-none+)))
    (gtk:connect app "activate" #'start)
    (unwind-protect (gio:application-run app nil)
      (progn
        (mapcar (alexandria:compose
                 #'gtk4:window-close
                 (alexandria:rcurry #'gobj:pointer-object 'window))
                (glib:glist-list (gtk4:application-windows app)))
        (glib:idle-add (lambda () (gio:application-quit app)))))))

(defun run-test ()
  (bt:make-thread #'wait-trigger-gc)
  (run-app))

(run-test)

(let ((level-bar-widget (gtk:make-level-bar :min-value 0 :max-value 4)))
  (setf (gtk:level-bar-mode level-bar-widget) gtk:+level-bar-mode-discrete+)
  (setf (gtk:level-bar-value level-bar-widget) 2)
  (gtk:box-append layout level-bar-widget))

  (let ((frame (gtk:make-frame :label (cu/full-name u)))
        (statblock (gtk:make-box :orientation gtk:+orientation-vertical+ :spacing 5))
        (img (gtk:make-picture :filename (namestring (cu/display u)))))
    (setf (gtk:frame-child frame) statblock)
    (gtk:box-append statblock img)
    frame)