Deconstructive Analysis: Barnett Newman's Stations of the Cross

A Formalist Approach to Encoding the Structural Descriptions of Art and the Art Making Process

Alan G. Turransky
Art Department
University of Massachusetts Amherst

"A tendency to concentrate on form as opposed to allegorical and photographic content, as an attempt to dismiss the overlaying of metaphors and to regard the work of art as hermetically sealed. The idea of building a painting from a series of basic elements, an analytical, almost laboratorial interpretation of art. Punin, a Formalist art critic, went on to assert that the only way in which the artist could create a new artistic value (an original work of art) was to apply his intuition not to the systems or constructions already known, but to the series of mechanical, technical and aesthetic principles which formed the substructure of any invented phenomenon."
-John E. Bowlt, Russian Formalism and the Visual Arts

Have you ever tried to teach your native language to a foriegner? Native speakers often find that it is extremely difficult to do so due to the fact that since there are so many different levels of information contained within the language, it is often difficult to structure them for the purpose of teaching. The grammar, style, interpretation and many other aspects intertwine themselves so integrally, that by separating them at the wrong juncture can harm their meaning and power. Yet, for the purpose of teaching, it is necessary to separate and abstract these components of the language into simplistic interpretations, from which a base may be formed, providing the necessary tools and constructs needed to work with it. Once this low-level knowledge is obtained and understood, the language is reduced to a tool and one is able to go beyond mere words and phrases to really explore the artistic qualities it has to offer. This also holds true in art and the art making process. An artist must have the necessary knowledge at the low-level before the high-level creative act may be fully investigated. Once the low-level knowledge is acquired, it becomes a suitable tool for the execution of creative ideas; but until they are overcome and comprehended, they can be restrictive to the artist.


;******************************************************************
; File:         Stations of the Cross
; Author:       Alan Turransky
; Created:      02-Sept-90
; Language:     LISP
; Packages:     Artifex 0.6 (c) Raymond G. Lauzzana
;               Macintosh Allegro Common LISP (c) Coral Software 
;
; Description:  Barnett Newnam's series, the Stations of the Cross
;               is classified as a Shape Grammar.  Two sets of rules
;               are defined; one that specifically classifies the
;               original Stations, and one that creates new Stations
;               which adhere to the same artistic style of the originals.
;
; (c) Copyright 1990, by Alan G. Turransky
;                        Department of Art, Computer Graphics Section
;                        University of Massachusetts
;                        Amherst, Massachusetts 01003
; All rights reserved.
;
; This software was conceived, designed, and written by Alan G. Turransky,
; in conjunction with Raymond G. Lauzzana's Shape Grammar interpreter Artifex. 
;
; I wish to acknowledge the generous support, knowledge and patience of the following people:
;
; Ray Lauzzana, who without him this project probably wouldn't have been possible;
; Beverly Woolf for her knowledge of LISP and her 'artistic' qualities that made me see
; certian aspects of Newman's work that I had missed;
; Russell Kirsch and Robert Mallary for their 'computer generated art' inspiration and enthusiasm;
; and Louise Bloomberg for her knowledge of Barnett Newman.
;******************************************************************

; management

(def-logical-pathname "h" 
  (directory-namestring (user-homedir-pathname)))
(def-logical-pathname"CLIB" "h;CLIB:")
(def-logical-pathname"LLIB" "h;LLIB:")
(def-logical-pathname"Artifex" "h;")
(load "LLIB;RESTORE")                                              ; loads necessary Artifex files.

;******************************************************************
;           symbols for newman's stations of the cross
;                     (c) turransky 1990
; in conjunction with artifex 0.6 (c) raymond g. lauzzana 1989 1990
;******************************************************************

; NOTE: ALL POINTS AND COORDINATES ARE REFERENCED OFF THE POINT P.

(defvar p (@@ 250 315))                                            ; set center point of picture to be a constant.

;******************************************************************

; canvas symbols.
; all call the primitive 'canvas'.

(defun canvas ()                                                   ; rectangular primitive.
  (let ((i (i-coord p))(j (j-coord p)))
    (rectangle (@@ (- i 215)(- j 150))
               (@@ (+ i 215)(+ j 150)))))

(defsymbol bcs ()                                                  ; blank canvas space - initial state.
  (canvas))

(defsymbol border ()                                               ; framing element.
  (canvas))

(defsymbol comp1 ()                                                ; used for a control structure test. 
  (canvas))

(defsymbol comp2 ()                                                ; used for a control structure test.
  (canvas))

(defsymbol comp3 ()                                                ; used for a control structure test.
  (canvas))

(defsymbol comp4 ()                                                ; used for a control structure test.
  (canvas))

(defsymbol cleaning-border ()                                      ; cleans up border area from bleeds.
  (let ((i (i-coord p))(j (j-coord p)))
    (rectangle (@@ (- i 235)(- j 170))
               (@@ (+ i 235)(+ j 170))
               :pen (@@ 20 20)
               :clr (rgb 130 130 130))))

;******************************************************************

(defsymbol l-region ()                                             ; left-region.
  (let ((i (i-coord p))(j (j-coord p)))                             
    (rectangle (@@ (- i 215)(- j 150))
               (@@ (+ i 215)(- j 118)))))

;******************************************************************

; o-regions.
; all call the primitive 'o-region-rect'.

(defun o-region-rect ()                                            ; other-region primitive.
  (let ((i (i-coord p))(j (j-coord p)))
    (line (@@ (- i 215)(- j 119))
          (@@ (- i 215)(+ j 149))
          (@@ (+ i 214)(+ j 149))
          (@@ (+ i 214)(- j 119)))))

(defsymbol o-region ()                                             ; other-region.
  (o-region-rect))

(defsymbol special-o-region ()                                     ; sepcial other-region.
  (o-region-rect))

(defsymbol terminal-o-region ()                                    ; other-region.
  (o-region-rect))

(defsymbol 2nd-o-region ()                                         ; second other-region.
  (o-region-rect))

;******************************************************************

; r-regions.                                                       
; all r-regions call the primitive 'r-region-rect'.

(defun r-region-rect ()                                            ; right-region primitive.                        
  (let ((i (i-coord p))(j (j-coord p)))                            
    (rectangle (@@ (- i 215)(+ j 62))                               
               (@@ (+ i 215)(+ j 150)))))

(defsymbol r-region ()                                             ; right-region.
  (r-region-rect))

(defsymbol special-r-region ()                                     ; special right-region.
  (r-region-rect))

(defsymbol terminal-r-region ()                                    ; right-region.
  (r-region-rect))

(defsymbol tiny-r-region ()                                        ; tiny right-region.
  (let ((i (i-coord p))(j (j-coord p)))                            
    (rectangle (@@ (- i 215)(+ j 64))                               
               (@@ (+ i 215)(+ j 150)))))

;******************************************************************

; single pixel lines that
; all call the primitive 'lin'.

(defun lin (n)                                                     ; line primitive.  
  (let ((i (i-coord p))(j (j-coord p)))
    (line (@@ (- i 215)(+ j n))
          (@@ (+ i 214)(+ j n)))))

(defsymbol ll ()                                                   ; left-line.
  (lin -119))

(defsymbol l-border ()                                             ; left borber line.
  (lin -150))

(defsymbol rl ()                                                   ; right-line.
  (lin 62))

(defsymbol special-rl ()                                           ; special right-line.
  (lin 62))

(defsymbol r-border ()                                             ; right border line.
  (lin 149))

(defsymbol decorative-rl (:number n)                               ; decorative right-line.
  (lin n))

(defsymbol spl (:number n)                                         ; single pixel line.
  (lin n))                                                 

(defsymbol special-ll ()                                           ; special left-line.
  (lin -119))

(defsymbol l-o-border ()                                           ; left-line/ other-region border line.
  (lin -119))

(defsymbol o-r-border ()                                           ; other-region/ right-line border line.
  (lin 62))                                                       

(defsymbol 2nd-rl (:number n)                                      ; second right-line.
  (lin n))

(defsymbol 2nd-rl-wide ()                                          ; second right-line used in conjunction with a decorative right-line.
  (2nd-rl 102))

(defsymbol 2nd-rl-medium ()                                        ; second right-line used in conjunction with a pin-tape.
  (2nd-rl 92))

(defsymbol 2nd-rl-small ()                                         ; second right-line used in conjunction with a masking-tape.
  (2nd-rl 82))

(defsymbol 2nd-rl-tiny ()                                          ; second right-line used in conjunction with a single pixel line.
  (2nd-rl 64))

;******************************************************************

; bleed lines.                                    

(defun bleed-line (n a)                                            ; bleed line primitive that uses splines.                      
  (let* ((i (i-coord p))(j (j-coord p))
         (pnt1 (@@ (- i 215)(+ j n)))
         (count 45)(x 215)
         p1 p2 pnt2 stpnt endpnt)
    (loop 
      (if (equal count 0)(return nil))
      (setf p1 (@@ (- i x)(+ j n)))
      (setf p2 (@@ (- i (+ x 30))(+ j (+ n a))))
      (setf pnt2 (rand-in-box p1 p2))
      (setf stpnt (rand-in-box p1 p2))
      (setf endpnt (rand-in-box p1 p2))
      (spline stpnt pnt1 pnt2 endpnt)
      (setf pnt1 pnt2)
      (setf x (- x 10))
      (setf count (- count 1)))))

(defsymbol bleed (:number n :number a)                             ; bleed-line symbol.
  (bleed-line n a)
  (cleaning-border))

(defsymbol l-o-border-bleed ()                                     ; left-line/ other-region bleed-line. 
  (bleed -112 15)
  (cleaning-border))

(defsymbol o-rl-border ()                                          ; other-region/ right-line bleed-line.
  (bleed 72 10)
  (cleaning-border))

;******************************************************************

(defsymbol pt (:number n)                                          ; pin-tape.
  (let ((i (i-coord p))(j (j-coord p)))
    (rectangle (@@ (- i 215)(+ j n))
               (@@ (+ i 215)(+ j (+ n 5))))))
      
(defsymbol r-pt (:number n)                                        ; right pin-tape.                          
  (pt n))

;******************************************************************

(defsymbol mt (:number n)                                          ; masking-tape.
  (let ((i (i-coord p))(j (j-coord p)))
    (rectangle (@@ (- i 215)(+ j n))
               (@@ (+ i 215)(+ j (+ n 10))))))

(defsymbol r-mt (:number n)                                        ; right masking tape.
  (mt n))

;******************************************************************

(defsymbol 2xmt (:number n)                                        ; double width masking-tape.
  (let ((i (i-coord p))(j (j-coord p)))
    (rectangle (@@ (- i 215) (+ j n))
               (@@ (+ i 215)(+ j (+ n 20))))))
                 
(defsymbol medium-band ()                                          ; medium-band that occurs to the                                     
  (let ((i (i-coord p))(j (j-coord p)))                            ; right of the right-line.
    (rectangle (@@ (- i 215)(+ j 62))
               (@@ (+ i 215)(+ j 92)))))

(defsymbol thick-band ()                                           ; thick-band that occurs to the                                        
  (let ((i (i-coord p))(j (j-coord p)))                            ; left of the right-line.
    (rectangle (@@ (- i 215)(+ j 10))
               (@@ (+ i 215)(+ j 63)))))


;******************************************************************
;         rules for newman's stations of the cross 
;                  (c) turransky 1990 
; in conjunction with artifex 0.6 (c) raymond g. lauzzana 1989 1990 
;******************************************************************

(defrule choose-composition ()                                     ; choose type of composition.
  (bcs) -> (one                                                    ; used for control structure test.
            (60 (comp1))
            (20 (comp2))
            (10 (comp3))
            (10 (comp4))))

(defrule transform-comp1 ()                                        ; composition of type one for original stations.
  (comp1) -> (list 
              (border)
              (l-region)
              (o-region)))

;******************************************************************

(defrule transform-comp2 ()                                        ; composition of type two for original stations.
  (comp2) -> (list 
              (border)
              (l-region)
              (special-rl)
              (r-region)))

(defrule transform-comp2-ver2 ()                                   ; composition of type two for new stations.
  (comp2) -> (list 
              (border)
              (ll)
              (o-region)))

;******************************************************************

(defrule transform-comp3 ()                                        ; composition of type three for original stations.
  (comp3) -> (list 
              (border)
              (ll)
              (special-o-region)))

(defrule transform-comp3-ver2 ()                                   ; composition of type three for original stations.
  (comp3) -> (list 
              (border)
              (special-ll)
              (special-o-region)))

;******************************************************************

(defrule transform-comp4 ()                                        ; composition of type four original and new stations.
  (comp4) -> (list 
              (border)
              (l-border)
              (r-border)))

;******************************************************************

; o-region transformations.

(defrule transform-o-region ()                                     ; used for original stations.
  (o-region) -> (one
                 (90 (rl))
                 (10 (terminal-o-region))))

(defrule transform-o-region-ver2 ()                                ; used for new stations.                                    
  (o-region) -> (one
                 (48 (list 
                      (rl) 
                      (terminal-o-region)))                   
                 (37 (list 
                      (rl) 
                      (r-region) 
                      (terminal-o-region)))
                 (9  (list 
                      (rl) 
                      (special-r-region) 
                      (terminal-o-region)))
                 (6  (terminal-o-region))))

(defrule transform-special-o-region ()                             ; used for new stations.                                              
  (special-o-region) -> (list
                         (terminal-o-region)
                         (spl 62)
                         (l-o-border-bleed)))

(defrule transform-special-o-region-bleed ()                       ; used for original stations. other-region transformation
  (special-o-region) -> (spl 62))                                  ; when the left-line has been transformed into a bleed-line.

(defrule transform-special-o-region-pt ()                          ; used for original stations.  other-region transformation
  (special-o-region) -> (list                                      ; when the left-line has been transformed into a pin-tape.
                         (spl 62)
                         (tiny-r-region)))

(defrule transform-special-o-region-mt ()                          ; used for original stations. other-region transformation
  (special-o-region) -> (one                                       ; when the left-line has been transformed into a masking-tape.
                         (50 (list
                              (l-o-border-bleed)
                              (spl 62)))
                         (50 (list
                              (mt 62)
                              (o-rl-border)))))

;******************************************************************

; various rl/ 2nd-rl transformations.

(defrule transform-rl ()                                           ; used for original stations.                                                       
  (rl) -> (one
           (40 (decorative-rl 62))                   
           (40 (mt 62))                                         
           (10 (medium-band))
           (10 (thick-band))))

(defrule transform-rl-ver2 ()                                      ; used for new stations.
  (rl) -> (one
           (30 (decorative-rl 62))
           (30 (r-mt 62))
           (20 (r-pt 62))
           (10 (medium-band))
           (9  (thick-band))
           (1  (spl 62))))

(defrule transform-special-rl ()                                   ; used for new stations.
  (special-rl) -> (one
                   (50 (pt 62))                   
                   (50 (mt 62))))

(defrule transform-decorative-rl ()                                ; used for original stations.                                                     
  (decorative-rl) -> (one
                      (33 (list 
                           (bleed 62 -20)
                           (mt 62)
                           (bleed 72 20)))  
                      (33 (list 
                           (pt 57)
                           (mt 62)
                           (2xmt 72)))
                      (34 (list 
                           (bleed 42 -5)
                           (mt 62)
                           (bleed 72 10)))))

(defrule transform-2nd-decorative-rl ()                            ; used for original stations.                                                     
  (decorative-rl) -> (list 
                           (bleed 102 -10)
                           (mt 102)
                           (bleed 112 10)))

(defrule transform-2nd-rl-wide ()                                  ; used for new stations.                                                       
  (2nd-rl-wide) -> (one
                 (25 (decorative-rl 102))
                 (25 (r-mt 102))
                 (25 (r-pt 102))                   
                 (25 (spl 102))))

(defrule transform-2nd-rl-medium ()                                ; used for new stations.                                                       
  (2nd-rl-medium) -> (one
                 (25 (decorative-rl 92))
                 (25 (r-mt 92))
                 (25 (r-pt 92))                   
                 (25 (spl 92))))

(defrule transform-2nd-rl-small ()                                 ; used for new stations.                                                       
  (2nd-rl-small) -> (one
                 (25 (decorative-rl 82))
                 (25 (r-mt 82))
                 (25 (r-pt 82))                   
                 (25 (spl 82))))

(defrule transform-2nd-rl-tiny ()                                  ; used for new stations.                                                       
  (2nd-rl-tiny) -> (one
                    (25 (decorative-rl 64))
                    (25 (r-mt 64))
                    (25 (r-pt 64))                   
                    (25 (spl 64))))                                        

;******************************************************************

; r-region transformations.

(defrule transform-r-region ()                                     ; used for new stations.                                    
  (r-region) -> (one
                 (25 (list 
                      (2nd-rl-wide)
                      (terminal-r-region)))                   
                 (25 (list 
                      (2nd-rl-medium)
                      (terminal-r-region)))
                 (25 (list 
                      (2nd-rl-small)
                      (terminal-r-region)))                     
                 (25 (list 
                      (2nd-rl-tiny)
                      (terminal-r-region)))))

(defrule transform-r-region-wide ()                                ; used for original stations.
  (r-region) -> (decorative-rl 102))

(defrule transform-r-region-medium ()                              ; used for original stations.
  (r-region) -> (pt 92))

(defrule transform-r-region-small ()                               ; used for original stations.
  (r-region) -> (mt 82))

(defrule transform-special-r-region ()                             ; used for new stations.                                              
  (special-r-region) -> (list
                         (terminal-r-region)
                         (o-r-border)))

;******************************************************************

; ll transformations.
(defrule transform-ll ()                                           ; used for original and new stations.            
  (ll) -> (one
           (33 (bleed -119 10))                                     
           (33 (mt -119))
           (34 (pt -119))))

(defrule transform-special-ll ()                                   ; used for new stations.                                                       
  (special-ll) -> (one                                                
                   (50 (mt -119))
                   (50 (pt -119))))

;******************************************************************

; border transformations.

(defrule transform-l-border ()                                     ; used for original and new stations.                                              
  (l-border) -> (mt -150))

(defrule transform-r-border ()                                     ; used for original and new stations.                                              
  (r-border) -> (bleed 149 -15))

(defrule transform-o-r-border ()                                   ; used for new stations.                                              
  (o-r-border) -> (bleed 72 20))

(defrule transform-l-o-border ()                                   ; used for new stations.
  (l-o-border) -> (l-o-border-bleed))

;******************************************************************
;      control structure for newman's stations of the cross 
;                    (c) turransky 1990 
; in conjunction with artifex 0.6 (c) raymond g. lauzzana 1989 1990 
;******************************************************************

; control structure helping functions.


(defun show-history ()                                             ; prints out what is currently in the display list.
  (terpri)(princ  *current-display-list*)(terpri))

(defun show-and-return ()                                          
  (show-history)(terpri))

(defun test-element (item)                                         ; tests to see if an item is in the current display list.
  (member item (mapcar 'car *current-display-list*)))

(defun ll-casetest (item)                                          ; tests to see what the left-line has been transformed 
  (case item                                                       ; into and calls the corresponding other-region transformation.
    (bleed (fire-rule 'transform-special-o-region-bleed))
    (mt    (fire-rule 'transform-special-o-region-mt))
    (pt    (fire-rule 'transform-special-o-region-pt))))

(defun special-rl-casetest (item)                                  ; tests to see what the right-line has been transformed 
  (case item                                                       ; into and calls the corresponding right-region transformation.
    (mt (one
         (50 (fire-rule 'transform-r-region-wide))
         (50 (fire-rule 'transform-r-region-small))))
    (pt (fire-rule 'transform-r-region-medium))))

(defun supercasetest2 ()                                           ; checks the positioning of the second right-line and calls
  (terpri)                                                         ; the corresponding second right-line casetest2 transformation.
  (princ '(2nd-rl-supercase-test))
  (terpri)
  (cond
   ((test-element '2nd-rl-wide)
    (casetest2 '2nd-rl-wide))
   ((test-element '2nd-rl-medium)
    (casetest2 '2nd-rl-medium))
   ((test-element '2nd-rl-small)
    (casetest2 '2nd-rl-small))
   (t
    (casetest2 '2nd-rl-tiny))))

(defun casetest2 (item)                                            ; fires corresponding special-r-region/ second-rl transformations.
  (case item
    (2nd-rl-wide 
     (list (fire-rule 'transform-2nd-rl-wide)
           (terpri)
           (princ '(transform-2nd-rl-wide))
           (show-history)))
    (2nd-rl-medium 
     (list (fire-rule 'transform-2nd-rl-medium)         
           (terpri)
           (princ '(transform-2nd-rl-medium))  
           (show-history)))
    (2nd-rl-small 
     (list (fire-rule 'transform-2nd-rl-small)     
           (terpri)
           (princ '(transform-2nd-rl-small))     
           (show-history)))
    (2nd-rl-tiny 
     (list (fire-rule 'transform-2nd-rl-tiny)     
           (terpri)(princ '(transform-2nd-rl-tiny))    
           (show-history)))))

(defun draw-initial-state ()                                       ; used for original stations.  transformation of the initial state.
  (fire-rule 'choose-composition)
  (princ '(choose-composition))
  (show-and-return))

(defun draw-initial-state-ver2 ()                                  ; used for new stations.  transformation of the initial state.
  (fire-rule 'choose-composition)                      
  (terpri)
  (princ '(choose-composition))     
  (show-history))

(defun draw-comp1 ()                                               ; used for original stations.  transforms the initial state
  (fire-rule 'transform-comp1)
  (princ '(transform-comp1))
  (show-and-return)
  (fire-rule 'transform-o-region)
  (princ '(transform-o-region))
  (show-and-return)
  (if
    (test-element 'rl) 
    (list
     (fire-rule 'transform-rl)
     (princ '(transform-rl))
     (show-and-return)
     (if 
       (test-element 'decorative-rl)
       (fire-rule 'transform-decorative-rl)))))

(defun draw-comp1-ver2 ()                                          ; used for new stations.  transforms the initial state
  (fire-rule 'transform-comp1)     
  (terpri)
  (princ '(transform-comp1)) 
  (show-history))

(defun draw-comp2 ()                                               ; used for original stations.  transforms the initial state
  (fire-rule 'transform-comp2)
  (princ '(transform-comp2))
  (show-and-return)
  (fire-rule 'transform-special-rl)
  (princ '(transform-special-rl))
  (show-and-return)
  (if
    (test-element 'mt) 
    (list
     (special-rl-casetest 'mt)
     (princ '(special-rl-casetest 'mt))
     (show-and-return)
     (if 
       (test-element 'decorative-rl)
       (fire-rule 'transform-2nd-decorative-rl)))
    (list
     (special-rl-casetest 'pt)
     (princ '(special-rl-casetest 'pt))
     (show-and-return))))

(defun draw-comp2-ver2 ()                                          ; used for new stations.  transforms the initial state
  (fire-rule 'transform-comp2-ver2)        
  (terpri)
  (princ '(transform-comp2-ver2)) 
  (show-history)
  (fire-rule 'transform-ll)  
  (terpri)
  (princ '(transform-ll))           
  (show-history))

(defun draw-comp3 ()                                               ; used for original stations.  transforms the initial state
  (fire-rule 'transform-comp3)                                     ; into a composition of type 3.
  (princ '(transform-comp3))
  (show-and-return)
  (fire-rule 'transform-ll)
  (princ '(transform-ll))
  (show-and-return)
  (cond
   ((test-element 'bleed)
    (list
     (ll-casetest 'bleed)
     (princ '(ll-casetest 'bleed))
     (show-and-return)))
   ((test-element 'pt)
    (list
     (ll-casetest 'pt)
     (princ '(ll-casetest 'pt))
     (show-and-return)))
   (t
    (list
     (ll-casetest 'mt)
     (princ '(ll-casetest 'mt))
     (show-and-return)))))

(defun draw-comp3-ver2 ()                                          ; used for new stations.  transforms the initial state
  (fire-rule 'transform-comp3-ver2)                                ; into a composition of type 3.                      
  (terpri)
  (princ '(transform-comp3-ver2))         
  (show-history)
  (fire-rule 'transform-special-ll)  
  (terpri)
  (princ '(transform-special-ll))     
  (show-history)
  (fire-rule 'transform-special-o-region)   
  (terpri)
  (princ '(transform-special-o-region))
  (show-history)
  (fire-rule 'transform-l-o-border)   
  (terpri)
  (princ '(transform-l-o-border))          
  (show-history))

(defun draw-comp4 ()                                               ; used for original and new stations.  transforms the 
  (fire-rule 'transform-comp4)                                     ; initial state into a composition of type 4.
  (princ '(transform-comp4))
  (show-and-return)
  (fire-rule 'transform-l-border)
  (princ '(transform-l-border))
  (show-and-return)
  (fire-rule 'transform-r-border)
  (princ '(transform-r-border))
  (show-and-return))

(defun draw-o-region ()                                            ; used for new stations.
  (fire-rule 'transform-o-region-ver2)   
  (terpri)
  (princ '(transform-o-region-ver2))   
  (show-history))

(defun draw-rl ()                                                  ; used for new stations.
  (fire-rule 'transform-rl-ver2)   
  (terpri)
  (princ '(transform-rl-ver2))            
  (show-history))

(defun draw-special-r-region ()                                    ; used for new stations.
  (fire-rule 'transform-special-r-region)     
  (terpri)
  (princ '(transform-special-r-region)) 
  (show-history)
  (if 
    (test-element 'o-r-border)
    (list 
     (fire-rule 'transform-o-r-border)  
     (terpri)
     (princ '(transform-o-r-border))  
     (show-history))))

(defun draw-r-region ()                                            ; used for new stations.
  (fire-rule 'transform-r-region) 
  (terpri)
  (princ '(transform-r-region))     
  (show-history)
  (supercasetest2))

(defun draw-dec-rl ()                                              ; used for new stations.
  (fire-rule 'transform-decorative-rl)    
  (terpri)
  (princ '(transform-decorative-rl))
  (show-history))

;******************************************************************

; initial structure.

(definit
  (erase-display)                                                  ; clear screen.
  (get-user-item 'bcs))                                            ; replace display with the initial state.

;******************************************************************

; control structure.

(defcontrol
  (if (equal csnum 1)                                              ; if csnum equals 1 then the original stations rules are fired.
    (list                                                          ; begin list of original stations rules.
     (terpri)(terpri)(terpri)(terpri)
     (if
       (test-element 'bcs)
       (list
        (draw-initial-state)
        (cond
         ((test-element 'comp4) 
          (draw-comp4))
         ((test-element 'comp3) 
          (draw-comp3))
         ((test-element 'comp2) 
          (draw-comp2))
         (t                     
          (draw-comp1)))
        (princ '(terminal-symbols))
        (show-history)))))                                         ; end list of original stations rules.
  (if (equal csnum 2)                                              ; if csnum equals 2 then the new stations rules are fired.
    (list                                                          ; begin list of new stations rules.
     (terpri)(terpri)(terpri)(terpri)
     (if (test-element 'bcs)
       (list
        (draw-initial-state-ver2)
        (cond
         ((test-element 'comp4)
          (draw-comp4))
         ((test-element 'comp3)
          (draw-comp3-ver2))
         (t
          (list
           (if (test-element 'comp2)
             (draw-comp2-ver2))
           (if (test-element 'comp1)
             (draw-comp1-ver2))
           (if (test-element 'o-region)
             (draw-o-region))
           (if (test-element 'rl)
             (draw-rl))
           (if
             (test-element 'special-r-region)
             (draw-special-r-region))
           (if
             (test-element 'r-region)
             (draw-r-region))
           (if
             (test-element 'decorative-rl)
             (draw-dec-rl))
           (terpri)
           (princ '(terminal-symbols))
           (show-history)))))))))                                  ; end list of new stations rules.

;******************************************************************

; termination structure.

(defend nil)

;******************************************************************


;******************************************************************
;         menus for the stations of the cross 
;                  (c) turransky 1990 
; in conjunction with artifex 0.6 (c) raymond g. lauzzana 1989 1990 
;******************************************************************

(defvar csnum 0)                                                   ; variable used in control structure test.

;******************************************************************

; OPENING-STATEMENT

(defun opening-statement ()
"
  OPENING-STATEMENT ()

  Giving credit to the one person who deserives it.
"

(modal-dialog
   (oneof *dialog*
          :window-size #@(350 150)
          :window-position '(:top 100)
          :window-type :double-edge-box
          :window-show nil
          :dialog-items
          (list (oneof *static-text-dialog-item*
                       :dialog-item-font '("New York" 24 :bold)
                       :dialog-item-position #@(4 5)
                       :dialog-item-text "Stations of the Cross" )
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 12 :plain)
                       :dialog-item-position #@(4 35)
                       :dialog-item-text "   The Stations of the Cross is a program that works")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 12 :plain)
                       :dialog-item-position #@(4 50)
                       :dialog-item-text "  in conjunction with the shape grammar interpreter")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 12 :bold)
                       :dialog-item-position #@(4 65)
                       :dialog-item-text
                       "      Artifex (c) Raymond G. Lauzzana 1990.")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 12 :plain)
                       :dialog-item-position #@(4 80)
                       :dialog-item-text
                       " Without Artifex, or more importantly the knowledge")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 12 :plain)
                       :dialog-item-position #@(4 95)
                       :dialog-item-text
                       "  and patience of Ray Lauzzana, this project would ")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 12 :plain)
                       :dialog-item-position #@(4 110)
                       :dialog-item-text
                       "                    have never been possible.")
                (oneof *button-dialog-item*
                       :dialog-item-text "OK"
                       :dialog-item-size #@(70 20)
                       :dialog-item-position #@(275 125)
                       :dialog-item-action
                       #'(lambda () (return-from-modal-dialog t))
                       :default-button t)))))

;******************************************************************

; ABOUT MENU

(defun ABOUT-STATIONS ()
"
  ABOUT-STATIONS ()
  
  Displays the documentation dialog about the Stations of the Cross.

"
  (modal-dialog
   (oneof *dialog*
          :window-size #@(300 150)
          :window-position '(:top 100)
          :window-type :double-edge-box
          :window-show nil
          :dialog-items
          (list (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 12 :bold)
                       :dialog-item-position #@(4 4)
                       :dialog-item-text "Stations of the Cross" )
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 12 :plain)
                       :dialog-item-position #@(4 20)
                       :dialog-item-text "An expert design rule system")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 12 :plain)
                       :dialog-item-position #@(4 35)
                       :dialog-item-text "for Barnett Newman's Stations of the Cross")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 10 :plain)
                       :dialog-item-position #@(4 67)
                       :dialog-item-text
                       "(c) copyright Alan Turransky 1990")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 10 :plain)
                       :dialog-item-position #@(4 80)
                       :dialog-item-text
                       "6 Cleveland Rd.")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 10 :plain)
                       :dialog-item-position #@(4 93)
                       :dialog-item-text
                       "Peabody, Ma 01960")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 10 :plain)
                       :dialog-item-position #@(4 106)
                       :dialog-item-text
                       "United States of America")
                (oneof *static-text-dialog-item*
                       :dialog-item-font '("Geneva" 10 :plain)
                       :dialog-item-position #@(4 126)
                       :dialog-item-text
                       "tel: (508) 535-0685")
                (oneof *button-dialog-item*
                       :dialog-item-text "OK"
                       :dialog-item-size #@(70 20)
                       :dialog-item-position #@(217 115)
                       :dialog-item-action
                       #'(lambda () (return-from-modal-dialog t))
                       :default-button t)))))

(ask  *apple-menu*
  (apply #'remove-menu-items (list (ult (menu-items)))))
(ask  *apple-menu*
  (add-menu-items
   (oneof *menu-item*
          :menu-item-action 'about-statements
          :menu-item-title "About STATIONS...")))

(defun about-statements ()
  (list (opening-statement)
        (about-stations)
        (about-artifex)))

;******************************************************************

; ORIGINAL-STATIONS MENU

(defobject *old-stations-menu* (oneof *menu* :menu-title "Original Stations"))

(ask  *old-stations-menu* 
  (add-menu-items 
   (oneof *menu-item*
          :menu-item-action '(first-station)
          :menu-item-title "First Station")
   (oneof *menu-item*
          :menu-item-action '(second-station)
          :menu-item-title "Second Station")
   (oneof *menu-item*
          :menu-item-action '(third-station)
          :menu-item-title "Third Station")
   (oneof *menu-item*
          :menu-item-action '(fourth-station)
          :menu-item-title "Fourth Station")
   (oneof *menu-item*
          :menu-item-action '(fifth-station)
          :menu-item-title "Fifth Station")
   (oneof *menu-item*
          :menu-item-action '(sixth-station)
          :menu-item-title "Sixth Station")
   (oneof *menu-item*
          :menu-item-action '(seventh-station)
          :menu-item-title "Seventh Station")
   (oneof *menu-item*
          :menu-item-action '(eighth-station)
          :menu-item-title "Eighth Station")
   (oneof *menu-item*
          :menu-item-action '(ninth-station)
          :menu-item-title "Ninth Station")
   (oneof *menu-item*
          :menu-item-action '(tenth-station)
          :menu-item-title "Tenth Station")
   (oneof *menu-item*
          :menu-item-action '(eleventh-station)
          :menu-item-title "Eleventh Station")
   (oneof *menu-item*
          :menu-item-action '(twelveth-station)
          :menu-item-title "Twelveth Station")
   (oneof *menu-item*
          :menu-item-action '(thirteenth-station)
          :menu-item-title "Thirteenth Station")
   (oneof *menu-item*
          :menu-item-action '(fourteenth-station)
          :menu-item-title "Fourteenth Station")
   (oneof *menu-item*
          :menu-item-action '(be2)
          :menu-item-title "Be II")
   *menu-sep*
   (oneof *menu-item*
          :menu-item-action '(generate-old 1)
          :menu-item-title "Generate Original Station(s)...")))

(defun generate-old (d)
    (setq csnum d)
    (generate))

;******************************************************************

; ADDITIONAL SYMBOLS USED IN FUNCTIONS FOR ORIGINAL STATIONS MENU

(defsymbol r-mt-menu ()
  (mt 62))

(defsymbol rl-mt ()
  (mt 82))

(defsymbol r-pt-menu ()
  (pt 62))

(defsymbol r-pt-wide ()
  (pt 92))

(defsymbol rl-spl-mt ()
  (spl 82))

(defsymbol rl-spl-pt ()
  (spl 92))

(defsymbol rl-spl-mt-wide ()
  (spl 102))

(defsymbol l-mt ()
  (mt -119))

(defsymbol l-pt ()
  (pt -119))

(defsymbol l-border-mt ()
  (mt -150))

(defsymbol dec-rl-1 ()
  (mt 62)(bleed 62 -10)(bleed 72 10))

(defsymbol dec-rl-2 ()
  (pt 57)(mt 62)(2xmt 72))

(defsymbol dec-rl-3 ()
  (mt 102)(bleed 102 -10)(bleed 112 10))

(defsymbol dec-rl-4 ()
  (bleed 42 -5)(mt 62)(bleed 72 10))

(defsymbol r-bleed ()
  (bleed 72 10)(cleaning-border))

(defsymbol r-border-bleed ()
  (bleed 149 -10)(cleaning-border))

(defsymbol ll-bleed ()
  (bleed -119 10)(cleaning-border))

(defsymbol ll-mt-bleed ()
  (bleed -109 20)(cleaning-border))

;******************************************************************

; FUNCTIONS FOR ORIGINAL STATIONS MENU

; first station.

(defun first-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'dec-rl-1)
  (repaint))

;******************************************************************

; second station.

(defun second-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'dec-rl-2)
  (repaint))

;******************************************************************

; third station.

(defun third-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'rl-spl-mt-wide)
  (get-user-item 'r-mt-menu)
  (get-user-item 'dec-rl-3)
  (repaint))

;******************************************************************

; fourth station.

(defun fourth-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'dec-rl-4)
  (repaint))

;******************************************************************

; fifth station.

(defun fifth-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll-bleed)
  (get-user-item 'rl)
  (repaint))

;******************************************************************

; sixth station.

(defun sixth-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'r-mt-menu)
  (repaint))

;******************************************************************

; seventh station.

(defun seventh-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'l-pt)
  (get-user-item 'tiny-r-region)
  (repaint))

;******************************************************************

; eighth station.

(defun eighth-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'medium-band))

;******************************************************************

; ninth station.

(defun ninth-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'rl-spl-mt)
  (get-user-item 'r-mt-menu)
  (get-user-item 'rl-mt))

;******************************************************************

; tenth station.

(defun tenth-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'l-mt)
  (get-user-item 'll-mt-bleed))

;******************************************************************

; eleventh station.

(defun eleventh-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'rl-spl-pt)
  (get-user-item 'r-pt-menu)
  (get-user-item 'r-pt-wide))

;******************************************************************

; twelveth station.

(defun twelveth-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'l-mt)
  (get-user-item 'r-mt-menu)
  (get-user-item 'r-bleed))

;******************************************************************

; thirteenth station.

(defun thirteenth-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll)
  (get-user-item 'rl)
  (get-user-item 'thick-band))

;******************************************************************

; fourteenth station.

(defun fourteenth-station ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'll))

;******************************************************************

; be II

(defun be2 ()
  (erase-display)
  (get-user-item 'border)
  (get-user-item 'l-border-mt)
  (get-user-item 'r-border-bleed))


;******************************************************************

; NEW-STATIONS MENU

(defobject *new-stations-menu* (oneof *menu* :menu-title "New Stations"))

(ask  *new-stations-menu* 
  (add-menu-items 
   (oneof *menu-item*
          :menu-item-action '(generate-new 2)
          :menu-item-title "Generate New Station(s)...")))

(defun generate-new (d)
    (setq csnum d)
    (generate))

;generate a series of stations

(defun generate ()
  (let ((num nil)(wait nil))
    (setf num (get-number :title "the number of Stations to be generated"))
    (loop 
      (if (equal num 0)(return nil))
      (auto-fire)
      (setf num (- num 1))
      (setf wait 200000)
      (loop 
        (if (equal wait 0)(return nil))
        (setf wait (- wait 1))))))

;******************************************************************

; MAIN MENUS

(setf *graphics-menubar*                                           ; reset menubar.
      (list *apple-menu*
            *revised-file-menu*
            *windows-menu*
            *symbols-menu*
            *rules-menu*
            *old-stations-menu*
            *new-stations-menu*))

(replace-display (opening-statement))
(repaint)