Created
January 5, 2012 20:38
-
-
Save gpadd/1567171 to your computer and use it in GitHub Desktop.
Lame unfinished game
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;;;;;; | |
;;;;;;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)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment