TakeV/lisp-game-jam
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Merge branch 'main' of https://git.solarpunk.moe/TakeV/lisp-game-jam

Browse source
This commit is contained in:
nephryte 2024-05-25 22:04:51 -04:00
commit 8e49207c72
4 changed files with 35 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
game.scm
View file

@ -56,19 +56,22 @@
(define game-width 640.0)
(define game-height 480.0)
(define game-images `(('player . ,(make-image "assets/sprites/player.png"))
('barrel . ,(make-image "assets/sprites/barrel.png"))
('bricks . ,(make-image "assets/sprites/bricks.png"))
('stones . ,(make-image "assets/sprites/stones.png"))
('card-back . ,(make-image "assets/sprites/bricks.png"))))
(define game-images `((player . ,(make-image "assets/sprites/player.png"))
(barrel . ,(make-image "assets/sprites/barrel.png"))
(bricks . ,(make-image "assets/sprites/bricks.png"))
(stones . ,(make-image "assets/sprites/stones.png"))
(card-back . ,(make-image "assets/sprites/bricks.png"))))
(parameterize ((*logger* pk))
(parameterize ((*media-library* (create-media-library)))
(add-images! (get-media-library) game-images)
(define bootstrap-entity-manager (make-parameter #f))
(define bootstrap-system-manager (make-parameter #f))
(write-log! "Creating entity manager")
(define e-manager
(create-entity-manager (init-game-entities)))
(define e-manager (parameterize ((*entity-manager-parameter* bootstrap-entity-manager)
(*system-manager-parameter* bootstrap-system-manager))
(create-entity-manager (pk (init-game-entities)))))
(write-log! "Creating system manager")
(define s-manager

2
modules/ces/entity-manager.scm
View file

@ -46,7 +46,7 @@
(case-lambda
(() (create-entity-manager (emap:create-entity-map)))
((initial-world-state)
(make-entity-manager initial-world-state
(make-entity-manager (emap:create-entity-map initial-world-state)
(emap:create-entity-map)
(emap:create-entity-map)
(create-entity-generator)))

25
modules/ces/entity/entity-map.scm
View file

@ -1,6 +1,7 @@
(define-module (ces entity entity-map)
#:pure
#:use-module (scheme base)
#:use-module (scheme case-lambda)
#:use-module (hoot atomics)
#:use-module (hoot hashtables)
#:use-module (hoot match)
@ -24,9 +25,27 @@
entity-map?
(entities entity-map-entities))
(define (create-entity-map)
"Creates a new entity-map and returns it."
(make-entity-map (make-eq-hashtable)))
(define create-entity-map
(case-lambda
(() (make-entity-map (make-eq-hashtable)))
((initial-entities)
(cond
((list? initial-entities)
(let ((initial-map (make-eq-hashtable)))
(for-each (lambda (val)
(when (game-entity? val)
(hashtable-set! initial-map
(game-entity-id val)
val)))
initial-entities)
(make-entity-map initial-map)))
((hashtable? initial-entities)
(make-entity-map initial-entities))
((entity-map? initial-entities)
(make-entity-map
(hashtable-copy
(entity-map-entities initial-entities))))
(else (create-entity-map))))))
(define (entity-key entity)
"Returns the entity id of an entity, or the value itself if it is

6
modules/media.scm
View file

@ -27,19 +27,17 @@
(*media-library*))
(define (create-media-library)
(write-log! "Creating media library.")
(make-media-library (make-eq-hashtable)
(make-eq-hashtable)))
(define (add-image! media-library image-symbol image)
(write-log! "Adding image: " image-symbol)
(hashtable-set! (media-images media-library) image-symbol image))
(define (add-images! media-library images)
(write-log! "Adding images: " images)
(for-each (lambda (val)
(add-image! media-library (car val) (cdr val)))
images))
(define (get-image media-library image-symbol)
(hashtable-ref (media-images media-library) image-symbol #f))
"Gets the image in the library, or 'image-not-found if the image does not exists."
(hashtable-ref (media-images media-library) image-symbol 'image-not-found))