Skip to content

Instantly share code, notes, and snippets.

@k0f1sh

k0f1sh/naruto.el

Last active December 20, 2015 03:38
Download ZIP

Revisions

  1. k0f1sh revised this gist Aug 6, 2013. 1 changed file with 32 additions and 0 deletions.
    32 changes: 32 additions & 0 deletions naruto.el
    View file
    Original file line number Diff line number Diff line change
    @@ -117,3 +117,35 @@
    (zip-list (-zip (string-to-list str) distinct-list))
    )
    (render (translate zip-list))))

    ;;(naruto "あいうえおかきくけこさしすせそーーーーーーーーーーーーーーーーーー")
    ;; 実行結果
    ;; ー ー
    ;; ／ ー

    ;; ＼
    ;; ／
    ;; ＼

    ;; ｜
    ;; ｜
    ;; かおえう
    ;; き い
    ;; ｜ く あ ｜

    ;; け
    ;; ｜
    ;; こ
    ;; ｜
    ;; さ ／
    ;; し そ
    ;; す せ
    ;; ＼



    ;; ＼


    ;; ー
    ;; ー
  2. k0f1sh revised this gist Aug 6, 2013. 1 changed file with 85 additions and 122 deletions.
    207 changes: 85 additions & 122 deletions naruto.el
    View file
    Original file line number Diff line number Diff line change
    @@ -1,77 +1,99 @@
    (require 'dash)

    (defconst PI 3.1415)
    (defconst a 0.05)

    (defvar b 0.3)

    (defvar update-span 0.05
    "画面更新時間")
    (defvar scale-x 1
    (defvar scale-x 0.3
    "x軸拡大率")

    (defvar scale-y 1
    (defvar scale-y 0.3
    "y軸拡大率")

    (defun uzumaki (k)
    (defun uzumaki (n)
    "uzumakiのx,y座標をコンスセルで返す"
    (let* ((theta (* k PI))
    (x (* a (* b theta) (cos theta)))
    (y (* a (* b theta) (sin theta))))
    (let* ((k (/ n 10.0))
    (theta (* k PI))
    (x (* a theta (cos theta)))
    (y (* a theta (sin theta))))
    (cons x y)))

    (defun naruto (str)
    "文字列をなると風に変換してバッファに書き出す"
    (let* ((point-alist (mapcar (lambda (k)
    (let* ((p (uzumaki k))
    (x (car p))
    (y (cdr p)))
    (cons (round (* 100 x)) (round (* 100 y)))))
    (number-sequence 0 10 0.07)))
    (zip-list (-zip (string-to-list str) (translate point-alist))))
    (render zip-list)))
    (defun get-nth (x y width)
    "座標から配列上の場所を求める"
    (+ x (* y width)))

    (defun black-hole (str)
    "文字列をブラックホールのように表示する"
    (let* ((point-alist (mapcar (lambda (k)
    (let* ((p (uzumaki k))
    (x (car p))
    (y (cdr p)))
    (cons (round (* 100 x)) (round (* 100 y)))))
    (number-sequence 0 10 0.07)))
    (str-list (string-to-list str)))
    (dotimes (i (length str-list))
    (setq str-list (-concat (cdr str-list) '(?　)))
    (if (null str-list)
    nil
    (render (-zip str-list (translate point-alist))))
    (goto-char (/ (+ (point-min)(point-max)) 2))
    (recenter)
    (sit-for update-span))))
    (defun scale-update (point-alist)
    (mapcar (lambda (point-cell)
    (cons
    (floor (* scale-x (car point-cell)))
    (floor (* scale-y (cdr point-cell)))))
    point-alist))

    (defun str-update (str x y ox oy)
    "文字を適切なものに変換して返す
    ー => 中心からの角度によって文字を変える
    英数字 => 半角スペースを足して全角１文字と同じ幅にする"
    (cond ((string= "ー" str)
    (let ((r (atan-360 (- y oy) (- x ox))))
    ; 角度によって"ー"を変換
    (cond
    ;; |
    ((or (or (and (> 22.5 r)
    (<= 0 r))
    (< 337.5 r))
    (and (<= 157.5 r)
    (> 202.5 r)))
    "｜")
    ;; ／
    ((or (and (<= 112.5 r)
    (> 157.5 r))
    (and (<= 292.5 r)
    (> 337.5 r)))
    "／")
    ;; ＼
    ((or (and (<= 22.5 r)
    (> 67.5 r))
    (and (<= 202.5 r)
    (> 247.5 r)))
    "＼")
    (t "ー"))))
    ((multibyte-string-p str)
    str)
    (t (format " %s" str))))

    (defun translate (point-alist)
    (let ((min-x (apply #'min (mapcar (lambda (p) (car p)) point-alist)))
    (max-y (apply #'max (mapcar (lambda (p) (cdr p)) point-alist))))
    (defun atan-360 (y x)
    "atanを度に変化して返す"
    (let ((a (atan y x)))
    (if (< a 0)
    (+ 360 (/ (* 180 a) PI))
    (/ (* 180 a) PI))))

    (defun translate (zip-list)
    (let ((min-x (apply #'min (mapcar (lambda (p) (cadr p)) zip-list)))
    (max-y (apply #'max (mapcar (lambda (p) (cddr p)) zip-list)))
    (ox (cadr (first zip-list)))
    (oy (cddr (first zip-list))))
    (mapcar (lambda (p)
    (cons
    (* (+ (abs min-x) (car p)) scale-x)
    (* (+ (abs max-y) (cdr p) scale-y))))
    point-alist)))
    (str-update (char-to-string (car p)) (cadr p) (cddr p) ox oy)
    (cons
    (+ (abs min-x) (cadr p))
    (- (abs max-y) (cddr p)))))
    zip-list)))


    (defun get-nth (x y width)
    "座標から配列上の場所を求める"
    (+ x (* y width)))

    (defun render (zip-list)
    (let* ((max-x (1+ (apply #'max (mapcar (lambda (p) (cadr p)) zip-list))))
    (max-y (1+ (apply #'max (mapcar (lambda (p) (cddr p)) zip-list))))
    (nl (-repeat (* max-x max-y) nil)))
    (nl (-repeat (* max-x max-y) nil))
    (ox (cadr (first zip-list)))
    (oy (cddr (first zip-list))))
    (-each zip-list (lambda (z)
    (setf (nth (get-nth (cadr z)
    (cddr z)
    max-x)
    nl)
    (char-to-string (car z)))
    ))
    (car z))))
    (switch-to-buffer "*naruto-render*")
    (erase-buffer)
    (dotimes (y max-y)
    @@ -81,76 +103,17 @@
    (insert " ")
    (insert mass))
    ))
    (insert "\n"))
    ))
    ;; TODO
    ;; 半角文字にも対応させる
    ;; 中心が潰れてしまう問題を修正する
    ;; 変な空白がでる
    ;;(naruto "吾輩は猫である。名前はまだ無い。どこで生れたかとんと見当がつかぬ。何でも薄暗いじめじめした所でニャーニャー泣いていた事だけは記憶している。吾輩はここで始めて人間というものを見た。")
    ;;
    ;; 実行結果
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;; 人 間
    ;; と
    ;; て
    ;; い
    ;;
    ;; め
    ;; う
    ;;
    ;;
    ;; 始
    ;; ー ニ ャ ー
    ;; も
    ;; ャ 泣
    ;; で
    ;; ニ
    ;; い
    ;; で の
    ;;
    ;; こ て
    ;; 所 た か とん
    ;; れ と
    ;; 生 見 い
    ;; た で を
    ;; こ こ 当
    ;; ど
    ;; 。 が た
    ;; し い 輩は
    ;; 無 あ つ
    ;; は だ 。 見
    ;; め は前名 か
    ;; 事
    ;; じ ぬ
    ;;
    ;; 輩 。
    ;; め だ た
    ;; 何
    ;; じ で
    ;; い も
    ;; 吾 暗 薄 け
    ;;
    ;; 。
    ;; 。 は
    ;;
    ;;
    ;; る 記
    ;;
    ;; い 憶
    ;; て し
    ;;
    (insert "\n"))))

    (defun naruto (str)
    "文字列をなると風に変換してバッファに書き出す"
    (let* ((point-alist (mapcar (lambda (k)
    (let* ((p (uzumaki k))
    (x (car p))
    (y (cdr p)))
    (cons (round (* 100 x)) (round (* 100 y)))))
    (number-sequence 0 (* 2 (length str)) 1)))
    (distinct-list (-take (length str) (-distinct (scale-update point-alist))))
    (zip-list (-zip (string-to-list str) distinct-list))
    )
    (render (translate zip-list))))
  3. k0f1sh revised this gist Jul 25, 2013. 1 changed file with 0 additions and 1 deletion.
    1 change: 0 additions & 1 deletion naruto.el
    View file
    Original file line number Diff line number Diff line change
    @@ -83,7 +83,6 @@
    ))
    (insert "\n"))
    ))
    (black-hole "吾輩は猫である。名前はまだ無い。どこで生れたかとんと見当がつかぬ。何でも薄暗いじめじめした所でニャーニャー泣いていた事だけは記憶している。吾輩はここで始めて人間というものを見た。")
    ;; TODO
    ;; 半角文字にも対応させる
    ;; 中心が潰れてしまう問題を修正する
  4. k0f1sh revised this gist Jul 25, 2013. 1 changed file with 112 additions and 52 deletions.
    164 changes: 112 additions & 52 deletions naruto.el
    View file
    Original file line number Diff line number Diff line change
    @@ -1,30 +1,60 @@
    (require 'dash)
    (require 's)
    (defconst PI 3.1415)
    (defconst a 0.05)

    (defvar b 0.3)

    (defvar update-span 0.05
    "画面更新時間")
    (defvar scale-x 1
    "x軸拡大率")

    (defvar scale-y 1
    "y軸拡大率")

    (defun uzumaki (k)
    "uzumakiのx,y座標をコンスセルで返す"
    (let* ((theta (* k PI))
    (x (* a theta (cos theta)))
    (y (* a theta (sin theta))))
    (x (* a (* b theta) (cos theta)))
    (y (* a (* b theta) (sin theta))))
    (cons x y)))

    (defun naruto (str)
    "文字列をなると風に変換してバッファに書き出す"
    (let* ((point-alist (mapcar (lambda (k)
    (let* ((p (uzumaki k))
    (x (car p))
    (y (cdr p)))
    (cons (floor (* 100 x)) (floor (* 100 y)))))
    (number-sequence 0 2 0.1)))
    (zip-list (-zip (string-to-list str) (translate point-alist))))
    (x (car p))
    (y (cdr p)))
    (cons (round (* 100 x)) (round (* 100 y)))))
    (number-sequence 0 10 0.07)))
    (zip-list (-zip (string-to-list str) (translate point-alist))))
    (render zip-list)))

    (defun black-hole (str)
    "文字列をブラックホールのように表示する"
    (let* ((point-alist (mapcar (lambda (k)
    (let* ((p (uzumaki k))
    (x (car p))
    (y (cdr p)))
    (cons (round (* 100 x)) (round (* 100 y)))))
    (number-sequence 0 10 0.07)))
    (str-list (string-to-list str)))
    (dotimes (i (length str-list))
    (setq str-list (-concat (cdr str-list) '(?　)))
    (if (null str-list)
    nil
    (render (-zip str-list (translate point-alist))))
    (goto-char (/ (+ (point-min)(point-max)) 2))
    (recenter)
    (sit-for update-span))))

    (defun translate (point-alist)
    (let ((min-x (apply #'min (mapcar (lambda (p) (car p)) point-alist)))
    (min-y (apply #'min (mapcar (lambda (p) (cdr p)) point-alist))))
    (max-y (apply #'max (mapcar (lambda (p) (cdr p)) point-alist))))
    (mapcar (lambda (p)
    (cons (+ (abs min-x) (car p)) (+ (abs min-y) (cdr p))))
    (cons
    (* (+ (abs min-x) (car p)) scale-x)
    (* (+ (abs max-y) (cdr p) scale-y))))
    point-alist)))

    (defun get-nth (x y width)
    @@ -37,10 +67,10 @@
    (nl (-repeat (* max-x max-y) nil)))
    (-each zip-list (lambda (z)
    (setf (nth (get-nth (cadr z)
    (cddr z)
    max-x)
    nl)
    (char-to-string (car z)))
    (cddr z)
    max-x)
    nl)
    (char-to-string (car z)))
    ))
    (switch-to-buffer "*naruto-render*")
    (erase-buffer)
    @@ -53,45 +83,75 @@
    ))
    (insert "\n"))
    ))

    (black-hole "吾輩は猫である。名前はまだ無い。どこで生れたかとんと見当がつかぬ。何でも薄暗いじめじめした所でニャーニャー泣いていた事だけは記憶している。吾輩はここで始めて人間というものを見た。")
    ;; TODO
    ;; ２０文字までしか対応していない
    ;; 対数螺旋だと文字数少ないのでイマイチ
    ;; 半角文字にも対応させる
    ;;(naruto "吾輩は猫である。名前はまだ無い。どこで生れ")
    ;; 中心が潰れてしまう問題を修正する
    ;; 変な空白がでる
    ;;(naruto "吾輩は猫である。名前はまだ無い。どこで生れたかとんと見当がつかぬ。何でも薄暗いじめじめした所でニャーニャー泣いていた事だけは記憶している。吾輩はここで始めて人間というものを見た。")
    ;;
    ;; 実行結果
    ;; 。 ど

    ;; こ
    ;; い



    ;; 無 で




    ;; だ

    ;; 生



    ;; ま




    ;; れ
    ;; は 吾輩
    ;; は

    ;; 猫
    ;; 前
    ;; で

    ;; 名 あ
    ;; 。 る

    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;;
    ;; 人 間
    ;; と
    ;; て
    ;; い
    ;;
    ;; め
    ;; う
    ;;
    ;;
    ;; 始
    ;; ー ニ ャ ー
    ;; も
    ;; ャ 泣
    ;; で
    ;; ニ
    ;; い
    ;; で の
    ;;
    ;; こ て
    ;; 所 た か とん
    ;; れ と
    ;; 生 見 い
    ;; た で を
    ;; こ こ 当
    ;; ど
    ;; 。 が た
    ;; し い 輩は
    ;; 無 あ つ
    ;; は だ 。 見
    ;; め は前名 か
    ;; 事
    ;; じ ぬ
    ;;
    ;; 輩 。
    ;; め だ た
    ;; 何
    ;; じ で
    ;; い も
    ;; 吾 暗 薄 け
    ;;
    ;; 。
    ;; 。 は
    ;;
    ;;
    ;; る 記
    ;;
    ;; い 憶
    ;; て し
    ;;
  5. k0f1sh revised this gist Jul 23, 2013. 1 changed file with 37 additions and 1 deletion.
    38 changes: 37 additions & 1 deletion naruto.el
    View file
    Original file line number Diff line number Diff line change
    @@ -58,4 +58,40 @@
    ;; ２０文字までしか対応していない
    ;; 対数螺旋だと文字数少ないのでイマイチ
    ;; 半角文字にも対応させる
    (naruto "吾輩は猫である。名前はまだ無い。どこで生れ")
    ;;(naruto "吾輩は猫である。名前はまだ無い。どこで生れ")
    ;;
    ;; 実行結果
    ;; 。 ど

    ;; こ
    ;; い



    ;; 無 で




    ;; だ

    ;; 生



    ;; ま




    ;; れ
    ;; は 吾輩
    ;; は

    ;; 猫
    ;; 前
    ;; で

    ;; 名 あ
    ;; 。 る

  6. k0f1sh created this gist Jul 23, 2013.
    61 changes: 61 additions & 0 deletions naruto.el
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,61 @@
    (require 'dash)
    (require 's)
    (defconst PI 3.1415)
    (defconst a 0.05)

    (defun uzumaki (k)
    "uzumakiのx,y座標をコンスセルで返す"
    (let* ((theta (* k PI))
    (x (* a theta (cos theta)))
    (y (* a theta (sin theta))))
    (cons x y)))

    (defun naruto (str)
    (let* ((point-alist (mapcar (lambda (k)
    (let* ((p (uzumaki k))
    (x (car p))
    (y (cdr p)))
    (cons (floor (* 100 x)) (floor (* 100 y)))))
    (number-sequence 0 2 0.1)))
    (zip-list (-zip (string-to-list str) (translate point-alist))))
    (render zip-list)))

    (defun translate (point-alist)
    (let ((min-x (apply #'min (mapcar (lambda (p) (car p)) point-alist)))
    (min-y (apply #'min (mapcar (lambda (p) (cdr p)) point-alist))))
    (mapcar (lambda (p)
    (cons (+ (abs min-x) (car p)) (+ (abs min-y) (cdr p))))
    point-alist)))

    (defun get-nth (x y width)
    "座標から配列上の場所を求める"
    (+ x (* y width)))

    (defun render (zip-list)
    (let* ((max-x (1+ (apply #'max (mapcar (lambda (p) (cadr p)) zip-list))))
    (max-y (1+ (apply #'max (mapcar (lambda (p) (cddr p)) zip-list))))
    (nl (-repeat (* max-x max-y) nil)))
    (-each zip-list (lambda (z)
    (setf (nth (get-nth (cadr z)
    (cddr z)
    max-x)
    nl)
    (char-to-string (car z)))
    ))
    (switch-to-buffer "*naruto-render*")
    (erase-buffer)
    (dotimes (y max-y)
    (dotimes (x max-x)
    (let ((mass (nth (get-nth x y max-x) nl)))
    (if (null mass)
    (insert " ")
    (insert mass))
    ))
    (insert "\n"))
    ))

    ;; TODO
    ;; ２０文字までしか対応していない
    ;; 対数螺旋だと文字数少ないのでイマイチ
    ;; 半角文字にも対応させる
    (naruto "吾輩は猫である。名前はまだ無い。どこで生れ")