ooRexx logo
   1: /* ---------------------------------------------------------------- */
   2: /* Two classes to facilitate Google maps interaction:               */
   3: /*                                                                  */
   4: /*   GeoLoc - an immutable definition of a latitude/longitude pair  */
   5: /*   GeoPath - a list of GeoLoc objects defining a route or path    */
   6: /*                                                                  */
   7: /* ---------------------------------------------------------------- */
   8: /*                                                                  */
   9: /* Originally by Ruurd J. Idenburg                                  */
  10: /*                                                                  */
  11: /* No copyright, no licence, no guarantees or warrantees, be it     */
  12: /* explicit, implicit or whatever. Usage is totally and completely  */
  13: /* at the users own risk, the author shall not be liable for any    */ 
  14: /* damages whatsoever, for any reason whatsoever.                   */
  15: /*                                                                  */
  16: /* Please keep this comment block intact when modifying this code   */
  17: /* and add a note with date and a description.                      */
  18: /*                                                                  */
  19: /* ---------------------------------------------------------------- */
  20: /* 2013/12/01 - Initial version approximately                       */
  21: /* 2020/02/15 - Corrected comments above                            */
  22: /* ---------------------------------------------------------------- */
  23: 
  24: ::class geoloc public
  25: -- GeoLoc class, for now consisting of an immutable latitude
  26: -- and longitude specification in decimal degrees.
  27: --
  28: -- The precision for calculations is a settable attribute, initially
  29: -- set to the highest precision supported by the 'rxmath' library.
  30: --
  31: 
  32: ::attribute latitude get
  33: ::attribute longitude get
  34: ::attribute precision
  35: 
  36: -- (equatorial) radius of the Earth in meters as used by Google
  37: ::constant earthRadius 6378137
  38: 
  39: ::method init
  40: 	expose latitude longitude precision
  41: 	use strict arg lat,lon
  42: -- set precision to the maximum supported number of digits in the rxmath library
  43: 	precision = 16
  44: -- create proper and valid latitude and longitude  
  45: 	latitude = .latitude~new(lat)
  46: 	longitude = .longitude~new(lon)
  47: 
  48: ::method distanceFrom
  49: -- Calculates the distance between the receiving and the argument (geo)location 
  50: -- in thousands of Kilometers or Miles, as specified by the optional second argument. 
  51: -- Default is the the metric system, specify 'M' for the imperial system.
  52: --
  53: 	numeric digits (self~precision)
  54: -- distance in Kilometers(K), is default, or Miles(M)
  55: 	use strict arg fromGeoLoc, unit='K'	
  56: 	if fromGeoLoc~class<>.geoloc then raise syntax 88.914 array("1-(geoloc)",self~class~id)
  57: 	unit = unit~subchar(1)~upper
  58: -- distance will be calculated in thousands of the unit, be it metric or imperial
  59: 	if ('KM')~pos(unit)==0 then raise syntax 88.916 array("2-(unit)",'"K(m)","M(ile)"',unit)
  60: 	unit = '1000 1639'~word(('KM')~pos(unit)) 
  61: -- I'm told that the best formula for short distances is: 
  62: -- d=R*2*asin(sqrt((sin((lat1-lat2)/2))^2 + cos(lat1)*cos(lat2)*(sin((lon1-lon2)/2)^2)))
  63: 	lat1 = self~latitude
  64: 	lat2 = fromGeoLoc~latitude
  65: 	lon1 = self~longitude
  66: 	lon2 = fromGeoLoc~longitude
  67: 	R = self~earthRadius
  68: 	dist = R*2*asin(sqrt((sin(lat1-lat2)/2)**2 + cos(lat1)*cos(lat2)*(sin((lon1-lon2)/2)**2)),,'R')
  69: --for a possibly future method implementation 
  70: --R*2*(((lat1-lat2)/2)~sin**2 + lat1~cos*lat2~cos*(((lon1-lon2)/2)**2)~sqrt)~asin(,'R')
  71: --
  72: -- return distance in thousands of unit
  73: 	return (dist/unit)~format(,3) 
  74: 
  75: ::method distanceTo
  76: 	forward message('distanceFrom') to(self)
  77: 
  78: ::class geoPath public subclass list
  79: -- GeoPath class, defined as a list of GeoLocs.
  80: -- Class method 'of' in the .list class uses insert instance methods, no need to override.
  81: 
  82: ::method insert
  83: 	use arg item
  84: 	if item~class<>.geoloc then do
  85: 		raise syntax 88.914 array(1,.geoloc~id)
  86: 	end
  87: -- 2nd argument is index if specified
  88: 	if arg(2,'E') then do
  89: 		return self~insert:super(item,arg(2))
  90: 	end
  91: -- no 2nd argument means append
  92: 	else do
  93: 		return self~insert:super(item)
  94: 	end
  95: exit
  96: 	
  97: ::method append
  98: 	use strict arg item
  99: 	self~insert(item)
 100: exit
 101: 	
 102: ::method put
 103: -- same as insert with 2nd argument
 104: 	use strict arg item, index
 105: 	self~insert(item,index)
 106: 	
 107: ::method distance
 108: 	use strict arg unit='K'
 109: 	items = self~items
 110: 	distance = 0
 111: 	do l=0 to items-2
 112:     distance += self[l]~distanceTo(self[l+1],unit)
 113: 	end
 114:   return distance
 115: 	
 116: ::class number public subclass string
 117: -- Number class, a subclass of the String class
 118: -- Values can be any valid number
 119: --
 120: -- All arithmetic methods need to be defined here, because 
 121: -- the result of the operation should be another object of 
 122: -- the Number class, and the result of the String class operators
 123: -- always is a String class object.
 124: --
 125: -- Note that subclasses of the Number class will yield results
 126: -- that belong to that particular receiver subclass.
 127: 
 128: ::method init
 129: 	self~init:super
 130: 	if (self)~datatype\='NUM' then do	--if self is not a number
 131: 		raise syntax 93.904 array(1,self) -- then raise an error and quit	
 132: 	end
 133: 
 134: ::method '+' 
 135: --use strict arg num
 136: --return self~class~new(self~'+':super(num))
 137: -- or:
 138: 	forward class(super) continue
 139: 	return self~class~new(result)
 140: 	
 141: ::method '-' 
 142: 	use strict arg num
 143: 	return self~class~new(self~'-':super(num))
 144: 
 145: ::method '*' 
 146: 	use strict arg num
 147: 	return self~class~new(self~'*':super(num))
 148: 
 149: ::method '/' 
 150: 	use strict arg num
 151: 	return self~class~new(self~'/':super(num))
 152: 
 153: ::method '%' 
 154: 	use strict arg num
 155: 	return self~class~new(self~'%':super(num))
 156: 
 157: ::method '//' 
 158: 	use strict arg num
 159: 	return self~class~new(self~'//':super(num))
 160: 
 161: ::method '**' 
 162: 	use strict arg num
 163: 	return self~class~new(self~'**':super(num))
 164: 
 165: ::class latitude public subclass number
 166: -- Latitude class, a subclass of the Number class
 167: -- Values range from -90 thru +90
 168: 
 169: ::method init
 170: -- the number class will check if I'm a valid number
 171: 	self~init:super	 
 172: -- I check if I'm a valid latitude
 173: 	if self<-90 | self>90 then do 
 174: 		raise syntax 88.907 array("1-(latitude)","-90","90",self)
 175: 	end
 176: 
 177: ::class longitude public subclass number
 178: -- Longitude class, a subclass of the Number class
 179: -- Values range from -180 thru +180
 180: 
 181: ::method init
 182: 	self~init:super	
 183: 	if self<-180 | self>180 then do 
 184: 		raise syntax 88.907 array("1-(longitude)","-180","180",self)
 185: 	end
 186: 
 187: -- Simplify function names for the necessary 'RxMath' functions	
 188: ::routine Sin EXTERNAL "LIBRARY rxmath RxCalcSin"
 189: ::routine Cos EXTERNAL "LIBRARY rxmath RxCalcCos"
 190: ::routine Asin EXTERNAL "LIBRARY rxmath RxCalcArcSin"
 191: ::routine Sqrt EXTERNAL "LIBRARY rxmath RxCalcSqrt"
 192: 
 193: -- number.cls added above
 194: --::requires "number.cls" 
If you feel inclined to make corrections, suggestions etc., please mail me any.
All content © Ruurd Idenburg, 2007–, except where marked otherwise. All rights reserved. This page is primarily for non-commercial use only. The Idenburg website records no personal information and sets no ‘cookies’. This site is hosted on a VPS(Virtual Private System) rented from Transip.nl, a Dutch company, falling under Dutch (privacy) laws (I think).

This page updated on by Ruurd Idenburg.