Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/piwg/z000011.ada

Text File | 1988-05-03 | 14.4 KB | 700 lines

with PHYSICAL_UNITS_BASIC ; use PHYSICAL_UNITS_BASIC ;

package PHYSICAL_UNITS_OUTPUT_BASIC is

-- This package specification defines a simple PUT for Ada types for physical
-- quantities. The initial thought was to have metric units and English units
-- in separate package specifications. This proved inpractical
-- because time in seconds is both metric and English. Many other
-- units such as watt of power and Farad of capacitance are in
-- both systems. Thus, in order to keep the packages reasonable sizes,
-- the packages are basic units, mechanical units and electrical units.
--
-- Notice that there is not a procedure PUT defined for LENGTH_METER
-- or for that matter, any " subtype " defined in the package PHYSICAL_UNITS.
-- It is unnecessary and happens to be illegal ada.

  procedure PUT ( ITEM : LENGTH_MKS ) ;

  procedure PUT ( ITEM : LENGTH_ENGLISH ) ;

  procedure PUT ( ITEM : LENGTH_PICOMETER ) ;

  procedure PUT ( ITEM : LENGTH_NANOMETER ) ;

  procedure PUT ( ITEM : LENGTH_MICROMETER ) ;

  procedure PUT ( ITEM : LENGTH_MILLIMETER ) ;

  procedure PUT ( ITEM : LENGTH_CENTIMETER ) ;

  procedure PUT ( ITEM : LENGTH_DECIMETER ) ;

  procedure PUT ( ITEM : LENGTH_DECAMETER ) ;

  procedure PUT ( ITEM : LENGTH_HECTOMETER ) ;

  procedure PUT ( ITEM : LENGTH_KILOMETER ) ;

  procedure PUT ( ITEM : LENGTH_MEGAMETER ) ;

  procedure PUT ( ITEM : LENGTH_GIGAMETER ) ;

  procedure PUT ( ITEM : LENGTH_ANGSTROM ) ;

  procedure PUT ( ITEM : LENGTH_MIL ) ;

  procedure PUT ( ITEM : LENGTH_INCH ) ;

  procedure PUT ( ITEM : LENGTH_YARD ) ;

  procedure PUT ( ITEM : LENGTH_FATHOM ) ;

  procedure PUT ( ITEM : LENGTH_ROD ) ;

  procedure PUT ( ITEM : LENGTH_CHAIN_SURVEYOR ) ;

  procedure PUT ( ITEM : LENGTH_CHAIN_ENGINEER ) ;

  procedure PUT ( ITEM : LENGTH_FURLONG ) ;

  procedure PUT ( ITEM : LENGTH_MILE ) ;

  procedure PUT ( ITEM : LENGTH_MILE_NAUTICAL ) ;

  procedure PUT ( ITEM : LENGTH_LEAGUE_LAND ) ;

  procedure PUT ( ITEM : LENGTH_LEAGUE_MARINE ) ;

  procedure PUT ( ITEM : LENGTH_LIGHT_YEAR ) ;

  procedure PUT ( ITEM : MASS_MKS ) ;

  procedure PUT ( ITEM : MASS_ENGLISH ) ;

  procedure PUT ( ITEM : MASS_POUND_TROY ) ;

  procedure PUT ( ITEM : MASS_MILLIGRAM ) ;

  procedure PUT ( ITEM : MASS_GRAM ) ;

  procedure PUT ( ITEM : MASS_GRAIN ) ;

  procedure PUT ( ITEM : MASS_PENNYWEIGHT_TROY ) ;

  procedure PUT ( ITEM : MASS_CARAT_TROY ) ;

  procedure PUT ( ITEM : MASS_SCRUPLE ) ;

  procedure PUT ( ITEM : MASS_DRAM_AVDP ) ;

  procedure PUT ( ITEM : MASS_OUNCE_AVDP ) ;

  procedure PUT ( ITEM : MASS_OUNCE_TROY ) ;

  procedure PUT ( ITEM : MASS_TON_SHORT ) ;

  procedure PUT ( ITEM : MASS_TON_LONG ) ;

  procedure PUT ( ITEM : MASS_TON_METRIC ) ;

  procedure PUT ( ITEM : TIME_SECOND ) ;

  procedure PUT ( ITEM : TIME_PICOSECOND ) ;

  procedure PUT ( ITEM : TIME_NANOSECOND ) ;

  procedure PUT ( ITEM : TIME_MICROSECOND ) ;

  procedure PUT ( ITEM : TIME_MILLISECOND ) ;

  procedure PUT ( ITEM : TIME_CENTISECOND ) ;

  procedure PUT ( ITEM : TIME_KILOSECOND ) ;

  procedure PUT ( ITEM : TIME_MEGASECOND ) ;

  procedure PUT ( ITEM : TIME_GIGASECOND ) ;

  procedure PUT ( ITEM : TIME_MINUTE ) ;

  procedure PUT ( ITEM : TIME_HOUR ) ;

  procedure PUT ( ITEM : TIME_DAY ) ;

  procedure PUT ( ITEM : TIME_FORTNIGHT ) ;

  procedure PUT ( ITEM : TIME_MONTH ) ;

  procedure PUT ( ITEM : TIME_YEAR ) ;

  procedure PUT ( ITEM : TIME_DECADE ) ;

  procedure PUT ( ITEM : TIME_CENTURY ) ;

  procedure PUT ( ITEM : TIME_MILLENNIA ) ;

  procedure PUT ( ITEM : CHARGE_COULOMB ) ;

  procedure PUT ( ITEM : CHARGE_ELECTRON ) ;

  procedure PUT ( ITEM : CHARGE_FARADAY ) ;

  procedure PUT ( ITEM : CHARGE_AMPERE_HOURS ) ;

  procedure PUT ( ITEM : LUMINOUS_INTENSITY_CANDLE ) ;

  procedure PUT ( ITEM : TEMPERATURE_KELVIN ) ;

  procedure PUT ( ITEM : TEMPERATURE_CENTIGRADE ) ;

  procedure PUT ( ITEM : TEMPERATURE_FARENHEIT ) ;

  procedure PUT ( ITEM : ANGLE_RADIAN ) ;

  procedure PUT ( ITEM : ANGLE_SECOND ) ;

  procedure PUT ( ITEM : ANGLE_MINUTE ) ;

  procedure PUT ( ITEM : ANGLE_DEGREE ) ;

  procedure PUT ( ITEM : ANGLE_REVOLUTION ) ;

  procedure PUT ( ITEM : ANGLE_BAM ) ;

  procedure PUT ( ITEM : SOLID_ANGLE_STERADIAN ) ;

end PHYSICAL_UNITS_OUTPUT_BASIC ;
with PHYSICAL_REAL ; use PHYSICAL_REAL ;
with TEXT_IO ; use TEXT_IO ;
with FLT_IO ; use FLT_IO ;

package body PHYSICAL_UNITS_OUTPUT_BASIC is

  procedure PUT ( ITEM : LENGTH_MKS ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " meter " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_ENGLISH ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " feet " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_PICOMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " picometer " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_NANOMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " nanometer " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_MICROMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " micrometer " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_MILLIMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " millimeter " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_CENTIMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " centimeter " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_DECIMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " decimeter " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_DECAMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " decameter " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_HECTOMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " hectometer " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_KILOMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " kilometer " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_MEGAMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " megameter " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_GIGAMETER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " gigameter " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_ANGSTROM ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " angstrom " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_MIL ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " mil " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_INCH ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " inch " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_YARD ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " yard " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_FATHOM ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " fathom " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_ROD ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " rod " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_CHAIN_SURVEYOR ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " chain (surveyor) " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_CHAIN_ENGINEER ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " chain (engineer) " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_FURLONG ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " furlong " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_MILE ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " mile " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_MILE_NAUTICAL ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " mile (nautical) " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_LEAGUE_LAND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " league (land) " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_LEAGUE_MARINE ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " league (marine) " ) ;
  end PUT ;

  procedure PUT ( ITEM : LENGTH_LIGHT_YEAR ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " light year " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_MKS ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " kilogram " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_ENGLISH ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " pound " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_POUND_TROY ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " pound (troy) " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_MILLIGRAM ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " milligram " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_GRAM ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " gram " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_GRAIN ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " grain " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_PENNYWEIGHT_TROY ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " pennyweight (troy) " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_CARAT_TROY ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " carat (troy) " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_SCRUPLE ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " scruple " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_DRAM_AVDP ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " dram (avdp.) " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_OUNCE_AVDP ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " ounce " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_OUNCE_TROY ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " ounce (troy) " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_TON_SHORT ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " ton (short) " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_TON_LONG ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " ton (long) " ) ;
  end PUT ;

  procedure PUT ( ITEM : MASS_TON_METRIC ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " ton (metric) " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_SECOND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " second " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_PICOSECOND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " picosecond " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_NANOSECOND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " nanosecond " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_MICROSECOND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " microsecond " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_MILLISECOND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " millisecond " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_CENTISECOND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " centisecond " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_KILOSECOND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " kilosecond " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_MEGASECOND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " megasecond " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_GIGASECOND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " gigasecond " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_MINUTE ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " minute " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_HOUR ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " hour " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_DAY ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " day " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_FORTNIGHT ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " fortnight " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_MONTH ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " month " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_YEAR ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " year " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_DECADE ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " decade " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_CENTURY ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " century " ) ;
  end PUT ;

  procedure PUT ( ITEM : TIME_MILLENNIA ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " millennia " ) ;
  end PUT ;

  procedure PUT ( ITEM : CHARGE_COULOMB ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " coulomb " ) ;
  end PUT ;

  procedure PUT ( ITEM : CHARGE_ELECTRON ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " charge (electron) " ) ;
  end PUT ;

  procedure PUT ( ITEM : CHARGE_FARADAY ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " faraday " ) ;
  end PUT ;

  procedure PUT ( ITEM : CHARGE_AMPERE_HOURS ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " ampere hour " ) ;
  end PUT ;

  procedure PUT ( ITEM : LUMINOUS_INTENSITY_CANDLE ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " candel " ) ;
  end PUT ;

  procedure PUT ( ITEM : TEMPERATURE_KELVIN ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " degree kelvin " ) ;
  end PUT ;

  procedure PUT ( ITEM : TEMPERATURE_CENTIGRADE ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " degree centigrade " ) ;
  end PUT ;

  procedure PUT ( ITEM : TEMPERATURE_FARENHEIT ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " degree farenheit " ) ;
  end PUT ;

  procedure PUT ( ITEM : ANGLE_RADIAN ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " radian " ) ;
  end PUT ;

  procedure PUT ( ITEM : ANGLE_SECOND ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " second (angle) " ) ;
  end PUT ;

  procedure PUT ( ITEM : ANGLE_MINUTE ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " minute ( angle) " ) ;
  end PUT ;

  procedure PUT ( ITEM : ANGLE_DEGREE ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " degree (angle) " ) ;
  end PUT ;

  procedure PUT ( ITEM : ANGLE_REVOLUTION ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " revolution " ) ;
  end PUT ;

  procedure PUT ( ITEM : ANGLE_BAM ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " bam " ) ;
  end PUT ;

  procedure PUT ( ITEM : SOLID_ANGLE_STERADIAN ) is

  begin
    PUT ( UNDIMENSION( ITEM )) ;
    PUT ( " steradian " ) ;
  end PUT ;

end PHYSICAL_UNITS_OUTPUT_BASIC ;