Archive for 2010年10月2日|Daily archive page

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

 newLISP の開発バージョン 2.8.16 がリリースされ、gs:table が使えるようになりました。
 と、言うことで、gs:table を使って、先日の太陽系惑星のデータを表示させてみましょう。
 先ずは、スクリプトから、(aif と defun は 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 the function for gs:table
(defun clear-table (table)
  (gs:table-get-size table)
  (dotimes (i (gs:table-size 0))
    (dotimes (j (gs:table-size 1))
      (gs:table-set-cell table i j ""))))
(defun set-table (lst)
  (clear-table 'OutputArea)
  (let (len (length (lst 0)))
    (when (< (gs:table-size 1) len)
      (for (i (i+ (gs:table-size 1)) len) (gs:table-add-column 'OutputArea ""))))
  (dolist (row lst)
    (let (r $idx)
      (if (< r (gs:table-size 0))
          (dolist (c row) (gs:table-set-cell 'OutputArea r $idx (string c)))
        (gs:table-add-row 'OutputArea (map string row))))))
; 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*)
        (set-table 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*))
(define (table-action id row col data)
  (println "id=" id " row=" row " col=" col " data=" data))
; initialization
(gs:init)
(define FPosX 100)
(define FPosY 50)
(define FWidth 640)
(define FHeight 480)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "CSV Viewer with gs:table")
(gs:panel 'StatusPanel)
(gs:label 'Status (real-path))
(gs:button 'fileButton 'open-file-dialog "File")
(gs:table 'OutputArea 'table-action "1")
(gs:table-add-row 'OutputArea )
(gs:table-set-row-number  'OutputArea true)
(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)

 これを実行させるには、 v 2.8.16以上が必要です。
 実行させて、CSVファイルを読み込むと、

 こんな感じで日本語も表示できます。日本語になっているのそういう CSVファイルを読み込んだからです。gs:table で自動的に日本語になる訳はありません。念のため(笑)。

 さて、gs:table の解説は、次回に。

 以上、如何でしょうか?