From db530b65a828d94e2affaa65b01366b81a541f29 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 6 Feb 2019 17:27:41 -0800 Subject: Rename demostuff.tl to gtkffi.tl. --- demostuff.tl | 122 ----------------------------------------------------------- gtkffi.tl | 122 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ run.tl | 2 +- 3 files changed, 123 insertions(+), 123 deletions(-) delete mode 100644 demostuff.tl create mode 100644 gtkffi.tl diff --git a/demostuff.tl b/demostuff.tl deleted file mode 100644 index faad59f..0000000 --- a/demostuff.tl +++ /dev/null @@ -1,122 +0,0 @@ -(defun letter-to-type (ch) - (caseql ch - (#\v 'void) - (#\x 'cptr) - (#\i 'int) - (#\l 'long) - (#\f 'float) - (#\d 'double) - (#\s 'str) - (#\y 'closure))) - -(defmacro df (name sig) - (let ((si (list-str (symbol-name sig)))) - ^(deffi ,name ,(symbol-name name) ,(letter-to-type (car si)) - ,[mapcar letter-to-type (cdr si)]))) - -(with-dyn-lib "libgtk-3.so.0" - (df gtk_application_window_new xx) - (df gtk_window_set_title vxs) - (df gtk_window_set_default_size vxii) - (df gtk_button_box_new xi) - (df gtk_size_group_new xi) - (df gtk_bin_get_child xx) - #;(df gtk_label_set_xalign vxf) - (df gtk_container_add vxx) - (df gtk_label_new xs) - (df gtk_label_set_text vxs) - (df gtk_button_set_label vxs) - (df gtk_button_get_label sx) - (df gtk_button_new_with_label xs) - (df gtk_widget_destroy xx) - (df gtk_application_new xsi) - (df g_application_run ixix) - (df g_object_unref vx) - (df gtk_widget_show_all vx) - (df g_signal_connect_data lxsyxxi)) - -(deffi-cb button-cb void (cptr cptr)) - -(deffi-cb app-cb void (cptr cptr)) - -(defsymacro null cptr-null) - -(defun callbackname (object) - (make-sym `@object-cb`)) - -; window establishes a Gtk window object. -; The arguments are, what window object to establish, what -; application the window is used in, the window title, and -; the width and height of the window. -(defmacro window (awin app title wid ht) - ^(progn - (defparm ,awin (gtk_application_window_new ,app)) - (gtk_window_set_title ,awin ,title) - (gtk_window_set_default_size ,awin ,wid ,ht))) - -; box establishes a box object. The arguments are, whether the box -; contents are organized horizontally or vertically (h or v), what -; box is to be established, and what object to place the box in. -(defmacro box (hv abox placement) - (let ((horizvert (caseql hv - (h 0) (v 1) - (t (error "The first argument to box should \ - \ be h or v, not ~a" hv))))) - ^(progn - (defparm ,abox nil) - (progn - (set ,abox (gtk_button_box_new ,horizvert)) - (gtk_container_add ,placement ,abox))))) - -; button establishes a Gtk button object. The arguments are, -; the name of the button object, the text shown on the button, -; what object to place the button in, and the action of the -; button, which can be any sequence of code. -(defmacro button (abutton buttonlabel placement . body) - (let ((cb (callbackname abutton))) - ^(progn - (defparm ,abutton nil) - (defun ,cb (a b) - ,*body) - (set ,abutton (gtk_button_new_with_label ,buttonlabel)) - (g_signal_connect_data ,abutton "clicked" [button-cb ,cb] - null null 0) - (gtk_container_add ,placement ,abutton)))) - -; mbutton is like button, except that the button label text will be -; left aligned instead of centered, to make it neater in a column of -; buttons, such as for a menu. -(defmacro mbutton (abutton buttonlabel placement . body) - ^(progn - (button ,abutton ,buttonlabel ,placement ,*body) - (let ((thelabel (gtk_bin_get_child ,abutton))) - #;(gtk_label_set_xalign thelabel 0.0)))) - -; text establishes a Gtk "label" object which is actually a text -; display object. The arguments are, what text object to -; establish, the initial text to display, and what object to -; place this text object in. -(defmacro text (atext text0 placement) - ^(progn - (defparm ,atext (gtk_label_new ,text0)) - (gtk_container_add ,placement ,atext))) - -; xtext changes the text in a text object. -(defun xtext (textobject newtext) - (gtk_label_set_text textobject newtext)) - -; xlabel changes the text label on a button. -(defun xlabel (button newtext) - (gtk_button_set_label button newtext)) - -; gapp establishes a Gtk application. The arguments are, -; the name of the application object, and the code to be -; executed by the application. -(defmacro gapp (theapp . body) - (let ((cb (callbackname theapp))) - ^(progn - (defparm ,theapp nil) - (defun ,cb (a b) - ,*body) - (set ,theapp (gtk_application_new nil 0)) - (g_signal_connect_data ,theapp "activate" [app-cb ,cb] null null 0)))) diff --git a/gtkffi.tl b/gtkffi.tl new file mode 100644 index 0000000..faad59f --- /dev/null +++ b/gtkffi.tl @@ -0,0 +1,122 @@ +(defun letter-to-type (ch) + (caseql ch + (#\v 'void) + (#\x 'cptr) + (#\i 'int) + (#\l 'long) + (#\f 'float) + (#\d 'double) + (#\s 'str) + (#\y 'closure))) + +(defmacro df (name sig) + (let ((si (list-str (symbol-name sig)))) + ^(deffi ,name ,(symbol-name name) ,(letter-to-type (car si)) + ,[mapcar letter-to-type (cdr si)]))) + +(with-dyn-lib "libgtk-3.so.0" + (df gtk_application_window_new xx) + (df gtk_window_set_title vxs) + (df gtk_window_set_default_size vxii) + (df gtk_button_box_new xi) + (df gtk_size_group_new xi) + (df gtk_bin_get_child xx) + #;(df gtk_label_set_xalign vxf) + (df gtk_container_add vxx) + (df gtk_label_new xs) + (df gtk_label_set_text vxs) + (df gtk_button_set_label vxs) + (df gtk_button_get_label sx) + (df gtk_button_new_with_label xs) + (df gtk_widget_destroy xx) + (df gtk_application_new xsi) + (df g_application_run ixix) + (df g_object_unref vx) + (df gtk_widget_show_all vx) + (df g_signal_connect_data lxsyxxi)) + +(deffi-cb button-cb void (cptr cptr)) + +(deffi-cb app-cb void (cptr cptr)) + +(defsymacro null cptr-null) + +(defun callbackname (object) + (make-sym `@object-cb`)) + +; window establishes a Gtk window object. +; The arguments are, what window object to establish, what +; application the window is used in, the window title, and +; the width and height of the window. +(defmacro window (awin app title wid ht) + ^(progn + (defparm ,awin (gtk_application_window_new ,app)) + (gtk_window_set_title ,awin ,title) + (gtk_window_set_default_size ,awin ,wid ,ht))) + +; box establishes a box object. The arguments are, whether the box +; contents are organized horizontally or vertically (h or v), what +; box is to be established, and what object to place the box in. +(defmacro box (hv abox placement) + (let ((horizvert (caseql hv + (h 0) (v 1) + (t (error "The first argument to box should \ + \ be h or v, not ~a" hv))))) + ^(progn + (defparm ,abox nil) + (progn + (set ,abox (gtk_button_box_new ,horizvert)) + (gtk_container_add ,placement ,abox))))) + +; button establishes a Gtk button object. The arguments are, +; the name of the button object, the text shown on the button, +; what object to place the button in, and the action of the +; button, which can be any sequence of code. +(defmacro button (abutton buttonlabel placement . body) + (let ((cb (callbackname abutton))) + ^(progn + (defparm ,abutton nil) + (defun ,cb (a b) + ,*body) + (set ,abutton (gtk_button_new_with_label ,buttonlabel)) + (g_signal_connect_data ,abutton "clicked" [button-cb ,cb] + null null 0) + (gtk_container_add ,placement ,abutton)))) + +; mbutton is like button, except that the button label text will be +; left aligned instead of centered, to make it neater in a column of +; buttons, such as for a menu. +(defmacro mbutton (abutton buttonlabel placement . body) + ^(progn + (button ,abutton ,buttonlabel ,placement ,*body) + (let ((thelabel (gtk_bin_get_child ,abutton))) + #;(gtk_label_set_xalign thelabel 0.0)))) + +; text establishes a Gtk "label" object which is actually a text +; display object. The arguments are, what text object to +; establish, the initial text to display, and what object to +; place this text object in. +(defmacro text (atext text0 placement) + ^(progn + (defparm ,atext (gtk_label_new ,text0)) + (gtk_container_add ,placement ,atext))) + +; xtext changes the text in a text object. +(defun xtext (textobject newtext) + (gtk_label_set_text textobject newtext)) + +; xlabel changes the text label on a button. +(defun xlabel (button newtext) + (gtk_button_set_label button newtext)) + +; gapp establishes a Gtk application. The arguments are, +; the name of the application object, and the code to be +; executed by the application. +(defmacro gapp (theapp . body) + (let ((cb (callbackname theapp))) + ^(progn + (defparm ,theapp nil) + (defun ,cb (a b) + ,*body) + (set ,theapp (gtk_application_new nil 0)) + (g_signal_connect_data ,theapp "activate" [app-cb ,cb] null null 0)))) diff --git a/run.tl b/run.tl index ad97965..2c0a8f2 100755 --- a/run.tl +++ b/run.tl @@ -10,7 +10,7 @@ (defun load-demo () (with-compilation-unit - (comp-load "demostuff") + (comp-load "gtkffi") (comp-load "menu") (each ((i (range 1 9))) (comp-load `demo@i`)))) -- cgit v1.2.3