\ ********** for defining the rule tables **************** 00 00 == ul0 01 01 == ur0 02 02 == ll0 03 03 == lr0 04 04 == ul1 05 05 == ur1 06 06 == ll1 07 07 == lr1 08 08 == ul2 09 09 == ur2 10 10 == ll2 11 11 == lr2 12 12 == ul3 13 13 == ur3 14 14 == ll3 15 15 == lr3 00 03 == pln0 04 07 == pln1 08 11 == pln2 12 15 == pln3 create-lut even-table create-lut odd-table create-lut reverse-table : even>odd even-table buffer odd-table buffer length /w* cmove ; : even>reverse even-table buffer reverse-table buffer length /w* cmove ; : propagate update ul0 <-> lr0 ll0 <-> ur0 ul1 <-> lr1 ll1 <-> ur1 ul2 <-> lr2 ll2 <-> ur2 ul3 <-> lr3 ll3 <-> ur3 ; create-lut propagate-table ?rule>table propagate propagate-table \ ******** alternative neighbors for rotsym rules ********* 00 00 == center0 01 01 == center1 02 02 == center2 03 03 == center3 04 04 == cw0 05 05 == cw1 06 06 == cw2 07 07 == cw3 08 08 == opp0 09 09 == opp1 10 10 == opp2 11 11 == opp3 12 12 == ccw0 13 13 == ccw1 14 14 == ccw2 15 15 == ccw3 00 03 == centers 04 07 == cws 08 11 == opps 12 15 == ccws 0 0 == center 4 4 == cw 8 8 == opp 12 12 == ccw 1 1 == center' 5 5 == cw' 9 9 == opp' 13 13 == ccw' create-lut rotsym-table rotsym-table buffer constant rotsym-buffer : rotsym-lookup (s centers cws opps ccws -- value ) 4 << or 4 << or 4 << or /w* rotsym-buffer + w@ f and ; : uls ul3 2* ul2 + 2* ul1 + 2* ul0 + ; : urs ur3 2* ur2 + 2* ur1 + 2* ur0 + ; : lls ll3 2* ll2 + 2* ll1 + 2* ll0 + ; : lrs lr3 2* lr2 + 2* lr1 + 2* lr0 + ; : >uls dup 3 >> -> ul3 dup 2 >> -> ul2 dup 2/ -> ul1 -> ul0 ; : >urs dup 3 >> -> ur3 dup 2 >> -> ur2 dup 2/ -> ur1 -> ur0 ; : >lls dup 3 >> -> ll3 dup 2 >> -> ll2 dup 2/ -> ll1 -> ll0 ; : >lrs dup 3 >> -> lr3 dup 2 >> -> lr2 dup 2/ -> lr1 -> lr0 ; : expand-rotsym uls urs lrs lls rotsym-lookup >uls urs lrs lls uls rotsym-lookup >urs lrs lls uls urs rotsym-lookup >lrs lls uls urs lrs rotsym-lookup >lls propagate ; \ If we want to be able to use "update" with a rotationally symmetric \ rule, we need to actually update all 4 cells. "rotsym" takes a word \ that updates only the centers as a function of the others, and applies \ it to all 4 rotated cases. : rotate4 (s addr -- ) dup @ dup h# fff and 4 << swap h# f000 and 12 >> or swap ! ; 0 value last-rotacf : (rotsym (s acf -- ) is last-rotacf 4 0 do last-rotacf execute lut-in rotate4 lut-out rotate4 loop ; : (rotsym) r@ token@ (rotsym r> ta1+ >r ; : rotsym ( ----- mmmmm ) state @ if compile (rotsym) else ' (rotsym then ; immediate \ ******************* define the steps ********************* define-step free-step full-space lut-src site site-src lut display site kick lr0 field -1 x -1 y ur0 field -1 x 0 y ll0 field 0 x -1 y lr1 field -1 x -1 y ur1 field -1 x 0 y ll1 field 0 x -1 y lr2 field -1 x -1 y ur2 field -1 x 0 y ll2 field 0 x -1 y lr3 field -1 x -1 y ur3 field -1 x 0 y ll3 field 0 x -1 y run free switch-luts kick ul0 field 1 x 1 y ll0 field 1 x 0 y ur0 field 0 x 1 y ul1 field 1 x 1 y ll1 field 1 x 0 y ur1 field 0 x 1 y ul2 field 1 x 1 y ll2 field 1 x 0 y ur2 field 0 x 1 y ul3 field 1 x 1 y ll3 field 1 x 0 y ur3 field 0 x 1 y run free switch-luts end-step this is update-step \ We prepare to run backwards by performing a transformation on the \ state of the system that reverses the "momentum" of all particles. We \ first apply this transformation as if it was the even-step rule, then \ we undo the propagate part of the rule and move the data back where it \ started. Subsequent evolution uses the normal "free-step" rule. define-step reverse-step full-space lut-src site site-src lut display 0 fix lut-data reverse-table switch-luts kick lr0 field -1 x -1 y ur0 field -1 x 0 y ll0 field 0 x -1 y lr1 field -1 x -1 y ur1 field -1 x 0 y ll1 field 0 x -1 y lr2 field -1 x -1 y ur2 field -1 x 0 y ll2 field 0 x -1 y lr3 field -1 x -1 y ur3 field -1 x 0 y ll3 field 0 x -1 y run free \ reverse state lut-data propagate-table switch-luts kick run free \ undo propagation kick lr0 field 1 x 1 y ur0 field 1 x 0 y ll0 field 0 x 1 y lr1 field 1 x 1 y ur1 field 1 x 0 y ll1 field 0 x 1 y lr2 field 1 x 1 y ur2 field 1 x 0 y ll2 field 0 x 1 y lr3 field 1 x 1 y ur3 field 1 x 0 y ll3 field 0 x 1 y site-src site run free \ move the data back end-step \ ******************* run the experiment ******************** define-step send-tables full-space lut-data even-table switch-luts lut-data odd-table end-step this is when-starting : density-map 0 >color ul0 ur0 ll0 lr0 + + + bright 4 / * dup >green >red ul1 ur1 ll1 lr1 + + + bright 4 / * >blue ; colormap density-map