crystals.ps

% Nicolas Seriot, seriot.ch
% 2025-06-25
% inspired by https://nedbatchelder.com/blog/202506/math_factoid_of_the_day_63.html

/E 28 def % cube edge
/O  6 def % cube offset % g 2 mul
/S 32 def % world edge size

/space [ S S S mul mul {0} repeat ] def

/_m_g_DrawSide {
    gsave
    concat
    0 0 s O sub s O sub rectfill
    0 setgray
    0.2 setlinewidth
    0 0 s O sub s O sub rectstroke
    grestore
} def

/_s_DrawCube {
    /s exch def
    
    gsave
    [currentrgbcolor] {0.9 mul} forall setrgbcolor
    [  1  0.5 -1   0.5 0 0 ] _m_g_DrawSide % top
    grestore

    gsave
    [currentrgbcolor] {0.8 mul} forall setrgbcolor
    [  1  0.5  0  -1   0 0 ] _m_g_DrawSide % right
    grestore

    gsave
    [ -1  0.5  0  -1   0 0 ] _m_g_DrawSide % left
    grestore
} def

/_x_y_z_DrawCube {
    /cz exch def
    /cy exch def
    /cx exch def
    
    gsave

    cx E mul cy E mul sub % x
    cx E 2 div neg mul cy E 2 div mul sub cz E mul add % y
    translate
    
    currentrgbcolor /B exch def /G exch def /R exch def
    cy S div cz S div 0.6 mul add cx S div 0.1 mul sub R mul
    cy S div cz S div 0.6 mul add cx S div 0.1 mul sub G mul
    cy S div cz S div 0.6 mul add cx S div 0.1 mul sub B mul
    setrgbcolor

    E _s_DrawCube
        
    grestore
} def

/_x_y_z_3DTo1D_i_ { S S mul mul exch S mul add add } def

/_i_1DTo3D_x_y_z_ { dup S mod exch dup S idiv S mod exch S S mul idiv } def

/_i_AddNeighboursToCube {
    _i_1DTo3D_x_y_z_ /z_ exch def /y_ exch def /x_ exch def    
        
    [ [x_ 1 sub y_ z_] [x_ 1 add y_ z_]
      [x_ y_ 1 sub z_] [x_ y_ 1 add z_]
      [x_ y_ z_ 1 sub] [x_ y_ z_ 1 add] ]
    {
        aload pop
        _x_y_z_3DTo1D_i_
        /i exch def        
        i 0 ge i space length 1 sub le and
        { space i get 0 eq { space i gen 1 add put } if }
        { (-- out of bounds) == }
        ifelse
    } forall    
} def

/AddNeighbours {
    0 1 space length 1 sub { /i exch def
        /g space i get def
        gen g eq { i _i_AddNeighboursToCube } if
    } for
} def

/DrawSpace {
    0 1 space length 1 sub { /i exch def
        /g space i get def

        g 0 gt {            
            g  1 eq { 1     1   0   setrgbcolor } if
            g  2 eq { 0     1   1   setrgbcolor } if
            g  3 eq { 1     0   1   setrgbcolor } if 
            g  4 eq { 0     1   0   setrgbcolor } if
            g  5 eq { 0.8   0.6 0   setrgbcolor } if
            g  6 eq { 0     0.5 1   setrgbcolor } if
            g  7 eq { 1     1   1   setrgbcolor } if
            g  8 eq { 0.5   1   1   setrgbcolor } if
            g  9 eq { 1     0   0.5 setrgbcolor } if
            g 10 eq { 0     1   0.5 setrgbcolor } if
            i _i_1DTo3D_x_y_z_ _x_y_z_DrawCube
        } if
    } for    
} def

space 28 23 27 _x_y_z_3DTo1D_i_ 1 put
space 18 19 21 _x_y_z_3DTo1D_i_ 1 put
space 12  9 20 _x_y_z_3DTo1D_i_ 1 put

1 1 10 {
    /gen exch def
    300 400 translate
    DrawSpace
    (Gen: ) =only gen =only (, cubes: ) =only 0 space { 0 ne { 1 add } if } forall ==
    showpage
    AddNeighbours
} for