nendo 0.3.1 → 0.3.2

data/bin/nendo

@@ -3,7 +3,7 @@
 #
 # nendo  -  "interpretter main program"
 #  
-#   Copyright (c) 2000-2010  Kiyoka Nishiyama  <kiyoka@sumibi.org>
+#   Copyright (c) 2009-2010  Kiyoka Nishiyama  <kiyoka@sumibi.org>
 #   
 #   Redistribution and use in source and binary forms, with or without
 #   modification, are permitted provided that the following conditions
@@ -36,45 +36,114 @@
 #
 require 'nendo'
 require 'getoptlong'
+#require 'profile'
+
+def userOptionEater
+  i = 0
+  while ( i < ARGV.length )
+    case ARGV[i]
+    when '-h'
+      i += 1
+    when '-q'
+      i += 1
+    when '-c'
+      i += 1
+    when '-l'
+      i += 2
+    when /^[^-]/
+      break
+    else
+      break
+    end
+  end
+  userOptions = ARGV.clone[i..ARGV.length]
+  userOptions.length.times { |x|
+    ARGV.pop
+  }
+  return userOptions
+end
+
+def cache_exist?( fn )
+  dotdir_path = File.expand_path( "~/.nendo" )
+  cache_path  = File.expand_path( "~/.nendo/cache" )
+  Dir.mkdir( dotdir_path ) unless File.exist?( dotdir_path )
+  Dir.mkdir( cache_path  ) unless File.exist?( cache_path  )
+  sha1 = Digest::SHA1.hexdigest( File.expand_path( fn ))
+  cache_name = cache_path + "/" + sha1 + "_" + File.basename( fn ) + ".rb"
+  if File.exist?( cache_name )
+    [  true, cache_name ]
+  else
+    [ false, cache_name ]
+  end
+end
 
 def main
-  loadInit = true
+  loadInit  = true
+  compile   = false
+  conflict = 0
   core = Nendo.new()
 
+  userOptions = userOptionEater
   opts = GetoptLong.new(
-                        [ '--help',          '-h', GetoptLong::NO_ARGUMENT ],
-                        [ '--no-init-file',  '-q', GetoptLong::NO_ARGUMENT ],
-                        [ '--load',          '-l', GetoptLong::REQUIRED_ARGUMENT ]
+                        [ '-h', GetoptLong::NO_ARGUMENT ],
+                        [ '-q', GetoptLong::NO_ARGUMENT ],
+                        [ '-c', GetoptLong::NO_ARGUMENT ],
+                        [ '-l', GetoptLong::REQUIRED_ARGUMENT ]
                         ).each { |opt, arg|
     case opt
-    when '--help'
+    when '-h'
       puts <<-EOF
       
       nendo [OPTION] [script-file]
 
-      -h, --help:
+      -h:
         show help
 
-      -q, --no-init-file:
+      -q:
         Does not read the default initialization file.
 
-      -l, --load:
-        Does not read the default initialization file.
+      -l file:
+        load nendo script files. ( can specify n times like   -l a.nnd -l b.nnd  )
+
+      -c:
+        compile nendo script file. (and initialization file was loaded)
 
       EOF
-    when '--no-init-file'
+      exit 0
+    when '-q'
       loadInit = false
-    when '--load'
+      conflict += 1
+    when '-c'
+      loadInit = true
+      compile  = true
+      conflict += 1
+    when '-l'
       core.load( arg )
       STDERR.printf( "loaded file [%s]\n", arg )
     end
   }
+
+  if  2 <= conflict 
+    STDERR.puts( "Error: Can't specify both -q and -c ...\n" ) 
+    exit( 1 )
+  end
   
   if loadInit
     core.loadInitFile
   end
-  if 0 < ARGV.length
-    core.load( ARGV[0] )
+  if 0 < userOptions.length
+    fn = userOptions[0]
+    if compile
+      # compile script file.
+      core.clean_compiled_code( )
+      core.load( fn )
+      core.replStr( sprintf( '(print-compiled-code "%s")', fn ))
+    else
+      # start script file.
+      core.setArgv( userOptions[1..userOptions.length] )
+      core.load( fn )
+      core.replStr( "(if (and (global-defined? 'main) (procedure? main)) (main *argv*) #f)" )
+    end
   else
     core.repl
   end

data/emacs/nendo-mode.el

@@ -4,6 +4,12 @@
 ;;  Copyright (c) 2010 Kiyoka Nishiyama
 ;;
 ;;
+;; Please add follows to .emacs
+;;  (setq scheme-program-name "nendo")
+;;  (autoload 'scheme-mode "cmuscheme" "Major mode for Scheme." t)
+;;  (autoload 'run-scheme "cmuscheme" "Run an inferior Scheme process." t)
+;;  (require 'nendo-mode)
+
 
 (require 'comint)
 (require 'cmuscheme)
@@ -42,6 +48,7 @@
   "Major mode for editing nendo code.
 Editing commands are similar to those of 'scheme-mode'."
   (make-local-variable 'scheme-buffer)
+  (modify-coding-system-alist 'process "nendo" '(utf-8 . utf-8))
   (local-set-key "\C-c\C-e" 'nendo-send-definition)
   (local-set-key "\C-x\C-e" 'nendo-send-last-sexp))
 

data/example/cgi/dekamoji.cgi

@@ -15,19 +15,23 @@
 (define font-list `(
                     ("1" "ゴシック" ,(+ fontbase "ipagp.ttf"))
                     ("2" "明朝"     ,(+ fontbase "ipamp.ttf"))
+                    ("3" "あんず"   ,(+ fontbase "APJapanesefont.ttf"))
                     ))
 (define default-fonttype 2)
 
 (define default-wording "デカ文字")
 (define default-size    2)
 (define size-list '(
-                    (1 . "サイズ小")
-                    (2 . "サイズ中")
-                    (3 . "サイズ大")
-                    (4 . "サイズ特大")
+                    (1 . "サイズ極小")
+                    (2 . "サイズ小")
+                    (3 . "サイズ中")
+                    (4 . "サイズ大")
+                    (5 . "サイズ特大")
                     ))
 
 (define (response-dekamoji str pointsize fontpath)
+  (define (blur image width)
+    (image.blur_channel 0 width Magick::AllChannels))
   (let* ((font-dots pointsize)
          (margin     (* pointsize 0.3))
          (tmp-image  (Magick::Image.new 1 1))
@@ -42,30 +46,46 @@
       (set! dr.fill     "#777799")
       (set! dr.stroke   "#8888AA")
       (dr.annotate image1  0 0 5 5 str)
-      (let* ((image2 (image1.blur_channel 0 3 Magick::AllChannels)))
+      (let* ((image2 (blur image1 3)))
         (set! dr.fill   "#111111")
         (set! dr.stroke "#606060")
         (dr.annotate image2  0 0 0 0 str)
-        (image2.to_blob)))))
+        (let1 image3 (blur image2 0.5)
+          (image3.to_blob))))))
 
 
-(define (top-page params)
-  (define (calc-limit min val max)
-    (let* ((val (if (< val min) min val))
-           (val (if (< max val) max val)))
-      val))
+;; -----------------------------------
+;; encode & decode
+;; -----------------------------------
+(define (encode-wording wording)
+  (string-join 
+   (map
+    (lambda (x)
+      (+ "%" (sprintf "%02X" x)))
+    (to-list (wording.unpack "C*")))
+   ""))
+
+(define (decode-wording enc-str)
+  (let1 hex-str (enc-str.gsub "%" "")
+    (. (. (list hex-str) to_arr) pack "H*")))
 
-  (let* ((size (if (hash-table-exist? params "size")
-                   (to-i (car (to-list (hash-table-get params "size"))))
-                   default-size))
-         (wording (if (hash-table-exist? params "w")
-                      (car (to-list (hash-table-get params "w")))
-                      default-wording))
-         (fonttype (if (hash-table-exist? params "type")
-                       (to-i (car (to-list (hash-table-get params "type"))))
-                       default-fonttype)))
-    (let* ((size      (calc-limit 1 size     (length size-list)))
-           (fonttype  (calc-limit 1 fonttype (length font-list))))
+
+;; ----------------------------------
+;; top page
+;; -----------------------------------
+(define (top-page params)
+  (define (calc-limit _start val _end)
+    (min  (max _start val)  _end))
+  (define (get-param params key default-value)
+    (if (hash-table-exist? params key)
+        (car (to-list (hash-table-get params key)))
+        default-value))
+  
+  (let ((size     (to-i (get-param params "size"    default-size)))
+        (wording        (get-param params "w"       #f))
+        (fonttype (to-i (get-param params "type"    default-fonttype))))
+    (let ((size         (calc-limit 1 size     (length size-list)))
+          (fonttype     (calc-limit 1 fonttype (length font-list))))
       `(
         ,(html-doctype)
         ,(html:head
@@ -73,50 +93,49 @@
         ,(html:body
           (html:div :style "text-align: center; "
                     (html:h1 "デカ文字作成")
-                    (html:p
-                     "下記に文章を入れて『画像化』ボタンを押して下さい")
-                    (html:form
-                     :method "POST"
-                     :action "./dekamoji.cgi"
-                     (html:input :name "w"       :type "text" :size 60 :value wording)
-                     (html:br)
-                     (map
-                      (lambda (x)
-                        (list
-                         (html:input :name "size"    :type "radio"
-                                     :value (car x)
-                                     :CHECKED (eq? (car x) size))
-                         (cdr x)))
-                      size-list)
-                     (html:br)
-                     (map
-                      (lambda (x)
-                        (list
-                         (html:input :name "type"    :type "radio"
-                                     :value (car x)
-                                     :CHECKED (eq? (to-i (car x)) fonttype))
-                         (second x)))
-                      font-list)
-                     (html:br)
-                     (html:input :type "submit"  :value "画像化"))
+                    (html:p  "文章を入れて『画像化』ボタンを押して下さい")
+                    (html:form  :method "POST" :action "./dekamoji.cgi"
+                                (html:input :name "w"       :type "text" :size 60 :value wording)
+                                (html:br)
+                                (map (lambda (x) (list
+                                                  (html:input :name "size"    :type "radio"   :value (car x)
+                                                              :CHECKED (eq? (car x) size))
+                                                  (cdr x)))
+                                     size-list)
+                                (html:br)
+                                (map (lambda (x) (list
+                                                  (html:input :name "type"    :type "radio"   :value (car x)
+                                                              :CHECKED (eq? (to-i (car x)) fonttype))
+                                                  (second x)))
+                                     font-list)
+                                (html:br)
+                                (html:input :type "submit"  :value "画像化"))
                     (html:hr)
-                    (html:img :src (sprintf "./dekamoji.cgi?img=1&size=%d&type=%s&w=%s" size fonttype wording))
+                    (cond
+                     (wording
+                      (html:img :src (sprintf "./dekamoji.cgi?img=1&size=%d&type=%s&w=%s" size fonttype (encode-wording wording))))
+                     (else
+                      (html:p "no image")))
                     (html:hr)))))))
 
 (define fontsize-alist '(
-                         ("1" . 40)
-                         ("2" . 80)
-                         ("3" . 160)
-                         ("4" . 320)
+                         ("1" . 20)
+                         ("2" . 40)
+                         ("3" . 80)
+                         ("4" . 160)
+                         ("5" . 320)
                          ))
 
-(if #f
+;; -----------------------------------
+;; entry point
+;; -----------------------------------
+(if #t
     ;; testing
     (display
      (response-dekamoji
       "デカ文字"
       80
-      (+ fontbase "/IPAfont00302/ipam.ttf")))
+      (+ fontbase "ipamp.ttf")))
     ;; release
     (let1 cgi (CGI.new)
       (cond ((hash-table-exist? cgi.params "img")

data/example/fact.nnd

@@ -8,8 +8,5 @@
       1
       (* n #?=(fact (- n 1)))))
 
-(print (fact 5))
-
-
-
-
+(define (main argv)
+  (print (fact 5)))

data/example/fizzbuzz1.nnd

@@ -18,6 +18,8 @@
          x))))
    (range max)))
 
-(for-each
- print
- (fizzbuzz 30))
+(define (main argv)
+  (for-each
+   print
+   (fizzbuzz 30)))
+

data/example/nqueen.nnd

@@ -0,0 +1,71 @@
+#!/bin/sh
+:; #-*- mode: nendo; syntax: scheme -*-;;
+:; exec /usr/local/bin/nendo $0 $*
+;; -*- coding: utf-8 -*-
+;;  Nqueen
+;;  n×n の互いに効き線上にないクイーンの配列をみつける
+
+;;  SHINYAMA Yusuke (euske@cl.cs.titech.ac.jp)
+;;  This software is public domain.
+
+(define (decr x) (- x 1))
+(define (incr x) (+ x 1))
+
+; rotate: ベクタ x を pos要素 だけ回転させる
+(define (rotate x pos)
+  (do ((last (decr (vector-length x)))
+       (x0 (vector-ref x pos))
+       (i pos (incr i)))
+      ((= i last) (vector-set! x last x0))
+    (vector-set! x i (vector-ref x (incr i)))))
+
+; rotrec: ベクタ x の要素の、あらゆる配置の組み合わせに func を適用する
+(define (rotrec func x pos)
+  (let ((last (decr (vector-length x))))
+    (if (= pos last)
+	(func x)
+	(do ((i pos (incr i)))
+	    ((< last i) #f)
+	  (rotrec func x (incr pos))
+	  (rotate x pos)))))
+
+; genpat: n×n の盤の初期パターンを作る
+(define (genpat n)
+  (let ((x (make-vector n)))
+    (do ((i 0 (incr i)))
+	((= n i) x)
+      (vector-set! x i i))))
+
+; checkqueen: パターン p がすべて互いに効き線上にないクイーンなら #t
+(define (checkqueen p)
+  (define (loop i diag0 diag1) ; i はカウンタ, diag0, diag1 はリスト
+    (or (zero? i)
+	(let* ((x (decr i))
+	       (y (vector-ref p x))
+	       (d0 (+ x y))
+	       (d1 (- x y)))
+	  ;;(printf "check: %s (%d,%d) in %s,%s\n" p x y (write-to-string diag0) (write-to-string diag1))
+	  (and (not (or (memv d0 diag0)
+			(memv d1 diag1)))
+	       (loop (decr i) (cons d0 diag0) (cons d1 diag1))))))
+  (loop (vector-length p) '() '()))
+
+; nqueen: メインルーチン
+(define (nqueen n)
+  (let ((result '()))
+    (rotrec (lambda (p) 
+	      (if (checkqueen p)
+		  (set! result
+			(cons (vector->list p) result))))
+	    (genpat n) 0)
+    result))
+
+; sample
+;(display (nqueen 8))(newline)(exit)
+
+(define (main args)
+  (display (nqueen 8))
+  (newline)
+  (exit 0))
+(main *argv*)
+

data/example/scratch.nnd

@@ -1,7 +1,6 @@
 ;;-*- mode: nendo; syntax: scheme -*-;;
-
 ;; -----------------
 (enable-idebug)
+(disable-idebug)
 (define debug-print-length 256)
 
-

data/lib/debug/syslog.nnd

@@ -3,7 +3,7 @@
 ;;; debug/syslog.nnd  -  #?= debug message output to syslog
 ;;;
 ;;;  
-;;;   Copyright (c) 2000-2010  Kiyoka Nishiyama  <kiyoka@sumibi.org>
+;;;   Copyright (c) 2009-2010  Kiyoka Nishiyama  <kiyoka@sumibi.org>
 ;;;   
 ;;;   Redistribution and use in source and binary forms, with or without
 ;;;   modification, are permitted provided that the following conditions

data/lib/debug/syslog.nndc

@@ -1,3 +1,7 @@
+#
+#    This file is nendo's compiled library file. 
+#    generated  "nendo -c src" command. 
+# 
 
   callProcedure( 'require',
       begin
@@ -51,3 +55,8 @@
             end
         }
   end
+
+
+# -------------------------------------------------------
+# [EOF]
+# -------------------------------------------------------