repos / qt.examples / annotate_shade
summary | shortlog | log | tree | commit | commitdiff | headdiff | annotate | headblob | headfilediff | filehistory
normal | plain | shade | zebra
Qt Example: Colliding Mice
Annotate for file src/qt/colliding-mice.lisp
2010-01-25 tobias 1 ;;; Copyright (c) 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
21:13:57 ' 2 ;;; Copyright (C) 2009 Nokia Corporation and/or its subsidiary(-ies).
' 3 ;;; Contact: Qt Software Information (qt-info@nokia.com)
' 4 ;;;
' 5 ;;; This file is part of the examples of the Qt Toolkit.
' 6 ;;;
' 7 ;;; $QT_BEGIN_LICENSE:LGPL$
' 8 ;;; Commercial Usage
' 9 ;;; Licensees holding valid Qt Commercial licenses may use this file in
' 10 ;;; accordance with the Qt Commercial License Agreement provided with the
' 11 ;;; Software or, alternatively, in accordance with the terms contained in
' 12 ;;; a written agreement between you and Nokia.
' 13 ;;;
' 14 ;;; GNU Lesser General Public License Usage
' 15 ;;; Alternatively, this file may be used under the terms of the GNU Lesser
' 16 ;;; General Public License version 2.1 as published by the Free Software
' 17 ;;; Foundation and appearing in the file LICENSE.LGPL included in the
' 18 ;;; packaging of this file. Please review the following information to
' 19 ;;; ensure the GNU Lesser General Public License version 2.1 requirements
' 20 ;;; will be met: http://www.gnu.org/licenses/old-licenses/lgpl-2.1.html.
' 21 ;;;
' 22 ;;; In addition, as a special exception, Nokia gives you certain
' 23 ;;; additional rights. These rights are described in the Nokia Qt LGPL
' 24 ;;; Exception version 1.0, included in the file LGPL_EXCEPTION.txt in this
' 25 ;;; package.
' 26 ;;;
' 27 ;;; GNU General Public License Usage
' 28 ;;; Alternatively, this file may be used under the terms of the GNU
' 29 ;;; General Public License version 3.0 as published by the Free Software
' 30 ;;; Foundation and appearing in the file LICENSE.GPL included in the
' 31 ;;; packaging of this file. Please review the following information to
' 32 ;;; ensure the GNU General Public License version 3.0 requirements will be
' 33 ;;; met: http://www.gnu.org/copyleft/gpl.html.
' 34 ;;;
' 35 ;;; If you are unsure which license is appropriate for your use, please
' 36 ;;; contact the sales department at qt-sales@nokia.com.
' 37 ;;; $QT_END_LICENSE$
' 38
' 39 (in-package :qt.examples)
' 40
' 41 (defun normalize-angle (angle)
' 42 (loop while (< angle 0) do
' 43 (incf angle (* 2 Pi)))
' 44 (loop while (> angle (* 2 Pi)) do
' 45 (decf angle (* 2 Pi)))
' 46 angle)
' 47
' 48 (defclass mouse (qt:graphics-item)
' 49 ((angle :initform 0d0 :accessor angle)
' 50 (speed :initform 0d0 :accessor mouse-speed)
' 51 (eye-direction :initform 0d0 :accessor eye-direction)
' 52 (color :initform (make-instance 'qt:color
' 53 :arg0 (random 256)
' 54 :arg1 (random 256)
' 55 :arg2 (random 256))
' 56 :accessor color))
' 57 (:metaclass cxx:class))
' 58
' 59 (defmethod initialize-instance :after ((mouse mouse) &rest initargs)
' 60 (declare (ignore initargs))
' 61 (cxx:rotate mouse (random (* 360 16))))
' 62
' 63 (defmethod cxx:bounding-rect ((mouse mouse))
' 64 (let ((adjust 0.5d0))
' 65 (make-instance 'qt:rect-f :args (list (- -18 adjust) (- -22 adjust)
' 66 (+ 36 adjust) (+ 60 adjust)))))
' 67
' 68 (defmethod cxx:shape ((mouse mouse))
' 69 (let ((path (make-instance 'qt:painter-path)))
' 70 (cxx:add-rect path -10 -20 20 40)
' 71 path))
' 72
' 73 (defmethod cxx:paint ((mouse mouse) painter option widget)
' 74 (declare (ignore option widget))
' 75 ;; Body
' 76 (cxx:set-brush painter (color mouse))
' 77 (cxx:draw-ellipse painter -10 -20 20 40)
' 78
' 79 ;; Eyes
' 80 (cxx:set-brush painter qt:+white+)
' 81 (cxx:draw-ellipse painter -10 -17 8 8)
' 82 (cxx:draw-ellipse painter 2 -17 8 8)
' 83
' 84 ;; Nose
' 85 (cxx:set-brush painter qt:+black+)
' 86 (cxx:draw-ellipse painter -2 -22 4 4)
' 87
' 88 ;; Pupils
' 89 (cxx:draw-ellipse painter
' 90 (make-instance 'qt:rect-f
' 91 :arg0 (+ -8d0 (eye-direction mouse))
' 92 :arg1 -17
' 93 :arg2 4 :arg3 4))
' 94 (cxx:draw-ellipse painter
' 95 (make-instance 'qt:rect-f
' 96 :arg0 (+ 4d0 (eye-direction mouse))
' 97 :arg1 -17
' 98 :arg2 4 :arg3 4))
' 99
' 100 ;; Ears
' 101 (cxx:set-brush painter
' 102 (if (zerop (length (cxx:colliding-items (cxx:scene mouse)
' 103 mouse)))
' 104 qt:+dark-yellow+
' 105 qt:+red+))
' 106 (cxx:draw-ellipse painter -17 -12 16 16)
' 107 (cxx:draw-ellipse painter 1 -12 16 16)
' 108
' 109 ;; Tail
' 110 (let ((path (make-instance 'qt:painter-path
' 111 :arg0 (make-instance 'qt:point-f :args '(0 20)))))
' 112 (cxx:cubic-to path -5 22 -5 22 0 25)
' 113 (cxx:cubic-to path 5 27 5 32 0 30)
' 114 (cxx:cubic-to path -5 32 -5 42 0 35)
' 115 (cxx:set-brush painter qt:+no-brush+)
' 116 (cxx:draw-path painter path)))
' 117
' 118 (defmethod cxx:advance ((mouse mouse) step)
' 119 (unless (zerop step)
' 120 ;; Don't move too far away
' 121 (let ((line-to-center (make-instance 'qt:line-f
' 122 :arg0 (make-instance 'qt:point-f
' 123 :args '(0 0))
' 124 :arg1 (cxx:map-from-scene mouse 0 0))))
' 125 (if (> (cxx:length line-to-center) 150)
' 126 (let ((angle-to-center (acos (/ (cxx:dx line-to-center)
' 127 (cxx:length line-to-center)))))
' 128 (when (< (cxx:dy line-to-center) 0)
' 129 (setf angle-to-center (- (* 2 Pi) angle-to-center)))
' 130 (setf angle-to-center (normalize-angle (+ (- Pi angle-to-center)
' 131 (/ Pi 2))))
' 132 (if (< (/ pi 4) angle-to-center pi)
' 133 ;; Rotate left
' 134 (incf (angle mouse) (if (< (angle mouse) (/ Pi -2))
' 135 0.25 -0.25))
' 136 (when (and (>= angle-to-center Pi)
' 137 (< angle-to-center (+ Pi (/ Pi 2) (/ Pi 4))))
' 138 ;; Rotate right
' 139 (incf (angle mouse) (if (< (angle mouse) (/ Pi 2))
' 140 0.25 -0.25)))))
' 141 (incf (angle mouse) (* (signum (angle mouse)) 0.25))))
' 142
' 143 ;; Try not to crash with any other mice
' 144 (let ((danger-mice
' 145 (cxx:items (cxx:scene mouse)
' 146 (make-instance 'qt:polygon-f
' 147 :arg0
' 148 (vector (cxx:map-to-scene mouse 0 0)
' 149 (cxx:map-to-scene mouse -30 -50)
' 150 (cxx:map-to-scene mouse 30 -50))))))
' 151 (loop for item across danger-mice
' 152 unless (eq item mouse) do
' 153 (let* ((line-to-mouse (make-instance
' 154 'qt:line-f
' 155 :arg0 (make-instance 'qt:point-f
' 156 :args '(0 0))
' 157 :arg1 (cxx:map-from-item mouse item 0 0)))
' 158 (angle-to-mouse (acos (/ (cxx:dx line-to-mouse)
' 159 (cxx:length line-to-mouse)))))
' 160 (when (< (cxx:dy line-to-mouse) 0)
' 161 (setf angle-to-mouse (- (* 2 Pi) angle-to-mouse)))
' 162 (setf angle-to-mouse (normalize-angle (+ (- Pi angle-to-mouse)
' 163 (/ Pi 2))))
' 164 (if (and (>= angle-to-mouse 0) (< angle-to-mouse (/ Pi 2)))
' 165 ;; Rotate right
' 166 (incf (angle mouse) 0.5)
' 167 (when (and (<= angle-to-mouse (* 2 Pi))
' 168 (> angle-to-mouse (- (* 2 Pi) (/ Pi 2))))
' 169 ;; Rotate left
' 170 (decf (angle mouse) 0.5)))))
' 171
' 172 ;; Add some random movement
' 173 (when (and (> (length danger-mice) 1)
' 174 (zerop (random 10)))
' 175 (if (zerop (random 2))
' 176 (incf (angle mouse) (/ (random 100) 500d0))
' 177 (decf (angle mouse) (/ (random 100) 500d0))))
' 178
' 179 (incf (mouse-speed mouse) (/ (+ -50 (random 100)) 100d0))
' 180
' 181 (let ((dx (* (sin (angle mouse)) 10)))
' 182 (setf (eye-direction mouse)
' 183 (if (< (abs (/ dx 5)) 1) 0 (/ dx 5)))
' 184 (cxx:rotate mouse dx))
' 185 (cxx:set-pos mouse
' 186 (cxx:map-to-parent mouse
' 187 0
' 188 (- (+ 3
' 189 (* (sin (mouse-speed mouse))
' 190 3))))))))
' 191
' 192
' 193 (defconstant +mouse-count+ 7)
' 194
' 195 (defun colliding-mice ()
' 196 "Colliding Mice"
' 197 (qt:with-app ()
' 198 (let* ((scene (make-instance 'qt:graphics-scene))
' 199 (view (make-instance 'qt:graphics-view :arg0 scene))
' 200 (items)
' 201 (timer (make-instance 'qt:timer)))
' 202 ;; Prevent SECENE and TIMER from beeing GCed before VIEW.
' 203 (setf (qt:property view 'closure)
' 204 (qt:make-lisp-variant (cons scene timer)))
' 205 (cxx:set-scene-rect scene -300 -300 600 600)
' 206 (cxx:set-item-index-method scene qt:graphics-scene.+no-index+)
' 207 (dotimes (i +mouse-count+)
' 208 (let ((mouse (make-instance 'mouse)))
' 209 (cxx:set-pos mouse
' 210 (* (sin (/ (* i 6.28) +mouse-count+)) 200)
' 211 (* (cos (/ (* i 6.28) +mouse-count+)) 200))
' 212 (push mouse items)
' 213 (cxx:add-item scene mouse)))
' 214 (cxx:set-render-hint view qt:painter.+antialiasing+)
' 215 (cxx:set-background-brush
' 216 view
' 217 (make-instance 'qt:pixmap
' 218 :arg0 (concatenate 'string
' 219 (namestring *source-path*)
' 220 "/qt/images/cheese.jpg")))
' 221 (cxx:set-cache-mode view qt:graphics-view.+cache-background+)
' 222 (cxx:set-viewport-update-mode view qt:graphics-view.+bounding-rect-viewport-update+)
' 223 (cxx:set-drag-mode view qt:graphics-view.+scroll-hand-drag+)
' 224 (cxx:set-window-title view "Colliding Mice")
' 225 (cxx:resize view 400 300)
' 226 (cxx:show view)
' 227 (qt:connect (qt:get-signal timer "timeout()")
' 228 (qt:get-slot scene "advance()"))
' 229 (cxx:start timer (floor 1000 33))
' 230 (qt:exec))))
Crece desde el pueblo el futuro / crece desde el pie