Common Lispで直線と交点を描画する(lispbuilder-sdl)

交差するときは丸を表示する

交差しないときは表示しない

こういうのを作った

mf-atelier.sakura.ne.jp

上記サイトを参考にして，固定した線分と，一点がマウスで操作できる線分との交点を表示するコードを書いた． 図形描画ライブラリには lispbuilder-sdl を用いた．lispbuilder-sdlの操作には，Common LispでSTGを作りますが何か？を参考にした．

rosファイルを以下に示す．Roswellが動作する環境であれば，これを保存し，ros hogehoge.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 (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))))
        (lambda* (/ ksi delta))
        (mu (/ eta delta)))
    (if (and (and (>= lambda* 0)
                  (<= lambda* 1))
             (and (>= mu 0)
                  (<= mu 1)))
        `(t ,(+ l1ax (* lambda* (- l1bx l1ax)))
             ,(+ l1ay (* lambda* (- l1by l1ay))))
        nil)))

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

(defun render ()
  (sdl:draw-line (sdl:point :x (sdl:mouse-x) :y (sdl:mouse-y)) (sdl:point :x 64 :y 64) :color sdl:*white*)
  (sdl:draw-line (sdl:point :x 0 :y 128) (sdl:point :x 512 :y 128))
  (let ((crossing (line-cross (sdl:mouse-x) (sdl:mouse-y) 64 64 0 128 512 128)))
    (unless (null crossing)
      (sdl:draw-circle (sdl:point :x (cadr crossing) :y (caddr crossing)) 10 :color sdl:*red*)))
  )
;;; vim: set ft=lisp lisp: