Croissant Runtime
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
crsn/examples/life.csn

243 lines
6.1 KiB

4 years ago
(
; 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)
4 years ago
; Real pixel size
4 years ago
(sc-init 400 400)
; Upscaling factor (bug pixels)
4 years ago
(sc-opt SCREEN_UPSCALE 10)
; Number of big pixels
4 years ago
(def W 40)
(def H 40)
; !!! If you change size, also update the following constants.
; Compile-time math is not implemented yet.
4 years ago
(def XMAX 39) ; W-1
(def YMAX 39) ; H-1
(def NCELLS 1600) ; W*H
; --- end of config ---
(sc-opt SCREEN_AUTO_BLIT 0)
4 years ago
(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)
4 years ago
(: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)))
)
)
4 years ago
(call Display)
(sc-blit)
(mslp GENERATION_MS)
4 years ago
(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)
)
)