#lang racket

(require math/matrix)
(require math/array)
(require racket/draw)
(require pict)

(struct pt (x y) #:transparent)
(struct vec (dx dy) #:transparent)

(define (pt- p q)
  (let ([dx (- (pt-x p) (pt-x q))]
        [dy (- (pt-y p) (pt-y q))])
    (vec dx dy)))

(define (pt+ p v)
  (let ([x (+ (pt-x p) (vec-dx v))]
        [y (+ (pt-y p) (vec-dy v))])
    (pt x y)))

(define (pt-fliph p)
  (let ([x (- (pt-x p))]
        [y (pt-y p)])
    (pt x y)))

(define (vec+ u v)
  (let ([dx (+ (vec-dx u) (vec-dx v))]
        [dy (+ (vec-dy u) (vec-dy v))])
    (vec dx dy)))

(define (vec* c v)
  (let ([dx (* c (vec-dx v))]
        [dy (* c (vec-dy v))])
    (vec dx dy)))

(define (vec-dot u v)
  (let ([dx (* (vec-dx u) (vec-dx v))]
        [dy (* (vec-dy u) (vec-dy v))])
    (+ dx dy)))

(define (vec-neg v)
  (let ([dx (- (vec-dx v))]
        [dy (- (vec-dy v))])
    (vec dx dy)))

(define (pt-transform p m)
  (let* ([n (row-matrix [(pt-x p) (pt-y p) 1])]
        [o (matrix* n m)])
    (pt [array-ref o (vector 0 0)] [array-ref o (vector 0 1)])))

(define (vec-transform v m)
  (let* ([n (row-matrix [(vec-dx v) (vec-dy v) 1])]
         [o (matrix* n m)])
    (vec [array-ref o (vector 0 0)] [array-ref o (vector 0 1)])))

(define (vec-length v) (sqrt (vec-dot v v)))

(define (vec->pt v) (pt (vec-dx v) (vec-dy v)))
(define (pt->vec p) (vec (pt-x p) (pt-y p)))

(define (deg->rad n) (* n (/ (* 2 pi) 360)))
(define (rad->deg n) (* n (/ 360 (* 2 pi))))

(define (translation-matrix dx dy)
  (matrix [[1 0 0] [0 1 0] [dx dy 1]]))

(define (scale-matrix sx sy)
  (matrix [[sx 0 0] [0 sy 0] [0 0 1]]))

(define (rotation-matrix t)
  (matrix [[(cos t) (sin t) 0]
           [(- (sin t)) (cos t) 0]
           [0 0 1]]))

(define (tab a b) (translation-matrix a b))
(define (sab a b) (scale-matrix a b))
(define (rt t) (rotation-matrix t))

(define p1 (pt 5 8))
(define p2 (pt 1 1))
(define p3 (pt 5 4))
(define p4 (pt 8 5))

(define (draw-arrow dc p1 p2 pen)
  (define head-length 1)
  (define theta (deg->rad 30))
  (let* ([a (pt- p2 p1)]
         [t (/ head-length (vec-length a))]
         [v30 (vec* t a)]
         [v31 (vec-transform v30 (rt theta))]
         [v32 (vec-transform v30 (rt (- theta)))]
         [p4 (pt+ p2 (vec-neg v31))]
         [p5 (pt+ p2 (vec-neg v32))])
    (define old-pen (send dc get-pen))
    (define old-brush (send dc get-brush))
    (define path0 (new dc-path%))
    (define path1 (new dc-path%))
    (define path2 (new dc-path%))
    (send dc set-pen pen)
    (send path0 move-to (pt-x p1) (pt-y p1))
    (send path0 line-to (pt-x p2) (pt-y p2))
    (send path1 move-to (pt-x p4) (pt-y p4))
    (send path1 line-to (pt-x p2) (pt-y p2))
    (send path2 move-to (pt-x p5) (pt-y p5))
    (send path2 line-to (pt-x p2) (pt-y p2))
    (send dc draw-path path0)
    (send dc draw-path path1)
    (send dc draw-path path2)
    (send dc set-pen old-pen)
    (send dc set-brush old-brush)))

(define img
  (dc (λ (dc dx dy)
        (draw-arrow dc p1 p3 (new pen% [width 0.1] [color "blue"]))
        (draw-arrow dc p2 p1 (new pen% [width 0.1] [color "black"]))
        (draw-arrow dc p1 p4 (new pen% [width 0.1] [color "red"])))
      10 10))