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)

    ; Number of pixels
    (def W 40)
    (def H 40)
    (def UPSCALE 10)

    ; --- end of config ---

    ; Real pixel size
    (sc-init (=mul UPSCALE W) (=mul UPSCALE H))
    ; Upscaling factor (bug pixels)
    (sc-opt SCREEN_UPSCALE UPSCALE)

    (def XMAX (=sub W 1))
    (def YMAX (=sub H 1))
    (def NCELLS (=mul W H))

    (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)

    (:loop)
        (sc-poll)

        ; Drawing
        (sc-mbtn _ MBTN_MID
            (nz?
                (:release)
                    (sc-poll)
                    (mslp 10)
                    (sc-mbtn _ MBTN_MID (nz? (j :release)))

                (:mousing)
                    (sc-poll)
                    (mslp 10)

                    (ld r3 -1)

                    (sc-mbtn _ MBTN_LEFT)
                    (ld.nz r3 1)
                    (sc-mbtn _ MBTN_RIGHT)
                    (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_MID
                        (z? (j :mousing)))

                (:release2)
                    (sc-poll)
                    (mslp 10)
                    (sc-mbtn _ MBTN_MID (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)
    )
)