Add xor and level 4

2024-05-22 12:07:41 -04:00 · 2024-05-22 12:07:41 -04:00 · a49808d70d
commit a49808d70d
parent dc05a9cd05
7 changed files with 93 additions and 3 deletions
--- a/3
+++ b/3
@ -27,7 +27,8 @@ modules = \
 levels = \
  modules/game/levels/level-1.scm \
  modules/game/levels/level-2.scm \
-  modules/game/levels/level-3.scm
+  modules/game/levels/level-3.scm \
+  modules/game/levels/level-4.scm

 game.wasm: game.scm $(modules) $(levels)
 	guild compile-wasm -L modules -o $@ $<
--- a/game.scm
+++ b/game.scm
@ -30,6 +30,7 @@
             (game levels level-1)
             (game levels level-2)
             (game levels level-3)
+             (game levels level-4)
             (game tileset)
             (goblins core)
             (hoot bytevectors)
@ -83,7 +84,8 @@
  (vector
   load-level-1
   load-level-2
-   load-level-3))
+   load-level-3
+   load-level-4))
 (define *level-idx* #f)
 (define *gems* #f)
 (define *level* #f)
@ -296,6 +298,9 @@
 (define (draw-and-gate pos)
  (draw-tile context tileset 42 (vec2-x pos) (vec2-y pos)))

+(define (draw-xor-gate pos)
+  (draw-tile context tileset 44 (vec2-x pos) (vec2-y pos)))
+
 (define (draw-electric-switch pos on?)
  (draw-tile context tileset (if on? 7 6) (vec2-x pos) (vec2-y pos)))

@ -311,6 +316,7 @@
    (('gem pos) (draw-gem pos))
    (('gate pos open?) (draw-gate pos open?))
    (('and-gate pos) (draw-and-gate pos))
+    (('xor-gate pos) (draw-xor-gate pos))
    (('electric-switch pos on?) (draw-electric-switch pos on?))))

 (define (draw-background)
--- a/modules/game/actors.scm
+++ b/modules/game/actors.scm
@ -10,6 +10,7 @@
            ^gate
            ^gem
            ^and-gate
+            ^xor-gate
            ^electric-switch
            ^player
            ^level))
@ -274,6 +275,46 @@
    (('describe) `(and-gate ,position))
    (('collide other offset grid-info) #f)))

+(define (^xor-gate bcom x y)
+  (define position (vector x y 0))
+  (define state (spawn ^cell 'copper))
+  (match-lambda*
+    (('type) 'emitter)
+    (('position) position)
+    (('tick grid-info) #f)
+    (('post-tick grid-info) #f)
+    (('enter obj grid-info) #f)
+    (('exit obj grid-info) #f)
+    (('wire-state) ($ state))
+    (('update-wire-state grid-info)
+     (match ($ state)
+       ('electron-head ($ state 'electron-tail))
+       ('electron-tail ($ state 'copper))
+       ('copper
+        ;; TODO: Match other shapes? This only allows left-to-right
+        ;; circuit flow.
+        (match (pk 'xor-grid-info ($ grid-info 'wireworld-neighbor-grid x y))
+          (#('electron-head #f #f
+                            #f _ 'copper
+                            #f #f #f)
+           ($ state 'electron-head))
+          (#('electron-head #f #f
+                            #f _ 'copper
+                            'copper #f #f)
+           ($ state 'electron-head))
+          (#(#f #f #f
+                #f _ 'copper
+                'electron-head #f #f)
+           ($ state 'electron-head))
+          (#('copper #f #f
+                #f _ 'copper
+                'electron-head #f #f)
+           ($ state 'electron-head))
+          (_ ($ state 'copper))))))
+    (('alive?) #t)
+    (('describe) `(xor-gate ,position))
+    (('collide other offset grid-info) #f)))
+
 (define (^player bcom x y)
  (define position (spawn ^cell (vector x y 2)))
  (define velocity (spawn ^cell #(0 0)))
--- a/modules/game/level.scm
+++ b/modules/game/level.scm
@ -46,6 +46,7 @@
                        (12 (let ((target-x (bytevector-u8-ref objects (+ i 3)))
                                  (target-y (bytevector-u8-ref objects (+ i 4))))
                              (spawn ^electric-switch x y target-x target-y)))
+                        (13 (spawn ^xor-gate x y))
                        (id (error "invalid level object" id))))
                 (i* (+ i (match id
                            ;; floor-switch or electric-switch
--- a/modules/game/levels/level-2.tmx
+++ b/modules/game/levels/level-2.tmx
@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="20" height="15" tilewidth="16" tileheight="16" infinite="0" nextlayerid="3" nextobjectid="22">
 <tileset firstgid="1" source="tiles.tsx"/>
- <layer id="1" name="background" width="20" height="15" visible="0">
+ <layer id="1" name="background" width="20" height="15">
  <data encoding="csv">
 23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
 23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
--- a/modules/game/levels/level-4.tmx
+++ b/modules/game/levels/level-4.tmx
@ -0,0 +1,39 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="20" height="15" tilewidth="16" tileheight="16" infinite="0" nextlayerid="3" nextobjectid="15">
+ <tileset firstgid="1" source="tiles.tsx"/>
+ <layer id="1" name="background" width="20" height="15">
+  <data encoding="csv">
+23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
+23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
+23,23,24,24,24,24,24,24,24,24,24,24,24,24,23,23,23,23,23,23,
+23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,24,24,24,23,
+23,24,49,3,3,3,3,3,3,3,3,3,24,24,24,23,24,24,24,23,
+23,24,24,24,24,24,24,24,24,24,24,24,24,3,24,23,24,24,24,23,
+23,24,49,3,3,24,3,3,3,3,3,3,24,24,24,24,24,24,24,23,
+23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,24,24,24,23,
+23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,24,28,24,23,
+23,24,24,24,24,24,24,24,24,24,24,24,24,24,23,23,24,24,24,23,
+23,24,24,24,24,24,24,24,24,24,24,24,24,24,23,23,24,24,24,23,
+23,23,24,24,24,24,24,24,24,24,24,24,24,23,23,23,23,23,23,23,
+23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
+23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
+23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23
+</data>
+ </layer>
+ <objectgroup id="2" name="objects">
+  <object id="1" type="player-spawn" gid="1" x="80" y="128" width="16" height="16"/>
+  <object id="4" type="block" gid="4" x="80" y="96" width="16" height="16">
+   <properties>
+    <property name="kind" value="copper"/>
+   </properties>
+  </object>
+  <object id="8" type="electric-switch" gid="8" x="224" y="80" width="16" height="16">
+   <properties>
+    <property name="target-x" type="int" value="15"/>
+    <property name="target-y" type="int" value="6"/>
+   </properties>
+  </object>
+  <object id="9" type="gate" gid="46" x="240" y="96" width="16" height="16"/>
+  <object id="13" type="xor-gate" gid="45" x="192" y="80" width="16" height="16"/>
+ </objectgroup>
+</map>
--- a/scripts/compile-map.scm
+++ b/scripts/compile-map.scm
@ -557,6 +557,7 @@ the default ORIENTATION value of 'orthogonal' is supported."
 (define obj:gate 10)
 (define obj:and-gate 11)
 (define obj:electric-switch 12)
+(define obj:xor-gate 13)

 (define (compile-environment-layer tile-map layer-name)
  (let ((tw (tile-map-tile-width tile-map))
@ -604,6 +605,7 @@ the default ORIENTATION value of 'orthogonal' is supported."
                      ('gem (list x y obj:gem))
                      ('gate (list x y obj:gate))
                      ('and-gate (list x y obj:and-gate))
+                      ('xor-gate (list x y obj:xor-gate))
                      ('electric-switch (list x y obj:electric-switch
                                              (assq-ref properties 'target-x)
                                              (assq-ref properties 'target-y)))