脳汁でコードを書く

10 月 9
テクスチャに対応.こんな感じ.



textured cube
textured cube



(require :komainu)
(use-package :komainu)
(use-package :nurarihyon)
(use-package :nurikabe)
 
(defvar *viewer* (make-komainu-viewer :loggingp t))
(defvar *a* (make-cube 100.0 100.0 100.0 :color :red))
(defvar *im* (make-image :width 300 :height 300 :background :green))
(draw-string *im* "Hoge" 150 150
             :font-size 0.03
             :color :black)
(paste-texture (car (faces-of *a*)) *im*
               (list (float-vector 0 1)
                     (float-vector 0 0)
                     (float-vector 1 0)
                     (float-vector 1 1)))
(objects *viewer* (list *a*))

このために, clxのGLX, OpenGLのバインディングを捨てて, すべてcffiでバインディングを1から作り直すことにした.

ちなみに, 2Dの描画はcl-vectorsをつかってベクター描画.

common lisp No Comments

10 月 4

snow leopardでsbclのbuildにてこずったのでメモ

まずいまのstable版ではmakeが通らない.
以下のようなエラーが出る.

//entering make-target-1.sh
//building runtime system and symbol table file
rm -f *.[do] sbcl sbcl.nm sbcl.h core *.tmp
echo '#include "genesis/config.h"' >sbcl.h
echo '#include "genesis/constants.h"' >>sbcl.h
gcc -g -Wall -O2 -fdollars-in-identifiers -mmacosx-version-min=10.4 -I. -no-cpp-precomp  -c -o alloc.o alloc.c
In file included from alloc.c:21:
runtime.h: In function 'CONS':
runtime.h:151: warning: cast to pointer from integer of different size
runtime.h: In function 'SYMBOL':
runtime.h:157: warning: cast to pointer from integer of different size
runtime.h: In function 'FDEFN':
runtime.h:163: warning: cast to pointer from integer of different size
/var/folders/3K/3K4LXRIJHoq8UNahYP7P4U+++TI/-Tmp-//cck88adh.s:81:Incorrect register `%rbx' used with `l' suffix
/var/folders/3K/3K4LXRIJHoq8UNahYP7P4U+++TI/-Tmp-//cck88adh.s:578:Incorrect register `%rdx' used with `l' suffix
make: *** [alloc.o] Error 1

x86, x86_64にするとか1.0.30のバイナリをつかうとかいろいろ試してみたけど, 最終的にcvsの先端だとバグがfixされている模様

$ cvs -d :pserver:anonymous@sbcl.cvs.sourceforge.net:/cvsroot/sbcl co sbcl

そしたら, multi threadつかいたいのでsbcl/customize-target-features.lispというファイルを作る

(lambda (features)
      (flet ((enable (x)
               (pushnew x features))
             (disable (x)
               (setf features (remove x features))))
        ;; Threading support, available only on x86/x86-64 Linux, x86 Solaris
        ;; and x86 Mac OS X (experimental).
        (enable :sb-thread)))

次にsbcl/sbclcomprというのを作る

SBCL_HOME=/usr/local/lib/sbcl /usr/local/bin/sbcl $*

そんでもって

$ sh make.sh "sbclcompr"
$ sudo sh install.sh

なんかrun-tests.shが大量のエラーをはいてるけど, みなかったことにしよう…

追記:

sh run-tests.shの結果

Finished running tests.
Status:
 Expected failure:    float.pure.lisp / (SCALE-FLOAT-OVERFLOW BUG-372)
 Expected failure:    float.pure.lisp / (ADDITION-OVERFLOW BUG-372)
 Expected failure:    threads.pure.lisp / WITHOUT-INTERRUPTS+CONDITION-WAIT
 Expected failure:    callback.impure.lisp / UNDERFLOW-DETECTION
 Invalid exit status: clos-add-remove-method.impure.lisp
 Invalid exit status: clos-cache.impure.lisp
 Invalid exit status: clos-interrupts.impure.lisp
 Invalid exit status: compare-and-swap.impure.lisp
 Invalid exit status: debug.impure.lisp
 Expected failure:    external-format.impure.lisp / (CHARACTER-DECODE-LARGE
                                                     FORCE-END-OF-FILE)
 Invalid exit status: gc.impure.lisp
 Invalid exit status: hash.impure.lisp
 Expected failure:    packages.impure.lisp / USE-PACKAGE-CONFLICT-SET
 Expected failure:    packages.impure.lisp / IMPORT-SINGLE-CONFLICT
 Invalid exit status: profile.impure.lisp
 Invalid exit status: threads.impure.lisp
 Invalid exit status: timer.impure.lisp
 Invalid exit status: core.test.sh
test failed, expected 104 return code, got 1

common lisp, os x No Comments

10 月 2

色とcylinderを追加してみた

こんなかんじ

komainu-viewer2

komainu-viewer2

 (require :komainu)
(use-package :komainu)
(use-package :nurarihyon)
(defvar *viewer* (make-komainu-viewer))
(defvar *a* (make-cube 100.0 100.0 100.0 :color :red))
(defvar *b* (make-cube 100.0 100.0 100.0 :color :green))
(translate (coords-of *a*) (float-vector 0 100 0))
(translate (coords-of *b*) (float-vector 0 -100 0))
(objects *viewer* (list *a* *b* *world-coords*
                        (make-cylinder 100 100)))

common lisp No Comments

10 月 1

最近というかこの一瞬間くらいで猛烈に実装しているのですが, 幾何ライブラリとそのビューワーをせっせと作ってます.

これくらいのコードで

(require :komainu)
 
(defvar *viewer* (komainu:make-komainu-viewer))
 
(komainu:objects *viewer* (komainu:make-cube 100 100 100))

こんなかんじの表示が出ます.

komainu viewer

komainu viewer

ちなみにkomainuっていうパッケージが幾何ライブラリ.

依存するライブラリとしてはchimi(ユーティリティライブラリ), nurarihyon(数学ライブラリ), nurikabe(GUIライブラリ)があります.

もうちょっとできて, いろいろと落ち着いたら公開します.

描画系はclxを叩いてglxでGLの関数を呼んでいます. clxのバグがいくつか発見されたので, どうしようかなーと悩み中

描画系のモットーはインタプリタからの対話性を重視

common lisp No Comments

9 月 6

CL::log5

icon9 月 6th, 2009

CLのloggerであるlog5についてまとめてみた.

これがloggerとしては標準なのかな?

http://garaemon.net/dokuwiki/doku.php?id=programming:lisp:commonlisp:log5

common lisp No Comments

8 月 1

たまにはロボット研究者らしい記事でも書こう.

というわけでros

これはWillow Garageっていうアメリカの会社が開発してる.

WGはOpenCVとかもメインでサポートしてる.

rosはopencvとかいろいろつかったロボット用のソフトウェア.OpenRTMを想像すれば大体OK.

# 開発者によれば色々違う!と言いたいところだろうが, 使う側としてはどっちも似たような感じ

OpenRTMと違っているのはすでにアプリケーションが充実. 2dnavっていう経路計画ソフトとかはだいぶ凄い.

というわけで本題のインストール 基本的にはここにしたがっていけばOK

確認環境はubuntu 8.04 on VMWare

sudo aptitude install libcppunit-dev #これが必要だったけど, すでにdebugされてるかも
wget http://ros.sf.net/rosconfig -O ~/rosconfig
chmod 755 ~/rosconfig
~/rosconfig bootstrap -s http://ros.sf.net/config/stable.rosconfig ~/ros move_base_stage

これでしばしまつ.
boostとかmakeしはじめるのでだいぶ時間かかる

で、環境変数とか設定するために以下をおこなう

~/rosconfig setup ~/ros > ~/.bashrc.ros
echo "source ~/.bashrc.ros" >> ~/.bashrc

要注目コマンドがいくつか定義されてることに注意.

roscdとかrosapt-getとかrosmakeとか

特にrosapt-getとrosmakeは超重要.

データ可視化ソフトであるrviz位まではmakeしておく良い.

rosapt-get rviz
rosmake rviz

こんな感じでパッケージをmakeするまえにrosapt-getして, それからrosmakeする.

rvizはOgreとかmakeしはじめるのでこれまた結構時間がかかる.

WGでは信じられないペースでcommitされてるので, 1日で結構変わってたりすることにも注意.

動かし方とかはまた次回

robot No Comments

6 月 28

前回に引き続き今度はフォントの描画をしてみる

(require :cl-vectors)
(require :zpb-ttf)
(require :cl-aa-misc)
(require :cl-paths-ttf)
(require :clx)
 
(defvar *font-path* "/your/path/to/ttf/font.ttf")
(defvar *display* (xlib:open-display ""))
(defvar *root-screen* (car (xlib:display-roots *display*)))
(defvar *root-window* (xlib:screen-root *root-screen*))
 
(defvar *win* (xlib:create-window :parent *root-window*
                                  :x 0 :y 0
                                  :width 300 :height 200))
 
(defvar *gc* (xlib:create-gcontext
              :drawable *root-window*))
 
(xlib:map-window *win*)
 
(defun make-image-array (base width height)
  (let ((ret (make-array (* width height 4) :element-type '(UNSIGNED-BYTE 8)
                         :initial-element 0)))
    (let ((dims (array-dimensions base)))
      (dotimes (i (car dims))
        (dotimes (j (cadr dims))
          (setf (aref ret (+ (* (+ (* i width) j) 4) 0)) (aref base i j 0))
          (setf (aref ret (+ (* (+ (* i width) j) 4) 1)) (aref base i j 1))
          (setf (aref ret (+ (* (+ (* i width) j) 4) 2)) (aref base i j 2))
          ))
      ret)))
 
(defun test-cl-vectors (func)
  (let ((height 200)
        (width 300))
    (let ((array (make-image-array (funcall func width height) width height)))
      (let ((image (xlib:create-image :data array
                                    :depth 24
                                    :bits-per-pixel 32
                                    :width width
                                    :height height
                                    :FORMAT              :Z-PIXMAP
                                    )))
        (xlib:put-image *win*
                        *gc*
                        image
                        :x 0
                        :y 0
                        :src-x 0
                        :src-y 0
                        :width width
                        :height height
                        )
        (xlib:display-finish-output *display*)
        t))))
 
 
(defun test1 (width height)
  (zpb-ttf:with-font-loader (loader *font-path*)
    (let ((paths (paths-ttf:paths-from-string loader "Hello World!"
                                              :offset (paths-ttf::make-point 0 100)
                                              :scale-x 0.05
                                              :scale-y -0.05))
          (state (aa:make-state))
          (image (aa-misc:make-image width height #(255 255 255))))
      (let ((put-pixel (aa-misc:image-put-pixel image #(0 0 0))))
        (aa:cells-sweep (vectors::update-state state paths) put-pixel)
        image))))
 
;; (test-cl-vectors #'test1)

こんな感じ

Hello World

Hello World

未分類 No Comments

6 月 28

cl-vectorsを利用したいのでその第一段.

cl-vectorsのチュートリアルはこちら.

(require :cl-vectors)
(require :cl-aa-misc)
(require :clx)
 
(defvar *display* (xlib:open-display ""))
(defvar *root-screen* (car (xlib:display-roots *display*)))
(defvar *root-window* (xlib:screen-root *root-screen*))
 
(defvar *win* (xlib:create-window :parent *root-window*
                                  :x 0 :y 0
                                  :width 300 :height 200))
 
(defvar *gc* (xlib:create-gcontext
              :drawable *root-window*))
 
(xlib:map-window *win*)
 
(defun make-simple-image-array ()
  (let ((height 200)
        (width 300))
    (let ((image (let ((state (aa:make-state)))
                   (aa:line-f state 200 50 250 150)
                   (aa:line-f state 250 150 50 100)
                   (aa:line-f state 50 100 200 50)
                   (let* ((image (aa-misc:make-image width height #(255 255 255)))
                          (put-pixel (aa-misc:image-put-pixel image #(0 0 0))))
                     (aa:cells-sweep state put-pixel)
                     image))))
      image)))
 
(defun make-image-array (base width height)
  (let ((ret (make-array (* width height 4) :element-type '(UNSIGNED-BYTE 8)
                         :initial-element 0)))
    (let ((dims (array-dimensions base)))
      (dotimes (i (car dims))
        (dotimes (j (cadr dims))
          (setf (aref ret (+ (* (+ (* i width) j) 4) 0)) (aref base i j 0))
          (setf (aref ret (+ (* (+ (* i width) j) 4) 1)) (aref base i j 1))
          (setf (aref ret (+ (* (+ (* i width) j) 4) 2)) (aref base i j 2))
          ))
      ret)))
 
(defun test-cl-vectors (func)
  (let ((height 200)
        (width 300))
    (let ((array (make-image-array (funcall func width height) width height)))
      (let ((image (xlib:create-image :data array
                                    :depth 24
                                    :bits-per-pixel 32
                                    :width width
                                    :height height
                                    :FORMAT              :Z-PIXMAP
                                    )))
        (xlib:put-image *win*
                        *gc*
                        image
                        :x 0
                        :y 0
                        :src-x 0
                        :src-y 0
                        :width width
                        :height height
                        )
        (xlib:display-finish-output *display*)
        t))))
 
(defun test1 (width height)
  (let ((image (let ((state (aa:make-state)))
                   (aa:line-f state 200 50 250 150)
                   (aa:line-f state 250 150 50 100)
                   (aa:line-f state 50 100 200 50)
                   (let* ((image (aa-misc:make-image width height #(255 255 255)))
                          (put-pixel (aa-misc:image-put-pixel image #(0 0 0))))
                     (aa:cells-sweep state put-pixel)
                     image))))
    image))
 
(defun test2 (width height)
  (let ((state (aa:make-state)))       ; create the state
  ;; the 1st triangle
  (aa:line-f state 200 50 250 150)   ; describe the 3 sides
  (aa:line-f state 250 150 50 100)   ; of the first triangle
  (aa:line-f state 50 100 200 50)
  ;; the 2nd triangle
  (aa:line-f state 75 25 10 75)      ; describe the 3 sides
  (aa:line-f state 10 75 175 100)    ; of the second triangle
  (aa:line-f state 175 100 75 25)
  (let* ((image (aa-misc:make-image width height #(255 255 255)))
         (put-pixel (aa-misc:image-put-pixel image #(0 0 0))))
    (aa:cells-sweep state put-pixel) ; render it
    image))
  )
 
(defun test3 (width height)
  (let ((state1 (aa:make-state))
        (state2 (aa:make-state)))
    ;; the 1st triangle
    (aa:line-f state1 200 50 250 150)   ; describe the 3 sides
    (aa:line-f state1 250 150 50 100)   ; of the first triangle
    (aa:line-f state1 50 100 200 50)
    ;; the 2nd triangle
    (aa:line-f state2 75 25 10 75)      ; describe the 3 sides
    (aa:line-f state2 10 75 175 100)    ; of the second triangle
    (aa:line-f state2 175 100 75 25)
    (let ((image (aa-misc:make-image width height #(255 255 255))))
      (aa:cells-sweep state1 (aa-misc:image-put-pixel image #(255 0 0)))
      (aa:cells-sweep state2 (aa-misc:image-put-pixel image #(0 0 255)))
      image)))
 
;; (test-cl-vectors #'test1)
;; (test-cl-vectors #'test2)
;; (test-cl-vectors #'test3)

こんな感じ.

tutorial 1

tutorial 1

tutorial 2

tutorial 2

tutorial 3

tutorial 3

#3Aのベクトルを#1Aにするところがださい.

未分類 No Comments

6 月 21

test from kaku.app

icon6 月 21st, 2009

テストです

未分類 No Comments

6 月 21

okra on mac

icon6 月 21st, 2009

okraがmacで動いたのでメモ.

  • mac用のOgreSDKを落として, OgreSDK/Dependencies以下のframeworkを/Library/Frameworks以下にコピーする
  • okra-1.6.2.1a1/libokra/srcの*.hにCarbon/Carbon.hを追加する
// for mac
 
#include <Carbon/Carbon.h>
  • 以下のようなMakefileを作る
CXX     = g++
RM      = rm -f
CFLAGS  = -I/Library/Frameworks/Ogre.framework/Headers \
          -I/Library/Frameworks/CEGUI.framework/Headers
LDFLAGS = -framework Ogre -framework Cg -framework CEGUI
SHARED  = -dynamiclib
CXXSRC  = ogre-camera.cpp ogre-entity.cpp ogre-light.cpp ogre-manual-object.cpp \
          ogre-node.cpp ogre-overlay-element.cpp ogre-overlay-manager.cpp \
	  ogre-overlay.cpp ogre-plane.cpp ogre-render-window.cpp \
	  ogre-resource-group-manager.cpp ogre-root.cpp \
	  ogre-scene-manager.cpp ogre-scene-node.cpp ogre-timer.cpp \
	  ogre-viewport.cpp ogre-window-event-utilities.cpp
OBJS    = $(subst .cpp,.o, $(CXXSRC))
TARGET  = ../../lib/libokra.dylib
INSTALL = cp
.PHONY: all clean
all: $(TARGET)
 
$(TARGET): $(OBJS)
	$(CXX) $(SHARED) -o $@ $^ $(LDFLAGS)
.cpp.o:
	$(CXX) -c $< $(CFLAGS)
 
clean:
	$(RM) *.o $(TARGET)
install:
	$(INSTALL) $(TARGET) /usr/local/lib/
  • src-bindings/ogre-lib.lispを編集
(define-foreign-library libokra
  (:windows "libokra.dll")
  (:darwin "libokra.dylib")
  (:unix "libokra.so")
  (t "libokra"))
  • examples/simple-okra.lispにASDFとか書いているので修正
(require 'asdf)
(asdf:operate 'asdf:load-op :okra)
  • libokra/srcでmake, make install
  • examples/simple-okra.lispなどやってみる.

未分類 3 Comments

Previous Entries
Next Entries

Archives

2010 年 9 月
月 火 水 木 金 土 日
« 4 月    
 12345
6789101112
13141516171819
20212223242526
27282930  

Other

Syndication