adding rules to all sites

au-bom-tides.lisp

@@ -3,11 +3,16 @@
 ;;;; http://www.bom.gov.au/cgi-bin/oceanography/tides/tide_predications.cgi?location=qld_59980&Submit.x=63&Submit.y=4&tide_hiddenField=Queensland&years=2010&months=Jan&dates=31
 
 ; dive-site : port | port+adjustment [rules]
-(defvar *dive-sites*
-  '(("Wolf Rock" "Noosa Head" #'wolf-rock)
-    ("Noosa Head" :same)
-    ("Mooloolaba" :same)
-    ("Brisbane Bar" :same)))
+(defparameter *dive-sites*
+  '(("Wolf Rock" "Noosa Head" 
+     (#'wolf-rock 
+      "The best trip dates - high tide between 10pm-midnight the day of the trip (so about 10:30AM-12:30 the next morning"))
+    ("Bundaberg" :same 
+     (#'bundaberg 
+      "The best dates - high tide in the morning after the trip starts (9am-midday)."))
+    ("Noosa Head" :same (#'day-filter "Shows all tides for trip days."))
+    ("Mooloolaba" :same (#'day-filter "Shows all tides for trip days."))
+    ("Brisbane Bar" :same (#'day-filter "Shows all tides for trip days."))))
 
 (defun make-dive-site (name)
   (assoc name *dive-sites* :test #'string=))
@@ -35,6 +40,9 @@
 (defun list-dive-sites ()
   (mapcar #'dive-site-site *dive-sites*))
 
+(defun list-dive-sites-with-rules ()
+  (mapcar #'dive-site-site (remove-if (complement #'dive-site-rules-fn) *dive-sites*)))
+
 (defvar *standard-ports* 
   '(("nsw_60130" "Yamba")
     ("qld_59300" "Abbot Point") 
@@ -267,7 +275,7 @@ month, and day."
 
 (defun tides-for-year (port-name year &key (sleep 3) (days 365))
   "Request tides from BOM website, week-at-a-time for 365 days, 
-starting at the beginning of Jan 1 of year. Format results to destination. 
+starting at the beginning of Jan 1 of year. 
 Sleep for sleep seconds between requests."
   (remove-if (curry #'timestamp<= (first-day (1+ year)))
 	     (iter
@@ -280,6 +288,14 @@ Sleep for sleep seconds between requests."
 					   (timestamp-day date))))
 	     :key (compose #'universal-to-timestamp #'first)))
 
+(defun write-tides-for-year (port-name year &key (sleep 3) (days 365))
+  "Request tides from BOM website, week-at-a-time for 365 days, 
+starting at the beginning of Jan 1 of year.
+Write tides to file based on port-name and year.
+Sleep for sleep seconds between requests."
+  (write-tides (tides-for-year port-name year :sleep sleep :days days) port-name year))
+
+;;;
 (defun format-tide-table (page year month day destination)
   "Read html page of tide table data (#p path, or string) for the year, 
 month, and day, and write it to the stream."
@@ -291,11 +307,6 @@ month, and day, and write it to the destination."
   (format destination "~s~%" 
 	  (parse-tide-table-from-uri port-name year month day)))
 
-(defun format-tides-for-year (port-name year destination &key (sleep 3) (days 365))
-  "Request tides from BOM website, week-at-a-time for 365 days, 
-starting at the beginning of Jan 1 of year. Format results to destination. 
-Sleep for sleep seconds between requests."
-  (format destination "~s~%" (tides-for-year port-name year :sleep sleep :days days)))
 
 ;;; reqd?
 

rules.lisp

@@ -1,6 +1,6 @@
 (in-package :au-bom-tides)
 
-
+;; ~12.5 hours between high tides
 (defun wolf-rock (tide &key (high-water 1.9) above-high-water 
 		  (trip-day "Fri") (hour-from 22) (hour-to 23))
   ;; test that for wolf-rock trip:
@@ -22,6 +22,22 @@
 					      (tide-height x) high-water))))
 	     tide))
 
+(defun bundaberg (tide &key (trip-day "Fri") (hour-from 21) (hour-to 23)
+		  high-water above-high-water)
+  ;; test that for bundaberg trip:
+  ;; high tide on the trip-start-day is between the hours hour-from and hour-to.
+  ;; or about 12.5 hours later the next day (default ~9:30am-12:30)
+  ;; if a high-tide value is specified, then the high is lower than this number
+  ;; (or above this number if above-high-water is true)
+  ;; (ie. default = High tide Sat morning if trip leaves Fri)
+  (remove-if #'(lambda (x) (not (and (eq :high (tide-high-low x)) 
+				     (string-equal trip-day (tide-day x))
+				     (<= hour-from (tide-hour x) hour-to)
+				     (or (null high-water)
+					 (funcall (if above-high-water #'>= #'<) 
+						  (tide-height x) high-water)))))
+	     tide))
+
 (defun day-num (time)
   "Number of the day this year."
   (- (day-of time) (day-of (timestamp-minimize-part time :month))))
@@ -47,3 +63,14 @@
 (defun wolf-rock-expanded (tides trip-day days-to-add)
   (expand-days tides #'(lambda (tides) (wolf-rock tides :trip-day trip-day))
 	       days-to-add))
+
+(defun bundaberg-expanded (tides trip-day days-to-add)
+  (expand-days tides #'(lambda (tides) (bundaberg tides :trip-day trip-day))
+	       days-to-add))
+
+(defun day-filter (tides trip-day days-to-add)
+  (expand-days tides #'(lambda (tides)
+			 (remove-if (complement (curry #'string-equal trip-day)) 
+				    tides :key #'tide-day))
+	       days-to-add))
+

tide.lisp

@@ -25,9 +25,11 @@
   (with-open-file (s (make-path location year))
     (read s)))
 
-(defun read-tides-path (path)
-  (with-open-file (s path)
-    (read s)))
+(defun write-tides (tides port-name year)
+  "Write tides to file based on port-name and year."
+  (with-open-file (s (make-path port-name year) 
+		     :direction :output :if-exists :supersede)
+    (format s "~s~%" tides)))
 
 (defun tide-day (tide)
   (fourth tide))

utilities.lisp

@@ -32,6 +32,11 @@
   "Add days to date."
   (adjust-timestamp date (offset :day days)))
 
+(defun next-short-day (short-day)
+  (aref +short-day-names+ 
+	(mod (1+ (position-if (curry #'string-equal short-day) 
+			      +short-day-names+ )) 7)))
+
 ;;; Recursive find 
 (defun rec-find-if (predicate tree)
   (if (null tree)