Mon Jan 25 22:13:57 CET 2010 Tobias Rautenkranz * Qt Example: Colliding Mice diff -rN -u old-qt.examples/cl-smoke.qt.examples.asd new-qt.examples/cl-smoke.qt.examples.asd --- old-qt.examples/cl-smoke.qt.examples.asd 2014-10-30 07:35:55.000000000 +0100 +++ new-qt.examples/cl-smoke.qt.examples.asd 2014-10-30 07:35:55.000000000 +0100 @@ -24,7 +24,8 @@ (:module "qt" :depends-on ("package") :components - ((:file "analog-clock"))))))) + ((:file "analog-clock") + (:file "colliding-mice"))))))) ;;(:module "origami" ;; :depends-on ("package") ;; :components diff -rN -u old-qt.examples/src/package.lisp new-qt.examples/src/package.lisp --- old-qt.examples/src/package.lisp 2014-10-30 07:35:55.000000000 +0100 +++ new-qt.examples/src/package.lisp 2014-10-30 07:35:55.000000000 +0100 @@ -18,6 +18,7 @@ #:launcher #:analog-clock + #:colliding-mice #:load-ui-file)) diff -rN -u old-qt.examples/src/qt/colliding-mice.lisp new-qt.examples/src/qt/colliding-mice.lisp --- 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-30 07:35:55.000000000 +0100 @@ -0,0 +1,230 @@ +;;; Copyright (c) 2010 Tobias Rautenkranz +;;; 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