diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/game.scm | 82 | ||||
| -rw-r--r-- | src/macroknight/game.hy | 32 | ||||
| -rw-r--r-- | src/tilemap.scm | 193 |
3 files changed, 290 insertions, 17 deletions
diff --git a/src/game.scm b/src/game.scm new file mode 100644 index 0000000..1e9da8b --- /dev/null +++ b/src/game.scm @@ -0,0 +1,82 @@ +(import scheme + (chicken base) + (chicken format) + (chicken process-context) + (chicken condition) + (chicken pretty-print) + (srfi 1) + miscmacros + (prefix sdl2 "sdl2:") + (prefix sdl2-ttf "ttf:") + (prefix sdl2-image "img:") + tilemap) + +(define +color-depth+ 32) +(define +screen-width+ 600) +(define +screen-height+ 400) +(define *fullscreen?* #f) +(define +background-color+ (sdl2:make-color 0 0 0)) +(define +software-mode?+ (member "--software" (command-line-arguments))) +(define +vsync?+ (member "--vsync" (command-line-arguments))) + +(sdl2:set-main-ready!) +(sdl2:init! '(video joystick)) +(ttf:init!) +(img:init! '(png)) + +(on-exit sdl2:quit!) + +;; Install a custom exception handler that will call quit! and then +;; call the original exception handler. This ensures that quit! will +;; be called even if an unhandled exception reaches the top level. +(current-exception-handler + (let ((original-handler (current-exception-handler))) + (lambda (exception) + (sdl2:quit!) + (original-handler exception)))) + +(if (and +vsync?+ (not +software-mode?+)) ; vsync doesn't work with software rendering + (sdl2:set-hint! 'render-vsync "1")) +(define *window* (sdl2:create-window! "MacroKnight" + 'centered 'centered + +screen-width+ +screen-height+ + (if *fullscreen?* '(fullscreen) '()))) +(define *renderer* (sdl2:create-renderer! *window* -1 + (if +software-mode?+ '(software) '(accelerated)))) + +(define *font* (ttf:open-font "DejaVuSans.ttf" 12)) +(define *text-color* (sdl2:make-color 255 255 255)) +(pp (sdl2:num-joysticks)) +(define *joystick* (if (> (sdl2:num-joysticks) 0) + (sdl2:joystick-open! 0) + #f)) +(define *level* (load-tilemap "assets/level-0.tmx")) + +(define (draw-tile target tileset tile-id) + 123) + +(set! (sdl2:render-draw-color *renderer*) +background-color+) +(sdl2:render-clear! *renderer*) + +(let/cc exit-main-loop! + (while #t + (set! (sdl2:render-draw-color *renderer*) +background-color+) + (sdl2:render-clear! *renderer*) + (sdl2:pump-events!) + (while (sdl2:has-events?) + (let ((event (sdl2:make-event))) + (sdl2:poll-event! event) + (pp event) + (when (and (sdl2:keyboard-event? event) + (eq? (sdl2:event-type event) 'key-down) + (eq? (sdl2:keyboard-event-sym event) 'escape)) + (exit-main-loop!)))) + + (sdl2:render-present! *renderer*) + + (sdl2:delay! 10))) + +(sdl2:joystick-close *joystick*) + +(format #t "Bye!\n") + diff --git a/src/macroknight/game.hy b/src/macroknight/game.hy index 8675f81..125768a 100644 --- a/src/macroknight/game.hy +++ b/src/macroknight/game.hy @@ -39,8 +39,6 @@ (load_pygame "assets/level-2.tmx") (load_pygame "assets/level-3.tmx")]) (setv level-id 0) -(setv game-won False) -(setv game-lost False) (defn abs-to-tile-index [abs-id] (int (floor (/ abs-id TILE_SIZE)))) @@ -86,7 +84,7 @@ TILE_SIZE tile-x tile-y))))) - + (setv player-pos (let [player-objects (lfor ent (get level.layers 1) :if (= ent.type "Player") ent)] (if (any player-objects) @@ -94,9 +92,10 @@ #((abs-to-tile-index player-object.x) (abs-to-tile-index player-object.y))) #(5 5)))) - (setv player (Player 1 [(get tileset.tiles 28) - (get tileset.tiles 29)] TILE_SIZE #* player-pos)) + (setv player (Player (len entities) [(get tileset.tiles 28) + (get tileset.tiles 29)] TILE_SIZE #* player-pos)) (.append entities player) + (setv macro-input-mode False) (setv macro-wait-time 0) (setv macro-commands [None None None]) @@ -202,8 +201,17 @@ (setv level-id (+ level-id 1)) (setv running False) (when (>= level-id (len levels)) - (setv game-running False) - (setv game-won True))) + (setv level-id 0) + (.fill screen "#000000") + + (render-text screen + tileset + "YOU WIN" + 15 + 14) + + (pygame.display.flip) + (pygame.time.wait 1000))) (except [PlayerKilled] (setv running False))) @@ -221,16 +229,6 @@ (.tick clock 60))) -(when game-won - (.fill screen "#000000") - - (render-text screen - tileset - "YOU WIN" - 10 - 10) - (pygame.display.flip) - (pygame.time.wait 1000)) (pygame.quit) diff --git a/src/tilemap.scm b/src/tilemap.scm new file mode 100644 index 0000000..e80978e --- /dev/null +++ b/src/tilemap.scm @@ -0,0 +1,193 @@ +(module tilemap +(load-tilemap) +(import scheme + (chicken io) + (chicken base) + (chicken string) + (chicken format) + (chicken process-context) + (chicken pathname) + (chicken pretty-print) + (srfi 1) + expat + defstruct + (prefix sdl2-image "img:")) + +(defstruct tileset + tilewidth + tileheight + spacing + tilecount + columns + image-source + image) + +(defstruct layer + name + width + height + map) + +(defstruct object + name + type + x + y + width + height + properties) + +(defstruct tilemap + width + height + tilewidth + tileheight + tileset-source + tileset + layers + objects) + +(define (maybe-do action) + (lambda (value) + (if (eq? value #f) + #f + (action value)))) + +(define (attempt action) + (lambda (value) + (or (action value) value))) + +(define maybe-string->number (maybe-do (attempt string->number))) + +(define (string-alist->alist string-alist) + (map (lambda (pair) (cons (string->symbol (car pair)) + (maybe-string->number (cdr pair)))) + string-alist)) + +(define (parse-tileset string-tileset) + (let ((parser (expat:make-parser)) + (tags '()) + (tileset (make-tileset 0 0 0 0 0 ""))) + (expat:set-start-handler! parser + (lambda (tag attrs) + (let ((symbol-attrs (string-alist->alist attrs))) + (cond ((string=? tag "tileset") + (set! tileset (alist->tileset symbol-attrs))) + ((string=? tag "image") + (tileset-image-source-set! tileset (alist-ref 'source symbol-attrs))))) + (set! tags (cons tag tags)))) + (expat:set-end-handler! parser (lambda (tag) + (set! tags (cdr tags)))) + (expat:set-character-data-handler! parser (lambda (line) #f)) + (expat:parse parser string-tileset) + tileset)) + +(define (load-tileset file-name) + (call-with-input-file file-name + (lambda (port) + (let* ((tileset (parse-tileset (read-string #f port))) + (image-source (tileset-image-source tileset)) + (base-path (pathname-directory file-name)) + (img-to-load (if (absolute-pathname? image-source) + image-source + (pathname-replace-directory + image-source + (if (pathname-directory image-source) + (format "~a/~a" base-path (pathname-directory image-source)) + base-path))))) + (tileset-image-set! tileset (img:load img-to-load)) + tileset)))) + +(define (parse-tilemap string-tilemap) + (let ((parser (expat:make-parser)) + (tags '()) + (tilemap (make-tilemap 0 0 0 0 '() '() '())) + (layer '())) + (expat:set-start-handler! parser + (lambda (tag attrs) + (let ((symbol-attrs (string-alist->alist attrs))) + (cond ((string=? tag "map") + (tilemap-width-set! tilemap (alist-ref 'width symbol-attrs)) + (tilemap-height-set! tilemap (alist-ref 'height symbol-attrs)) + (tilemap-tilewidth-set! tilemap (alist-ref 'tilewidth symbol-attrs)) + (tilemap-tileheight-set! tilemap (alist-ref 'tileheight symbol-attrs))) + ((string=? tag "tileset") + (tilemap-tileset-source-set! tilemap (alist-ref 'source symbol-attrs))) + ((string=? tag "layer") + (set! layer (alist->layer attrs))) + ((string=? tag "object") + (tilemap-objects-set! tilemap (cons (alist->object symbol-attrs) + (tilemap-objects tilemap))))) + (set! tags (cons tag tags))))) + (expat:set-end-handler! parser (lambda (tag) + (when (string=? tag "layer") + (tilemap-layers-set! tilemap + (cons layer (tilemap-layers tilemap))) + (set! layer '())) + (set! tags (cdr tags)))) + (expat:set-character-data-handler! parser (lambda (line) + (when (string=? (car tags) "data") + (let ((txt (string-chomp line))) + (when (not (string=? txt "")) + (layer-map-set! layer (append + (or (layer-map layer) '()) + (list (map string->number + (string-split txt ",")))))))))) + (expat:parse parser string-tilemap) + tilemap)) + +(define (load-tilemap file-name) + (call-with-input-file file-name + (lambda (port) + (let* ((tilemap (parse-tilemap (read-string #f port))) + (base-path (pathname-directory file-name)) + (tileset-source (tilemap-tileset-source tilemap))) + (tilemap-tileset-set! tilemap (load-tileset + (if (absolute-pathname? tileset-source) + tileset-source + (pathname-replace-directory + tileset-source + (if (pathname-directory tileset-source) + (format "~a/~a" base-path (pathname-directory tileset-source)) + base-path)) + ))) + tilemap)))) + +(when #f + + (let ((txt "<?xml version='1.0' encoding='UTF-8'?> +<tileset version='1.10' tiledversion='1.11.2' name='monochrome_transparent' tilewidth='16' tileheight='16' spacing='1' tilecount='1078' columns='49'> + <image source='monochrome-transparent.png' width='832' height='373'/> +</tileset> +")) + (tileset-image (parse-tileset txt))) + + (let ((txt "<?xml version='1.0' encoding='UTF-8'?> +<map version='1.10' tiledversion='1.11.0' orientation='orthogonal' renderorder='right-down' width='40' height='30' tilewidth='16' tileheight='16' infinite='0' nextlayerid='8' nextobjectid='5'> + <tileset firstgid='1' source='monochrome_transparent.tsx'/> + <layer id='3' name='ground' width='40' height='30'> + <data encoding='csv'> +0,0,0,0,168,169,0,0,0,0, +844,0,0,0,0,0,845,546,546,546, +</data> + </layer> + <objectgroup id='7' name='entities'> + <object id='2' name='player' type='Player' gid='29' x='182' y='350.5' width='16' height='16'/> + <object id='3' name='hint' type='Text' x='98.5' y='432.5' width='197' height='78'> + <properties> + <property name='text' value='hit enter to start a macro'/> + </properties> + </object> + <object id='4' name='goal' type='Goal' x='560.935' y='288.641' width='16' height='16'/> + </objectgroup> +</map> +")) + (tilemap-tileset (parse-tilemap txt))) + + (tileset-image (tilemap-tileset (load-tilemap "assets/level-0.tmx"))) + ) + + + +) ;; End tilemap module + |