This is the grammar used to parse the three part gene shown earlier.

;;; -------------------------------------------------
;;;
;;; Created: 11/7/94
;;;        
;;; Nikos Nikolakis
;;;
;;;  A general grammar for parsing of Gene diagrams
;;; -------------------------------------------------


(defvar *sline-ratio* 6)
(defvar *small* 100)
(defvar *large* 1050)

   
(setf 
 *grammar*

 (defgrammar
   

   ( Gene-Diagram -> Set ( Gene ) );

   ;;; ******************** GENE ********************

   ( Gene -> Gene-body  Gene-Title  Tick-specifs
     (:optional Gene-Title Tick-specifs)
     (Gene-body)
     (Gene-Title  (difference* (intersect* (left '? Gene-body :entirely nil)
                                           (horiz-aligned-gen Gene-body :how-near (/ (height Gene-body) 1.5)))
                               (Backbone Gene-body)))
     (Tick-specifs  ($ (intersect* (touch '? Gene-body) (above&below '? Gene-body :strip t))
                        :segments (Segments Gene-body))) );

   ( Gene-Title -> Set ( Text ) );

   ( Gene-body -> Segments  Backbone
     (:optional Backbone)
     (Segments)
     (Backbone   (touch Segments '? :every t)
       :constraints 
       (left (left-endpoint (Line Backbone)) Segments)) );

;;; ****************** Tick-specifs ******************
   
   ( Tick-specifs -> set ( Tick-specif ) );

   ( Tick-specif -> Line  Close-or-Remote-Label
      (Line :constraints (vertp Line) (short Line) (not (polylinep Line)))
      (Close-or-Remote-Label ($ :line Line)) );

   ( Close-or-Remote-Label -> X-or < (Label (touch (get-val Line) '?)) (Label (vert-strip (get-val Line))) > );

   ( Label -> Text
           (Text
            :constraints 
            (not (member Text (solution->list (get-val Segments)))) ; ignore segment-title
            (or (and (below (center (get-val Line))  (center (get-val Segments))) (below (center Text)  (center (get-val Segments))))
                (and (above (center (get-val Line))  (center (get-val Segments))) (above (center Text)  (center (get-val Segments)))))          
            :select 
            (min (min (abs (- (a-point-x (center (get-val Line))) (a-point-x (center Text))))
                      (abs (- (a-point-x (center (get-val Line))) (a-point-x (ur-point Text))))
                      (abs (- (a-point-x (center (get-val Line))) (a-point-x (ll-point Text))))))) );

;;; ******************** BACKBONE ********************

( Backbone -> Line  Left-label  Right-label
   (:optional Left-label  Right-label)
   (Line  :constraints (horizp Line)  (long Line)  (not (polylinep Line)))
   (Left-label   (touch '? (left-endpoint Line))
                 :select (min (distance (center Left-label)  (left-endpoint Line))))
   (Right-label (touch '? (right-endpoint Line))
                :select (min (distance (center Right-label) (right-endpoint Line)))) );

( Left-label -> Text );

( Right-label -> Text );


;;; ******************** SEGMENTS ********************
   ( Segments -> Set ( Segment )
       (:constraint  horiz-aligned-gen) ); <--

   ( Segment -> Body  Divisions 
      (:optional Divisions)
      (Body :constraints  (< (height Body) *large*))
      (Divisions  ($ (contain Body '?)  :body Body  :width (width Body))) );


;;; ******************** BODY ********************
   ( Body -> Polygon   ; rectangle body
      (:constraints  (rectangle? Polygon)  (< (height Polygon) *large*)) );   
   
   ( Body -> Line_1  Line_2  ; body made from two horizontal lines 
     (Line_1 
        :constraints 
         (horizp Line_1)  (long Line_1 :ratio 7)  (not (polylinep Line_1)))
     (Line_2  (near Line_1 (/ (a-length Line_1) 4.0))
         :constraints  
         (horizp Line_2)  (long Line_2 :ratio 7)  (same-length Line_1 Line_2)
         (not (polylinep Line_2))  (below (center Line_2) (center Line_1))) );


;;; ******************** DIVISIONS ********************
  ( Divisions -> Set ( Division ) );


  ( Division -> Division-Marks  Division-Title
     (:optional Division-Title)
     (Division-Marks :constraints  (> (width Division-marks) *small*))
     (Division-Title 
          ($ (near (get-val Body) (get-val width))  :box Division-Marks)) );


  ( Division-Marks -> Pair ( Line )
      (:element-constraints (vertp Line)  (contained  Line (get-val body)))
      (:constraint  neighbor-pairs :direction 'x) );


;;; ******************** DIVISION-TITLE ********************
   ( Division-Title -> Set ( Text )
      (:element-constraints  (contained (center Text) (get-val box))) );
 
   )
)

		Back to gene example

		Back to Index page