Commit fc3663dc authored by Dave Cooper's avatar Dave Cooper

trying to launch timer

parent 62410798
;;
;; FLAG -- put smtp functions into glisp.
;;
;;
;; FLAG -- sleazy hack of returning :gendl after side-effect requir'ing smtp on allegro.
;;
;;
"(:cl-smtp)"
\ No newline at end of file
......@@ -193,9 +193,12 @@
(end-timer-tasks
()
(the current-journal-entry (set-slot! :universal-time-end (get-universal-time)))
(the cancel-background-timer)
(the zero!))
(the zero!))
;;
;; FLAG -- split this into separate drift-check and zeroing of the values.
;;
(zero!
()
(unless (and (zerop (the timer-form-min value))
......@@ -217,6 +220,7 @@
()
(the timer-form-min restore-defaults!)
(the timer-form-sec restore-defaults!)
(the cancel-background-timer)
(when (the current-journal-entry)
(the entries (delete! (the current-journal-entry index)))
(the (restore-slot-default! :current-journal-entry))))
......
......@@ -25,27 +25,25 @@
(sleep 120)
#+allegro
(net.post-office:send-letter
*smtp-server*
"support@genworks.com"
"david.cooper@genworks.com"
(format nil "Dear Citizen,
(cl-smtp:send-email *smtp-server*
"support@genworks.com"
"david.cooper@genworks.com"
"Journal Entry needed"
(format nil "Dear Citizen,
Your latest time unit has expired and no journal entry has been
received. Please take care of this matter immediately at the following
location:
~a
http://genworks.com~a
Regards,
Bureau of Records Enforcement
The Ministry of Time
"
(the url))
:subject "Journal Entry needed"))
" (the url))))
(cancel-background-timer
......
......@@ -3,7 +3,7 @@
(asdf:defsystem #:timer :description
"The Gendl™ timer Subsystem" :author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150930" :depends-on nil
:version "20151024" :depends-on (:cl-smtp)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
......@@ -48,9 +48,6 @@
(args (rest (assoc "args" query :test #'string-equal)))
(*ipaddr* (socket:ipaddr-to-dotted (socket:remote-host (request-socket req)))))
(print-variables query args *ipaddr*)
(let ((args-list (base64-decode-list args)))
;;
;; FLAG -- consider a warning if package not found
......
This diff is collapsed.
......@@ -28,29 +28,61 @@
"This object makes a Cardinal Spline, which defaults to a Catmull-Rom Spline for nil tension-params (which means they all default to 0.0)"
:author "Dave Cooper, Genworks International")
:input-slots (control-points
:input-slots (through-points
(tension-params nil)
(periodic? nil))
(periodic? nil)
(alpha 0))
:computed-slots ((native-curve-iw (make-cardinal-spline *geometry-kernel*
:periodic? (the periodic?)
:tension-params (the tension-params)
:control-points (if (and (the periodic?)
(coincident-point? (first (the control-points))
(lastcar (the control-points))))
(butlast (the control-points))
(the control-points))))))
(coincident-point? (first (the through-points))
(lastcar (the through-points))))
(butlast (the through-points))
(the through-points))
:alpha (the alpha)))))
(define-object test-cardinal-spline (cardinal-spline)
(define-object test-uniform-cr (cardinal-spline)
:computed-slots
((through-points (list (make-point 0 0 0)
(make-point 1 1 0)
(make-point 1.1 1 0)
(make-point 2 0 0)))
(periodic? t)))
(define-object test-centripetal-cr (cardinal-spline)
:computed-slots
((alpha 0.5)
(through-points (list (make-point 0 0 0)
(make-point 1 1 0)
(make-point 1.1 1 0)
(make-point 2 0 0)))
(periodic? t)))
(define-object test-chordal-cr (cardinal-spline)
:computed-slots
((control-points (list (make-point 0 0 0)
(make-point 1 0 0)
((alpha 1)
(through-points (list (make-point 0 0 0)
(make-point 1 1 0)
(make-point 0 1 0)))
(make-point 1.1 1 0)
(make-point 2 0 0)))
(periodic? t)))
(periodic? t)))
\ No newline at end of file
This diff is collapsed.
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