; Doom in Bel.
;
; A WAD loader, BSP renderer and game loop for Freedoom's E1M1, written in
; Paul Graham's Bel.  Entry points (see docs/protocol.md for the frame protocol):
;
;   (doom-init "wad/e1m1.wad")  load the level, write the palette packet
;   (doom-frame w "wq")         run one tic with the given keys held, write a frame
;
; The engine is written functionally, in the style of bel.bel: no assignment,
; no loops, just recursion and functions over lists.  The whole game is a
; value, the world, threaded through pure functions:
;
;   (doom-init path)     reads the WAD and returns the world
;   (doom-frame w keys)  returns the next world, writing its sounds and frame
;   (step w keys)        the world one tic later
;   (render w)           the frame: a list of columns of palette chars
;
; Only doom-init and doom-frame touch the outside world, reading the WAD and
; writing packets.  Randomness comes from Doom's own table, indexed by a
; number carried in the world.

;;;; Screen

; The screen size is a parameter of doom-init, which builds the screen
; record (see make-screen in render.bel).  These two are only the default
; size, for hosts that don't pass one: Doom's low-detail 160x100, or
; 320x200 after loading doom/hires.bel.
(set screen-w 160
     screen-h 100)

(set near 1)              ; near clipping plane, in map units

(set walk-speed 8         ; map units per tic (Doom runs 35 tics a second); r doubles it
     turn-speed 0.07      ; radians per tic
     view-height 41
     player-radius 16
     max-step 24)

;;;; The engine

(load "doom/math.bel")
(load "doom/wad.bel")
(load "doom/level.bel")
(load "doom/render.bel")
(load "doom/actors.bel")
(load "doom/game.bel")

;;;; The world

(set hud-pictures
     (append '(STBAR STARMS STYSNUM2 STGNUM3 STGNUM4 STGNUM5 STGNUM6 STGNUM7 STTPRCNT STFDEAD0)
             digits
             (apply append (map (fn (i) (map [sym (list \S \T \F \S \T (nchar (+ 48 i)) (nchar (+ 48 _)))]
                                              '(0 1 2)))
                                '(0 1 2 3 4)))))

(def new-world (bytes scr)
  (withs (lumps    (wad-lumps bytes)
          palette  (first 768 (lump 'PLAYPAL lumps))
          rgb      (palette-rgb palette)
          cmaps    (colormap-chars (lump 'COLORMAP lumps))
          textures (load-textures lumps)
          level    (load-level lumps textures)
          sprites  (map car (sprite-lumps lumps))
          lv       (append (list (cons 'palette palette)
                                 (cons 'colormaps cmaps)
                                 (cons 'sky-tables (sky-tables (cdr (get 'SKY1 textures)) (car cmaps) scr))
                                 (cons 'xangles (x-angles scr))
                                 (cons 'pictures (map [cons _ (picture (lump _ lumps))]
                                                      (append sprites hud-pictures)))
                                 (cons 'sprite-frames (sprite-frames sprites))
                                 (cons 'pain-table (tint-table 255 0 0 0.25 rgb))
                                 (cons 'bonus-table (tint-table 215 186 69 0.2 rgb)))
                           level))
    (update-hud
      (reset-player
        (list (cons 'lv lv) (cons 'screen scr) (cons 'tic 0) (cons 'rnd 0)
              (cons 'heights (at 'heights level)) (cons 'movers nil)
              (cons 'mobjs (spawn-things lv)) (cons 'next-id 10000)
              (cons 'used nil) (cons 'sounds nil) (cons 'blasts nil) (cons 'hud nil))))))

; For each sky texture column, its pixels down the view, which only depend
; on the screen row.  Doom puts sky row 100 at the middle of its 168-row
; view, so the row at Doom screen row y is y + 16.
(def sky-tables (sky cm scr)
  (let ((w h cols . rest) (width height view-h half-w half-h focal-x focal-y xmap ymap)) (list sky scr)
    (map (fn (tc)
           (map [nth (nth (+ 1 (mod (+ (nth (+ _ 1) ymap) 16) h)) tc) cm]
                (iota view-h)))
         cols)))

; The angle of each screen column from the view direction.
(def x-angles (scr)
  (let (width height view-h half-w half-h focal-x . rest) scr
    (map [atan (/ (- half-w _ 0.5) focal-x)] (iota width))))

;;;; Entry points: the only side effects

; Read the WAD, write the palette packet, return the world for a screen of
; width x height.
(def doom-init ((o path "wad/e1m1.wad") (o width screen-w) (o height screen-h))
  (let w (new-world (read-bytes path) (make-screen width height))
    (prc \P)
    (pr (map nchar (at 'palette (at 'lv w))))
    w))

; One tic of the game: the next world, after writing that tic's sounds.
(def doom-tick (w (o keys ""))
  (let w2 (step w keys)
    (if (at 'sounds w2)
        (pr (apply append (map [append "S" _ (list (nchar 10))] (rev (at 'sounds w2))))))
    w2))

; Draw the world: write the frame packet and return the world unchanged.
(def doom-draw (w)
  (prc \F)
  (apply pr (render w))
  w)

; Draw only screen columns x0..x1: the F packet holds (x1 - x0 + 1) columns,
; the same bytes as those columns of the whole frame.
(def doom-draw-slice (w x0 x1)
  (prc \F)
  (apply pr (render-slice w x0 x1))
  w)

; A tic and its frame, for hosts that draw every tic.
(def doom-frame (w (o keys ""))
  (doom-draw (doom-tick w keys)))