Archive for 2010年9月|Monthly archive page

newLISP で GUI する。。。または、CSV ファイルをテーブル表示する。

投稿日 2010年9月30日
Filed under: GUI, Utility | タグ: , ,
* コメントを残す

　前回までの “newLISP で CSV を扱う。” は、如何だったでしょうか？
　今頃の掲載は、ネタに困ったから？　否定はしません（笑）が、理由があります。
　newLISP Fan Club FORUM で unya氏が TextTableWidget – JTable base を紹介されています。これは、guiserver 上で、EXECLのような表が扱えるようになるというもの。
　それで、EXECL のデータを newLISP でも使えるようにして置こうと、思ったわけです。
　同投稿で、Lutz氏が次期開発バージョンに組み込まれることを表明されています。
　嬉しい限りです。リリースされたら早速、この blog にて報告しましょう（笑）。

　とは言っても、それまで待っているのも何ですから、現在の guiserver でテーブル表示をしてみましょう。表示に使うのは、gs:text-pane の “text/html” モードです。

gs:text-pane

syntax: (gs:text-pane sym-id sym-action str-style [int-width int-height])
parameter: sym-id – The name of the text pane.
parameter: sym-action – The key action handler for the html pane.
parameter: sym-style – The content type of the text pane.
parameter: int-width – The optional width of the pane.
parameter: int-height – The optional height of the pane.

gs:text-pane は gs:text-area のように使えます。次のスタイルが sym-style でサポートされます：
The gs:text-pane is used similar to ‘gs:text-area. The following styles are supported in sym-style:
“text/plain”
“text/html”

（中略）

HTML 形式のテキストでハイパーリンクをクリック可能にするには、 関数 gs:set-editable を使って、編集不可にします。 gs:set-font と gs:append-text は、text/plain スタイルでのみ、動作します。
To make hyperlinks in HTML formatted text clickable, editing must be disabled using the gs:set-editable function. The functions gs:set-font and gs:append-text will work only on the text/plain content style.

　マニュアルにあるように、 “text/html” モードでは gs:set-font と gs:append-text が使えません。つまり、フォントは表示する HTML文字列内に記述し、用意した正しい記述の HTML文字列を gs:set-text で gs:text-pane に貼り付けて使うということ。
　と、言うことで、先ずは、リストから テーブル表示用の HTML文字列を作ります。
（defun は newlisp-utility.lsp に定義してあります。）

(define *header* [text]<!-- generated page -->
<html>
<table border="1">
[/text])
(define tableROW '("<tr>" "</tr>"))
(define tableDATA '("<td align=\"right\">" "</td>"))
(define tableHEADER '("<th>" "</th>"))
(define *footer* [text]</table>
</html>
[/text])
(defun addHTMLtag (data tag)
  (string (tag 0) data (tag 1)))
(defun makeHTMLtable (lst)
  (let (html *header*)
    (dolist (row lst)
      (extend html (tableROW 0))
      (dolist (col row) 
        (extend html (addHTMLtag col (if (string? col) tableHEADER tableDATA))))
      (extend html (tableROW 1) "\n"))
    (extend html *footer*)))

　特にフォント指定はしていませんので、必要な方は、*header* にでも追加して下さい。
　先日の太陽系惑星のデータを使って、動作させると、

> (makeHTMLtable sol-sys)
[text]<!-- generated page -->
<table border="1">
<tr><th>Planet name</th><th>Equator diameter (earth)</th><th>Mass (earth)</th><th>Orbital radius (AU)</th><th>Orbital period (years)</th><th>Orbital Incline Angle</th><th>Orbital Eccentricity</th><th>Rotation (days)</th><th>Moons</th></tr>
<tr><th>Mercury</th><td align="right">0.382</td><td align="right">0.06</td><td align="right">0.387</td><td align="right">0.241</td><td align="right">7</td><td align="right">0.206</td><td align="right">58.6</td><td align="right">0</td></tr>
<tr><th>Venus</th><td align="right">0.949</td><td align="right">0.82</td><td align="right">0.72</td><td align="right">0.615</td><td align="right">3.39</td><td align="right">0.0068</td><td align="right">-243</td><td align="right">0</td></tr>
<tr><th>Earth</th><td align="right">1</td><td align="right">1</td><td align="right">1</td><td align="right">1</td><td align="right">0</td><td align="right">0.0167</td><td align="right">1</td><td align="right">1</td></tr>
<tr><th>Mars</th><td align="right">0.53</td><td align="right">0.11</td><td align="right">1.52</td><td align="right">1.88</td><td align="right">1.85</td><td align="right">0.0934</td><td align="right">1.03</td><td align="right">2</td></tr>
<tr><th>Jupiter</th><td align="right">11.2</td><td align="right">318</td><td align="right">5.2</td><td align="right">11.86</td><td align="right">1.31</td><td align="right">0.0484</td><td align="right">0.414</td><td align="right">63</td></tr>
<tr><th>Saturn</th><td align="right">9.41</td><td align="right">95</td><td align="right">9.54</td><td align="right">29.46</td><td align="right">2.48</td><td align="right">0.0542</td><td align="right">0.426</td><td align="right">49</td></tr>
<tr><th>Uranus</th><td align="right">3.98</td><td align="right">14.6</td><td align="right">19.22</td><td align="right">84.01</td><td align="right">0.77</td><td align="right">0.0472</td><td align="right">-0.718</td><td align="right">27</td></tr>
<tr><th>Neptune</th><td align="right">3.81</td><td align="right">17.2</td><td align="right">30.06</td><td align="right">164.8</td><td align="right">1.77</td><td align="right">0.0086</td><td align="right">0.671</td><td align="right">13</td></tr>
<tr><th>Pluto</th><td align="right">0.18</td><td align="right">0.002</td><td align="right">39.5</td><td align="right">248.5</td><td align="right">17.1</td><td align="right">0.249</td><td align="right">-6.5</td><td align="right">3</td></tr>
</table>
[/text]
>

　と、いった具合。一応、文字列と数値では、HTML タグを変えてあります。
　さて、これを表示する GUI 部分は、
（aif は newlisp-utility.lsp に, include は init.lsp に定義してあります。）

; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp")) 
(include "macro.lsp")
(include "newlisp-utility.lsp")
; define sub-routine
(define CRLF "\x0d\x0a")
(define regexCRLF "\r*\n")
(defun stringEx (x)
  (if (string? x) (string "\"" x "\"") (string x)))
(defun string-convert (str) 
  (if (catch (eval-string str) 'res) (if res res str) str))
(defun list2csv (lst)
  (let (csv "")
    (dolist (row lst)
      (extend csv (join (map stringEx row) ",") CRLF))))
(defun csv2list (csv)
  (let (lst '())
    (dolist (row (parse (if (ends-with csv regexCRLF 0) (chop csv) csv) regexCRLF 0))
      (push (map string-convert (parse row ",")) lst -1))
    (setf (lst -1 -1) (if (string? $it) (trim $it "\r") $it))
    lst))
(defun csvfile2list (file)
  (cond ((directory? file) nil)
         ((file? file)
          (csv2list (read-file *fileName*)))
         (true nil)))
; define handler
(define *fileName* (real-path))
(define *filemask* "csv CSV")
(define *description* "csv file")
(define (openfile-action id op file)
  (when file
    (setq *fileName* (base64-dec file))
    (gs:set-text 'Status *fileName*)
    (aif (csvfile2list *fileName*)
        (gs:set-text 'OutputArea (makeHTMLtable it))
      (gs:set-text 'Status (string *fileName* " is not csv file.")))))
(define (open-file-dialog)
  (gs:open-file-dialog 'Frame 'openfile-action *fileName* *filemask* *description*))
; initialization
(gs:init)
(define FPosX 100)
(define FPosY 50)
(define FWidth 640)
(define FHeight 480)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "CSV Viewer")
(gs:panel 'StatusPanel)
(gs:label 'Status (real-path))
(gs:button 'fileButton 'open-file-dialog "File")
(gs:text-pane 'OutputArea 'gs:no-action "text/html")
(gs:add-to 'StatusPanel 'fileButton 'Status) 
; mount all on frame
(gs:set-border-layout 'Frame)
(gs:set-flow-layout 'StatusPanel "left")
(gs:add-to 'Frame 'OutputArea "center" 'StatusPanel "south")
(gs:set-visible 'Frame true)
; main routine
(gs:listen)
(exit)

　という感じ。先日の関数csv2list も入っています。
　これを実行すれば、

　と表示されるはず。
　左下の File ボタンを押して、ファイルダイアログを表示させ、<a href="https://johu02.wordpress.com/2010/09/29/"前回のやり方で用意したファイルを選択すれば、

　と、めでたく表示されます。EXCEL 出力の CSVファイルも同様に表示されるはず。
　もちろん、編集はできません（笑）。
　それは、TextTableWidget – JTable base が guiserver に組み込まれるのを待つことにしましょう。

　以上、如何でしょうか？

newLISP で CSV を扱う（解説編）。

投稿日 2010年9月29日
Filed under: Utility | タグ: , , ,
* コメントを残す

　先日の “newLISP で CSV を扱う。” は如何だったでしょうか？
（defun は newlisp-utility.lsp に定義してあります。）

(define CRLF "\r\n")
(define regexCRLF "\r*\n")
(defun stringEx (x)
  (if (string? x) (string "\"" x "\"") (string x)))
(defun string-convert (str) 
  (if (catch (eval-string str) 'res) (if res res str) str))
(defun list2csv (lst)
  (let (csv "")
    (dolist (row lst)
      (extend csv (join (map stringEx row) ",") CRLF))))
(defun csv2list (csv)
  (let (lst '())
    (dolist (row (parse (if (ends-with csv regexCRLF 0) (chop csv) csv) regexCRLF 0))
      (push (map string-convert (parse row ",")) lst -1))
    (setf (lst -1 -1) (if (string? $it) (trim $it "\r") $it))
    lst))

　短いコードなので、再掲載。といいつつ、さりげなく変更しています（汗）。
　関数list2csv では組込join を使ってCSV 文字列を作り、関数csv2list では組込parse を使ってリストにしているのは、定石通り？
　もちろん、ポイントは、関数stringEx と string-convert です。
　関数stringEx は、組込string のように文字列に変換しますが、引数が文字列の時は、ダブルクォートで囲まれた文字列に変換します。
　一方、関数string-convert は、引数に組込eval-string を適用して、エラーなら文字列そのまま出力します。組込eval-string がエラーを起こさなければ、それは評価されたわけですから、評価された値を出します。関数list2csv で作成した CSV 文字列だけを扱うなら、

(defun string-convert (str) 
  (if (catch (eval-string str) 'res) res str))

　でも良かったのですが、最初のコードのように評価値が nil の場合も、文字列のまま出すようにしています。
　これは、CSV 文字列中で文字列に変換したい部分が必ずしもダブルクォートで囲まれているとは限らないからです。
　ここが、EXCEL 等の出力する CSV ファイルにも対応する時のポイントです（笑）。
　問題があるとすれば、

> (setq test (list2csv '(("test" nil true))))
"\"test\",nil,true\r\n"
> (csv2list test)
(("test" "nil" true))
>

　という風に、データが nil の時も文字列になってしまうことくらい？（笑）
　ちなみに、EXCEL のブール値 TRUE と FALSE も、文字列になります。
　さて、先日の関数は、ファイルを対象にしていません。なぜなら、組込read-file と write-file を使えば良いだけだからです。

> csv
"\"Planet name\",\"Equator diameter (earth)\",\"Mass (earth)\",\"Orbital radius (AU)\",\"Orbital period (years)\",\"Orbital Incline Angle\",\"Orbital Eccentricity\",\"Rotation (days)\",\"Moons\"\r\n\"Mercury\",0.382,0.06,0.387,0.241,7,0.206,58.6,0\r\n\"Venus\",0.949,0.82,0.72,0.615,3.39,0.0068,-243,0\r\n\"Earth\",1,1,1,1,0,0.0167,1,1\r\n\"Mars\",0.53,0.11,1.52,1.88,1.85,0.0934,1.03,2\r\n\"Jupiter\",11.2,318,5.2,11.86,1.31,0.0484,0.414,63\r\n\"Saturn\",9.41,95,9.54,29.46,2.48,0.0542,0.426,49\r\n\"Uranus\",3.98,14.6,19.22,84.01,0.77,0.0472,-0.718,27\r\n\"Neptune\",3.81,17.2,30.06,164.8,1.77,0.0086,0.671,13\r\n\"Pluto\",0.18,0.002,39.5,248.5,17.1,0.249,-6.5,3\r\n\"test\",FALSE,TRUE,nil,true\r\n"
> (write-file "test.csv" csv)
639
> (csv2list (read-file "test.csv"))
(("Planet name" "Equator diameter (earth)" "Mass (earth)" "Orbital radius (AU)" "Orbital period (years)" 
  "Orbital Incline Angle" "Orbital Eccentricity" "Rotation (days)" "Moons") 
 ("Mercury" 0.382 0.06 0.387 0.241 7 0.206 58.6 0) 
 ("Venus" 0.949 0.82 0.72 0.615 3.39 0.0068 -243 0) 
 ("Earth" 1 1 1 1 0 0.0167 1 1) 
 ("Mars" 0.53 0.11 1.52 1.88 1.85 0.0934 1.03 2) 
 ("Jupiter" 11.2 318 5.2 11.86 1.31 0.0484 0.414 63) 
 ("Saturn" 9.41 95 9.54 29.46 2.48 0.0542 0.426 49) 
 ("Uranus" 3.98 14.6 19.22 84.01 0.77 0.0472 -0.718 27) 
 ("Neptune" 3.81 17.2 30.06 164.8 1.77 0.0086 0.671 13) 
 ("Pluto" 0.18 0.002 39.5 248.5 17.1 0.249 -6.5 3) 
 ("test" "FALSE" "TRUE" "nil" true))
>

　こんな感じです。
　また、Linux で使われている改行だけの文字列にも、

> (replace "\r" csv "")
"\"Planet name\",\"Equator diameter (earth)\",\"Mass (earth)\",\"Orbital radius (AU)\",\"Orbital period (years)\",\"Orbital Incline Angle\",\"Orbital Eccentricity\",\"Rotation (days)\",\"Moons\"\n\"Mercury\",0.382,0.06,0.387,0.241,7,0.206,58.6,0\n\"Venus\",0.949,0.82,0.72,0.615,3.39,0.0068,-243,0\n\"Earth\",1,1,1,1,0,0.0167,1,1\n\"Mars\",0.53,0.11,1.52,1.88,1.85,0.0934,1.03,2\n\"Jupiter\",11.2,318,5.2,11.86,1.31,0.0484,0.414,63\n\"Saturn\",9.41,95,9.54,29.46,2.48,0.0542,0.426,49\n\"Uranus\",3.98,14.6,19.22,84.01,0.77,0.0472,-0.718,27\n\"Neptune\",3.81,17.2,30.06,164.8,1.77,0.0086,0.671,13\n\"Pluto\",0.18,0.002,39.5,248.5,17.1,0.249,-6.5,3\n\"test\",nil,true,FALSE,TRUE\n"
> (csv2list csv)
(("Planet name" "Equator diameter (earth)" "Mass (earth)" "Orbital radius (AU)" "Orbital period (years)" 
  "Orbital Incline Angle" "Orbital Eccentricity" "Rotation (days)" "Moons") 
 ("Mercury" 0.382 0.06 0.387 0.241 7 0.206 58.6 0) 
 ("Venus" 0.949 0.82 0.72 0.615 3.39 0.0068 -243 0) 
 ("Earth" 1 1 1 1 0 0.0167 1 1) 
 ("Mars" 0.53 0.11 1.52 1.88 1.85 0.0934 1.03 2) 
 ("Jupiter" 11.2 318 5.2 11.86 1.31 0.0484 0.414 63) 
 ("Saturn" 9.41 95 9.54 29.46 2.48 0.0542 0.426 49) 
 ("Uranus" 3.98 14.6 19.22 84.01 0.77 0.0472 -0.718 27) 
 ("Neptune" 3.81 17.2 30.06 164.8 1.77 0.0086 0.671 13) 
 ("Pluto" 0.18 0.002 39.5 248.5 17.1 0.249 -6.5 3) 
 ("test" "nil" true "FALSE" "TRUE"))
>

　対応しています。parse に正規表現を使っていますから。
　ということで、さりげなく直しているこの部分。やはり、正規表現は、鬼門？（汗）

　以上、如何でしょうか？

newLISP で CSV を扱う。

投稿日 2010年9月28日
Filed under: Utility | タグ: , ,
* コメントを残す

　newLISP で CSV（Comma-Separated Values）を扱うなら、ArtfulCode に Module:CSV があります。ArtfulCode の名にふさわしい洗練されたコードです。
　と、言いつつ、今回は、自作します。何故か？それは後ほど。

　まずは、スクリプトから、
（defun は newlisp-utility.lsp に定義してあります。）

(define CRLF "\r\n")
(define regexCRLF "\r*\n")
(defun stringEx (x)
  (if (string? x) (string "\"" x "\"") (string x)))
(defun list2csv (lst)
  (let (csv "")
    (dolist (row lst)
      (extend csv (join (map stringEx row) ",") CRLF))))
(defun string-convert (str) 
  (if (catch (eval-string str) 'res) (if res res str) str))
(defun csv2list (csv)
  (let (lst '())
    (dolist (row (parse (if (ends-with csv regexCRLF 0) (chop csv) csv) regexCRLF 0))
      (push (map string-convert (parse row ",")) lst -1))))

　関数名からわかるように、CSV文字列とリストを相互に変換しますが、これだけです（笑）。
　だから、自作。いえいえ。それは動作させてみれば判ります。
　次のデータは、 Introduction to newLISP に載っていた太陽系惑星のデータを使わせてもらっています。

(setq sol-sys '(("Planet name" "Equator diameter (earth)" "Mass (earth)"
"Orbital radius (AU)" "Orbital period (years)"
"Orbital Incline Angle" "Orbital Eccentricity"
"Rotation (days)" "Moons")
("Mercury" 0.382 0.06 0.387 0.241 7.00 0.206 58.6 0)
("Venus" 0.949 0.82 0.72 0.615 3.39 0.0068 -243 0)
("Earth" 1.00 1.00 1.00 1.00 0.00 0.0167 1.00 1)
("Mars" 0.53 0.11 1.52 1.88 1.85 0.0934 1.03 2)
("Jupiter" 11.2 318 5.20 11.86 1.31 0.0484 0.414 63)
("Saturn" 9.41 95 9.54 29.46 2.48 0.0542 0.426 49)
("Uranus" 3.98 14.6 19.22 84.01 0.77 0.0472 -0.718 27)
("Neptune" 3.81 17.2 30.06 164.8 1.77 0.0086 0.671 13)
("Pluto" 0.18 0.002 39.5 248.5 17.1 0.249 -6.5 3)))

　では動作を、

> (setq csv (list2csv sol-sys))
"\"Planet name\",\"Equator diameter (earth)\",\"Mass (earth)\",\"Orbital radius (AU)\",\"Orbital period (years)\",\"Orbital Incline Angle\",\"Orbital Eccentricity\",\"Rotation (days)\",\"Moons\"\r\n\"Mercury\",0.382,0.06,0.387,0.241,7,0.206,58.6,0\r\n\"Venus\",0.949,0.82,0.72,0.615,3.39,0.0068,-243,0\r\n\"Earth\",1,1,1,1,0,0.0167,1,1\r\n\"Mars\",0.53,0.11,1.52,1.88,1.85,0.0934,1.03,2\r\n\"Jupiter\",11.2,318,5.2,11.86,1.31,0.0484,0.414,63\r\n\"Saturn\",9.41,95,9.54,29.46,2.48,0.0542,0.426,49\r\n\"Uranus\",3.98,14.6,19.22,84.01,0.77,0.0472,-0.718,27\r\n\"Neptune\",3.81,17.2,30.06,164.8,1.77,0.0086,0.671,13\r\n\"Pluto\",0.18,0.002,39.5,248.5,17.1,0.249,-6.5,3\r\n"
> (begin (print csv) nil)
"Planet name","Equator diameter (earth)","Mass (earth)","Orbital radius (AU)","Orbital period (years)","Orbital Incline Angle","Orbital Eccentricity","Rotation (days)","Moons"
"Mercury",0.382,0.06,0.387,0.241,7,0.206,58.6,0
"Venus",0.949,0.82,0.72,0.615,3.39,0.0068,-243,0
"Earth",1,1,1,1,0,0.0167,1,1
"Mars",0.53,0.11,1.52,1.88,1.85,0.0934,1.03,2
"Jupiter",11.2,318,5.2,11.86,1.31,0.0484,0.414,63
"Saturn",9.41,95,9.54,29.46,2.48,0.0542,0.426,49
"Uranus",3.98,14.6,19.22,84.01,0.77,0.0472,-0.718,27
"Neptune",3.81,17.2,30.06,164.8,1.77,0.0086,0.671,13
"Pluto",0.18,0.002,39.5,248.5,17.1,0.249,-6.5,3
nil
> (csv2list csv)
(("Planet name" "Equator diameter (earth)" "Mass (earth)" "Orbital radius (AU)" "Orbital period (years)" 
  "Orbital Incline Angle" "Orbital Eccentricity" "Rotation (days)" "Moons") 
 ("Mercury" 0.382 0.06 0.387 0.241 7 0.206 58.6 0) 
 ("Venus" 0.949 0.82 0.72 0.615 3.39 0.0068 -243 0) 
 ("Earth" 1 1 1 1 0 0.0167 1 1) 
 ("Mars" 0.53 0.11 1.52 1.88 1.85 0.0934 1.03 2) 
 ("Jupiter" 11.2 318 5.2 11.86 1.31 0.0484 0.414 63) 
 ("Saturn" 9.41 95 9.54 29.46 2.48 0.0542 0.426 49) 
 ("Uranus" 3.98 14.6 19.22 84.01 0.77 0.0472 -0.718 27) 
 ("Neptune" 3.81 17.2 30.06 164.8 1.77 0.0086 0.671 13) 
 ("Pluto" 0.18 0.002 39.5 248.5 17.1 0.249 -6.5 3))
>

　CSV文字列からリストへの変換で、文字列は文字列、数値は数値へと変換されているのに、お気付きでしょうか？これが自作したポイントです。
　これなら、EXCEL で作った表を CSVで保存すれば、newLISP で簡単に扱え、逆も可能です。

　以上、如何でしょうか？

guiserver の gs:confirm-dialog について

投稿日 2010年9月27日
Filed under: GUI, Reference | タグ:
* コメントを残す

　guiserver の gs:confirm-dialog は、文字通り、確認用ダイアログ・ボックスを表示するための関数です。

　guiserver マニュアルに、

gs:confirm-dialog

syntax: (gs:confirm-dialog sym-parent-frame sym-action str-title str-message [str-type])
parameter: sym-parent-frame – The symbol name of the parent frame.
parameter: sym-action – The action to perform when the diaog is closed.
parameter: str-title – The title of the message box.
parameter: str-message – The message in the message box.
parameter: str-type – The type of the message box.

メッセージ・ボックスのタイプは、”yes-no” か “yes-no-cancel” のいずれかです （訳注：str-type のデフォルトは、”yes-no-cancel”）。 メッセージ・ボックスから返ると、sym-action が、yes の 0 か no の 1 か cancel の 2 のいずれかを運んできます。
The type of the message box can be one of: “yes-no”, “yes-no-cancel” On return of the message box sym-action carries one of the responses 0 for the yes-, 1 for the no- or 2 for the cancel-button.

　とあるように、 gs:confirm-dialog の種類は "yes-no" と "yes-no-cancel" の二種類で、デフォルトは "yes-no-cancel" です。種類の指定は、オプションの str-type で指定します。
　newLISP Fan Club FORUM で Lutz 氏が、

PS: I also corrected gs:confirm-dialog (type “plain”) instead of (type plain) for the default parameter. Now version 1.38

　と発言されているように、バージョン1.38 から、オプションの str-type のデフォルトは、"plain" になりました。
　といっても、現在の guiserver.jar のバージョンでは、"plain" 指定は "yes-no-cancel" 指定と同じです。つまり、デフォルトは変わりません。なぜなら、str-type に nil を指定した場合も、"yes-no-cancel" だからです。
　ということで、あえて、日本語併記 Guiserver マニュアル や newLISP 関数リファレンス・スクリプト の改変はやらなかったのですが、、、

　以上、如何でしょうか？
　

newLISP で GUI する。。。または、gs:shear-tag を使ってみる（その２）

投稿日 2010年9月26日
Filed under: GUI, Reference | タグ: ,
* コメントを残す

　前回の、guiserver の２Dグラフィックス関数 gs:shear-tag の動作例は、如何だったでしょうか？
　前回のスクリプトでは、表示されたウィンドウの大きさは変更できませんでした。
　それは、

(gs:set-resizable 'Frame nil)

　で、変更を禁止していたからです。guiserver アプリケーションのデフォルトは、サイズ変更可能なので、禁止する場合に、上記コードが必要になります。
　さて、今回は、サイズ変更可能にして、もう少し、gs:shear-tag の動作を見てみます。

; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp")) 
; define sub-routine
(define (center-point width height)
  (setq X-pos (/ width 2) Y-pos (/ height 2) Radius (/ (if (< width height) width height) 2)))
(define (draw-tag)
    (gs:draw-circle 'C X-pos Y-pos Radius gs:blue)
    (gs:draw-rect 'C (- X-pos Radius) (- Y-pos Radius) (* 2 Radius) (* 2 Radius)))
; define handler
(setq canvas-Size 400)
(center-point 400 400)
(setq shearX 0.0 shearY 0.0) 
(define (slider-action id value)
  (let (axis ((parse id) -1))
    (case axis 
      ("X-factor" (setq shearX (div (- value 50) 50 )))
      ("Y-factor" (setq shearY (div (- 50 value) 50))))
    (gs:delete-tag 'C)
    (draw-tag)
    (gs:shear-tag 'C shearX shearY)
    (gs:set-text 'Frame (string "(gs:shear-tag 'C " shearX " , " shearY " )"))))
(define (resize-action id width height)
  (let (cLst (gs:get-bounds 'OutputArea))
(println cLst)
    (center-point (cLst 2) (cLst 3)))
    (gs:delete-tag 'C)
    (draw-tag)
    (gs:shear-tag 'C shearX shearY)
)
; initialization
(gs:init)
(define FPosX 100)
(define FPosY 50)
(define FWidth canvas-Size)
(define FHeight canvas-Size)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "Frame")
(gs:set-text 'Frame (string "(gs:shear-tag 'C " shearX " , " shearY " )"))
(gs:set-border-layout 'Frame)
(gs:panel 'XPanel)
(gs:set-flow-layout 'XPanel "left")
(gs:panel 'YPanel)
;(gs:set-flow-layout 'YPanel "center")
(gs:slider 'X-factor 'slider-action "horizontal" 0 100 50)
(gs:slider 'Y-factor 'slider-action "vertical"   0 100 50)
(gs:canvas 'OutputArea)
(gs:set-background 'OutputArea gs:white)
; mount all on frame
(gs:add-to 'XPanel 'X-factor) 
(gs:add-to 'YPanel 'Y-factor) 
(gs:add-to 'XPanel 'X-factor) 
(gs:add-to 'YPanel 'Y-factor) 
(gs:add-to 'Frame 'XPanel "south" 'YPanel "east" 'OutputArea "center")
(gs:window-resized 'Frame 'resize-action)
(gs:set-visible 'Frame true)
(let (cLst (gs:get-bounds 'OutputArea))
  (gs:set-size 'Frame (+ canvas-Size (- canvas-Size (cLst 2))) (+ canvas-Size (- canvas-Size (cLst 3))))
)
; main routine
(gs:listen)
(exit)

　このスクリプトを実行し、ウィンドウを横に広げ、横のスライダを動かすと、


　こんな感じの変形も可能です。縦でも同様に変形します。
　こちらの変形の方が、この関数の一般的な使い方なのかも。
　私には、gs:shear-tag という関数名から、思い浮かばないですが、、、

　以上、如何でしょうか？

newLISP の Guiserver 翻訳マニュアル アップデート

投稿日 2010年9月25日
Filed under: GUI, Reference | タグ: ,
* コメントを残す

　いくつか間違いがあったので修正版のアップデートです。
　昨日の引用も、アップデータ後のデータです。

guiserver_manual.zip

　同時に newLISP 関数リファレンス・スクリプトも guiserver 関連ファイルをアップデートしました。
　“newLISP 関数リファレンス・スクリプト” は、newLISP 関数リファレンスを表示するスクリプトです。newLISP v10.2.7 以降で動作します。

newLISP 関数リファレンス・スクリプト

　重ねて、翻訳に、おかしな点や、間違いなど有りましたら、こちらの blog までご連絡下さい。

　以上、如何でしょうか？

newLISP で GUI する。。。または、gs:shear-tag を使ってみる

投稿日 2010年9月24日
Filed under: GUI, Reference | タグ:
* コメントを残す

　guiserver の２Dグラフィックス関数に gs:shear-tag というのがあります。
マニュアルには、説明がないので、日本語訳では、

gs:shear-tag
syntax: (gs:shear-tag sym-tag float-x float-y [boolean-repaint])
parameter: sym-tag – The tag group to shear.
parameter: float-x – The X shearing factor.
parameter: float-y – The Y shearing factor.
parameter: boolean-repaint – An optional flag to indicate if repainting is required (default is true).

（訳注：sym-tag で指定された 2Dグラフィックス・オブジェクトをハサミで潰すように変形します。）

　と、訳注を付けています。
　といっても、わかり辛いので、サンプルを書いてみました

; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp")) 
; define handler
(setq canvas-Size 400)
(setq X-pos (/ canvas-Size 2) Y-pos X-pos Radius (/ (* X-pos 9) 10))
(setq shearX 0.0 shearY 0.0) 
(define (slider-action id value)
  (let (axis ((parse id) -1))
    (case axis 
      ("X-factor" (setq shearX (div value 100)))
      ("Y-factor" (setq shearY (div (- 100 value) 100))))
    (gs:delete-tag 'C)
    (gs:draw-circle 'C X-pos Y-pos Radius gs:blue)
    (gs:draw-rect 'C 0 0 canvas-Size canvas-Size)
    (gs:shear-tag 'C shearX shearY)
    (gs:set-text 'Frame (string "(gs:shear-tag 'C " shearX " , " shearY " )"))
))
; initialization
(gs:init)
(define FPosX 100)
(define FPosY 50)
(define FWidth canvas-Size)
(define FHeight canvas-Size)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "Frame")
(gs:set-text 'Frame (string "(gs:shear-tag 'C " shearX " , " shearY " )"))
(gs:set-border-layout 'Frame)
(gs:panel 'XPanel)
(gs:set-flow-layout 'XPanel "left")
(gs:panel 'YPanel)
;(gs:set-flow-layout 'YPanel "center")
(gs:slider 'X-factor 'slider-action "horizontal" 0 100 0)
(gs:slider 'Y-factor 'slider-action "vertical"   0 100 100)
(gs:canvas 'OutputArea)
(gs:set-background 'OutputArea gs:white)
; mount all on frame
(gs:add-to 'XPanel 'X-factor) 
(gs:add-to 'YPanel 'Y-factor) 
(gs:add-to 'XPanel 'X-factor) 
(gs:add-to 'YPanel 'Y-factor) 
(gs:add-to 'Frame 'XPanel "south" 'YPanel "east" 'OutputArea "center")
(gs:set-visible 'Frame true)
(let (cLst (gs:get-bounds 'OutputArea)
      fLst (gs:get-bounds 'Frame)
      )
  (gs:set-size 'Frame (+ (fLst 2) (- canvas-Size (cLst 2))) (+ (fLst 3) (- canvas-Size (cLst 3))))
  (gs:set-size 'Frame (+ canvas-Size (- canvas-Size (cLst 2))) (+ canvas-Size (- canvas-Size (cLst 3))))
  (gs:draw-circle 'C X-pos Y-pos Radius gs:blue)
  (gs:draw-rect 'C 0 0 canvas-Size canvas-Size)
)
(gs:set-resizable 'Frame nil)
; main routine
(gs:listen)
(exit)

　このスクリプトを実行すれば、

　そして、縦と横のスライダを動かすと、

　こんな感じに 2Dグラフィックス・オブジェクトが変形されます。
　これを “ハサミで潰すように変形” と表記したのですが、、、

　以上、如何でしょうか？

UTF-8 版newLISP で日付を扱う。

投稿日 2010年9月23日
Filed under: Utility | タグ: , ,
* コメントを残す

　前回は、日付を抽出する正規表現でしたが、今回は、その後の処理。
　といっても、前に紹介した関数change-date の改良版です。
　その前に、ちょっとおさらい。

(define dateMatchStr
  {([　 ]*[0-9０-９]{2,4})?[　 ]*[./\-・／－‐年]?([　 ]*[0-9０-９]{1,2}[　 ]*)[./\-・／－‐月]([　 ]*[0-9０-９]{1,2})日?}
)
(define (number-zen2han str)
  (replace "[　 ]" str "" 2048)    ; added 2010/11/ 8
  (replace "[０-９]" str (char (+ (- (char $0) 0xFF10) 0x30)) 2048))

(define (convert-2slash str)
  (trim
    (replace "[.\\-・／－‐年月日]" (number-zen2han str) "/" 2048)
    "/"))

(define (divide-with-date str (flag true))
  (let (res (regex dateMatchStr str 2048))
    (if res (list (0 (res 1) str)
                  (if flag (convert-2slash (res 0)) (res 0))
                  ((+ (res 1) (res 2)) str)))))

　おさらいと言いつつ、さりげなく正規表現文字列を変えています（汗）。区切り文字にスペース（半角と全角）を使えなくしました。なんと前と同じ、進歩のない私です（汗）。
　気のとり直して、本題です（defun と hayashi は、 newlisp-utility.lsp に定義してあります）。

(setq Today (0 3 (now (* 9 60))))

(defun strlst2date (lst)
  (let (n (length (lst 0)))
    (if (zero? n)
        (setf (lst 0) (string (Today 0)))
      (setf (lst 0) (string (chop "2000" n) $it)))
      (map (hayashi int 0 10) (map (fn (x) (replace "　" x " ")) lst))))

(defun change-date (str)
  (let (slst (divide-with-date str))
    (when slst
      (let (d (/ (- (apply date-value (strlst2date (map trim (map number-zen2han (list $1 $2 $3)))))
                    (apply date-value Today))
                 24 60 60))
         (case d
           (0 (setf (slst 1) " 本日"))
           (1 (setf (slst 1) " 明日"))
           (2 (setf (slst 1) " 明後日"))
           (true (if (< d ) (setf (slst 1) (string " " (- d) "日前")))))))
      (apply string slst)))

(defun extract-date (str)
  (let (res (regex dateMatchStr (number-zen2han str) 2048))
    (when res
      (strlst2date (map trim (list $1 $2 $3))))))

　動作は、

> (change-date "9/23 テニスの日")
" 本日 テニスの日"
> (change-date "行事 9/23 テニスの日")
"行事 本日 テニスの日"
> (change-date "行事 10/9/23 テニスの日")
"行事 本日 テニスの日"
> (change-date "行事 2011/9/23 テニスの日")
"行事 2011/9/23 テニスの日"
> (change-date "祝日 １１年９月２３日 秋分の日")
"祝日 11/9/23 秋分の日"
> (extract-date "祝日 １１年９月２３日 秋分の日")
(2011 9 23)
> (extract-date "行事 9/23 テニスの日")
(2010 9 23)
> (extract-date "９／２３　テニスの日")
(2010 9 23)
>

　こんな感じ。

　以上、如何でしょうか？

UTF-8 版 newLISP で日付を抽出する。

投稿日 2010年9月22日
Filed under: Utility | タグ: , , ,
* コメントを残す

　前の blog で紹介した “newLISP で日付を抽出する”と“newLISP で日付を抽出する(再び)”の UTF-8 対応です。
　先ずは、スクリプトから、

(define dateMatchStr 
  {([　 ]*[0-9０-９]{2,4})?[　 ]*[./\-・／－‐年]?([　 ]*[0-9０-９]{1,2}[　 ]*)[./\-・／－‐月]([　 ]*[0-9０-９]{1,2})日?}
)
(define (number-zen2han str)
  (replace "[　 ]" str "" 2048)    ; added 2010/11/ 8
  (replace "[０-９]" str (char (+ (- (char $0) 0xFF10) 0x30)) 2048))

(define (convert-2slash str) 
  (trim 
    (replace "[.\\-・／－‐年月日]" (number-zen2han str) "/" 2048)
    "/"))

(define (divide-with-date str (flag true))
  (let (res (regex dateMatchStr str 2048))
    (if res (list (0 (res 1) str)
                  (if flag (convert-2slash (res 0)) (res 0))
                  ((+ (res 1) (res 2)) str)))))

　前の時のように、正規表現文字列を複数用意せずに済み、コードもすっきり（笑）。
　（2010/ 9/23 区切り文字から全角と半角のスペースを削除。）
　ちなみに、全角には、－（マイナス記号）と‐（ハイホン記号）の両方を用意しました。また、半角の -（ハイホン-マイナス記号）の前には、\（エスケープ文字）が必要です。前の時の文字列では付いていませんが、たまたま動作する配置になっています（汗）。
　全角->半角変換には前回のスクリプトを使ってもいいのですが、数字だけなので専用にしました。漢数字も対応といきたいところですが、それはまた、別の機会に。
　動作は、

> (divide-with-date "出張　３／１３　横浜")
("出張" "3/13" "　横浜")
> (divide-with-date "１０月１１日芋煮会")
("" "10/11" "芋煮会")
>

　こんな感じ。
　関数divide-with-date の追加した第二引数を nil にすると、

> (divide-with-date "１０月１１日芋煮会" nil)
("" "１０月１１日" "芋煮会")
>

　日付は、入力のまま出力されます。

　以上、如何でしょうか？

UTF-8 版で全角文字と半角文字を相互に変換する。

投稿日 2010年9月21日
Filed under: Utility | タグ: , ,
* コメントを残す

　Windows 上でも newLISP で UTF-8 コードが使えるようになり、一番、うれしかったのは、正規表現で日本語が普通に使えること。
　Shift-JIS コード上でも、使えなくことはないですが、工夫が要ります(汗)。
　でも、UTF-8 版なら、マニュアルにあるように

directory, find, member, parse, regex, regex-comp, replace で使われる — Perl Compatible Regular Expressions (PCRE) を UTF-8 利用可能にするには、 オプション番号 (2048) に従って設定します。 regex の結果のオフセットと長さは、 常に１バイト単位のカウントであることに注意して下さい。 詳細は、regex の項を見て下さい。
To enable UTF-8 in Perl Compatible Regular Expressions (PCRE) — used by directory, find, member, parse, regex, regex-comp and replace — set the option number accordingly (2048). Note that offset and lengths in regex results are always in single byte counts. See the regex documentation for details.

　だけで済みます。
　今回は、組込regex の UTF-8 モードの練習です。ついでに、正規表現も(笑)。
　まずは、半角を全角に変換します。対象は、数字、アルファベット、記号です。

(define (han2zen str)
  (replace "[\x20-\x7E]" str (if (= $0 " ") "　" (char (+ (- (char $0) 0x20) 0xFF00))) 2048))

　UNICODE では、全角のスペース以外は、ASCII コード順に展開されているので楽です。これが、Shift-JISだと、、、
　閑話休題、つまり、スペースだけ分けて変換しています。
　実際の動作は、（動作には、UTF-8 コード環境と UTF-8 版 newLISP が必要です。）

> [cmd]
(begin 
  (for (i 0x20 0x7E) (if (zero? (% i 32)) (println)) (print (char i)))
  (for (i 0x20 0x7E) (if (zero? (% i 32)) (println)) (print (han2zen (char i))))
  (println)
)
[/cmd]

 !"#$%&'()*+,-./0123456789:;?
@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
`abcdefghijklmnopqrstuvwxyz{|}~
　！＂＃＄％＆＇（）＊＋，－．／０１２３４５６７８９：；＜＝＞？
＠ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ［＼］＾＿
｀ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ｛｜｝～
nil
>

　これが Shift-JIS だと、

(define (han2zen str)
  (replace {^\130*[0-9A-Za-z]{1}|^\129*[A-Z]{1}} str
    (let (c (char $0))
      (cond ((> c 0x60) (string "\130" (char (+ (- c 0x61) 0x81))))
            (true  (string "\130" (char (+ (- c 0x41) 0x60)))))) 0))

　このスクリプトでも、数字とアルファベットだけです。記号は、変換できません。
　Shift-JIS コードでは、記号が ASCII コード順ではないのです（泣）。

　さて、全角から半角への変換は、　

(define (zen2han str)
  (replace [text][　\x{FF01}-\x{FF5E}][/text] str (if (= $0 "　") " " (char (+ (- (char $0) 0xFF00) 0x20))) 2048))

　こんな感じ。ポイントは、2バイト以上の16進数表記に {} を使うので [text][/text] タグを使うことくらい。後は、関数han2zen の逆をやっているだけですから。
　動作は、（動作には、UTF-8 コード環境と UTF-8 版 newLISP が必要です。）

> [cmd]
(begin 
  (print "　")
  (for (i 0xFF01 0xFF5E) (if (zero? (% i 32)) (println)) (print (char i)))
  (println)
  (print (zen2han "　"))
  (for (i 0xFF01 0xFF5E) (if (zero? (% i 32)) (println)) (print (zen2han (char i))))
  (println))
[/cmd]

　！＂＃＄％＆＇（）＊＋，－．／０１２３４５６７８９：；＜＝＞？
＠ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ［＼］＾＿
｀ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ｛｜｝～
 !"#$%&'()*+,-./0123456789:;?
@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
`abcdefghijklmnopqrstuvwxyz{|}~
nil
>

　といった具合。
　こちらの Shift-JIS 版は、

(define (zen2han str)
  (replace "(\130[O-X`a-y\x81-\x9A])" str
    (let (c (char ($1 1)))
      (cond ((> c 0x80) (char (+ (- c 0x81) 0x61)))
            (true  (char (- c 0x1F))))) 0))

　もちろん、このスクリプトでも、数字とアルファベットだけ。

　やはり、UTF-8 版が楽でいい（笑）。

　以上、如何でしょうか？

« Older Entries