ANEW --WOLFRAM--  DECIMAL                     \  Wil Baden  2002-07-19

VARIABLE  RULE  0 RULE !  \  0...255

\  "This long-awaited work from one of the world's most respected
\  scientists presents a series of dramatic discoveries never before
\  made public. Starting from a collection of simple computer
\  experiments - illustrated in the book by striking computer
\  graphics - Stephen Wolfram shows how their unexpected results force
\  a whole new way of looking at the operation of our universe."
\  -- Blurb from dust-jacket, _A New Kind of Science_ 

\  Wolfram-Chart               ( -- )
\     With the value at `RULE`, display the start of the expansion of 
\     one bit as given in Wolfram, _A New Kind of Science_. 
\     Uses MacForth `DOT` and other MacForth graphic words:
\     `Move.To`, `QD-Clear`, and `RECTANGLE` (and `BEEP`).
\
\     For each bit _b_, take it and bit _a_ before it and bit _c_
\     after it as _4a+2b+c_.  When _(1 << (4a+2b+c)) & rule_ is not
\     0, bit _b_ in the next row is on.

\  DOT                          ( x y -- )              MacForth
\     Display dot at _x,y_ in window using current pen pattern.

\  WOLFRAM                      ( -- )
\     Display charts for all rules.  Uses `Wolfram-Chart`.
\     The rules are done in graycode order. Thus there is only one
\     bit difference between each rule and the next.

\  Thanks to Krishna Myneni, david, Jim White, Marcel Hendrix, Walter 
\  Rottenkolb, William Tanksley, Roelf Toxopeus. 

200 CONSTANT  WIDTH        \  According to taste.
100 CONSTANT  HEIGHT       \  According to taste.
\  Small widow for speed.  WIDTH is twice HEIGHT.

WIDTH chars BUFFER:  ROW
WIDTH chars BUFFER:  Next-Row

: >GRAY  ( n -- graycode )  dup 1 RSHIFT XOR ;

    : GRAY>                 ( graycode -- n )
        dup  1 RSHIFT XOR
        dup  2 RSHIFT XOR
        dup  4 RSHIFT XOR
        dup  8 RSHIFT XOR
        dup 16 RSHIFT XOR ;

: Wolfram-Chart             ( -- )
    0 0 WIDTH HEIGHT QD-Clear RECTANGLE
    20  HEIGHT 20 -  Move.To  ." RULE "  RULE @ .
    ROW WIDTH ERASE
    1 WIDTH 2/ ROW + C!
    HEIGHT 0 DO
        WIDTH 0 DO
            I ROW + C@ IF  I J DOT  THEN
            I ORIF WIDTH THEN 1- ROW + C@  2 LSHIFT ( 4a)
                I ROW + C@  1 LSHIFT  +             ( 4a+2b)
                I 1+ WIDTH MOD ROW + C@ +           ( 4a+2b+c)
                1 SWAP LSHIFT                       ( 1 << 4a+2b+c)
                RULE @ AND ANDIF 1 THEN             ( 0 | 1)
            I Next-Row + C!                         ( )
        LOOP
        ROW WIDTH Next-Row WIDTH COMPARE 0=
            IF  BEEP  1000 MS  LEAVE  THEN
        Next-Row ROW WIDTH MOVE
      \ Get.Window FlushWindow  \  OS9 and OSX.
        1 MS
    LOOP ;

: WOLFRAM                   ( -- )
    256 0 DO
        I >GRAY RULE !
        Wolfram-Chart
    LOOP ;

\  The rest is all Power MacForth dependent.  It is stolen from
\  other tasks, and is ready to be stolen again.

45 CONSTANT  YSTART        \  According to taste.
8 CONSTANT   XSTART        \  According to taste.

CREATE  Work-Title  64 chars ALLOT
    S" WORK" Work-Title PLACE

New.Window  Work-Window
    Work-Title  Work-Window W.Title
    YSTART XSTART over HEIGHT + over WIDTH + Work-Window W.Bounds
    Close.Box   Work-Window W.Attributes
    Work-Window SYS.Window W.Behind

NEWTASK  Work-Task
    Work-Task ADDTASK

DEFER WORK

: Do-Nothing ;

: Work-Activate
    IF
        Init.Cursor
        BEGIN
            Do.Events DROP
        AGAIN
    THEN ;

Work-Window  On.Activate  Work-Activate
Work-Window  On.Update    Do-Nothing

: BKG.Work
    Work-Window Add.Window
    0 Work-Task
    1 1 _PenSize
    BLACK _PenPat
    ACTIVATE<
        Work-Window WINDOW
        WORK
    STOP> ;

' WOLFRAM IS WORK

BKG.Work

\\  ***********************  End of WOLFRAM  ************************