Lame unfinished game

game.scm

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;
;;;;;;add's contribution
;;;;;;
;;;;;;
;;;;;;
;;;;;;
;;;;;;

(use-modules ((sdl sdl) #:renamer (symbol-prefix-proc '///-))
             ((sdl gfx) #:renamer (symbol-prefix-proc '/G/-))
             ((sdl misc-utils) #:renamer (symbol-prefix-proc '/M/-))
             ((sdl simple) #:renamer (symbol-prefix-proc '/S/-))
             ((sdl mixer) #:renamer (symbol-prefix-proc '/A/-))
             (ice-9 rdelim)
             (srfi srfi-9)
             (rnrs io ports))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Global
(define MAP_WIDTH 40)
(define MAP_HEIGHT 40)

(define TILE_SIZE 16)

(define WWIDTH 640)
(define WHEIGHT 480)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CAnimation

;; Private
(define animation-current-frame 0)
(define animation-frame-inc 0)
(define animation-frame-rate 0)
(define animation-old-time 0)
;; Public
(define animation-max-frames 0)
(define animation-oscillate #f)

(define (animation-set-current-frame frame)
  ;; TBH I don't see the point of
  ;; using this if..
  (if (not (or (< frame 0)
               (> frame animation-max-frames)))
      (set! animation-current-frame frame)
      #f))

(define (animation-set-frame-rate rate)
  (set! animation-frame-rate rate))

(define (animation-get-current-frame)
  animation-current-frame)


(define (animation-set-running-on-off true-or-false)
  (if (equal? true-or-false #t)
      (set! animation-running? #t)
      (if (equal? true-or-false #f)
          (set! animation-running? #f)
          #f)))

(define (animation-set-frame-inc inc)
  (set! animation-frame-inc inc))

(define (animation-set-old-time o-time)
  (set! animation-old-time o-time))

(define (animation-set-max-frames new-max-frames)
  (set! animation-max-frames new-max-frames))

(define (animation-set-oscillator-on-off true-or-false)
  (if (equal? true-or-false #t)
      (set! animation-oscillate #t)
      (if (equal? true-or-false #f)
          (set! animation-oscillate #f)
          #f)))

(define (animation-get-max-frames)
  animation-max-frames)

(define (animation-get-frame-inc)
  animation-frame-inc)

(define (animation-get-frame-rate)
  animation-frame-rate)

(define (animation-get-old-time)
  animation-old-time)

(define (animation-oscillate?)
  (if (equal? animation-oscillate #t)
      #t
      #f))

(define (animation-running?)
  (if (equal? animation-running? #t)
      #t
      #f))

(define (animation-animation)
  (animation-set-current-frame 0)
  (animation-set-max-frames 8)
  (animation-set-frame-inc 1)
  (animation-set-frame-rate 1)
  (animation-set-old-time 0)
  (animation-set-oscillator-on-off #f))

(define (animation-on-animate)
  (if (not (> (+ animation-old-time animation-frame-rate) (///-get-ticks)))
      (begin
	(animation-set-old-time (///-get-ticks))
	(if (animation-oscillate?)
	    (if (> (animation-get-frame-inc) 0)
		(if (>= (animation-get-current-frame) (- (animation-get-max-frames) 1))
		    (animation-set-frame-inc (- (animation-get-frame-inc))))
		(if (<= (animation-get-current-frame) 0)
		    (animation-set-frame-inc (- (animation-get-frame-inc)))))
	    (if (>= (animation-get-current-frame) (- (animation-get-max-frames) 1))
		(animation-set-current-frame 1)))
        (animation-set-current-frame (+ (animation-get-current-frame) (animation-get-frame-inc))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CTile

(define TILE_TYPE_NONE 0)
(define TILE_TYPE_NORMAL 1)
(define TILE_TYPE_BLOCK 2)

;; Public
(define-record-type ctile-type
  (make-ctile tile-id type-id)
  ctile?
  (tile-id get-ctile-tile-id set-ctile-tile-id)
  (type-id get-ctile-type-id set-ctile-type-id))

(define tile (make-ctile 0 TILE_TYPE_NONE))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Surface
(define dest-r 0)
(define src-r 0)

(define (surface-on-load file)
  (define surf-return (///-load-image file))
  surf-return)

(define surface-on-draw
  (case-lambda ((surf-dest surf-src x y)
           (if (not (or (equal? surf-dest 0)
                        (equal? surf-src 0)))
               (begin
                 (set! dest-r (///-make-rect 0 0 0 0))
                 (///-rect:set-x! dest-r x)
                 (///-rect:set-y! dest-r y)
                 (///-blit-surface surf-src #f surf-dest dest-r)
                 surf-src)))
          ((surf-dest surf-src x y x2 y2 w h)
           (if (not (or (equal? surf-dest 0)
                        (equal? surf-src 0)))
               (begin
                 (set! dest-r (///-make-rect 0 0 0 0))
                 (set! src-r (///-make-rect 0 0 0 0))
                 (///-rect:set-x! dest-r x)
                 (///-rect:set-y! dest-r y)
                 (///-rect:set-x! src-r x2)
                 (///-rect:set-y! src-r y2)
                 (///-rect:set-w! src-r w)
                 (///-rect:set-h! src-r h)
                 (///-blit-surface surf-src src-r surf-dest dest-r)
                 surf-src)))))

(define (surface-transparent surf-dest r g b)
  (if (not (equal? surf-dest #t))
       (begin
         (///-set-color-key! surf-dest '(SDL_SRCCOLORKEY SDL_RLEACCEL) (///-map-rgb (///-surface-get-format surf-dest) r g b))
         #t)
      #f))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Player


(define-record-type player-type
  (make-player x
               y
               on-load
               on-loop
               on-render
               on-clean-up
               on-animate
               on-collision)
  player?
  (x get-player-x set-player-x)
  (y get-player-y set-player-y)
  (entity-on-load get-player-entity-on-load set-player-entity-on-load)
  (entity-on-loop get-player-entity-on-loop set-player-entity-on-loop)
  (entity-on-render get-player-entity-on-render set-player-entity-on-render)
  (entity-on-clean-up get-player-entity-on-clean-up set-player-entity-on-clean-up)
  (entity-on-animate get-player-entity-on-animate set-player-entity-on-animate)
  (entity-on-collision get-player-entity-collision set-player-entity-on-collision))

(define (player-on-load file width height max-frames)
  (if (not (equal? (entity-on-load file width height max-frames) #f))
      #t
      #f))

(define (player-on-loop)
  (entity-on-loop))

(define (player-on-render surf-display)
  (entity-on-render surf-display))

(define (player-on-clean-up)
  (entity-on-clean-up))

(define (player-on-animate)
  (if (not (equal? entity-speed-x 0))
      (set! animation-max-frames 8)
      (set! animation-max-frames 0))
  (entity-on-animate))

(define (player-on-collision entity)
  (entity-jump)
  #t)

(define (player-player1 file width height max-frames surf-display entity)
  (make-player 0
               0
               (player-on-load file width height max-frames)
               (player-on-loop)
               (player-on-render surf-display)
               (player-on-clean-up)
               (player-on-animate)
               (player-on-collision entity)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CMap

;; Public
(define cmap-surf-tileset #f)
;; Private

(define (cmap)
  (set! cmap-surf-tileset #f))

(define (cmap-on-load file)
  (let stuff ((file-handle "")
              (temp-tile ""))
    (set! cmap-tile-list '())
    (open-file file "r")
    (if (not (equal? file-handle #f))
        (begin
          (do ((y 0 (+ y 1)))
              ((< y '(MAP_HEIGHT)))
            (do ((x 0 (+ x 1)))
                ((< x '(MAP_WIDTH)))
              (read-line file-handle)
              (set! cmap-tile-list temp-tile))
            (read-line file-handle))
          #t))))

(define (cmap-on-render surf-display map-x map-y)
  (let stuff ((tileset-width 0)
              (tileset-height 0)
              (id 0)
              (tx 0)
              (ty 0)
              (tileset-x 0)
              (tileset-y 0))
    (if (not (equal? surf-tileset #f))
        (begin (set! tileset-width (/ (///-surface:w surf-tileset) '(TILE_SIZE)))
               (set! tileset-height (/ (///-surface:h surf-tileset) '(TILE_SIZE)))
               
               (set! id 0)

               (do ((y 0 (+ y 1)))
                   ((< y MAP_HEIGHT))
                 (do ((x 0 (+ x 1)))
                     ((< x MAP_WIDTH))
                   (if (equal? (vector-ref cmap-tile-list id) '(TILE_TYPE_NONE)) ;; TileList[ID].TypeID
                       (set! id (+ id 1)))

                   (set! tx (+ map-x (* x TILE_SIZE)))
                   (set! ty (+ map-y (* y TILE_SIZE)))

                   (set! tileset-x (* (modulo (vector-ref cmap-tile-list id) tileset-width) TILE_SIZE)) ;; TileList[ID].TileID

                   (set! tileset-y (* (/ (vector-ref cmap-tile-list id) tileset-width) TILE_SIZE)) ;; TileList[ID].TileID

                   (surface-on-draw surf-display cmap-surf-tileset tx ty tileset-x tileset-y TILE_SIZE TILE_SIZE)

                   (set! id (+ id 1))))))))

(define (cmap-get-tile x y)
  (let stuff ((id 0))
    (set! id 0)
    (set! id (/ x '(TILE_SIZE)))
    (set! id (+ id (* 'MAP_WIDTH (/ y '(TILE_SIZE)))))
    (if (or (not (< id 0))
            (not (>= id (vector-length (cmap-tile-list)))))
        (record-accessor cmap-tile-list id)
        #f)))

(define tile-list '())
(define-record-type cmap-type
  (make-cmap-t cmap-surf-tileset
               tile-list
               cmap
               cmap-on-load
               cmap-on-render
               cmap-get-tile)
  cmap-t?
  (cmap-surf-tileset get-cmap-t-cmap-surf-tileset set-cmap-t-cmap-tileset)
  (tile-list get-cmap-t-tile-list set-cmap-t-tile-list)
  (cmap get-cmap-t-cmap set-cmap-t-cmap)
  (cmap-on-load get-cmap-t-on-load set-cmap-t-on-load)
  (cmap-on-render get-cmap-t-on-render set-cmap-t-on-render)
  (cmap-get-tile get-cmap-t-cmap-get-tile))

(define cmap-tile-list
  (make-cmap-t cmap-surf-tileset
               tile-list
               cmap
               cmap-on-load
               cmap-on-render
               cmap-get-tile))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utils
(define-syntax dotimes
  (syntax-rules ()
    ((dotimes count body ...)
     (let loop ((counter count))
       (if (> counter 0)
           (begin
             body ...
             (loop (- counter 1))))))))

(define loop-through-type
  (case-lambda ((type0)
           (let loop ((i 0)
                      (type1 type0))
             (if (not (equal? type1 '()))
                 (begin (display type1)
                        (display i)
                        (newline)
                        (loop (+ i 1) (cdr type1)))
                 (values i type1))))
          ((type0 stop-at)
           (let loop ((i 0)
                     (type1 type0))
            (if (not (or (equal? type1 '())
                         (>= i (- stop-at 1))))
                (begin (display type1)
                       (display i)
                       (newline)
                       (loop (+ i 1) (cdr type1)))
                (values i type1))))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; FPS
;; Public
(define fps-control 0)
;; Private
(define fps-old-time 0)
(define fps-last-time 0)
(define fps-speed-factor 0)
(define fps-num-frames 0)
(define fps-frames 0)

(define (fps)
  (set! fps-old-time 0)
  (set! fps-last-time 0)

  (set! fps-speed-factor 0)

  (set! fps-frames 0)
  (set! fps-num-frames 0))

(define (fps-on-loop)
  (if (< (+ fps-old-time 1000) (///-get-ticks))
      (begin
        (set! fps-old-time (///-get-ticks))

        (set! fps-num-frames fps-frames)

        (set! fps-frames 0)))
  (set! fps-speed-factor (* (/ (- (///-get-ticks) fps-last-time) 1000.0) 32.0))
  
  (set! fps-last-time (///-get-ticks))

  (set! fps-frames (+ fps-frames 1)))

(define (fps-get-FPS)
  fps-num-frames)
(define (fps-get-speed-factor)
  fps-speed-factor)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Event
(define (on-event event)
  (if (///-event:type event)
      (case (///-event:type event)
        ((SDL_ACTIVEEVENT)
         (case (///-event:active:state event)
           ((SDL_APPMOUSEFOCUS)
            (if (///-event:active:gain event)
                (on-mouse-focus)
                (on-mouse-blur)))
           ((SDL_APPINPUTFOCUS)
            (if (///-event:active:gain event)
                (on-input-focus)
                (on-input-blur)))
           ((SDL_APPACTIVE)
            (if (///-event:active:gain event)
                (on-restore)
                (on-minimize)))))
        ((SDL_KEYDOWN)
         (on-key-down
          (///-event:key:keysym:sym event)
          (///-event:key:keysym:mod event)
          (///-event:key:keysym:unicode event)))
        ((SDL_KEYUP)
         (on-key-up
          (///-event:key:keysym:sym event)
          (///-event:key:keysym:mod event)
          (///-event:key:keysym:unicode event)))
        ((SDL_MOUSEMOTION)
         (on-mouse-move
          (///-event:motion:x event)
          (///-event:motion:y event)
          (///-event:motion:xrel event)
          (///-event:motion:yrel event)
          (not (equal? (///-event:motion:state event)
                       '(SDL_BUTTON SDL_BUTTON_RIGHT)
                       0))
          (not (equal? (///-event:motion:state event)
                       '(SDL_BUTTON SDL_BUTTON_MIDDLE)
                       0))
          (not (equal? (///-event:motion:state event)
                       '(SDL_BUTTON SDL_BUTTON_LEFT)
                       0))))
        ((SDL_MOUSEBUTTONDOWN)
         (case (///-event:button:button event)
           ((SDL_BUTTON_LEFT)
            (on-lbutton-down
             (///-event:button:x event)
             (///-event:button:y event)))
           ((SDL_BUTTON_RIGHT)
            (on-rbutton-down
             (///-event:button:x event)
             (///-event:button:y event)))
           ((SDL_BUTTON_MIDDLE)
            (on-mbutton-down
             (///-event:button:x event)
             (///-event:button:y event)))))
        ((SDL_MOUSEBUTTONUP)
         (case (///-event:button:button event)
           ((SDL_BUTTON_LEFT)
            (on-lbutton-up
             (///-event:button:x event)
             (///-event:button:y event)))
           ((SDL_BUTTON_RIGHT)
            (on-rbutton-up
             (///-event:button:x event)
             (///-event:button:y event)))
           ((SDL_BUTTON_MIDDLE)
            (on-mbutton-up
             (///-event:button:x event)
             (///-event:button:y event)))))
        ((SDL_JOYAXISMOTION)
         (on-joy-axis
          (///-event:jaxis:which event)
          (///-event:jaxis:axis event)
          (///-event:jaxis:value event)))
        ((SDL_JOYBALLMOTION)
         (on-joy-ball
          (///-event:jball:which event)
          (///-event:jball:ball event)
          (///-event:jball:xrel event)
          (///-event:jball:yrel event)))
        ((SDL_JOYHATMOTION)
         (on-joy-hat
          (///-event:jhat:which event)
          (///-event:jhat:hat event)
          (///-event:jhat:value event)))
        ((SDL_JOYBUTTONDOWN)
         (on-joy-button-down
          (///-event:jbutton:which event)
          (///-event:jbutton:button event)))
        ((SDL_JOYBUTTONUP)
         (on-joy-button-up
          (///-event:jbutton:which event)
          (///-event:jbutton:button event)))
        ((SDL_QUIT)
         (on-exit))
        ((SDL_SYSWMEVENT)
         '())
        ((SDL_VIDEORESIZE)
         (on-resize
          (///-event:resize:w event)
          (///-event:resize:h event)))
        ((SDL_VIDEOEXPOSE)
         (on-expose)))))


(define (on-input-focus) #f)

(define (on-input-blur) #f)

(define (on-key-down sym mod unicode) #f)

(define (on-key-up sym mod unicode) #f)

(define (on-mouse-focus) #f)

(define (on-mouse-blur) #f)

(define (on-mouse-move mx my rel-x rel-y left right middle) #f)

(define (on-mouse-wheel up down) #f)

(define (on-lbutton-down mx my) #f)

(define (on-lbutton-up mx my) #f)

(define (on-rbutton-down mx my) #f)

(define (on-rbutton-up mx my) #f)

(define (on-mbutton-down mx my) #f)

(define (on-mbutton-up mx my) #f)

(define (on-joy-axis which axis vaule) #f)

(define (on-joy-button-down which button) #f)

(define (on-joy-button-up which button) #f)

(define (on-joy-hat which hat value) #f)

(define (on-joy-ball which ball x-rel y-rel) #f)

(define (on-minimize) #f)

(define (on-restore) #f)

(define (on-resize w h) #f)

(define (on-expose) #f)

(define (on-exit) #f)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entity


(define ENTITY_TYPE_GENERIC 0)
(define ENTITY_TYPE_PLAYER 1)

(define ENTITY_FLAG_NONE 0)
(define ENTITY_FLAG_GRAVITY 1)
(define ENTITY_FLAG_GHOST 2)
(define ENTITY_FLAG_MAPONLY 4)


;; Public


;; Protected
(define eanim-control #t)
(define esurf-entity #f)
;; Public
(define entity-x 0.0)
(define entity-y 0.0)

(define entity-width 0)
(define entity-height 0)

(define entity-move-left #f)
(define entity-move-right #f)

(define entity-type 0)
(define entity-dead #f)
(define entity-eflags 0)
;; Protected
(define entity-speed-x 0.0)
(define entity-speed-y 0.0)
(define entity-accel-x 0.0)
(define entity-accel-y 0.0)
(define entity-can-jump #f)
;; Public
(define entity-max-speed-x 10)
(define entity-max-speed-y 10)
;; Protected
(define entity-current-frame-col 0)
(define entity-current-frame-row 0)

(define entity-col-x 0)
(define entity-col-y 0)
(define entity-col-width 0)
(define entity-col-height 0)

(define (entity)
  (set! esurf-entity #f)
  (set! entity-x 0)
  (set! entity-y 0)
  (set! entity-width 0)
  (set! entity-height 0)
  (set! entity-move-left #f)
  (set! entity-move-right #f)
  (set! entity-type ENTITY_TYPE_GENERIC)
  (set! entity-dead #f)
  (set! entity-eflags ENTITY_FLAG_GRAVITY)
  (set! entity-speed-x 0.0)
  (set! entity-speed-y 0.0)
  (set! entity-accel-x 0.0)
  (set! entity-accel-y 0.0)
  (set! entity-can-jump #f)
  (set! entity-max-speed-x 10)
  (set! entity-max-speed-y 10)
  (set! entity-current-frame-col 0)
  (set! entity-col-x 0)
  (set! entity-col-y 0)
  (set! entity-col-width 0)
  (set! entity-col-height 0))

(define (entity-on-load file width height max-frames)
  (if (not (equal? (set! (esurf-entity) (surface-on-load file))#f))
      (begin
        (surface-transparent esurf-entity 255 0 255)
        (set! animation-max-frames max-frames)
        #t)
      #f))

(define (entity-on-loop)
  (if (and (equal? entity-move-left #f)
           (equal? entity-move-right #f))
      (entity-stop-move))
  (cond ((entity-move-left)
         (set! entity-accel-x (- 0.5)))
        ((entity-move-right) (set! entity-accel-x 0.5)))
  (if (logand entity-eflags ENTITY_FLAG_GRAVITY)
      (entity-accel-y 0.75))
  (set! entity-speed-x (+ entity-speed-x (* entity-accel-x (fps-get-speed-factor))))
  (set! entity-speed-y (+ entity-speed-y (* entity-accel-y (fps-get-speed-factor))))
  (if (> entity-speed-x entity-max-speed-x)
      (set! entity-speed-x entity-max-speed-x))
  (if (> entity-speed-x (- entity-max-speed-x))
      (set! entity-speed-x (- entity-max-speed-x)))
  (if (> entity-speed-y entity-max-speed-y)
      (set! entity-speed-y entity-max-speed-y))
  (if (> entity-speed-y entity-max-speed-y)
      (set! entity-speed-y (- entity-max-speed-y)))
  (entity-on-animate)
(entity-on-move entity-speed-x entity-speed-y))
  
(define (entity-on-render surf-display)
  (if (not (or (equal? esurf-entity #f)
               (equal? surf-display #f)))
      (surface-on-draw surf-display esurf-entity (- entity-x (camera-get-x)) (- entity-y (camera-get-y)) (* entity-current-frame-col entity-width) (+ entity-current-frame-row (* (+ animation-get-current-frame) entity-height)) entity-width entity-height)))

(define (entity-on-clean-up)
  (set! esurf-entity #f))

(define (entity-on-animate)
  (cond ((entity-move-left)
         (set! entity-current-frame-col 0))
        ((entity-move-right)
         (set! entity-current-frame-col 1)))
  (animation-on-animate))

(define (entity-on-collision entity1 entity2)
  #t)


(define (entity-on-move move-x move-y)
  (let* ((blahblah #t))
      (if (not (and (equal? move-x 0)
                (equal? move-y 0)))
      (let stuff ((new-x 0)
                  (new-y 0))
        (set! entity-can-jump #f)
        (set! move-x (* move-x (fps-get-speed-factor)))
        (set! move-y (* move-y (fps-get-speed-factor)))
        (if (not (equal? move-x))
            (cond ((>= move-x 0)
                   (set! new-x (fps-get-speed-factor)))
                  (else
                   (set! new-x (- (fps-get-speed-factor))))))
        (if (not (equal? move-y 0))
            (cond ((>= move-y 0)
                   (set! new-y (fps-get-speed-factor)))
                  (else
                   (set! new-y (- (fps-get-speed-factor))))))
        (while (blahblah)
          (cond ((logand entity-eflags ENTITY_FLAG_GHOST)
                 (entity-pos-valid (+ entity-x new-x) (+ entity-y new-y))
                 (set! entity-x (+ entity-x new-x))
                 (set! entity-y (+ entity-y new-y)))
                ((if (entity-pos-valid (+ entity-x new-x) entity-y)
                     (set! entity-x (+ entity-x new-x))
                     (set! entity-speed-x 0)))
                ((if (entity-pos-valid entity-x (+ entity-y new-y))
                     (set! entity-y (+ entity-y new-y))
                      (begin
                        (if (> move-y 0)
                            (set! entity-can-jump #t))
                        (set! entity-speed-y 0)))))
          (set! move-x (+ move-x (- new-x)))
          (set! move-y (+ move-y (- new-y)))

          (if (and (> new-x 0)
                   (<= move-x 0))
              (set! new-x 0))
          (if (and (< new-x 0)
                   (>= move-x 0))
              (set! new-x 0))

          (if (and (> new-y 0)
                   (<= move-y 0))
              (set! new-x 0))
          (if (and (< new-y 0)
                   (>= move-y 0))
              (set! new-x 0))

          (if (equal? move-x 0)
              (set! new-x 0))
          (if (equal? move-y 0)
              (set! new-y 0))
          (if (and (equal? move-x 0)
                   (equal? move-y 0))
              (set! blahblah #f))
          (if (and (equal? new-x 0)
                   (equal? new-y 0))
              (set! blahblah #f)))))))

(define (entity-jump)
  (if (not (equal? (entity-can-jump) #f))
      (begin
        (set! entity-speed-y (- entity-max-speed-y))
        #t)
      #f))

(define (entity-stop-move)
  (if (> entity-speed-x 0)
      (set! entity-accel-x (- 1)))
  (if (< entity-speed-x 0)
      (set! entity-accel-x 1))
  (if (and (< entity-speed-x 2.0)
           (> entity-speed-x (- 2.0)))
      (begin
        (set! entity-accel-x 0)
        (set! entity-speed-x 0))))

(define (entity-collides ox oy ow oh)
  (let stuff ((left1 0)
              (left2 0)
              (right1 0)
              (right2 0)
              (top1 0)
              (top2 0)
              (bottom1 0)
              (bottom2 0)
              (tx (+ entity-x entity-col-x))
              (ty (+ entity-y entity-col-y)))
    (set! left1 tx)
    (set! left2 ox)
    
    (set! right1 (- (- (+ left1 entity-width) 1) entity-col-width))
    (set! right2 (- (+ ox ow) 1))

    (set! top1 ty)
    (set! top2 oy)
    
    (set! bottom1 (- (- (+ top1 entity-height) 1) entity-col-height))
    (set! bottom2 (- (+ oy oh) 1))
    (cond ((< bottom1 top2)
           #f)
          ((> top1 bottom2)
           #f)
          ((< right1 left2)
           #f)
          ((> left1 right2)
           #f)
          (else
           #t))))

(define (entity-pos-valid new-x new-y)
  (let* ((returns #t)
              (start-x (/ (+ new-x entity-col-x) TILE_SIZE))
              (start-y (/ (+ new-y entity-col-y) TILE_SIZE))
              (end-x (/ (- (- (+ (+ new-x entity-col-x) entity-width) 1) entity-col-width) TILE_SIZE))
              (end-y (/ (- (- (+ (+ new-y entity-col-y) entity-height) 1) entity-col-height) TILE_SIZE)))
    (do ((iy start-y (+ iy 1)))
        ((<= iy end-y))
      (do ((ix start-y (+ ix 1)))
          ((<= ix end-x))
        (let* ((tile (area-get-tile (* ix TILE_SIZE) (* iy TILE_SIZE))))
          (if (equal? (entity-pos-valid-tile tile) #f)
              (set! returns #f)))))
    (if (logand entity-eflags '(ENTITY_FLAG_MAPONLY))
        #f
        (do ((i 0 (+ i 1)))
            ((< i (vector-length entity-list)))
          (if (equal? (entity-pos-valid-entity (entity-list i) new-x new-y) #f)
              (set! returns #f))))
    returns))

(define (entity-pos-valid-tile tile)
  (if (not(equal? tile #f))
      (if (equal? ctile? TILE_TYPE_BLOCK)
          #f
          #t)
      #t))



(define (entity-pos-valid-entity entity new-x new-y)
  (let* ((this-e entity)
         (this-x new-x)
         (this-y new-y))
    (if (and (not (equal? this-e entity))
             (not (equal? entity #f))
             (equal? (entity-dead entity) #f)
             (expt (entity-eflags entity) ENTITY_FLAG_MAPONLY)
             (equal? (entity-collides (+ new-x entity-col-x) (+ new-y entity-col-y) (- (- entity-width entity-col-width) 1) (- (- entity-height entity-col-height) 1)) #t))
        (begin
          (set! entity-a this-e)
          (set! entity-b entity)
          (entity-col-list (entity-col) entity-col-list)
          #f)
        #t)))

(define-record-type entity-type
  (make-entity eanim-control
                esurf-entity
                entity-x
                entity-y
                entity-width
                entity-height
                entity-move-left
                entity-move-right
                entity-type
                entity-dead
                entity-eflags
                entity-speed-x
                entity-speed-y
                entity-accel-x
                entity-accel-y
                entity-can-jump
                entity-max-speed-x
                entity-max-speed-y
                entity-current-frame-col
                entity-current-frame-row
                entity-col-x
                entity-col-y
                entity-col-width
                entity-col-height
                entity-on-load
                entity-on-loop
                entity-on-render
                entity-on-clean-up
                entity-on-animate
                entity-on-collision
                entity-on-move
                entity-jump
                entity-stop-move
                entity-collides
                entity-pos-valid
                entity-pos-valid-tile
                entity-pos-valid-entity)
  entity? 
  (eanim-control get-entity-eanim-control set-entity-eanim-control)
  (esurf-entity get-entity-esurf-entity set-entity-esurf-entity)
  (x get-entity-entity-x set-entity-entity-x)
  (y get-entity-entity-y set-entity-entity-y)
  (width get-entity-entity-width set-entity-entity-width)
  (height get-entity-entity-height set-entity-entity-height)
  (move-left get-entity-entity-move-left set-entity-entity-move-left)
  (move-right get-entity-entity-move-right set-entity-entity-move-right)
  (type get-entity-entity-type set-entity-entity-type)
  (dead get-entity-entity-dead set-entity-entity-dead)
  (eflags get-entity-entity-eflags set-entity-entity-eflags)
  (speed-x get-entity-entity-speed-x set-entity-entity-speed-x)
  (speed-y get-entity-entity-speed-y set-entity-entity-speed-y)
  (accel-x get-entity-entity-accel-x set-entity-entity-accel-x)
  (accel-y get-entity-entity-accel-y set-entity-entity-accel-y)
  (can-jump get-entity-entity-entity-can-jump set-entity-entity-can-jump)
  (max-speed-x get-entity-entity-max-speed-x set-entity-entity-max-speed-x)
  (max-speed-y get-entity-entity-max-speed-y set-entity-entity-max-speed-y)
  (current-frame-col get-entity-entity-current-frame-col set-entity-entity-current-frame-col)
  (current-frame-row get-entity-entity-current-frame-row set-entity-entity-current-frame-row)
  (col-x get-entity-entity-col-x set-entity-entity-col-x)
  (col-y get-entity-entity-col-y set-entity-entity-col-y)
  (col-width get-entity-entity-col-width set-entity-entity-col-width)
  (col-height get-entity-entity-col-height set-entity-entity-col-height)
  (on-load get-entity-entity-on-load set-entity-entity-on-load)
  (on-loop get-entity-entity-on-loop set-entity-entity-on-loop)
  (on-render get-entity-entity-on-render set-entity-entity-on-render)
  (on-clean-up get-entity-entity-on-clean-up set-entity-entity-on-clean-up)
  (on-animate get-entity-entity-on-animate set-entity-entity-on-animate)
  (on-collision get-entity-entity-on-collision set-entity-entity-on-collision)
  (on-move get-entity-entity-on-move set-entity-entity-on-move)
  (jump get-entity-entity-jump set-entity-entity-jump)
  (stop-move get-entity-entity-stop-move set-entity-entity-stop-move)
  (collides get-entity-entity-collides set-entity-entity-collides)
  (pos-valid get-entity-entity-pos-valid set-entity-entity-pos-valid)
  (pos-valid-tile get-entity-entity-pos-valid-tile set-entity-entity-pos-valid-tile)
  (pos-valid-entity get-entity-entity-pos-valid-entity set-entity-entity-pos-valid-entity))

(define entity-list
  (make-entity eanim-control
               esurf-entity
               entity-x
               entity-y
               entity-width
               entity-height
               entity-move-left
               entity-move-right
               entity-type
               entity-dead
               entity-eflags
               entity-speed-x
               entity-speed-y
               entity-accel-x
               entity-accel-y
               entity-can-jump
               entity-max-speed-x
               entity-max-speed-y
               entity-current-frame-col
               entity-current-frame-row
               entity-col-x
               entity-col-y
               entity-col-width
               entity-col-height
               entity-on-load
               entity-on-loop
               entity-on-render
               entity-on-clean-up
               entity-on-animate
               entity-on-collision
               entity-on-move
               entity-jump
               entity-stop-move
               entity-collides
               entity-pos-valid
               entity-pos-valid-tile
               entity-pos-valid-entity))

(define entity-a 0)
(define entity-b 0)

(define (entity-col)
  (set! entity-a #f) ;;TODO
  (set! entity-b #f))

(define-record-type entity-col-type
  (make-entity-col entity-a
                   entity-b)
  entity-col?
  (entity-a get-entity-col-entity-a set-entity-col-entity-a)
  (entity-b get-entity-col-entity-b set-entity-col-entity-b))

(define entity-col-list (make-entity-col #f #f))
(define entity-col-list-length 2)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Camera

(define TARGET_MODE_NORMAL 0)
(define TARGET_MODE_CENTER 0)


(define camera-x 0)
(define camera-y 0)

(define camera-target-x 0.0)
(define camera-target-y 0.0)

(define camera-target-mode 0)

(define (camera)
  (let* ((y 0)
         (x y)
         (target-y #f)
         (target-x target-y)
         (target-mode 0))
    (set! target-mode TARGET_MODE_NORMAL)))

(define (camera-on-move move-x move-y)
  (set! camera-x (+ camera-x move-x))
  (set! camera-y (+ camera-y move-y)))

(define (camera-get-x)
  (if (not (equal? camera-target-x #f))
      (if (equal? camera-target-mode TARGET_MODE_CENTER)
          (begin
            (inexact->exact (- camera-target-x (/ WWIDTH 2)))))
      (inexact->exact camera-target-x)))

(define (camera-get-y)
  (if (not (equal? camera-target-y #f))
      (if (equal? camera-target-mode TARGET_MODE_CENTER)
          (inexact->exact (- camera-target-y (/ WWIDTH 2))))
      (inexact->exact camera-target-y)))

(define (camera-set-pos x y)
  (let stuff ((this-x x)
              (this-y y))
    this-x
    this-y))

(define (camera-set-target x y)
  (set! camera-target-x x)
  (set! camera-target-y y))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Audio

(define audio-track 0)

(define (open-audio-stuff)
  (/A/-open-audio))

(define (close-audio-stuff)
  (/A/-close-audio))

(define (pause-audio-stuff)
  (/A/-pause-music))

(define (resume-audio-stuff)
  (/A/-resume-music))

(define (load-audio-file file)
  (set! audio-track (/A/-load-music file)))

(define (load-dummy)
  (set! audio-track (/A/-load-music "../sounds/bd_ttr5.xm")))

(define (play-audio)
  (/A/-play-music audio-track))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CArea

(define area-control 0)

(define area-size 0)

(define surf-tileset 0)

(define list-sizes 6)

(define-record-type cmap-list-type
  (make-cmap surf-tileset
             tiled-list
             the-cmap
             area-on-load
             area-on-render
             area-get-tile)
  cmap?
  (surf-tileset get-cmap-surf-tileset set-cmap-surf-tileset)
  (tiled-list get-cmap-tiled-list set-cmap-tiled-list)
  (the-cmap get-cmap-the-cmap set-cmap-the-cmap)
  (on-load get-cmap-area-on-load set-cmap-area-on-load)
  (on-render get-cmap-area-on-render set-cmap-area-on-render)
  (area-get-tile get-cmap-area-get-tile set-cmap-area-get-tile))

(define tiled-list (make-ctile 0 TILE_TYPE_NONE))

(define (area-on-load file)
  (let* ((file-handle (open-file file "r"))
         (tileset 0)
         (map-file ""))
    (define tileset-file (get-string-n file-handle 255))
    (if (equal? (set! surf-tileset (surface-on-load tileset-file)) #f)
        (close file-handle)
        #f)
    (get-string-n file-handle 255)
    (do ((x 0 (+ x 1)))
        ((< x area-size))
      (do ((y 0 (+ y 1)))
          ((< y area-size))
        (get-string-n file-handle 255)
        (if (equal? (area-on-load map-file) #f)
            '()
            #f)
        (set-cmap-surf-tileset temp-map (get-cmap-surf-tileset temp-map))
        (set! cmap-list (list cmap-list temp-map))) ;; push_back
      (get-string-n file-handle 255))
    (close-port file-handle)
    (close-port map-file)
    #t))

(define (area-on-render surf-display camera-x camera-y)
  (define map-width (* MAP_WIDTH TILE_SIZE))
  (define map-height (* MAP_HEIGHT TILE_SIZE))
  (define first-id (/ (- camera-x) map-width))
  (set! first-id (+ first-id (* (/ (- camera-y) map-height) area-size)))
  (do ((i 0 (+ i 1)))
      ((< i 4))
    (let* ((id (+ first-id (+ (* (/ i 2) area-size) (modulo i 2))))
           (x (+ (* (modulo id area-size) map-width) camera-x))
           (y (+ (* (/ id area-size) map-height) camera-y)))
      (if (or (< id 0)
              (>= id list-sizes))
          (set! (get-cmap-area-on-render) (area-on-render surf-display x y))))))

(define (area-on-clean-up)
  (set! cmap-list #f))


(define (area-get-map x y)
  (let* ((map-width (* MAP_WIDTH TILE_SIZE))
         (map-height (* MAP_HEIGHT TILE_SIZE))
         (id (/ x map-width)))
    (set! id (+ id (* (/ y map-height) area-size)))
    (if (not (or (< id 0)
                 (>= id list-sizes))) ;; size
        (loop-through-type cmap-list id)
        #f)))
(define (area-get-tile x y)
  (let size-stuff ((map-width (* MAP_WIDTH TILE_SIZE))
                   (map-height (* MAP_HEIGHT TILE_SIZE))
                   (area-map (area-get-map x y)))
    (if (not (equal? area-map #f))
        (begin
          (set! x (modulo x map-width))
          (set! y (modulo y map-height))
          (area-get-tile x y))
        #f)))

(define cmap-list (make-cmap surf-tileset
                             tiled-list
                             cmap
                             area-on-load
                             area-on-render
                             area-get-tile))

(define temp-map (make-cmap surf-tileset
                            tiled-list
                            cmap
                            area-on-load
                            area-on-render
                            area-get-tile))

;; Capp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define app-surf-test 0)
(define app-surf-bg 0)
(define app-surf-display (///-set-video-mode WWIDTH WHEIGHT 32 '(SDL_HWSURFACE SDL_DOUBLEBUF)))
(define app-on-render
  (case-lambda
    (()
     (let* ((rect (///-make-rect (- (camera-get-x)) (- (camera-get-y)) 0 0))
            (width WWIDTH)
            (height WHEIGHT))
       (animation-on-animate)
       (///-rect:set-x! rect 0)
       (///-rect:set-y! rect 0)
       (///-rect:set-w! rect width)
       (///-rect:set-h! rect height)
       (///-fill-rect app-surf-display rect 0)
       (area-on-render app-surf-display (- (camera-get-x)) (- (camera-get-y)))
       (do ((i 0 (+ i 1)))
           ((< i 37))
         (if (not (entity-list i))
             #t)
         (set! (entity-list i) app-surf-display))
       ;;(surface-on-draw app-surf-display app-surf-test 280 155 0 (* (animation-get-current-frame) 64) 64 64)
       (///-flip app-surf-display)))
    ((x y)
     (let* ((rect (///-make-rect (apply (- (camera-get-x))) (- (camera-get-y)) 0 0))
            (width WWIDTH)
            (height WHEIGHT))
       (animation-on-animate)
       (///-rect:set-x! rect 0)
       (///-rect:set-y! rect 0)
       (///-rect:set-w! rect width)
       (///-rect:set-h! rect height)
       (///-fill-rect app-surf-display (- (camera-get-x)) (- (camera-get-y)))
       (do ((i 0 (+ i 1)))
           ((< i 37))
         (if (not (entity-list i))
             #t)
         (set! (entity-list i) app-surf-display))
       ;;(surface-on-draw app-surf-display app-surf-test x y 0 (* (animation-get-current-frame) 64) 64 64)
       (///-flip app-surf-display)))

    ((x y x2 y2 w h)
     (let* ((rect (///-make-rect (- (camera-get-x)) (- (camera-get-y)) 0 0))
            (width WWIDTH)
            (height WHEIGHT))
       (animation-on-animate)
       (///-rect:set-x! rect 0)
       (///-rect:set-y! rect 0)
       (///-rect:set-w! rect width)
       (///-rect:set-h! rect height)
       (///-fill-rect app-surf-display (- (camera-get-x)) (- (camera-get-y)))
       (do ((i 0 (+ i 1)))
           ((< i 37))
         (if (not (entity-list i))
             #t)
         (set! (entity-list i) app-surf-display))
       (surface-on-draw app-surf-display app-surf-bg 0 0 0 0 640 400)
       (surface-on-draw app-surf-display app-surf-test x y x2 y2 w h)
       (///-flip app-surf-display)))))


(define app-ent-list-len 37)

(define (app-on-loop)
  (do ((i 0 (+ i 1)))
      ((< i app-ent-list-len)) ;; This (vector-length entity-list)
    (if (not (entity-list i))
        #t
        (set! (entity-list i) (entity-on-loop))))
  (do ((i 0 (+ i 1)))
      ((< i entity-col-list-length)) ;; This (vector-length entity-entity-col-list)
    (set! entity-a (entity-col-list i))
    (set! entity-b (entity-col-list i))
    (if (or (equal? entity-a #f)
            (equal? entity-b #f))
        (if (entity-on-collision entity-a entity-b)
            (entity-on-collision entity-b entity-a))))
  (set! entity-col-list '())
  (fps-on-loop)
  (///-set-caption "Hello everyone!" "Hello everyone!"))

(define app-area1 0)

(define (player1 file width height max-frames surf-display entity)
  (make-player 0
                      0
                      (player-on-load file width height max-frames)
                      (player-on-loop)
                      (player-on-render surf-display)
                      (player-on-clean-up)
                      (player-on-animate)
                      (player-on-collision entity)))

(define (app-on-init)
  (and (= (///-init '(SDL_INIT_EVERYTHING)) 0)
       (if (not (equal? (set! app-surf-display (///-set-video-mode WWIDTH WHEIGHT 32 '(SDL_HWSURFACE SDL_DOUBLEBUF))) #f))
           (begin
             (set! app-area1 (area-on-load "1.area"))
             (///-enable-key-repeat 1 '(SDL_DEFAULT_REPEAT_INTERVAL))
             (set! player1 (player-on-load "yoshi.png" 64 64 8))
             (set! entity-list (player1 "yoshi.png" 64 64 8 app-surf-display #f))
             (set! camera-target-mode TARGET_MODE_CENTER)
             (camera-set-target (get-player-x player1) (get-player-y player1))))))

(define (app-on-key-down sym mod unicode)
  (cond ((sym '(SDLK_LEFT))
         (set! entity-move-left #t))
        ((sym '(SDLK_RIGHT))
         (set! entity-move-right #t))
        ((sym '(SDLK_SPACE))
         (entity-jump))
        (#t)))

(define (app-on-key-up sym mod unicode)
  (cond ((sym '(SDLK_LEFT))
         (set! entity-move-left #f))
        ((sym '(SDLK_RIGHT))
         (set! entity-move-right #f))
        (#t)))


(define app-on-clean-up
  (case-lambda (()
           (area-on-clean-up)
           (do ((i 0 (+ i 1)))
               ((< i 37))
             (if (equal? (entity-list i) #f)
                 (app-on-clean-up (entity-list i))))
           (///-quit))
          ((what)
           (area-on-clean-up)
           (do ((i 0 (+ i 1)))
               ((< i 37))
             (if (equal? (entity-list i) #f)
                 (app-on-clean-up (entity-list i))))
           (///-quit))))

;; Private
(define app-running? #t)
(define app-player1 0)

;; -.-
(define (capp)
  (set! app-surf-display #f)
  (set! app-running? #t))


(define app-banana #f)
(define app-event1 #f)
(define (app-on-execute)
  (if (not (equal? app-running? #f))
      (begin
        (app-on-init)
        (set! app-banana (///-make-event))
        (set! app-event1 (on-event app-banana))
        (animation-set-running-on-off #t)
        (if (not (equal? (///-init '(SDL_INIT_EVERYTHING)) #f))
            (begin        
              (while animation-running?
                (while (///-poll-event app-banana)
                  (on-event app-banana))
                (app-on-loop)
                (app-on-render))
              (app-on-clean-up)
              #f)))
      #f))