/*
/*  Program:   BARSCALE.AML  
/*
/*  Version:   1.0
/*
/*  Release:   1
/*
/*  Purpose:   This program will draw the linework and text (meters, miles and 
/*             feet) for any scale map composition   
/*
/*  Usage:     &r barscale {%xcen%} {%ypos%} {custom}
/*
/*  Language:  ARC/INFO  version 7.1
/*
/*  System:    Data General AViiON series, DG/UX 4.32
/*
/*  Notes:  For standard scales (12K,24k,25k,50k,62500,63360,100k) subdivisions
/*          are preset. For custom scales user will be prompted for input.
/*
/*          This program is for use in ARCPLOT in a MAP COMPOSITION environment.
/*          The user must setup the composition before running this program.
/*          Mapextent, mapscale (greater than 12K) and page settings must be
/*          set by the user or the application calling this program.
/*
/*          If a beginning x,y location is not given as an arguement the user
/*          will be prompted to enter beginning location with the mouse. The
/*          beginning x,y is the center of the top scale. If the
/*
/*          If the user wants the custom option, any entry as arguement 3, other
/*          than no, NO, N or n, will be interpreted as a custom option. For the
/*          custom option the user will be prompted to enter the # of divisions,
/*          the interval and the # of subdivisions for each unit. The 
/*          subdivisions are the smaller intervals to the left of the scale. 
/*
/******************************  HISTORY  **************************************/*
/*  Author      Site   Date       Event
/*  ------      ----   ----       -----
/*  Bob Davis   MCMC  09/24/97    Original coding
/*
/*******************************************************************************/*
/*============================  DISCLAIMER  ====================================/*
/*  Although this program has been used by the U.S. Geological Survey (USGS),
/*  no warranty, expressed or implied, is made by the USGS as to the accuracy
/*  and functioning of the program and related program material, nor shall
/*  the fact of distribution constitute any such warranty, and no
/*  responsibility is assumed by the USGS in connection therewith.
/*
/*==============================================================================/*
/*
/*************************  LINKS TO OTHER PROGRAMS  ***************************/*
/*  Referenced by: 
/*
/*  Programs called: none
/*
/*  Subroutines called:  None
/*
/**************************  INPUT/OUTPUT COVERAGES  ***************************/*
/*  Input:
/*
/*  Output:
/*
/***************************  DATA DICTIONARY  *********************************/*
/*
/*
/*
/****************************  AML VARIABLES  **********************************/*
/*  Local variables: XCEN = X location of center of set pagesize
/*                   YCEN = y start value
/*
/*  Global variables: 
/*
/*
/*==============================================================================/*
/*=========================  BEGIN MAIN PROGRAM  ===============================/*
/*==============================================================================/*
/*
&args xcen ycen custom
&term 9999
&s program barscale 
/*
/* check program
/*
&if [show program] NE ARCPLOT &then
  &do
    &type Program for use in ARCPLOT only ...
    &return
  &end
&else &if [quote [show map]] = [quote [unquote ' ']] &then
  &do
    &type %program% program for use in map composition ...
    &type Exiting %program% ...
    &return
  &end
/*
/* check mapcomp settings
/*
&if [extract 1 [show mape]] < 1 &then
  &do
    &type Mapextent must be set before creating barscale ...
    &type Exiting %program% ...
    &return
  &end
&if [show mapscale] < 12000 &then
  &do
    &type Mapscale is currently [show mapscale]
    &type Mapscale must be greater than 12000 for this program ...
    &type Exiting %program% ...
    &return
  &end
&s bgnunits [show mapunits]
/*
/* check for args set
/*
&if [NULL %xcen%] &then
  &do
    &type Enter x,y location for bar scale ...
    &getpoint &page
    &s xcen %pnt$x%
    &s ycen %pnt$y%
  &end
&else &if [quote %xcen%] = [quote #] &then
  &do
    &type Enter x,y location for bar scale ...
    &getpoint &page
    &s xcen %pnt$x%
    &s ycen %pnt$y%
  &end
&else
  &do
    &if [TYPE %xcen%] NE -1 AND [TYPE %xcen%] NE -2 &then
      &do
        &type X start value is not integer or real number ...
        &type USAGE: &r %program% {x} {y} {custom}
        &type Exiting %program% ...
        &return 
      &end
    &if [TYPE %ycen%] NE -1 AND [TYPE %ycen%] NE -2 &then
      &do
        &type Y start value is not integer or real number ...
        &type USAGE: &r %program% {x} {y} {custom}
        &type Exiting %program% ...
        &return 
      &end
  &end
/*
&if [NULL %custom%] &then
  &s custom = no
&else &if [locase [substr %custom% 1 1]] = n &then
  &s custom = no
&else
  &s custom = yes
/*
/* if custom option not exercised then set default intervals
/* and division for common scales (12k,24k,25k,50k,62.5k,63.36k,100k)
/*
&if [show mapscale] = 12000 &then
  &do
    &s metersdiv = 2
    &s metersint = 500
    &s feetdiv = 8
    &s feetint = 500
    &s milesdiv = 2
    &s milesint = 2640
    &s meterssub = 10
    &s milessub = 10
    &s feetsub = 5
    &s order = miles feet meters
  &end
&else &if [show mapscale] = 24000 OR [show mapscale] = 25000 AND ~
    %custom% = no &then
  &do
    &s metersdiv = 3
    &s metersint = 1000
    &s feetdiv = 11
    &s feetint = 1000
    &s milesdiv = 2
    &s milesint = 5280
    &s meterssub = 10
    &s milessub = 10
    &s feetsub = 5
    &s order = meters miles feet
  &end
&else &if [show mapscale] = 50000 OR [show mapscale] = 62500 OR ~
      [show mapscale] = 63360 AND %custom% = no &then
  &do
    &s metersdiv = 6
    &s metersint = 1000
    &s feetdiv = 8 
    &s feetint = 3000
    &s milesdiv = 5
    &s milesint = 5280
    &s meterssub = 10
    &s milessub = 10
    &s feetsub = 6
    &s order = miles feet meters
  &end
&else &if [show mapscale] = 100000 &then
  &do
    &s metersdiv = 21
    &s metersint = 1000
    &s feetdiv = 15
    &s feetint = 5000
    &s milesdiv = 14
    &s milesint = 5280
    &s meterssub = 5
    &s milessub = 5
    &s feetsub = 5
    &s order = meters feet miles
  &end
&else
  &do input &list meters miles feet
    &s [value input]div [RESPONSE ~
       [quote Enter number of %input% divisions for [calc ~
       [show mapscale] / 1000]K (less than 30)]]
    &if [value [value input]div] > 30 &then
    &s [value input]div [RESPONSE ~
       [quote Enter number of %input% divisions for [calc ~
       [show mapscale] / 1000]K (less than 30)]]
    &s [value input]int [RESPONSE [quote Enter interval of %input% scale]]
    &if %input% = miles &then
      &s [value input]int [calc [value [value input]int] * 5280]
    &s [value input]sub [GETCHOICE 3 4 5 6 10 -PROMPT ~
       [quote Select minor subdivisions for %input%]]    
  &end
&if ^ [var order] &then
  &do
    &s order [unquote ' ']
    &s option [unquote ' ']
    &s possible meters, miles, feet
    &do a = 1 &to 3
    &s option [GETCHOICE [UNQUOTE [SUBST [QUOTE %possible%] %option% ~
              [unquote ' ']]] -PROMPT [QUOTE Select number %a% scale]]  
    &s order [unquote %order%,%option%]
    &s possible [UNQUOTE [SUBST [QUOTE %possible%] %option% [unquote ' ']]]
    &end
    &s order [unquote [trim [quote [subst [quote %order%] ',' [unquote ' ']]]]]
  &end
/*
&s x = %xcen%
&s y = %ycen%
/*
&s mapu [show mapunits]
/*
&do units &list %order%
  &if %units% = meters &then
    mapunits meters
  &else
    mapunits feet
  &s subdiv [value [value units]sub]
  &s subint [value [value units]int] / %subdiv%
  &s page [show convert page 0 0 map]
  &s junkx [extract 1 %page%]
  &s junky [extract 2 %page%]
  &s pgesub [extract 1 [show convert map [calc %junkx% + %subint%] %junky% page]]
  &s pgeint %pgesub% * %subdiv%
  &s mappos [show convert page %x% %y% map]
  &s totaldist [value [value units]div] * [value [value units]int]
  &s left [show convert map [calc [EXTRACT 1 %mappos%] - [calc %totaldist% / 2]]~
          [extract 2 %mappos%] page]
  &s leftx [extract 1 %left%]
  &s lefty [extract 2 %left%]
  &s right [show convert map [calc [EXTRACT 1 %mappos%] + [calc %totaldist% / 2]]~ 
           [extract 2 %mappos%] page]
  &s rightx [extract 1 %right%]
  &s righty [extract 2 %right%]
  MBEGIN
  BOX %leftx% [calc %lefty% - .015] %rightx% [calc %righty% + .015]
  &do line = 1 &to %subdiv%
    line [calc %leftx% + ( %line% * %pgesub% )] [calc %lefty% - .015]~
         [calc %leftx% + ( %line% * %pgesub% )] [calc %lefty% + .015]
    &if %line% ^ IN {2,4,6,8,10,12,14,16,18,20} AND %line% NE %subdiv% &then
      &do
        move [calc %leftx% + ( %line% * %pgesub% )] %y%
        &s string [show where current]
        line [extract 1 %string%] %y% [calc [extract 1 %string%] + %pgesub%] %y%
      &end 
  &end
  &do line = 1 &to [value [value units]div]
    line [calc %leftx% + ( %line% * %pgeint% )] [calc %lefty% - .015]~
         [calc %leftx% + ( %line% * %pgeint% )] [calc %lefty% + .015]
    &if %subdiv% IN {1,3,5,7,9,11,13,15,17,19,21,23,25,27,29} &then
      &s list 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30
    &else 
      &s list 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29
    &if %line% ^ IN {%list%} AND %line% NE [value [value units]div] &then
      &do
        move [calc %leftx% + ( %line% * %pgeint% )] %y%
        &s string [show where current]
        line [extract 1 %string%] %y% [calc [extract 1 %string%] + %pgeint%] %y%
      &end
  &end
  MEND
  MGROUP [calc [show mapscale] / 1000]K%units%scale
/*
/* Text is not included in the mgrouped element to allow the user to edit
/*
  &call text
/*
/* .375 is the distance separating each scale
/*
  &s y %y% - .375
&end      
mapunits %bgnunits%
&return
/*
&routine text
/*
/* set text conditions
/*
  TEXTFONT 94037 /* Univers-Condensed
  TEXTQUALITY PROPORTIONAL
  TEXTSIZE 8 PT
  TEXTOFFSET 0 .03
  TEXTJUSTIFICATION LC
/*
/* place scale label
/*
&if %units% = [extract 1 %order%] &then
  &do
    MOVE %x% [calc %y% + .1875]
    &s txtfnt [show textfont]
    &s txtsze [show textsize]
    TEXTFONT 334
    TEXTSIZE 10 PT
    TEXT [QUOTE SCALE 1:[SHOW MAPSCALE]]
    TEXTFONT %txtfnt%
    TEXTSIZE %txtsze%
  &end
/*
/* Place unit labels
/*
MOVE %x% %y%
&s txtoff [show textoffset]
&s txtjst [show textjustification]
TEXTJUSTIFICATION UC
TEXTOFFSET 0 -.03
TEXT [UPCASE %units%]
TEXTOFFSET %txtoff%
TEXTJUSTIFICATION %txtjst%
&if %units% = meters &then
  &do
    MOVE %x% %y%
    TEXT KILOMETERS
  &end
/*
/* place text at far left of scale
/*
move %leftx% %y%
&if %units% = miles &then
  TEXT [calc [value [value units]int] / 5280]
&else &if %units% = meters &then
  &do
    &s txtoff [show textoffset]
    &s txtjst [show textjustification]
    TEXTOFFSET 0 -.03
    TEXTJUSTIFICATION UC
    TEXT [value [value units]int]
    MOVE %leftx% %y% 
    TEXTJUSTIFICATION %txtjst%
    TEXTOFFSET %txtoff%
    TEXT [calc [value [value units]int] / 1000]
  &end
&else
  TEXT [value [value units]int]
/* 
/* if subdivision of interval is more than 6 place label a half point
/*
&if %subdiv% > 6 &then
  &do
    move [calc %leftx% + ( ( %subdiv% / 2 ) * %pgesub% )] %y%
    &if %units% = miles &then
      text [calc ( [value [value units]int] / 2 ) / 5280]
    &else &if %units% = meters &then
      &do
        textjustification %txtjst%
        textoffset %txtoff%
        text [calc ( [value [value units]int] / 2 ) / 1000]
      &end
    &else
      text [calc [value [value units]int] / 2]
  &end
/*
/* place text for rest of scale
/*
&s conflict [calc %xcen% - .5] [calc %y% - [EXTRACT 2 [show textoffset]]]~
   [calc %x% + .5] [calc %y% + [EXTRACT 2 [show textoffset]]]
/*
&do divis = 1 &to [value [value units]div]
  move [calc %leftx% + ( %divis% * %pgeint% )] %y%
  &s text [unquote ' ']
  &s txtoff [show textoffset]
  &s txtjst [show textjustification]
  &if %units% = miles &then
    TEXT [calc ( ( %divis% - 1 ) * [value [value units]int] ) / 5280]
  &else &if %units% = meters &then
    &do
      &if [extract 1 [show where current]] < [extract 1 %conflict%] OR ~
          [extract 1 [show where current]] > [extract 3 %conflict%] &then
      &do
        textjustification uc
        textoffset 0 -.03 
        TEXT [calc ( %divis% - 1 ) * [value [value units]int]]
        textjustification %txtjst%
        textoffset %txtoff%
        move [calc %leftx% + ( %divis% * %pgeint% )] %y%
        TEXT [calc ( ( %divis% - 1 ) * [value [value units]int] ) / 1000]
      &end
    &end
  &else
    TEXT [calc ( %divis% - 1 ) * [value [value units]int]]
&end
&return