diff options
| -rw-r--r-- | Makefile | 28 | ||||
| -rw-r--r-- | src/game.scm | 31 | ||||
| -rw-r--r-- | src/input.scm | 192 | ||||
| -rw-r--r-- | src/macroknight/entities.hy | 182 | ||||
| -rw-r--r-- | src/macroknight/game.hy | 234 | ||||
| -rw-r--r-- | src/macroknight/systems.hy | 71 | ||||
| -rw-r--r-- | src/macroknight/text.hy | 23 | ||||
| -rw-r--r-- | src/macroknight/tiles.hy | 53 | ||||
| -rw-r--r-- | src/macroknight/utils.hy | 66 | ||||
| -rw-r--r-- | src/tilemap.scm | 2 |
10 files changed, 231 insertions, 651 deletions
@@ -1,19 +1,29 @@ .DEFAULT_GOAL := bin/game -bin: - @mkdir -p $@ - -bin/tilemap.o: src/tilemap.scm | bin - csc -c -J src/tilemap.scm -unit tilemap -o $@ +# Get all .scm modules (excluding game.scm) +MODULE_FILES := $(wildcard src/*.scm) +MODULE_FILES := $(filter-out src/game.scm, $(MODULE_FILES)) +MODULE_NAMES := $(patsubst src/%.scm,%,$(MODULE_FILES)) +OBJECT_FILES := $(patsubst %,bin/%.o,$(MODULE_NAMES)) -bin/game.o: src/game.scm | bin - csc -c src/game.scm -uses tilemap -o $@ +# Main target - compile game.o with -uses flags, then link all .o files +bin/game: bin/game.o $(OBJECT_FILES) + csc bin/game.o $(OBJECT_FILES) -o bin/game -bin/game: bin/tilemap.o bin/game.o | bin - csc -o bin/game bin/tilemap.o bin/game.o +# Compile game.scm to game.o (declare that it uses the modules) +bin/game.o: src/game.scm $(OBJECT_FILES) | bin + csc -c src/game.scm -o bin/game.o -I bin $(patsubst %,-uses %,$(MODULE_NAMES)) +bin: + @mkdir -p $@ +# Pattern rule: compile each module as a library unit (unique C toplevel name) +# so linking multiple .o files doesn't cause "multiple definition of C_toplevel". +bin/%.o bin/%.import.scm: src/%.scm | bin + csc -c -J -unit $* src/$*.scm -o bin/$*.o + mv $*.import.scm bin/ .PHONY: clean clean: rm -rf bin rm -f *.import.scm game + rm -f *.so diff --git a/src/game.scm b/src/game.scm index c4e1356..d22263b 100644 --- a/src/game.scm +++ b/src/game.scm @@ -12,7 +12,8 @@ (prefix sdl2-image "img:") matchable tilemap - defstruct) + defstruct + input) (define +color-depth+ 32) (define +screen-width+ 600) @@ -60,6 +61,7 @@ #f)) (define *level* (load-tilemap "assets/level-0.tmx")) (define *level-tileset-texture* (sdl2:create-texture-from-surface *renderer* (tileset-image (tilemap-tileset *level*)))) +(define *input* (create-input-state)) (define (draw-tile renderer tileset tile-id row-num col-num) (let ((tile (tileset-tile tileset tile-id))) @@ -154,22 +156,29 @@ (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 (sdl2:keyboard-event? event) - (keymap-process-input! event (sdl2:event-type event)) - ;; (exit-main-loop!) - ))) + ;; Collect this frame's events (input-state-update! expects a list) + (let ((events-this-frame + (let collect ((lst '())) + (if (not (sdl2:has-events?)) + (reverse lst) + (let ((e (sdl2:make-event))) + (sdl2:poll-event! e) + (collect (cons e lst))))))) + (input-state-update! *input* events-this-frame) + ;; Check for escape to exit + (for-each (lambda (event) + (when (and (sdl2:keyboard-event? event) + (eq? (sdl2:event-type event) 'key-down) + (eq? (sdl2:keyboard-event-sym event) 'escape)) + (exit-main-loop!))) + events-this-frame)) (draw-tilemap *renderer* *level*) - (draw-objects *renderer* *level*) (sdl2:render-present! *renderer*) (sdl2:delay! 10))) -(sdl2:joystick-close *joystick*) +(when *joystick* (sdl2:joystick-close *joystick*)) (format #t "Bye!\n") diff --git a/src/input.scm b/src/input.scm new file mode 100644 index 0000000..f48518b --- /dev/null +++ b/src/input.scm @@ -0,0 +1,192 @@ +(module input + (create-input-state + input-state-update! + input-pressed? + input-held? + input-released? + input-any-pressed?) + +(import scheme + (chicken base) + (chicken module) + (only srfi-1 any) + (prefix sdl2 sdl2:)) + +;; Input state record - tracks current and previous frame state +(define-record input-state + up down left right a b start select + prev-up prev-down prev-left prev-right prev-a prev-b prev-start prev-select) + +;; Create a new input state with all buttons released +(define (create-input-state) + (make-input-state #f #f #f #f #f #f #f #f + #f #f #f #f #f #f #f #f)) + +;; Button name to keyboard scancode mapping +(define *keyboard-map* + '((up . w) + (down . s) + (left . a) + (right . d) + (a . j) + (b . k) + (start . return) + (select . backspace))) + +;; Button name to gamepad button mapping +(define *gamepad-button-map* + '((a . 0) ; Button 0 (typically A/Cross) + (b . 1) ; Button 1 (typically B/Circle) + (start . 9) ; Button 9 (Start) + (select . 8))) ; Button 8 (Select) + +;; Update input state based on SDL2 events +;; This should be called once per frame AFTER processing events +;; Pass the event list from your game loop +(define (input-state-update! state events) + ;; Save previous frame state + (input-state-prev-up-set! state (input-state-up state)) + (input-state-prev-down-set! state (input-state-down state)) + (input-state-prev-left-set! state (input-state-left state)) + (input-state-prev-right-set! state (input-state-right state)) + (input-state-prev-a-set! state (input-state-a state)) + (input-state-prev-b-set! state (input-state-b state)) + (input-state-prev-start-set! state (input-state-start state)) + (input-state-prev-select-set! state (input-state-select state)) + + ;; Process events to update current state + (for-each + (lambda (event) + (let ((type (sdl2:event-type event))) + (cond + ;; Keyboard events + ((eq? type 'key-down) + (let ((key (sdl2:keyboard-event-sym event))) + (cond + ((eq? key 'w) (input-state-up-set! state #t)) + ((eq? key 's) (input-state-down-set! state #t)) + ((eq? key 'a) (input-state-left-set! state #t)) + ((eq? key 'd) (input-state-right-set! state #t)) + ((eq? key 'j) (input-state-a-set! state #t)) + ((eq? key 'k) (input-state-b-set! state #t)) + ((eq? key 'return) (input-state-start-set! state #t)) + ((eq? key 'backspace) (input-state-select-set! state #t))))) + + ((eq? type 'key-up) + (let ((key (sdl2:keyboard-event-sym event))) + (cond + ((eq? key 'w) (input-state-up-set! state #f)) + ((eq? key 's) (input-state-down-set! state #f)) + ((eq? key 'a) (input-state-left-set! state #f)) + ((eq? key 'd) (input-state-right-set! state #f)) + ((eq? key 'j) (input-state-a-set! state #f)) + ((eq? key 'k) (input-state-b-set! state #f)) + ((eq? key 'return) (input-state-start-set! state #f)) + ((eq? key 'backspace) (input-state-select-set! state #f))))) + + ;; Joystick button events + ((eq? type 'joy-button-down) + (let ((button (sdl2:joy-button-event-button event))) + (cond + ((= button 0) (input-state-a-set! state #t)) + ((= button 1) (input-state-b-set! state #t)) + ((= button 8) (input-state-select-set! state #t)) + ((= button 9) (input-state-start-set! state #t))))) + + ((eq? type 'joy-button-up) + (let ((button (sdl2:joy-button-event-button event))) + (cond + ((= button 0) (input-state-a-set! state #f)) + ((= button 1) (input-state-b-set! state #f)) + ((= button 8) (input-state-select-set! state #f)) + ((= button 9) (input-state-start-set! state #f))))) + + ;; Joystick hat (d-pad) events + ((eq? type 'joy-hat-motion) + (let ((value (sdl2:joy-hat-event-value event))) + (input-state-up-set! state (or (= value 1) (= value 9) (= value 5))) ; UP, LEFT-UP, RIGHT-UP + (input-state-down-set! state (or (= value 4) (= value 6) (= value 10))) ; DOWN, LEFT-DOWN, RIGHT-DOWN + (input-state-left-set! state (or (= value 8) (= value 9) (= value 6))) ; LEFT, LEFT-UP, LEFT-DOWN + (input-state-right-set! state (or (= value 2) (= value 5) (= value 10))))) ; RIGHT, RIGHT-UP, RIGHT-DOWN + + ;; Joystick axis (analog stick as d-pad) + ((eq? type 'joy-axis-motion) + (let ((axis (sdl2:joy-axis-event-axis event)) + (value (sdl2:joy-axis-event-value event))) + (cond + ((= axis 0) ; X-axis + (input-state-left-set! state (< value -8000)) + (input-state-right-set! state (> value 8000))) + ((= axis 1) ; Y-axis + (input-state-up-set! state (< value -8000)) + (input-state-down-set! state (> value 8000))))))))) + events)) + +;; Check if a button was just pressed this frame +(define (input-pressed? state button) + (let ((current (case button + ((up) (input-state-up state)) + ((down) (input-state-down state)) + ((left) (input-state-left state)) + ((right) (input-state-right state)) + ((a) (input-state-a state)) + ((b) (input-state-b state)) + ((start) (input-state-start state)) + ((select) (input-state-select state)) + (else #f))) + (previous (case button + ((up) (input-state-prev-up state)) + ((down) (input-state-prev-down state)) + ((left) (input-state-prev-left state)) + ((right) (input-state-prev-right state)) + ((a) (input-state-prev-a state)) + ((b) (input-state-prev-b state)) + ((start) (input-state-prev-start state)) + ((select) (input-state-prev-select state)) + (else #f)))) + (and current (not previous)))) + +;; Check if a button is currently held down +(define (input-held? state button) + (case button + ((up) (input-state-up state)) + ((down) (input-state-down state)) + ((left) (input-state-left state)) + ((right) (input-state-right state)) + ((a) (input-state-a state)) + ((b) (input-state-b state)) + ((start) (input-state-start state)) + ((select) (input-state-select state)) + (else #f))) + +;; Check if a button was just released this frame +(define (input-released? state button) + (let ((current (case button + ((up) (input-state-up state)) + ((down) (input-state-down state)) + ((left) (input-state-left state)) + ((right) (input-state-right state)) + ((a) (input-state-a state)) + ((b) (input-state-b state)) + ((start) (input-state-start state)) + ((select) (input-state-select state)) + (else #f))) + (previous (case button + ((up) (input-state-prev-up state)) + ((down) (input-state-prev-down state)) + ((left) (input-state-prev-left state)) + ((right) (input-state-prev-right state)) + ((a) (input-state-prev-a state)) + ((b) (input-state-prev-b state)) + ((start) (input-state-prev-start state)) + ((select) (input-state-prev-select state)) + (else #f)))) + (and (not current) previous))) + +;; Check if any button was pressed this frame +(define (input-any-pressed? state) + (any (lambda (button) + (input-pressed? state button)) + '(up down left right a b start select))) + +) ; end module diff --git a/src/macroknight/entities.hy b/src/macroknight/entities.hy deleted file mode 100644 index b171069..0000000 --- a/src/macroknight/entities.hy +++ /dev/null @@ -1,182 +0,0 @@ -;;; Copyright (C) 2025 Gene Pasquet -;;; -;;; This program is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -(require hyrule [case]) -(import pygame.sprite [Sprite] - pygame [Surface] - pygame - utils [neg merge-moves Direction] - enum [Enum]) - -(defclass PlayerKilled [Exception]) - -(defclass Entity [Sprite] -;;; Game entity - (setv _fixed False) - (setv _type "none") - - (defn __init__ [self id tile tile-size x y] - (.__init__ (super)) - (setv self.id id) - (setv self.tile-size tile-size) - (setv self._surf (Surface #(tile-size tile-size))) - (.blit self._surf tile #(0 0)) - (setv self._rect (.get_rect self._surf - :left (* x tile-size) - :top (* y tile-size)))) - - (defn [property] fixed [self] - self._fixed) - - (defn [property] rect [self] - self._rect) - - (defn [property] surf [self] - self._surf) - - (defn [property] type [self] - self._type) - - (defn [property] pos [self] - #((/ self.rect.x self.tile-size) - (/ self.rect.y self.tile-size)))) - -(defclass LevelTile [Entity] - (setv _fixed True) - (setv _type "level") - - (defn __init__ [self id tile tile-size x y scaling] - (let [tile-width (* (.get_width tile) scaling) - tile-height (* (.get_height tile) scaling) - tile_ (if (!= scaling 1) - (pygame.transform.scale tile #(tile-width tile-height)) - tile)] - (.__init__ (super) id tile_ tile-size x y)))) - -(defclass Goal [Entity] - (setv _type "goal") - (setv _fixed True)) - -(defclass Player [Entity] - (setv _type "player") - (setv SPEED 3) - (setv JUMP_IMPULSE 10) - (setv MAX_JUMPING 100) - - (defn __init__ [self id tiles tile-size x y] - (.__init__ (super) id (get tiles 0) tile-size x y) - (setv self.tiles tiles) - (setv self.jumping False) - (setv self.jump-move 0) - (setv self.moves []) - (setv self._disp_surf (.copy self._surf)) - (setv self.facing Direction.RIGHT) - (setv self.attacking False) - (setv self.animate-end 0)) - - (defn move [self move] - (.append self.moves move) - (.move_ip self._rect (get move 0) (get move 1)) - (when (!= (get move 0) 0) - (setv self.facing - (.x-from-move Direction move)))) - - (defn [property] total-move [self] - (merge-moves self.moves)) - - (defn attack [self] - (setv self.attacking True)) - - (defn jump [self] - (setv self.jumping True) - (when (< self.jump-move self.MAX_JUMPING) - (setv self.jump-move (+ self.jump-move self.JUMP_IMPULSE)) - (.move self #(0 (neg self.JUMP_IMPULSE))))) - - (defn ground [self] - (setv self.jump-move 0)) - - (defn animate [self ticks] - ;; Attack animation - (when (and self.attacking (= self.animate-end 0)) - (setv self.animate-end (+ ticks 200)) - (.blit self._surf (get self.tiles 1) #(0 0))) - (when (and self.attacking (> ticks self.animate-end)) - (setv self.animate-end 0) - (setv self.attacking False) - (.blit self._surf (get self.tiles 0) #(0 0))) - - ;; Facing direction - (setv self._disp_surf - (case self.facing - Direction.LEFT (pygame.transform.flip self._surf True False) - Direction.RIGHT (.copy self._surf))) - - (.flush self)) - - (defn flush [self] - (setv self.moves [])) - - (defn [property] surf [self] - self._disp_surf)) - -(defclass Enemy [Entity] - (setv _type "enemy") - - (defn __init__ [self id tiles tile-size x y] - (.__init__ (super) id (get tiles 0) tile-size x y) - (setv self.tiles tiles) - (setv self.facing Direction.RIGHT) - (setv self.attacking False) - (setv self.animate-end 0) - (.flush self)) - - (defn move [self move] - (.append self.moves move) - (.move_ip self._rect (get move 0) (get move 1)) - (when (!= (get move 0) 0) - (setv self.facing - (.x-from-move Direction move)))) - - (defn attack [self] - (setv self.attacking True)) - - (defn flush [self] - (setv self.moves [])) - - (defn ground [self]) - - (defn animate [self ticks] - ;; Attack animation - (when (and self.attacking (= self.animate-end 0)) - (setv self.animate-end (+ ticks 200)) - (.blit self._surf (get self.tiles 1) #(0 0))) - (when (and self.attacking (> ticks self.animate-end)) - (setv self.animate-end 0) - (setv self.attacking False) - (raise PlayerKilled) - (.blit self._surf (get self.tiles 0) #(0 0))) - - (setv self._disp_surf - (case self.facing - Direction.LEFT (pygame.transform.flip self._surf True False) - Direction.RIGHT (.copy self._surf))) - (.flush self)) - - (defn [property] total-move [self] - (merge-moves self.moves)) - - (defn [property] surf [self] - self._disp_surf)) diff --git a/src/macroknight/game.hy b/src/macroknight/game.hy deleted file mode 100644 index 125768a..0000000 --- a/src/macroknight/game.hy +++ /dev/null @@ -1,234 +0,0 @@ -;;; Copyright (C) 2025 Gene Pasquet -;;; -;;; This program is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -(require hy) -(require hyrule *) -(import pygame - pytmx.util_pygame [load_pygame] - entities [Player LevelTile Goal Enemy PlayerKilled] - tiles [TileSet draw-tile] - utils [neg] - text [render-text] - systems [apply-gravity apply-collisions run-enemies GoalHit] - math [floor]) - -(pygame.init) - -(setv TILE_SCALING 1) -(setv TILE_SIZE (* TILE_SCALING 16)) -(setv MACRO_STEP_WAIT 300) -(setv MACRO_COOLDOWN 2000) - -(setv screen (pygame.display.set_mode #((* TILE_SCALING 640) (* TILE_SCALING 480)))) -(setv clock (pygame.time.Clock)) -(setv tileset (TileSet "assets/monochrome-transparent.png" TILE_SCALING TILE_SIZE TILE_SIZE 1)) -(setv levels [(load_pygame "assets/level-0.tmx") - (load_pygame "assets/level-1.tmx") - (load_pygame "assets/level-2.tmx") - (load_pygame "assets/level-3.tmx")]) -(setv level-id 0) -(defn abs-to-tile-index [abs-id] - (int (floor (/ abs-id TILE_SIZE)))) - - -(do ;; Help screen - (.fill screen "#000000") - - (render-text screen tileset "MACROKNIGHT" 15 10) - (render-text screen tileset "GENE AND OWEN PASQUET" 10 2) - - (render-text screen tileset "CONTROLS" 16 22) - (render-text screen tileset "WASD TO MOVE" 14 25) - (render-text screen tileset "SPACE TO ATTACK" 13 26) - (render-text screen tileset "ENTER FOR MACRO" 13 27) - - (pygame.display.flip) - (pygame.time.wait 3000)) - -(setv game-running True) - -(while game-running - - ;; Load the level - (setv running True) - (setv level (get levels level-id)) - (setv entities []) - (setv player-pos #(5 5)) - (for [item (get level.layers 1)] - (let [tile-x (abs-to-tile-index item.x) - tile-y (abs-to-tile-index item.y)] - (case item.type - "Player" (setv player-pos #(tile-x tile-y)) - "Goal" (.append entities - (Goal (len entities) - (get tileset.tiles 0) - TILE_SIZE - tile-x - tile-y)) - "Enemy1" (.append entities - (Enemy (len entities) - [(get tileset.tiles 128) - (get tileset.tiles 129)] - 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) - (let [player-object (get player-objects 0)] - #((abs-to-tile-index player-object.x) - (abs-to-tile-index player-object.y))) - #(5 5)))) - (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]) - (let [id-offset (len entities)] - (for [#(id tiledef) (enumerate (.tiles (get level.layers 0)))] - (let [x (get tiledef 0) - y (get tiledef 1) - tile (get tiledef 2)] - (.append entities (LevelTile (+ id id-offset) tile TILE_SIZE x y TILE_SCALING))))) - - (setv ongoing_inputs []) - - (while running - (for [event (pygame.event.get)] - (case event.type - pygame.QUIT (do - (setv running False) - (setv game-running False)) - pygame.KEYDOWN (if (= event.key pygame.K_ESCAPE) - (do - (setv running False) - (setv game-running False)) - (if macro-input-mode - (when (in event.key [pygame.K_a pygame.K_w pygame.K_a pygame.K_s pygame.K_d pygame.K_SPACE]) - (setv (get macro-commands (.index macro-commands None)) event.key)) - (if (and (= event.key pygame.K_RETURN) (= macro-wait-time 0)) - (setv macro-input-mode True) - (.append ongoing_inputs event.key)))) - pygame.KEYUP (when (in event.key ongoing_inputs) - (.remove ongoing_inputs event.key)))) - - (.fill screen "#000000") - - ;; Render special objects - (for [item (get level.layers 1)] - (case item.type - "Text" (render-text screen - tileset - (.upper item.text) - (abs-to-tile-index item.x) - (abs-to-tile-index item.y)))) - - (if macro-input-mode - ;; If the commands list is full - (if (get macro-commands -1) - ;; Process commands - (do - (let [#(command-id command) (get (lfor command (enumerate macro-commands) :if (get command 1) command) 0)] - (case command - pygame.K_a (.move player #((neg (* 2 TILE_SIZE)) 0)) - pygame.K_s (.move player #(0 TILE_SIZE)) - pygame.K_w (.move player #(0 (neg (/ player.MAX_JUMPING 2)))) - pygame.K_d (.move player #((* 2 TILE_SIZE) 0)) - pygame.K_SPACE (.attack player)) - - (if (= command-id (- (len macro-commands) 1)) - (do - (setv macro-commands [None None None]) - (setv macro-input-mode False) - (setv macro-wait-time (+ (pygame.time.get_ticks) MACRO_COOLDOWN))) - (setv (get macro-commands command-id) None))) - (pygame.time.wait MACRO_STEP_WAIT)) - - ;; If there's still space in the commands list - (for [#(num command) (enumerate macro-commands)] - (let [x-pos (+ 4 num)] - (case command - pygame.K_w (draw-tile screen tileset 1057 x-pos 5) - pygame.K_d (draw-tile screen tileset 1058 x-pos 5) - pygame.K_s (draw-tile screen tileset 1059 x-pos 5) - pygame.K_a (draw-tile screen tileset 1060 x-pos 5) - pygame.K_SPACE (draw-tile screen tileset 329 x-pos 5) - None (draw-tile screen tileset 725 x-pos 5))))) - - ;; Not in macro mode - (do - (when (> macro-wait-time 0) - (let [progress (round (* 3 (/ (- macro-wait-time (pygame.time.get_ticks)) MACRO_COOLDOWN)))] - (for [indicator (range progress)] - (draw-tile screen tileset 725 (+ 4 indicator) 5)))) - (for [inp ongoing_inputs] - (case inp - pygame.K_a (.move player #((neg player.SPEED) 0)) - pygame.K_s (.move player #(0 1)) - pygame.K_w (.jump player) - pygame.K_d (.move player #(player.SPEED 0)) - pygame.K_SPACE (.attack player))) - - (try - (when (any ongoing_inputs) - (for [entity entities] - (apply-collisions entity entities))) - - ;; Apply systems - (let [ticks (pygame.time.get_ticks)] - (for [entity entities] - (run-enemies entity entities) - (when (hasattr entity "animate") (.animate entity ticks)) - (apply-gravity entity entities) - (apply-collisions entity entities))) - - (except [GoalHit] - (setv level-id (+ level-id 1)) - (setv running False) - (when (>= level-id (len levels)) - (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))) - - (.flush player))) - - - (for [entity entities] - (.blit screen entity.surf entity.rect)) - - (pygame.display.flip) - - (when (and (!= 0 macro-wait-time) - (> (pygame.time.get_ticks) macro-wait-time)) - (setv macro-wait-time 0)) - - (.tick clock 60))) - - - -(pygame.quit) diff --git a/src/macroknight/systems.hy b/src/macroknight/systems.hy deleted file mode 100644 index 91d4e8c..0000000 --- a/src/macroknight/systems.hy +++ /dev/null @@ -1,71 +0,0 @@ -;;; Copyright (C) 2025 Gene Pasquet -;;; -;;; This program is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -(import utils [sub-points distance Direction]) - -;; Define systems here -(setv GRAVITY 5) - -(defclass GoalHit [Exception]) - -(defn entities-by-type [entities types] - (gfor ent entities - :if (in ent.type types) - ent)) - -(defmacro defsystem [name pred #* body] - `(defn ~name [entity entities] - (when ~pred - ~@body))) - -(defsystem apply-gravity - (not entity.fixed) - (.move entity #(0 GRAVITY))) - -(defsystem apply-collisions - (not entity.fixed) - (for [ent (gfor enti entities - :if (!= enti.id entity.id) - enti)] - (when (.colliderect entity.rect ent.rect) - (if (= ent.type "goal") - (raise (GoalHit)) - (let [collision-rect (.clip entity.rect ent.rect) - move-x (get entity.total-move 0) - move-y (get entity.total-move 1)] - (when (!= move-x 0) - (.move entity #((* (if (> move-x 0) -1 1) collision-rect.width) 0))) - (when (!= move-y 0) - (.move entity #(0 (* (if (> move-y 0) -1 1) collision-rect.height)))))) - (.ground entity)))) - -(defsystem run-enemies - (= entity.type "enemy") - ;; If the player is on the tile next to the enemy, attack. - (let [player (next (entities-by-type entities ["player"])) - delta (sub-points entity.pos player.pos) - dist (distance entity.pos player.pos) - direction (.x-from-move Direction delta)] - ;; If facing the player and within reach, attack) - (when (and (= direction entity.facing) - (< (get delta 1) 1) ;; Same level - (< (abs (get delta 0)) 2) - (not entity.attacking)) - (.attack entity)) - ;; If not facing the player, turn to face - (when (and (< dist 5) - (!= direction entity.facing)) - (.move entity #((if (< (get delta 0) 0) -1 1) 0))) - )) diff --git a/src/macroknight/text.hy b/src/macroknight/text.hy deleted file mode 100644 index 9608bf9..0000000 --- a/src/macroknight/text.hy +++ /dev/null @@ -1,23 +0,0 @@ -;;; Copyright (C) 2025 Gene Pasquet -;;; -;;; This program is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -(import tiles [draw-tile]) - -(defn render-text [surf tileset text x y] - (for [#(char-num char) (enumerate text)] - (when (> (ord char) 32) - (let [sprite-num (+ (ord char) - (if (> (ord char) 77) 888 852))] - (draw-tile surf tileset sprite-num (+ x char-num) y))))) diff --git a/src/macroknight/tiles.hy b/src/macroknight/tiles.hy deleted file mode 100644 index 81e72e5..0000000 --- a/src/macroknight/tiles.hy +++ /dev/null @@ -1,53 +0,0 @@ -;;; Copyright (C) 2025 Gene Pasquet -;;; -;;; This program is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -(import pygame) - -(defclass TileSet [] - (defn __init__ [self image-file scaling tile-w tile-h [padding 0]] - (setv self.tile-w tile-w) - (setv self.tile-h tile-h) - (setv self.scaling scaling) - - (setv self.sheet - (let [surf (pygame.image.load image-file) - map-width (* (.get_width surf) self.scaling) - map-height (* (.get_height surf) self.scaling)] - (if (!= self.scaling 1) - (pygame.transform.scale surf #(map-width map-height)) - surf))) - - (setv self.tiles - (lfor y (range 0 (.get_height self.sheet) (+ tile-h (* padding self.scaling))) - x (range 0 (.get_width self.sheet) (+ tile-w (* padding self.scaling))) - (let [tile (pygame.Surface #(tile-w tile-h))] - (.blit tile self.sheet #(0 0) #(x y tile-w tile-h)) - tile))))) - -(defclass MiniSprite [pygame.sprite.Sprite] - (defn __init__ [self tile tile-size x y [goal False]] - (.__init__ (super)) - (setv self.surf (pygame.Surface #(tile-size tile-size))) - (.blit self.surf tile #(0 0)) - (setv self.rect (.get_rect self.surf - :left (* x tile-size) - :top (* y tile-size))) - (setv self.goal goal))) - -(defn draw-tile [target tileset tile-id #* args #** kwargs] - (let [tile (get tileset.tiles tile-id) - sprite (MiniSprite tile tileset.tile-w #* args #** kwargs)] - (.blit target sprite.surf sprite.rect) - sprite)) diff --git a/src/macroknight/utils.hy b/src/macroknight/utils.hy deleted file mode 100644 index 05412e8..0000000 --- a/src/macroknight/utils.hy +++ /dev/null @@ -1,66 +0,0 @@ -;;; Copyright (C) 2025 Gene Pasquet -;;; -;;; This program is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -(import enum [Enum] - math [sqrt]) - -(defclass Direction [Enum] - (setv UP "UP") - (setv DOWN "DOWN") - (setv LEFT "LEFT") - (setv RIGHT "RIGHT") - - (defn [staticmethod] from-move [move] - #((.x-from-move Direction move) - (.y-from-move Direction move))) - - (defn [staticmethod] x-from-move [move] - (if (>= (get move 0) 0) - Direction.RIGHT - Direction.LEFT)) - - (defn [staticmethod] y-from-move [move] - (if (>= (get move 0) 0) - Direction.DOWN - Direction.UP)) - - (defn [staticmethod] x-between-points [point1 point2] - (let [delta-x (abs (- (get point1 0) (get point2 0)))] - (if (>= delta-x 0) - Direction.RIGHT - Direction.LEFT)))) - -(defn neg [value] - (* -1 value)) - -(defn invert [move] - #((neg (get move 0)) - (neg (get move 1)))) - -(defn merge-moves [moves] - (let [end-move #(0 0)] - (for [move moves] - (setv end-move - #((+ (get end-move 0) (get move 0)) - (+ (get end-move 1) (get move 1))))) - end-move)) - -(defn sub-points [point1 point2] - #((- (get point2 0) (get point1 0)) - (- (get point2 1) (get point2 1)))) - -(defn distance [point1 point2] - (sqrt (+ (** (- (get point1 0) (get point2 0)) 2) - (** (- (get point1 1) (get point2 1)) 2)))) diff --git a/src/tilemap.scm b/src/tilemap.scm index 7df0561..1c4cf74 100644 --- a/src/tilemap.scm +++ b/src/tilemap.scm @@ -230,6 +230,4 @@ (tileset-image (tilemap-tileset (load-tilemap "assets/level-0.tmx"))) ) - - ) ;; End tilemap module |