102 lines
3.2 KiB
Common Lisp
102 lines
3.2 KiB
Common Lisp
(defpackage :advtrains-helpers
|
|
(:use :cl :parse-float)
|
|
(:nicknames :helpers :aux)
|
|
(:export :parse-lua-number :adj-vector-of
|
|
:v3d :make-v3d :v3d-x :v3d-y :v3d-z :v3d-p
|
|
:string-to-v3d :hash-table-to-v3d :v3d-dist
|
|
:with-integrally-indexed-entries :collect-integrally-indexed-entries
|
|
:collect-integrally-indexed-non-nil
|
|
:with-entries-in-hash-table))
|
|
(in-package :aux)
|
|
|
|
(defmacro adj-vector-of (element-type)
|
|
`(make-array 0
|
|
:element-type ,element-type
|
|
:adjustable t
|
|
:fill-pointer t))
|
|
|
|
(deftype lua-number () '(or float integer))
|
|
|
|
(defmacro parse-lua-number (str)
|
|
(alexandria:with-gensyms (n)
|
|
`(let ((,n (parse-float ,str :type 'real)))
|
|
(if (typep ,n 'ratio) (coerce ,n 'float) ,n))))
|
|
|
|
(defstruct v3d
|
|
(x 0 :type fixnum)
|
|
(y 0 :type fixnum)
|
|
(z 0 :type fixnum))
|
|
|
|
(defmacro v3d (x y z)
|
|
`(make-v3d :x ,x :y ,y :z ,z))
|
|
|
|
(defmethod print-object ((obj v3d) stream)
|
|
(with-accessors ((x v3d-x) (y v3d-y) (z v3d-z)) obj
|
|
(print-unreadable-object (obj stream)
|
|
(format stream "~a,~a,~a" x y z))))
|
|
|
|
(defmethod json:encode-json ((obj v3d) &optional json:*json-output*)
|
|
(with-accessors ((x v3d-x) (y v3d-y) (z v3d-z)) obj
|
|
(json:encode-json (list (cons "x" x)
|
|
(cons "y" y)
|
|
(cons "z" z)))))
|
|
|
|
(defmacro string-to-v3d (str)
|
|
(alexandria:with-gensyms (xs ys zs)
|
|
`(cl-ppcre:register-groups-bind
|
|
(,xs ,ys ,zs)
|
|
("^\\((-?[0-9]+),(-?[0-9]+),(-?[0-9]+)\\)$" ,str)
|
|
(when (and ,xs ,ys ,zs)
|
|
(make-v3d :x (parse-integer ,xs)
|
|
:y (parse-integer ,ys)
|
|
:z (parse-integer ,zs))))))
|
|
|
|
(defmacro hash-table-to-v3d (ht)
|
|
(alexandria:once-only
|
|
(ht)
|
|
`(make-v3d :x (gethash "x" ,ht)
|
|
:y (gethash "y" ,ht)
|
|
:z (gethash "z" ,ht))))
|
|
|
|
(defmacro v3d-to-string (obj)
|
|
(alexandria:with-gensyms (x y z)
|
|
`(with-accessors ((,x v3d-x) (,y v3d-y) (,z v3d-z))
|
|
,obj
|
|
(format nil "(~a,~a,~a)" ,x ,y ,z))))
|
|
|
|
(defmacro v3d-dist (from to)
|
|
(alexandria:once-only
|
|
(from to)
|
|
`(sqrt (+ (expt (- (v3d-x ,from) (v3d-x ,to)) 2)
|
|
(expt (- (v3d-y ,from) (v3d-y ,to)) 2)
|
|
(expt (- (v3d-z ,from) (v3d-z ,to)) 2)))))
|
|
|
|
(defmacro with-integrally-indexed-entries ((hash-table key value start) &body body)
|
|
(let ((i (gensym)) (k (or key (gensym))) (v (or value (gensym))) (ht (gensym)))
|
|
`(let ((,ht ,hash-table))
|
|
(when ,ht
|
|
(do* ((,i ,start (1+ ,i)) (,k ,i ,i) (,v (gethash ,i ,ht) (gethash ,i ,ht)))
|
|
((not ,v))
|
|
,@body)))))
|
|
|
|
(defmacro collect-integrally-indexed-entries ((result-type &body options) &body body)
|
|
(alexandria:with-gensyms (l)
|
|
`(let ((,l nil))
|
|
(with-integrally-indexed-entries ,options (push (progn ,@body) ,l))
|
|
(coerce (nreverse ,l) (quote ,result-type)))))
|
|
|
|
(defmacro collect-integrally-indexed-non-nil ((result-type &body options) &body body)
|
|
(alexandria:with-gensyms (l e)
|
|
`(let ((,l nil))
|
|
(with-integrally-indexed-entries ,options
|
|
(let ((,e (progn ,@body))) (when ,e (push ,e ,l))))
|
|
(coerce (nreverse ,l) (quote ,result-type)))))
|
|
|
|
(defmacro with-entries-in-hash-table ((hash-table &body indices) &body body)
|
|
(alexandria:once-only
|
|
(hash-table)
|
|
`(when (hash-table-p ,hash-table)
|
|
(let ,(loop for i in indices
|
|
collect `(,(car i) (gethash ,(cadr i) ,hash-table ,(caddr i))))
|
|
,@body))))
|