2012年6月27日水曜日

[Python]help関数とpydoc

Pythonの情報を得たい場合、help関数やpydocコマンドが便利なようです。
 ドキュメントの調べ方を知っていると、ググれない空間にとらわれても安心ですね。 

Pythonインタプリタでhelp("モジュール名やキーワード、トピック")としてhelp関数を呼び出すと、 対応するドキュメントが閲覧できます。
# ビルトイン関数のドキュメントを表示
>>> help("__builtin__")
# open関数のドキュメントを表示
>>> help("open")
pydocコマンドを使うとhelp関数と同じようなドキュメント閲覧をコマンドラインから行えます。
# モジュールのドキュメントを表示
pydoc glob
pydoc ctypes
# モジュール一覧を表示
pydoc modules
# キーワード一覧を表示(with,raiseなど)
pydoc keywords
# シンボル一覧を表示(+, u"など)
pydoc symbols
# トピック一覧を表示(DEBUGGING, LOOPINGなど)
pydoc topics
また、pydocはオプションを指定することでドキュメントをHTML形式にして出力したり、 Webサーバーを立ち上げてブラウザで閲覧できるようにしてくれたりするようです。
# ポート番号を指定してWebサーバーを起動
pydoc -p 9999
# HTMLで出力
pydoc -w os

2012年6月26日火曜日

[CL]Windowsでselect

CCL + CFFIでWindows上でselectしてみます。
(asdf:load-system :usocket)
(asdf:load-system :bordeaux-threads)
(asdf:load-system :cffi)

(defconstant FD-SETSIZE 64)

(cffi:defcstruct timeval
  (tv-sec :ulong)
  (tv-usec :ulong))

(cffi:defcstruct fd-set
  (fd-count :uint)
  (fd-array :uint :count 64))

(cffi:defcfun ("select" win-select) :int
  (nfds :int)
  (readfds :pointer)
  (writefds :pointer)
  (exceptfds :pointer)
  (timeout :pointer))

(defun fd-zero (set)
  (setf (cffi:foreign-slot-value set 'fd-set 'fd-count) 0))

(defun fd-set (fd set)
  (when (< (cffi:foreign-slot-value set 'fd-set 'fd-count) FD-SETSIZE)
    (setf (cffi:mem-aref (cffi:foreign-slot-pointer set 'fd-set 'fd-array)
    :uint
    (cffi:foreign-slot-value set 'fd-set 'fd-count))
   fd)
    (incf (cffi:foreign-slot-value set 'fd-set 'fd-count))))

(defun fd-isset (fd set)
  (cffi:foreign-funcall "__WSAFDIsSet" :uint fd ::pointer set :int))

(defun fd-clr (fd set)
  (loop
     :with count = (cffi:foreign-slot-value set 'fd-set 'fd-count)
     :with i = 0
     :while (<  i count)
     :if (= (cffi:mem-aref (cffi:foreign-slot-pointer set 'fd-set 'fd-array) :uint i) fd)
     :do (loop :while (< i (1- count))
     :do
     (setf (cffi:mem-aref (cffi:foreign-slot-pointer set 'fd-set 'fd-array) :uint i)
    (cffi:mem-aref (cffi:foreign-slot-pointer set 'fd-set 'fd-array) :uint (1+ i)))
     (incf i))
     (decf count)
     :else
     :do (incf i)
     :finally (setf (cffi:foreign-slot-value set 'fd-set 'fd-count) count)))


(defun test ()
  (let* ((listener (usocket:socket-listen "localhost" 8888 :reuse-address t))
  (listener-fd (ccl:socket-os-fd (usocket:socket listener)))
  (fds (list listener-fd))
  (fd-obj `((,listener-fd ,listener))))
    (format t "Listener Fd:~A~%" listener-fd)
  (cffi:with-foreign-object (set 'fd-set)
    (loop
       (fd-zero set)
       (dolist (fd fds) (fd-set fd set))
       (unless (= 0 (win-select
       (apply #'max fds)
       set
    (cffi:null-pointer) (cffi:null-pointer) (cffi:null-pointer)))
  (dolist (fd fds)
    (when (fd-isset fd set)
      (if (= fd listener-fd)
   (let* ((sock (usocket:socket-accept listener))
   (sock-fd (ccl:socket-os-fd (usocket:socket sock))))
     (format t "Accept~%")
     (force-output t)
     (push sock-fd fds)
     (push (list sock-fd sock) fd-obj))
   (progn
     (format t "ReadLine:~A~%"
      (read-line (usocket:socket-stream (second (assoc fd fd-obj)))))
     (force-output t))))))))))


;; (defparameter th (bordeaux-threads:make-thread #'test))
;; (defparameter *con* (usocket:socket-connect "localhost" 8888))
;; (format (usocket:socket-stream *con*) "Hello, World~%")
;; (force-output (usocket:socket-stream *con*))
;; (bordeaux-threads:destroy-thread th)

2012年6月23日土曜日

[Racket]クリップボードにある画像をファイルに保存する

クリップボードにあるデータが画像である場合に、ファイルに保存させてみます。
#lang racket

(require racket/gui/base
  (prefix-in srfi19: srfi/19))

(define (make-filename)
  (format "~A~A.png"
   "C:/path_to_save_dir/"
   (srfi19:date->string
    (srfi19:current-date)
    "~Y~m~d_~H~M~S_~N")))

(define (save-clipboard-bitmap)
  (let ((bm (send the-clipboard get-clipboard-bitmap 0)))
    (and bm
  (send bm save-file (make-filename) 'png))))

(exit
 (if (save-clipboard-bitmap) 0 1))
AutoHotKeyを使って適当なキーにこのプログラムの実行を割り当てれば、 PrintScreen+ファイル保存を1つのキーで実行できます。
実行可能ファイルの作成は raco exe や raco distribute で行えます。

> raco exe capture.rkt
> raco distribute directory_name capture.exe
Numpad0::                      ; テンキーの「0」に割り当て
  Send, {PrintScreen}          ; PrintScreen実行
  Run, "C:/path_to_exe_dir/capture.exe" ; プログラム実行
  Return

2012年6月21日木曜日

[Racket]MzCOMを利用してPowerShellからRacketを利用する

MzCOMを利用するとRacketをCOMオブジェクトとして利用できます。
たとえば以下のようにしてPowerShellからRacketの関数を呼び出せます。
$a = New-Object -ComObject "MzCOM.MzObj"
$a.Eval('(require racket/gui)')
$a.Eval('(message-box "title" "MzCom ")')
ただし、文字コードの扱いがうまくできていないっぽいです(バージョン5.2.1)

[Racket]OpenGLでテクスチャ

球にテクスチャを貼り付けてみます。掲示板やgistにあったコードを参考にしました。
#lang racket

(require sgl sgl/gl sgl/gl-vectors)
(require racket/gui)

;; argbをrgbaに変換
(define (argb->gl-rgba argb)
  (let* ((len (bytes-length argb))
   (buf (make-gl-ubyte-vector len)))
    (for ((i (in-range 0 len 4)))
  (gl-vector-set! buf (+ i 0) (bytes-ref argb (+ i 1)))
  (gl-vector-set! buf (+ i 1) (bytes-ref argb (+ i 2)))
  (gl-vector-set! buf (+ i 2) (bytes-ref argb (+ i 3)))
  (gl-vector-set! buf (+ i 3) (bytes-ref argb (+ i 0))))
    buf))

;; bitmapからargbのバイト列を取得
(define (bm->argb bm)
  (let* ((w (send bm get-width))
  (h (send bm get-height))
  (mask (send bm get-loaded-mask))
  (buf (make-bytes (* w h 4) 255)))
    (send bm get-argb-pixels 0 0 w h buf #f)
    (when mask
      (send bm get-argb-pixels 0 0 w h buf #t))
    buf))

;; テクスチャ読み込み
(define (load-texture path)
  (gl-enable 'texture-2d)
  (let* ((bm (make-object bitmap% path))
  (w (send bm get-width))
  (h (send bm get-height))
  (vec (argb->gl-rgba (bm->argb bm)))
  (tex (gl-vector-ref (glGenTextures 1) 0)))
    (glBindTexture GL_TEXTURE_2D tex)
    (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR)
    (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR)
    (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP)
    (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP)
    (gluBuild2DMipmaps GL_TEXTURE_2D GL_RGBA w h GL_RGBA GL_UNSIGNED_BYTE vec)
    tex))

(define current-texture #f)


;; OpenGLによる描画
(define (draw-gl)
  (gl-clear 'color-buffer-bit)
  (gl-push-matrix)
  (glBindTexture GL_TEXTURE_2D current-texture)
  (let ((q (gl-new-quadric))
 (list-id (gl-gen-lists 1)))
    (gl-quadric-texture q #t)
    (gl-quadric-draw-style q 'fill)
    (gl-new-list list-id 'compile)
    (gl-sphere q 0.5 20 20)
    (gl-end-list)
    (gl-call-list list-id))
  (gl-pop-matrix)
  (gl-flush))

(define gl-canvas%
  (class* canvas% ()
    (inherit with-gl-context swap-gl-buffers)
    ;; on-paintをオーバーライド
    (define/override (on-paint)
      (with-gl-context
       (lambda ()
  (draw-gl)
  (swap-gl-buffers))))
    ;; on-sizeをオーバーライド
    (define/override (on-size w h)
      (with-gl-context
       (lambda ()
  (gl-viewport 0 0 w h))))
    
    ;; canvas%のスタイルにglを指定
    (super-new [style '(gl)])))

(define top-level-frame
  (new frame%
       [label "OpenGL test"]
       [width 400]
       [height 400]))

(define canvas
  (new gl-canvas%
       [parent top-level-frame]))

(set! current-texture
 (send canvas with-gl-context
       (lambda () (load-texture "./texture.jpg"))))

(send top-level-frame show #t)

2012年6月20日水曜日

[Racket]GUIの中でOpenGLを利用する

RacketのGUIでは、canvas%クラスを利用してOpenGLによる描画を行えます。
#lang racket

(require sgl sgl/gl sgl/gl-vectors)
(require racket/gui)

;; OpenGLによる描画.
;; 関数やパラメータの形式にはRacket-StyleとC-Styleがある.
(define (draw-gl)
  (gl-clear 'color-buffer-bit)
  (gl-color 1.0 1.0 0.0)
  (gl-begin 'line-loop)
  (gl-vertex -0.9 -0.9)
  (gl-vertex 0.9 -0.9)
  (gl-vertex-v (gl-float-vector 0.9 0.9))
  (gl-vertex -0.9 0.9)
  (gl-end)
  (gl-flush))

(define gl-canvas%
  (class* canvas% ()
    (inherit with-gl-context swap-gl-buffers)
    ;; on-paintをオーバーライド
    (define/override (on-paint)
      (with-gl-context
       (lambda ()
  (draw-gl)
  (swap-gl-buffers))))
    ;; canvas%のスタイルにglを指定
    (super-new [style '(gl)])))

(define top-level-frame
  (new frame%
       [label "OpenGL test"]
       [width 400]
       [height 400]))

(define canvas
  (new gl-canvas%
       [parent top-level-frame]))

(send top-level-frame show #t)

2012年6月18日月曜日

gccの拡張機能無効化

日ごろ書いているのは'正しい'Cではない可能性が高いということに気付きました。 gccで拡張機能を無効にするには-pedanticオプションをつければよいようです。
gcc -pedantic test.c