mirrors/lqml
1
Fork 0
mirror of https://gitlab.com/eql/lqml.git synced 2026-01-03 07:42:27 -08:00
Code Issues Projects Releases Packages Wiki Activity

revisions

Browse source
This commit is contained in:
pls.153 2024-10-26 12:58:15 +02:00
parent dc29ac9084
commit e8866954c0
9 changed files with 120 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

53
examples/tilt-sensor/lisp/main.lisp
View file

@ -8,36 +8,37 @@
(defvar *max-x* (* (1- *width*) +w+))
(defun move (x-rotation y-rotation) ; called from QML
(labels ((add (x)
(truncate (signum x)))
(to-pos (x)
(truncate (/ (+ x (/ +w+ 2))
+w+)))
(normalize (x)
(* (to-pos x) +w+)))
;; x axis rotation changes y
;; y axis rotation changes x
(let* ((dx (min (* 0.2 y-rotation) (1- +w+)))
(dy (min (* 0.2 x-rotation) (1- +w+)))
(add-x (add dx))
(add-y (add dy)))
(setf *x* (min *x* *max-x*)) ; don't lose ball (initial x)
(if (aref *maze*
(+ add-x (to-pos *x*))
(to-pos *y*))
(setf *x* (normalize *x*))
(incf *x* dx))
(if (aref *maze*
(to-pos *x*)
(+ add-y (to-pos *y*)))
(setf *y* (normalize *y*))
(incf *y* dy))))
(move-ball)
(when *ready*
(labels ((add (x)
(truncate (signum x)))
(to-pos (x)
(truncate (/ (+ x (/ +w+ 2))
+w+)))
(normalize (x)
(* (to-pos x) +w+)))
;; x axis rotation changes y
;; y axis rotation changes x
(let* ((dx (min (* 0.2 y-rotation) (1- +w+)))
(dy (min (* 0.2 x-rotation) (1- +w+)))
(add-x (add dx))
(add-y (add dy)))
(setf *x* (min *x* *max-x*)) ; don't lose ball (initial x)
(if (aref *maze*
(min (1- *width*) (+ add-x (to-pos *x*)))
(max 0 (to-pos *y*)))
(setf *x* (normalize *x*))
(incf *x* dx))
(if (aref *maze*
(min (1- *width*) (to-pos *x*))
(max 0 (+ add-y (to-pos *y*))))
(setf *y* (normalize *y*))
(incf *y* dy))))
(move-ball))
(values)) ; no return value to QML
(defun move-ball ()
(if (and (= *x* +w+)
(= *y* 0))
(<= *y* 0))
(new-game)
(let ((ball (find-quick-item ui:*ball*)))
;; 'qset' is faster than 'q>', but can't trigger animations