pxl8/demo/mod/worldgen.fnl

(local pxl8 (require :pxl8))

(var world nil)

(var auto-run? false)
(var auto-run-cancel-key nil)
(var cam-pitch 0)
(var cam-x 1000)
(var cam-y 64)
(var cam-yaw 0)
(var cam-z 1000)
(var cursor-look? true)

(var smooth-cam-x 1000)
(var smooth-cam-z 1000)
(local cam-smoothing 0.25)

(local bob-amount 4.0)
(local bob-speed 8.0)
(var bob-time 0)
(local cell-size 64)
(local cursor-sensitivity 0.008)
(local gravity -800)
(local grid-size 64)
(var grounded? true)
(local ground-y 64)
(local jump-force 175)
(local land-recovery-speed 20)
(local land-squash-amount -4)
(var land-squash 0)
(local max-pitch 1.5)
(local move-speed 200)
(local turn-speed 2.0)
(var velocity-y 0)

(fn init []
  (set world (pxl8.world_new))
  (let [result (pxl8.world_generate world {
                 :type pxl8.PROCGEN_ROOMS
                 :width 64
                 :height 64
                 :seed 42
                 :min_room_size 5
                 :max_room_size 10
                 :num_rooms 20})]
    (if (< result 0)
        (pxl8.error (.. "Failed to generate rooms - result: " result))
        (let [floor-tex (pxl8.procgen_tex {:name "floor"
                                           :seed 11111
                                           :width 64
                                           :height 64
                                           :base_color 19})
            ceiling-tex (pxl8.procgen_tex {:name "ceiling"
                                           :seed 22222
                                           :width 64
                                           :height 64
                                           :base_color 1})
            wall-tex (pxl8.procgen_tex {:name "wall"
                                        :seed 12345
                                        :width 64
                                        :height 64
                                        :base_color 4})]

        (let [result (pxl8.world_apply_textures world [
                       {:name "floor"
                        :texture_id floor-tex
                        :rule (fn [normal] (> normal.y 0.7))}
                       {:name "ceiling"
                        :texture_id ceiling-tex
                        :rule (fn [normal] (< normal.y -0.7))}
                       {:name "wall"
                        :texture_id wall-tex
                        :rule (fn [normal] (and (<= normal.y 0.7) (>= normal.y -0.7)))}])]
          (when (< result 0)
            (pxl8.error (.. "Failed to apply textures - result: " result))))))))

(fn update [dt]
  (when (pxl8.key_pressed "`")
    (set auto-run? (not auto-run?))
    (when (and auto-run? (pxl8.key_down "w"))
      (set auto-run-cancel-key "w")))
  (when (and auto-run? (not auto-run-cancel-key) (or (pxl8.key_down "w") (pxl8.key_down "s")))
    (set auto-run? false)
    (when (pxl8.key_down "s")
      (set auto-run-cancel-key "s")))
  (when (and auto-run-cancel-key (not (pxl8.key_down auto-run-cancel-key)))
    (set auto-run-cancel-key nil))

  (when (pxl8.world_is_loaded world)
    (let [forward-x (- (math.sin cam-yaw))
          forward-z (- (math.cos cam-yaw))
          right-x (math.cos cam-yaw)
          right-z (- (math.sin cam-yaw))
          grid-max (* grid-size cell-size)
          move-delta (* move-speed dt)]

      (var moving false)
      (var move-forward 0)
      (var move-right 0)

      (when (or (pxl8.key_down "w") auto-run?)
        (set move-forward (+ move-forward 1)))

      (when (and (pxl8.key_down "s") (not= auto-run-cancel-key "s"))
        (set move-forward (- move-forward 1)))

      (when (pxl8.key_down "a")
        (set move-right (- move-right 1)))

      (when (pxl8.key_down "d")
        (set move-right (+ move-right 1)))

      (set moving (or (not= move-forward 0) (not= move-right 0)))

      (var new-x cam-x)
      (var new-z cam-z)

      (when moving
        (let [len (math.sqrt (+ (* move-forward move-forward) (* move-right move-right)))
              norm-forward (/ move-forward len)
              norm-right (/ move-right len)]
          (set new-x (+ new-x (* move-delta (+ (* forward-x norm-forward) (* right-x norm-right)))))
          (set new-z (+ new-z (* move-delta (+ (* forward-z norm-forward) (* right-z norm-right)))))))

      (when (and (>= new-x 0) (<= new-x grid-max)
                 (>= new-z 0) (<= new-z grid-max))
        (let [(resolved-x resolved-y resolved-z) (pxl8.world_resolve_collision world cam-x cam-y cam-z new-x cam-y new-z 5)]
          (set cam-x resolved-x)
          (set cam-z resolved-z)))

      (set smooth-cam-x (+ (* smooth-cam-x (- 1 cam-smoothing)) (* cam-x cam-smoothing)))
      (set smooth-cam-z (+ (* smooth-cam-z (- 1 cam-smoothing)) (* cam-z cam-smoothing)))

      (when cursor-look?
        (let [dx (pxl8.mouse_dx)
              dy (pxl8.mouse_dy)]
          (set cam-yaw (- cam-yaw (* dx cursor-sensitivity)))
          (set cam-pitch (math.max (- max-pitch)
                                   (math.min max-pitch
                                             (- cam-pitch (* dy cursor-sensitivity)))))))

      (when (and (not cursor-look?) (pxl8.key_down "left"))
        (set cam-yaw (+ cam-yaw (* turn-speed dt))))

      (when (and (not cursor-look?) (pxl8.key_down "right"))
        (set cam-yaw (- cam-yaw (* turn-speed dt))))

      (when (and (not cursor-look?) (pxl8.key_down "up"))
        (set cam-pitch (math.min max-pitch (+ cam-pitch (* turn-speed dt)))))

      (when (and (not cursor-look?) (pxl8.key_down "down"))
        (set cam-pitch (math.max (- max-pitch) (- cam-pitch (* turn-speed dt)))))

      (when (and (pxl8.key_pressed "space") grounded?)
        (set velocity-y jump-force)
        (set grounded? false))

      (set velocity-y (+ velocity-y (* gravity dt)))
      (set cam-y (+ cam-y (* velocity-y dt)))

      (when (<= cam-y ground-y)
        (when (not grounded?)
          (set land-squash land-squash-amount))
        (set cam-y ground-y)
        (set velocity-y 0)
        (set grounded? true))

      (when (< land-squash 0)
        (set land-squash (math.min 0 (+ land-squash (* land-recovery-speed dt)))))

      (if (and moving grounded?)
          (set bob-time (+ bob-time (* dt bob-speed)))
          (let [target-phase (* (math.floor (/ bob-time math.pi)) math.pi)]
            (set bob-time (+ (* bob-time 0.8) (* target-phase 0.2))))))))

(fn frame []
  (pxl8.clear 0)

  (when (pxl8.world_is_loaded world)
    (let [bob-offset (* (math.sin bob-time) bob-amount)
          eye-y (+ cam-y bob-offset land-squash)
          forward-x (- (math.sin cam-yaw))
          forward-z (- (math.cos cam-yaw))
          target-x (+ smooth-cam-x forward-x)
          target-y (+ eye-y (math.sin cam-pitch))
          target-z (+ smooth-cam-z forward-z)]

      (pxl8.clear_zbuffer)
      (pxl8.set_backface_culling true)
      (pxl8.set_wireframe false)

      (let [aspect (/ (pxl8.get_width) (pxl8.get_height))
            fov 1.047]
        (pxl8.set_projection (pxl8.mat4_perspective fov aspect 1.0 4096.0)))

      (pxl8.set_view (pxl8.mat4_lookat
                       [smooth-cam-x eye-y smooth-cam-z]
                       [target-x target-y target-z]
                       [0 1 0]))

      (pxl8.set_model (pxl8.mat4_identity))

      (pxl8.world_render world [smooth-cam-x eye-y smooth-cam-z])

      (let [cx (/ (pxl8.get_width) 2)
            cy (/ (pxl8.get_height) 2)
            crosshair-size 4
            red-color 18]
        (pxl8.line (- cx crosshair-size) cy (+ cx crosshair-size) cy red-color)
        (pxl8.line cx (- cy crosshair-size) cx (+ cy crosshair-size) red-color))

      (pxl8.text (.. "fps: " (string.format "%.1f" (pxl8.get_fps))) 5 5 12)
      (pxl8.text (.. "pos: " (string.format "%.0f" cam-x) ","
                     (string.format "%.0f" cam-y) ","
                     (string.format "%.0f" cam-z)) 5 15 12))))

{:init init
 :update update
 :frame frame}