From 125a6090de1df0b1a04f2f03b94b501a0d5bcc73 Mon Sep 17 00:00:00 2001 From: YoheiKakiuchi Date: Fri, 25 Sep 2015 11:37:46 +0900 Subject: [PATCH] add :make-pqpmodel method to glvertices --- irteus/irtgl.l | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/irteus/irtgl.l b/irteus/irtgl.l index 027ba3805..663c4a0d9 100644 --- a/irteus/irtgl.l +++ b/irteus/irtgl.l @@ -1165,6 +1165,54 @@ if flat option is true, use-flat-shader" (unless bbox (send self :calc-bounding-box)) bbox) + (:make-pqpmodel (&key (fat 0)) + (let ((m (geo::pqpmakemodel)) + v1 v2 v3 (id 0)) + (dolist (mesh mesh-list) ;; check triangle model + (let ((tp (cadr (assoc :type mesh)))) + (unless (eq tp :triangles) + (warn ";; not supported mesh type -> ~A" tp) + (geo::pqpdeletemodel m) + (return-from :make-pqpmodel nil)))) + (setq v1 (float-vector 0 0 0)) + (setq v2 (float-vector 0 0 0)) + (setq v3 (float-vector 0 0 0)) + (geo::pqpbeginmodel m) + (dolist (mesh mesh-list) + (let* ((vlst (cadr (assoc :vertices mesh))) + (idces (cadr (assoc :indices mesh))) + (idlen (* (/ (length idces) 3) 3))) + (cond + (idces + (do ((v 0 (+ v 3))) + ((>= v idlen)) + (user::c-matrix-row vlst (elt idces v ) v1) + (user::c-matrix-row vlst (elt idces (+ v 1)) v2) + (user::c-matrix-row vlst (elt idces (+ v 2)) v3) + (when (not (= fat 0)) + (v+ v1 (scale fat (normalize-vector v1)) v1) + (v+ v2 (scale fat (normalize-vector v2)) v2) + (v+ v3 (scale fat (normalize-vector v3)) v3)) + (geo::pqpaddtri m v1 v2 v3 id) + (incf id) + )) + (t + (do ((v 0 (+ v 3))) + ((>= v (array-dimension vlst 0))) + (user::c-matrix-row vlst v v1) + (user::c-matrix-row vlst (+ v 1) v2) + (user::c-matrix-row vlst (+ v 2) v3) + (when (not (= fat 0)) + (v+ v1 (scale fat (normalize-vector v1)) v1) + (v+ v2 (scale fat (normalize-vector v2)) v2) + (v+ v3 (scale fat (normalize-vector v3)) v3)) + (geo::pqpaddtri m v1 v2 v3 id) + (incf id) + ))) + )) + (geo::pqpendmodel m) + m + )) ) ;;;