Commit ad73a43a authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Define reader macros in a named readtable and don't activate

parent 895f7864
;; Physical dimension system definition
;; Liam Healy
;; Time-stamp: <2014-01-14 21:10:05EST date-time.asd>
;; Time-stamp: <2014-10-06 23:13:35EDT date-time.asd>
;; Copyright 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -42,11 +42,12 @@
(asdf:defsystem-connection #:datime-pqd
:serial t
:requires (#:date-time #:physical-dimension)
:requires (#:date-time #:physical-dimension #:named-readtables)
:components
((:module date-time
:components
((:file "time-interval")
((:file "readtable")
(:file "time-interval")
(:file "relative-time")
(:file "linear-timepoint")
(:file "dtmath")))))
......
;; Mathematics on timepoints.
;; Liam Healy Fri Oct 12 2001 - 16:32
;; Time-stamp: <2013-03-24 19:33:27EDT dtmath.lisp>
;; Time-stamp: <2014-10-06 23:10:23EDT dtmath.lisp>
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -83,7 +83,8 @@
"Julian Day from J2000 epoch, and seconds from the start of the day."
(values
;; Days from J2000 epoch to the start of the UTC day; always integer + 0.5.
(cl:- (days- datime #d2000-01-01T12:00:00) 1/2)
(cl:- (days- datime (MAKE-TIMEPOINT :TIMEPARSE '(0 0 12 1 1 2000) :DAY-ONLY NIL :SCALE :UTC))
1/2)
;; Seconds from the start of the UTC day to the current timepoint.
;; No timescale is required because this is
;; only a difference from the start of the day.
......
;; Define a new readtable
;; Liam Healy 2014-09-28 22:27:28EDT readtable.lisp
;; Time-stamp: <2014-10-04 21:56:36EDT readtable.lisp>
;; Time-stamp: <2014-10-06 23:16:45EDT readtable.lisp>
;; Copyright 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -19,10 +19,11 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :antik)
(export 'antik)
(named-readtables:defreadtable antik
(:merge :standard)
(:macro-char #\# :dispatch)
(:dispatch-macro-char #\# #\_ #'read-physical-dimension-quantity)
(:dispatch-macro-char #\# #\d #'read-datime)
(:dispatch-macro-char #\# #\m #'grid:read-grid))
(:dispatch-macro-char #\# #\m #'grid::read-grid))
;; Time interval parsing and generating.
;; Liam Healy Thu May 2 2002 - 16:34
;; Time-stamp: <2014-01-14 21:21:06EST time-interval.lisp>
;; Time-stamp: <2014-10-06 22:37:13EDT time-interval.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -97,8 +97,7 @@
"How to format time intervals:
:tud = ISO8601 time-unit designator (like P10H7M23.726979085813582S)
:alternative = ISO8601 alternate (like P10:07:23.726979085813582)
nil = with the unit for time given by :system-of-units
(like #_36443.72697908581_S.")
nil = with the unit for time given by :system-of-units.")
(defun time-interval-format (pq &optional (stream t))
"Format the time interval ISO8601."
......
;; Physical dimension system definition
;; Liam Healy 2012-02-20 10:14:49EST physical-dimension.asd
;; Time-stamp: <2014-10-04 22:08:01EDT physical-dimension.asd>
;; Time-stamp: <2014-10-06 23:13:26EDT physical-dimension.asd>
;; Copyright 2012, 2013, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -32,8 +32,7 @@
((:module init
:serial t
:components
((:file "readtable")
(:file "pd-shadow-symbols")))
((:file "pd-shadow-symbols")))
(:module physical-quantities
:serial t
:components
......
;; Angles by component parts.
;; Liam Healy Thu May 30 2002 - 11:46
;; Time-stamp: <2013-03-24 19:01:15EDT angle-component.lisp>
;; Time-stamp: <2014-10-06 22:29:48EDT angle-component.lisp>
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -312,7 +312,7 @@
;;; (let ((asin (asin sine)))
;;; (if (minusp vertical-halfplane) (- pi asin) (if (minusp asin) (+ 2pi asin) asin)))
(defparameter *half-rev* #_1/2_revolution)
(defparameter *half-rev* (make-pq 1/2 'revolution))
(defmethod pq-magnitude :before ((angle angle))
;; I'm undecided on whether to use antik:atan etc. here vs. atan;
......
;; Functions on angles
;; Liam Healy Fri Mar 26 1999 - 13:48
;; Time-stamp: <2013-12-16 17:48:14EST angle.lisp>
;; Time-stamp: <2014-10-06 23:01:33EDT angle.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -81,7 +81,7 @@
(defun angle-as-time (angle &optional (normalize t))
"Convert the angle to a time (interval), where one revolution is a
complete day."
(antik:* #_1_day/revolution
(antik:* (make-pq 1 'day/revolution)
(normalize-angle angle normalize)))
(defvar *check-angle-limits* t
......@@ -113,7 +113,7 @@
(cl:/ (cl:abs minutes) +minutes-per-hour+)
(cl:/ (cl:abs seconds) +seconds-per-hour+)))))
(if hours
(antik:* (make-pq decimal 'hours) #_1_revolution/day)
(antik:* (make-pq decimal 'hours) (make-pq 1.0 'revolution/day))
(make-pq decimal 'degree))))
(defun time-as-angle (time-string)
......
;; Do calculations without physical dimension.
;; Liam Healy Wed Jun 22 2005 - 22:35
;; Time-stamp: <2013-06-02 23:13:22EDT undimension.lisp>
;; Time-stamp: <2014-10-06 22:32:24EDT undimension.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -25,14 +25,14 @@
#+example
(without-units ()
(multiple-value-bind (mag inpunits) (pqwu #_4_km)
(multiple-value-bind (mag inpunits) (pqwu (make-pq 4 'km))
(redimension (g+ mag 5) inpunits)))
;;; #_9.000000000000000_km
#+example
(without-units ()
(multiple-value-bind (mag inpunits)
(pqwu (list #_4_km/s #_5_km #_6_km))
(pqwu (list (make-pq 4 'km/s) (make-pq 5 'km) (make-pq 6 'km)))
(redimension (g+ mag (list 5 10 15)) inpunits)))
;;; (#_9.000000000000000_km/s #_15.000000000000000_km #_21.000000000000000_km)
......
;; Tests of physical quantities
;; Liam Healy 2011-01-09 17:38:41EST tests.lisp
;; Time-stamp: <2014-03-15 12:53:26EDT physical-quantities-grid.lisp>
;; Time-stamp: <2014-10-06 22:39:08EDT physical-quantities-grid.lisp>
;; Copyright 2011, 2013, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -25,14 +25,14 @@
(lisp-unit:define-test grid-scalar-units
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid #(#_1.0d0_m #_5.0d0_m)))
(let ((grid (vector (make-pq 1.0 'm) (make-pq 5.0 'm))))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
(check-pq (grid:aref grid 1) 5.0d0 'meter))))
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid (make-array '(2) :initial-contents '(#_1.0d0_m #_5.0d0_m))))
(let ((grid (make-array '(2) :initial-contents (list (make-pq 1.0 'm) (make-pq 5.0 'm)))))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment