Archive for 2011年3月|Monthly archive page
newLISP マニュアル・アップデート v.10.3.0 rev 2011-03-26
コメントを残す newLISP のマニュアルが rev 2011-03-26 のバージョンアップされたので、それに合わせて日本語訳もアップデートします。
変更内容は関数find-all の語句訂正で、関数の機能が変わったわけではありません。
newLISP マニュアル ＆ リファレンス の全訳のリリースで、現在のバージョンは、v.10.3.0 rev 2011-03-26 です。
目次も含め日本語併記にしてあります。
いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報下さい。
以上、如何でしょうか？
newLISP で GUI する。。。数独入力スクリプト
先日の数独解法スクリプトは、如何だったでしょうか？
さて今回は、予告通り（笑）GUI による数独の入力スクリプトです。
; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp"))
; initialization
(gs:init)
(define *size* 40)
(define *sudoku* (explode (dup 0 81) 9))
(define *temporary* (explode (dup 0 81) 9))
(setq X-pos 0 Y-pos 0)
(define *fileName* (real-path))
(define *filemask* "sdk SDK")
(define *description* "sudoku file")
; define sub-routine
(define (sudoku1pass nums)
(let (res)
(for (i 0 8)
(let (row)
(for (j 0 8)
(let (n (nums i j))
(if (> n 0) (push (list n) row -1)
(letn (can (difference '(1 2 3 4 5 6 7 8 9) (nums i))
can (difference can (map (curry nth j) nums))
can (difference can (flat (map (curry (* (/ j 3) 3) 3) ((* (/ i 3) 3) 3 nums)))))
(if (= (length can) 1) (setf (nums i j) (can 0)))
(push can row -1)))))
(let (tmp (ref-all 1 (count '(0 1 2 3 4 5 6 7 8 9) (apply append row))))
(if tmp (dolist (k (apply append tmp)) (setf (nums i ((ref k row) 0)) k))))
(push row res -1)))
(for (j 0 8)
(letn (col (map (curry nth j) res)
tmp (ref-all 1 (count '(0 1 2 3 4 5 6 7 8 9) (apply append col))))
(if tmp (dolist (k (apply append tmp)) (setf (nums ((ref k col) 0) j) k)))))
(list nums res)))
; define handler
(define (item-action id)
(set-number X-pos Y-pos (int (id -1))))
(define (mouse-pressed-action x y button modifiers tags)
(when (= button 3)
(let (lst (sudoku1pass *temporary*))
(for (i 1 9) (gs:disable (sym (string i))))
(if (> ((lst 0) Y-pos X-pos) 0) (gs:enable (sym ((lst 0) Y-pos X-pos)))
(dolist (i (map string ((lst -1) Y-pos X-pos)))
(gs:enable (sym i))))
(gs:show-popup 'numlist 'Sudoku x y))))
(define (move-cell x y)
(if x (setq X-pos x))
(if y (setq Y-pos y))
(gs:delete-tag 'R) (gs:set-stroke 3.0)
(gs:draw-rect 'R (+ (* X-pos *size*) 2) (+ (* Y-pos *size*) 2) (- *size* 4) (- *size* 4) gs:lightGray)
(gs:update))
(define (mouse-clicked-action x y button cnt modifiers tags)
(unless (find "S" tags 0)
(move-cell (/ x *size*) (/ y *size*))))
(define (mouse-moved-action x y)
(let (xc (/ x *size*) yc (/ y *size*))
(gs:set-text 'SudokuFrame (string "moved row: " (+ 1 yc) " col:" (+ 1 xc)))))
(define (delete-num x y)
(gs:delete-tag (string "T" x y))
(gs:delete-tag (string "S" x y)))
(define (set-number x y num)
(delete-num x y)
(setf (*temporary* y x) num)
(gs:draw-text (string "T" x y)
(string num)
(+ (* x *size*) (/ *size* 4))
(- (* (+ 1 y) *size*) (/ *size* 8)))
(gs:update))
(define (set-sudoku x y num)
(delete-num x y)
(setf (*sudoku* y x) num)
(gs:draw-text (string "S" x y)
(string num)
(+ (* x *size*) (/ *size* 4))
(- (* (+ 1 y) *size*) (/ *size* 8))
gs:blue)
(gs:update))
(define (move x y)
(do-until (= 0 (*sudoku* Y-pos X-pos))
(if (= x "up") (++ X-pos)
(= y "up") (++ Y-pos)
(= x "down") (-- X-pos)
(= y "down") (-- Y-pos))
(if (< X-pos 0) (setq X-pos 8)
(< 8 X-pos) (setq X-pos 0))
(if (< Y-pos 0) (setq Y-pos 8)
(< 8 Y-pos) (setq Y-pos 0)) )
(move-cell))
(define (key-action id type code modifiers)
(when (= type "released")
(case code
( 8 (move "down" nil)); bs
(37 (move "down" nil)); left
(38 (move nil "down")); up
(39 (move "up" nil)); right
(40 (move nil "up")); downt
(127 (gs:delete-tag (string "T" X-pos Y-pos))
(setf (*temporary* Y-pos X-pos) 0)); del
(true (let (key (& code 0xF))
(when (and (> key 0) (> 10 key)
(find key (((sudoku1pass *temporary*) -1) Y-pos X-pos)))
(set-number X-pos Y-pos key)))))))
(define (draw-sudoku)
(for (r 0 8) (for (c 0 8)
(let (s (*sudoku* r c)
t (*temporary* r c))
(if (> s 0) (set-sudoku c r s)
(> t 0) (set-number c r t))))))
(define (open-action id op file)
(when file
(setq *fileName* (base64-dec file))
(unless (directory? *fileName*)
(load *fileName*)
(for (r 0 8) (for (c 0 8)
(let (s (*sudoku* r c)
t (*temporary* r c))
(if (> s 0) (set-sudoku c r s)
(> t 0) (set-number c r t)
(delete-num c r)))))
(let (it (ref 0 *sudoku*)) (if it (apply move-cell (reverse it)))))))
(define (open-file-dialog)
(gs:open-file-dialog 'SudokuFrame 'open-action *fileName* *filemask* *description*))
(define (save-action id op file)
(when file
(setq *fileName* (base64-dec file))
(unless (directory? *fileName*)
(save *fileName* '*sudoku* '*temporary*))))
(define (save-file-dialog)
(if (directory? *fileName*)
(gs:save-file-dialog 'SudokuFrame 'save-action *fileName* "" *filemask* *description*)
(gs:save-file-dialog 'SudokuFrame 'save-action *fileName* *fileName* *filemask* *description*)))
(define (fix-action id)
(when (ref 0 *temporary*)
(setq *sudoku* *temporary*)
(draw-sudoku)))
(define (release-action id)
(setq *sudoku* (explode (dup 0 81) 9))
(draw-sudoku))
; making frame & canvas
(gs:frame 'SudokuFrame 100 100 400 400 "Sudoku")
(gs:canvas 'Sudoku 'SudokuFrame)
(gs:add-to 'SudokuFrame 'Sudoku)
(gs:set-background 'Sudoku gs:white)
(gs:mouse-pressed 'Sudoku 'mouse-pressed-action true)
(gs:mouse-clicked 'Sudoku 'mouse-clicked-action true)
(gs:mouse-moved 'Sudoku 'mouse-moved-action)
(gs:key-event 'Sudoku 'key-action)
(gs:menu-popup 'numlist "Candidate")
(for (i 1 9)
(let (n (string i))
(gs:menu-item (sym n) 'item-action (string i))
(gs:add-to 'numlist (sym n))))
(gs:menu 'File "Tools")
(gs:menu-item 'Load 'open-file-dialog "load")
(gs:menu-item 'Save 'save-file-dialog "save")
(gs:menu-item 'Fix 'fix-action "fix")
(gs:menu-item 'Release 'release-action "release")
(gs:add-to 'File 'Load 'Save)
(gs:add-separator 'File)
(gs:add-to 'File 'Fix 'Release)
(gs:menu-bar 'SudokuFrame 'File)
(gs:set-anti-aliasing true)
(gs:set-font'Sudoku "Monospaced" (- *size* 1) "bold")
(gs:set-stroke 2.0)
(for (r 1 9)
(if (= 0 (mod r 3)) (gs:set-stroke 3.0) (gs:set-stroke 1.0))
(gs:draw-line 'L (* r *size*) 0 (* r *size*) (* 9 *size*) gs:black)
(gs:draw-line 'L 0 (* r *size*) (* 9 *size*) (* r *size*) gs:black))
(gs:set-visible 'SudokuFrame true)
(let (size (gs:get-bounds 'Sudoku))
(gs:set-size 'SudokuFrame (- 400 (- (size 2) (* 9 *size*))) (- 400 (- (size 3) (* 9 *size*))))
(gs:update))
(move-cell)
; main routine
(while (gs:check-event 10000) (gs:request-focus 'Sudoku))
(exit)
実行すれは、右図のような数独のマスが現れます。後は、数字を入力するだけ、数字を変更するには、del キーで空きマスにしてから再度入力して下さい。空きマスの入力には、右クリックで出てくる入力可能な数字からも可能です。
数独を入力し終わったら、メニュー Tools から、fix を選択すると、数字が青に変わり、変更できなくなります。解除するには、同じ Tools から、release を選択します。数字の青を変えたいときは、スクリプト中の gs:blue を適当な値に変更して下さい。（例えば、gs:cyan gs:darkGray gs:gray gs:green gs:lightGray gs:magenta gs:orange gs:pink gs:red gs:yellow 等）
Tools の残りは、load と save ですから、説明するまでもありませんね（笑）。
下図のように、数独を解いている途中の状態も保存できます。
ここまでできれば、後は数独出題スクリプト？ なんてね（笑）。
以上、如何でしょうか？
新リスプな日々 