interim/sledge/tests/gtn.l

(
(def cursor 0)

(def screen-w 80)
(def screen-h 32)

(def screen   (alloc (* screen-w screen-h)))
(def tilemap (alloc (* screen-w screen-h)))
(def solidmap (alloc (* screen-w screen-h)))

(def fill (fn buf from to c (do
  (print (list "fill" (size buf) from to c))
  (let i from)
  (while (lt i (+ to 1)) (do
    (put buf i c)
    (let i (+ i 1))
  ))
)))

(def buf-render (fn b bx by (do
  (let y 0)
  (while (lt y screen-h) (do
    (blit-str (substr b (* y screen-w) screen-w) bx (+ by (* y 16)))
    (let y (+ y 1))
  ))
  0
)))

; symbols ------------------------------------------------------

(def sym-block (get "#" 0))
(def sym-umbrella  (get "m" 0))
(def sym-coffee  (get "c" 0))
(def sym-scissors  (get "x" 0))
(def sym-zigzag  (get "z" 0))
(def sym-dog  (get "D" 0))
(def sym-pot  (get "p" 0))
(def sym-pill  (get "." 0))
(def sym-egg  (get "o" 0))
(def sym-ear  (get "e" 0))
(def sym-rabbit  (get "R" 0))
(def sym-table  (get "T" 0))
(def sym-salad  (get "s" 0))
(def sym-hot  (get "~" 0))
(def sym-fish  (get "<" 0))
(def sym-disc  (get "0" 0))
(def sym-potb  (get "p" 0))
(def sym-person  (get "@" 0))
(def sym-blockb  (get "=" 0))

; structures -----------------------------------------------------------

; rune color solid

(def tiles (list))
(def num-tiles 0)

(def make-tile (fn definition (do
  (let new-tile (cons num-tiles definition))
  (def tiles (cons new-tile tiles))
  (def num-tiles (+ num-tiles 1))
  (print (list "added tile" new-tile))
  new-tile
)))

(def tile-space        (make-tile (list 32 0 0 "space")))
(def tile-wall         (make-tile (list sym-block 12 1 "wall")))
(def tile-asphalt      (make-tile (list (get "." 0) 11 0 "asphalt")))
(def tile-floor-yellow (make-tile (list (get "_" 0) 7 0 "yellow floor")))
(def tile-floor-wood   (make-tile (list (get "_" 0) 8 0 "wooden floor")))
(def tile-floor-woodl  (make-tile (list (get "_" 0) 9 0)))
(def tile-dog          (make-tile (list sym-dog 1 0 "dog")))
(def tile-pot          (make-tile (list sym-pot 1 0 "pot")))
(def tile-pill         (make-tile (list sym-pill 1 0 "pill")))
(def tile-coffee       (make-tile (list sym-coffee 1 0 "coffee")))
(def tile-window       (make-tile (list sym-blockb 12 0 "window")))

(def tile-player       (make-tile (list sym-person 10 1)))

; rat
; pills
; money
; coffee

(def put-tile (fn x y tile (do
  (put tilemap  (+ x (* screen-w y)) (car tile))
  (put screen   (+ x (* screen-w y)) (car (cdr tile)))
  (put solidmap (+ x (* screen-w y)) (car (cdr (cdr (cdr tile)))))
)))

(def is-tile-solid (fn tile (do
  (eq 1 (car (cdr (cdr tile))))
)))

(def get-tile-rune (fn x y (do
  (get screen (+ x (* screen-w y)))
)))

(def get-tile-solid (fn x y (do
  (get solidmap (+ x (* screen-w y)))
)))

(def get-tile (fn x y (do
  (let tile-id (get tilemap (+ x (* screen-w y))))
  (item tiles (- (- num-tiles tile-id) 1))
)))

(def tile-rect (fn x y xx yy tile (do
  (let i y)
  (while (lt y (+ yy 1)) (do
    (put-tile x  y tile)
    (put-tile xx y tile)
    (let y (+ y 1))
  ))

  (let y i)
  (while (lt x (+ xx 1)) (do
    (put-tile x y  tile)
    (put-tile x yy tile)
    (let x (+ x 1))
  ))
)))

(def fill-tile-rect (fn x y xx yy tile (do
  (print (cons "fill-tile-rect" tile))
  (print (list x y xx yy))
  (while (lt y (+ yy 1)) (do
    (let i x)
    (while (lt i (+ xx 1)) (do
      (put-tile i y tile)
      (let i (+ i 1))
    ))
    (let y (+ y 1))
  ))
)))

; game ------------------------------------------------------------------------

(def make-room (fn x y xx yy (do
  (fill-tile-rect (+ x 1) (+ y 1) xx yy tile-floor-yellow)
  (tile-rect      x y xx yy tile-wall)
  (put-tile       (/ (+ x xx) 2) y tile-floor-yellow)
)))

(def state-init 1)
(def state-playing 2)
(def state state-init)
(def screen-size (* screen-w screen-h))

(def actors (quote ()))


(def make-actor (fn tile x y
  (cons tile (cons x (cons y nil)))
))

(def add-actor (fn a (do
  (def actors (cons a actors))
)))

(def actor-tile (fn a (car a)))
(def actor-rune (fn a (car (cdr (actor-tile a)))))
(def actor-color (fn a (car (cdr (cdr (actor-tile a))))))
(def actor-x (fn a (car (cdr a))))
(def actor-y (fn a (car (cdr (cdr a)))))

(def player (make-actor tile-player 13 13))

; keyboard -----------------------------------------------------------

(def move-player (fn nx ny (do
  (if (get-tile-solid nx ny)
    0
    (do
      (def player (make-actor (actor-tile player) nx ny))
      (def actors (quote ()))
      (add-actor player)))
)))

(def player-west (fn (do
  (let nx (- (actor-x player) 1))
  (let ny (actor-y player))
  (move-player nx ny)
)))

(def player-east (fn (do
  (let nx (+ (actor-x player) 1))
  (let ny (actor-y player))
  (move-player nx ny)
)))

(def player-north (fn (do
  (let nx (actor-x player))
  (let ny (- (actor-y player) 1))
  (move-player nx ny)
)))

(def player-south (fn (do
  (let nx (actor-x player))
  (let ny (+ (actor-y player) 1))
  (move-player nx ny)
)))

(def px 0)
(def py 0)
(def player-tile (list))

(def inventory (list))

(def update-player-tile (fn (do
  (def px (actor-x player))
  (def py (actor-y player))
  (def player-tile (get-tile px py))
)))

(def handle-game-key (fn k (do
  (if (eq k 20) (player-east)
      (if (eq k 19) (player-west)
        (if (eq k 17) (player-north)
          (if (eq k 18) (player-south) 0
  ))))
  
  (update-player-tile)

  (if (eq k (get "t" 0)) (do
    ; take item
    (def inventory (cons player-tile inventory))
    (put-tile px py tile-asphalt)
  ) 0)
  
)))

; --------------------------------------------------------------

(def ox 0)
(def oy 0)

(def actors-render (fn ox oy (do
  (let ad actors)
  (let aa (car ad))
  
  (while aa (do
    (blit-char (actor-rune aa) (* 8 (actor-x aa)) (* 16 (actor-y aa)))
    
    (let ad (cdr ad))
    (let aa (car ad))
    0
  ))
)))

(def main (fn
(while 1 (do

  (if (eq state state-init) (do
    ;(fill colormap 0 (- screen-size 1) 0)
    (fill screen 0 (- screen-size 1) 32)
    ;(fill screen 0 (- screen-size 1) sym-block)

    (fill-tile-rect 0 0 screen-w 11 tile-asphalt)

    (make-room 10 10 25 22)
    (put-tile  15 15 tile-dog)
    (put-tile  17 17 tile-pill)
    (put-tile  18 17 tile-coffee)

    (make-room 25 15 38 31)
    (put-tile  27 18 tile-pill)
    (put-tile  27 19 tile-pill)

    (print (cons "state" state))
    (print (cons "screen-size" screen-size))
    (print (cons "sym-block" sym-block))
    
    (def player (make-actor tile-player 13 13))
    (add-actor player)

    (def state state-playing)
  ) 0)

  (let str (recv keyboard))
  (let c (get str 0))
  
  (handle-game-key c)
  (buf-render screen 0 0)
  (actors-render 0 0)

  (p (list px py player-tile inventory) 0 0)

  (send scr 0)
  (gc)
))
))

(main)

)