newLISP on canvas
久しぶりにSDを買った。なぜ関数型プログラミングは難しいのか？ なんて特集が組まれて いたから。これFAQ もとえ、雑誌社には美味しい題材なんでしょうな。一年毎に繰り返されて、 オイラーみたいに乗せられてしまう人が居るからな。
オイラーにとちゃ、関数型よりオブジェクト嗜好の方がブラックボックスで難しいと思うぞ。 ちょいとプログラムを組むのに、何でクラスなんて面倒な事を考えなきゃいかんのかね？ 無い資源（思考力）を無駄に消費してると思うぞ。まあ、guiに手を出さなければ、オブジェクト 嗜好に毒される事もなかろう。
関数型と言えばHaskell。小難しい事をかんがえなければ（それって、モナドとかあれの事だな） 書くのは容易だ。数式をそのまま、書き下せばいいのだから。難しいのは、その数式を 導き出すまでだ。って事は、やっぱり数学か。
Javaの上で動く関数型が取り上げられていた。Scalaとclojure。やはり２つ並べられると、 clojureの方に目が行く。目を放していた隙に、 「Clojure 1.7」がリリースって事らしい。 Qiitaにも結構逃行が上がってた。
fedoraに入れてみた。
[sakae@fedora clojure-1.7.0]$ java -jar clojure-1.7.0.jar
Clojure 1.7.0
user=> (defn f [n]
(if (= n 0)
1
(* n (f (dec n)))))
#'user/f
user=> (f 30)
ArithmeticException integer overflow clojure.lang.Numbers.throwIntOverflow (Numbers.java:1501)
user=> (defn fl [n]
(if (= n 0)
1
(*' n (fl (dec n)))))
#'user/fl
user=> (fl 30)
265252859812191058636308480000000N
時折Javaが牙を剥いてくるとな。で、それをなだめるには、演算子をチョンするとな。 そんなの知らなかった。javaの都合を押し付けるなよ。
でも、これと同じようなのがnewLISPでも有ったね。あの時は、演算子をいじるんではなくて、 データ（数値）に、大きくなる可能性があるから、ヨロって合図をしておいた。
clojureの方は、対照的に、演算子に大きな数を扱える指示をした。どっちがユーザーの 混乱を招かない？ オイラーにはnewLISPの方が数学的にまともだと思うぞ。
newLISPにも + とaddって言う違いがあるじゃんってのは却下。整数の演算と実数の演算 っていう区分けがちゃんとしてあるから。でも、扱える範囲を超えたら、落ちるってのが 実用的って言うか安全側に振った処理になるかな。
とまあ、いろいろな処理系に触ると違いが見えてきて為になるね。
HTML5のcanvas
近頃、HTML5が正式にリリースされたとかで、フラッシュが駆逐される事を願っております。 それはさておき、５になってタグも覚えきれない程増えてる。
今更、本を買わなくても、HTML5リファレンス なんて所を見ればOK。そして、注目は、２Dグラフィックを描けるキャンバスが目玉でしょうか。
Canvasリファレンス とか HTML5 Canvas を見れば十分（かな）。
調子こいてHTML5 JavaScript APIリファレンスまで足を延ばす？ いいえ、そんな事はしませんよ（キリィ）
我がnewLISPにも、canvasを扱うmoduleが標準で提供されてる。そして説明書の所に リンクが貼ってあって、10種近いサンプルを即実行出来る。これを見れば、何が出来るか 大体分かるぞ。
実際に観賞
このモジュールは、newLISPで書いたお絵書きスクリプトをxxx.htmlに変換するものだ。 後はこのxxx.htmlをFirefox等のブラウザーに食わせれば、そこにめくるめく絵が出現するって訳。 （誰か、絵心のある方が、綺麗なおねーちゃんを書いてくれると、個人的に嬉しいな）
でも、いちいちブラウザーに食わせるって、無駄してない！ そんな事もあろうかと、 ブラウザーを呼び出す仕組みが備わっている。大した仕掛けじゃなくて、/tmpに特定な 名前でhtmlファイルを書き出し、次にそれを引数にしてブラウザーを起動してるだけ。
canvas.lspの最後の所に、使うブラウザーを指定するようになってる。そこを書き換えて あげる。
(define (show-in-browser)
(write-file "/tmp/noname.html" page)
(cond
( (= ostype "OSX")
(exec "open /tmp/noname.html"))
( (= ostype "Win32")
(set 'prog (string "cmd /c \"" (env "PROGRAMFILES")
; Use either Firefox or Safari 4.0
; "/Mozilla Firefox 3.1 Beta 2/firefox.exe\""))
"/Safari/Safari.exe\""))
:
WIndowsでもサファリが起動するようになってたので、そこをコメントにし、一つ上の行の コメントを外した。dirが昔のFirefoxになってたので、変更したよ。
これで、スクリプトをnewlispから実行すると、firefoxが立ち上がって、新しいTABに 絵が表示される。リナちゃんとかにも対応してるんで、好きなブラウザーを登録しておけるぞ。
Fedoraでは、midoriを指定してみた。こいつ、入っている場所が/usr/binの下じゃなくて、/binの 下って破格の扱いを受けていたぞ。IEみたいにシステム寄りの仕事もこなすみたいだ。
canvas.lspを手本にplotter版作成
早速、canvas.lspで自分も図を描いてみようと思った。説明を読むと、線の引き方が 亀さん 仕様なのね。 タートル・グラフィック、もっと言えばLogo風味。
ある点に移動しなさい(got x y) そこから50歩進みなさい(draw 50) 90度曲がりなさい(turn 90)。 これを４回繰り返せば、正方形が描けるよってやつ。
これはこれで良いんだけど、数学的な座標軸上で線を書こうとすると、ちと都合が悪い。 普通に直線を引く、lineとかdrawtoとかあるんだけど、スケールが固定になってるんだ。
目標を、去年末にgoでSVGタグを発生させて、リサージュ波形やらを描かせたけど、それを newLISPの上でもやりたい。
だったら、今有るcanbas.lspを修正すればいいんでないかい？ そういう考えもあるけど、 増設は今後に差し支えると思うので、一度ばらして、必要な物だけ再利用する方針にします。 その過程で、どういう仕組みになってるかも分かるしね。
どーんと一挙掲載。名前は pc.lsp
;; plotter on canvas - based canvas.lsp
;; Usage sample
;; (module "pc.lsp") ; use this module
;;
;; (pc:html "<h3>Lissajous</h3>") ; we can use html tag
;; (pc:canvas 300 300) ; use real canvas (canvas width height)
;; (pc:vbox -1 -1 1 1) ; vertual canvas (vbox left bottom right top)
;;
;; (pc:move (cos 0) (sin 0)) ; pen up to (move x y)
;; (dotimes (i 361)
;; (set 't (mul i (div 3.141592653 180.0)))
;; (pc:draw (cos (mul 3 t)) (sin (mul 5 t)))) ; pen down and (draw x y)
;;
;; (pc:line-color 1.0 0.1 0) ; (line-color R G B)
;; (pc:move -1 0) (pc:draw 1 0)
;; (pc:move 0 -1) (pc:draw 0 1)
;;
;; (pc:render "page.html") ; if no-file firefox launch
;; (exit)
(when (< (sys-info -2) 10110)
(constant (global 'extend) write-buffer))
(define (html:html str) (extend pc:body-html str))
(context 'pc)
; global values and constants
(set 'line-feed (if (> (& 0xF (sys-info -1)) 5) "\r\n" "\n"))
(set 'header-tags "") ; header tags from pc:header go here
(set 'canvas-script "") ; graphics statements go here
(set 'body-html "") ; body html written with pc:html goes here
(set 'XMAX 500) ; canvas size
(set 'YMAX 500)
(set 'line-color "#000000") ; for strokeStyle()
(set 'line-width 1) ;
(set 'fill-color '(0xff 0 0 0)) ; for fillStyle()
(set 'gr_xfac 1.0) ; plotter -> canvas scale factor
(set 'gr_yfac 1.0)
(set 'gr_xconst 0.0) ; offset
(set 'gr_yconst 0.0)
(set 'xpen 0.0) ; current pen posisoin for plotter
(set 'ypen 0.0)
(set 'template-header [text]
<html>
<head>
%s[/text])
(set 'script-header [text]<script type="text/javascript">
var canvasWidth, canvasHeight;
var xpos, ypos;
var ctx;
function Ctx(c) { ctx = c; }
function Goto(x, y) { xpos = x; ypos = y; }
function Drawto(x, y) {
ctx.beginPath(); ctx.moveTo(xpos, ypos);
ctx.lineTo(x, y); ctx.stroke();
xpos = x; ypos = y;
}
function drawAllCanvas() { try { [/text])
(set 'script-template [text]
var canvas=document.getElementById('%s');
var ctx=canvas.getContext('2d'); Ctx(ctx);
canvasWidth = %g; canvasHeight = %g;
xpos = 0; ypos = 0;
ctx.lineWidth = 1;
ctx.strokeStyle = 'rgb(0, 0, 0)';
ctx.fillStyle = 'rgb(0, 0, 0)';
<!-- start generated JavaScript -->
[/text])
(define (pc:pc str) (write-line canvas-script str))
(set 'script-close [text]
<!-- end generated JavaScript -->
} catch (er) { }
}
</script></head>
<body onload="drawAllCanvas();">
[/text])
; same definition as html:html
(define (pc:html str) (write-line body-html str))
(set 'canvas-template [text]<canvas id="%s" width="%d" height="%d"></canvas>[/text])
(set 'body-close "</body></html>\n")
; user functions
(define (pc:header tags )
(set 'header-tags tags)
)
(define (pc:canvas (width XMAX) (height YMAX))
(set 'canvas-name "mine")
(set 'XMAX width) (set 'YMAX height)
(pc (format script-template canvas-name width height))
(html (format canvas-template canvas-name width height)))
(define (pc:move x y)
(set 'xp (int (add (mul gr_xfac x) gr_xconst)))
(set 'yp (int (add (mul gr_yfac y) gr_yconst)))
(pc (format "Goto(%g, %g);" xp yp))
(set 'xpen x)
(set 'ypen y))
(define (pc:draw x y)
(set 'xp (int (add (mul gr_xfac x) gr_xconst)))
(set 'yp (int (add (mul gr_yfac y) gr_yconst)))
(pc (format "Drawto(%g, %g);" xp yp)))
(define (pc:vbox left bottom right top)
(set 'gr_xfac (div (sub XMAX 1) (sub right left)))
(set 'gr_yfac (div (sub YMAX 1) (sub bottom top)))
(set 'gr_xfac (mul gr_xfac (abs(div gr_yfac gr_xfac))))
(set 'gr_yfac (mul gr_yfac (abs(div gr_xfac gr_yfac))))
(set 'gr_xconst (sub 0.5 (mul gr_xfac left)))
(set 'gr_yconst (sub 0.5 (mul gr_yfac top))))
(define (line-color red green blue alpha)
(if (string? red)
(let (color red)
(set 'red (div (int (append "0x" (0 2 color)) 0 16) 255))
(set 'green (div (int (append "0x" (2 2 color)) 0) 255))
(set 'blue (div (int (append "0x" (4 2 color)) 0) 255))))
(if alpha
(pc (format "ctx.strokeStyle = 'rgba(%d, %d, %d, %g)';"
(mul red 255) (mul green 255) (mul blue 255) alpha))
(pc (format "ctx.strokeStyle = 'rgb(%d, %d, %d)';"
(mul red 255) (mul green 255) (mul blue 255) ))))
(define (pc:render mode)
(let (page (append (format template-header header-tags)
script-header
canvas-script
script-close
body-html
body-close))
; (println page) ;;;; debug, show html on console
(cond
((nil? mode) ; on Emscripten open tab
(if eval-string-js
(display-html page true)
(show-in-browser)))
((= (upper-case mode) "CGI")
(println page))
(true
(write-file mode page)))))
(define (show-in-browser)
(write-file "/tmp/noname.html" page)
(cond
((= ostype "OSX")
(exec "open /tmp/noname.html"))
((= ostype "Win32")
(set 'prog (string "cmd /c \"" (env "PROGRAMFILES")
"/Mozilla Firefox/firefox.exe\""))
(exec (string prog " file://c:/tmp/noname.html")))
(true // all Linux and other unix
(set 'files '(
"/bin/midori"
"/usr/bin/firefox"
"/usr/bin/konqueror" ))
(set 'prog (find true (map file? files)))
(if prog
(exec (string (files prog) " file:///tmp/noname.html"))
(println "Cannot find browser to display documentation" "warning")))))
(context MAIN)
モジュールを書く場合、モジュールと、ユーザーが書くコード空間を別にして、名前の衝突が 起こらないようにする事が必須。
ファイルの先頭で、context宣言し、新しい空間を作ってモジュールのコードを置く。最後は、 コンテキストをMAINに切り替えて、ユーザー空間に戻しておくんだ。外に輸出する名前の 宣言とか、複雑なものは一切無し。ユーザーを信頼してますからって言う潔い態度です。
コードのデバッグは、どうするかと言うと、同ファイルを適当な所に置いて、 ユーザーコードを、(context MAIN) の後ろに置けばOK。このファイル自身をロードすれば、 ユーザーコードを、モジュール付きで呼び出した事になる。
いきなりfirefoxとかにhtmlファイルが送られちゃうと、どんなhtmlを吐き出されたかは、 /tmpの下のファイルを見なきゃなならない。それもかったるので、debugって書いた行を 有効にして、lispのコンソールでモニター出来るようにした。
これでOKとなったら、modulesの下に移すか、手元で確認したかったら、loadして使えばOK。 ゆるい制限しかないので、debugは楽で良いぞ。
context
ふと疑問に思った事がある。モジュール内と利用者側(MAIN)で同名の手続きが定義される 事が有るだろう。その手続きを、モジュール内で使ったら、どちら側が呼ばれる？ モジュールの隠蔽体質からすれば、外の事は知らんて事だろうと予測が付くが。。。
(context 'hoge) (define (foo x) (+ x x)) (define (dofoo x) (foo x)) (context MAIN) (define (foo x) (* x x)) (hoge:dofoo 5)
同名な関数fooを定義、それをMAIN側から呼ぶコードだ。
> (hoge:dofoo 5) 10
予想通り。
> (context hoge) hoge hoge> (foo 5) 10 hoge> (context MAIN) MAIN > (foo 5) 25
これも当然の帰結。そんじゃ、hoge内のfooを消すとどうなる？ fooを消したソースで 実行すると、
ERR: invalid function : (foo x) called from user function hoge:dofoo
エラー行数が出てこないのは、ちと寂しいけど、冷静にメッセージを読めば、 MAIN側から呼んだhoge:dofooの先で、良からぬ事が起きてまっせ。良からぬ事って、fooが 無効って事だ。
モジュールの中ではシャドーイングされるのではなく、set,setq されたものは内部的に TAGが付けられて、区別される。だから、混乱が起きないのだな。手続きを定義するのに 使うdefineも、下記のものの構文糖衣だからね。
(setq foo (fn (x) (+ x x)))
pc.lspの使い方
ファイル中に例を置いたので、想像は付くだろうけど、未来の自分の為のメモを残しておく。
html上に展開されるcanvasエリアを、実画面とする。一方vboxで宣言される座標範囲は、 仮想canvasとする。ユーザーは、その仮想画面上で、ペンを動かして、線を引いていく。 プロッターの動作を模倣したものだ。
なお、実画面と仮想画面のアスペクト比（縦横の比率）は、同一にしておく事。これが 異なると、描画が欠けたり、空白を生じる可能性が有ります。
使える描画用コマンドは、(move x y)、 (draw x y) 、(line-color R G B)だけって潔さ。 moveはペンを面から放して移動。drawはペンを下ろして（描画状態）から移動。line-colorは、 ペンの色指定。pen-colorの方が良かったかも知れないけど、前例に倣った。
こうして描画したものを最後は、renderで、ブラウザーに送る。あるいはオプションで、 ファイル名を指定すると、そこに書き出される。
例を実行して、ファイルに落としたものを俯瞰すると
<html>
<head>
<script type="text/javascript">
var canvasWidth, canvasHeight;
var xpos, ypos;
var ctx;
:
function drawAllCanvas() { try {
var canvas=document.getElementById('mine');
:
<!-- start generated JavaScript -->
Goto(299, 150);
Drawto(299, 150);
:
ctx.strokeStyle = 'rgb(255, 25, 0)';
Goto(0, 150);
Drawto(299, 150);
Goto(150, 299);
Drawto(150, 0);
<!-- end generated JavaScript -->
} catch (er) { }
}
</script></head>
<body onload="drawAllCanvas();">
<h3>Lissajous</h3>
<canvas id="mine" width="300" height="300"></canvas>
</body></html>
忌まわしいJavascriptは、htmlのヘッダータグ内に埋め込まれる。勿論その中には、 ユーザーがlispコードで書いた物も、JSに変換されて埋め込まれる。
ボディタグ内には、htmlファイルがロードされたのを機に発動するJSの起動スクリプトが ある。この起動スクリプトの一部にユーザー定義部分が埋め込まれているのだ。
後の主要な部分は、canvasタグの指定ぐらいですかね。
更にもう一例
今年は、アベック台風を超える、トリプル台風が発生したりして大変。そこで当たらぬ予想の いい訳に使えるローレンツ・アトラクタをやってみる。別名ではカオス、混沌と言われる。
まずは、オリジナルの奥村先生のC語版
#include "plotter.c"
#define A 10.0
#define B 28.0
#define C (8.0 / 3.0)
#define D 0.01
int main()
{
int k;
double x, y, z, dx, dy, dz;
gr_on(); gr_window(-30, 0, 30, 60, 1, GREEN);
x = y = z = 1;
for (k = 0; k < 3000; k++) {
dx = A * (y - x);
dy = x * (B - z) - y;
dz = x * y - C * z;
x += D * dx; y += D * dy; z += D * dz;
if (k > 100) draw(x, z); else move(x, z);
}
hitanykey();
return EXIT_SUCCESS;
}
例によって、これをコピペしてから、逐次変換します。出来たのが下記
(module "pc.lsp")
(setq A 10.0)
(setq B 28.0)
(setq C (div 8.0 3.0))
(setq D 0.01)
(define (lorentz)
(let (x 1.0 y 1.0 z 1.0 dx 0.0 dy 0.0 dz 0.0)
(pc:canvas)
(pc:vbox -30 0 30 60)
(dotimes (k 3000)
(setq dx (mul A (sub y x)))
(setq dy (sub (mul x (sub B z)) y))
(setq dz (sub (mul x y) (mul C z)))
(inc x (mul D dx))
(inc y (mul D dy))
(inc z (mul D dz))
(if (> k 100)
(pc:draw x z)
(pc:move x z)))
(pc:html "<p>Figure of Lorenz Attractor</p>")
(pc:render)))
(lorentz)
(exit)
A,B,C,Dは、constantを使った方が良かったかな。incの第二引数を使うと、x += ... が 綺麗に書けるな。decを使えば、x -= ... になるけど、乗算とかはどうなる。そんなの、 たまにしか出てこないんで、自前で何とかしろよ。
ああ、canvasで引数を省略すると、500 500で代用されます。大きなパネルを持ってる人は、 pc.lspのXMAX、YMAXを調整してね。
debug
涼しい顔して例を載せているけど、最初正しい動きをしなかった。カッコの付け間違いで あらぬ演算をしてたから。。。 こんな時はどうするか？
カオスな演算なんで、C語の正しい結果を数例と、lispスクリプトにprint文を埋め込んで サンプル採取が上等手段だろう。けど、newLISPでもdebuggもどきが出来るよ例を挙げておく。
(trace true)ってのをスクリプト中に埋め込むと、それ以降は簡単なdebugerと言うか モニターと言うか、、に制御が渡る。traceを中止したい場合はtrueの代わりにnilを渡す。 例は、ifの前にtraceを埋め込んでみた。
----- (define (move x y) #(set 'xp (int (add (mul gr_xfac x) gr_xconst)))# (set 'yp (int (add (mul gr_yfac y) gr_yconst))) (pc:pc (format "Goto(%g, %g);" xp yp)) (set 'xpen x) (set 'ypen y)) [-> 7 pc] s|tep n|ext c|ont q|uit >
あくまでもtraceなんで、ifの結果として、moveに移ってきた。最初の行がシャープサインで 囲まれていて、ポインタはここに有りますって言ってる。
変数の値を確認
[-> 7 pc] s|tep n|ext c|ont q|uit > x 1 [-> 7 pc] s|tep n|ext c|ont q|uit > dx nil [-> 7 pc] s|tep n|ext c|ont q|uit > MAIN:dx 0
モジュールの中に居るので、メイン側の値を参照するには、MAINを前置する必要が有る。 後なｓなりnなりで進めて行けばよい。
[<- 7 pc] s|tep n|ext c|ont q|uit > n ----- (define (move x y) (set 'xp (int (add (mul gr_xfac x) gr_xconst))) (set 'yp (int (add (mul gr_yfac y) gr_yconst))) (pc:pc (format "Goto(%g, %g);" xp yp)) (set 'xpen x) #(set 'ypen y)#) RESULT: 0.9833333333333333
式の評価結果が表示されてる。traceの代わりに、debugなんてのも使える。こちらの方が 手軽かな。
> (debug (lorentz)) : [<- 5 ] s|tep n|ext c|ont q|uit >
シャープサインがどの範囲を囲んでいるか注意して、stepするかnextするか決めて実行します。 上手に使うと効率上がるかも。
で、よく考えたらこれってラケットだかロケットの売りの一つになってた、初心者脱出ツールの stepperじゃないですか。下記のような設定をしておくと、評価予定のS式に色が付いて、 （シャープサインより）分かりやすくなるぞ。
(trace-highlight "\027[1m" "\027[0m")
範囲を太字にするって設定。（おいらの所では、screenとemacsの関係から、7mで、対象が 赤になり見易かった）この頃からhtmlの原型が有ったのね。 詳細は、VT100のエスケープシーケンスを 参照の事。