skill.geometry.Points_generateHeartCurve

; -----------------------------------------------------------------------------
; (Points_generateHeartCurve boundaryRect [b])
; -----------------------------------------------------------------------------
; ハート型の点列を生成する汎用の関数。点列を順になぞると一筆書きのハート形状になる。
;   boundaryRect : 描画するハートが外接する四角形の座標（対向する二つの頂点のリスト）
;   b : ハートの形状を微調整するパラメーター。省略可能。規定値は 1.0。
;
; 《例》 (0.0, 0.0) - (20.0, 15.0) の矩形領域に外接するハート形状の点を生成する。
;
;   (Points_generateHeartCurve '((0.0 0.0) (20.0 15.0)))
;
; -----------------------------------------------------------------------------
; ※ 参考資料: http://www16.ocn.ne.jp/~akiko-y/heart/index_heart.html
; -----------------------------------------------------------------------------

(define (Points_generateHeartCurve boundaryRect @optional (b 1.0))
  (letseq
    (
    (heartCurve
      (let
        ((buffer nil) (pi (acos -1.0)) (theta 0))
        (while (lessp theta 360)
          (letseq
            (
            (x (cos (times pi (quotient theta 180.0))))
            (yb (times b (sqrt (abs x))))
            (ya (sqrt (difference 1.0 (times x x))))
            (y (if (lessp theta 180) (plus yb ya) (difference yb ya)))
            )
            (setq buffer (cons (list x y) buffer))
          )
          (setq theta (plus theta 5))
        )
        buffer
      )
    )
    (heartCurve_ys (mapcar 'cadr heartCurve))
    (heartCurve_ymin (apply 'min heartCurve_ys))
    (heartCurve_ymax (apply 'max heartCurve_ys))
    (heartCurve_yc (quotient (plus       heartCurve_ymax heartCurve_ymin) 2.0))
    (heartCurve_hH (quotient (difference heartCurve_ymax heartCurve_ymin) 2.0))
    (unitHeartCurve
      (mapcar
        (lambda (point)
          (list
            (car point)
            (quotient (difference (cadr point) heartCurve_yc) heartCurve_hH)
          )
        )
        heartCurve
      )
    )
    (xs (mapcar 'car  boundaryRect)) (width  (abs (apply 'difference xs))) (xmin (apply 'min xs))
    (ys (mapcar 'cadr boundaryRect)) (height (abs (apply 'difference ys))) (ymin (apply 'min ys))
    )
    (mapcar
      (lambda (point)
        (list
          (plus xmin (times (plus (car  point) 1.0) 0.5 width ))
          (plus ymin (times (plus (cadr point) 1.0) 0.5 height))
        )
      )
      unitHeartCurve
    )
  )
)