crsn/examples/life.csn

(
    ; simple GOL with screen and a buffer + DRAWING!!!
    
    ; Middle-click to payse or resume 
    ; (hold the button until paused - there is a sleep between generations and checking buttons)
    ;
    ; When paused, draw with left (white) and right (black) mouse buttons
    ;
    ; Resume by clicking middle again.
    
    (def GENERATION_MS 200)

    ; Real pixel size
    (sc-init 400 400)
    ; Upscaling factor (bug pixels)
    (sc-opt SCREEN_UPSCALE 10)
    
    ; Number of big pixels
    (def W 40)
    (def H 40)
    
    ; !!! If you change size, also update the following constants.
    ;     Compile-time math is not implemented yet.
    
    (def XMAX 39) ; W-1
    (def YMAX 39) ; H-1
    (def NCELLS 1600) ; W*H
        
    ; --- end of config ---
    (sc-opt SCREEN_AUTO_BLIT 0)
    
    (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)
    
    
    (def LBTN 0)
    (def RBTN 1)
    (def MBTN 2)
                
    (:loop)
        (sc-poll)
        
        ; Drawing
        (sc-mbtn _ MBTN
            (nz?
                (:release)
                    (sc-poll)
                    (mslp 10)
                    (sc-mbtn _ MBTN (nz? (j :release)))
                    
                (:mousing)
                    (sc-poll)
                    (mslp 10)
                    
                    (ld r3 -1)
                    
                    (sc-mbtn _ LBTN)
                    (ld.nz r3 1)
                    (sc-mbtn _ RBTN)
                    (ld.nz r3 0)
                    
                    (tst r3 (nneg?
                        (sc-mouse r0 r1)
                        
                        (tst r3)
                        (sc-wr.nz r0 r1 #ffffff)
                        (sc-wr.z r0 r1 #000000)
                        
                        (sc-blit)
                        (mul r1 W)
                        (add r0 r1)
                        (ld8 r3:8 r3)
                        (bfwr @ng r0 r3)
                    ))                    
                    
                    (sc-mbtn _ MBTN 
                        (z? (j :mousing)))
                        
                (:release2)
                    (sc-poll)
                    (mslp 10)
                    (sc-mbtn _ MBTN (nz? (j :release2)))
            )
        )       
        
        (call Display)
        (sc-blit)
        (mslp GENERATION_MS)
        (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)
    )
)