cl-ballistics.lisp 7.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246
  1. ;;;; cl-ballistics.lisp
  2. (in-package #:cl-ballistics)
  3. ;;; Constant definitions
  4. (defconstant +gravity+ -32.194)
  5. (defconstant +standard-pressure+ 29.92)
  6. (defconstant +to-radians+ (/ pi 180))
  7. (defconstant +to-degrees+ (/ 180 pi))
  8. (defconstant +standard-altitude+ 0)
  9. (defconstant +standard-temperature+ 59)
  10. (defconstant +standard-humidity+ 1)
  11. ;;; Alist of Drag Functions
  12. (defconstant +drag-functions+
  13. '((:g1 . "Ingalls, flatbase")
  14. (:g2 . "Aberdeen \"J\" Projectile")
  15. (:g3 . "")
  16. (:g4 . "")
  17. (:g5 . "Short, 7.5° boat-tail")
  18. (:g6 . "Flatbase, 6 Calibers long")
  19. (:g7 . "Long 7.5° boat-tail")
  20. (:g8 . "Flatbase, 10 Calibers long")))
  21. ;;; Solution class
  22. (defclass ballistic-solution ()
  23. ())
  24. ;;; Atmospheric Functions
  25. (defun calc-fp (pressure)
  26. (declare (real pressure))
  27. (/ (- pressure +standard-pressure+) +standard-pressure+))
  28. (defun calc-fr (temperature pressure relative-humidity)
  29. (declare (real temperature pressure relative-humidity))
  30. (let ((vpw (- (* 4e-6 (expt temperature 3))
  31. (+ (* 4e-4 (expt temperature 2))
  32. (* 0.0234 temperature))
  33. 0.2517)))
  34. (* 0.995
  35. (/ pressure (* (- pressure 0.3783)
  36. relative-humidity
  37. vpw)))))
  38. (defun calc-ft (temperature altitude)
  39. (declare (real temperature altitude))
  40. (let ((tstd (+ (* -0.0036 altitude) 59)))
  41. (/ (- temperature tstd)
  42. (- 459.6 tstd))))
  43. (defun calc-fa (altitude)
  44. (declare (real altitude))
  45. (/ 1 (+ (* -4e-15 (expt altitude 3))
  46. (* 4e-10 (expt altitude 2))
  47. (* -3e-5 altitude)
  48. 1)))
  49. (defun atmospheric-correction (drag-coefficient &optional (altitude +standard-altitude+) (pressure +standard-pressure+) (temperature +standard-temperature+) (relative-humidity +standard-humidity+))
  50. (declare (real drag-coefficient altitude pressure temperature relative-humidity))
  51. (let* ((altitude-correction (calc-fa altitude))
  52. (temperature-correction (calc-ft temperature altitude))
  53. (humidity-correction (calc-fr temperature pressure relative-humidity))
  54. (pressure-correction (calc-fp pressure))
  55. (correction-factor (* altitude-correction
  56. (- (+ 1 temperature-correction)
  57. pressure-correction)
  58. humidity-correction)))
  59. (* drag-coefficient correction-factor)))
  60. (export 'atmospheric-correction)
  61. ;;; G-function retardation
  62. (defun retrieve-a-m (drag-function velocity)
  63. (ecase drag-function
  64. (:g1
  65. (cond
  66. ((> velocity 4230) (values 1.477404177730177e-04 1.9565))
  67. ((> velocity 3680) (values 1.920339268755614e-04 1.925))
  68. ((> velocity 3450) (values 2.894751026819746e-04 1.875))
  69. ((> velocity 3295) (values 4.349905111115636e-04 1.825))))
  70. (:g2)
  71. (:g3)
  72. (:g4)
  73. (:g5)
  74. (:g6)
  75. (:g7)
  76. (:g8)))
  77. (defun retard (drag-function drag-coefficient velocity)
  78. (declare (integer drag-function)
  79. (real drag-coefficient velocity))
  80. (let ((val -1)
  81. (a (ecase drag-function))
  82. (m (ecase drag-function)))
  83. ))
  84. ;;; Angular conversion functions
  85. (defun degrees-to-moa (degrees)
  86. "Converts degrees to Minutes of Angle."
  87. (declare (real degrees))
  88. (* degrees 60))
  89. (defun degrees-to-radians (degrees)
  90. "Converts Degrees to Radians"
  91. (declare (real degrees))
  92. (* degrees +to-radians+))
  93. (defun moa-to-degrees (moa)
  94. "Converts Minutes of Angle to Degrees"
  95. (declare (real moa))
  96. (/ moa 60))
  97. (defun moa-to-radians (moa)
  98. "Converts Minutes of Angle to Radians"
  99. (declare (real moa))
  100. (degrees-to-radians (moa-to-degrees moa)))
  101. (defun radians-to-degrees (radians)
  102. "Converts Radians to Degrees"
  103. (declare (real radians))
  104. (* radians +to-degrees+))
  105. (defun radians-to-moa (radians)
  106. "Converts Radians to Minutes of Angle"
  107. (declare (real radians))
  108. (degrees-to-moa (radians-to-degrees radians)))
  109. (export '(degrees-to-moa
  110. degrees-to-radians
  111. moa-to-degrees
  112. moa-to-radians
  113. radians-to-degrees
  114. radians-to-moa))
  115. ;;; Windage functions
  116. (defun windage (wind-speed initial-velocity range time)
  117. "Calculates the windage correction, in inches, to achive zero on
  118. target at given range."
  119. (declare (real wind-speed initial-velocity range time))
  120. (let ((wind-speed-inches-per-second (* wind-speed 17.60)))
  121. (* wind-speed-inches-per-second (/ (- time range) initial-velocity))))
  122. (defun head-wind (wind-speed wind-angle)
  123. "Calculates the Headwind component in miles per hour"
  124. (declare (real wind-speed wind-angle))
  125. (* (cos (degrees-to-radians wind-angle))
  126. wind-speed))
  127. (defun cross-wind (wind-speed wind-angle)
  128. "Calculates the crosswind components in miles per hour"
  129. (* (sin (degrees-to-radians wind-angle))
  130. wind-speed))
  131. (export '(windage
  132. head-wind
  133. cross-wind))
  134. ;;; Bore angle functions
  135. (defun zero-angle (drag-function ballistic-coefficient initial-velocity sight-height zero-range y-intercept)
  136. "Calculates the angle of the bore, relative to the sighting system in degrees."
  137. (declare (keyword drag-function)
  138. (real ballistic-coefficient
  139. initial-velocity
  140. sight-height
  141. zero-range
  142. y-intercept))
  143. (let ((nit 0)
  144. (dt (/ 1 initial-velocity))
  145. (y (/ sight-height 12))
  146. (x 0)
  147. (da 0)
  148. (v 0) (vx 0) (vy 0)
  149. (vx1 0) (vy1 0)
  150. (dv 0) (dvx 0) (dvy 0)
  151. (gx 0) (gy 0)
  152. (angle 0)
  153. (quit 0))
  154. (declare (real nit
  155. dt
  156. y
  157. x
  158. da
  159. v vx vy
  160. vx1 vy1
  161. dv dvx dvy
  162. gx gy
  163. angle)
  164. (integer quit))
  165. (iter)))
  166. ;;; Solving
  167. (defun solve-all (drag-function drag-coefficient initial-velocity sight-height shooting-angle zero-angle wind-speed wind-angle)
  168. "Generates a ballistic solutions table."
  169. (declare (keyword drag-function)
  170. (real drag-coefficient
  171. initial-velocity
  172. sight-height
  173. shooting-angle
  174. zero-angle
  175. wind-speed
  176. wind-angle)))
  177. ;;; Retrieving Data
  178. (defun get-range (solution yardage)
  179. "Retrieve range in yards.")
  180. (defun get-path (solution yardage)
  181. "Retrieves projectile pathin inches, relative to the line of sight at yardage.")
  182. (defun get-moa (solution yardage)
  183. "Retrieves the estimated elevation correction for zero at specified range.
  184. Very useful for \"click charts\" and similar.")
  185. (defun get-time (solution yardage)
  186. "Retrieves the time of flight to this range.")
  187. (defun get-windage (solution yardage)
  188. "Retrives the windage correction, in inches, required to achieve
  189. zero at this range.")
  190. (defun get-windage-moa (solution yardage)
  191. "Retrieves windage correction in MOA to achieve zero at this range.")
  192. (defun get-velocity (solution yardage)
  193. "Retrieves velocity of projectile at specified yardage.")
  194. (defun get-velocity-bore (solution yardage)
  195. "Retrives projectile's velocity in the direction of the bore.")
  196. (defun get-velocity-perpendicular (solution yardage)
  197. "Retireves the velocity of the projectile perpendicular to the
  198. direction of the bore.")