pxl8/demo/mod/first_person3d.fnl

(local pxl8 (require :pxl8))
(local effects (require :pxl8.effects))
(local net (require :pxl8.net))

(local colormap (require :mod.colormap))
(local menu (require :mod.menu))
(local palette (require :mod.palette))
(local sky (require :mod.sky))
(local textures (require :mod.textures))

(local bob-amount 4.0)
(local bob-speed 8.0)
(local cam-smoothing 0.25)
(local chunk-size 64)
(local cursor-sensitivity 0.010)
(local gravity -800)
(local grid-size 64)
(local ground-y 64)
(local jump-force 175)
(local land-recovery-speed 20)
(local land-squash-amount -4)
(local max-pitch 1.5)
(local move-speed 200)
(local turn-speed 4.0)

(local sim-tick-rate 60)
(local sim-dt (/ 1.0 sim-tick-rate))
(local history-size 128)
(local correction-threshold 1.0)

(var auto-run? false)
(var auto-run-cancel-key nil)
(var bob-time 0)
(var cam-pitch 0)
(var cam-x 416)
(var cam-y 64)
(var cam-yaw 0)
(var cam-z 416)
(var camera nil)
(var ceiling-tex nil)
(var fireball-mesh nil)
(var floor-tex nil)
(var fps-avg 0)
(var fps-sample-count 0)
(var grounded? true)
(var land-squash 0)
(var last-dt 0.016)
(var light-time 0)
(var lights nil)
(var materials-setup false)
(var network nil)
(var real-time 0)
(var smooth-cam-x 416)
(var smooth-cam-z 416)
(var velocity-y 0)
(var wall-tex nil)
(var world nil)

(local cursor-look? true)
(local FIREBALL_COLOR 218)
(local STONE_FLOOR_START 37)
(local STONE_WALL_START 2)
(local MOSS_COLOR 200)

(local trail-positions [])
(local TRAIL_LENGTH 8)

(fn create-fireball-mesh []
  (let [verts []
        indices []
        radius 5
        rings 4
        segments 6
        core-color (+ FIREBALL_COLOR 6)
        spike-color (+ FIREBALL_COLOR 2)]

    ;; top pole
    (table.insert verts {:x 0 :y radius :z 0 :nx 0 :ny 1 :nz 0 :color core-color :light 255})

    ;; sphere rings
    (for [ring 1 (- rings 1)]
      (let [phi (* (/ ring rings) math.pi)
            sin-phi (math.sin phi)
            cos-phi (math.cos phi)
            y (* radius cos-phi)
            ring-radius (* radius sin-phi)]
        (for [seg 0 (- segments 1)]
          (let [theta (* (/ seg segments) math.pi 2)
                x (* ring-radius (math.cos theta))
                z (* ring-radius (math.sin theta))
                nx (* sin-phi (math.cos theta))
                nz (* sin-phi (math.sin theta))]
            (table.insert verts {:x x :y y :z z :nx nx :ny cos-phi :nz nz :color core-color :light 255})))))

    ;; bottom pole
    (let [bottom-idx (length verts)]
      (table.insert verts {:x 0 :y (- radius) :z 0 :nx 0 :ny -1 :nz 0 :color core-color :light 255})

      ;; top cap triangles
      (for [seg 0 (- segments 1)]
        (let [next-seg (% (+ seg 1) segments)]
          (table.insert indices 0)
          (table.insert indices (+ 1 next-seg))
          (table.insert indices (+ 1 seg))))

      ;; middle quads
      (for [ring 0 (- rings 3)]
        (for [seg 0 (- segments 1)]
          (let [next-seg (% (+ seg 1) segments)
                curr-row (+ 1 (* ring segments))
                next-row (+ 1 (* (+ ring 1) segments))]
            (table.insert indices (+ curr-row seg))
            (table.insert indices (+ curr-row next-seg))
            (table.insert indices (+ next-row seg))
            (table.insert indices (+ curr-row next-seg))
            (table.insert indices (+ next-row next-seg))
            (table.insert indices (+ next-row seg)))))

      ;; bottom cap triangles
      (let [last-ring-start (+ 1 (* (- rings 2) segments))]
        (for [seg 0 (- segments 1)]
          (let [next-seg (% (+ seg 1) segments)]
            (table.insert indices bottom-idx)
            (table.insert indices (+ last-ring-start seg))
            (table.insert indices (+ last-ring-start next-seg))))))

    ;; add spikes - evenly distributed using golden ratio
    (let [num-spikes 12
          spike-len 8
          base-size 1.2
          golden-ratio (/ (+ 1 (math.sqrt 5)) 2)]
      (for [i 0 (- num-spikes 1)]
        (let [;; fibonacci sphere distribution
              y (- 1 (* (/ i (- num-spikes 1)) 2))
              r-at-y (math.sqrt (- 1 (* y y)))
              theta (* math.pi 2 i golden-ratio)
              nx (* r-at-y (math.cos theta))
              ny y
              nz (* r-at-y (math.sin theta))
              ;; tangent vectors for base
              tx (if (> (math.abs ny) 0.9) 1 0)
              ty (if (> (math.abs ny) 0.9) 0 1)
              tz 0
              ;; cross product for perpendicular
              px (- (* ty nz) (* tz ny))
              py (- (* tz nx) (* tx nz))
              pz (- (* tx ny) (* ty nx))
              pl (math.sqrt (+ (* px px) (* py py) (* pz pz)))
              px (/ px pl) py (/ py pl) pz (/ pz pl)
              ;; second perpendicular
              qx (- (* ny pz) (* nz py))
              qy (- (* nz px) (* nx pz))
              qz (- (* nx py) (* ny px))
              ;; base center inside sphere
              bx (* radius 0.8 nx)
              by (* radius 0.8 ny)
              bz (* radius 0.8 nz)
              ;; spike tip
              sx (* (+ radius spike-len) nx)
              sy (* (+ radius spike-len) ny)
              sz (* (+ radius spike-len) nz)
              base-idx (length verts)]
          ;; 4 base vertices forming a square
          (table.insert verts {:x (+ bx (* base-size px) (* base-size qx))
                               :y (+ by (* base-size py) (* base-size qy))
                               :z (+ bz (* base-size pz) (* base-size qz))
                               :nx nx :ny ny :nz nz :color core-color :light 255})
          (table.insert verts {:x (+ bx (* base-size px) (* (- base-size) qx))
                               :y (+ by (* base-size py) (* (- base-size) qy))
                               :z (+ bz (* base-size pz) (* (- base-size) qz))
                               :nx nx :ny ny :nz nz :color core-color :light 255})
          (table.insert verts {:x (+ bx (* (- base-size) px) (* (- base-size) qx))
                               :y (+ by (* (- base-size) py) (* (- base-size) qy))
                               :z (+ bz (* (- base-size) pz) (* (- base-size) qz))
                               :nx nx :ny ny :nz nz :color core-color :light 255})
          (table.insert verts {:x (+ bx (* (- base-size) px) (* base-size qx))
                               :y (+ by (* (- base-size) py) (* base-size qy))
                               :z (+ bz (* (- base-size) pz) (* base-size qz))
                               :nx nx :ny ny :nz nz :color core-color :light 255})
          ;; spike tip
          (table.insert verts {:x sx :y sy :z sz :nx nx :ny ny :nz nz :color spike-color :light 255})
          ;; 4 triangular faces of pyramid
          (table.insert indices base-idx)
          (table.insert indices (+ base-idx 1))
          (table.insert indices (+ base-idx 4))
          (table.insert indices (+ base-idx 1))
          (table.insert indices (+ base-idx 2))
          (table.insert indices (+ base-idx 4))
          (table.insert indices (+ base-idx 2))
          (table.insert indices (+ base-idx 3))
          (table.insert indices (+ base-idx 4))
          (table.insert indices (+ base-idx 3))
          (table.insert indices base-idx)
          (table.insert indices (+ base-idx 4)))))

    (set fireball-mesh (pxl8.create_mesh verts indices))))

(var client-tick 0)
(var last-processed-tick 0)
(var time-accumulator 0)
(var position-history {})
(var pending-inputs {})

(fn history-idx [tick]
  (+ 1 (% tick history-size)))

(fn store-position [tick x z yaw]
  (tset position-history (history-idx tick) {:tick tick :x x :z z :yaw yaw}))

(fn get-position [tick]
  (let [entry (. position-history (history-idx tick))]
    (when (and entry (= entry.tick tick))
      entry)))

(fn store-pending-input [tick input]
  (tset pending-inputs (history-idx tick) {:tick tick :input input}))

(fn get-pending-input [tick]
  (let [entry (. pending-inputs (history-idx tick))]
    (when (and entry (= entry.tick tick))
      entry.input)))

(fn apply-movement [x z yaw input]
  (var new-x x)
  (var new-z z)

  (let [move-forward (or input.move_y 0)
        move-right (or input.move_x 0)]
    (when (or (not= move-forward 0) (not= move-right 0))
      (let [forward-x (- (math.sin yaw))
            forward-z (- (math.cos yaw))
            right-x (math.cos yaw)
            right-z (- (math.sin yaw))
            len (math.sqrt (+ (* move-forward move-forward) (* move-right move-right)))
            norm-forward (/ move-forward len)
            norm-right (/ move-right len)
            move-delta (* move-speed sim-dt)]
        (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))))))))

  (values new-x new-z))
(fn init []
  (pxl8.set_relative_mouse_mode true)
  (pxl8.set_palette palette 256)
  (pxl8.set_colormap colormap 16384)
  (for [i 0 7]
    (let [t (/ i 7)
          r 0xFF
          g (math.floor (+ 0x60 (* t (- 0xE0 0x60))))
          b (math.floor (+ 0x10 (* t (- 0x80 0x10))))]
      (pxl8.set_palette_rgb (+ FIREBALL_COLOR i) r g b)))
  (sky.update-gradient 1 2 6 6 10 18)
  (pxl8.update_palette_deps)

  (when (not camera)
    (set camera (pxl8.create_camera_3d)))
  (when (not lights)
    (set lights (pxl8.create_lights)))
  (when (not fireball-mesh)
    (create-fireball-mesh))

  (sky.generate-stars 12345)

  (when (not network)
    (set network (net.get))
    (when network
      (network:spawn cam-x cam-y cam-z cam-yaw cam-pitch)))

  (when (not world)
    (set world (pxl8.get_world)))

  (when (not floor-tex)
    (set floor-tex (textures.mossy-cobblestone 44444 STONE_FLOOR_START MOSS_COLOR)))
  (when (not wall-tex)
    (set wall-tex (textures.ashlar-wall 55555 STONE_WALL_START MOSS_COLOR)))
  (when (not ceiling-tex)
    (set ceiling-tex (pxl8.create_texture [0] 1 1)))

  )

(fn setup-materials []
  (when (and world (not materials-setup))
    (let [chunk (world:active_chunk)]
      (when (and chunk (chunk:ready))
        (let [bsp (chunk:bsp)]
          (when bsp
            (let [floor-mat (pxl8.create_material {:texture floor-tex :lighting true})
                  wall-mat (pxl8.create_material {:texture wall-tex :lighting true})
                  ceiling-mat (pxl8.create_material {:texture ceiling-tex})]

              (bsp:set_material 0 floor-mat)
              (bsp:set_material 1 wall-mat)
              (bsp:set_material 2 ceiling-mat)

              (for [i 0 (- (bsp:face_count) 1)]
                (let [n (bsp:face_normal i)]
                  (bsp:face_set_material i
                    (if (> n.y 0.7) 0
                        (< n.y -0.7) 2
                        1))))
              (set materials-setup true))))))))

(fn sample-input []
  (var move-forward 0)
  (var move-right 0)

  (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 (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)))

  {:move_x move-right
   :move_y move-forward
   :look_dx (pxl8.mouse_dx)
   :look_dy (pxl8.mouse_dy)})

(fn reconcile [server-tick server-x server-z]
  (let [predicted (get-position server-tick)]
    (when predicted
      (let [dx (- predicted.x server-x)
            dz (- predicted.z server-z)
            error (math.sqrt (+ (* dx dx) (* dz dz)))]
        (when (> error correction-threshold)
          (set cam-x server-x)
          (set cam-z server-z)

          (for [t (+ server-tick 1) client-tick]
            (let [input (get-pending-input t)
                  hist (get-position t)]
              (when (and input hist)
                (let [(new-x new-z) (apply-movement cam-x cam-z hist.yaw input)
                      (resolved-x _ resolved-z) (world:resolve_collision cam-x cam-y cam-z new-x cam-y new-z 5)]
                  (set cam-x resolved-x)
                  (set cam-z resolved-z)
                  (store-position t cam-x cam-z hist.yaw))))))))))

(fn update [dt]
  (set last-dt dt)
  (let [fps (pxl8.get_fps)]
    (set fps-sample-count (+ fps-sample-count 1))
    (set fps-avg (+ (* fps-avg (/ (- fps-sample-count 1) fps-sample-count))
                    (/ fps fps-sample-count)))
    (when (>= fps-sample-count 120)
      (set fps-sample-count 0)
      (set fps-avg 0)))

  (setup-materials)

  (let [chunk (world:active_chunk)]
  (when (and chunk (chunk:ready))
    (let [input (sample-input)
          grid-max (* grid-size chunk-size)
          movement-yaw cam-yaw]

      (set time-accumulator (+ time-accumulator dt))

      (while (>= time-accumulator sim-dt)
        (set time-accumulator (- time-accumulator sim-dt))
        (set client-tick (+ client-tick 1))

        (store-pending-input client-tick input)

        (let [(new-x new-z) (apply-movement cam-x cam-z movement-yaw input)]
          (when (and (>= new-x 0) (<= new-x grid-max)
                     (>= new-z 0) (<= new-z grid-max))
            (let [(resolved-x _ resolved-z) (world:resolve_collision cam-x cam-y cam-z new-x cam-y new-z 5)]
              (set cam-x resolved-x)
              (set cam-z resolved-z)))

          (store-position client-tick cam-x cam-z movement-yaw)))

      (when cursor-look?
        (set cam-yaw (- cam-yaw (* input.look_dx cursor-sensitivity)))
        (set cam-pitch (math.max (- max-pitch)
                                 (math.min max-pitch
                                           (- cam-pitch (* input.look_dy cursor-sensitivity))))))

      (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 (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 network
        (let [(ok err) (pcall (fn []
                                (network:send_input {:move_x input.move_x
                                                     :move_y input.move_y
                                                     :look_dx input.look_dx
                                                     :look_dy input.look_dy
                                                     :yaw movement-yaw
                                                     :tick client-tick})
                                (let [snapshot (network:snapshot)]
                                  (when (and snapshot (> snapshot.tick last-processed-tick))
                                    (set last-processed-tick snapshot.tick)
                                    (let [player-id (network:player_id)]
                                      (when (> player-id 0)
                                        (let [curr (network:entity_userdata player-id)]
                                          (when curr
                                            (let [srv-x (pxl8.unpack_f32_be curr 0)
                                                  srv-z (pxl8.unpack_f32_be curr 8)]
                                              (reconcile snapshot.tick srv-x srv-z))))))))))]
          (when (not ok)
            (pxl8.error (.. "Network error: " err)))))

      (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 (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)))))

      (let [moving (or (not= input.move_x 0) (not= input.move_y 0))]
        (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))))))

      (set light-time (+ light-time (* dt 0.5)))
      (set real-time (+ real-time dt))))))

(fn frame []
  (pxl8.clear 1)

  (when (not camera)
    (pxl8.error "camera is nil!"))

  (when (not world)
    (pxl8.error "world is nil!"))

  (let [chunk (when world (world:active_chunk))]
  (when (and world (or (not chunk) (not (chunk:ready))))
    (pxl8.text "Waiting for world data..." 5 30 12))

  (when (and camera world chunk (chunk:ready))
    (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)
          aspect (/ (pxl8.get_width) (pxl8.get_height))]

      (camera:lookat [smooth-cam-x eye-y smooth-cam-z]
                     [target-x target-y target-z]
                     [0 1 0])
      (camera:set_perspective 1.047 aspect 1.0 4096.0)

      (let [light-x (+ 384 (* 50 (math.cos light-time)))
            light-z (+ 324 (* 50 (math.sin light-time)))
            light-y 80
            phase (+ (* light-x 0.01) 1.7)
            f1 (* 0.08 (math.sin (+ (* real-time 2.5) phase)))
            f2 (* 0.05 (math.sin (+ (* real-time 4.1) (* phase 0.7))))
            f3 (* 0.03 (math.sin (+ (* real-time 7.3) (* phase 1.2))))
            flicker (+ 0.92 f1 f2 f3)
            light-intensity (math.floor (math.max 0 (math.min 255 (* 255 flicker))))
            r1 (* 0.06 (math.sin (+ (* real-time 1.8) (* phase 0.5))))
            r2 (* 0.04 (math.sin (+ (* real-time 3.2) phase)))
            light-radius (* 150 (+ 0.95 r1 r2))]
        (lights:clear)
        (lights:add light-x light-y light-z 255 200 150 light-intensity light-radius)
        (pxl8.begin_frame_3d camera lights {
          :ambient 30
          :fog_density 0.0
          :celestial_dir [0.5 -0.8 0.3]
          :celestial_intensity 0.5})
        (pxl8.clear_depth)

        (sky.update-gradient 1 2 6 6 10 18)
        (sky.render smooth-cam-x eye-y smooth-cam-z (menu.is-wireframe))
        (pxl8.clear_depth)

        (when chunk
          (let [bsp (chunk:bsp)]
            (when bsp
              (bsp:set_wireframe (menu.is-wireframe)))))
        (world:render [smooth-cam-x eye-y smooth-cam-z])

        (when fireball-mesh
          (let [wire (menu.is-wireframe)]
            (pxl8.draw_mesh fireball-mesh {:x light-x :y light-y :z light-z
                                            :passthrough true
                                            :wireframe wire
                                            :emissive 1.0})))

        (pxl8.end_frame_3d))

      (sky.render-stars smooth-cam-x eye-y smooth-cam-z 1.0 last-dt)

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

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

{:init init
 :update update
 :frame frame}