Mon Jan 25 22:13:57 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* 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 06:59:39.000000000 +0100
+++ new-qt.examples/cl-smoke.qt.examples.asd 2014-10-30 06:59:39.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 06:59:39.000000000 +0100
+++ new-qt.examples/src/package.lisp 2014-10-30 06:59:39.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 06:59:39.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