Sun Apr 5 17:36:46 CEST 2009 Tobias Rautenkranz * initial import diff -rN -u old-qt.examples/qt.examples.mbd new-qt.examples/qt.examples.mbd --- old-qt.examples/qt.examples.mbd 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/qt.examples.mbd 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,38 @@ +;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- + +;;; 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") + (: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")))))) diff -rN -u old-qt.examples/src/CMakeLists.txt new-qt.examples/src/CMakeLists.txt --- old-qt.examples/src/CMakeLists.txt 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/CMakeLists.txt 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,7 @@ +cmake_minimum_required(VERSION 2.6) + + +set(CMAKE_MODULE_PATH ${CMAKE_CURRENT_SOURCE_DIR}) +include(UseClQti18n) + +CL_GENERATE_QT_CATALOG(hello-world i18n-hello-world.lisp) diff -rN -u old-qt.examples/src/UseClQti18n.cmake new-qt.examples/src/UseClQti18n.cmake --- old-qt.examples/src/UseClQti18n.cmake 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/UseClQti18n.cmake 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,66 @@ +# - Extract qt:tr strings from lisp source files and generate the Qt message files. +# +# macro CL_GENERATE_QT_CATALOG(CATALOG_NAME LISP_SOURCE_FILES) +# Generates ${CATALOG_NAME}.pot, updates the ${CATALOG_NAME}_LANGS.po files and +# makes the ${CATALOG_NAME}_LANGS.qm files when the global target is build. +# + +find_package(Gettext) +find_program(XGETTEXT_EXECUTABLE xgettext) + +macro(CL_GENERATE_QT_CATALOG CATALOG_NAME LISP_SOURCE_FILES) + ## Run xgettext + ## + ## TODO: set charset + if(XGETTEXT_EXECUTABLE) + add_custom_command(OUTPUT ${CATALOG_NAME}.pot + COMMAND ${XGETTEXT_EXECUTABLE} -L lisp + -kqt:tr:1,2c + -kqt:tr:1 + ${LISP_SOURCE_FILES} -o ${CATALOG_NAME}.pot + DEPENDS ${LISP_SOURCE_FILES}) + add_custom_target(messages ALL DEPENDS ${CATALOG_NAME}.pot) + endif(XGETTEXT_EXECUTABLE) + + ## Generate Qt .qm files from the .po files. + ## + ## based on: + ## http://techbase.kde.org/Development/Tutorials/Localization/i18n_Build_Systems#Extracting_and_merging_messages + if(GETTEXT_MSGFMT_EXECUTABLE AND GETTEXT_MSGMERGE_EXECUTABLE) + file(GLOB PO_FILES ${CATALOG_NAME}*.po) + message ("PO ${PO_FILES}") + + set(QM_FILES "") + + foreach(_poFile ${PO_FILES}) + get_filename_component(_poFileName ${_poFile} NAME) + string(REGEX REPLACE "^${CATALOG_NAME}_?" "" _langCode ${_poFileName} ) + string(REGEX REPLACE "\\.po$" "" _langCode ${_langCode} ) + + if( _langCode ) + get_filename_component(_lang ${_poFile} NAME_WE) + set(_qmFile ${CMAKE_CURRENT_BINARY_DIR}/${_lang}.qm) + add_custom_command(OUTPUT ${_qmFile} + COMMAND ${GETTEXT_MSGMERGE_EXECUTABLE} + --quiet --update --backup=none + ${_poFileName} + ${CATALOG_NAME}.pot + + COMMAND ${GETTEXT_MSGFMT_EXECUTABLE} + --check --use-fuzzy --qt -o ${_qmFile} ${_poFile} + + DEPENDS ${_poFile} ${CATALOG_NAME}.pot) + list(APPEND QM_FILES ${_qmFile}) + endif( _langCode ) + + endforeach(_poFile ${PO_FILES}) + + add_custom_target(translations ALL + DEPENDS ${QM_FILES}) + + endif(GETTEXT_MSGFMT_EXECUTABLE AND GETTEXT_MSGMERGE_EXECUTABLE) + +endmacro(CL_GENERATE_QT_CATALOG) + + + diff -rN -u old-qt.examples/src/class-browser.lisp new-qt.examples/src/class-browser.lisp --- old-qt.examples/src/class-browser.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/class-browser.lisp 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,117 @@ +(in-package :qt.examples) +(declaim (optimize (debug 3))) + +(defclass classes-model (qt:abstract-list-model) + ((items :reader items :initarg :items + :initform (make-array 0 :adjustable t + :fill-pointer t))) + (:metaclass cxx:class)) + +(defmethod cxx:row-count ((list classes-model) &rest args + &aux (parent (first args))) + (declare (ignore parent)) + (length (items list))) + +(defmethod cxx:data ((list classes-model) &rest args + &aux (index (first args)) + (role (second args))) + (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))) + +(defun class-at (model-index) + (aref (items (cxx:model model-index)) (cxx:row model-index))) + +(defclass class-browser (qt:splitter) + ((classes :accessor classes + :initform (make-instance 'classes-model)) + (classes-list :reader classes-list + :initform (make-instance 'qt:list-view)) + (info :reader class-info + :initform (make-instance 'qt:label)) + (web-view :reader web-view + :initform (make-instance 'qt.webkit:web-view))) + (:metaclass smoke::smoke-wrapper-class)) + +(defun setup-class-list (classes) + (do-external-symbols (symbol :qt) + (let ((class (find-class symbol nil))) + (when (and (not (null class)) + (typep class (find-class 'smoke::smoke-standard-class))) + (vector-push-extend class + (items classes))))) + (sort (items classes) #'(lambda (class1 class2) + (string< (class-name class1) + (class-name class2))))) + +(defmethod initialize-instance :after ((browser class-browser) &rest args) + (declare (ignore args)) + (setup-class-list (classes browser)) + + (let* ((w (make-instance 'qt:widget)) + (layout (make-instance 'qt:vbox-layout))) + (cxx:add-widget layout (classes-list browser)) + (let ((search (make-instance 'qt:line-edit))) + (cxx:add-widget layout search) + (qt:connect (qt:get-signal search "textChanged(QString)") + #'(lambda (text) + ;; FIXME since the class list is sorted we could do better + (cxx:keyboard-search (classes-list browser) + text)))) + (let ((scroll (make-instance 'qt:scroll-area))) + (cxx:set-widget scroll (class-info browser)) + (cxx:set-widget-resizable scroll t) + (cxx:add-widget layout scroll)) + (cxx:set-layout w layout) + (cxx:add-widget browser w)) + (cxx:add-widget browser (web-view browser)) + (cxx:load (web-view browser) (make-instance 'qt:url + :args '("http://doc.trolltech.com/4.5"))) + (cxx:set-uniform-item-sizes (classes-list browser) t) + (cxx:set-selection-mode (classes-list browser) qt:abstract-item-view.+single-selection+) + (cxx:set-model (classes-list browser) (classes browser)) + (cxx:set-word-wrap (class-info browser) t) + (cxx:set-window-title browser "CL Qt Classes") + + (qt:connect (qt:get-signal (cxx:selection-model (classes-list browser)) + "currentChanged(QModelIndex, QModelIndex)") + #'(lambda (current previous) + (declare (ignore previous)) + (set-info (class-info browser) + (web-view browser) current)))) + +(defun set-info (info web-view model-index) + (let* ((class (class-at model-index))) + (cxx:load web-view + (make-instance 'qt:url + :args (list (format nil "http://doc.trolltech.com/~A/~A.html" + (subseq (qt:q-version) 0 3) + (remove #\: (smoke::name class) :count 1))))) + (cxx:set-text info + (format nil "

qt:~A

+

~A

+

Direct Superclasses

+ +

Direct Subclasses

+ +" + (string-downcase (class-name class)) + (smoke::name class) + (mapcar #'(lambda (c) (string-downcase (class-name c))) + (closer-mop:class-direct-superclasses class)) + (mapcar #'(lambda (c) (string-downcase (class-name c))) + (closer-mop:class-direct-subclasses class)))))) + +(defun class-browser () + "Qt Class Browser" + (qt:with-app + (let ((browser (make-instance 'class-browser))) + (cxx:show browser) + (qt:exec)))) diff -rN -u old-qt.examples/src/hello-world-quit.lisp new-qt.examples/src/hello-world-quit.lisp --- old-qt.examples/src/hello-world-quit.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/hello-world-quit.lisp 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,20 @@ +(in-package :qt.examples) + +(defun hello-world-quit () + "Quit on push-button click" + (qt:with-app + (let ((quit (make-instance 'qt:push-button :args '("Quit"))) + (font (make-instance 'qt:font :args (list "Times" + 18 + (value qt:font.+bold+))))) + (cxx:resize quit 75 30) + (cxx:set-font quit font) + + (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)))) diff -rN -u old-qt.examples/src/hello-world.lisp new-qt.examples/src/hello-world.lisp --- old-qt.examples/src/hello-world.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/hello-world.lisp 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,9 @@ +(in-package :qt.examples) +(declaim (optimize (debug 3))) + +(defun hello-world () + "Hello world" + (qt:with-app + (let ((widget (make-instance 'qt:push-button :args '("Hello world")))) + (cxx:show widget) + (qt:exec)))) diff -rN -u old-qt.examples/src/hello-world_de.po new-qt.examples/src/hello-world_de.po --- old-qt.examples/src/hello-world_de.po 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/hello-world_de.po 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,33 @@ +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# +# Tobias Rautenkranz , 2009. +msgid "" +msgstr "" +"Project-Id-Version: hello-world\n" +"Report-Msgid-Bugs-To: \n" +"POT-Creation-Date: 2009-04-05 15:44+0200\n" +"PO-Revision-Date: 2009-03-21 11:41+0100\n" +"Last-Translator: Tobias Rautenkranz \n" +"Language-Team: German <>\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: Lokalize 0.3\n" +"Plural-Forms: nplurals=2; plural=n != 1;\n" + +#: i18n-hello-world.lisp:15 +msgctxt "hello-world" +msgid "Lisp Qt Example" +msgstr "Lisp Qt Beispiel" + +#: i18n-hello-world.lisp:17 +#, lisp-format +msgid "" +"

Hello world

\n" +"\n" +"You are running ~A version ~A on a ~A ~A" +msgstr "" +"

Hallo Welt

\n" +"\n" +"Du verwendest, auf ~2@*~A ~A, ~0@*~A version ~A" diff -rN -u old-qt.examples/src/i18n-hello-world.lisp new-qt.examples/src/i18n-hello-world.lisp --- old-qt.examples/src/i18n-hello-world.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/i18n-hello-world.lisp 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,27 @@ +(in-package :qt.examples) + +(defun i18n-hello-world () + "i18n hello world" + (qt:with-app + (qt:with-translator + ;; ensures that the message catalogs are found regardless + ;; of the current directory. + (concatenate 'string + + (directory-namestring + (mb.sysdef:input-file + (mb.sysdef:find-component :qt.examples "src" "i18n-hello-world"))) + "hello-world") + (let ((widget (make-instance 'qt:label))) + (setf (qt:property widget 'window-title) + (qt:tr "Lisp Qt Example" "hello-world")) + (cxx:set-text widget + (format nil (qt:tr "

Hello world

+ +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))))) diff -rN -u old-qt.examples/src/launcher.lisp new-qt.examples/src/launcher.lisp --- old-qt.examples/src/launcher.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/launcher.lisp 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,29 @@ +(in-package :qt.examples) + +(defclass launcher (qt:widget) + () + (:metaclass cxx:class)) + +(defun make-launcer-button (function) + (let ((button (make-instance 'qt:push-button + :args (list (or (documentation function 'function) + (format nil "~A" function)))))) + (qt:connect-function button "clicked()" + #'(lambda () (funcall function))) + button)) + + +(defmethod initialize-instance :after ((launcher launcher) &rest args) + (declare (ignore args)) + (let ((layout (make-instance 'qt:vbox-layout :args (list launcher)))) + (do-external-symbols (example :qt.examples) + (when (fboundp example) + (cxx:add-widget layout (make-launcer-button (symbol-function example))))) + (cxx:set-layout launcher layout))) + +(defun launcher () + "Launch the Qt examples" + (qt:with-app + (let ((launcher (make-instance 'launcher))) + (cxx:show launcher) + (qt:exec)))) diff -rN -u old-qt.examples/src/package.lisp new-qt.examples/src/package.lisp --- old-qt.examples/src/package.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/package.lisp 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,15 @@ +(defpackage #:qt.examples + (:use #:cl #:cxx-support) + (:export #:hello-world + #:i18n-hello-world + #:hello-world-quit + #:hello-world-gc + + #:class-browser + + #:tick-tack-toe + #:repl + + #:launcher + + #:load-ui-file)) diff -rN -u old-qt.examples/src/repl.lisp new-qt.examples/src/repl.lisp --- old-qt.examples/src/repl.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/repl.lisp 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,45 @@ +(in-package :qt.examples) + +(defclass repl (qt:widget) + ((model :reader model + :initform (make-instance 'qt:string-list-model)) + (output :reader output + :initform (make-instance 'qt:list-view)) + (input :reader input + :initform (make-instance 'qt:line-edit))) + (:metaclass cxx:class)) + +(defun append-list-model (list-model string) + "Appends STRING to LIST-MODEL." + (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 0) + (qt::make-variant string)))) + +(defmethod initialize-instance :after ((repl repl) &rest args) + (declare (ignore args)) + (cxx:set-model (output repl) (model repl)) + (qt:connect (qt:get-signal (input repl) "returnPressed()") + #'(lambda () + (append-list-model ;; Input + (model repl) + (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)))) + (cxx:set-text (input repl) ""))) + (let ((layout (make-instance 'qt:vbox-layout))) + (cxx:add-widget layout (output repl)) + (cxx:add-widget layout (input repl)) + (cxx:set-layout repl layout)) + (cxx:set-focus (input repl))) + +(defun repl () + "Lisp REPL" + (qt:with-app + (let ((repl (make-instance 'repl))) + (cxx:show repl) + (qt:exec repl)))) diff -rN -u old-qt.examples/src/tick-tack-toe.lisp new-qt.examples/src/tick-tack-toe.lisp --- old-qt.examples/src/tick-tack-toe.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/tick-tack-toe.lisp 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,116 @@ +(in-package :qt.examples) +(declaim (optimize (debug 3))) + +(defclass tick-tack-toe (qt:widget) + ((board :accessor board + :initform (make-array '(3 3))) + (check :accessor check-slot)) + (:metaclass smoke::smoke-wrapper-class)) + +(defclass chell-button (qt:push-button) + ((x :reader x + :initarg :x) + (y :reader y + :initarg :y)) + (:metaclass smoke::smoke-wrapper-class)) + +(defun update-cell (widget cell) + (when (= 0 (state cell)) + (cxx:set-text cell "X") + (check-end widget) + (computer-move (board widget)) + (check-end widget))) + +(defun computer-move (board) + (block top + (let ((cell (random (free-cells board)))) + (dotimes (x 3) + (dotimes (y 3) + (when (= 0 (state (aref board x y))) + (when (= 0 cell) + (cxx:set-text (aref board x y) "O") + (return-from top)) + (decf cell))))))) + +(defun check-end (widget) + (let ((winner (winner (board widget)))) + (if winner + (progn + (qt:message-box.information widget "End" + (if (= 1 winner) + "You win." + "You lose.")) + (reset-board (board widget))) + (when (= 0 (free-cells (board widget))) + (qt:message-box.information widget "End" + "Drawn.") + (reset-board (board widget)))))) + +(defun reset-board (board) + (dotimes (x 3) + (dotimes (y 3) + (cxx:set-text (aref board x y) "")))) + + +(defun state (cell) + (if (= (length (cxx:text cell)) 0) + 0 + (ecase (aref (cxx:text cell) 0) + (#\X 1) + (#\O -1)))) + +(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 + (+ 1 (* (1- dx) offset) (* dx i)) + (+ 1 (* (1- dy) offset) (* dy i)))))) + (if (= (abs sum) 3) + (floor sum 3) + nil))) + +(defun free-cells (board) + (let ((sum 0)) + (dotimes (x 3 sum) + (dotimes (y 3) + (when (= 0 (state (aref board x y))) + (incf sum)))))) + +(defun winner (board) + (or (winner-line board 1 1) + (winner-line board -1 1) + + (winner-line board 1 0 -1) + (winner-line board 1 0) + (winner-line board 1 0 1) + + (winner-line board 0 1 -1) + (winner-line board 0 1) + (winner-line board 0 1 1))) + + +(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 (make-instance 'qt::qt-signal + :sender (aref (board widget) x y) + :name "clicked()") + (check-slot widget)) + (cxx:add-widget layout (aref (board widget) x y) + x y))) + (cxx:set-layout widget layout))) + +(defun tick-tack-toe () + "Tick Tack Toe" + (qt:with-app + (let ((widget (make-instance 'tick-tack-toe))) + (cxx:show widget) + (qt:exec)))) diff -rN -u old-qt.examples/src/ui.lisp new-qt.examples/src/ui.lisp --- old-qt.examples/src/ui.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/ui.lisp 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,24 @@ +(in-package :qt.examples) + +(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)) + (cxx:set-file-name file + (concatenate 'string + (directory-namestring + (mb.sysdef:input-file + (mb.sysdef:find-component :qt.examples "src" "ui"))) + "widget.ui")) + (assert (cxx:exists file) (file) + "File ~A does not exists" (cxx:file-name file)) + (unless (cxx:open file (value qt:iodevice.+read-only+)) ;;FIXME value + (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)))) diff -rN -u old-qt.examples/src/widget.ui new-qt.examples/src/widget.ui --- old-qt.examples/src/widget.ui 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.examples/src/widget.ui 2014-10-30 07:39:33.000000000 +0100 @@ -0,0 +1,59 @@ + + + Form + + + + 0 + 0 + 160 + 245 + + + + Form + + + + + + + Helvetica + 26 + 75 + true + + + + widget.ui + + + + + + + + + + + + + + + dial + dialMoved(int) + lcdNumber + display(int) + + + 222 + 144 + + + 216 + 229 + + + + +