# taxon.icn: Taxon object; see `Txny' object for context
#--

$define  TAXON_REVISION     "$Revision: 1.9 $"
$define  TAXON_DATE         "$Date: 1996/11/15 04:33:24 $"

#================================================================
# Class Taxon: Each instance describes the names and affinities
# of one taxon, that is, one taxonomic group of organisms.
# Examples:
#   Class Aves: the taxon containing all birds
#   _Falco peregrinus_: one species, the Peregrine Falcon.
#----------------------------------------------------------------
# EXPORTED METHODS
#----------------------------------------------------------------
# Taxon_New ( txny, parent, rank, sci, eng, tex, status, canon, disamb )
#   [ if the arguments satisfy the invariants of the corresponding
#     fields, and (parent) is a Taxon object ->
#       if parent is &null ->
#         return a new Taxon object with those fields
#       else ->
#         parent  :=  parent with a new first child consisting of
#                     a new Taxon object with those fields
#         return that new Taxon object
#   ]
#--
# Taxon_Txny ( self )
#   [ returns the Txny object containing self
#   ]
#--
# Taxon_Rank ( self )
#   [ returns the Rank object describing the rank of self
#   ]
#--
# Taxon_Sci ( self )
#   [ returns self's scientific name as a string
#   ]
#--
# Taxon_Eng ( self )
#   [ returns self's English name as a string
#   ]
#--
# Taxon_TeX ( self )
#   [ returns self's English name marked up for the TeX
#     typesetting system
#   ]
#--
# Taxon_Tx_Key ( self )
#   [ returns self's taxonomic key, a string of digits which
#     will sort self in phylogenetic order; the length will
#     be given by self's txny's hier's Hier_Tx_Key_Len() method
#   ]
#--
# Taxon_Short_Tx_Key ( self )
#   [ returns self's taxonomic key, a string of digits which
#     will sort self in phylogenetic order; the length will
#     vary, with all right zeroes dropped.
#   ]
#--
# Taxon_Status ( self )
#   [ if self's status is normal -> fail
#     else ->
#       returns a status code as a string
#   ]
#--
# Taxon_Canon ( self )
#   [ if self has a canonical abbreviation -> return that as a string
#     else -> fail
#   ]
#--
# Taxon_Disamb ( self )
#   [ if self has an unambiguous substitute abbreviation -> return it
#     else -> fail
#   ]
#--
# Taxon_Abbr ( self )
#	[ if self has an unambiguous substitute abbreviation ->
#       return that as an Abbr
#     else if self has a canonical abbreviation ->
#       return that as an Abbr
#     else -> fail
#	]
#--
# Taxon_Parent ( self )
#   [ if self has a parent -> return the parent Taxon object
#     else -> fail
#   ]
#--
# Taxon_N_Children ( self )
#   [ return the number of children of self, >= 0
#   ]
#--
# Taxon_Gen_Children ( self )
#   [ generate the child Taxon objects in birth order, if any
#   ]
#--
# Taxon_Nth_Child ( self, n )
#   [ if self has at least n children ->
#       return the Taxon whose birth order is n
#     else -> fail
#   ]
#--
# Taxon_Last_Child ( self )
#   [ if self has any children ->
#       return the child Taxon with the last birth order
#     else -> fail
#   ]
#--
# Taxon_Birth_Order ( self )
#   [ if self has no parent -> return 1
#     else ->
#       return self's birth order relative to the other children
#       of its parent, >= 1
#   ]
#--
# Taxon_Depth ( self )
#   [ return self's rank's depth
#   ]
#--
# Taxon_Show ( self )
#   [ return a string showing the English name, with the scientific
#     name following in square brackets
#   ]
#--


# - - -   State   - - -

  record taxonTag (
    txny,       # Back pointer to the containing Txny object
    rank,       # A Rank object describing the taxonomic level
    sci,        # Scientific name as a string
    eng,        # English name as a string
    tex,        # TeX-encoded English name as a string
    status,     # Status code: &null for normal, else a string
    canon,      # Canonical species/form abbreviation, or &null
    disamb,     # Unambiguous substitute abbreviation, or &null
    tree,       # A Tree object that links us to our relatives
    txKey )     # The taxonomic sort key, with right zeroes dropped

# - - -   Invariants   - - -

#--
# .txny == the Txny object containing self
#--
# .rank == a Rank object that represents the taxonomic level
#          of self, e.g., subfamily, species
#--
# .sci == a string
#--
# .eng == a string
#--
# .tex == a string
#--
# .status == a one-character string, one of:
#       "+" if the taxon is extinct
#       "?" if the taxon's status is questionable
#       &null otherwise
#--
# .canon ==
#       if self is a species or form ->
#         the abbreviation as formed by the rules, as an Abbr
#       else -> &null
#--
# .disamb ==
#       if self is a species or form and is involved in a collision ->
#         the unambiguous substitute abbreviation, as an Abbr
#       else -> &null
#--
# .tree == a Tree object whose value is self and whose parent's value
#       is self's parent Taxon object, if any, else &null, and whose
#       children have as values self's child Taxon objects
#--
# .txKey ==
#       if self.tree has a parent -> derived-tx-key(parent(self),self)
#       else -> &null
#--


# - - -   T a x o n _ N e w    - - -

#-- 1996-10-16: Verified, A. Stavely

procedure Taxon_New ( txny, parent, rank, sci, eng, tex, status,
                      canon, disamb )
  #-- 1 --
  #-[ parentTree  :=  &null
  #-]
  local self		# The new Tree object being returned
  local parentTree  # parent.tree, or &null if parent is &null

  #-- 2 --
  #-[ if parent is &null -> I
  #   else ->
  #     parentTree  :=  parent.tree
  #-]
  if  \ parent  then
    parentTree  :=  parent.tree;

  #-- 3 --
  #-[ self  :=  a new Taxon object with .txny (txny), .rank (rank),
  #             .sci (sci), .eng (eng), .tex (tex), .status (status),
  #             .canon (canon), .disamb (disamb), and other fields &null
  #-]
  self  :=  taxonTag ( );
  self.txny    :=  txny;
  self.rank    :=  rank;
  self.sci     :=  sci;
  self.eng     :=  eng;
  self.tex     :=  tex;
  self.status  :=  status;
  self.canon   :=  canon;
  self.disamb  :=  disamb;

  #-- 4 --
  #-[ self.tree  :=  a new Tree node, linked in as the next child
  #                  of (parentTree) if (parentTree) is not &null
  #-]
  self.tree    :=  Tree_New ( parentTree, self );

  #-- 5 --
  #-[ self.txKey  :=  derived-tx-key ( txny, parent, self )
  #-]
  Txny_Derive_Tx_Key ( txny, parent, self );

  #-- 6 --
  return self;
end # --- Taxon_New ---


# - - -   T a x o n _ T x n y   - - -

#-- 1996-08-13: Verified with Stavely

#   [ returns the Txny object containing self
#   ]

procedure Taxon_Txny ( self )
  return self.txny;
end


# - - -   T a x o n _ R a n k   - - -

#-- 1996-08-13: Verified with Stavely

#   [ returns the Rank object describing the rank of self
#   ]

procedure Taxon_Rank ( self )
  return self.rank;
end


# - - -   T a x o n _ S c i   - - -

#-- 1996-08-13: Verified with Stavely

#   [ returns self's scientific name as a string
#   ]

procedure Taxon_Sci ( self )
  return self.sci;
end


# - - -   T a x o n _ E n g   - - -

#-- 1996-08-13: Verified with Stavely

#   [ returns self's English name as a string
#   ]

procedure Taxon_Eng ( self )
  return self.eng;
end


# - - -   T a x o n _ T e X   - - -

#-- 1996-08-13: Verified with Stavely

#   [ returns self's English name marked up for the TeX
#     typesetting system
#   ]

procedure Taxon_TeX ( self )
  return self.tex;
end


# - - -   T a x o n _ T x _ K e y   - - -

#-- 1996-10-16: Verified, A. Stavely

procedure Taxon_Tx_Key ( self )
#--
# The left() function is used to supply right zeroes sufficient to
# bring it to length, the length being given by self's txny's hier's
# Hier_Tx_Key_Len() method.
#--
  return left ( self.txKey, 
                Hier_Tx_Key_Len ( Txny_Hier ( self.txny ) ),
                "0" );
end # --- Taxon_Tx_Key ---


# - - -   T a x o n _ S h o r t _ T x _ K e y   - - -

#-- Unverified

procedure Taxon_Short_Tx_Key ( self )
  return self.txKey;
end # --- Taxon_Tx_Key ---


# - - -   T a x o n _ S t a t u s   - - -

#-- 1996-08-13: Verified with Stavely

#   [ returns a status code, one of:
#       " " for normal status
#       "?" for questionable status
#       "+" for extinct status
#   ]

procedure Taxon_Status ( self )
  return self.status;
end


# - - -   T a x o n _ C a n o n   - - -

#-- 1996-08-13: Verified with Stavely

#   [ if self has a canonical abbreviation ->
#       return that as a string
#     else ->
#       fail
#   ]

procedure Taxon_Canon ( self )
  return  \ self.canon;
end


# - - -   T a x o n _ D i s a m b   - - -

#-- 1996-08-13: Verified with Stavely

#   [ if self has an unambiguous substitute abbreviation -> return it
#     else -> fail
#   ]

procedure Taxon_Disamb ( self )
  return  \ self.disamb;
end


# - - -   T a x o n _ A b b r   - - -

procedure Taxon_Abbr ( self )
  if  \ self.disamb  then
    return self.disamb
  else if  \ self.canon  then
    return self.canon
  else
    fail;
end


# - - -   T a x o n _ P a r e n t   - - -

#-- 1996-08-13: Verified with Stavely

#   [ if self has a parent -> return the parent Taxon object
#     else -> fail
#   ]

procedure Taxon_Parent ( self )
  return Tree_Value ( Tree_Parent ( self.tree ) );
end


# - - -   T a x o n _ N _ C h i l d r e n   - - -

#-- 1996-08-13: Verified with Stavely

#   [ return the number of children, >= 0
#   ]

procedure Taxon_N_Children ( self )
  return Tree_N_Children ( self.tree );
end


# - - -   T a x o n _ G e n _ C h i l d r e n   - - -

#-- 1996-08-13: Verified with Stavely

#   [ generate the child Taxon objects in birth order, if any
#   ]

procedure Taxon_Gen_Children ( self )
  every suspend Tree_Value ( Tree_Gen_Children ( self.tree ) );
end


# - - -   T a x o n _ N t h _ C h i l d   - - -

#-- 1996-08-13: Verified with Stavely

#   [ if self has at least n children ->
#       return the Taxon whose birth order is n
#     else -> fail
#   ]

procedure Taxon_Nth_Child ( self, n )
  return Tree_Value ( Tree_Nth_Child ( self.tree, n ) ); 
end


# - - -   T a x o n _ L a s t _ C h i l d   - - -

#-- 1996-10-16: Verified, A. Stavely

procedure Taxon_Last_Child ( self )
  local nKids       # How many kids we have

  if ( ( nKids := Taxon_N_Children ( self ) )  >  0 )  then
    return Taxon_Nth_Child ( self, nKids )
  else
    fail;
end


# - - -   T a x o n _ B i r t h _ O r d e r   - - -

#-- 1996-08-13: Verified with Stavely

#   [ if self has no parent -> return 1
#     else ->
#       return self's birth order relative to the other children
#       of its parent, >= 1
#   ]

procedure Taxon_Birth_Order ( self )
  return Tree_Birth_Order ( self.tree );  
end


# - - -   T a x o n _ D e p t h   - - -

#-- 1996-08-13: Verified with Stavely

#   [ return self's rank's depth
#   ]

procedure Taxon_Depth ( self )
  return Rank_Depth ( self.rank );
end


# - - -   T a x o n _ S h o w   - - -

#-- 1996-08-13: Verified with Stavely

#   [ return a string showing the English name, with the scientific
#     name following in square brackets
#   ]

procedure Taxon_Show ( self )
  return self.eng || " [" || self.sci || "]";
end