ray.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp (ql:quickload '(:cffi :lispbuilder-sdl :lispbuilder-sdl-binaries) :silent t)
  )

(defpackage :ros.script.ray.3746070076
  (:use :cl))
(in-package :ros.script.ray.3746070076)

;;; helper functions
(defun line-cross-by-points (l1ax l1ay l1bx l1by l2ax l2ay l2bx l2by)
  (let ((ksi (- (* (- l2by l2ay)
                   (- l2bx l1ax))
                (* (- l2bx l2ax)
                   (- l2by l1ay))))
        (eta (- (* (- l1bx l1ax)
                   (- l2by l1ay))
                (* (- l1by l1ay)
                   (- l2bx l1ax))))
        (delta (- (* (- l1bx l1ax)
                     (- l2by l2ay))
                  (* (- l1by l1ay)
                     (- l2bx l2ax)))))
    (when (eq delta 0) (return-from line-cross nil))
    (let ((lambda* (/ ksi delta))
          (mu (/ eta delta)))
      (if (and (and (>= lambda* 0)
                    (<= lambda* 1))
               (and (>= mu 0)
                    (<= mu 1)))
          (list (+ l1ax (* lambda* (- l1bx l1ax)))
                (+ l1ay (* lambda* (- l1by l1ay))))
          nil))))

(defstruct point (x 0) (y 0))
(defstruct line (de (make-point)) (to (make-point)))

(defmethod line-cross ((line1 line) (line2 line))
  (line-cross-by-points (point-x (line-de line1))
              (point-y (line-de line1))
              (point-x (line-to line1))
              (point-y (line-to line1))
              (point-x (line-de line2))
              (point-y (line-de line2))
              (point-x (line-to line2))
              (point-y (line-to line2))))

(defmethod draw-line ((line line) &rest args)
  (apply #'sdl:draw-line
         (sdl:point :x (point-x (line-de line))
                    :y (point-y (line-de line)))
         (sdl:point :x (point-x (line-to line))
                    :y (point-y (line-to line)))
         args))

(defparameter *base-line*
  (make-line :de (make-point :x 0 :y 128)
             :to (make-point :x 512 :y 128)))
(defparameter *pointer-line*
  (make-line :de (make-point :x 64 :y 64)
             :to (make-point)))

(defun render ()
  (setf (point-x (line-to *pointer-line*)) (sdl:mouse-x))
  (setf (point-y (line-to *pointer-line*)) (sdl:mouse-y))
  (draw-line *pointer-line* :color sdl:*white*)
  (draw-line *base-line* :color sdl:*green*)
  (let ((crossing (line-cross *base-line* *pointer-line*)))
    (when crossing
      (sdl:draw-circle (sdl:point :x (car crossing) :y (cadr crossing)) 10 :color sdl:*red*))))

(defun main (&rest argv)
  (declare (ignorable argv))
  (sdl:with-init ()
    (sdl:window 480 480 :title-caption "ray")
    (setf (sdl:frame-rate) 60)

    (sdl:update-display)

    (sdl:with-events ()
      (:quit-event () t)
      (:key-down-event (:key key)
       (when (sdl:key= key :sdl-key-escape)
         (sdl:push-quit-event)))
      (:idle ()
       (sdl:clear-display sdl:*black*)
       (render)
       (sdl:update-display)))))
;;; vim: set ft=lisp lisp: