脳汁でコードを書く

Archive for the ‘未分類’ Category

wordpressやーめた

金曜日, 4 月 2nd, 2010

wordpressがうざい. というかwebブラウザ経由なのがキニイラナイ.

そこで全部emacsのorg-modeからやることにした.

というわけでこのwordpressは今後更新されません, はい.

こっちのほうをミテネ

Posted in 未分類 | No Comments »

snow leopardでnurikabe

月曜日, 3 月 8th, 2010

このあいだのエントリーのpatchによってsnow leopard x sbclでnurikabeが動くようになりました.

nurikabeは私が作っているGUIライブラリです.

ソースコードはここから入手できます.

ちなみに, これのソースは以下のような感じです.

(require :nurikabe)
 
(defvar *manager* (nk:init-gui :loggingp t :threadingp t))
(defvar *win* (nk:make-window :width 300 :height 200
                              :background :white
                              :name "test window"))
(defvar *widget1* (nk:make-widget 'nk:<image-widget>
                                 :x 0 :y 0
                                 :width 150 :height 100
                                 :parent *win*
                                 :background :blue))
(defvar *widget2* (nk:make-widget 'nk:<image-widget>
                                 :x 150 :y 0
                                 :width 150 :height 100
                                 :parent *win*
                                 :background :green))
(defvar *widget3* (nk:make-widget 'nk:<image-widget>
                                  :x 0 :y 100
                                  :width 150 :height 100
                                  :parent *win*
                                  :background :red))
(defvar *widget4* (nk:make-widget 'nk:<image-widget>
                                  :x 150 :y 100
                                  :width 150 :height 100
                                  :parent *win*
                                  :background :white))
 
(nk:draw-line (nk:image-of *widget1*) 0 0 100 100)
(nk:draw-circle (nk:image-of *widget2*) 75 50 30)
(nk:draw-string (nk:image-of *widget3*) "NURIKABE" 0 0 :font-size 30)
(nk:draw-rectangle (nk:image-of *widget4*) 0 0 100 100)
 
(nk:render-widgets *win*)

Posted in common lisp, 未分類 | No Comments »

cl-vectorsとclxでttfフォントの描画をしてみる

日曜日, 6 月 28th, 2009

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

(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

Posted in 未分類 | No Comments »

cl-vectorsのチュートリアルをclxで

日曜日, 6 月 28th, 2009

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にするところがださい.

Posted in 未分類 | No Comments »

test from kaku.app

日曜日, 6 月 21st, 2009

テストです

Posted in 未分類 | No Comments »

okra on mac

日曜日, 6 月 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などやってみる.

Posted in 未分類 | 3 Comments »

心機一転

土曜日, 6 月 20th, 2009

色々と思うところがあって, blogなどをまめに更新していったりしようかと思う.

今日も明日もhogeる

Posted in 未分類 | No Comments »

さくらにGauche-dbd-mysqlを入れる

水曜日, 12 月 24th, 2008

めもめも

Gauche-dbd-mysql-0.2.2.tgz

すでにgaucheはいれてあるとすると

tarボールを解凍したあとに./configureまでやってMakefileをいじる

MYSQL_LIBSをいじる
libgauche.soが/home/username/libにあるとして

MYSQL_LIBS   = -L/usr/local/lib/mysql -lmysqlclient -lz -lcrypt -lm -Wl,--rpath,/home/username/lib -lgauche

みたいにする

./configure --prefix=/home/username

でよかったみたい
欝だお

Posted in scheme, 未分類 | 8 Comments »