Sierpinski triangle (Forth)
This program will display a crude Sierpinski triangle by calculating a simple one-dimensional cellular automaton and displaying its changing state over time.
We will use a byte array to represent the current state of the one-dimensional universe. We allocate an extra byte at the end (1+ allot and 1+ erase) to avoid overflow during the later generational calculation. init-state clears the array and sets one cell to Full. .state prints the current state, showing a space for Empty cells and '@' for full cells. (. is typically pronounced "print" in Forth.)
<<state>>= 80 constant size create state size 1+ allot : init-state state size 1+ erase 1 state size 2/ + c! ; ctable symbol bl c, char @ c, : .state cr size 0 do state i + c@ symbol emit loop ;
The CREATE-DOES> construct works well for defining the character tables we use for the state transitions and the output symbols.
<<ctable>>= : ctable create does> + c@ ;
The particular cellular automaton for generating a Sierpinski triangle looks at the current cell and the two neighboring cells. There are eight possible permutations of the states of these three cells (which will henceforth be called the neighborhood), and we will represent the automaton as a table mapping the state of the neighborhood (represented as a number from 0..7) to the next state of the current cell. The rule stated succinctly is to clear the cell if the neighborhood cells are the same (all Empty or all Full) and set the cell if the three cells differ.
<<automaton rules>>= \ the input has three bits: b0,b1,b2 = next neighbor, current cell, previous neighbor ctable transition \ 000 001 010 011 100 101 110 111 0 c, 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 0 c,
The gen word will keep the neighborhood of the current cell on the stack. It is easy to obtain the neighborhood of the current cell from the neighborhood of the previous cell. You just shift the window: shift right (2*), shifting the state of the next neighbor into the LSB (state i + 1+ c@ or) and taking away the old neighbor from the MSB by restricting the result to three bits (7 and).
<<current neighborhood>>= 2* state i + 1+ c@ or 7 and
gen invokes the automaton to obtain the next generation of the state from the previous state.
<<gen>>= : gen state c@ ( neighborhood ) size 0 do dup transition state i + c! loop drop ;
sierpinski will calculate and show n generations of the automaton (including the initial one), displaying a Sierpinski triangle n characters tall and 2n+1 characters wide. Powers of two for n generate complete triangles.
<<sierpinski.f>>= : sierpinski ( n -- ) init-state .state 1 ?do gen .state loop ; 32 sierpinski bye