Qt example: Analog Clock
src/qt/analog-clock.lisp
Sat Jan 23 23:18:27 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Qt example: Analog Clock
--- 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-30 07:36:14.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))
+ (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))))