From ea787200c2c3a4af54594dae98998c7a18949993 Mon Sep 17 00:00:00 2001 From: mifpasoti <46360451+mifpasoti@users.noreply.github.com> Date: Thu, 3 Jan 2019 18:41:13 -0500 Subject: Add files via upload --- demo1 | 28 +++++++++++++ demo2 | 41 +++++++++++++++++++ demo3 | 30 ++++++++++++++ demostuff | 138 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ intro | 27 ++++++++++++ 5 files changed, 264 insertions(+) create mode 100644 demo1 create mode 100644 demo2 create mode 100644 demo3 create mode 100644 demostuff create mode 100644 intro diff --git a/demo1 b/demo1 new file mode 100644 index 0000000..413d3fd --- /dev/null +++ b/demo1 @@ -0,0 +1,28 @@ +#!/bin/bash +sbcl --script << 'EOF' 2> >(sed '/^Backtrace/,$d;/^; /d') + +; Refer to the demostuff file for definitions and descriptions. + +(load "demostuff") + +(defun main () + (gapp demo1 + (window win demo1 "Four Button Demo" 300 150) + (box h outerbox win) + (box v mainbox outerbox) + (box h buttons mainbox) + (box h numbox mainbox) + (box v leftbuttons buttons) + (box v rightbuttons buttons) + (text thenum "Zero" numbox) + (button button1 "1" leftbuttons (xtext thenum "One")) + (button button2 "2" leftbuttons (xtext thenum "Two")) + (button button3 "3" rightbuttons (xtext thenum "Three")) + (button button4 "4" rightbuttons (xtext thenum "Four")) + (gtk_widget_show_all win)) + (g_application_run demo1 0 nil) + (g_object_unref demo1)) + +(main) + +EOF diff --git a/demo2 b/demo2 new file mode 100644 index 0000000..3e6ef61 --- /dev/null +++ b/demo2 @@ -0,0 +1,41 @@ +#!/bin/bash +sbcl --script << 'EOF' 2> >(sed '/^Backtrace/,$d;/^; /d') + +; Refer to the demostuff file for definitions and descriptions. + +(load "demostuff") + +(defun main () + (gapp demo2 + (window win demo2 "Numerals Demo" 250 250) + (box h outerbox win) + (box v mainbox outerbox) + (box h numbox mainbox) + (button but1 (bnt 1) mainbox (xnum (bn 1))) + (button but2 (bnt 2) mainbox (xnum (bn 2))) + (button but3 (bnt 3) mainbox (xnum (bn 3))) + (button but4 (bnt 4) mainbox (xnum (bn 4))) + (button but5 (bnt 5) mainbox (xnum (bn 5))) + (button numeralbutton "Numerals" mainbox (togglenumar)) + (text thenum "zero" numbox) + (gtk_widget_show_all win)) + (g_application_run demo2 0 nil) + (g_object_unref demo2)) + +(defparameter numar 'a) ; 'r = I II II IV V. 'a = 1 2 3 4 5. + +; Button number (bn) and button number text (bnt): +(defun bn (n) (nth (1- n) '(11 22 33 44 55))) +(defun bnt (n) (format nil (if (eq numar 'a) "~d" "~@R") (bn n))) + +(defun togglenumar () + (setq numar (if (eq numar 'a) 'r 'a)) + (loop as button in (list but1 but2 but3 but4 but5) + as n from 1 to 5 + do (xlabel button (bnt n)))) + +(defun xnum (n) (xtext thenum (format nil "~R" n))) + +(main) + +EOF diff --git a/demo3 b/demo3 new file mode 100644 index 0000000..fbe2d17 --- /dev/null +++ b/demo3 @@ -0,0 +1,30 @@ +#!/bin/bash +sbcl --script << 'EOF' 2> >(sed '/^Backtrace/,$d;/^; /d') + +; Refer to the demostuff file for definitions and descriptions. + +(load "demostuff") + +(defun main () + (gapp demo3 + (window win demo3 "Dates Demo" 300 200) + (box h outerbox win) + (box v mainbox outerbox) + (button button1 "1066" mainbox (relabel button1 1066)) + (button button2 "1415" mainbox (relabel button2 1415)) + (button button3 "1492" mainbox (relabel button3 1492)) + (button button4 "1620" mainbox (relabel button4 1620)) + (button button5 "1776" mainbox (relabel button5 1776)) + (gtk_widget_show_all win)) + (g_application_run demo3 0 nil) + (g_object_unref demo3)) + +(defun relabel (button number) + (let* ((old (gtk_button_get_label button)) + (isdigits (<= 0 (- (char-int (aref old 0)) (char-int #\0)) 9)) + (new (format nil (if isdigits "~@R" "~d") number))) + (xlabel button new))) + +(main) + +EOF diff --git a/demostuff b/demostuff new file mode 100644 index 0000000..9f091bd --- /dev/null +++ b/demostuff @@ -0,0 +1,138 @@ +#| +This file of "demostuff", used by the demo scripts, loads Gtk +and defines gapp, window, box, button, text, xtext, and xlabel. + gapp Establishes a Gtk app. Its arguments are the app name + and the code to be executed in the app. + window Establishes a window. Its arguments are the name of + the window object, the name of the app the window is + used in, the window title, and the default width and + height of the window. + box Establishes a box to place Gtk objects in. Its three + arguments are, first, h or v, for whether the contents + of the box are to be organized horizontally or + vertically, second, what box to establish, and third, + what object the box is to be placed in. + button Establishes a button. Its arguments are, what button + to establish, the initial label text on the button, + the object the button is to be placed in, and the code + to be executed when the button is pressed. + text Establishes a text display object, which Gtk calls a + label. Its arguments are the name of the text object, + the initial text, and what object to place the text + object in. + xtext Is a function to display some text in a text object. + Its arguments are what text object to display the text + in, and what text to display. + xlabel Is a function to update a button label. Its arguments + are the button and the new text. +|# + +(load-shared-object "/usr/lib/x86_64-linux-gnu/libgtk-3.so.0") + +; Gtk relies on being able to divide by zero. To prevent it from +; being an error, the following line changes the floating point +; errors to just overflow and invalid, and not division-by-zero. +; This isn't needed in most programming languages, because most +; of them default to having it not be an error. +(sb-int:set-floating-point-modes :traps '(:overflow :invalid)) + +; The following makes Gtk functions available, giving their names +; and argument types. +(loop as gfunc in + '((gtk_application_window_new (* t) (* t)) + (gtk_window_set_title void (* t) c-string) + (gtk_window_set_default_size void (* t) int int) + (gtk_button_box_new (* t) int) + (gtk_container_add void (* t) (* t)) + (gtk_label_new (* t) c-string) + (gtk_label_set_text void (* t) c-string) + (gtk_button_set_label void (* t) c-string) + (gtk_button_get_label c-string (* t)) + (gtk_button_new_with_label (* t) c-string) + (gtk_widget_destroy (* t) (* t)) + (gtk_application_new (* t) c-string int) + (g_application_run int (* t) int (* t)) + (g_object_unref void (* t)) + (g_signal_connect_data long + (* t) c-string (function void (* t) (* t)) (* t) (* t) int) + (gtk_widget_show_all void (* t))) + do (eval (nconc (list 'define-alien-routine (car gfunc) (cadr gfunc)) + (loop as argname in '(a b c d e f g h i j k l m) + as argtype in (cddr gfunc) + collect (list argname argtype))))) + +; callbackname makes a callback name from an object name. +; The eval-when makes it usable during macro expansions. +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun callbackname (object) + (intern (concatenate 'string (symbol-name object) "-CALLBACK")))) + +; 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) + (eval `(defparameter ,awin nil)) + `(progn + (setf ,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) + (eval `(defparameter ,abox nil)) + (let ((horizvert (case hv (h 0) (v 1) (t (error + "The first argument to box should be h or v, not ~a" hv))))) + `(progn + (setf ,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 body) + (eval `(defparameter ,abutton nil)) + (let ((cb (callbackname abutton))) + (eval `(sb-alien::define-alien-callback + ,cb void ((a (* t)) (u (* t))) + ,@body)) + `(progn + (setf ,abutton (gtk_button_new_with_label ,buttonlabel)) + (g_signal_connect_data ,abutton "clicked" ,cb nil nil 0) + (gtk_container_add ,placement ,abutton)))) + +; 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) + (eval `(defparameter ,atext nil)) + `(progn + (setf ,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 body) + (eval `(defparameter ,theapp nil)) + (let ((cb (callbackname theapp))) + (eval `(sb-alien::define-alien-callback + ,cb void ((a (* t)) (u (* t))) + ,@body)) + `(progn + (setf ,theapp (gtk_application_new nil 0)) + (g_signal_connect_data ,theapp "activate" ,cb nil nil 0)))) + +; End of the demostuff file, which gets loaded by each demo script. diff --git a/intro b/intro new file mode 100644 index 0000000..47f663e --- /dev/null +++ b/intro @@ -0,0 +1,27 @@ +These demos demonstrate using Gtk directly from a higher level language. +None of the demos have any low level code in them. There is no need for +any makefiles, C compilers, or any other low level stuff. There is +probably no need to install Gtk, because it's probably already used by +your Linux. + +To use a different high level language for these demos, it is of course +necessary to edit them to change the language. But they aren't very long +and that might not take very long. It's strongly advised to run the +present demos first, and make some minor changes to them, to see the +differences, to make sure to understand how they work, before starting to +change them to a different language. + +When a demo script gets invoked, the code gets compiled into memory, with +a very fast compiler, so there will be no object files, executable binaries, +etc., unless those are desired. The only requirement is to download or copy +and paste the demos and demostuff and make each demo executable with +"chmod +x demo". Then run the demos with "./demo1 ; ./demo2 ; ./demo3". + +If there are error messages about not finding sbcl, it might be necessary +to install that, or to add it to the path. Installing sbcl is easy, usually +via the Linux distro. + +In the rare circumstance that a particular Linux distro doesn't have sbcl, +you could install a binary version from Sourceforge: +prdownloads.sourceforge.net/sbcl/sbcl-1.4.14-x86-64-linux-binary.tar.bz2 +or, if desired, you could compile it from sources from sbcl.org. -- cgit v1.2.3