Sat Feb 20 18:23:58 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Fix analog-clock timer interval

Mon Feb 8 18:04:52 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Load qt.webkit, .uitools & .phonon optionaly.

Sun Feb 7 16:06:42 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Qt XML Stream Lint Example.

Mon Jan 25 22:13:57 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Qt Example: Colliding Mice

Sat Jan 23 23:18:27 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Qt example: Analog Clock

Tue Jan 19 16:01:21 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Use qt.nokia.com for class-browser api doc.

Sun Jan 10 09:54:26 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* modular smoke & cleanup.

Sun Dec 13 13:47:57 CET 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Support ASDF instead of Mudballs.

Wed Sep 2 14:06:44 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Let cl-smoke to do the return value user conversion.

Thu Jul 23 00:16:26 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Phonon video example

Mon Jul 6 23:50:38 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Pleated Hyperbolic Paraboloid

Fri Jul 3 12:17:07 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Fix SBCL #'software-version crash also when starting from an image.

Wed Jul 1 13:01:24 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Use new qt:with-app.

Sun Jun 21 11:28:55 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* All Qt modules are now in the :qt package.

Sun May 31 23:06:50 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Undo support for tick tack toe

Thu May 28 16:23:33 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* ASDF support

Sun May 24 17:00:42 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Testrun examples on commit

Tue May 19 17:15:52 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Add Smoke C wrapper libraries to bundle

--- old-qt.examples/cl-smoke.qt.examples.asd 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/cl-smoke.qt.examples.asd 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,46 @@

+;; :weakly-depends-on loaded the system to late to use #+feature for

+;; components; thus we load them earlyer.

+(dolist (system '(:cl-smoke.qt.webkit :cl-smoke.qt.uitools

+ :cl-smoke.qt.phonon))

+ (when (asdf:find-system system nil)

+ (asdf:oos 'asdf:load-op system)))

+

+(defsystem :cl-smoke.qt.examples

+ :name :cl-smoke.qt.examples

+ :version (0 0 1)

+ :author "Tobias Rautenkranz"

+ :license "X11 & GPL"

+ :description "Qt examples."

+ :depends-on (:cl-smoke.qt.gui)

+ ;;:cl-opengl :cl-glu :cl-smoke.qt.opengl)

+

+ :components

+ ((:module "src"

+ :components

+ ((:file "package")

+ (:file "hello-world" :depends-on ("package"))

+ #+qt.phonon

+ (:file "video" :depends-on ("package"))

+ (:file "hello-world-quit" :depends-on ("package"))

+ (:file "i18n-hello-world" :depends-on ("package"))

+ (:file "tick-tack-toe" :depends-on ("package"))

+ (:file "launcher" :depends-on ("package"))

+ #+qt.uitools

+ (:file "ui" :depends-on ("package"))

+ (:file "repl" :depends-on ("package"))

+ #+qt.webkit

+ (:file "class-browser" :depends-on ("package"))

+ (:module "qt"

+ :depends-on ("package")

+ :components

+ ((:file "analog-clock")

+ (:file "xmlstreamlint")

+ (:file "colliding-mice")))))))

+ ;;(:module "origami"

+ ;; :depends-on ("package")

+ ;; :components

+ ;; ((:file "origami" :depends-on ("tri"))

+ ;; (:file "tri")))))))

+

+(defmethod perform ((o test-op) (c (eql (find-system :cl-smoke.qt.examples))))

+ (funcall (intern (string :test-all) (string :qt.examples))))

--- old-qt.examples/make-bundle.sh 2014-10-29 00:57:12.000000000 +0100

+++ new-qt.examples/make-bundle.sh 2014-10-29 00:57:12.000000000 +0100

@@ -9,7 +9,11 @@

--eval '(mb:load :qt.examples)' \

--eval "(smoke::add-startup-function #'(lambda() (format t \"\

cl-smoke: build: `date -R`~%\

-Run examples with: (qt.examples:launcher)\")))" \

+Run the examples with: (qt.examples:launcher)\")))" \

--eval "(smoke:save-bundle \"cl-smoke-qt.examples.linux.x86.run\"\

- '(\"src/widget.ui\" \"src/hello-world_de.qm\"))" \

+ '(\"src/widget.ui\" \"src/hello-world_de.qm\" \

+ \"/usr/local/lib/libsmokeqt.so.2\" \

+ \"/usr/local/lib/libsmokeqtuitools.so.2\" \

+ \"/usr/local/lib/libsmokephonon.so.2\" \

+ \"/usr/local/lib/libsmokeqtwebkit.so.2\" ))" \

--eval '(quit)'

--- old-qt.examples/qt.examples.mbd 2014-10-29 00:57:11.000000000 +0100

+++ new-qt.examples/qt.examples.mbd 1970-01-01 01:00:00.000000000 +0100

@@ -1,63 +0,0 @@

-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-

-;;;

-;;; Copyright 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

-;;;

-;;; Permission is hereby granted, free of charge, to any person

-;;; obtaining a copy of this software and associated documentation

-;;; files (the "Software"), to deal in the Software without

-;;; restriction, including without limitation the rights to use,

-;;; copy, modify, merge, publish, distribute, sublicense, and/or sell

-;;; copies of the Software, and to permit persons to whom the

-;;; Software is furnished to do so, subject to the following

-;;; conditions:

-;;;

-;;; The above copyright notice and this permission notice shall be

-;;; included in all copies or substantial portions of the Software.

-;;;

-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,

-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES

-;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT

-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,

-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING

-;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR

-;;; OTHER DEALINGS IN THE SOFTWARE.

-

-

-;;; SYSDEF.CMAKE

-(defpackage :sysdef.cmake

- (:use :cl :sysdef)

- (:export :cmake-file :cmake-library))

-

-(in-package :sysdef.cmake)

-(defclass sysdef.cmake:cmake-file (source-file)

- ()

- (:default-initargs :type "txt"))

-

-(defclass sysdef.cmake:cmake-library (component)

- ())

-;;; end SYSDEF.CMAKE

-

-(in-package :sysdef-user)

-(eval-when (:compile-toplevel :load-toplevel :execute)

- (use-package :sysdef.cmake))

-

-(define-system :qt.examples ()

- (:version 0 0 1)

- (:documentation "Qt examples.")

- (:author "Tobias Rautenkranz")

- (:license "X11")

- (:needs :qt :qt.webkit :qt.uitools :sysdef.cmake)

- (:components

- ("src" module

- (:components

- ("CMakeLists" cmake-file)

- "package"

- ("hello-world" (:needs "package"))

- ("hello-world-quit" (:needs "package"))

- ("i18n-hello-world" (:needs "package" "CMakeLists"))

- ("tick-tack-toe" (:needs "package"))

- ("launcher" (:needs "package"))

- ("ui" (:needs "package"))

- ("repl" (:needs "package"))

- ("class-browser" (:needs "package"))))))

--- old-qt.examples/src/class-browser.lisp 2014-10-29 00:57:11.000000000 +0100

+++ new-qt.examples/src/class-browser.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -16,9 +16,8 @@

(if (and (cxx:is-valid index)

(< (cxx:row index) (length (items list)))

(= role (value qt:+display-role+)))

- (qt:make-variant (string-downcase

- (class-name (aref (items list) (cxx:row index)))))

- (make-instance 'qt:variant)))

+ (string-downcase (class-name (aref (items list) (cxx:row index))))

+ (qt:make-variant)))

(defun class-at (model-index)

(aref (items (cxx:model model-index)) (cxx:row model-index)))

@@ -31,7 +30,7 @@

(info :reader class-info

:initform (make-instance 'qt:label))

(web-view :reader web-view

- :initform (make-instance 'qt.webkit:web-view)))

+ :initform (make-instance 'qt:web-view)))

(:metaclass cxx:class))

(defun setup-class-list (classes)

@@ -80,9 +79,9 @@

(defun set-info (info web-view model-index)

(let* ((class (class-at model-index)))

- (cxx:load web-view (format nil "http://doc.trolltech.com/~A/~A.html"

- (subseq (qt:q-version) 0 3)

- (remove #\: (smoke:name class) :count 1)))

+ (cxx:load web-view (format nil "http://qt.nokia.com/doc/~A/~(~A~).html"

+ (subseq (qt:q-version) 0 3)

+ (remove #\: (smoke:name class) :count 1)))

(cxx:set-text info

(format nil "<h1>qt:~A</h1>

<p>~A</p>

@@ -104,7 +103,7 @@

(defun class-browser ()

"Qt Class Browser"

- (qt:with-app

- (let ((browser (make-instance 'class-browser)))

- (cxx:show browser)

- (qt:exec))))

+ (qt:with-app ()

+ (let ((browser (make-instance 'class-browser)))

+ (cxx:show browser)

+ (qt:exec))))

--- old-qt.examples/src/hello-world-quit.lisp 2014-10-29 00:57:11.000000000 +0100

+++ new-qt.examples/src/hello-world-quit.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -5,7 +5,7 @@

(defun hello-world-quit ()

"Quit on push-button click"

- (qt:with-app

+ (qt:with-app ()

(let ((quit (make-instance 'qt:push-button :args '("Quit")))

(font (make-instance 'qt:font :args (list "Times"

18

@@ -16,8 +16,8 @@

(qt:connect (qt:get-signal quit "pressed()")

#'(lambda ()

(format t "About to quit()~%")))

-

+

(qt:connect (qt:get-signal quit "clicked()")

(qt:get-slot (qt:app) "quit()"))

(cxx:show quit)

- (qt:exec quit))))

+ (qt:exec))))

--- old-qt.examples/src/hello-world.lisp 2014-10-29 00:57:11.000000000 +0100

+++ new-qt.examples/src/hello-world.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -5,7 +5,7 @@

(defun hello-world ()

"Hello world"

- (qt:with-app

+ (qt:with-app ()

(let ((widget (make-instance 'qt:push-button :args '("Hello world"))))

(cxx:show widget)

- (qt:exec widget))))

+ (qt:exec))))

--- old-qt.examples/src/hello-world_de.po 2014-10-29 00:57:11.000000000 +0100

+++ new-qt.examples/src/hello-world_de.po 2014-10-29 00:57:12.000000000 +0100

@@ -6,7 +6,7 @@

msgstr ""

"Project-Id-Version: hello-world\n"

"Report-Msgid-Bugs-To: \n"

-"POT-Creation-Date: 2009-05-14 13:56+0200\n"

+"POT-Creation-Date: 2009-07-01 01:17+0200\n"

"PO-Revision-Date: 2009-03-21 11:41+0100\n"

"Last-Translator: Tobias Rautenkranz <tobias@rautenkranz.ch>\n"

"Language-Team: German <>\n"

@@ -16,12 +16,12 @@

"X-Generator: Lokalize 0.3\n"

"Plural-Forms: nplurals=2; plural=n != 1;\n"

-#: i18n-hello-world.lisp:19

+#: i18n-hello-world.lisp:21

msgctxt "hello-world"

msgid "Lisp Qt Example"

msgstr "Lisp Qt Beispiel"

-#: i18n-hello-world.lisp:20

+#: i18n-hello-world.lisp:22

#, lisp-format

msgid ""

"<h1>Hello world</h1>\n"

--- old-qt.examples/src/i18n-hello-world.lisp 2014-10-29 00:57:11.000000000 +0100

+++ new-qt.examples/src/i18n-hello-world.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -5,24 +5,27 @@

(defun i18n-hello-world ()

"i18n hello world"

- (qt:with-app

- ;; ensures that the message catalogs are found regardless

- ;; of the current directory.

- (let ((source-path (directory-namestring

- (mb.sysdef:input-file

- (mb.sysdef:find-component :qt.examples "src"

- "i18n-hello-world")))))

- (qt:with-translator ("hello-world"

- *default-pathname-defaults*

- source-path)

- (let ((widget (make-instance 'qt:label)))

- (setf (cxx:window-title widget) (qt:tr "Lisp Qt Example" "hello-world")

- (cxx:text widget) (format nil (qt:tr "<h1>Hello world</h1>

+ (qt:with-app ()

+ (qt:with-translator ("hello-world"

+ *default-pathname-defaults*

+ *source-path*)

+ (let ((widget (make-instance 'qt:label)))

+ (setf (cxx:window-title widget) (qt:tr "Lisp Qt Example" "hello-world")

+ (cxx:text widget) (format nil (qt:tr "<h1>Hello world</h1>

You are running ~A version ~A on a ~A ~A")

- (lisp-implementation-type)

- (lisp-implementation-version)

- (software-type)

- (software-version)))

- (cxx:show widget)

- (qt:exec widget))))))

+ (lisp-implementation-type)

+ (lisp-implementation-version)

+ (software-type)

+ (software-version)))

+ (cxx:show widget)

+ (qt:exec)))))

+

+;; FIXME:

+;; calling #'software-version from the qt:application event loop

+;; segfaults in SBCL. The first call caches the result in

+;; sb-sys::*software-version* and we thus prevent the crash in

+;; (run-program "/bin/uname" [...]).

+#+sbcl

+(smoke:eval-startup (:load-toplevel)

+ (software-version))

--- old-qt.examples/src/launcher.lisp 2014-10-29 00:57:11.000000000 +0100

+++ new-qt.examples/src/launcher.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -26,7 +26,7 @@

(defun launcher ()

"Launch the Qt examples"

- (qt:with-app

+ (qt:with-app ()

(let ((launcher (make-instance 'launcher)))

(cxx:show launcher)

(qt:exec))))

--- old-qt.examples/src/origami/Makefile 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/src/origami/Makefile 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,7 @@

+tri.lisp : tri.head.lisp tri.input tri.util.lisp

+ cp tri.head.lisp $@

+ echo ')read "tri.input"' | AXIOMsys

+

+.PHONY: clean

+clean:

+ rm -f tri.lisp

--- old-qt.examples/src/origami/origami.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/src/origami/origami.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,283 @@

+;;; OpenGL Pleated Hyperbolic Paraboloid

+;;;

+;;; Construction using the method in:

+;;;

+;;; (Non)existence of Pleated Folds: How Paper Folds Between Creases

+;;;

+;;; Erik D. Demaine, Martin L. Demaine, Vi Hart, Gregory N. Price,

+;;; Tomohiro Tachi

+;;;

+;;; http://arxiv.org/abs/0906.4747

+;;;

+;;; Section 6: Existence of Triangulated Hyperbolic Paraboloid

+

+(in-package :qt.examples)

+

+(defun triangulid-length (n diagonal-part-length)

+ "Length of the extra fold from ring N to the next."

+ (sqrt (+ (expt (* n diagonal-part-length) 2)

+ (expt (* (1+ n) diagonal-part-length) 2))))

+

+(defun length-in-diagonal-plane (distance-to-plane length)

+ "Length in the r z plane."

+ (sqrt (- (expt length 2)

+ (expt distance-to-plane 2))))

+

+(defun next-vertex (z-x r-x z-y diagonal-part-length

+ length-in-diagonal-plane n)

+ (multiple-value-bind (r-1 z-1)

+ (v1 z-x z-y

+ r-x

+ diagonal-part-length

+ length-in-diagonal-plane)

+ (multiple-value-bind (r-2 z-2)

+ (v2 z-x z-y

+ r-x

+ diagonal-part-length

+ length-in-diagonal-plane)

+ ;; alternate valley and mountain fold

+ (if (or (and (> z-1 z-2)

+ (evenp n))

+ (and (< z-1 z-2)

+ (oddp n)))

+ (values z-1 r-1)

+ (values z-2 r-2)))))

+

+(defun make-grid-points (fold-angle n)

+ "Returns the vertex points for FOLD-ANGLE of the center diagonal

+and N rings."

+ ;; Cylindrical coodinates (θ = 0 or θ = π/2)

+ ;; the x and y axes are the diagonals of the square paper.

+ ;; Due to symetry only one fourth need to be calculated.

+ (let (;; θ = 0

+ (z-x (make-array n

+ :element-type 'double-float

+ :initial-element 0d0))

+ (r-x (make-array n

+ :element-type 'double-float

+ :initial-element 0d0))

+ ;; θ = π/2

+ (z-y (make-array n

+ :element-type 'double-float

+ :initial-element 0d0))

+

+ (r-y (make-array n

+ :element-type 'double-float

+ :initial-element 0d0))

+ (diagonal-part-length 1d0))

+ ;; the innermost square

+ (setf (aref r-x 0) diagonal-part-length)

+ (setf (aref z-y 0)

+ (- (* (cos (/ fold-angle 2)) diagonal-part-length))

+ (aref r-y 0)

+ (* (sin (/ fold-angle 2)) diagonal-part-length))

+

+ (dotimes (ring (1- n))

+ (let ((length-in-diagonal-plane

+ (length-in-diagonal-plane (aref r-y ring)

+ (triangulid-length

+ (1+ ring)

+ diagonal-part-length))))

+ (multiple-value-bind

+ (z1 r1)

+ (next-vertex (aref z-x ring) (aref r-x ring)

+ (aref z-y ring) diagonal-part-length

+ length-in-diagonal-plane ring)

+ (setf (aref z-x (1+ ring)) z1)

+ (setf (aref r-x (1+ ring)) r1)))

+ (let ((length-in-diagonal-plane

+ (length-in-diagonal-plane (aref r-x (1+ ring))

+ (* (sqrt 2) (+ 2 ring)))))

+ (multiple-value-bind

+ (z2 r2)

+ (next-vertex (aref z-y ring) (aref r-y ring)

+ (aref z-x (1+ ring)) diagonal-part-length

+ length-in-diagonal-plane ring)

+ (setf (aref z-y (1+ ring)) z2)

+ (setf (aref r-y (1+ ring)) r2))))

+ (values z-x r-x z-y r-y)))

+

+(defclass origami-view (qt:glwidget)

+ ((object :accessor object)

+ (animate)

+ (rings :initform 4 :accessor rings)

+ (rings-changed :reader rings-changed)

+ (fold-angle :initform Pi :accessor fold-angle)

+ (fold-angle-changed :reader fold-angle-changed))

+ (:metaclass cxx:class))

+

+(defmethod initialize-instance :after ((view origami-view) &rest initargs)

+ (declare (ignore initargs))

+ (cxx:set-minimum-size view 200 200)

+ (setf (slot-value view 'rings-changed)

+ (qt:make-slot #'(lambda (rings)

+ (setf (rings view) rings)

+ (make-origami view (fold-angle view)

+ (rings view)))))

+ (setf (slot-value view 'fold-angle-changed)

+ (qt:make-slot #'(lambda (fold-angle)

+ (setf (fold-angle view)

+ (* (/ pi 180) fold-angle))

+ (make-origami view (fold-angle view)

+ (rings view)))))

+ (let ((animate (make-instance 'qt:timer)))

+ (setf (cxx:interval animate) (* 1/25 1000)

+ (slot-value view 'animate) animate)

+ (qt:connect (qt:get-signal animate "timeout()")

+ (qt:get-slot view "update()"))))

+

+(defun inner-square (z-x r-x z-y r-y)

+ "OpenGL vertices for the inner square."

+ (gl:with-primitive :triangle-strip

+ (gl:normal 0d0 (aref z-y 0) (- (aref r-y 0)))

+ (gl:vertex 0d0 (aref r-y 0) (aref z-y 0))

+ (gl:vertex (aref r-x 0) 0d0 (aref z-x 0))

+

+ (gl:vertex (- (aref r-x 0)) 0d0 (aref z-x 0))

+ (gl:normal 0d0 (- (aref z-y 0)) (- (aref r-y 0)))

+ (gl:vertex 0d0 (- (aref r-y 0)) (aref z-y 0))))

+

+(defun triangle-strip (z-x r-x z-y r-y x-direction y-direction)

+ "Generates a OpenGL triangle strip for one quarter not

+including the inner square part."

+ (declare (type (or (eql 1) (eql -1)) x-direction y-direction))

+ (gl:with-primitives :triangle-strip

+ (loop for i from 0 below (1- (length z-x))

+ do

+ (ring-edge-vertices (aref z-x i) (aref r-x i)

+ (aref z-y i) (aref r-y i)

+ x-direction y-direction)

+ (normal (* x-direction (aref r-x i)) 0d0 (aref z-x i)

+ 0d0 (* y-direction (aref r-y i)) (aref z-y i)

+ (* x-direction (aref r-x (1+ i))) 0d0 (aref z-x (1+ i)))

+ finally

+ (ring-edge-vertices (aref z-x i) (aref r-x i)

+ (aref z-y i) (aref r-y i)

+ x-direction y-direction))))

+

+

+(defun ring-edge-vertices (z-x r-x z-y r-y x-direction y-direction)

+ "The two vertices of a fourth of a ring."

+ (let ((r-x (* x-direction r-x))

+ (r-y (* y-direction r-y)))

+ (if (= 0 (* x-direction y-direction ))

+ (progn

+ (gl:vertex 0d0 r-y z-y)

+ (gl:vertex r-x 0d0 z-x))

+ (progn

+ (gl:vertex r-x 0d0 z-x)

+ (gl:vertex 0d0 r-y z-y)))))

+

+(defun normal (mid-x mid-y mid-z

+ x1 y1 z1

+ x2 y2 z2)

+ "Generates a OpenGL normal normal to three points."

+ (let* ((vec1 (vector (- x1 mid-x) (- y1 mid-y) (- z1 mid-z)))

+ (vec2 (vector (- x2 mid-x) (- y2 mid-y) (- z2 mid-z)))

+ (cross-product (vector (- (* (aref vec1 1) (aref vec2 2))

+ (* (aref vec2 1) (aref vec1 2)))

+ (- (* (aref vec2 0) (aref vec1 2))

+ (* (aref vec1 0) (aref vec2 2)))

+ (- (* (aref vec1 0) (aref vec2 1))

+ (* (aref vec2 0) (aref vec1 1))))))

+ (gl:normal (aref cross-product 0)

+ (aref cross-product 1)

+ (aref cross-product 2))))

+

+(defun make-hyperbolic-parabolid (z-x r-x z-y r-y)

+ (gl:material :front-and-back :ambient #(0.6 0.6 0.6 1.0))

+ (gl:material :front-and-back :diffuse #(0.4 0.4 0.4 1.0))

+ (inner-square z-x r-x z-y r-y)

+ (triangle-strip z-x r-x z-y r-y 1 1)

+ (triangle-strip z-x r-x z-y r-y -1 1)

+ (triangle-strip z-x r-x z-y r-y 1 -1)

+ (triangle-strip z-x r-x z-y r-y -1 -1))

+

+(defun make-origami (view fold-angle rings)

+ (handler-case

+ (let ((grid-points

+ (multiple-value-list

+ (make-grid-points fold-angle rings))))

+

+ (gl:with-new-list ((object view) :compile)

+ (gl:scale (/ 1.0 rings) (/ 1.0 rings) (/ 1.0 rings))

+ (apply #'make-hyperbolic-parabolid

+ grid-points)))

+ ((or type-error arithmetic-error) (condition)

+ (warn "Can not fold: ~A." condition)

+ (sb-debug:backtrace 10)

+ (gl:with-new-list ((object view) :compile))))

+ (cxx:update view))

+

+(defmethod cxx:initialize-gl ((view origami-view))

+ (gl:check-error)

+ (gl:clear-color 0 0 0 0)

+ (gl:shade-model :flat)

+ (gl:light :light0 :position '(2 2 1 1))

+ (gl:light :light0 :ambient '(1 1 1 1))

+ (gl:light :light0 :diffuse '(1 1 1 1))

+ (gl:light-model :light-model-two-side 1)

+ (gl:enable :light0 :lighting :normalize :depth-test)

+ ;(gl:enable :line-smooth)

+ (setf (object view) (gl:gen-lists 1))

+ (gl:check-error)

+ (make-origami view 2.5 5)

+ (cxx:start (slot-value view 'animate)))

+

+(defmethod cxx:paint-gl ((view origami-view))

+ (gl:clear :color-buffer :depth-buffer)

+ (gl:load-identity)

+ (gl:translate 0 0 -2)

+ (gl:rotate -60 1 0 0)

+ (gl:rotate (mod (* 4 (/ (get-internal-real-time)

+ internal-time-units-per-second))

+ 360)

+ 0 0 1)

+ (gl:call-list (object view))

+ (gl:check-error))

+

+(defmethod cxx:resize-gl ((view origami-view) width height)

+ (gl:viewport 0 0 width height)

+ (gl:matrix-mode :projection)

+ (gl:load-identity)

+ (glu:perspective 50 (/ width height) 0.5 20)

+ (gl:matrix-mode :modelview)

+ (gl:load-identity)

+ (gl:check-error))

+

+(defclass origami (qt:widget)

+ ((view :initform (make-instance 'origami-view)

+ :reader view))

+ (:metaclass cxx:class))

+

+(defmethod initialize-instance :after ((origami origami) &rest initargs)

+ (declare (ignore initargs))

+ (let ((layout (make-instance 'qt:hbox-layout)))

+ (cxx:add-widget layout (view origami))

+ (let ((fold-angle (make-instance 'qt:slider))

+ (rings (make-instance 'qt:slider)))

+ (cxx:add-widget layout fold-angle)

+ (cxx:add-widget layout rings)

+ (qt:do-delayed-initialize

+ (qt:connect (qt:get-signal fold-angle "valueChanged(int)")

+ (fold-angle-changed (view origami)))

+ (setf (cxx:minimum fold-angle) 0

+ (cxx:value fold-angle) 150

+ (cxx:maximum fold-angle) 360

+ (cxx:tick-position fold-angle) qt:slider.+ticks-left+

+ (cxx:tick-interval fold-angle) 90)

+ (qt:connect (qt:get-signal rings "valueChanged(int)")

+ (rings-changed (view origami)))

+ (setf (cxx:minimum rings) 1

+ (cxx:value rings) 20

+ (cxx:maximum rings) 50

+ (cxx:tick-position rings) qt:slider.+ticks-right+

+ (cxx:tick-interval rings) 10)))

+ (cxx:set-layout origami layout)))

+

+(defun origami ()

+ "OpenGL Pleated Hyperbolic Paraboloid"

+ (qt:with-app ()

+ (let ((origami (make-instance 'origami)))

+ (cxx:show origami)

+ (qt:exec))))

--- old-qt.examples/src/origami/tri.head.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/src/origami/tri.head.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,6 @@

+(in-package :qt.examples)

+

+(declaim (inline ^))

+(defun ^ (base power)

+ (expt base power))

+

--- old-qt.examples/src/origami/tri.input 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/src/origami/tri.input 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,8 @@

+-- echo ')read tst.input' | AXIOMsys >tst.output

+a := radicalSolve([R**2+(Z-Z2)**2 = R2**2, (R-D1)**2 + (Z-Z1)**2 = R1**2], [R,Z])

+

+)lisp (load "tri.util.lisp")

+

+rhsmap(list) == map(rhs, list)

+PRINTEXPRESSIONSDEFUN("tri.lisp", '[V1 V2],

+ '[Z1, Z2, D1, R1, R2], map(simplify,map(rhsmap,a))::InputForm)$Lisp

--- old-qt.examples/src/origami/tri.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/src/origami/tri.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,174 @@

+(in-package :qt.examples)

+

+(declaim (inline ^))

+(defun ^ (base power)

+ (expt base power))

+

+

+(defun v1 (z1 z2 d1 r1 r2)

+ (values

+ (/

+ (+

+ (* (+ (* -1 z2) z1)

+ (^

+ (+

+ (+

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ z2 4))

+ (* (* (* 64 (^ d1 2)) z1) (^ z2 3)))

+ (*

+ (+ (* (* -96 (^ d1 2)) (^ z1 2))

+ (+ (* (* 32 (^ d1 2)) (^ r2 2))

+ (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* -32 (^ d1 4)))))

+ (^ z2 2)))

+ (*

+ (+ (* (* 64 (^ d1 2)) (^ z1 3))

+ (*

+ (+ (* (* -64 (^ d1 2)) (^ r2 2))

+ (+ (* (* -64 (^ d1 2)) (^ r1 2)) (* 64 (^ d1 4))))

+ z1))

+ z2))

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ z1 4))

+ (*

+ (+ (* (* 32 (^ d1 2)) (^ r2 2))

+ (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* -32 (^ d1 4))))

+ (^ z1 2)))

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ r2 4))

+ (* (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* 32 (^ d1 4))) (^ r2 2)))

+ (+ (+ (* (* -16 (^ d1 2)) (^ r1 4)) (* (* 32 (^ d1 4)) (^ r1 2)))

+ (* -16 (^ d1 6))))))

+ (/ 1 2)))

+ (+ (+ (* (* 4 (^ d1 2)) (^ z2 2)) (* (* (* -8 (^ d1 2)) z1) z2))

+ (+ (* (* 4 (^ d1 2)) (^ z1 2))

+ (+ (* (* 4 (^ d1 2)) (^ r2 2))

+ (+ (* (* -4 (^ d1 2)) (^ r1 2)) (* 4 (^ d1 4)))))))

+ (+ (+ (* (* 8 d1) (^ z2 2)) (* (* (* -16 d1) z1) z2))

+ (+ (* (* 8 d1) (^ z1 2)) (* 8 (^ d1 3)))))

+ (/

+ (+

+ (* -1

+ (^

+ (+

+ (+

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ z2 4))

+ (* (* (* 64 (^ d1 2)) z1) (^ z2 3)))

+ (*

+ (+ (* (* -96 (^ d1 2)) (^ z1 2))

+ (+ (* (* 32 (^ d1 2)) (^ r2 2))

+ (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* -32 (^ d1 4)))))

+ (^ z2 2)))

+ (*

+ (+ (* (* 64 (^ d1 2)) (^ z1 3))

+ (*

+ (+ (* (* -64 (^ d1 2)) (^ r2 2))

+ (+ (* (* -64 (^ d1 2)) (^ r1 2)) (* 64 (^ d1 4))))

+ z1))

+ z2))

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ z1 4))

+ (*

+ (+ (* (* 32 (^ d1 2)) (^ r2 2))

+ (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* -32 (^ d1 4))))

+ (^ z1 2)))

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ r2 4))

+ (* (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* 32 (^ d1 4))) (^ r2 2)))

+ (+ (+ (* (* -16 (^ d1 2)) (^ r1 4)) (* (* 32 (^ d1 4)) (^ r1 2)))

+ (* -16 (^ d1 6))))))

+ (/ 1 2)))

+ (+

+ (+ (+ (* 4 (^ z2 3)) (* (* -4 z1) (^ z2 2)))

+ (*

+ (+ (* -4 (^ z1 2))

+ (+ (* -4 (^ r2 2)) (+ (* 4 (^ r1 2)) (* 4 (^ d1 2)))))

+ z2))

+ (+ (* 4 (^ z1 3))

+ (* (+ (* 4 (^ r2 2)) (+ (* -4 (^ r1 2)) (* 4 (^ d1 2)))) z1))))

+ (+ (+ (* 8 (^ z2 2)) (* (* -16 z1) z2))

+ (+ (* 8 (^ z1 2)) (* 8 (^ d1 2)))))))

+

+(defun v2 (z1 z2 d1 r1 r2)

+ (values

+ (/

+ (+

+ (* (+ z2 (* -1 z1))

+ (^

+ (+

+ (+

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ z2 4))

+ (* (* (* 64 (^ d1 2)) z1) (^ z2 3)))

+ (*

+ (+ (* (* -96 (^ d1 2)) (^ z1 2))

+ (+ (* (* 32 (^ d1 2)) (^ r2 2))

+ (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* -32 (^ d1 4)))))

+ (^ z2 2)))

+ (*

+ (+ (* (* 64 (^ d1 2)) (^ z1 3))

+ (*

+ (+ (* (* -64 (^ d1 2)) (^ r2 2))

+ (+ (* (* -64 (^ d1 2)) (^ r1 2)) (* 64 (^ d1 4))))

+ z1))

+ z2))

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ z1 4))

+ (*

+ (+ (* (* 32 (^ d1 2)) (^ r2 2))

+ (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* -32 (^ d1 4))))

+ (^ z1 2)))

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ r2 4))

+ (* (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* 32 (^ d1 4))) (^ r2 2)))

+ (+ (+ (* (* -16 (^ d1 2)) (^ r1 4)) (* (* 32 (^ d1 4)) (^ r1 2)))

+ (* -16 (^ d1 6))))))

+ (/ 1 2)))

+ (+ (+ (* (* 4 (^ d1 2)) (^ z2 2)) (* (* (* -8 (^ d1 2)) z1) z2))

+ (+ (* (* 4 (^ d1 2)) (^ z1 2))

+ (+ (* (* 4 (^ d1 2)) (^ r2 2))

+ (+ (* (* -4 (^ d1 2)) (^ r1 2)) (* 4 (^ d1 4)))))))

+ (+ (+ (* (* 8 d1) (^ z2 2)) (* (* (* -16 d1) z1) z2))

+ (+ (* (* 8 d1) (^ z1 2)) (* 8 (^ d1 3)))))

+ (/

+ (+

+ (^

+ (+

+ (+

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ z2 4)) (* (* (* 64 (^ d1 2)) z1) (^ z2 3)))

+ (*

+ (+ (* (* -96 (^ d1 2)) (^ z1 2))

+ (+ (* (* 32 (^ d1 2)) (^ r2 2))

+ (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* -32 (^ d1 4)))))

+ (^ z2 2)))

+ (*

+ (+ (* (* 64 (^ d1 2)) (^ z1 3))

+ (*

+ (+ (* (* -64 (^ d1 2)) (^ r2 2))

+ (+ (* (* -64 (^ d1 2)) (^ r1 2)) (* 64 (^ d1 4))))

+ z1))

+ z2))

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ z1 4))

+ (*

+ (+ (* (* 32 (^ d1 2)) (^ r2 2))

+ (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* -32 (^ d1 4))))

+ (^ z1 2)))

+ (+

+ (+ (* (* -16 (^ d1 2)) (^ r2 4))

+ (* (+ (* (* 32 (^ d1 2)) (^ r1 2)) (* 32 (^ d1 4))) (^ r2 2)))

+ (+ (+ (* (* -16 (^ d1 2)) (^ r1 4)) (* (* 32 (^ d1 4)) (^ r1 2)))

+ (* -16 (^ d1 6))))))

+ (/ 1 2))

+ (+

+ (+ (+ (* 4 (^ z2 3)) (* (* -4 z1) (^ z2 2)))

+ (*

+ (+ (* -4 (^ z1 2))

+ (+ (* -4 (^ r2 2)) (+ (* 4 (^ r1 2)) (* 4 (^ d1 2)))))

+ z2))

+ (+ (* 4 (^ z1 3))

+ (* (+ (* 4 (^ r2 2)) (+ (* -4 (^ r1 2)) (* 4 (^ d1 2)))) z1))))

+ (+ (+ (* 8 (^ z2 2)) (* (* -16 z1) z2))

+ (+ (* 8 (^ z1 2)) (* 8 (^ d1 2)))))))

--- old-qt.examples/src/origami/tri.util.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/src/origami/tri.util.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,19 @@

+(defun expression-defun (name variables expressions)

+ `(defun ,name ,variables

+ (values ,@(rest expressions))))

+

+(defun print-to-file (file expression)

+ (with-open-file (out file :direction :output

+ :if-exists :append :if-does-not-exist :create)

+ (let ((*print-case* :downcase))

+ (print expression out)

+ (terpri out))))

+

+(defun printexpressionsdefun (name function-names variables expressions)

+ (loop

+ for function-name in (first (rest function-names))

+ for expression in (rest (first (rest expressions))) do

+ (print-to-file name (expression-defun function-name

+ (rest variables)

+ expression))))

+

--- old-qt.examples/src/package.lisp 2014-10-29 00:57:11.000000000 +0100

+++ new-qt.examples/src/package.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -8,11 +8,34 @@

#:hello-world-quit

#:hello-world-gc

+ #+qt.webkit

#:class-browser

#:tick-tack-toe

#:repl

+ #+qt.phonon

+ #:play-video

+ ;;#:origami

#:launcher

+

+ #:analog-clock

+ #:colliding-mice

+ #+qt.uitools

#:load-ui-file))

+

+(in-package #:qt.examples)

+

+(defvar *source-path*

+ #.(asdf:component-pathname (asdf:find-component

+ (asdf:find-system :cl-smoke.qt.examples) "src")))

+

+(defun test-all ()

+ (let ((qt:*exec-p* nil))

+ (do-external-symbols (example :qt.examples)

+ (when (fboundp example)

+ (format *debug-io* "testing ~A~%"

+ (documentation (symbol-function example)

+ 'function))

+ (funcall (symbol-function example))))))

--- old-qt.examples/src/qt/analog-clock.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/src/qt/analog-clock.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,108 @@

+;;; Copyright (c) 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

+;;; Copyright (C) 2009 Nokia Corporation and/or its subsidiary(-ies).

+;;; Contact: Qt Software Information (qt-info@nokia.com)

+;;;

+;;; This file is part of the examples of the Qt Toolkit.

+;;;

+;;; $QT_BEGIN_LICENSE:LGPL$

+;;; Commercial Usage

+;;; Licensees holding valid Qt Commercial licenses may use this file in

+;;; accordance with the Qt Commercial License Agreement provided with the

+;;; Software or, alternatively, in accordance with the terms contained in

+;;; a written agreement between you and Nokia.

+;;;

+;;; GNU Lesser General Public License Usage

+;;; Alternatively, this file may be used under the terms of the GNU Lesser

+;;; General Public License version 2.1 as published by the Free Software

+;;; Foundation and appearing in the file LICENSE.LGPL included in the

+;;; packaging of this file. Please review the following information to

+;;; ensure the GNU Lesser General Public License version 2.1 requirements

+;;; will be met: http://www.gnu.org/licenses/old-licenses/lgpl-2.1.html.

+;;;

+;;; In addition, as a special exception, Nokia gives you certain

+;;; additional rights. These rights are described in the Nokia Qt LGPL

+;;; Exception version 1.0, included in the file LGPL_EXCEPTION.txt in this

+;;; package.

+;;;

+;;; GNU General Public License Usage

+;;; Alternatively, this file may be used under the terms of the GNU

+;;; General Public License version 3.0 as published by the Free Software

+;;; Foundation and appearing in the file LICENSE.GPL included in the

+;;; packaging of this file. Please review the following information to

+;;; ensure the GNU General Public License version 3.0 requirements will be

+;;; met: http://www.gnu.org/copyleft/gpl.html.

+;;;

+;;; If you are unsure which license is appropriate for your use, please

+;;; contact the sales department at qt-sales@nokia.com.

+;;; $QT_END_LICENSE$

+

+(in-package :qt.examples)

+

+(defclass analog-clock (qt:widget)

+ ()

+ (:metaclass cxx:class))

+

+(defmethod initialize-instance :after ((clock analog-clock) &rest initargs)

+ (declare (ignore initargs))

+ (let ((timer (make-instance 'qt:timer :arg0 clock)))

+ (qt:connect (qt:get-signal timer "timeout()")

+ (qt:get-slot clock "update()"))

+ (cxx:start timer 1000))

+ (setf (cxx:window-title clock) "Analog Clock")

+ (cxx:resize clock 200 200))

+

+(defun make-polygon (points)

+ (make-instance 'qt:polygon :arg0

+ (map 'vector #'(lambda (coords)

+ (make-instance 'qt:point

+ :arg0 (first coords)

+ :arg1 (rest coords)))

+ points)))

+

+(let ((hour-hand (make-polygon '((7 . 8) (-7 . 8) (0 . -40))))

+ (minute-hand (make-polygon '((7 . 8) (-7 . 8) (0 . -70)))))

+ (defmethod cxx:paint-event ((clock analog-clock) paint-event)

+ (let ((hour-color (make-instance 'qt:color :args '(127 0 127)))

+ (minute-color (make-instance 'qt:color :args '(0 127 127 191)))

+ (side (min (cxx:width clock) (cxx:height clock)))

+ (time (qt:time.current-time)))

+ (qt:with-painter (painter clock)

+ (cxx:set-render-hint painter qt:painter.+antialiasing+)

+ (cxx:translate painter

+ (/ (cxx:width clock) 2) (/ (cxx:height clock) 2))

+ (cxx:scale painter (/ side 200.0) (/ side 200.0))

+ (cxx:set-pen painter qt:+no-pen+)

+ (cxx:set-brush painter hour-color)

+

+ (qt:with-painter (painter)

+ (cxx:rotate painter (* 30.0 (+ (cxx:hour time)

+ (/ (cxx:minute time) 60.0))))

+ (cxx:draw-convex-polygon painter hour-hand))

+

+ (cxx:set-pen painter hour-color)

+

+ (dotimes (i 12)

+ (cxx:draw-line painter 88 0 96 0)

+ (cxx:rotate painter 30.0))

+

+ (cxx:set-pen painter qt:+no-pen+)

+ (cxx:set-brush painter minute-color)

+

+ (qt:with-painter (painter)

+ (cxx:rotate painter (* 6.0 (+ (cxx:minute time)

+ (/ (cxx:second time) 60.0))))

+ (cxx:draw-convex-polygon painter minute-hand))

+

+ (cxx:set-pen painter minute-color)

+

+ (dotimes (i 60)

+ (unless (zerop (mod i 5))

+ (cxx:draw-line painter 92 0 96 0))

+ (cxx:rotate painter 6.0))))))

+

+(defun analog-clock ()

+ "Analog Clock"

+ (qt:with-app ()

+ (let ((clock (make-instance 'analog-clock)))

+ (cxx:show clock)

+ (qt:exec))))

--- old-qt.examples/src/qt/colliding-mice.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/src/qt/colliding-mice.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,230 @@

+;;; Copyright (c) 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

+;;; Copyright (C) 2009 Nokia Corporation and/or its subsidiary(-ies).

+;;; Contact: Qt Software Information (qt-info@nokia.com)

+;;;

+;;; This file is part of the examples of the Qt Toolkit.

+;;;

+;;; $QT_BEGIN_LICENSE:LGPL$

+;;; Commercial Usage

+;;; Licensees holding valid Qt Commercial licenses may use this file in

+;;; accordance with the Qt Commercial License Agreement provided with the

+;;; Software or, alternatively, in accordance with the terms contained in

+;;; a written agreement between you and Nokia.

+;;;

+;;; GNU Lesser General Public License Usage

+;;; Alternatively, this file may be used under the terms of the GNU Lesser

+;;; General Public License version 2.1 as published by the Free Software

+;;; Foundation and appearing in the file LICENSE.LGPL included in the

+;;; packaging of this file. Please review the following information to

+;;; ensure the GNU Lesser General Public License version 2.1 requirements

+;;; will be met: http://www.gnu.org/licenses/old-licenses/lgpl-2.1.html.

+;;;

+;;; In addition, as a special exception, Nokia gives you certain

+;;; additional rights. These rights are described in the Nokia Qt LGPL

+;;; Exception version 1.0, included in the file LGPL_EXCEPTION.txt in this

+;;; package.

+;;;

+;;; GNU General Public License Usage

+;;; Alternatively, this file may be used under the terms of the GNU

+;;; General Public License version 3.0 as published by the Free Software

+;;; Foundation and appearing in the file LICENSE.GPL included in the

+;;; packaging of this file. Please review the following information to

+;;; ensure the GNU General Public License version 3.0 requirements will be

+;;; met: http://www.gnu.org/copyleft/gpl.html.

+;;;

+;;; If you are unsure which license is appropriate for your use, please

+;;; contact the sales department at qt-sales@nokia.com.

+;;; $QT_END_LICENSE$

+

+(in-package :qt.examples)

+

+(defun normalize-angle (angle)

+ (loop while (< angle 0) do

+ (incf angle (* 2 Pi)))

+ (loop while (> angle (* 2 Pi)) do

+ (decf angle (* 2 Pi)))

+ angle)

+

+(defclass mouse (qt:graphics-item)

+ ((angle :initform 0d0 :accessor angle)

+ (speed :initform 0d0 :accessor mouse-speed)

+ (eye-direction :initform 0d0 :accessor eye-direction)

+ (color :initform (make-instance 'qt:color

+ :arg0 (random 256)

+ :arg1 (random 256)

+ :arg2 (random 256))

+ :accessor color))

+ (:metaclass cxx:class))

+

+(defmethod initialize-instance :after ((mouse mouse) &rest initargs)

+ (declare (ignore initargs))

+ (cxx:rotate mouse (random (* 360 16))))

+

+(defmethod cxx:bounding-rect ((mouse mouse))

+ (let ((adjust 0.5d0))

+ (make-instance 'qt:rect-f :args (list (- -18 adjust) (- -22 adjust)

+ (+ 36 adjust) (+ 60 adjust)))))

+

+(defmethod cxx:shape ((mouse mouse))

+ (let ((path (make-instance 'qt:painter-path)))

+ (cxx:add-rect path -10 -20 20 40)

+ path))

+

+(defmethod cxx:paint ((mouse mouse) painter option widget)

+ (declare (ignore option widget))

+ ;; Body

+ (cxx:set-brush painter (color mouse))

+ (cxx:draw-ellipse painter -10 -20 20 40)

+

+ ;; Eyes

+ (cxx:set-brush painter qt:+white+)

+ (cxx:draw-ellipse painter -10 -17 8 8)

+ (cxx:draw-ellipse painter 2 -17 8 8)

+

+ ;; Nose

+ (cxx:set-brush painter qt:+black+)

+ (cxx:draw-ellipse painter -2 -22 4 4)

+

+ ;; Pupils

+ (cxx:draw-ellipse painter

+ (make-instance 'qt:rect-f

+ :arg0 (+ -8d0 (eye-direction mouse))

+ :arg1 -17

+ :arg2 4 :arg3 4))

+ (cxx:draw-ellipse painter

+ (make-instance 'qt:rect-f

+ :arg0 (+ 4d0 (eye-direction mouse))

+ :arg1 -17

+ :arg2 4 :arg3 4))

+

+ ;; Ears

+ (cxx:set-brush painter

+ (if (zerop (length (cxx:colliding-items (cxx:scene mouse)

+ mouse)))

+ qt:+dark-yellow+

+ qt:+red+))

+ (cxx:draw-ellipse painter -17 -12 16 16)

+ (cxx:draw-ellipse painter 1 -12 16 16)

+

+ ;; Tail

+ (let ((path (make-instance 'qt:painter-path

+ :arg0 (make-instance 'qt:point-f :args '(0 20)))))

+ (cxx:cubic-to path -5 22 -5 22 0 25)

+ (cxx:cubic-to path 5 27 5 32 0 30)

+ (cxx:cubic-to path -5 32 -5 42 0 35)

+ (cxx:set-brush painter qt:+no-brush+)

+ (cxx:draw-path painter path)))

+

+(defmethod cxx:advance ((mouse mouse) step)

+ (unless (zerop step)

+ ;; Don't move too far away

+ (let ((line-to-center (make-instance 'qt:line-f

+ :arg0 (make-instance 'qt:point-f

+ :args '(0 0))

+ :arg1 (cxx:map-from-scene mouse 0 0))))

+ (if (> (cxx:length line-to-center) 150)

+ (let ((angle-to-center (acos (/ (cxx:dx line-to-center)

+ (cxx:length line-to-center)))))

+ (when (< (cxx:dy line-to-center) 0)

+ (setf angle-to-center (- (* 2 Pi) angle-to-center)))

+ (setf angle-to-center (normalize-angle (+ (- Pi angle-to-center)

+ (/ Pi 2))))

+ (if (< (/ pi 4) angle-to-center pi)

+ ;; Rotate left

+ (incf (angle mouse) (if (< (angle mouse) (/ Pi -2))

+ 0.25 -0.25))

+ (when (and (>= angle-to-center Pi)

+ (< angle-to-center (+ Pi (/ Pi 2) (/ Pi 4))))

+ ;; Rotate right

+ (incf (angle mouse) (if (< (angle mouse) (/ Pi 2))

+ 0.25 -0.25)))))

+ (incf (angle mouse) (* (signum (angle mouse)) 0.25))))

+

+ ;; Try not to crash with any other mice

+ (let ((danger-mice

+ (cxx:items (cxx:scene mouse)

+ (make-instance 'qt:polygon-f

+ :arg0

+ (vector (cxx:map-to-scene mouse 0 0)

+ (cxx:map-to-scene mouse -30 -50)

+ (cxx:map-to-scene mouse 30 -50))))))

+ (loop for item across danger-mice

+ unless (eq item mouse) do

+ (let* ((line-to-mouse (make-instance

+ 'qt:line-f

+ :arg0 (make-instance 'qt:point-f

+ :args '(0 0))

+ :arg1 (cxx:map-from-item mouse item 0 0)))

+ (angle-to-mouse (acos (/ (cxx:dx line-to-mouse)

+ (cxx:length line-to-mouse)))))

+ (when (< (cxx:dy line-to-mouse) 0)

+ (setf angle-to-mouse (- (* 2 Pi) angle-to-mouse)))

+ (setf angle-to-mouse (normalize-angle (+ (- Pi angle-to-mouse)

+ (/ Pi 2))))

+ (if (and (>= angle-to-mouse 0) (< angle-to-mouse (/ Pi 2)))

+ ;; Rotate right

+ (incf (angle mouse) 0.5)

+ (when (and (<= angle-to-mouse (* 2 Pi))

+ (> angle-to-mouse (- (* 2 Pi) (/ Pi 2))))

+ ;; Rotate left

+ (decf (angle mouse) 0.5)))))

+

+ ;; Add some random movement

+ (when (and (> (length danger-mice) 1)

+ (zerop (random 10)))

+ (if (zerop (random 2))

+ (incf (angle mouse) (/ (random 100) 500d0))

+ (decf (angle mouse) (/ (random 100) 500d0))))

+

+ (incf (mouse-speed mouse) (/ (+ -50 (random 100)) 100d0))

+

+ (let ((dx (* (sin (angle mouse)) 10)))

+ (setf (eye-direction mouse)

+ (if (< (abs (/ dx 5)) 1) 0 (/ dx 5)))

+ (cxx:rotate mouse dx))

+ (cxx:set-pos mouse

+ (cxx:map-to-parent mouse

+ 0

+ (- (+ 3

+ (* (sin (mouse-speed mouse))

+ 3))))))))

+

+

+(defconstant +mouse-count+ 7)

+

+(defun colliding-mice ()

+ "Colliding Mice"

+ (qt:with-app ()

+ (let* ((scene (make-instance 'qt:graphics-scene))

+ (view (make-instance 'qt:graphics-view :arg0 scene))

+ (items)

+ (timer (make-instance 'qt:timer)))

+ ;; Prevent SECENE and TIMER from beeing GCed before VIEW.

+ (setf (qt:property view 'closure)

+ (qt:make-lisp-variant (cons scene timer)))

+ (cxx:set-scene-rect scene -300 -300 600 600)

+ (cxx:set-item-index-method scene qt:graphics-scene.+no-index+)

+ (dotimes (i +mouse-count+)

+ (let ((mouse (make-instance 'mouse)))

+ (cxx:set-pos mouse

+ (* (sin (/ (* i 6.28) +mouse-count+)) 200)

+ (* (cos (/ (* i 6.28) +mouse-count+)) 200))

+ (push mouse items)

+ (cxx:add-item scene mouse)))

+ (cxx:set-render-hint view qt:painter.+antialiasing+)

+ (cxx:set-background-brush

+ view

+ (make-instance 'qt:pixmap

+ :arg0 (concatenate 'string

+ (namestring *source-path*)

+ "/qt/images/cheese.jpg")))

+ (cxx:set-cache-mode view qt:graphics-view.+cache-background+)

+ (cxx:set-viewport-update-mode view qt:graphics-view.+bounding-rect-viewport-update+)

+ (cxx:set-drag-mode view qt:graphics-view.+scroll-hand-drag+)

+ (cxx:set-window-title view "Colliding Mice")

+ (cxx:resize view 400 300)

+ (cxx:show view)

+ (qt:connect (qt:get-signal timer "timeout()")

+ (qt:get-slot scene "advance()"))

+ (cxx:start timer (floor 1000 33))

+ (qt:exec))))

Binary files old-qt.examples/src/qt/images/cheese.jpg and new-qt.examples/src/qt/images/cheese.jpg differ

--- old-qt.examples/src/qt/xmlstreamlint.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/src/qt/xmlstreamlint.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,66 @@

+;;; Copyright (c) 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

+;;; Copyright (C) 2009 Nokia Corporation and/or its subsidiary(-ies).

+;;; Contact: Qt Software Information (qt-info@nokia.com)

+;;;

+;;; This file is part of the examples of the Qt Toolkit.

+;;;

+;;; $QT_BEGIN_LICENSE:LGPL$

+;;; Commercial Usage

+;;; Licensees holding valid Qt Commercial licenses may use this file in

+;;; accordance with the Qt Commercial License Agreement provided with the

+;;; Software or, alternatively, in accordance with the terms contained in

+;;; a written agreement between you and Nokia.

+;;;

+;;; GNU Lesser General Public License Usage

+;;; Alternatively, this file may be used under the terms of the GNU Lesser

+;;; General Public License version 2.1 as published by the Free Software

+;;; Foundation and appearing in the file LICENSE.LGPL included in the

+;;; packaging of this file. Please review the following information to

+;;; ensure the GNU Lesser General Public License version 2.1 requirements

+;;; will be met: http://www.gnu.org/licenses/old-licenses/lgpl-2.1.html.

+;;;

+;;; In addition, as a special exception, Nokia gives you certain

+;;; additional rights. These rights are described in the Nokia Qt LGPL

+;;; Exception version 1.0, included in the file LGPL_EXCEPTION.txt in this

+;;; package.

+;;;

+;;; GNU General Public License Usage

+;;; Alternatively, this file may be used under the terms of the GNU

+;;; General Public License version 3.0 as published by the Free Software

+;;; Foundation and appearing in the file LICENSE.GPL included in the

+;;; packaging of this file. Please review the following information to

+;;; ensure the GNU General Public License version 3.0 requirements will be

+;;; met: http://www.gnu.org/copyleft/gpl.html.

+;;;

+;;; If you are unsure which license is appropriate for your use, please

+;;; contact the sales department at qt-sales@nokia.com.

+;;; $QT_END_LICENSE$

+

+(in-package :qt.examples)

+

+;; Small example using only qt.core

+

+(defun xml-lint (input-file-path)

+ "Reads the XML from the file at INPUT-FILE-PATH and returns a copy."

+ (qt:with-core-app ()

+ (let ((input-file (make-instance 'qt:file

+ :arg0 input-file-path)))

+ (unless (cxx:exists input-file)

+ (error "File ~A does not exist." input-file-path))

+ (unless (cxx:open input-file qt:iodevice.+read-only+)

+ (error "Failed to open file ~A." input-file-path))

+

+ (let* ((reader (make-instance 'qt:xml-stream-reader

+ :arg0 input-file))

+ (output (make-instance 'qt:byte-array))

+ (writer (make-instance 'qt:xml-stream-writer

+ :arg0 output)))

+ (loop until (cxx:at-end reader) do

+ (cxx:read-next reader)

+ (when (cxx:has-error reader)

+ (error "Error: ~A in file ~A at line ~A, column ~A."

+ (cxx:error-string reader)

+ input-file-path

+ (cxx:line-number reader) (cxx:column-number reader)))

+ (cxx:write-current-token writer reader))

+ (cxx:data output)))))

--- old-qt.examples/src/repl.lisp 2014-10-29 00:57:12.000000000 +0100

+++ new-qt.examples/src/repl.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -8,7 +8,7 @@

:initform (make-instance 'qt:string-list-model))

(output :reader output

:initform (make-instance 'qt:list-view))

- (input :reader input

+ (input :reader input

:initform (make-instance 'qt:line-edit)))

(:metaclass cxx:class))

@@ -17,8 +17,8 @@

(let ((index (cxx:row-count list-model)))

(unless (cxx:insert-row list-model index)

(error "insert-row ~A for ~A failed." index list-model))

- (cxx:set-data list-model (cxx:index list-model index)

- (qt:make-variant string))))

+ (unless (cxx:set-data list-model (cxx:index list-model index) string)

+ (error "set-data failed."))))

(defmethod initialize-instance :after ((repl repl) &rest args)

(declare (ignore args))

@@ -30,10 +30,11 @@

(format nil "> ~A" (cxx:text (input repl))))

(append-list-model ;; return value

(model repl)

- (format nil "~S"

- (handler-case (eval (read-from-string (cxx:text (input repl))))

- (error (condition) condition))))

- (setf (cxx:text (input repl)) "")))

+ (write-to-string

+ (handler-case (eval (read-from-string

+ (cxx:text (input repl))))

+ (error (condition) condition))))

+ (cxx:clear (input repl))))

(let ((layout (make-instance 'qt:vbox-layout)))

(cxx:add-widget layout (output repl))

(cxx:add-widget layout (input repl))

@@ -42,7 +43,7 @@

(defun repl ()

"Lisp REPL"

- (qt:with-app

+ (qt:with-app ()

(let ((repl (make-instance 'repl)))

(cxx:show repl)

- (qt:exec repl))))

+ (qt:exec))))

--- old-qt.examples/src/tick-tack-toe.lisp 2014-10-29 00:57:11.000000000 +0100

+++ new-qt.examples/src/tick-tack-toe.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -2,14 +2,33 @@

;;; License: X11 license

(in-package :qt.examples)

-(declaim (optimize (debug 3)))

-(defclass tick-tack-toe (qt:widget)

+(defclass tick-tack-toe-board (qt:widget)

((board :accessor board

:initform (make-array '(3 3)))

- (check :accessor check-slot))

+ (check :accessor check-slot)

+ (undo-stack :reader undo-stack

+ :initform (make-instance 'qt:undo-stack)))

(:metaclass cxx:class))

+(defmethod initialize-instance :after ((widget tick-tack-toe-board) &rest args)

+ (declare (ignore args))

+ (setf (check-slot widget) (qt:make-slot #'(lambda ()

+ (update-cell widget

+ (qt:sender)))))

+ (let ((layout (make-instance 'qt:grid-layout)))

+ (dotimes (x (array-dimension (board widget) 0))

+ (dotimes (y (array-dimension (board widget) 1))

+ (setf (aref (board widget) x y)

+ (make-instance 'chell-button :x x :y y))

+ (qt:connect (qt:get-signal (aref (board widget) x y)

+ "clicked()")

+ (check-slot widget))

+ (cxx:add-widget layout (aref (board widget) x y)

+ x y)))

+ (setf (cxx:layout widget) layout)))

+

+

(defclass chell-button (qt:push-button)

((x :reader x

:initarg :x)

@@ -17,22 +36,114 @@

:initarg :y))

(:metaclass cxx:class))

-(defun update-cell (widget cell)

- (when (= 0 (state cell))

- (setf (cxx:text cell) "X")

- (check-end widget)

- (computer-move (board widget))

- (check-end widget)))

+;;; Undo

+;;

+;; Move

+

+(defclass move (qt:undo-command)

+ ((cell :accessor cell :initarg :cell)

+ (board :reader board :initarg :board))

+ (:metaclass cxx:class))

+

+(defmethod cxx:undo ((move move))

+ (setf (cxx:text (cell move)) ""))

+

+(defmethod cxx:id ((move move))

+ 37)

+

+

+(defclass player-move (move)

+ ((computer-cell :accessor computer-cell))

+ (:metaclass cxx:class))

+

+(defmethod cxx:redo ((move player-move))

+ (setf (cxx:text (cell move)) "X")

+ (when (slot-boundp move 'computer-cell)

+ (setf (cxx:text (computer-cell move)) "O")))

+

+(defmethod cxx:undo ((move player-move))

+ (call-next-method)

+ (when (slot-boundp move 'computer-cell)

+ (setf (cxx:text (computer-cell move)) "")))

+

+(defmethod cxx:merge-with ((move player-move) command)

+ "Merge a player and a computer move, such that undo and redo

+operate on a player - computer move pair."

+ (when (typep command 'computer-move)

+ (setf (computer-cell move) (cell command))

+ t))

+

+

+(defclass computer-move (move)

+ ()

+ (:metaclass cxx:class))

+

+(defmethod initialize-instance :after ((move computer-move) &key)

+ (setf (cell move) (computer-move (board move))))

+

+(defmethod cxx:redo ((move computer-move))

+ (setf (cxx:text (cell move)) "O"))

+

+

+

+;; New Game

+;;

+(defclass new-game (qt:undo-command)

+ ((board :reader board :initarg :board)

+ (state :reader state :initform (make-array '(3 3)))

+ (initial-move :accessor initial-move))

+ (:metaclass cxx:class))

+

+(defmethod initialize-instance :after ((new-game new-game) &key)

+ (dotimes (x 3)

+ (dotimes (y 3)

+ (setf (aref (state new-game) x y)

+ (cxx:text (aref (board new-game) x y))))))

-(defun computer-move (board)

+(defmethod cxx:id ((new-game new-game))

+ 37)

+

+(defmethod cxx:redo ((new-game new-game))

+ (dotimes (x 3)

+ (dotimes (y 3)

+ (setf (cxx:text (aref (board new-game) x y)) "")))

+ (when (slot-boundp new-game 'initial-move)

+ (setf (cxx:text (initial-move new-game)) "O")))

+

+(defmethod cxx:undo ((new-game new-game))

+ (dotimes (x 3)

+ (dotimes (y 3)

+ (setf (cxx:text (aref (board new-game) x y))

+ (aref (state new-game) x y)))))

+

+(defmethod cxx:merge-with ((new-game new-game) command)

+ (when (typep command 'computer-move)

+ (setf (initial-move new-game) (cell command))

+ t))

+

+(defun new-game (board-widget)

+ (cxx:push (undo-stack board-widget)

+ (make-instance 'new-game :board (board board-widget))))

+

+

+

+(defun update-cell (board-widget cell)

+ (when (= 0 (cell-state cell))

+ (cxx:push (undo-stack board-widget)

+ (make-instance 'player-move :cell cell :board board-widget))

+ (check-end board-widget)

+ (cxx:push (undo-stack board-widget)

+ (make-instance 'computer-move :board board-widget))

+ (check-end board-widget)))

+

+(defun computer-move (board-widget)

(block top

- (let ((cell (random (free-cells board))))

+ (let ((cell (random (free-cells (board board-widget)))))

(dotimes (x 3)

(dotimes (y 3)

- (when (= 0 (state (aref board x y)))

+ (when (= 0 (cell-state (aref (board board-widget) x y)))

(when (= 0 cell)

- (setf (cxx:text (aref board x y)) "O")

- (return-from top))

+ (return-from top (aref (board board-widget) x y)))

(decf cell)))))))

(defun check-end (widget)

@@ -43,19 +154,14 @@

(if (= 1 winner)

"You win."

"You lose."))

- (reset-board (board widget)))

+ (new-game widget))

(when (= 0 (free-cells (board widget)))

(qt:message-box.information widget "End"

"Drawn.")

- (reset-board (board widget))))))

+ (new-game widget)))))

-(defun reset-board (board)

- (dotimes (x 3)

- (dotimes (y 3)

- (setf (cxx:text (aref board x y)) ""))))

-

-

-(defun state (cell)

+

+(defun cell-state (cell)

(if (= (length (cxx:text cell)) 0)

0

(ecase (aref (cxx:text cell) 0)

@@ -65,7 +171,7 @@

(defun winner-line (board dx dy &optional (offset 0))

(let ((sum 0))

(loop for i from -1 to 1 do

- (incf sum (state (aref board

+ (incf sum (cell-state (aref board

(+ 1 (* (1- dx) offset) (* dx i))

(+ 1 (* (1- dy) offset) (* dy i))))))

(if (= (abs sum) 3)

@@ -76,7 +182,7 @@

(let ((sum 0))

(dotimes (x 3 sum)

(dotimes (y 3)

- (when (= 0 (state (aref board x y)))

+ (when (= 0 (cell-state (aref board x y)))

(incf sum))))))

(defun winner (board)

@@ -90,28 +196,26 @@

(winner-line board 0 1 -1)

(winner-line board 0 1)

(winner-line board 0 1 1)))

-

+

+(defclass tick-tack-toe (qt:main-window)

+ ()

+ (:metaclass cxx:class))

(defmethod initialize-instance :after ((widget tick-tack-toe) &rest args)

(declare (ignore args))

- (setf (check-slot widget) (qt:make-slot #'(lambda ()

- (update-cell widget

- (qt:sender)))))

- (let ((layout (make-instance 'qt:grid-layout)))

- (dotimes (x (array-dimension (board widget) 0))

- (dotimes (y (array-dimension (board widget) 1))

- (setf (aref (board widget) x y)

- (make-instance 'chell-button :x x :y y))

- (qt:connect (qt:get-signal (aref (board widget) x y)

- "clicked()")

- (check-slot widget))

- (cxx:add-widget layout (aref (board widget) x y)

- x y)))

- (setf (cxx:layout widget) layout)))

-

+ (let ((board (make-instance 'tick-tack-toe-board)))

+ (cxx:set-central-widget widget board)

+ (let ((toolbar (cxx:add-tool-bar widget "Main")))

+ (cxx:add-action toolbar

+ (cxx:create-undo-action (undo-stack board)

+ widget))

+ (cxx:add-action toolbar

+ (cxx:create-redo-action (undo-stack board)

+ widget)))))

+

(defun tick-tack-toe ()

"Tick Tack Toe"

- (qt:with-app

+ (qt:with-app ()

(let ((widget (make-instance 'tick-tack-toe)))

(cxx:show widget)

(qt:exec))))

--- old-qt.examples/src/ui.lisp 2014-10-29 00:57:11.000000000 +0100

+++ new-qt.examples/src/ui.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -5,24 +5,22 @@

(defun load-ui-file ()

"Load a Qt Designer .ui file"

- (qt:with-app

- (let ((loader (make-instance 'qt.uitools:ui-loader))

- (file (make-instance 'qt:file))

- (widget))

- (setf (cxx:file-name file)

- (namestring

- (qt:search-file "widget.ui"

- *default-pathname-defaults*

- (directory-namestring

- (mb.sysdef:input-file

- (mb.sysdef:find-component :qt.examples "src" "ui"))))))

- (assert (cxx:exists file) (file)

- "File ~A does not exists" (cxx:file-name file))

- (unless (cxx:open file qt:iodevice.+read-only+)

- (error "open failed"))

- (setf widget (cxx:load loader file))

- (when (cffi:null-pointer-p (smoke:pointer widget))

- (error "load failed"))

- (cxx:close file)

- (cxx:show widget)

- (qt:exec))))

+ (qt:with-app ()

+ (let ((loader (make-instance 'qt:ui-loader))

+ (file (make-instance 'qt:file))

+ (widget))

+ (setf (cxx:file-name file)

+ (namestring

+ (qt:search-file "widget.ui"

+ *source-path*

+ *default-pathname-defaults*)))

+ (assert (cxx:exists file) (file)

+ "File ~A does not exists" (cxx:file-name file))

+ (unless (cxx:open file qt:iodevice.+read-only+)

+ (error "open failed"))

+ (setf widget (cxx:load loader file))

+ (when (cffi:null-pointer-p (smoke:pointer widget))

+ (error "load failed"))

+ (cxx:close file)

+ (cxx:show widget)

+ (qt:exec))))

--- old-qt.examples/src/video.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/src/video.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,24 @@

+(in-package :qt.examples)

+

+(defun play-video ()

+ "Play video"

+ (qt:with-app ()

+ (setf (cxx:application-name (qt:app)) "Lisp")

+ (let ((widget (make-instance 'qt:widget))

+ (video-player (make-instance 'qt:phonon.video-player

+ :arg0 qt:phonon.+video-category+)))

+ (let ((layout (make-instance 'qt:vbox-layout))

+ (open-button (make-instance 'qt:push-button :arg0 "Open")))

+ (cxx:add-widget layout video-player)

+ (cxx:add-widget layout open-button)

+ (qt:connect (qt:get-signal open-button "clicked()")

+ #'(lambda ()

+ (let ((file (qt:file-dialog.get-open-file-name

+ video-player

+ "Select the file to play")))

+ (when (> (length file) 0)

+ (cxx:play video-player file)))))

+ (cxx:set-layout widget layout))

+ (cxx:resize widget 300 300)

+ (cxx:show widget)

+ (qt:exec))))

--- old-qt.examples/test.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.examples/test.lisp 2014-10-29 00:57:12.000000000 +0100

@@ -0,0 +1,8 @@

+#|

+exec -a "$0" sbcl --noinform --noprint --disable-debugger --load $0 --end-toplevel-options "$@"

+|#

+

+(asdf:oos 'asdf:load-op :cl-smoke.qt.examples)

+(asdf:oos 'asdf:test-op :cl-smoke.qt.examples)

+

+(sb-ext:quit)