mirror of
https://gitlab.com/eql/EQL5.git
synced 2025-12-14 14:20:34 -08:00
245 lines
9.2 KiB
Common Lisp
245 lines
9.2 KiB
Common Lisp
;;; This is a port of the Qt Example "Colliding Mice"
|
|
;;;
|
|
;;; Note (OSX only):
|
|
;;;
|
|
;;; Seldom crashes (OSX 10.4, Qt 4.6.2) are not related to this tool, as they happen even in the original Qt example.
|
|
;;;
|
|
;;; The good news: if a seg.fault happens (in C++), just choose the restart option "Abort" (below "Continue"),
|
|
;;; and the application will continue to run.
|
|
|
|
(defpackage :colliding-mice
|
|
(:nicknames :mice)
|
|
(:use :common-lisp :eql)
|
|
(:export
|
|
#:start))
|
|
|
|
(in-package :colliding-mice)
|
|
|
|
(defconstant +2pi+ (* 2 pi))
|
|
|
|
(defvar *graphics-scene* (qnew "QGraphicsScene"
|
|
"sceneRect" '(-300 -300 600 600)))
|
|
(defvar *timer* (qnew "QTimer"))
|
|
(defvar *mouse-count* 0)
|
|
|
|
(defstruct mouse ; DEFSTRUCT (instead of DEFCLASS) is simpler in this case
|
|
(item (qnew "QGraphicsItem"))
|
|
(brush (brush (|fromRgb.QColor| (random 256) (random 256) (random 256))))
|
|
(angle 0)
|
|
(speed 0)
|
|
(eye-direction 0))
|
|
|
|
(defmethod the-qt-object ((object mouse)) ; see example "X-extras/CLOS-encapsulation.lisp"
|
|
(mouse-item object))
|
|
|
|
(let ((shape (x:let-it (qnew "QPainterPath")
|
|
(|addRect| x:it '(-10 -20 20 40)))))
|
|
(defun new-mouse ()
|
|
(incf *mouse-count*)
|
|
(let ((mouse (make-mouse)))
|
|
(|setRotation| mouse (random (* 360 16)))
|
|
(x:do-with (qoverride mouse)
|
|
("boundingRect()"
|
|
(lambda () '(-18.5 -22.5 36.5 60.5)))
|
|
("shape()"
|
|
(lambda () shape))
|
|
("paint(QPainter*,QStyleOptionGraphicsItem*,QWidget*)"
|
|
(lambda (painter s w) (paint mouse painter)))
|
|
("advance(int)"
|
|
(lambda (step) (advance mouse step))))
|
|
mouse)))
|
|
|
|
(defun brush (color &optional (style |Qt.SolidPattern|))
|
|
(x:let-it (qnew "QBrush")
|
|
(|setStyle| x:it style)
|
|
(when color
|
|
(|setColor| x:it color))))
|
|
|
|
(defparameter *brush-eyes* (brush "white"))
|
|
(defparameter *brush-nose* (brush "black"))
|
|
(defparameter *brush-ears* (brush "olive"))
|
|
(defparameter *brush-colliding* (brush "red"))
|
|
(defparameter *brush-tail* (brush nil |Qt.NoBrush|))
|
|
|
|
(defparameter *painter-path-tail* (x:let-it (qnew "QPainterPath")
|
|
(x:do-with x:it
|
|
(|moveTo| '(0 20))
|
|
(|cubicTo| '(-5 22) '(-5 22) '(0 25))
|
|
(|cubicTo| '(5 27) '(5 32) '(0 30))
|
|
(|cubicTo| '(-5 32) '(-5 42) '(0 35)))))
|
|
|
|
(defun paint (mouse painter)
|
|
(|setBrush| painter (mouse-brush mouse))
|
|
(|drawEllipse| painter '(-10 -20 20 40))
|
|
;; eyes
|
|
(|setBrush| painter *brush-eyes*)
|
|
(|drawEllipse| painter '(-10 -17 8 8))
|
|
(|drawEllipse| painter '(2 -17 8 8))
|
|
;; nose
|
|
(|setBrush| painter *brush-nose*)
|
|
(|drawEllipse| painter '(-2 -22 4 4))
|
|
;; pupils
|
|
(let ((dir (mouse-eye-direction mouse)))
|
|
(|drawEllipse| painter (list (- dir 8) -17 4 4))
|
|
(|drawEllipse| painter (list (+ dir 4) -17 4 4)))
|
|
;; ears
|
|
(|setBrush| painter (if (null (|collidingItems| (|scene| mouse) mouse))
|
|
*brush-ears*
|
|
*brush-colliding*))
|
|
(|drawEllipse| painter '(-17 -12 16 16))
|
|
(|drawEllipse| painter '(1 -12 16 16))
|
|
;; tail
|
|
(|setBrush| painter *brush-tail*)
|
|
(|drawPath| painter *painter-path-tail*))
|
|
|
|
(defun advance (mouse step)
|
|
(unless (zerop step)
|
|
(labels ((normalize-angle (a)
|
|
(x:while (minusp a)
|
|
(incf a +2pi+))
|
|
(x:while (> a +2pi+)
|
|
(decf a +2pi+))
|
|
a)
|
|
(dx (line)
|
|
(- (third line) (first line)))
|
|
(dy (line)
|
|
(- (fourth line) (second line)))
|
|
(len (line)
|
|
(let ((x (dx line))
|
|
(y (dy line)))
|
|
(sqrt (+ (* x x) (* y y)))))
|
|
(map-from (p)
|
|
(|mapFromScene| mouse p))
|
|
(map-to (p)
|
|
(|mapToScene| mouse p)))
|
|
(let ((line-to-center (append '(0 0) (map-from '(0 0)))))
|
|
(if (> (len line-to-center) 150)
|
|
(let ((angle-to-center (acos (/ (dx line-to-center) (len line-to-center)))))
|
|
(when (minusp (dy line-to-center))
|
|
(setf angle-to-center (- +2pi+ angle-to-center)))
|
|
(setf angle-to-center (normalize-angle (+ (- pi angle-to-center)
|
|
(/ pi 2))))
|
|
(cond ((< (/ pi 4) angle-to-center pi)
|
|
;; rotate left
|
|
(incf (mouse-angle mouse)
|
|
(if (< (mouse-angle mouse) (/ (- pi) 2)) 0.25 -0.25)))
|
|
((and (>= angle-to-center pi)
|
|
(< angle-to-center (+ pi (/ pi 2) (/ pi 4))))
|
|
;; rotate right
|
|
(incf (mouse-angle mouse)
|
|
(if (< (mouse-angle mouse) (/ pi 2)) 0.25 -0.25)))))
|
|
(let ((sin (sin (mouse-angle mouse))))
|
|
(incf (mouse-angle mouse) (cond ((minusp sin) 0.25)
|
|
((plusp sin) -0.25)
|
|
(t 0))))))
|
|
;; try not to crash with any other mice
|
|
(let ((danger-mice (|items| (|scene| mouse)
|
|
(append (map-to '(0 0))
|
|
(map-to '(-30 -50))
|
|
(map-to '(30 -50)))
|
|
|Qt.IntersectsItemShape|
|
|
|Qt.AscendingOrder|)))
|
|
(dolist (danger-mouse danger-mice)
|
|
(unless (qeql mouse danger-mouse)
|
|
(let* ((line-to-mouse (append '(0 0)
|
|
(|mapFromItem| mouse danger-mouse '(0 0))))
|
|
(angle-to-mouse (acos (/ (dx line-to-mouse) (len line-to-mouse)))))
|
|
(when (minusp (dy line-to-mouse))
|
|
(setf angle-to-mouse (- +2pi+ angle-to-mouse)))
|
|
(setf angle-to-mouse (normalize-angle (+ (- pi angle-to-mouse)
|
|
(/ pi 2))))
|
|
(cond ((and (>= angle-to-mouse 0)
|
|
(< angle-to-mouse (/ pi 2)))
|
|
;; rotate right
|
|
(incf (mouse-angle mouse) 0.5))
|
|
((and (<= angle-to-mouse +2pi+)
|
|
(> angle-to-mouse (- +2pi+ (/ pi 2))))
|
|
;; rotate left
|
|
(decf (mouse-angle mouse) 0.5))))))
|
|
;; add some random movement
|
|
(when (and (> (length danger-mice) 1)
|
|
(zerop (random 10)))
|
|
(let ((rnd (/ (random 100) 500))
|
|
(angle (mouse-angle mouse)))
|
|
(setf (mouse-angle mouse)
|
|
(if (zerop (random 2)) (+ angle rnd) (- angle rnd)))))
|
|
(incf (mouse-speed mouse) (/ (- (random 100) 50) 100))
|
|
(let ((dx (* 10 (sin (mouse-angle mouse)))))
|
|
(setf (mouse-eye-direction mouse)
|
|
(if (< (abs (/ dx 5)) 1) 0 (/ dx 5)))
|
|
(|setRotation| mouse (+ dx (|rotation| mouse)))
|
|
(|setPos| mouse (|mapToParent| mouse (list 0 (- (+ 3 (* 3 (sin (mouse-speed mouse)))))))))))))
|
|
|
|
(defun start ()
|
|
(setf *random-state* (make-random-state t))
|
|
(let ((view (qnew "QGraphicsView"
|
|
"windowTitle" "Colliding Mice"
|
|
"size" '(400 300))))
|
|
(|setItemIndexMethod| *graphics-scene* |QGraphicsScene.NoIndex|)
|
|
(x:do-with view
|
|
(|setScene| *graphics-scene*)
|
|
(|setRenderHint| |QPainter.Antialiasing|)
|
|
(|setBackgroundBrush| (qnew "QBrush(QPixmap)"
|
|
(qnew "QPixmap(QString)"
|
|
(in-src "examples/data/icons/cheese.jpg"))))
|
|
(|setCacheMode| |QGraphicsView.CacheBackground|)
|
|
(|setViewportUpdateMode| |QGraphicsView.BoundingRectViewportUpdate|)
|
|
(|setDragMode| |QGraphicsView.ScrollHandDrag|))
|
|
(let ((count 7))
|
|
(dotimes (i count)
|
|
(flet ((pos (fun)
|
|
(truncate (* 200 (funcall fun (/ (* i +2pi+) count))))))
|
|
(let ((item (new-mouse)))
|
|
(|setPos| item (list (pos 'sin) (pos 'cos)))
|
|
(|addItem| *graphics-scene* item)))))
|
|
(qconnect *timer* "timeout()" *graphics-scene* "advance()")
|
|
(|start| *timer* 30)
|
|
(x:do-with view |show| |raise|)))
|
|
|
|
;;; for playing around interactively
|
|
|
|
(defun m+ (&optional (n 1))
|
|
"Add n mice."
|
|
(dotimes (i n)
|
|
(let ((item (new-mouse)))
|
|
(|setPos| item (list (- 100 (random 200)) (- 100 (random 200))))
|
|
(|addItem| *graphics-scene* item)))
|
|
*mouse-count*)
|
|
|
|
(defun m- (&optional (n 1))
|
|
"Remove n mice."
|
|
(dotimes (i n)
|
|
(when (zerop *mouse-count*)
|
|
(return))
|
|
(decf *mouse-count*)
|
|
(qdel (first (last (|items| *graphics-scene*)))))
|
|
*mouse-count*)
|
|
|
|
(defun iv (&optional (ms 30))
|
|
"Change move interval."
|
|
(|setInterval| *timer* ms))
|
|
|
|
(defun ? ()
|
|
;; demo of QSLEEP (a SLEEP processing Qt events)
|
|
(let ((max (print (length (|items| *graphics-scene*)))))
|
|
(dotimes (n max)
|
|
(print (m-))
|
|
(qsleep 1))
|
|
(dotimes (n max)
|
|
(print (m+))
|
|
(qsleep 1))))
|
|
|
|
#|
|
|
(require :profile)
|
|
|
|
(progn
|
|
(use-package :profile)
|
|
(profile:profile
|
|
paint
|
|
advance))
|
|
|#
|
|
|
|
(progn
|
|
(start)
|
|
(qlater (lambda () (in-package :mice))))
|
|
|