1 files changed, 79 insertions, 3 deletions
diff --git a/lisparuga/player.scm b/lisparuga/player.scm
index ca6f491..1646f15 100644
--- a/lisparuga/player.scm
+++ b/lisparuga/player.scm
@@ -15,11 +15,19 @@
 ;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (lisparuga player)
-  #:use-module (sly records)
+  #:use-module (ice-9 match)
+  #:use-module (sly actor)
+  #:use-module (sly math)
   #:use-module (sly math rect)
   #:use-module (sly math vector)
+  #:use-module (sly records)
+  #:use-module (lisparuga bullets)
   #:use-module (lisparuga utils)
-  #:export (make-player
+  #:export (%player-bounds
+            %player-speed
+            %player-attack
+            %player-invincible-time
+            make-player
             player?
             player-polarity
             player-position
@@ -27,7 +35,23 @@
             player-shooting?
             player-hitbox
             player-absorb-hitbox
-            player-last-death-time))
+            player-last-death-time
+            kill-player
+            player-invincible?
+            toggle-polarity
+            direct-player
+            move-player
+            set-player-shooting
+            player-forward
+            player-bullet-script
+            make-player-bullet
+            player-world-hitbox
+            player-world-absorb-hitbox))
+
+(define %player-bounds (rect-inflate bounds -6 -8))
+(define %player-speed 1.1)
+(define %player-attack 1)
+(define %player-invincible-time (* 4 60))
 
 (define-record-type* <player>
   %make-player make-player
@@ -39,3 +63,55 @@
   (hitbox player-hitbox (make-rect -1 1 2 4))
   (absorb-hitbox player-absorb-hitbox (make-rect -9 -2 16 6))
   (last-death-time player-last-death-time #f))
+
+(define (kill-player player time)
+  (make-player #:inherit player #:last-death-time time))
+
+(define (player-invincible? player time)
+  (let ((last-death (player-last-death-time player)))
+    (and last-death
+         (negative?
+          (- time (+ last-death %player-invincible-time))))))
+
+(define (toggle-polarity player)
+  (make-player #:inherit player
+               #:polarity (if (eq? (player-polarity player) 'light)
+                              'dark
+                              'light)))
+
+(define (direct-player player direction)
+  (make-player #:inherit player #:direction direction))
+
+(define (move-player player offset)
+  (make-player #:inherit player
+               #:position (rect-clamp %player-bounds
+                                      (v+ (player-position player)
+                                          offset))))
+
+(define (set-player-shooting player shooting?)
+  (make-player #:inherit player #:shooting? shooting?))
+
+(define (player-forward speed)
+  (lambda (world effects player)
+    (values #f
+            effects
+            (move-player player (v* speed (player-direction player))))))
+
+(define player-bullet-script
+  (forever (forward 5)))
+
+(define player-bullet-direction (/ pi 2))
+
+(define (make-player-bullet player offset)
+  (make-actor (make-bullet #:position (v+ (player-position player) offset)
+                           #:type (match (player-polarity player)
+                                    ('light 'player-light)
+                                    ('dark 'player-dark))
+                           #:direction player-bullet-direction)
+              player-bullet-script))
+
+(define (player-world-hitbox player)
+  (rect-move (player-hitbox player) (player-position player)))
+
+(define (player-world-absorb-hitbox player)
+  (rect-move (player-absorb-hitbox player) (player-position player)))