pxl8/demo/mod/worldgen.fnl

(local pxl8 (require :pxl8))

(local bob-amount 4.0)
(local bob-speed 8.0)
(var bob-time 0)
(var cam-x 1000)
(var cam-y 64)
(var cam-z 1000)
(var cam-pitch 0)
(var cam-yaw 0)
(local cell-size 64)
(local gravity -800)
(local grid-size 32)
(var grounded? true)
(local ground-y 64)
(local jump-force 175)
(var land-squash 0)
(local land-squash-amount -4)
(local land-recovery-speed 20)
(local max-pitch 1.5)
(local move-speed 200)
(local turn-speed 2.0)
(var velocity-y 0)
(var world nil)

(fn init []
  (set world (pxl8.world_new))
  (let [result (pxl8.world_generate world {
                 :type pxl8.PROCGEN_CAVE
                 :width 32
                 :height 32
                 :seed 42
                 :density 0.45
                 :iterations 4})]
    (if (< result 0)
        (pxl8.error (.. "Failed to generate cave - 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})]

        (pxl8.upload_atlas)

        (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.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 (pxl8.key_down "w")
        (set move-forward (+ move-forward 1)))

      (when (pxl8.key_down "s")
        (set move-forward (- move-forward 1)))

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

      (when (pxl8.key_down "e")
        (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))
        (set cam-x new-x)
        (set cam-z new-z))

      (when (or (pxl8.key_down "left") (pxl8.key_down "a"))
        (set cam-yaw (+ cam-yaw (* turn-speed dt))))

      (when (or (pxl8.key_down "right") (pxl8.key_down "d"))
        (set cam-yaw (- cam-yaw (* turn-speed dt))))

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

      (when (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 (+ cam-x forward-x)
          target-y (+ eye-y (math.sin cam-pitch))
          target-z (+ 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
                       [cam-x eye-y cam-z]
                       [target-x target-y target-z]
                       [0 1 0]))

      (pxl8.set_model (pxl8.mat4_identity))

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

      (pxl8.text (.. "Pos: " (string.format "%.0f" cam-x) ","
                     (string.format "%.0f" cam-y) ","
                     (string.format "%.0f" cam-z)) 10 25 12)
      (pxl8.text (.. "FPS: " (string.format "%.1f" (pxl8.get_fps))) 10 40 12))))

{:init init
 :update update
 :frame frame}