Day 1 progress.

9 files changed, 755 insertions, 26 deletions

diff --git a/lisparuga/actor.scm b/lisparuga/actor.scm
new file mode 100644
index 0000000..c7caab2
--- /dev/null
+++ b/lisparuga/actor.scm
@@ -0,0 +1,113 @@
+;;; Lisparuga
+;;; Copyright © 2020 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Lisparuga is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Lisparuga 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; A class representing a scripted or player-controller object in the
+;; game world.  Actors can emit bullets and have many hitboxes.
+;;
+;;; Code:
+
+
+(define-module (lisparuga actor)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee math rect)
+  #:use-module (lisparuga node)
+  #:use-module (lisparuga node-2d)
+  #:use-module (oop goops)
+  #:use-module (srfi srfi-9)
+  #:export (make-hitbox
+            hitbox?
+            hitbox-name
+            hitbox-rect
+
+            world-hitbox?
+            world-hitbox-collision?
+            world-hitbox-parent
+
+            <actor>
+            polarity
+            velocity
+            hitboxes
+            world-hitboxes
+            on-collision
+            bullet-field))
+
+
+;;;
+;;; Hitboxes
+;;;
+
+(define-record-type <hitbox>
+  (make-hitbox name rect)
+  hitbox?
+  (name hitbox-name)
+  (rect hitbox-rect))
+
+(define-record-type <world-hitbox>
+  (%make-world-hitbox parent rect)
+  world-hitbox?
+  (parent world-hitbox-parent)
+  (rect world-hitbox-rect))
+
+(define (make-world-hitbox parent)
+  (let ((r (hitbox-rect parent)))
+    (%make-world-hitbox parent
+                        (make-rect 0.0 0.0 (rect-width r) (rect-height r)))))
+
+(define (sync-world-hitbox world-hitbox position)
+  (rect-move-vec2! (world-hitbox-rect world-hitbox) position))
+
+(define (world-hitbox-collision? a b)
+  (if (world-hitbox? b)
+      (rect-intersects? (world-hitbox-rect a) (world-hitbox-rect b))
+      (rect-intersects? (world-hitbox-rect a) b)))
+
+
+;;;
+;;; Actors
+;;;
+
+(define-class <actor> (<node-2d>)
+  (polarity #:accessor polarity #:init-form 'none #:init-keyword #:polarity)
+  (velocity #:getter velocity #:init-form (vec2 0.0 0.0))
+  (hitboxes #:accessor hitboxes #:init-form '() #:init-keyword #:hitboxes)
+  (world-hitboxes #:accessor world-hitboxes #:init-form '())
+  (bullet-field #:accessor bullet-field #:init-keyword #:bullet-field))
+
+(define-method (initialize (actor <actor>) initargs)
+  (next-method)
+  (set! (world-hitboxes actor)
+    (map make-world-hitbox (hitboxes actor))))
+
+(define-method (update (actor <actor>) dt)
+  (let ((v (velocity actor)))
+    (unless (and (= (vec2-x v) 0.0)
+                 (= (vec2-y v) 0.0))
+      ;; Move by current velocity.
+      (vec2-add! (position actor) v)
+      ;; Sync hitboxes to world coordinates.
+      (let ((pos (position actor)))
+        (for-each (lambda (world-hitbox)
+                    (sync-world-hitbox world-hitbox pos))
+                  (world-hitboxes actor)))
+      ;; Mark for matrix updates.
+      (dirty! actor))))
+
+;; Actor-actor collision event.
+(define-method (on-collision (actor <actor>) (other-actor <actor>)
+                             hitbox other-hitbox)
+  #t)
diff --git a/lisparuga/asset.scm b/lisparuga/asset.scm
index b4969b0..a2b0c99 100644
--- a/lisparuga/asset.scm
+++ b/lisparuga/asset.scm
@@ -22,6 +22,7 @@
 ;;; Code:
 
 (define-module (lisparuga asset)
+  #:use-module (chickadee render texture)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (oop goops)
@@ -38,7 +39,8 @@
             reload-modified-assets
             clear-asset-cache
             asset-ref
-            define-asset))
+            define-asset
+            load-tile-atlas))
 
 (define-class <asset> ()
   (watch? #:allocation #:class #:init-form #f)
@@ -198,3 +200,9 @@
       #:file-name file-name
       #:loader loader
       #:loader-args (list loader-args ...))))
+
+;; Convenience procedure for loading tilesets
+(define* (load-tile-atlas file-name tile-width tile-height
+                          #:key (margin 0) (spacing 0))
+  (split-texture (load-image file-name) tile-width tile-height
+                 #:margin margin #:spacing spacing))
diff --git a/lisparuga/bullets.scm b/lisparuga/bullets.scm
new file mode 100644
index 0000000..e241694
--- /dev/null
+++ b/lisparuga/bullets.scm
@@ -0,0 +1,243 @@
+;;; Lisparuga
+;;; Copyright © 2020 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Lisparuga is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Lisparuga 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Bullet state and logic.
+;;
+;;; Code:
+
+(define-module (lisparuga bullets)
+  #:use-module (chickadee math matrix)
+  #:use-module (chickadee math rect)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee render color)
+  #:use-module (chickadee render sprite)
+  #:use-module (chickadee render texture)
+  #:use-module (lisparuga actor)
+  #:use-module (lisparuga asset)
+  #:use-module (lisparuga node)
+  #:use-module (lisparuga node-2d)
+  #:use-module (oop goops)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:export (make-bullet
+            bullet-name
+            bullet-hitbox-rect
+            bullet-tile
+            ikaruga-bullet
+            ikaruga-missle
+            small-dot
+            medium-dot
+            large-dot
+            tapered-shot
+            big-laser
+
+            <bullet-field>
+            spawn-bullet
+            collision?
+            size
+            capacity
+            texture-atlas))
+
+
+;;;
+;;; Bullet Identifiers
+;;;
+
+(define-record-type <bullet>
+  (make-bullet name hitbox-rect tile-white tile-black)
+  bullet?
+  (name bullet-name)
+  ;; *NOT* a <hitbox> instance, those are just for actors.
+  (hitbox-rect bullet-hitbox-rect)
+  (tile-white bullet-tile-white)
+  (tile-black bullet-tile-black))
+
+(define ikaruga-bullet
+  (make-bullet 'ikaruga (make-rect 0.0 0.0 0.0 0.0) 0 1))
+(define ikaruga-missile
+  (make-bullet 'ikaruga-missile (make-rect 0.0 0.0 0.0 0.0) 0 1))
+(define small-dot
+  (make-bullet 'small-dot (make-rect 0.0 0.0 0.0 0.0) 0 1))
+(define medium-dot
+  (make-bullet 'medium-dot (make-rect 0.0 0.0 0.0 0.0) 0 1))
+(define large-dot
+  (make-bullet 'large-dot (make-rect 0.0 0.0 0.0 0.0) 0 1))
+(define tapered-shot
+  (make-bullet 'tapered-shot (make-rect 0.0 0.0 0.0 0.0) 0 1))
+;; Do lasers need a special data type? maybe I won't even get around
+;; to implementing them...
+(define big-laser
+  (make-bullet 'big-laser (make-rect 0.0 0.0 0.0 0.0) 0 1))
+
+
+;;;
+;;; Mass bullet management
+;;;
+
+(define-class <bullet-field> (<node-2d>)
+  (batch #:getter batch #:init-form (make-sprite-batch #f))
+  (size #:accessor size #:init-form 0)
+  (capacity #:getter capacity #:init-form 1000 #:init-keyword #:capacity)
+  (ids #:accessor ids)
+  (polarities #:accessor polarities)
+  (positions #:accessor positions)
+  (velocities #:accessor velocities)
+  (hitboxes #:accessor hitboxes)
+  (texture-atlas #:accessor texture-atlas #:init-keyword #:texture-atlas)
+  (scratch-rect #:getter scratch-rect #:init-form (make-rect 0.0 0.0 0.0 0.0)))
+
+(define-method (initialize (bullets <bullet-field>) initargs)
+  (next-method)
+  (let ((capacity (capacity bullets)))
+    (define (seed-vector thunk)
+      (let ((v (make-vector capacity #f)))
+        (let loop ((i 0))
+          (when (< i capacity)
+            (vector-set! v i (thunk))
+            (loop (+ i 1))))
+        v))
+    (set! (ids bullets) (make-vector capacity))
+    (set! (polarities bullets) (make-vector capacity))
+    (set! (positions bullets) (seed-vector (lambda () #v(0.0 0.0))))
+    (set! (velocities bullets) (seed-vector (lambda () #v(0.0 0.0))))
+    (set! (hitboxes bullets) (seed-vector (lambda () (make-rect 0.0 0.0 0.0 0.0))))))
+
+(define-method (spawn-bullet (bullets <bullet-field>) id polarity x y dx dy)
+  (let* ((i (size bullets))
+         (p (vector-ref (positions bullets) i))
+         (v (vector-ref (velocities bullets) i))
+         (h (vector-ref (hitboxes bullets) i))
+         (r (bullet-hitbox-rect id)))
+    (set! (size bullets) (+ i 1))
+    (vector-set! (ids bullets) i id)
+    (vector-set! (polarities bullets) i polarity)
+    (set-vec2! p x y)
+    (set-vec2! v dx dy)
+    (set-rect-x! h (rect-x r))
+    (set-rect-y! h (rect-y r))
+    (set-rect-width! h (rect-width r))
+    (set-rect-height! h (rect-height r))))
+
+(define-method (move-bullet (bullets <bullet-field>) from to)
+  (let ((ids (ids bullets))
+        (polarities (polarities bullets))
+        (positions (positions bullets))
+        (velocities (velocities bullets))
+        (hitboxes (hitboxes bullets)))
+    (vector-set! ids to (vector-ref ids from))
+    (vector-set! polarities to (vector-ref polarities from))
+    (vec2-copy! (vector-ref positions from) (vector-ref positions to))
+    (vec2-copy! (vector-ref velocities from) (vector-ref velocities to))
+    (rect-copy! (vector-ref hitboxes from) (vector-ref hitboxes to))))
+
+(define-method (kill-bullet (bullets <bullet-field>) i)
+  (let ((new-size (- (size bullets) 1)))
+    (set! (size bullets) new-size)
+    (move-bullet bullets new-size i)))
+
+(define-method (clear-bullets (bullets <bullet-field>))
+  (set! (size bullets) 0))
+
+(define-method (update (bullets <bullet-field>) dt)
+  (let ((l (size bullets))
+        (positions (positions bullets))
+        (velocities (velocities bullets))
+        (hitboxes (hitboxes bullets))
+        ;; Delete bullets that go too far off the screen.
+        (min-x -32.0)
+        (min-y -32.0)
+        (max-x (+ 160.0 32.0))
+        (max-y (+ 240.0 32.0)))
+    (define (delete i)
+      (let ((new-l (- l 1)))
+        (set! l new-l)
+        (move-bullet bullets new-l i)))
+    (let loop ((i 0))
+      (when (< i l)
+        (let ((p (vector-ref positions i))
+              (v (vector-ref velocities i))
+              (h (vector-ref hitboxes i)))
+          (vec2-add! p v)
+          ;; Remove bullets that go out of bounds of the play area.
+          (if (or (< (vec2-x p) min-x)
+                  (> (vec2-x p) max-x)
+                  (< (vec2-y p) min-y)
+                  (> (vec2-y p) max-y))
+              (begin
+                (delete i)
+                (loop i))
+              (begin
+                ;; Adjust hitbox.
+                (set-rect-x! h (+ (rect-x h) (vec2-x v)))
+                (set-rect-y! h (+ (rect-y h) (vec2-y v)))
+                (loop (+ i 1)))))))
+    (set! (size bullets) l)))
+
+;; Actor-bullet collision event.
+(define-method (on-collision (actor <actor>) bullet bullet-polarity hitbox)
+  #t)
+
+(define-method (collide (bullets <bullet-field>) (actor <actor>))
+  (let ((l (size bullets))
+        (ids (ids bullets))
+        (polarities (polarities bullets))
+        (hitboxes (hitboxes bullets)))
+    (let loop ((i 0))
+      (when (< i l)
+        (let* ((id (vector-ref ids i))
+               (h (vector-ref hitboxes i))
+               (wh (find (lambda (wh)
+                           (world-hitbox-collision? wh h))
+                         (world-hitboxes actor))))
+          (if (and wh
+                   (on-collision actor id (vector-ref polarities i)
+                                 (world-hitbox-parent wh)))
+              (kill-bullet bullets i)
+              (loop (+ i 1))))))))
+
+(define %identity-matrix (make-identity-matrix4))
+
+(define-method (render (bullets <bullet-field>) alpha)
+  (let ((l (size bullets))
+        (batch (batch bullets))
+        (ids (ids bullets))
+        (polarities (polarities bullets))
+        (positions (positions bullets))
+        (atlas (asset-ref (texture-atlas bullets)))
+        (r (scratch-rect bullets)))
+    (set-sprite-batch-texture! batch (texture-atlas-texture atlas))
+    (sprite-batch-clear! batch)
+    (let loop ((i 0))
+      (when (< i l)
+        (let* ((p (vector-ref positions i))
+               (id (vector-ref ids i))
+               (polarity (vector-ref polarities i))
+               (tile (if (eq? polarity 'white)
+                         (bullet-tile-white id)
+                         (bullet-tile-black id)))
+               (texture (texture-atlas-ref atlas tile))
+               (tw (texture-width texture))
+               (th (texture-height texture)))
+          (set-rect-x! r (- (vec2-x p) (/ tw 2.0)))
+          (set-rect-y! r (- (vec2-y p) (/ th 2.0)))
+          (set-rect-width! r tw)
+          (set-rect-height! r th)
+          (sprite-batch-add* batch r %identity-matrix
+                             #:texture-region texture))
+        (loop (+ i 1))))
+    (draw-sprite-batch* batch (world-matrix bullets))))
diff --git a/lisparuga/config.scm b/lisparuga/config.scm
index 322bf78..5d6f063 100644
--- a/lisparuga/config.scm
+++ b/lisparuga/config.scm
@@ -26,7 +26,7 @@
             scope-asset))
 
 (define developer-mode?
-  (equal? (getenv "LISPARGUA_DEV_MODE") "1"))
+  (equal? (getenv "LISPARUGA_DEV_MODE") "1"))
 
 (define asset-dir (getenv "LISPARUGA_ASSETDIR"))
 
diff --git a/lisparuga/enemy.scm b/lisparuga/enemy.scm
new file mode 100644
index 0000000..5ecba62
--- /dev/null
+++ b/lisparuga/enemy.scm
@@ -0,0 +1,65 @@
+;;; Lisparuga
+;;; Copyright © 2020 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Lisparuga is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Lisparuga 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Enemy actors.
+;;
+;;; Code:
+
+(define-module (lisparuga enemy)
+  #:use-module (chickadee math rect)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee scripting)
+  #:use-module (chickadee render texture)
+  #:use-module (lisparuga actor)
+  #:use-module (lisparuga asset)
+  #:use-module (lisparuga bullets)
+  #:use-module (lisparuga config)
+  #:use-module (lisparuga node)
+  #:use-module (lisparuga node-2d)
+  #:use-module (oop goops)
+  #:export (<enemy>
+            health
+            points
+            parting-shots
+
+            make-utatsugumi))
+
+
+;;;
+;;; Base Enemy
+;;;
+(define-class <enemy> (<actor>)
+  (health #:accessor health #:init-keyword #:health)
+  (points #:getter points #:init-keyword #:points)
+  (parting-shots #:getter parting-shots #:init-keyword #:parting-shots))
+
+
+;;;
+;;; Utatsugumi
+;;;
+
+(define-class <utatsugumi> (<enemy>))
+
+(define (make-utatsugumi polarity x y)
+  (make <utatsugumi>
+    #:name (gensym "utatsugumi-")
+    #:health 1
+    #:points 20
+    #:parting-shots 5
+    #:polarity polarity
+    #:position (vec2 x y)))
diff --git a/lisparuga/game.scm b/lisparuga/game.scm
new file mode 100644
index 0000000..edd97fc
--- /dev/null
+++ b/lisparuga/game.scm
@@ -0,0 +1,82 @@
+;;; Lisparuga
+;;; Copyright © 2020 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Lisparuga is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Lisparuga 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Game container.  Handles all the state, logic, and rendering for
+;; the game itself.
+;;
+;;; Code:
+
+(define-module (lisparuga game)
+  #:use-module (chickadee math rect)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee render color)
+  #:use-module (chickadee render texture)
+  #:use-module (lisparuga asset)
+  #:use-module (lisparuga bullets)
+  #:use-module (lisparuga config)
+  #:use-module (lisparuga node)
+  #:use-module (lisparuga node-2d)
+  #:use-module (lisparuga player)
+  #:use-module (oop goops)
+  #:export (<game>
+            steer-player
+            start-player-shooting
+            stop-player-shooting
+            toggle-player-polarity
+            fire-player-homing-missiles))
+
+(define-asset clouds (load-image (scope-asset "images/clouds.png")))
+(define-asset player-bullet-atlas
+  (load-tile-atlas (scope-asset "images/player-bullets.png") 16 16))
+
+;; nodes needed:
+;; enemies
+;; enemy bullets
+;; scrolling background
+(define-class <game> (<node-2d>))
+
+(define-method (on-boot (game <game>))
+  (let* ((player-bullets (make <bullet-field>
+                           #:capacity 500
+                           #:texture-atlas player-bullet-atlas))
+         (player (make-player player-bullets))
+         (enemy-bullets (make <bullet-field>
+                          #:capacity 1000
+                          #:texture-atlas player-bullet-atlas)))
+    (attach-to game
+               (make <sprite>
+                 #:name 'clouds
+                 #:texture clouds)
+               player
+               player-bullets
+               enemy-bullets)))
+
+(define-method (steer-player (game <game>) up? down? left? right?)
+  (steer (& game player) up? down? left? right?))
+
+(define-method (start-player-shooting (game <game>))
+  (start-shooting (& game player)))
+
+(define-method (stop-player-shooting (game <game>))
+  (stop-shooting (& game player)))
+
+(define-method (toggle-player-polarity (game <game>))
+  (toggle-polarity (& game player)))
+
+(define-method (fire-player-homing-missiles (game <game>))
+  (fire-homing-missiles (& game player)))
diff --git a/lisparuga/kernel.scm b/lisparuga/kernel.scm
index f94b832..36dea70 100644
--- a/lisparuga/kernel.scm
+++ b/lisparuga/kernel.scm
@@ -28,6 +28,7 @@
   #:use-module (chickadee render)
   #:use-module (chickadee render gpu)
   #:use-module (chickadee render viewport)
+  #:use-module (gl)
   #:use-module (ice-9 match)
   #:use-module (oop goops)
   #:use-module (sdl2)
@@ -35,7 +36,7 @@
   #:use-module (sdl2 input game-controller)
   #:use-module (sdl2 input joystick)
   #:use-module (sdl2 input text)
-  #:use-module (sdl2 video)
+  #:use-module ((sdl2 video) #:prefix sdl2:)
   #:use-module (lisparuga asset)
   #:use-module (lisparuga config)
   #:use-module (lisparuga node)
@@ -43,10 +44,10 @@
   #:use-module (lisparuga scene)
   #:use-module (system repl command)
   #:export (<window-config>
-            width
-            height
-            title
-            fullscreen?
+            window-width
+            window-height
+            window-title
+            window-fullscreen?
 
             <kernel>
             window-config
@@ -62,11 +63,11 @@
   #:re-export (abort-game))
 
 (define-class <window-config> ()
-  (width #:accessor width #:init-form 640 #:init-keyword #:width)
-  (height #:accessor height #:init-form 480 #:init-keyword #:height)
-  (title #:accessor title #:init-form "Lisparuga"
+  (width #:accessor window-width #:init-form 640 #:init-keyword #:width)
+  (height #:accessor window-height #:init-form 480 #:init-keyword #:height)
+  (title #:accessor window-title #:init-form "Lisparuga"
          #:init-keyword #:title)
-  (fullscreen? #:accessor fullscreen? #:init-form #f
+  (fullscreen? #:accessor window-fullscreen? #:init-form #f
                #:init-keyword #:fullscreen?))
 
 (define-class <kernel> (<scene-mux>)
@@ -114,11 +115,20 @@
     ;; Start REPL server.
     (attach-to kernel (make <repl> #:name 'repl))))
 
+(define-method (on-key-press (kernel <kernel>) key scancode modifiers repeat?)
+  ;; Hot keys when in dev mode
+  (when developer-mode?
+    (match key
+      ('f5 (reboot-current-scene))
+      ('escape (abort-game))
+      (_ #t)))
+  (next-method))
+
 (define-method (update-tree (kernel <kernel>) dt)
   (define (invert-y y)
     ;; SDL's origin is the top-left, but our origin is the bottom
     ;; left so we need to invert Y coordinates that SDL gives us.
-    (match (window-size (window kernel))
+    (match (sdl2:window-size (window kernel))
       ((_ height)
        (- height y))))
   (define (process-event event)
@@ -210,6 +220,12 @@
   ;; Free any GPU resources that have been GC'd.
   (gpu-reap!))
 
+(define %clear-mask
+  (logior (attrib-mask color-buffer)
+          (attrib-mask depth-buffer)
+          (attrib-mask stencil-buffer)
+          (attrib-mask accum-buffer)))
+
 (define-method (render-tree (kernel <kernel>) alpha)
   (let ((start-time (elapsed-time)))
     ;; Switch to the null viewport to ensure that
@@ -217,8 +233,9 @@
     ;; clear the screen.
     (set-gpu-viewport! (current-gpu) null-viewport)
     (with-viewport (default-viewport kernel)
+      (gl-clear %clear-mask)
       (next-method))
-    (swap-gl-window (window kernel))
+    (sdl2:swap-gl-window (window kernel))
     ;; Compute FPS.
     (set! (avg-frame-time kernel)
           (+ (* (- (elapsed-time) start-time) 0.1)
@@ -226,10 +243,10 @@
 
 (define-method (on-error (kernel <kernel>) stack key args)
   (if developer-mode?
-      (let ((title (window-title (window kernel))))
-        (set-window-title! (window kernel) (string-append "[ERROR] " title))
+      (let ((title (sdl2:window-title (window kernel))))
+        (sdl2:set-window-title! (window kernel) (string-append "[ERROR] " title))
         (on-error (& kernel repl) stack key args)
-        (set-window-title! (window kernel) title))
+        (sdl2:set-window-title! (window kernel) title))
       (apply throw key args)))
 
 (define-method (on-scenes-empty (kernel <kernel>))
@@ -253,18 +270,18 @@
   (init-audio)
   (let ((wc (window-config kernel)))
     (set! (window kernel)
-          (make-window #:opengl? #t
-                       #:title (title wc)
-                       #:size (list (width wc) (height wc))
-                       #:fullscreen? (fullscreen? wc)))
-    (set! (gl-context kernel) (make-gl-context (window kernel)))
+      (sdl2:make-window #:opengl? #t
+                        #:title (window-title wc)
+                        #:size (list (window-width wc) (window-height wc))
+                        #:fullscreen? (window-fullscreen? wc)))
+    (set! (gl-context kernel) (sdl2:make-gl-context (window kernel)))
     (set! (default-viewport kernel)
-          (make-viewport 0 0 (width wc) (height wc)))
+          (make-viewport 0 0 (window-width wc) (window-height wc)))
     ;; Attempt to activate vsync, if possible.  Some systems do
     ;; not support setting the OpenGL swap interval.
     (catch #t
       (lambda ()
-        (set-gl-swap-interval! 'vsync))
+        (sdl2:set-gl-swap-interval! 'vsync))
       (lambda args
         (display "warning: could not enable vsync\n"
                  (current-error-port))))
@@ -284,12 +301,13 @@
       (lambda ()
         (deactivate kernel)
         (quit-audio)
-        (delete-gl-context! (gl-context kernel))
-        (close-window! (window kernel))))))
+        (sdl2:delete-gl-context! (gl-context kernel))
+        (sdl2:close-window! (window kernel))))))
 
 (define (reboot-current-scene)
   "Reboot the currently active scene being managed by the game engine
 kernel.  A convenient procedure for developers."
+  (display "rebooting\n")
   (reboot (current-scene (current-kernel))))
 
 (define-meta-command ((debug-game lisparuga) repl)
@@ -301,3 +319,8 @@ Enter a debugger for the current game loop error."
   "resume-game
 Resume the game loop without entering a debugger."
   (set! (repl-debugging? (& (current-kernel) repl)) #f))
+
+(define-meta-command ((reboot lisparuga) repl)
+  "reboot
+Reboot the current scene."
+  (reboot-current-scene))
diff --git a/lisparuga/node-2d.scm b/lisparuga/node-2d.scm
index 9397c77..8dca8e1 100644
--- a/lisparuga/node-2d.scm
+++ b/lisparuga/node-2d.scm
@@ -191,6 +191,8 @@
 (define-class <view-2d> ()
   (camera #:accessor camera #:init-keyword #:camera)
   (area #:getter area #:init-keyword #:area)
+  (clear-color #:getter clear-color #:init-keyword #:clear-color
+               #:init-value tango-light-sky-blue)
   (viewport #:accessor viewport)
   (projection-matrix #:accessor projection-matrix)
   (sprite-rect #:accessor sprite-rect))
@@ -206,7 +208,8 @@
       (make-viewport (inexact->exact x)
                      (inexact->exact y)
                      (inexact->exact w)
-                     (inexact->exact h)))
+                     (inexact->exact h)
+                     #:clear-color (clear-color view)))
     (set! (sprite-rect view) (make-rect 0.0 0.0 w h))
     (set! (projection-matrix view) (orthographic-projection 0 w h 0 0 1))))
 
diff --git a/lisparuga/player.scm b/lisparuga/player.scm
new file mode 100644
index 0000000..a810e48
--- /dev/null
+++ b/lisparuga/player.scm
@@ -0,0 +1,192 @@
+;;; Lisparuga
+;;; Copyright © 2020 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Lisparuga is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Lisparuga 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Player actor.
+;;
+;;; Code:
+
+(define-module (lisparuga player)
+  #:use-module (chickadee math rect)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee scripting)
+  #:use-module (chickadee render texture)
+  #:use-module (lisparuga actor)
+  #:use-module (lisparuga asset)
+  #:use-module (lisparuga bullets)
+  #:use-module (lisparuga config)
+  #:use-module (lisparuga node)
+  #:use-module (lisparuga node-2d)
+  #:use-module (oop goops)
+  #:export (<player>
+            make-player
+            score
+            lives
+            energy
+            chain
+            chain-progress
+            speed
+            steer
+            start-shooting
+            stop-shooting
+            toggle-polarity
+            fire-homing-missiles))
+
+(define-asset ship (load-image (scope-asset "images/player.png")))
+(define-asset ship-atlas (load-tile-atlas (scope-asset "images/player.png") 24 24))
+
+(define kill-hitbox (make-hitbox 'kill (make-rect 0.0 0.0 0.0 0.0)))
+(define graze-hitbox (make-hitbox 'graze (make-rect 0.0 0.0 0.0 0.0)))
+
+(define-class <player> (<actor>)
+  (score #:accessor score #:init-value 0)
+  (lives #:accessor lives #:init-value 2)
+  (energy #:accessor energy #:init-value 0)
+  (chain #:accessor chain #:init-value 0)
+  (chain-progress #:accessor chain-progress #:init-form '())
+  (speed #:accessor speed #:init-value 1.75)
+  (invincible? #:accessor invincible? #:init-value #f)
+  (shooting? #:accessor shooting? #:init-value #f)
+  (shoot-time #:accessor shoot-time #:init-value 0))
+
+(define (make-player bullet-field)
+  (make <player>
+    #:name 'player
+    #:hitboxes (list graze-hitbox kill-hitbox)
+    #:position (vec2 80.0 24.0)
+    #:bullet-field bullet-field
+    #:polarity 'white))
+
+(define-method (on-boot (player <player>))
+  (attach-to player
+             (make <atlas-sprite>
+               #:name 'ship
+               #:atlas ship-atlas
+               #:index 0
+               #:origin (vec2 12.0 12.0))))
+
+(define (shoot player ox)
+  (let ((speed 8.0)
+        (pos (position player))
+        (bullets (bullet-field player))
+        (y-offset 6.0))
+    (spawn-bullet bullets ikaruga-bullet (polarity player)
+                  (+ (vec2-x pos) ox) (+ (vec2-y pos) y-offset)
+                  0.0 speed)))
+
+(define-method (update (player <player>) dt)
+  ;; Adjust velocity to force player to stay within the bounds of the
+  ;; screen.
+  (let ((p (position player))
+        (v (velocity player)))
+    (cond
+     ((< (+ (vec2-x p) (vec2-x v)) 0.0)
+      (set-vec2-x! v (- (vec2-x p))))
+     ((> (+ (vec2-x p) (vec2-x v)) 160.0)
+      (set-vec2-x! v (- 160.0 (vec2-x p)))))
+    (cond
+     ((< (+ (vec2-y p) (vec2-y v)) 0.0)
+      (set-vec2-y! v (- (vec2-y p))))
+     ((> (+ (vec2-y p) (vec2-y v)) 240.0)
+      (set-vec2-y! v (- 240.0 (vec2-y p))))))
+  ;; Shooting logic
+  (when (shooting? player)
+    (let ((t (shoot-time player)))
+      ;; Fire every n frames
+      (when (and (zero? (modulo t 2))
+                 ;; can't shoot while switching polarity.
+                 (not (eq? (polarity player) 'none)))
+        ;; The first shot is a single shot, everything after is double
+        ;; fire.  This enables players to just tap the fire button to
+        ;; fire off precision shots.
+        (cond
+         ;; single shot
+         ((zero? t)
+          (shoot player 0.0))
+         ;; double shot. give a buffer of 4 frames so players can
+         ;; reliably fire just a single shot.
+         ((> t 4)
+          (shoot player 5.0)
+          (shoot player -5.0))))
+      (set! (shoot-time player) (+ t 1))))
+  (next-method))
+
+(define-method (steer (player <player>) up? down? left? right?)
+  (let ((v (velocity player)))
+    (set-vec2! v (+ (if left? -1.0 0.0) (if right? 1.0 0.0))
+               (+ (if up? 1.0 0.0) (if down? -1.0 0.0)))
+    (vec2-normalize! v)
+    (vec2-mult! v (speed player))))
+
+(define-method (start-shooting (player <player>))
+  (set! (shooting? player) #t)
+  (set! (shoot-time player) 0))
+
+(define-method (stop-shooting (player <player>))
+  (set! (shooting? player) #f))
+
+(define-method (toggle-polarity (player <player>))
+  (let ((old (polarity player)))
+    ;; If polarity is none it means we are already switching so ignore
+    ;; the request.
+    (unless (eq? old 'none)
+      (run-script player
+        ;; There's a brief moment when switching polarity where the
+        ;; player is vulnerable to all bullets.
+        (set! (polarity player) 'none)
+        (sleep 7)
+        (set! (polarity player) (if (eq? old 'white) 'black 'white))
+        ;; Change sprite
+        (set! (index (& player ship)) (if (eq? old 'white) 4 0))))))
+
+(define-method (fire-homing-missiles (player <player>))
+  (let* ((e (energy player))
+         (n (quotient e 10)))
+    (set! (energy player) (- e (* n 10)))
+    ;; TODO: search for nearest enemy and fire missiles
+    #t))
+
+(define-method (increment-energy (player <player>))
+  (set! (energy player) (min (+ (energy player) 1) 120)))
+
+(define-method (kill-maybe (player <player>))
+  (unless (invincible? player)
+    (set! (lives player) (- (lives player) 1))
+    ;; Give player invincibility for a bit while they recover.
+    (run-script player
+      (set! (invincible? player) #t)
+      ;; 3 seconds of blinking
+      (blink 18 5)
+      (set! (invincible? player) #f))))
+
+(define-method (on-collision (player <player>) (other <actor>)
+                             hitbox other-hitbox)
+  (when (eq? hitbox kill-hitbox)
+    (kill-maybe player)))
+
+(define-method (on-collision (player <player>) bullet bullet-polarity hitbox)
+  (cond
+   ;; Absorb bullets of the same polarity.
+   ((and (eq? hitbox graze-hitbox)
+         (eq? bullet-polarity (polarity player)))
+    (increment-energy player)
+    #t)
+   ;; If a bullet makes it to the kill hitbox, lose a life.
+   ((eq? hitbox kill-hitbox)
+    (kill-maybe player)
+    #t)
+   (else #f)))