Add files via upload

5 files changed, 264 insertions, 0 deletions

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.