Advertisement
Guest User

Untitled

a guest
Sep 29th, 2016
54
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.43 KB | None | 0 0
  1. Red [
  2. Title: "Conway's Game of Life"
  3. Needs: 'View
  4. ]
  5.  
  6. grid: collect [repeat i 10 [keep/only collect [repeat j 10 [keep random true]]]]
  7. scratchgrid: collect [repeat i 10 [keep/only collect [repeat j 10 [keep false]]]]
  8.  
  9. a: copy grid/1
  10. b: copy grid/10
  11. c: collect [keep/only b keep grid keep/only a]
  12.  
  13. count-neighbors: function [gridd x y][
  14. count: 0
  15. foreach [h v][
  16. (x - 1) (y - 1)
  17. (x - 1) y
  18. (x - 1) (y + 1)
  19. x (y - 1)
  20. x (y + 1)
  21. (x + 1) y
  22. (x + 1) (y - 1)
  23. (x + 1) (y + 1)
  24. ][
  25. if gridd/(do h)/(do v) [count: count + 1]
  26. ]
  27. ;?? count
  28. count
  29. ]
  30.  
  31. iterate: function [] [
  32. repeat i 10 [
  33. ii: i + 1
  34. repeat j 10 [
  35. ncount: count-neighbors c ii j
  36. scratchgrid/:i/:j: make logic! any [
  37. all [c/:ii/:j ncount > 1 ncount < 4]
  38. all [not c/:ii/:j ncount = 3]
  39. ]
  40. ]
  41. ]
  42. ]
  43.  
  44. refresh: function [cmds][
  45. clear cmds
  46. repeat i 10 [
  47. repeat j 10 [
  48. insert cell: tail cmds [fill-pen <color> circle <coord> 5]
  49. cell/2: pick [red white] scratchgrid/:i/:j
  50. cell/4: 10 * as-pair i j
  51. ]
  52. ]
  53. ]
  54.  
  55. sync-grids: [
  56. grid: copy scratchgrid
  57.  
  58. clear scratchgrid
  59. scratchgrid: collect [repeat i 10 [keep/only collect [repeat j 10 [keep false]]]]
  60. a: copy grid/1
  61. b: copy grid/10
  62. c: collect [keep/only b keep grid keep/only a]
  63. ]
  64.  
  65. update-all: does [
  66. do iterate
  67. refresh canvas/draw
  68. do sync-grids
  69. ]
  70.  
  71. cmds: make block! 500
  72.  
  73. view [
  74. size 800x600
  75. canvas: base 780x580 draw cmds rate 30
  76. on-time [update-all]
  77. do [update-all]
  78. ]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement