add GOL example

2020-10-22 00:07:30 +02:00
parent 453f421bae
commit f61dc00291
1 changed files with 175 additions and 0 deletions
@@ -0,0 +1,175 @@
+(
+    ; simple GOL with screen and a buffer
+
+    (sc-init 400 400)
+    (sc-opt SCREEN_UPSCALE 10)
+    (sc-opt SCREEN_AUTO_BLIT 0)
+    (def W 40)
+    (def H 40)
+    (def XMAX 39) ; W-1
+    (def YMAX 39) ; H-1
+    (def NCELLS 1600) ; W*H
+    
+    (sc-erase 0) ; all black
+    (sym ng g15)
+    (mkbf ng NCELLS)
+    
+    ; one glider
+    (bfwr @ng 1 1)
+    (bfwr @ng 42 1)
+    (bfwr @ng 80 1)
+    (bfwr @ng 81 1)
+    (bfwr @ng 82 1)
+    
+    ; another glider
+    (bfwr @ng 16 1)
+    (bfwr @ng 55 1)
+    (bfwr @ng 95 1)
+    (bfwr @ng 96 1)
+    (bfwr @ng 97 1)
+                
+    (:loop)
+        (sc-poll)
+        ; TODO interactivity?
+        (call Display)
+        (sc-blit)
+        (mslp 200)
+        (j :loop)
+    
+    (proc CountNeighbors x y
+        (sym xx r4)
+        (sym yy r5)
+        (sym i r6)
+        (sym count r7)     
+        
+        ; yeah this sucks. it's correct, though
+        
+        (:a)
+            (add yy y -1 (neg? (j :d)))        
+            (add xx x -1 (neg? (j :b)))
+            (mul i yy W)
+            (add i xx)
+            (bfrd r0 @ng i)
+            (and r0 0xFF (nz? (inc count)))
+            
+        (:b)
+            (mul i yy W)
+            (add i x)
+            (bfrd r0 @ng i)
+            (and r0 0xFF (nz? (inc count)))
+        
+        (:c)
+            (add xx x 1)
+            (cmp xx W (ge? (j :d)))
+            (mul i yy W)
+            (add i xx)
+            (bfrd r0 @ng i)
+            (and r0 0xFF (nz? (inc count)))
+        
+        (:d)     
+            (add xx x -1 (neg? (j :f)))
+            (mul i y W)
+            (add i xx)
+            (bfrd r0 @ng i)
+            (and r0 0xFF (nz? (inc count)))
+            
+        ; there is no E
+            
+        (:f)
+            (add xx x 1)
+            (cmp xx W (ge? (j :g)))
+            (mul i y W)
+            (add i xx)
+            (bfrd r0 @ng i)
+            (and r0 0xFF (nz? (inc count)))
+                 
+        (:g)
+            (add yy y 1)        
+            (cmp yy H (ge? (j :end)))
+            (add xx x -1 (neg? (j :h)))
+            (mul i yy W)
+            (add i xx)
+            (bfrd r0 @ng i)
+            (and r0 0xFF (nz? (inc count)))
+            
+        (:h)
+            (add yy y 1)        
+            (cmp yy H (ge? (j :end)))
+            (mul i yy W)
+            (add i x)
+            (bfrd r0 @ng i)
+            (and r0 0xFF (nz? (inc count)))
+        
+        (:i)
+            (add yy y 1)        
+            (cmp yy H (ge? (j :end)))
+            (add xx x 1)
+            (cmp xx W (ge? (j :end)))
+            (mul i yy W)
+            (add i xx)
+            (bfrd r0 @ng i)
+            (and r0 0xFF (nz? (inc count)))
+        
+        (:end)
+        (ret count)
+    )
+    
+    (proc Display
+        ; display and calc next gen
+        (sym x r4)
+        (sym y r5)
+        (sym i r6)        
+        (:next)
+            ; The lower byte contains 0 or 1
+            ; the second byte will be filled with the next gen
+            
+            (bfrd r0 @ng i)
+            
+            ; Show this gen
+            (and r0 0xFF 
+                (nz? (sc-wr x y 0xffffff))
+                (z? (sc-wr x y 0x000000)))
+            
+            (call CountNeighbors x y)
+            
+            ; stay: 2,3
+            ; die:  >3
+            ; born: 3
+            
+            (cmp res0 2 
+                (eq? (ld8 r0:8 r0)) ; stasis
+                (ne?
+                    (tst r0 
+                        (z? 
+                            (cmp res0 3 (eq? (ld8 r0:8 1))) ; birth                
+                        ) 
+                        (nz? 
+                            (cmp res0 3 (eq? (ld8 r0:8 1))) ; stay alive                
+                        )
+                    )
+                )
+            )
+            
+            (bfwr @ng i r0)
+            
+            (inc i)
+            (inc x)
+            (cmp x W
+                (ne? (j :next)))
+            (ld x 0)
+            (inc y)
+            (cmp y H 
+                (eq? (j :next2)))
+            (j :next)
+                   
+        ; Shift all by 8 to the right (generation shift)
+        (:next2)
+            (dec i)
+            (bfrd r0 @ng i)
+            (lsr r0 8)
+            (bfwr @ng i r0)
+            (tst i)
+            (j.nz :next2)
+            (ret)
+    )
+)