Keskustelu: Koodit: 8th: Game Of Life

\
\ Game Of Life
\
needs nk/gui

24 font:system font:new "font1" font:atlas! drop

100 constant MIN-DELAY
1000 constant MAX-DELAY

16 constant STEP-X
16 constant STEP-Y

53 constant ROWS
53 constant COLS

nullvar update-task-id

var delay

var population

: create-cell  \ m a  -- m
  dup "%d:%d" s:strfmt m:_! ;

: neighbours?  \ a -- a
  >r m:new
  [
    [-1,-1],[0,-1],[1,-1],
    [-1,0],[1,0],
    [-1,1],[0,1],[1,1]
  ] ( r@ ' n:+ a:2map ) a:map rdrop
  ' create-cell a:each! drop ;

: count-alive-neighbours  \ m a -- m n
  neighbours? m:keys nip m:@ ( null? not nip ) a:filter a:len nip ;

: evolve \ m -- m
  m:new m:new rot m:vals
  (
    dup>r count-alive-neighbours dup 2 n:= swap 3 n:= or if
      over r@ create-cell drop
    then

    r> neighbours?
    (
      4 pick rot m:exists? !if
        swap dup>r create-cell drop
        r@ count-alive-neighbours 3 n:= if
          over r> create-cell drop
        else
          rdrop
        then
      else
        2drop
      then
    ) m:each drop
  ) a:each! 2drop nip ;

: populate-random  \ m -- m
  ( >r
    ( rand-pcg 100 n:mod 15 n:> !if
        r@ 2 a:close create-cell
      else
        drop
      then
    ) 0 COLS n:1- loop rdrop
  ) 0 ROWS n:1- loop ;

: grid-widget  \ m --
  nk:widget nk:WIDGET_INVALID n:= !if
    { rows: @ROWS, cols: @COLS } nk:layout-grid-begin
      ( >r
        (
          dup 1 r@ 1 nk:grid nk:BUTTON_LEFT swap true nk:clicked? if
            dup r@ 2 a:close
            "y-offs" nk:get "x-offs" nk:get 2 a:close
            ' n:- a:2map
           "pressed" swap nk:set
          then

          dup 1 r@ 1 nk:grid nk:hovered? nk:BUTTON_LEFT nk:down? and if
            dup r@ 2 a:close "down" swap nk:set
          then

          tuck "y-offs" nk:get n:+ r@ "x-offs" nk:get n:+ "%d:%d" s:strfmt m:exists? if
            swap 1 r@ 1 nk:grid -1 nk:rect-shrink 0 "black" nk:fill-rect
          else
            swap 1 r@ 1 nk:grid 0 2 "black" nk:stroke-rect
          then
        ) 0 ROWS n:1- loop rdrop
      ) 0 COLS n:1- loop
    nk:layout-grid-end drop

    "pressed" nk:get null? if
      drop
    else
      "down" nk:get swap ' n:- a:2map
      a:open
      "x-offs" swap nk:set
      "y-offs" swap nk:set
    then

    nk:BUTTON_LEFT nk:down? !if
      "pressed" null nk:set
    then
  else
    drop
  then ;

: reset
  m:new populate-random population !
  "x-offs" 0 nk:set
  "y-offs" 0 nk:set
  null nk:do ;

: new-win
  {
    name: "main",
    wide: 600,
    high: 610,
    resizable: false,
    bg: "white",
    title: "Game Of Life"
  } nk:win ;

: handle-timer
  d:msec >r "msecs" nk:get null? !if
    r@ swap n:- delay @ n:< !if
      "msecs" r> nk:set
      population @ evolve population !
    else
      rdrop
    then
  else
    drop "msecs" r> nk:set
  then ;

: handle-keys
  nk:KEY_LEFT nk:key-released? if "x-offs" dup nk:get STEP-X n:- nk:set then
  nk:KEY_RIGHT nk:key-released? if "x-offs" dup nk:get STEP-X n:+ nk:set then
  nk:KEY_UP nk:key-released? if "y-offs" dup nk:get STEP-Y n:- nk:set then
  nk:KEY_DOWN nk:key-released? if "y-offs" dup nk:get STEP-Y n:+ nk:set then ;

: main-render
  delay @
  {
    bg: "white",
    flags: [ @nk:WINDOW_NO_SCROLLBAR ],
    x-offs: 0,
    y-offs: 0
  }
  nk:begin
    null { rows: [0.90,0.10], cols: 1, rgap: 4, cgap:4, margin: 4 } nk:layout-grid-begin
      0 1 0 1 nk:grid nk:rect>local nk:grid-push population @ grid-widget

      1 1 0 1 nk:grid { rows: 1, cols: 8, rgap: 4, cgap:4, margin: 4 } nk:layout-grid-begin
        0 1 0 1 nk:grid nk:rect>local nk:grid-push "Reset" ' reset nk:button-label
        0 1 1 7 nk:grid nk:rect>local nk:grid-push MIN-DELAY MAX-DELAY 1 delay true nk:slider
      nk:layout-grid-end

      1 1 0 1 nk:grid 4 2 "black" nk:stroke-rect
    nk:layout-grid-end

    handle-keys
    handle-timer
  nk:end

  \ Old animation step delay value is on TOS, was it changed?
  delay @ n:= !if
    update-task-id @ t:notify
  then ;

 : update-task
  repeat
    null nk:do
    delay @ 1000 n:/ sleep
  again ;

: init
  MIN-DELAY delay !
  m:new populate-random population !
  1500k 1500k nk:max-vertex-element ;

: app:main
  init
  ' update-task t:task update-task-id !
  new-win ' main-render -1 nk:render-loop ;