(library (strigoform math)
  (export fmod
          pi
          pi/2
          tau
          do-circle
          clamp
          smoothstep
          lerp

          s32-ref
          s32-set!
          f64-ref
          f64-set!

          vec2
          vec2?
          vec2-x
          vec2-y
          set-vec2-x!
          set-vec2-y!
          vec2-add!
          vec2-sub!
          vec2-mul-scalar!
          vec2-magnitude
          vec2-normalize!
          vec2-clamp!

          make-rect
          rect-x
          rect-y
          rect-w
          rect-h
          within?
          rect-within?)
  (import (scheme base)
          (scheme inexact)
          (only (hoot bytevectors)
                bytevector-s32-native-ref
                bytevector-s32-native-set!
                bytevector-ieee-double-native-ref
                bytevector-ieee-double-native-set!)
          (strigoform type))

  (define (assert-float x)
    (unless (and (number? x) (inexact? x) (rational? x))
      (error "expected inexact rational" x)))

  (define (fmod x y)
    (assert-float x)
    (assert-float y)
    (- x (* (truncate (/ x y)) y)))

  (define pi (* 4.0 (atan 1.0)))
  (define pi/2 (/ pi 2.0))
  (define tau (* pi 2.0))

  (define (do-circle proc k)
    (do ((i 0 (+ i 1)))
        ((= i k))
      (proc (* tau (inexact (/ i k))))))

  (define (clamp x min max)
    (cond ((< x min) min)
          ((> x max) max)
          (else x)))

  (define (smoothstep t)
    (* t t (- 3.0 (* 2.0 t))))

  (define (lerp start end alpha)
    (+ (* start (- 1.0 alpha))
       (* end alpha)))

  (define s32-ref bytevector-s32-native-ref)
  (define s32-set! bytevector-s32-native-set!)
  (define f64-ref bytevector-ieee-double-native-ref)
  (define f64-set! bytevector-ieee-double-native-set!)

  (define-type vec2
    make-vec2
    vec2?
    (bv vec2-bv set-vec2-bv!))
  (define (vec2 x y)
    (let ((v (make-vec2 (make-bytevector 16))))
      (set-vec2-x! v x)
      (set-vec2-y! v y)
      v))
  (define (vec2-x v)
    (f64-ref (vec2-bv v) 0))
  (define (vec2-y v)
    (f64-ref (vec2-bv v) 8))
  (define (set-vec2-x! v x)
    (f64-set! (vec2-bv v) 0 x))
  (define (set-vec2-y! v y)
    (f64-set! (vec2-bv v) 8 y))
  (define (vec2-add! v w)
    (set-vec2-x! v (+ (vec2-x v) (vec2-x w)))
    (set-vec2-y! v (+ (vec2-y v) (vec2-y w))))
  (define (vec2-sub! v w)
    (set-vec2-x! v (- (vec2-x v) (vec2-x w)))
    (set-vec2-y! v (- (vec2-y v) (vec2-y w))))
  (define (vec2-mul-scalar! v x)
    (set-vec2-x! v (* (vec2-x v) x))
    (set-vec2-y! v (* (vec2-y v) x)))
  (define (vec2-magnitude v)
    (sqrt (+ (* (vec2-x v) (vec2-x v)) (* (vec2-y v) (vec2-y v)))))
  (define (vec2-normalize! v)
    (unless (and (= (vec2-x v) 0.0) (= (vec2-y v) 0.0))
      (let ((m (vec2-magnitude v)))
        (set-vec2-x! v (/ (vec2-x v) m))
        (set-vec2-y! v (/ (vec2-y v) m)))))
  (define (vec2-clamp! v xmin ymin xmax ymax)
    (set-vec2-x! v (clamp (vec2-x v) xmin xmax))
    (set-vec2-y! v (clamp (vec2-y v) ymin ymax)))

  (define (make-rect x y w h)
    (let ((r (make-bytevector (* 8 4))))
      (f64-set! r 0 x)
      (f64-set! r 8 y)
      (f64-set! r 16 w)
      (f64-set! r 24 h)
      r))
  (define (rect-x r)
    (f64-ref r 0))
  (define (rect-y r)
    (f64-ref r 8))
  (define (rect-w r)
    (f64-ref r 16))
  (define (rect-h r)
    (f64-ref r 24))

  (define (within? x y rx ry rw rh)
    (and (>= x rx)
         (>= y ry)
         (< x (+ rx rw))
         (< y (+ ry rh))))
  (define (rect-within? ax ay aw ah bx by bw bh)
    (let ((ax* (+ ax aw))
          (ay* (+ ay ah)))
      (or (within? ax ay bx by bw bh)
          (within? ax* ay bx by bw bh)
          (within? ax* ay* bx by bw bh)
          (within? ax ay* bx by bw bh)))))