Fri Apr 3 00:16:06 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* initial import

--- old-kde.examples/kde.examples.mbd 1970-01-01 01:00:00.000000000 +0100

+++ new-kde.examples/kde.examples.mbd 2014-10-30 06:57:00.000000000 +0100

@@ -0,0 +1,21 @@

+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-

+

+(in-package :sysdef-user)

+

+(define-system :kde.examples ()

+ (:version 0 0 1)

+ (:documentation "KDE examples.")

+ (:keywords "KDE")

+ (:author "Tobias Rautenkranz")

+ (:needs :kde)

+ (:components

+ ("src" module

+ (:components

+ "package"

+ ("hello-world" (:needs "package"))

+ ("mandelbrot" module

+ (:needs "package")

+ (:components

+ "render"

+ ("mandelbrotwidget" (:needs "render"))

+ ("mandelbrot" (:needs "mandelbrotwidget"))))))))

--- old-kde.examples/src/hello-world.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-kde.examples/src/hello-world.lisp 2014-10-30 06:57:00.000000000 +0100

@@ -0,0 +1,8 @@

+(in-package :kde.examples)

+

+(defun hello-world ()

+ (kde:with-kde ("khelloworld" "Hello World" "0.1")

+ (let* ((window (make-instance 'kde:push-button :args '("Hello world"))))

+ (cxx:show window)

+ (qt:exec))))

+

Binary files old-kde.examples/src/kmandelbrot/kmandelbrot.png and new-kde.examples/src/kmandelbrot/kmandelbrot.png differ

--- old-kde.examples/src/kmandelbrot/kmandelbrotui.rc 1970-01-01 01:00:00.000000000 +0100

+++ new-kde.examples/src/kmandelbrot/kmandelbrotui.rc 2014-10-30 06:57:00.000000000 +0100

@@ -0,0 +1,31 @@

+<?xml version="1.0" encoding="UTF-8"?>

+<!--

+This file needs to be in one of the paths of:

+$ kde4-config \-\-path data

+in a directory kmandelbrot.

+!-->

+<gui name="KMandelbrot"

+version="1"

+xmlns="http://www.kde.org/standards/kxmlgui/1.0"

+xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"

+xsi:schemaLocation="http://www.kde.org/standards/kxmlgui/1.0

+http://www.kde.org/standards/kxmlgui/1.0/kxmlgui.xsd" >

+

+<MenuBar>

+<!--

+<Menu name="file" >

+<Action name="view_zoom_in" />

+</Menu>

+!-->

+</MenuBar>

+

+<ToolBar name="mainToolBar" >

+<text>Main Toolbar</text>

+<Action name="view_zoom_in" />

+<!-- You can find the name with:

+(kde:kstandardaction.name kde:kstandardaction.+zoomin+)

+!-->

+<Action name="view_zoom_out" />

+</ToolBar>

+

+</gui>

--- old-kde.examples/src/mandelbrot/mandelbrot.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-kde.examples/src/mandelbrot/mandelbrot.lisp 2014-10-30 06:57:00.000000000 +0100

@@ -0,0 +1,66 @@

+(in-package :kde.examples)

+

+(declaim (optimize (debug 3)))

+

+(defun make-aboutdata ()

+ (let ((app-name (make-instance 'qt:byte-array :args '("kmandelbrot")))

+ (catalog-name (make-instance 'qt:byte-array))

+ (program-name (kde:ki18n "KMandelbrot"))

+ (version (make-instance 'qt:byte-array :args '("0.0.1")))

+ (description (kde:ki18n "KDE Mandelbrot program."))

+ (copyright (kde:ki18n "Copyright (c) 2009 Tobias Rautenkranz"))

+ (text (kde:ki18n "TODO"))

+ (homepage (make-instance 'qt:byte-array

+ :args '("http://tobias.rautenkranz.ch")))

+ (email (make-instance 'qt:byte-array

+ :args '("bugs@tobias.rautenkranz.ch"))))

+ (let ((aboutdata

+ (make-instance 'kde:about-data :args (list

+ app-name catalog-name program-name

+ version description

+ kde:about-data.+license-lgpl-v2+

+ copyright text homepage email))))

+ (cxx:add-author aboutdata

+ (kde:ki18n "Tobias Rautenkranz")

+ (make-instance 'kde:localized-string)

+ (make-instance 'qt:byte-array :args '("tobias@rautenkranz.ch")))

+ aboutdata)))

+

+(defun mandelbrot ()

+ (kde:with-app (make-aboutdata)

+ (let* ((window (make-instance 'kde:xml-gui-window))

+ (mandelbrot (make-instance 'mandelbrotwidget))

+ (resource-dir (directory-namestring

+ (mb.sysdef:component-pathname

+ (mb.sysdef:find-component :kde.examples "src")))))

+

+ (cxx:add-resource-dir (kde:global.dirs)

+ "icon" resource-dir)

+ (cxx:add-resource-dir (kde:global.dirs)

+ "apps" resource-dir)

+ (cxx:quit (find-class 'kde:standard-action)

+ window (qt:qslot "close()")

+ (cxx:action-collection window))

+

+ (kde:make-standard-action kde:standard-action.+redisplay+

+ (cxx:action-collection window)

+ #'(lambda () (zoom mandelbrot 1d0)))

+

+ (kde:make-standard-action kde:standard-action.+zoom-in+

+ (cxx:action-collection window)

+ #'(lambda () (zoom mandelbrot 0.5d0)))

+

+ (kde:make-standard-action kde:standard-action.+zoom-out+

+ (cxx:action-collection window)

+ #'(lambda () (zoom mandelbrot 2d0)))

+

+ (cxx:set-central-widget window mandelbrot)

+ (cxx:set-focus mandelbrot)

+ (setup-slot mandelbrot)

+

+ (cxx:add-resource-dir (kde:global.dirs)

+ "data" resource-dir)

+ (cxx:setup-gui window)

+

+ (cxx:show window)

+ (qt:exec))))

--- old-kde.examples/src/mandelbrot/mandelbrotwidget.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-kde.examples/src/mandelbrot/mandelbrotwidget.lisp 2014-10-30 06:57:00.000000000 +0100

@@ -0,0 +1,163 @@

+(in-package :kde.examples)

+(declaim (optimize (debug 3)))

+

+(defun zoom-in-factor ()

+ 0.8)

+

+(defun zoom-out-factor ()

+ (/ (zoom-in-factor)))

+

+(defclass mandelbrotwidget (qt:widget)

+ ((pixmap :accessor pixmap :initform nil)

+ (pixmap-scale :accessor pixmap-scale)

+ (pixmap-offset :accessor pixmap-offset)

+ (center :accessor center :initform #C(-0.5d0 0d0))

+ (scale :accessor scale :initform 0.007d0)

+ (update-pixmap-slot :accessor update-pixmap-slot)

+ (render :accessor render-thread)

+ (last-drag-pos :accessor last-drag-pos :initform nil))

+ (:metaclass cxx:class))

+

+(defun update-pixmap (mandelbrotwidget image scale)

+ (when (null (last-drag-pos mandelbrotwidget))

+ (setf (pixmap mandelbrotwidget)

+ (qt:pixmap.from-image image))

+ (setf (pixmap-offset mandelbrotwidget) #c(0 0))

+ (setf (pixmap-scale mandelbrotwidget) scale)

+ (cxx:update mandelbrotwidget)))

+

+(defparameter *render-control* (make-instance 'render-control))

+(defun setup-slot (mandelbrotwidget)

+ (setf (update-pixmap-slot mandelbrotwidget)

+ (qt:make-slot #'(lambda (image scale)

+ (update-pixmap mandelbrotwidget image scale))

+ (mapcar #'find-class

+ '(qt:image double-float))))

+ (qt:connect (done-signal *render-control*)

+ (update-pixmap-slot mandelbrotwidget)

+ qt:+queued-connection+))

+

+(defun draw-rendering (painter widget)

+ (cxx:set-pen painter (make-instance 'qt:color

+ :args (list qt:+white+)))

+ (cxx:draw-text painter (cxx:rect widget)

+ (value qt:+align-center+)

+ "Rendering initial image, please wait..."))

+

+(defun complex-floor (complex)

+ "Applys FLOOR to the real and imaginary part of COMPLEX."

+ (complex (floor (realpart complex)

+ (imagpart complex))))

+

+(defun draw-scaled-pixmap (painter widget)

+ (cxx:save painter) ;; FIXME make with- macro

+ (let* ((scale-factor (/ (pixmap-scale widget)

+ (scale widget)))

+ (pixmap-size (complex (cxx:width (pixmap widget))

+ (cxx:height (pixmap widget))))

+ (new-size (* scale-factor pixmap-size))

+ (new-center (+ (pixmap-offset widget) (/ (- pixmap-size new-size) 2))))

+ (cxx:translate painter (realpart new-center) (imagpart new-center))

+ (cxx:scale painter scale-factor scale-factor)

+ (let ((exposed (cxx:adjusted (cxx:map-rect (cxx:inverted (cxx:matrix painter))

+ (cxx:rect widget))

+ -1 -1 1 1)))

+ (cxx:draw-pixmap painter exposed (pixmap widget) exposed)))

+ (cxx:restore painter))

+

+

+(defun draw-pixmap (painter widget)

+ (if (= (scale widget) (pixmap-scale widget))

+ (cxx:draw-pixmap painter

+ (floor (realpart (pixmap-offset widget)))

+ (floor (imagpart (pixmap-offset widget)))

+ (pixmap widget))

+ (draw-scaled-pixmap painter widget)))

+

+(defmethod cxx:paint-event ((widget mandelbrotwidget) &rest args)

+ (declare (ignore args))

+ (qt:with-painter (painter widget)

+ (cxx:fill-rect painter (cxx:rect widget)

+ (make-instance 'qt:brush :args (list

+ (make-instance 'qt:color :args (list qt:+black+)))))

+ (if (null (pixmap widget))

+ (draw-rendering painter widget)

+ (draw-pixmap painter widget))))

+

+(defmethod cxx:resize-event ((widget mandelbrotwidget) &rest args)

+ (declare (ignore args))

+ (when (slot-boundp widget 'render)

+ (setf (stop-p *render-control*) t)

+ (join-thread (slot-value widget 'render)))

+ (queue-image widget))

+

+(defmethod cxx:key-press-event ((widget mandelbrotwidget) &rest args

+ &aux (event (first args)))

+ (enum-cases (cxx:key event)

+ (qt:+key-up+

+ (scroll widget #C(0d0 -5d0)))

+ (qt:+key-down+

+ (scroll widget #C(0d0 5d0)))

+ (qt:+key-left+

+ (scroll widget #C(-5d0 0d0)))

+ (qt:+key-right+

+ (scroll widget #C(5d0 0d0)))

+ (qt:+key-plus+

+ (zoom widget (zoom-in-factor)))

+ (qt:+key-minus+

+ (zoom widget (zoom-out-factor)))))

+

+(defmethod cxx:mouse-press-event ((widget mandelbrotwidget) &rest args

+ &aux (event (first args)))

+ (when (enum= (cxx:button event) qt:+left-button+)

+ (setf (last-drag-pos widget) (complex (cxx:x event)

+ (cxx:y event)))))

+

+(defmethod cxx:wheel-event ((widget mandelbrotwidget) &rest args

+ &aux (event (first args)))

+ (zoom widget (expt (zoom-in-factor) (/ (cxx:delta event) (* 8 15.0)))))

+

+(defmethod cxx:mouse-move-event ((widget mandelbrotwidget) &rest args

+ &aux (event (first args)))

+ (when (logand (cxx:buttons event) (value qt:+left-button+))

+ (incf (pixmap-offset widget)

+ (- (complex (cxx:x event)

+ (cxx:y event))

+ (last-drag-pos widget)))

+ (setf (last-drag-pos widget) (complex (cxx:x event)

+ (cxx:y event)))

+ (cxx:update widget)))

+

+(defmethod cxx:mouse-release-event ((widget mandelbrotwidget) &rest args

+ &aux (event (first args)))

+ (when (enum= (cxx:button event) qt:+left-button+)

+ (incf (pixmap-offset widget)

+ (- (complex (cxx:x event)

+ (cxx:y event))

+ (last-drag-pos widget)))

+ (setf (last-drag-pos widget) nil)

+ (let ((pixmap-size (complex (cxx:width (pixmap widget))

+ (cxx:height (pixmap widget))))

+ (size (complex (cxx:width widget)

+ (cxx:height widget))))

+ (scroll widget (- (/ (- size pixmap-size) 2) (pixmap-offset widget))))))

+

+(defun queue-image (widget)

+ (setf (stop-p *render-control*) nil)

+ ;; FIXME do not creating a new thread on every invokation

+ (setf (render-thread widget)

+ (make-thread (make-render-function (center widget)

+ (scale widget)

+ (cxx:width widget)

+ (cxx:height widget)

+ *render-control*))))

+

+(defun zoom (widget factor)

+ (setf (scale widget) (* (scale widget) factor))

+ (cxx:update widget)

+ (queue-image widget))

+

+(defun scroll (widget delta)

+ (incf (center widget) (* (scale widget) delta))

+ (cxx:update widget)

+ (queue-image widget))

--- old-kde.examples/src/mandelbrot/render.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-kde.examples/src/mandelbrot/render.lisp 2014-10-30 06:57:00.000000000 +0100

@@ -0,0 +1,114 @@

+;;; Copyright (C) 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

+;;; Copyright (C) 2009 Nokia Corporation and/or its subsidiary(-ies).

+;;;

+;;; This library is free software; you can redistribute it and/or

+;;; modify it under the terms of the GNU Lesser General Public

+;;; License as published by the Free Software Foundation; either

+;;; version 2.1 of the License, or (at your option) any later version.

+;;;

+;;; This library is distributed in the hope that it will be useful,

+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of

+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU

+;;; Lesser General Public License for more details.

+;;;

+;;; You should have received a copy of the GNU Lesser General Public

+;;; License along with this library; if not, write to the Free Software

+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

+;;;

+

+(in-package :kde.examples)

+

+(declaim (optimize (debug 3)))

+

+(defun make-image (width height)

+ (make-instance 'qt:image :args (list width height

+ qt:image.+format-rgb32+)))

+

+(declaim (inline z_0))

+(defun z_0 ()

+ #C(0d0 0d0))

+

+(declaim (inline z_n+1))

+(defun z_n+1 (z_n c)

+ (+ (expt z_n 2) c))

+

+(declaim (inline make-complex))

+(defun make-complex (realpart imagpart)

+ (+ (float realpart 0d0) (* imagpart #C(0d0 1d0))))

+

+

+(defun diverge-p (c iterations)

+ (declare (type (complex double-float) c)

+ (type fixnum iterations)

+ (optimize (speed 3) (debug 3) (safety 3)))

+ (let ((z (z_0)))

+ (declare (type (complex double-float) z))

+ (dotimes (n iterations nil)

+ (setf z (z_n+1 z c))

+ (when (> (+ (expt (realpart z) 2) (expt (imagpart z) 2)) 4)

+ (return n)))))

+

+

+(declaim (inline div-to-color))

+(defun div-to-color (n iterations)

+ (declare (type fixnum n iterations))

+ (let ((grey (- #xFF (min #xFF n))))

+ (+ #xFF000000

+ (* #x010000 grey)

+ (* #x000100 grey)

+ (* #x000001 grey))))

+

+(defclass render-control ()

+ ((done-signal :initform (qt:make-signal (find-class 'qt:image)

+ (find-class 'double-float))

+ :reader done-signal

+ :documentation "Signals that an image is ready.")

+ (mutex :initform (sb-thread:make-mutex)

+ :accessor mutex)

+ (stop-p :initform nil)))

+

+(defun stop-p (render-control)

+ (sb-thread:with-mutex ((mutex render-control))

+ (slot-value render-control 'stop-p)))

+

+(defmacro if-stop-p (render-control then else)

+ `(sb-thread:with-mutex ((mutex ,render-control))

+ (if (slot-value ,render-control 'stop-p)

+ ,then

+ ,else)))

+

+(defun (setf stop-p) (new-value control)

+ (sb-thread:with-mutex ((mutex control))

+ (setf (slot-value control 'stop-p)

+ new-value)))

+

+;;;a : x width

+;;;b : y height

+(defun render (center scale width height control)

+ (declare (fixnum width height)

+ (type (complex double-float) center)

+ (double-float scale)

+ (optimize (speed 3)))

+ (let ((image (make-image width height))

+ (top-left (- (/ (complex width height) 2))))

+ (dotimes (pass 1)

+ (let ((iterations 200)) ;(+ (expt 2 (+ (* 2 pass) 6)) 32)))

+ (dotimes (y height)

+ (when (stop-p control)

+ (return))

+ (let ((scanline (cxx:scan-line image y)))

+ (dotimes (x width)

+ (let ((diverge (diverge-p (+ (* scale (+ top-left (make-complex x y))) center) iterations)))

+ (if diverge

+ (setf (cffi:mem-ref scanline :unsigned-int)

+ (div-to-color diverge iterations))

+ (setf (cffi:mem-ref scanline :unsigned-int)

+ #.(qt:q-rgb 0 0 0))))

+ (cffi:incf-pointer scanline

+ (cffi:foreign-type-size :unsigned-int))))))

+ (if-stop-p control

+ (return)

+ (funcall (done-signal control) image scale)))))

+

+(defun make-render-function (center scale width height done-signal)

+ #'(lambda () (render center scale width height done-signal)))

--- old-kde.examples/src/package.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-kde.examples/src/package.lisp 2014-10-30 06:57:00.000000000 +0100

@@ -0,0 +1,4 @@

+(defpackage :kde.examples

+ (:use #:cl :bordeaux-threads #:cxx-support)

+ (:export #:hello-world

+ #:mandelbrot))