勉強中
http://blog.goo.ne.jp/torisu_tetosuki/e/209ad341d3ece2b1b4df24abf619d6e4
を参考に、PMDをsbclで表示してみました。
画像はとりあえずありません。
最初の速度がでない状態と、今の多少よくなった状態とのギャップが激しすぎてびっくり。
今回はじめて構造体を使ったのですが、アクセッサがものすごい長くなってしまって最初大変でした。
反省としては、関数や変数の名前の付け方が下手過ぎること。語彙増やさないと。
あとループの書方が定ってないこと。再帰でループがまだ書けないこと。
うまくコンパイルできないことの解決。キリないな。
pmdtest.asd
(require 'asdf) (asdf:defsystem #:pmdtest :depends-on (#:ieee-floats #:cl-opengl #:cl-glu #:cl-glut) :components ((:file "pmd") (:file "gl-pmd" :depends-on ("pmd"))))
pmd.lisp
(defpackage jp.narumij.pmd (:use :cl :ieee-floats)) (in-package jp.narumij.pmd) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun read-uint(in bytes) (let ((u 0)) (loop for i from 0 to (1- bytes) do (setf (ldb (byte 8 (* 8 i)) u) (read-byte in))) u)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun read-uint8 (in) (read-uint in 1)) (defun read-uint16 (in) (read-uint in 2)) (defun read-uint32 (in) (read-uint in 4)) (defun read-uint64 (in) (read-uint in 8)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun read-float (in) (decode-float32 (read-uint32 in))) (defun read-double (in) (decode-float64 (read-uint64 in))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun read-floats (in size) (loop for i from 1 to size collect (read-float in))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defstruct header "(+ 3 4 20 256) 283 byte" magic;char[3] version;float model-name;char[20] comment;char[256] ) (defstruct vertices "(+ 4 ?) 4 byte" count;dword list; list of vertex ) (defstruct vertex "(+ (* 4 3) (* 4 3) (* 4 2) (* 2 2) 1 1) 38 byte" pos;float[3] normal;float[3] uv;float[2] bone-num;word[2] bone-weight;byte edge-flag;byte ) (defstruct faces "(+ 4 ?) 4 byte" count;dword indices;word[3][?] ) (defstruct materials count;dward list ) (defstruct material "(+ 12 4 4 12 12 1 1 4 20) 46 byte" diffuse-color alpha specularity specular-color mirror-color toon-index edge-flag vertex-count texture-file-name ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun read-header (in) (loop for i from 1 to 283 do (read-uint8 in)) (make-header)) (defun read-vertices (in) (let ((count (read-uint32 in))) (make-vertices :count count :list (loop for i from 1 to count collect (progn (make-vertex :pos (read-floats in 3) :normal (read-floats in 3) :uv (read-floats in 2) :bone-num (list (read-uint16 in) (read-uint16 in)) :bone-weight (read-uint8 in) :edge-flag (read-uint8 in))))))) (defun read-faces (in) (let ((count (read-uint32 in))) (make-faces :count count :indices (loop for i from 1 to count collect (read-uint16 in))))) (defun read-materials (in) (let ((count (read-uint32 in))) (make-materials :count count :list (loop for i from 1 to count collect (make-material :diffuse-color (loop for i from 1 to 4 collect (if (< i 4 ) (read-float in) 1.0)) :alpha (read-float in) :specularity (read-float in) :specular-color (loop for i from 1 to 4 collect (if (< i 4 ) (read-float in) 1.0)) :mirror-color (loop for i from 1 to 4 collect (if (< i 4 ) (read-float in) 1.0)) :toon-index (read-uint8 in) :edge-flag (read-uint8 in) :vertex-count (read-uint32 in) :texture-file-name (loop for i from 1 to 20 collect (read-uint8 in))))))) (defun read-pmd (in) (let ((header (read-header in)) (vertices (read-vertices in)) (faces (read-faces in)) (materials (read-materials in))) (list :header header :vertices vertices :faces faces :materials materials ))) (defun open-byte-stream (filename) (open filename :element-type '(unsigned-byte 8))) (defun issue-vertex-lambda(vertex) (let ((position (vertex-pos vertex)) (normal (vertex-normal vertex))) (lambda()(progn (apply #'gl:normal normal) (apply #'gl:vertex position))))) (defun draw-triangles-of-faces-lambda (pmd start end) (let ((vertices (getf pmd :vertices)) (faces (getf pmd :faces))) (let ((v-lambda (mapcar #'(lambda (v) (issue-vertex-lambda v)) (mapcar #'(lambda(i)(nth (nth i (faces-indices faces)) (vertices-list vertices))) (loop for i from start to end collect i))))) (lambda() (gl:with-primitive :triangles (mapcar #'funcall v-lambda)))))) (defun draw-material-lambda(pmd material current-index) (let ((m material) (triangles (draw-triangles-of-faces-lambda pmd current-index (1- (+ current-index (material-vertex-count material)))))) (lambda () (progn (gl:material :front-and-back :emission (material-mirror-color m)) (gl:material :front-and-back :ambient (material-mirror-color m)) (gl:material :front-and-back :diffuse (material-diffuse-color m)) (gl:material :front-and-back :specular (material-specular-color m)) (gl:material :front-and-back :shininess (material-specularity m)) (funcall triangles))))) (defun draw-pmd-test-lambda(pmd) (let ((current-index 0) (materials (getf pmd :materials))) (loop for material in (materials-list materials) collect (let ((start current-index)) (setf current-index (+ current-index (material-vertex-count material))) (draw-material-lambda pmd material start)))))
gl-pmd.lisp
(in-package jp.narumij.pmd) (let ((in (open-byte-stream "miku.pmd"))) (defparameter *miku-draw* (draw-pmd-test-lambda (read-pmd in)))) (defparameter *use-light* nil) (defclass my-glut-window (glut:window) () (:default-initargs :pos-x 100 :pos-y 100 :width 400 :height 400 :mode '(:single :rgb :depth) :title "my-glut-window")) (defmethod glut:display-window :before ((w my-glut-window)) (gl:clear-color 0.1 0.1 0.1 0.1) (gl:clear-depth 1) (gl:shade-model :smooth) (if (not (null *use-light*)) (progn (gl:enable :lighting) (gl:enable :light0))) (gl:enable :depth-test) (gl:enable :normalize) ) (defmethod glut:reshape ((w my-glut-window) width height) (gl:viewport 0 0 width height) (cond (nil (progn (gl:matrix-mode :projection) (gl:load-identity) (glu:perspective 45 (/ width height) 3000 12000) (gl:matrix-mode :modelview) (gl:load-identity) (gl:translate 0 -1500 -7000))) ( (progn (gl:matrix-mode :projection) (gl:load-identity) (glu:perspective 45 (/ width height) 1 100) (gl:matrix-mode :modelview) (gl:load-identity) (gl:translate 0 -10 -30) (gl:rotate 180 0 1 0) )))) (defmethod glut:idle ((w my-glut-window)) (glut:post-redisplay)) (defmethod glut:display ((w my-glut-window)) (gl:clear :color-buffer :depth-buffer) (gl:color 1 1 1) (gl:rotate 1 0 1 0) (mapcar #'funcall *miku-draw*) (gl:flush) ) (defun my-glut-test () (glut:display-window (make-instance 'my-glut-window)) ) (setq *use-light* t) (my-glut-test)
PMDファイルは5.22に付属してたものをmiku.pmdに名称変更して使っています。
asdファイル足したら、(require 'pmdtest)で動くようになりました。