ywatds/helpers.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
	   :with-integrally-indexed-entries :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 lua-number)
  (y 0 :type lua-number)
  (z 0 :type lua-number))

(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 with-integrally-indexed-entries ((hash-table key value start) &body body)
  (alexandria:with-gensyms (ht k v)
    `(let ((,ht ,hash-table))
       (when (hash-table-p ,ht)
	 (loop
	    for ,k = ,start then (1+ ,k)
	    for ,v = (gethash ,k ,ht)
	    while ,v
	    for ,(or key (gensym)) = ,k
	    and ,(or value (gensym)) = ,v
	    do (progn ,@body))))))

(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))))