Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Delivering application based on sketch #58

Open
Gleefre opened this issue Nov 5, 2022 · 4 comments
Open

Delivering application based on sketch #58

Gleefre opened this issue Nov 5, 2022 · 4 comments

Comments

@Gleefre
Copy link
Contributor

Gleefre commented Nov 5, 2022

Hello,
I'm trying to make a standalone executable of an app made with sketch. I tried to look at qelt, since it has binaries here (itch.io), but I haven't been able to find a solution.

How can I define a main function? Just doing (make-instance 'app) doesn't work - main thread is closed immediately and the application is close just after starting up.

@Gleefre
Copy link
Contributor Author

Gleefre commented Nov 10, 2022

Hi again!
So I have been reading through source code and I have discovered *build* variable.

It seems that the following should work (make-this-thread-main as in kit.sdl2 README):

(let ((sketch::*build* t))
  (sdl2:make-this-thread-main
   (lambda ()
     (make-instance 'app))))

However, *build* is not exported, is it fine using it like this?

@vydd
Copy link
Owner

vydd commented Nov 11, 2022

Hi @Gleefre! I found the script I think I used to build sketch:

(ql:quickload :bordeaux-threads)
(ql:quickload :trivial-dump-core)
(ql:quickload :qelt)

(defparameter *running* t)

(defmethod kit.sdl2:close-window :after ((instance sketch::sketch))
  (setf *running* nil))

(defun run ()
  (sb-ext:disable-debugger)
  (sketch::initialize-sketch)
  (bt:make-thread #'qelt:qelt)
  (loop while *running* do (sleep 1))
  #++
  (let ((thread (find "SDL2 Main Thread" (bt:all-threads)
		      :key 'bt:thread-name
		      :test 'equalp)))
    (bt:join-thread thread)))

(sb-ext:save-lisp-and-die "qelt.exe" :toplevel #'run :executable t)

.exe was there just for the Windows build I think - not sure if I was changing anything for Linux builds.
This is probably not the best way to do it (#++ is definitely an artifact of me trying out multiple things).

It's also not using ::*build* and I don't know why, as it probably is needed for


If you figure it out, feel free to create a PR. Ideally it would be something like sketch:make-executable. I could also invest some time into it relatively soon.

@Gleefre
Copy link
Contributor Author

Gleefre commented Nov 11, 2022

Hello! Thanks for your script, I'll give it a look.

I don't think that such a feature should be sketch:make-executable, since it will be working on sbcl only and will be forcing one method of making an executable (asdf:make can be another way of doing).

Instead, I think it should be something similar to sdl2kit define-start-function.

@Gleefre
Copy link
Contributor Author

Gleefre commented Apr 8, 2023

I have been thinking on the possibilities of the define-start-function.

I think it must be able to define both toplevel function (to pass to the save-lisp-or-die or be used in combination with asdf:make) and one that can be used from REPL.

Also it would be nice if it could be used to define additional initialization and quit parts (like sdl2-mixer).

I have come up with following usage example:

(define-start-function (start) key-piano (:resizable t)
  (:on-close (app)
    (close-notes (key-piano-notes app)))
  (:start
    (sdl2-mixer:init :wave)
    (sdl2-mixer:open-audio 22050 :s16sys 1 1024)
    (sdl2-mixer:allocate-channels 100))
  (:quit
    (sdl2-mixer:halt-channel -1)
    (sdl2-mixer:close-audio)
    (sdl2-mixer:quit)
    (print 'bye!)))

And a somewhat ugly implementation:

(defmacro define-start-function ((name &optional toplevel-name)
                                 sketch-name initargs
                                 &rest options)
  "If toplevel-name is not specified uses `<name>-toplevel'.
Possible options:
  :setup - defines `sketch:setup' `:before' method
      (:setup (<arg-name>)
        <body>)
  :on-close - defines `kit.sdl2:on-close' `:before' method;
      (:on-close (<arg-name>)
        <body>)
  :start - executed before creating an instance of sketch (on every function call)
      (:start <body>)
  :quit - executed after the instance is closed (only for toplevel function)
      (:quit <body>)"
  (let ((initargs-name (gensym "INITARGS"))
        (toplevel-name (or toplevel-name
                           (intern (concatenate 'string
                                                (symbol-name name)
                                                "-TOPLEVEL")
                                   (symbol-package name)))))
    (flet ((define-method (name allow-other-keys arg &rest body)
             `(defmethod ,name :before ((,@arg ,sketch-name)
                                        ,@(if allow-other-keys
                                              '(&key &allow-other-keys)))
                (declare (ignorable ,@arg))
                ,@body)))
      `(progn
         ,(alexandria:when-let (arg-and-body (cdr (assoc :setup options)))
            (apply #'define-method 'sketch:setup t arg-and-body))
         ,(alexandria:when-let (arg-and-body (cdr (assoc :on-close options)))
            (apply #'define-method 'kit.sdl2:close-window nil arg-and-body))
         (defun ,name (&rest ,initargs-name &key &allow-other-keys)
           (initialize-sketch)
           ,@(cdr (assoc :start options))
           (apply #'make-instance ',sketch-name (append ,initargs-name ',initargs)))
         (defun ,toplevel-name ()
           (sdl2:make-this-thread-main
            (lambda ()
              (let ((*build* t))
                (initialize-sketch)
                ,@(cdr (assoc :start options))
                (make-instance ',sketch-name ,@initargs))))
           ,@(cdr (assoc :quit options)))
         (values ,name ,toplevel-name)))))

What do you think?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

2 participants