commit 124da36958f88a5ea75725dcbc2294ead7923cfd
parent ce1b8e15096c3b2911e67ff18dbdf25a74107609
Author: Yuval Langer <yuvallangerontheroad@gmail.com>
Date: Fri, 10 Nov 2023 16:27:58 +0000
Simplify movement and fix cursor overshoot jitter.
Diffstat:
| M | main.scm | | | 100 | ++++++++++++++++++++++++++++++++++++------------------------------------------- |
1 file changed, 46 insertions(+), 54 deletions(-)
diff --git a/main.scm b/main.scm
@@ -178,10 +178,6 @@
(define (element-half-width element) (assq-ref element 'half-width))
(define (element-height element) (* 2 (element-half-height element)))
(define (element-half-height element) (assq-ref element 'half-height))
-(define (extents-x-low extents) (caar extents))
-(define (extents-x-high extents) (cdar extents))
-(define (extents-y-low extents) (cadr extents))
-(define (extents-y-high extents) (cddr extents))
;;; END Getters.
@@ -234,6 +230,15 @@
(< (element-bottom element-b)
(element-top element-a)))))
+(define (clip-overshoot target-position old-position new-position)
+ (cond
+ ((<= old-position target-position new-position)
+ target-position)
+ ((<= new-position target-position old-position)
+ target-position)
+ (else
+ new-position)))
+
;;; END Predicates.
;;; Global variables: (~_~)
@@ -290,35 +295,24 @@
;;; END Drawers.
-(define (clip value low high)
- ((o (min <> high)
- (max <> min))
+(define (clip-low-high value low high)
+ ((o (cut min <> high)
+ (cut max <> low))
value))
-(define (move-element! dt element &optional clip-extents)
- (let* ((previous-center-x (element-center-x element))
- (velocity-x (element-velocity-x element))
- (new-center-x (+ previous-center-x (* velocity-x dt)))
- (clipped-new-center-x (if (void? clip-extents)
- new-center-x
- (clip new-center-x
- (extents-x-low clip-extents)
- (extents-x-high clip-extents))))
- (previous-center-y (element-center-y element))
- (velocity-y (element-velocity-y element))
- (new-center-y (+ previous-center-y (* velocity-y dt)))
- (clipped-new-center-y (if (void? clip-extents)
- new-center-y
- (clip new-center-y
- (extents-y-low clip-extents)
- (extents-y-high clip-extents)))))
- (set-element-center-x! element
- clipped-new-center-x)
- (set-element-center-y! element
- clipped-new-center-y)))
-
-(define (move-elements! dt elements &optional extents)
- (for-each (cut move-element! dt <> extents)
+(define (move-axis dt center velocity)
+ (+ center (* velocity dt)))
+
+(define (move-elements! dt elements)
+ (for-each (lambda (element)
+ (set-element-center-x! element
+ (move-axis dt
+ (element-center-x element)
+ (element-velocity-x element)))
+ (set-element-center-y! element
+ (move-axis dt
+ (element-center-y element)
+ (element-velocity-y element))))
elements))
(define (filter-out-of-canvas-elements elements)
@@ -366,31 +360,29 @@
;; Get input:
(let* ((wanted-player-center-x (cursor-x cursor))
(previous-player-center-x (element-center-x player))
- (ratsui-minus-matsui (- wanted-player-center-x
- previous-player-center-x))
- (player-direction-x (cond
- ((< (abs ratsui-minus-matsui)
- 5)
- 0)
- ((> ratsui-minus-matsui
- 0)
- 1)
- (else -1)))
+ (player-direction-x (if (< previous-player-center-x
+ wanted-player-center-x)
+ 1
+ -1))
(new-player-velocity-x (* player-direction-x
player-speed-x)))
- (set-element-velocity-x! player new-player-velocity-x))
- (move-element! dt player (list (cons (+ 0
- (/ player-width
- 2))
- (- (.width canvas)
- (/ player-width
- 2)))
- (cons (+ 0
- (/ player-height
- 2))
- (- (.height canvas)
- (/ player-height
- 2)))))
+ (set-element-velocity-x! player
+ new-player-velocity-x))
+
+ ;; Move player:
+ (let* ((old-center-x (element-center-x player))
+ (new-center-x (move-axis dt
+ (element-center-x player)
+ (element-velocity-x player)))
+ (new-center-x (clip-overshoot (cursor-x cursor)
+ old-center-x
+ new-center-x))
+ (new-center-x (clip-low-high new-center-x
+ (element-half-width player)
+ (- (.width canvas)
+ (element-half-width player)))))
+ (set-element-center-x! player
+ new-center-x))
(set! falling-bricks (filter-out-of-canvas-elements falling-bricks))
(set! clouds (filter-out-of-canvas-elements clouds))
