Welcome to the CHICKEN Scheme pasting service

;; This library implements two dimmensional vector manipulation
(module euclid/vector (
                       make-vect vect? vect-x vect-y
                       zero-vector up down left right
                       dot vect-add vect-sub
                       norm rotate unit-vect scale)


        ;; External stuff


        ;; Provides fold
        (use srfi-1)

        ;; Not present in any standard Chicken library I'm aware of
        (define pi 3.1415)


        ;; Basic stuff


        ;; Vector type
        (define-record vect x y)

        ;; Checks whether the given vector is zero
        (define (zero-vect? v)
          (and (vect? v)
               (= (vect-x v)
                  (vect-y v)
                  0)))


        ;; Common vector values


        ;; An empty vector
        (define zero-vect
          (make-vect 0 0))

        ;; Direction vectors
        (define up (make-vect 0 1))
        (define left (make-vect 1 0))
        (define down (make-vect 0 -1))
        (define right (make-vect -1 0))


        ;; Binary (kinda) operators on vectors
        ;;
        ;; That a function is grouped in here doesn't necessarily mean it
        ;; accepts exactly two arguments.  But when supplied two it must behavs
        ;; like a binop


        ;; With no arguments -- returns the neutral element (the zero vector).
        ;;
        ;; With one argument -- returns it.
        ;;
        ;; With two or more arguments -- adds up the vectors given.
        (define (vect-add . vs) ;; FIXME: causes error

          (define (add-two a b)
            (make-vect (+ (vect-x a) (vect-x b))
                       (+ (vect-y a) (vect-y b))))

          (fold add-two zero-vect vs))

        ;; With one argument, inverts a vector.
        ;;
        ;; With two or more arguments -- subtracts all the others from the
        ;; first.
        (define (vect-sub first . rest)

          (define (inverse v)
            (make-vect (- (vect-x v))
                       (- (vect-y v))))

          (if (null? rest)
            (inverse first)
            (apply vect-add first (map inverse rest))))

        ;; Calculates the dot product of two vectors
        (define (dot a b)
          (+ (* (vect-x a) (vect-x b))
             (* (vect-y a) (vect-y b))))


        ;; Other vector related functions


        ;; Calculates the length of a vector
        (define (norm v)
          (sqrt (dot v v)))

        ;; Rotates a vector the given number of degrees
        (define (rotate deg v)
          (let* ((x (vect-x v))
                 (y (vect-y v))
                 (rad (* pi deg (/ 180)))
                 (cos (cos rad))
                 (sin (sin rad)))

            (make-vect (- (* x cos) (* y sin))
                       (+ (* x sin) (* y cos)))))

        ;; Creates a unit vector with the same direction as the given
        (define (unit-vect v)

          (if (zero-vect? v)
            (error "unit-vect -- Cannot normalise zero vector")

            (let ((len (norm v))
                  (x (vect-x v))
                  (y (vect-y v)))

              (make-vect (/ x len)
                         (/ y len)))))

        ;; Multiply a vector by a number
        (define (scale k v)
          (let ((x (vect-x v))
                (y (vect-y v)))

            (make-vect (* k x)
                       (* k y)))))