;;; -*- Emacs-Lisp -*-
;;; ぐにょぐにょ Ver.2.2
;;; Copyright(C) 1994, 1995, 1999, 2008 by HIROSE Yuuji [yuuji@gentei.org]
;;; Last modified Sat Apr 26 21:13:16 2008 on firestorm
;;; $Id: gnyognyo.el,v 2.3 2017/02/21 07:56:03 yuuji Exp $
;;;[なんすかこれ?]
;;;
;;; ちまたにあふれている「ふ○よふ○よ」というゲームに似ているらし
;;; いがそれはたぶん気のせい。動きは似ているもようだが、得点の増え方
;;; は全然違うし、レベルが上がると駒の種類は増えるし、ステージの幅な
;;; どいろいろカスタマイズできるので別物と考えた方がいいかもしれない。
;;;
;;; Ver.2.0 からどうもねっとわーくを介して対戦ができるらしい(わー
;;; い)。でもルールがほんもの(ってなんだ)とはずいぶん違うもやう。二
;;; 人だけでなく無限人で勝負ができる(でも勧めない)し、ほんもの(って
;;; なに)だと5〜6連鎖をするとおじゃまが降りすぎて話にならないらしい
;;; (実際やったことないのだ)のだが、これはそうでもなく、一撃では死な
;;; ないようになっているので、弱い人もしばらくは楽しめる。
;;;
;;;[ルールしらないんだけど]
;;;
;;; 上から落ちて来る双子の「太武郎」兄弟を5でぐりぐりする。2でちょ
;;; んちょんと落とし、0かスペースでドカンと落とす。で、同じ種類のも
;;; のを四つ隣り合わせにするといいらしい。あ、vi好き好きな人も安心と
;;; いううわさ。h j k l でどうぞ。
;;;
;;;[ひつようなもの]
;;; ......
;;; は、Nemacs か Mule のうごくかなり速いマシン(すまん _o_)。なん
;;; かSS10でもあぶないような気がする。マシンのスピード判定をロード時
;;; にやってるんだけど、遅いマシンだと判定自体当てにならない。正しく
;;; 判定できてると、太武郎が *だいたい* 一秒間隔で落下して行くはずな
;;; んだけど、画面書き換えにもたつくような遅いマシンだと2秒近くかか
;;; るかもしれない。そういう時は、gnyo:timer という値をいじってみよ
;;; う。これを小さくして行って一秒おきに落下するようになればOK。でも
;;; 値を100以下にしてもだめならだめだ(変な日本語)。運良く gnyo:timer
;;; をいじれば大丈夫というマシンを使うなら、gnyo:load-hook を利用し
;;; てね。
;;;
;;; ところで Mule2 以降で X Window System を使っている時は色っぽい
;;; 太武郎が出るようになっておる。しかしこれでプレイするには **めちゃ
;;; めちゃ** 速いマシンが必要らしい。筆者の486DX4(96MHz)のマシンでも
;;; ちときついので最低でもPentiumかSS20かな。
;;;
;;; ………と書いてから早5年。そろそろ21世紀を迎えようという今日この
;;; 頃、SS20 なんてオエっと来るほど遅いマシンになり下がり、10万円の
;;; パソコンがあれば楽勝で遊べる時代になったとさ。はぁ。
;;;
;;; ………と書いてから早9年。平成も成人式を迎えた今日この頃、SS10 と
;;; か SS20 なんて言葉を知っている人になんか滅多に遭遇しなくなり、こ
;;; の程度のEmacs-Lispなら携帯電話ででも動くんじゃないかと思われる時
;;; 代になったとさ。ひぃ。
;;;
;;;[さていんすとーる]
;;;
;;; 次のディレクトリを決める必要がある。
;;;
;;; ・スコアファイルを置くディレクトリ
;;; (変数 gnyo:directory)
;;; ・スコアファイル更新時のロックファイルを置くディレクトリ
;;; (変数 gnyo:lock-directory)
;;;
;;; デフォルトは、 $EMACS/lisp/gnyognyo (ただし Mule2では
;;; $EMACS/site-lisp/gnyognyo), $EMACS/lock ってことになってます。ち
;;; なみに $EMACSってのはEmacsをインストールしたディレクトリのことで、
;;; emacs -q とやって load-path C-j って打って出てくるところが、
;;; $EMACS/lisp ね。 で、複数の Emacs をインストールしてるところだと
;;; スコアファイルが何種類もできてまずいから適当なディレクトリ作って
;;; そこに置くようにした方が良いかな。どうしてもエラーが出てスコア更
;;; 新ができないって時は、適当な場所にぐにょぐにょ用のディレクトリを
;;; 掘って chmod 1777 GnyoDir, chmod a+w GnyoDir/gnyognyo.score しま
;;; しょう。
;;;
;;; んで、対戦なんてものをやってみたい、そう思う時はぐにょサーバ
;;; (なんだかえらそう)をインストールしておく必要がある。一緒について
;;; る gnyoserv.c をコンパイルしてどっかに入れといてね。で、遊ぶ時に
;;; はどっかのマシンで ./gnyoserv なんて風に起動しといてちょ。あ、悪
;;; いけど System V のことは考えてないや(とかいいつつ平気でmemsetと
;;; か使ってるし…)。
;;;
;;;[かいし]
;;;
;;; このファイルをロードした後で、M-x gnyognyo す。
;;; 対戦する時は M-x gnyo-fight して gnyoserv を走らせているホスト名
;;; を入れる。
;;;
;;;[途中でトイレなど]
;;;
;;; ESC
;;;
;;;[あ、ボスが来た]
;;;
;;; RET
;;;
;;;[うるさい]
;;;
;;; ,
;;;
;;;[失敗した! 最初から]
;;;
;;; r (対戦の時にはやんないでー!)
;;;
;;;[つまんないからやめ]
;;;
;;; 電源OFF(うそ)
;;;
;;;[スコア関係(一人遊びモードの時は大切)]
;;;
;;; 一人さみしく自宅で練習する場合には gnyo:single-user-mode を t
;;; にセットしてくれ。MS-DOSならデフォルトで t なので、何もしないで
;;; いいらしい。シングルユーザモードだと一人のスコアを何遍でも登録し
;;; て上位10人だけ残るっていうゲーセン風のスコア登録モードなのだ。そ
;;; の逆は、UN*X上のゲーム風に一人のスコアは一個だけで全員のスコアが
;;; 残るってやつ。
;;;
;;; で、間違ってU*IXで使おうなんて場合は、誰でもスコアファイルに書
;;; き込めないと困る。スコアファイルはデフォルトで、Emacs18 の場合
;;; $EMACS/lisp/gnyognyo/、Emacs19 の場合 $EMACS/site-lisp/gnyognyo/
;;; に置くようになっていて、これを誰でも書けるように chmod a+w して
;;; おかねばならない。「それって不安〜」という向きの人は次のCプログ
;;; ラムを gnyoup.c というファイルに保存して、gnyoup というコマンド
;;; を作ってくれ。あ、もちろん行頭の ; は取ってね(分かるって)。
; /* gnyoup.c
; DOS以外ではこれをコンパイルして $EMACS/etc に置く。
; スコアファイルのオーナーの setuid を立てる。*/
;
;#include <stdio.h>
;void main(argc, argv)
; int argc;
; char **argv;
;{
; char c;
; FILE *fp;
; if (NULL == (fp=fopen(argv[1], "w"))) {
; fprintf(stderr, "%s: Cannot open %s.\n", argv[0], argv[1]);
; abort();
; }
; while (EOF != (c=getchar())) fputc(c, fp);
; fclose(fp);
;}
;;; で、gnyoup を変数 exec-directory の指すところにインストールすべ
;;; し。そして、スコアファイルと gnyoup のオーナーを同一にしておいて
;;; chmod u+s gnyoup して完了。gnyognyo っていう仮ユーザを作ると一番
;;; いいのかもしれないがそこまでするほどのゲームじゃないと思う。
;;;
;;; とか言いながら、スコアファイルを壊す可能性の高いのはぐにょぐにょ
;;; 自身って気がするの。もし壊れちゃったらご一報を。
;;;
;;; あーー、そうそう、対戦型はスコアの保存はしないよ。勝ちゃーいい
;;; んだ。それで満足。あまりに良い点をとってしまったらゲーム終了後、
;;; こっそり u を押そう。
;;;[カスタマイズ]
;;;
;;; インストール先、スコアファイル、スコア更新ロックファイルのディ
;;; レクトリなどが気に入らなかったら下の変数を~/.emacsにて変えるべし。
;;;
;; カスタマイズ可能変数
;;;
(defvar gnyo:single-user-mode (eq system-type 'ms-dos)
"*スコア登録で同じユーザのスコアを複数登録するか.")
(defvar gnyo:directory
(expand-file-name (concat exec-directory "../lisp"))
"*ぐにょぐにょ関係のファイルを置くディレクトリ.")
(defvar gnyo:lock-directory
(let ((ed exec-directory) dir)
(or (and (file-directory-p (setq dir (expand-file-name "../lock" ed)))
dir)
(and (file-directory-p
(setq dir (expand-file-name "../../lock" ed )))
dir)
(and (file-directory-p (setq dir "/usr/local/mule/lisp"))
dir)
(and (file-directory-p "/tmp") "/tmp")
(and (file-directory-p "c:/tmp") "c:/tmp")))
"*スコア更新時のロックファイルを書き込むディレクトリ.
World writable でなくてはならない!!")
(defvar gnyo:score-file
(or (and (file-directory-p
(expand-file-name "../../site-lisp" exec-directory))
(expand-file-name "../../site-lisp/gnyognyo/gnyognyo.score"
exec-directory))
(expand-file-name "gnyognyo.score" gnyo:directory))
"*スコアファイル.")
(defvar gnyo:score-update-command
(expand-file-name (concat "gnyoup " gnyo:score-file) exec-directory)
"*スコアをアップデートするためのコマンド(マルチユーザOS用).")
(defvar gnyo:mute nil "*Non-nilなら音を出さない.")
(defvar gnyo:nzap 4 "*何個駒が連続したら消えるか.")
;;;[めんせき]
;;;
;;; なにがおきてもしらないよ。本当にしらないからね。
;;;
;;;[あとがき]
;;;
;;; ゲームはいかん…
;;;
;;;[あとがき Ver.2.0]
;;;
;;; だいたいみんな、「対戦はできないんだよね」とか言うんだもん。た
;;; またまソケット使ったプログラム書かなきゃいけなくなったから、その
;;; 練習ってことで対戦型も足してみたんだけどどんなもんかねえ。でも同
;;; 一マシン上でのぐにょ対戦はきついっす。くれぐれも別のマシンで戦う
;;; ように(速いマシン使ってる人の方がきっと有利、いや絶対か)。
;;;
;;;[あとがき 1999]
;;;
;;; ↑で同一マシンじゃ辛いって書いたけど、そんな時代じゃないす。持っ
;;; てるパソコンが200MHz以上だったら何も考えず猿のように遊んでくださ
;;; い。はい。
;;;
;;;[あとがき 2008]
;;;
;;; ↑で200MHzって書いたけど、そんな低い値じゃ「それって新しいFM放
;;; 送ですか?」と言われかねない時代に。画面の許す限りの好きな人数でど
;;; うぞ。
;;;
;;;[きになる得点について]
;;;
;;; さて、得点の計算方法を書いておこう。そうしないと高得点や大量じゃー
;;; まん太武郎の送り込みが狙えない。まず得点。シュパシュパと消える時
;;; の隣接数を x (つまり最低で4)、その時の何連鎖目かを c とすると、
;;; 消えている一塊の太武郎の得点は x^2 * 2^(c-1) で計算される。つま
;;; り隣接数の二乗を基本得点として、連鎖が増えるたびにそれを倍々にし
;;; て足してゆくことになる。たとえば、(4), (4 6), (5) と三連鎖で消し
;;; た時は、
;;; 4^2 * 1 + (4^2 + 6^2) * 2 + 5^2 * 4
;;; = 16 + 104 + 100 = 220
;;;
;;; となる。これから分かるように、連鎖が多いほうがはるかに有利である。
;;; 対戦時にはこの得点をベースに敵に送り込むじゃーまん太武郎の数が計
;;; 算される。簡単のため上で計算された得点を p、pのlog2をとったもの
;;; の整数部すなわち int(log2(p)) を l とおく。この時太武郎の数 t は、
;;;
;;; t = (l-3) * (1+c) + max(0, int(log2(p-2^(l-1)))-3) - 1
;;;
;;; となる。基本一連鎖(4つだけ消える)で1点になるように調整しているの
;;; で複雑に見えるが、ようは
;;;
;;; 得点のlog2 * 連鎖数 + log2をとった余りのさらにlog2の値
;;;
;;; という計算をしている。logで小数部まで計算できればもうちょっと簡
;;; 単な式になるのだが、それだと Nemacs/Mule1 でできなくなっちゃうの
;;; であきらめ。ま、気になるのは、連鎖をした時にどれだけ敵にじゃーま
;;; んが送られるかってことだろうから表をかいときまひょ。
;;;
;;; ＼連鎖数
;;; 接続数 ＼ 一連鎖 二連鎖 三連鎖 四連鎖 五連鎖 六連鎖
;;; 4 1 6 13 22 33 46
;;; 5 1 8 17 27 40 54
;;; 6 3 10 18 30 44 59
;;; 7 4 12 22 33 46 62
;;; 8 5 14 23 34 47 62
;;; ずっと4最後5 - 8 16 26 39 53
;;; ずっと4最後6 - 9 18 28 40 54
;;;
;;; こんな表まで読んでくれたなんて嬉しいっす。嬉しいのでメイルくださ
;;; い。yuuji@gentei.org で届きます。
;;;
;;;いじょ.
(or (boundp 'MULE) (boundp 'NEMACS) (featurep 'mule)
(error "Sorry, this program requires Japanese language environment."))
;;;
;; 作業用変数
;;;
(defvar gnyo:width 6 "ステージの幅.")
(defvar gnyo:default-width gnyo:width "デフォルトステージ幅.")
(defvar gnyo:height 15 "ステージの高さ.")
(defvar gnyo:default-height gnyo:height "デフォルトステージ高.")
(defvar gnyo:stlength (* gnyo:width gnyo:height) "ステージ配列の長さ.")
(defvar gnyo:stage (make-vector gnyo:stlength nil) "ステージ配列.")
(defvar gnyo:stflags (make-vector gnyo:stlength nil)
"駒の同種隣接チェックが終わったか、と隣接状態を格納するフラグ.")
(defvar gnyo:work-array (make-vector gnyo:stlength nil)
"隣接している駒をgnyo:stageの添字で格納(consセルを乱発したくないので配列).")
(defvar gnyo:blocks nil "現在数えてる同種隣接ブロックの隣接数.")
(defvar gnyo:left-edge-x nil "左の壁のX座標.")
(defvar gnyo:right-edge-x nil "右の壁のX座標.")
(defvar gnyo:bottom-edge-y nil "床のY座標.")
(defvar gnyo:save-config nil "ゲームを始める前の画面.")
(defvar gnyo:buffer "*** [[[ぐにょぐにょ]]] ***" "ぐにょぐにょバッファ.")
(defvar gnyo:wall "■" "壁")
(defvar gnyo:wall-width 2 "壁幅.NemacsとMuleで自動判定しなきゃ.")
(defvar gnyo:char-width 2 "駒や壁の文字幅.")
(defvar gnyo:score nil "得点.")
(defvar gnyo:level nil "レベル.")
(defvar gnyo:time-over nil "ゲームオーバー時の時間.")
(defvar gnyo:t1 "○" "駒1")
(defvar gnyo:t2 "●" "駒2")
(defvar gnyo:t3 "◎" "駒3")
(defvar gnyo:t4 "★" "駒4")
(defvar gnyo:t5 "☆" "駒5")
(defvar gnyo:t6 "◆" "駒6")
(defvar gnyo:t7 "◇" "駒7")
(defvar gnyo:german "邪" "じゃーまん駒")
(defvar gnyo:5german "多" "5じゃーまん")
(defvar gnyo:10german "雨" "10じゃーまん")
(defvar gnyo:30german "爆" "30じゃーまん")
(defvar gnyo:tablets
(vector gnyo:t1 gnyo:t2 gnyo:t3 gnyo:t4 gnyo:t5 gnyo:t6 gnyo:t7 gnyo:german)
"駒データ")
(defconst gnyo:colorful
(and (fboundp 'make-face) (memq window-system '(x w32)) (x-display-color-p)))
(if gnyo:colorful
(or (member 'gnyo:cyan (face-list))
(progn
(mapcar 'make-face
'(gnyo:cyan gnyo:green gnyo:yellow gnyo:magenta
gnyo:white gnyo:LemonChiffon1 gnyo:red gnyo:next
gnyo:black gnyo:germanc gnyo:30germanc))
(set-face-foreground 'gnyo:cyan "cyan")
(set-face-foreground 'gnyo:green "green")
(set-face-foreground 'gnyo:yellow "yellow")
(set-face-foreground 'gnyo:magenta "magenta")
(set-face-foreground 'gnyo:white "white")
(set-face-foreground 'gnyo:germanc "darkorange")
(set-face-foreground 'gnyo:30germanc "firebrick1")
(set-face-foreground 'gnyo:red "red")
(set-face-foreground 'gnyo:next "gold")
(set-face-background 'gnyo:next "dark green"))))
(defvar gnyo:color-alist
(list (cons gnyo:t1 'gnyo:cyan)
(cons gnyo:t2 'gnyo:green)
(cons gnyo:t3 'gnyo:yellow)
(cons gnyo:t4 'gnyo:magenta)
(cons gnyo:t5 'gnyo:white)
(cons gnyo:t6 'gnyo:LemonChiffon1)
(cons gnyo:t7 'gnyo:red)
(cons gnyo:german 'gnyo:germanc)
(cons gnyo:5german 'gnyo:yellow)
(cons gnyo:10german 'gnyo:cyan)
(cons gnyo:30german 'gnyo:30germanc)
(cons gnyo:wall 'gnyo:white)))
(defvar gnyo:empty " " "駒の幅と同じ空白(駒を消す時に使う).")
(defvar gnyo:max-n-tablets (length gnyo:tablets))
(defvar gnyo:pausing-stage (make-vector 1 gnyo:wall) "ポーズ中.")
(defvar gnyo:n-tablets 4 "現在の駒の種類の数.")
(defvar gnyo:tablet-x nil "現在の駒X座標.")
(defvar gnyo:tablet-y nil "現在の駒Y座標.")
(defvar gnyo:twin-x nil "現在の相棒駒X座標.")
(defvar gnyo:twin-y nil "現在の相棒駒Y座標.")
(defvar gnyo:tablet-direction nil "駒の向き.")
(defvar gnyo:current-tablet (make-vector 2 nil) "現在の駒タイプ.")
(defvar gnyo:next-tablet (make-vector 2 nil) "次の駒タイプ.")
(defvar gnyo:timer nil "タイマー用カウンタ(デフォルト).")
(defvar gnyo:current-timer nil "レベルに応じたタイマー.")
(defvar gnyo:level-status-list
'((1 4 10) (2 4 9) (3 4 8) (4 5 8) (5 5 7)
(6 5 6) (7 6 6) (8 6 6) (9 6 5) (10 6 4)
(11 6 3) (12 7 3) (13 7 2) (14 7 1)
)
"(レベル 駒数 10を最大としたウェイト値) というリスト.")
(defvar gnyo:max-level (length gnyo:level-status-list) "最大レベル.")
(defvar gnyo:level-update-count 8 "何回置きにlevelを増加させるか.")
(defvar gnyo:score-lock-file
(expand-file-name "gnyognyo.lock" gnyo:lock-directory)
"スコア更新時のロックファイル.")
(defvar gnyo:key-map nil "ぐにょぐにょバッファのキーマップ.")
(if gnyo:key-map nil
(setq gnyo:key-map (make-keymap))
(suppress-keymap gnyo:key-map)
(define-key gnyo:key-map "q" 'gnyo-quit)
(define-key gnyo:key-map "h" 'describe-mode)
(define-key gnyo:key-map "?" 'describe-mode)
(define-key gnyo:key-map "r" 'gnyo-replay)
(define-key gnyo:key-map "s" 'gnyo-score)
(define-key gnyo:key-map "u" 'gnyo-update-score)
(define-key gnyo:key-map "c" 'gnyo-config))
(defvar gnyo:score-key-map nil "スコアファイル閲覧用キーマップ.")
(defvar gnyo:boss-key-map nil "ボスが来た時にセットするキーマップ.")
(if gnyo:score-key-map nil
(setq gnyo:score-key-map (make-keymap)
gnyo:boss-key-map (make-keymap))
(let ((key ? ))
(while (<= key ?z)
;;(aset gnyo:score-key-map key 'gnyo*kill-buffer)
;;(aset gnyo:boss-key-map key 'exit-recursive-edit)
(define-key gnyo:score-key-map (char-to-string key) 'gnyo*kill-buffer)
(define-key gnyo:boss-key-map (char-to-string key) 'exit-recursive-edit)
(setq key (1+ key))))
(define-key gnyo:score-key-map "\r"
(function (lambda (n) (interactive "P") (scroll-up n))))
(define-key gnyo:score-key-map "\e" 'gnyo*kill-buffer))
;;; -------------------- 対戦ぐにょ関係の変数 --------------------
(defvar gnyo:stand-alone t "対戦型か.")
(setq gnyo:stand-alone t) ;普段は必ずtにしておくのでーす
(defvar gnyo:server-buffer "*gnyoserver*")
(defvar gnyo:port 9969 "gnyoservのPORT番号")
(defvar gnyo:server-buffer-map nil)
(defvar gnyo:server-process nil)
(if gnyo:server-buffer-map nil
(setq gnyo:server-buffer-map (make-sparse-keymap))
(define-key gnyo:server-buffer-map "\C-m" 'gnyo*send-string))
(defvar gnyo:germans 0 "次に落すべきじゃーまん太武郎の個数.")
(defvar gnyo:german-unprocessed-p nil "未表示のじゃーまんがあるか?")
(defvar gnyo:clistates-unprocessed-p nil "未表示のクライアント状態あるか?")
(defvar gnyo:free-cells 0 "現在の空きセルの数.")
(defvar gnyo:clients 0 "現在参加しているとユーザ数.")
(defvar gnyo:clinames (make-vector 10 nil) "各ユーザの名前 (10人分で十分)")
(defvar gnyo:clistates (make-vector 10 nil) "各ユーザの状態 (10人分で十分)")
(defvar gnyo:my-id "" "サーバからもらったID")
(defvar gnyo:user-name (user-real-login-name) "プレイヤーの名前")
;;; --------------------------------------------------------------
(defmacro gnyo*location-to-index (x y)
(list '+ (list '* (list 'symbol-value (list 'quote 'gnyo:width)) y) x))
(fset 'gnyo*str2int
(if (fboundp 'string-to-number)
(function(lambda (str &optional base)
(ceiling (string-to-number str base))))
'string-to-int))
(defun gnyo*abs (x)
(if (< x 0) (- x) x))
(defun gnyo*display-width (s)
(cond
((boundp 'NEMACS) (length s))
((featurep 'mule) (string-width s))))
(defun gnyo*locate (x y)
(let ((cury (+ (count-lines (window-start) (point)) (if (bolp) 1 0))))
(next-line (- y cury))
(move-to-column x)))
(defun gnyo*locate-stage (x y)
(gnyo*locate (+ gnyo:left-edge-x gnyo:char-width
(* x gnyo:char-width))
(+ (- gnyo:bottom-edge-y gnyo:height) y)))
(defun gnyo*line (x1 y1 x2 y2 element)
(let ((width (gnyo*display-width element)) forward-func repeat)
(cond
((= x1 x2)
(setq forward-func (if (< y1 y2) 'next-line 'previous-line)
repeat (1+ (gnyo*abs (- y2 y1)))))
((= y1 y2)
(setq forward-func (if (< x1 x2) 'forward-char 'backward-char)
repeat (1+ (/ (gnyo*abs (- x2 x1)) width))))
(t (error "gnyo*line can't draw a diagonal line.")))
(gnyo*locate x1 y1)
(while (> repeat 0)
(delete-char width)
(save-excursion (insert element))
(funcall forward-func 1)
(setq repeat (1- repeat)))))
(defun gnyo*ovwt-insert (string)
(let ((overwrite-mode t)
(i 0) (len (length string)) (last-command-char 0))
(while (< i len)
(set (if (boundp 'last-command-event)
'last-command-event
'last-command-char)
(elt string i))
(self-insert-command 1)
(setq i (1+ i)))))
(defun gnyo*display-score (pts)
"スコアの表示."
(let ((y (- gnyo:bottom-edge-y 11)))
(cond
(pts
(gnyo*locate 7 y) (gnyo*ovwt-insert (format "%5d" gnyo:score)))
(t
(gnyo*locate 0 y) (gnyo*ovwt-insert "Score: ")))))
(defun gnyo*display-level (lev)
(let ((y (- gnyo:bottom-edge-y 12)))
(cond
(lev
(gnyo*locate 7 y) (gnyo*ovwt-insert (format "%5d" lev)))
(t
(gnyo*locate 0 y) (gnyo*ovwt-insert "Level: ")))))
(defun gnyo*setup-screen ()
"ぐにょぐにょ画面の初期化."
(erase-buffer)
(if (or (< (window-width) (+ 2 gnyo:width))
(< (window-height) (+ 2 gnyo:height)))
(error "もうちょっと画面を広くしよう."))
(setq gnyo:left-edge-x
(/ (- (window-width) (* gnyo:width gnyo:char-width) gnyo:wall-width) 2)
gnyo:right-edge-x
(+ gnyo:left-edge-x (* gnyo:width gnyo:char-width) gnyo:wall-width)
gnyo:bottom-edge-y (- (window-height) 3))
(let ((y 1) (w (window-height)))
(while (< y w)
(insert-char ? (1- (window-width))) (newline) (setq y (1+ y))))
(goto-char (point-min))
(gnyo*line gnyo:left-edge-x (- gnyo:bottom-edge-y gnyo:height)
gnyo:left-edge-x gnyo:bottom-edge-y gnyo:wall)
(gnyo*line gnyo:left-edge-x gnyo:bottom-edge-y
gnyo:right-edge-x gnyo:bottom-edge-y gnyo:wall)
(gnyo*line gnyo:right-edge-x (- gnyo:bottom-edge-y gnyo:height)
gnyo:right-edge-x gnyo:bottom-edge-y gnyo:wall)
(gnyo*display-score nil)
(gnyo*display-score gnyo:score)
(gnyo*display-level nil)
(gnyo*display-level gnyo:level)
(gnyo*display-next-tablet nil)
(gnyo*display-next-tablet gnyo:next-tablet)
(if gnyo:stand-alone nil
(gnyo*display-german nil)
(gnyo*display-german gnyo:germans)
(gnyo*display-clients nil)
(gnyo*display-clients gnyo:clistates)))
(defun gnyo*final-screen ()
"ゲームオーバー時にキーアサインを表示."
(save-excursion
(goto-line (1+ gnyo:bottom-edge-y))
(insert
"[q]=quit [r]=replay [s]=show score [u]=update score [c]=change config.\n")))
(defun gnyo*init-value ()
(setq gnyo:score 0 gnyo:level 1 gnyo:current-timer gnyo:timer
gnyo:n-tablets 4)
(aset gnyo:next-tablet 0 (gnyo*random gnyo:n-tablets))
(aset gnyo:next-tablet 1 (gnyo*random gnyo:n-tablets))
(let ((i 0) (len (length gnyo:stage)))
(while (< i len) (aset gnyo:stage i nil) (setq i (1+ i)))))
(defun gnyo*check-performance ()
(let ((curtime (current-time-string)) time (i 0)
(mes "Checking your machine/system's performance."))
(garbage-collect) ;計測中におきると困るので
(message "%s." mes)
(while (string= curtime (current-time-string)))
(setq curtime (current-time-string))
(message "○●")
(message " ")
(message "%s.." mes)
(while (string= curtime (current-time-string))
;;(message "%s.." mes)
(setq i (1+ i)))
(message "%s...Done(count:%d)" mes i)
i))
(defun gnyo*wait (timer)
(while (> timer 0) (current-time-string) (setq timer (1- timer))))
(defun gnyo*position-range-p (x y)
(and (>= x 0) (< x gnyo:width)
(>= y 0) (< y gnyo:height)))
(defun gnyo*set-pos-of-twin (&optional x y dir)
(setq x (or x gnyo:tablet-x)
y (or y gnyo:tablet-y)
dir (or dir gnyo:tablet-direction))
(cond ((= dir 0) ;below
(setq gnyo:twin-x x gnyo:twin-y (1+ y)))
((= dir 1) ;left
(setq gnyo:twin-x (1- x) gnyo:twin-y y))
((= dir 2) ;above
(setq gnyo:twin-x x gnyo:twin-y (1- y)))
((= dir 3) ;right
(setq gnyo:twin-x (1+ x) gnyo:twin-y y))))
(defun gnyo*tablet-exists-p (x y &optional dir)
"座標(X,Y)に駒が既に存在するか? DIRがnon-nilなら双子駒部分も調べる."
(if (null dir)
(or (< x 0)
(>= x gnyo:width)
(aref gnyo:stage (gnyo*location-to-index x y)))
(gnyo*set-pos-of-twin x y dir)
(or
(< x 0) (>= x gnyo:width)
(aref gnyo:stage (gnyo*location-to-index x y))
(not (gnyo*position-range-p gnyo:twin-x gnyo:twin-y))
(aref gnyo:stage (gnyo*location-to-index gnyo:twin-x gnyo:twin-y)))))
(defun gnyo*random (upper)
(% (gnyo*abs (random)) upper))
(defun gnyo:set-face-region (start end face)
"Set region to face"
(let ((ovl (make-overlay start end)))
(overlay-put ovl 'face face)))
(defun gnyo*repl-str (str)
"上書き"
(let*((len (gnyo*display-width str))
(x (current-column)) (x2 (+ x len)) start face)
(if (and gnyo:colorful (overlays-at (point)))
(mapcar '(lambda (ovl)
(if (= (point) (overlay-start ovl))
(delete-overlay ovl)))
(overlays-at (point))))
(while (< (current-column) x2)
(forward-char 1)
(if (eolp) (error "String out of range."));;
)
(while (> (current-column) x) (backward-delete-char 1))
(setq start (point))
(insert-before-markers str)
(if (and gnyo:colorful (setq face (cdr (assoc str gnyo:color-alist))))
(gnyo:set-face-region start (point) face))))
(defun gnyo*erase-square (x y &optional twin-dir)
"座標POSの(リスト)駒部分を消去."
(gnyo*locate-stage x y)
(gnyo*repl-str gnyo:empty)
(if twin-dir
(progn
(gnyo*set-pos-of-twin x y)
(gnyo*erase-square gnyo:twin-x gnyo:twin-y))))
(defun gnyo*display-tablet (type &optional x y)
"TYPEで示される駒を現在の座標に表示. X, Yを指定するとそこに表示."
(setq x (or x gnyo:tablet-x) y (or y gnyo:tablet-y))
(gnyo*locate-stage x y)
(gnyo*repl-str (aref gnyo:tablets (elt type 0)))
(gnyo*set-pos-of-twin x y)
(gnyo*locate-stage gnyo:twin-x gnyo:twin-y)
(gnyo*repl-str (aref gnyo:tablets (elt type 1)))
(sit-for 0))
(defun gnyo*display-next-tablet (type)
"次の駒を表示"
(let (p (x (- gnyo:left-edge-x 8)) (y (- gnyo:bottom-edge-y gnyo:height)))
(cond
((null type)
(gnyo*locate x y)
(setq p (point))
(gnyo*ovwt-insert "-Next-")
(if gnyo:colorful (gnyo:set-face-region p (point) 'gnyo:next)))
(t
(setq x (+ x gnyo:char-width))
(gnyo*locate x (1+ y))
(gnyo*repl-str (aref gnyo:tablets (elt type 0)))
(gnyo*locate x (+ y 2))
(gnyo*repl-str (aref gnyo:tablets (elt type 1)))))))
(defun gnyo*generate-tablet ()
"初期状態の駒を生成."
(setq gnyo:tablet-x (1- (/ gnyo:width 2))
gnyo:tablet-y 1
gnyo:tablet-direction 0)
(if (gnyo*tablet-exists-p gnyo:tablet-x gnyo:tablet-y gnyo:tablet-direction)
nil
(aset gnyo:current-tablet 0 (aref gnyo:next-tablet 0))
(aset gnyo:current-tablet 1 (aref gnyo:next-tablet 1))
(aset gnyo:next-tablet 0 (gnyo*random gnyo:n-tablets))
(aset gnyo:next-tablet 1 (gnyo*random gnyo:n-tablets))
(gnyo*display-next-tablet gnyo:next-tablet)
;;(gnyo*display-tablet gnyo:current-tablet)
t))
(defun gnyo*boss ()
"ボスが来た!"
(let ((gnyo-buffer (current-buffer))
(gnyo:stage gnyo:pausing-stage)
(er-key (key-description
(car (where-is-internal 'exit-recursive-edit)))))
(save-window-excursion
(save-excursion
(gnyo*redraw-stage)
(goto-char (point-min))
(insert "へへーん見えないよ〜ん\n")
(insert (format "(必ず %s で戻るべし!)\n" er-key))
(kill-line 2)
(use-local-map gnyo:boss-key-map)
(set-window-configuration gnyo:save-config)
(if (equal (current-buffer) gnyo-buffer)
(switch-to-buffer (other-buffer)))
(bury-buffer gnyo-buffer)
(message "やべー、ボスだ! 戻る時は %s (**必ず戻ること**)." er-key)
(unwind-protect
(recursive-edit)
(set-buffer gnyo-buffer)
(use-local-map gnyo:key-map)))))
(gnyo*setup-screen)
(gnyo*redraw-stage))
(defun gnyo*spinable-p ()
"現在の駒の位置で回転が可能か?"
(cond
((= gnyo:tablet-direction 0) ;下→左
(or (and (> gnyo:tablet-x 0)
(null (gnyo*tablet-exists-p (1- gnyo:tablet-x) gnyo:tablet-y)))
(and (null (gnyo*tablet-exists-p (1+ gnyo:tablet-x) gnyo:tablet-y))
(progn
(gnyo*erase-square
gnyo:tablet-x gnyo:tablet-y gnyo:tablet-direction)
(setq gnyo:tablet-x (1+ gnyo:tablet-x))
(gnyo*display-tablet gnyo:current-tablet)
t))))
((= gnyo:tablet-direction 1) ;左→上(絶対tだと思うけど)
(null (gnyo*tablet-exists-p gnyo:tablet-x (1- gnyo:tablet-y))))
((= gnyo:tablet-direction 2) ;上→右
(or (and (< gnyo:tablet-x (1- gnyo:width))
(null (gnyo*tablet-exists-p (1+ gnyo:tablet-x) gnyo:tablet-y)))
(and (null (gnyo*tablet-exists-p (1- gnyo:tablet-x) gnyo:tablet-y))
(progn
(gnyo*erase-square
gnyo:tablet-x gnyo:tablet-y gnyo:tablet-direction)
(setq gnyo:tablet-x (1- gnyo:tablet-x))
(gnyo*display-tablet gnyo:current-tablet)
t))))
((= gnyo:tablet-direction 3) ;右→下
(and (< gnyo:tablet-y (1- gnyo:height))
(null (gnyo*tablet-exists-p gnyo:tablet-x (1+ gnyo:tablet-y)))))))
(defun gnyo*key-action ()
"キー入力処理."
(let ((key (char-to-string (read-char))) twin)
(cond
((string-match key "5k") ;"5" 回転
(if (gnyo*spinable-p)
(progn
(gnyo*set-pos-of-twin)
(gnyo*erase-square gnyo:twin-x gnyo:twin-y)
(setq gnyo:tablet-direction (% (1+ gnyo:tablet-direction) 4))
(gnyo*display-tablet gnyo:current-tablet)
(setq timer (- timer (/ gnyo:current-timer 10))) ;??
(sit-for 0))))
((string-match key "4h") ;"4" 左移動
(if (gnyo*tablet-exists-p
(1- gnyo:tablet-x) gnyo:tablet-y gnyo:tablet-direction) nil
(gnyo*erase-square gnyo:tablet-x gnyo:tablet-y gnyo:tablet-direction)
(setq gnyo:tablet-x (1- gnyo:tablet-x))
(gnyo*display-tablet gnyo:current-tablet)
(sit-for 0)))
((string-match key "6l") ;"6" 右移動
(if (gnyo*tablet-exists-p
(1+ gnyo:tablet-x) gnyo:tablet-y gnyo:tablet-direction) nil
(gnyo*erase-square gnyo:tablet-x gnyo:tablet-y gnyo:tablet-direction)
(setq gnyo:tablet-x (1+ gnyo:tablet-x))
(gnyo*display-tablet gnyo:current-tablet)
(sit-for 0)))
((string-match key "2j") ;"2" 一段落とす
(setq gnyo:score (1+ gnyo:score))
(gnyo*display-score gnyo:score)
(setq timer 0)) ;gnyo*spinの中のtimer
((string-match key "0 ") ;"0" 落とす
(throw 'land t))
((string-match key ",") ;"," 音のON/OFF
(setq gnyo:mute (not gnyo:mute))
(message "Sound %s" (if gnyo:mute "OFF" "ON")))
((string-match key "q")
(throw 'over nil))
((string-match key "R") ;"R" 最初からやり直し
(throw 'over 'replay))
((string-match key "\ep") ;ESC ポーズ
(let ((config (current-window-configuration)))
(switch-to-buffer (get-buffer-create "*scratch*"))
(momentary-string-display
(concat "===============================\n"
"ぐにょぐにょお休み中 (-.-)Zzz..\n"
"===============================\n")
(save-excursion (forward-line 1) (beginning-of-line) (point)) ? )
(set-window-configuration config)))
((string-match key "\C-mb") ;RET ボスが来た!!
(gnyo*boss))
(t (message "そんなキーないよ")))))
(defun gnyo*spin ()
"駒の回転処理."
(let ((timer gnyo:current-timer))
(while (> timer 0)
(if gnyo:stand-alone nil
(if gnyo:german-unprocessed-p (gnyo*display-german gnyo:germans))
(if gnyo:clistates-unprocessed-p (gnyo*display-clients gnyo:clistates))
(accept-process-output)
(if gnyo:server-output-string (gnyo*parse-output)))
(current-time-string)
(if (input-pending-p)
(progn
(gnyo*key-action)
(beginning-of-line)
(sit-for 0)))
(setq timer (1- timer)))))
(defun gnyo*free-fall ()
"着地した駒を分離して一番下まで落とす."
(gnyo*set-pos-of-twin)
(let*((x gnyo:tablet-x) (y gnyo:tablet-y)
(tw-x gnyo:twin-x) (tw-y gnyo:twin-y)
x1 y1 x2 y2 tablet1 tablet2)
;;まず分離させないで落ちるところまで落とす.
(while (not (gnyo*land-p x y))
(gnyo*erase-square x y gnyo:tablet-direction)
(setq y (1+ y) tw-y (1+ tw-y) gnyo:score (1+ gnyo:score))
(gnyo*display-tablet gnyo:current-tablet x y)
(or gnyo:mute (ding))
(if (> gnyo:timer 99)
(gnyo*wait (/ gnyo:timer 100)))
(sit-for 0))
;;分離後落下
(if (or (= gnyo:tablet-direction 0) (= gnyo:tablet-direction 2))
;;上下方向ならそこで止まる
(setq x1 x y1 y x2 tw-x y2 tw-y
tablet1 (aref gnyo:tablets (elt gnyo:current-tablet 0))
tablet2 (aref gnyo:tablets (elt gnyo:current-tablet 1)))
(cond
((or (>= y (1- gnyo:height)) ;自分が先に着地
(gnyo*tablet-exists-p x (1+ y)))
(setq x1 x y1 y x2 tw-x y2 tw-y
tablet1 (aref gnyo:tablets (elt gnyo:current-tablet 0))
tablet2 (aref gnyo:tablets (elt gnyo:current-tablet 1))))
(t ;合方が先に着地
(setq x1 tw-x y1 tw-y x2 x y2 y
tablet2 (aref gnyo:tablets (elt gnyo:current-tablet 0))
tablet1 (aref gnyo:tablets (elt gnyo:current-tablet 1)))))
(while (and (< y2 (1- gnyo:height))
(not (gnyo*tablet-exists-p x2 (1+ y2))))
(gnyo*erase-square x2 y2)
(setq y2 (1+ y2))
(gnyo*locate-stage x2 y2)
(gnyo*repl-str tablet2)
(or gnyo:mute (ding))
(gnyo*wait (/ gnyo:timer 100))
(sit-for 0)))
;;ステージに埋める
(aset gnyo:stage (gnyo*location-to-index x1 y1) tablet1)
(aset gnyo:stage (gnyo*location-to-index x2 y2) tablet2)))
(defun gnyo*no-homogeneous (x y index kind)
"座標(X,Y) 添字INDEX の KIND という種類の駒の回りの同種の駒の数を返す.
添字INDEXはかならず(X,Y)のものでなくてはならない."
(aset gnyo:work-array gnyo:blocks index)
(aset gnyo:work-array (setq gnyo:blocks (1+ gnyo:blocks)) nil)
(aset gnyo:stflags index t)
(+
1
(if (and (> x 0) ; 左隣
(null (aref gnyo:stflags (1- index)))
(equal kind (aref gnyo:stage (1- index))))
(gnyo*no-homogeneous (1- x) y (1- index) kind)
0)
(if (and (< x (1- gnyo:width)) ; 右隣
(null (aref gnyo:stflags (1+ index)))
(equal kind (aref gnyo:stage (1+ index))))
(gnyo*no-homogeneous (1+ x) y (1+ index) kind)
0)
(if (and (> y 0) ; 上隣
(null (aref gnyo:stflags (- index gnyo:width)))
(equal kind (aref gnyo:stage (- index gnyo:width))))
(gnyo*no-homogeneous x (1- y) (- index gnyo:width) kind)
0)
(if (and (< y (1- gnyo:height)) ; 下隣
(null (aref gnyo:stflags (+ index gnyo:width)))
(equal kind (aref gnyo:stage (+ index gnyo:width))))
(gnyo*no-homogeneous x (1+ y) (+ index gnyo:width) kind)
0)))
;;; -------------------- 対戦型用の関数群 --------------------
(defun gnyo*open-gnyoserver (host &optional port)
(interactive "sGnyoserver's host: ")
(let ((buffer (get-buffer-create gnyo:server-buffer)))
(setq gnyo:germans 0)
(or (and gnyo:server-process
(memq (process-status gnyo:server-process) '(open run)))
(setq gnyo:server-process
(open-network-stream
"*gnyoserv*" buffer host (or port gnyo:port))))
(set-buffer buffer)
(buffer-disable-undo)
(erase-buffer)
(while (not (memq (process-status gnyo:server-process) '(open run)))
(message "Waiting for server to accept...")
(sit-for 1))
(accept-process-output)
(setq gnyo:server-output-queue nil)
(set-process-filter gnyo:server-process 'gnyo*server-filter)
(process-send-string gnyo:server-process "?\n");
(process-send-string
gnyo:server-process
(format "n%s@%s"
gnyo:user-name
(substring (system-name) 0 (string-match "\\." (system-name)))))
(message "")
(use-local-map gnyo:server-buffer-map)))
(defun gnyo*close-gnyoserver ()
(and gnyo:server-process
(memq (process-status gnyo:server-process) '(open run))
(progn
(process-send-string gnyo:server-process "q\n")
(message "Gnyoserver was closed.")
(sleep-for 1)
(or (memq (process-status gnyo:server-process) '(open run))
(delete-process gnyo:server-process)))))
(defvar gnyo:server-output-string nil)
(defun gnyo*server-filter (proc string)
"ぐにょさーばからの出力を受け取るためのフィルタ関数.
ループ中に処理したりすると重くなるので、ここでは何もせず変数
gnyo:server-output-string に到着した文字列を入れるだけ。"
;;(message "Got %s" string)(sit-for 1)
(save-excursion (set-buffer gnyo:server-buffer) (insert string))
(setq gnyo:server-output-string
(concat gnyo:server-output-string string)))
(defun gnyo*server-filter2 (proc string)
"負けたあとのフィルタ関数."
(setq gnyo:server-output-string
(concat gnyo:server-output-string string))
(gnyo*parse-output)
(save-excursion
(set-buffer gnyo:buffer)
(gnyo*display-clients gnyo:clistates)))
(defun gnyo*parse-output ()
"gnyo:server-filterで受け取った出力を実際に処理する."
;;(setq gnyo:server-output-string (nreverse gnyo:server-output-string))
(let (str (case-fold-search-nil))
(while gnyo:server-output-string
(setq str gnyo:server-output-string)
;;(save-excursion (set-buffer gnyo:server-buffer) (insert str))
(cond
((string-match "^Lost=\\(.*\\)$" str)
(message "%s がまけたー"
(substring str (match-beginning 1) (match-end 1)))
(sit-for 2))
((string-match "^m[0-9]+r=\\([0-9]+\\)" str)
(setq gnyo:germans
(+ gnyo:germans
(gnyo*str2int (substring str (match-beginning 1))))
gnyo:german-unprocessed-p t))
((string-match "^m\\([0-9]+\\)p=\\([0-9]+\\)" str)
(aset gnyo:clistates
(gnyo*str2int (substring str 1))
(gnyo*str2int
(substring str (match-beginning 2) (match-end 2))))
(setq gnyo:clistates-unprocessed-p t))
((string-match "^You won" str)
(throw 'over 'win))
((string-match "^AHO" str)
(message "まだ他の人達ゲーム続いてるってさ.") (sleep-for 3))
((string-match "^Your id is \\([0-9]+\\)" str)
(setq gnyo:my-id
(gnyo*str2int
(substring str (match-beginning 1) (match-end 1))))
(message "My id is %s." gnyo:my-id))
((string-match "^Client\\([0-9]+\\)=\\([^ ]+\\) " str)
(aset gnyo:clinames
(gnyo*str2int (substring str (match-beginning 1)))
(substring str (match-beginning 2) (match-end 2))))
((string-match "^Go! " str)
(setq gnyo:clients (gnyo*str2int (substring str 3)))
(if (boundp 'ready) (setq ready t)))
((string= "" str) (setq gnyo:server-output-string nil))
)
(setq gnyo:server-output-string
(if (string-match "[\n\r]" str)
(substring str (1+ (string-match "[\n\r]" str)))
nil)))))
(defun gnyo*send-german (pts)
"自分の得点PTSを gnyoserv に送る."
(message "Sent %d germans" pts)
(process-send-string gnyo:server-process (format "br=%d" pts)))
(defun gnyo*declare-lose ()
;;(process-send-string gnyo:server-process "blose!\nbp=100\n")
(process-send-string gnyo:server-process "bp=100\nblose!"))
(defun gnyo*display-german (germans)
"じゃーまん太武郎の個数表示.
gnyoservから得点をもらって来て脇に表示."
(if gnyo:server-output-string (gnyo*parse-output))
(let ((y (- gnyo:bottom-edge-y 10)) (g gnyo:germans))
(cond
(germans
(gnyo*locate 8 y)
(if (> g 90) (setq g 90))
(while (> g 29) ;30=爆じゃーまん
(gnyo*repl-str "爆") (setq g (- g 30)))
(while (> g 9) ;10=雨じゃーまん
(gnyo*repl-str "雨") (setq g (- g 10)))
(while (> g 4) ;5=多じゃーまん
(gnyo*repl-str "多") (setq g (- g 5)))
(while (> g 0) ;1=邪じゃーまん
(gnyo*repl-str "邪") (setq g (- g 1)))
(setq gnyo:german-unprocessed-p nil))
(t
(gnyo*locate 0 y) (gnyo*repl-str "German: ")))
(sit-for 0)))
(defun gnyo*display-clients (states)
(let ((i 0) s)
(gnyo*locate 0 (- gnyo:bottom-edge-y 9))
(cond
(states
(while (< i gnyo:clients)
(if (and (/= i gnyo:my-id) (setq s (aref states i)))
(progn
(move-to-column 23)
(gnyo*ovwt-insert
(cond
((< s 10) "(^_^)")
((< s 20) "(^.^)")
((< s 30) "(^x^)")
((< s 50) "(--;)")
((< s 70) "(;_;)")
(t "(T_T)")))
(forward-line 1)))
(setq i (1+ i)))
(setq gnyo:clistates-unprocessed-p nil))
(t
(while (< i gnyo:clients)
(if (/= i gnyo:my-id)
(progn
(gnyo*ovwt-insert (aref gnyo:clinames i))
(forward-line 1)))
(setq i (1+ i)))))
(forward-line 1)
(sit-for 0)))
(defun gnyo*send-string ()
"デバッグ用. *gnyoserver* バッファで入力した文字をサーバに送る."
(interactive)
(if (and (eq (process-status gnyo:server-process) 'open)
(>= (point) (process-mark gnyo:server-process)))
(let ((b (process-mark gnyo:server-process))
(e (save-excursion (end-of-line) (point))))
(goto-char b)
(skip-chars-forward " \t" e)
(setq b (point))
(process-send-string
gnyo:server-process (concat (buffer-substring b e) "\n"))
(goto-char e)
(insert "\n")
(set-marker (process-mark gnyo:server-process) (point)))
(ding)))
(defvar gnyo:fall-german-base-vector (make-vector gnyo:width nil))
(defvar gnyo:fall-german-base-vector-n 0)
(defun gnyo*fall-german-get-base ()
"盤の各列の空いている段を配列 gnyo:fall-german-base-vector に入れる.
空いている段のある列の数を変数 gnyo:fall-german-base-vector-n に入れる."
(setq gnyo:fall-german-base-vector-n 0 gnyo:free-cells 0)
(let ((x 0) y (cols 0))
(while (< x gnyo:width)
(setq y (1- gnyo:height))
(if (catch 'found
(while (>= y 0)
(or (gnyo*tablet-exists-p x y)
(progn
(setq gnyo:free-cells (+ gnyo:free-cells y 1))
(throw 'found t)))
(setq y (1- y))))
(progn
(setq gnyo:fall-german-base-vector-n
(1+ gnyo:fall-german-base-vector-n))
(aset gnyo:fall-german-base-vector x y))
(aset gnyo:fall-german-base-vector x nil))
(setq x (1+ x))))
(gnyo*display-german nil) ;表示じゃーまんをクリア
(process-send-string ;自分の盤面の太武郎占有率を送る
gnyo:server-process
(format "bp=%d" (- 100 (/ (* 100 gnyo:free-cells) (length gnyo:stage))))))
(defun gnyo*log2int (x &optional base)
"log関数. Xの2を底とした(BASEを指定するとそれを底とする)logを返す."
(or (and (fboundp 'log) ;ちっとだけEmacs19をひいき
(truncate (/ (log (max x 1)) (log (or base 2)))))
(let ((i 0) (base (or base 2)))
(while (> x 1)
(setq x (/ x base) i (1+ i)))
i)))
(defun gnyo*fall-german ()
"じゃーまん太武郎を落す."
(gnyo*fall-german-get-base)
(let ((n gnyo:germans) x y
(set-germ-func (function ;盤に埋め込んで表示するための局所関数
(lambda (x y)
(aset gnyo:stage
(gnyo*location-to-index x y) gnyo:german)
(gnyo*locate-stage x y)
(gnyo*repl-str gnyo:german)
(sit-for 0)
(setq n (1- n))
(if (< (setq y (1- y)) 0)
(progn
(aset gnyo:fall-german-base-vector x nil)
(setq gnyo:fall-german-base-vector-n
(1- gnyo:fall-german-base-vector-n)))
(aset gnyo:fall-german-base-vector x y))))))
;;もし空き場所より多かったら先に敗北宣言しておかないと時間かかって
;;相手が勝たない場合がある。
(if (> n gnyo:free-cells) (gnyo*declare-lose))
(cond
((> n 0)
(while (and (> n 0) (> gnyo:fall-german-base-vector-n 0))
(cond
((>= n gnyo:fall-german-base-vector-n)
(setq x 0)
(while (< x gnyo:width)
(if (setq y (aref gnyo:fall-german-base-vector x))
(funcall set-germ-func x y))
(setq x (1+ x))))
(t
(while (null (aref gnyo:fall-german-base-vector
(setq x (gnyo*random gnyo:width)))))
(funcall set-germ-func x (aref gnyo:fall-german-base-vector x)))))
(setq gnyo:germans 0)
(gnyo*redraw-stage)
(sit-for 0)))))
(defun gnyo*zap-germans ()
(let ((x 0) (y 0) (i 0) p)
(while (< y gnyo:height)
(setq x 0)
(while (< x gnyo:width)
(if (equal (aref gnyo:stage i) gnyo:german)
(cond
((and (> x 0) ; 左隣
(numberp (aref gnyo:stflags (setq p (1- i))))
(> (aref gnyo:stflags p) 1)) ;通常駒なら1より大のはず
(aset gnyo:stflags i 1))
((and (< x (1- gnyo:width)) ; 右隣
(numberp (aref gnyo:stflags (setq p (1+ i))))
(> (aref gnyo:stflags p) 1))
(aset gnyo:stflags i 1))
((and (> y 0) ; 上隣
(numberp (aref gnyo:stflags (setq p (- i gnyo:width))))
(> (aref gnyo:stflags p) 1))
(aset gnyo:stflags i 1))
((and (< y (1- gnyo:height)) ; 下隣
(numberp (aref gnyo:stflags (setq p (+ i gnyo:width))))
(> (aref gnyo:stflags p) 1))
(aset gnyo:stflags i 1))))
(setq x (1+ x) i (1+ i)))
(setq y (1+ y)))))
;;; -------------------- 対戦型用関数おしまい --------------------
(defun gnyo*need-zap-p ()
"ステージの駒消去が必要か? 配列gnyo:stflagsに結果を入れる."
(let ((i 0) this result
(x 0) (y 0) zap-p)
(while (< i gnyo:stlength) (aset gnyo:stflags i nil) (setq i (1+ i)))
(setq i 0)
(while (< y gnyo:height)
(setq x 0)
(while (< x gnyo:width)
(if (aref gnyo:stflags i) nil
(aset gnyo:stflags i t)
(cond
((null (setq this (aref gnyo:stage i)))
nil)
((equal this gnyo:german)
nil)
((>= (setq gnyo:blocks 0
result (gnyo*no-homogeneous x y i this))
gnyo:nzap)
(let ((j 0))
(while (aref gnyo:work-array j)
(aset gnyo:stflags (aref gnyo:work-array j) result)
(setq j (1+ j))))
(setq zap-p t))))
(setq i (1+ i) x (1+ x)))
(setq y (1+ y)))
(if (and zap-p (null gnyo:stand-alone))
(gnyo*zap-germans))
zap-p))
(defun gnyo*on-off-flash-tablets (on)
"配列gnyo:work-arrayにある駒の、表示(引数ONがnon-nil) または消去(nil).
親関数 gnyo*flash-tablets のローカル変数 no-flash-tablets を参照している."
(let ((i 0) index)
(while (< i no-flash-tablets)
(setq index (aref gnyo:work-array i))
(gnyo*locate-stage (% index gnyo:width) (/ index gnyo:width))
(gnyo*repl-str (if on (aref gnyo:stage index) gnyo:empty))
(setq i (1+ i)))
(sit-for 0)))
(defun gnyo*flash-tablets ()
"配列gnyo:stflagsを参照して、消すべき駒を点滅表示."
(let ((i 0) (no-flash-tablets 0))
(gnyo*locate-stage (1- (/ gnyo:width 2)) 1)
(gnyo*ovwt-insert (format "%2d" (1+ chain)))
(while (< i gnyo:stlength)
(if (integerp (aref gnyo:stflags i))
(progn
(aset gnyo:work-array no-flash-tablets i)
(setq no-flash-tablets (1+ no-flash-tablets))))
(setq i (1+ i)))
(setq i 0)
(while (< i 3)
(gnyo*on-off-flash-tablets nil)
(if (> gnyo:timer 100)
(gnyo*wait (/ gnyo:timer 5)))
(gnyo*on-off-flash-tablets t)
(or gnyo:mute (ding))
(setq i (1+ i))
))
(gnyo*wait (/ gnyo:timer 5)))
(defun gnyo*break-down-tablets ()
"配列gnyo:stflagsを参照して、gnyo:stageの駒の山を崩す.
gnyo:stflagsの数字を足したものをスコアとして返す."
(let ((x 0) y break-p no-moved j yy index (point 0))
(while (< x gnyo:width)
(setq y (1- gnyo:height) break-p nil no-moved 0
yy (gnyo*location-to-index x y)
index yy)
(while (>= y 0)
(if (integerp (aref gnyo:stflags index))
(setq break-p t point (+ point (* (aref gnyo:stflags index) odds)))
(aset gnyo:work-array no-moved (aref gnyo:stage index))
(setq no-moved (1+ no-moved)))
(setq y (1- y) index (- index gnyo:width)))
(setq index yy j 0)
(if break-p
(progn
(while (< j no-moved)
(aset gnyo:stage index (aref gnyo:work-array j))
(setq j (1+ j) index (- index gnyo:width)))
(while (< j gnyo:height)
(aset gnyo:stage index nil)
(setq j (1+ j) index (- index gnyo:width)))))
(setq x (1+ x)))
point))
(defun gnyo*redraw-stage ()
"配列gnyo:stageを画面に表示.
「ボス来た」用にも使うので、gnyo:stage が短いときは配列の最後のものを
続けて表示するようになっている。スピードはほとんど変わりません。"
(let ((y 0) x (left-edge 0) (len (length gnyo:stage)))
(while (< y gnyo:height)
(setq x 0)
(gnyo*locate-stage x y)
(while (< x gnyo:width)
(gnyo*repl-str
(or (aref gnyo:stage (min (+ left-edge x) (1- len)))
gnyo:empty))
(setq x (1+ x)))
(setq y (1+ y) left-edge (+ left-edge gnyo:width)))))
(defun gnyo*do-zap (odds)
"ステージの駒を消去."
(gnyo*flash-tablets)
(setq gnyo:score (+ gnyo:score (gnyo*break-down-tablets)))
(gnyo*redraw-stage)
(or gnyo:mute (ding))
(gnyo*display-score gnyo:score)
(sit-for 0)
(gnyo*wait (/ gnyo:timer 3)))
(defun gnyo*calculate-german (point chain)
(let ((l23 (max (- (gnyo*log2int point) 3) 0)))
(max 0
(+ (* l23 (1+ chain))
(max 0 (- (gnyo*log2int (- point (lsh 2 (+ 2 l23)))) 3))
-1))))
(defun gnyo*zap-tablets ()
"ステージ中の駒を消去."
(let ((odds 1) (chain 0) (oldscore gnyo:score) german cancel)
(while (gnyo*need-zap-p)
(while (input-pending-p) (read-char))
(gnyo*do-zap odds)
(setq odds (* odds 2) chain (1+ chain)))
(cond
((not gnyo:stand-alone)
(setq german (gnyo*calculate-german (- gnyo:score oldscore -1) chain)
cancel (- german gnyo:germans))
(if (<= cancel 0)
(setq german 0 gnyo:germans (- cancel))
(setq german cancel gnyo:germans 0)
(gnyo*send-german german))))
chain))
(defun gnyo*land-p (&optional x y)
(setq x (or x gnyo:tablet-x) y (or y gnyo:tablet-y))
(cond
((= gnyo:tablet-direction 0) ;双子が下
(or (>= (+ y 2) gnyo:height)
(gnyo*tablet-exists-p x (+ y 2))))
((= gnyo:tablet-direction 1) ;双子が左
(or (>= (+ y 1) gnyo:height)
(gnyo*tablet-exists-p x (1+ y))
(gnyo*tablet-exists-p (1- x) (1+ y))))
((= gnyo:tablet-direction 2) ;双子が上
(or (>= (+ y 1) gnyo:height)
(gnyo*tablet-exists-p x (+ y 1))))
((= gnyo:tablet-direction 3) ;双子が右
(or (>= (+ y 1) gnyo:height)
(gnyo*tablet-exists-p x (1+ y))
(gnyo*tablet-exists-p (1+ x) (1+ y))))))
(defun gnyo*gnyo ()
"ぐにょぐにょメインループ."
(let ((i 0) lev zap (visible-bell nil))
(prog1
(catch 'over
(while t
(setq i (max 0 i)
i (if (>= gnyo:level gnyo:max-level ) i (1+ i))
gnyo:level
(max (min (1+ (/ i gnyo:level-update-count))
gnyo:max-level)
1)
lev (assoc gnyo:level gnyo:level-status-list)
gnyo:n-tablets (nth 1 lev)
gnyo:current-timer (/ (* (nth 2 lev) gnyo:timer) 10))
(or gnyo:stand-alone (gnyo*fall-german))
(gnyo*display-score gnyo:score)
(gnyo*display-level gnyo:level)
(or (gnyo*generate-tablet) (throw 'over t))
(catch 'land
(while t
(if (< (nth 2 lev) 3)
(while (input-pending-p) (read-char))) ;key buffer clear
(gnyo*display-tablet gnyo:current-tablet)
(beginning-of-line)
(sit-for 0)
(message "") ;kill `Garbage collection'
(or gnyo:mute (ding))
(gnyo*spin) ;キー入力処理
(sit-for 0)
(if (gnyo*land-p) (throw 'land t))
(gnyo*erase-square
gnyo:tablet-x gnyo:tablet-y gnyo:tablet-direction)
(setq gnyo:tablet-y (1+ gnyo:tablet-y))
))
(gnyo*free-fall)
(setq zap (gnyo*zap-tablets))
(if (= gnyo:level gnyo:max-level)
(setq i (- i (* gnyo:level-update-count zap)))
(setq i (- i zap)))
))
(or gnyo:stand-alone (gnyo*declare-lose)) ;負けた旨通知
(setq gnyo:time-over (current-time-string)))))
(defun gnyo*insert-new-score (name)
"現在位置にスコアフィールドを書き込む."
(insert name)
(while (< (current-column) 24) (insert "\t"))
(insert (format "%d\t%d\t%s\n" gnyo:score gnyo:level gnyo:time-over)))
(defun gnyo*lock-score ()
(if (file-exists-p gnyo:score-lock-file)
(progn (message "誰かがスコア更新中.")
(sleep-for 3)))
(if (file-exists-p gnyo:score-lock-file) t
(save-excursion
(set-buffer (find-file-noselect gnyo:score-lock-file))
(message "") ;(New file) ってのを消す
(setq buffer-read-only nil)
(insert " ") (basic-save-buffer)
(kill-buffer (current-buffer)))
nil))
(defvar gnyo:score-field-regexp
"^\\(\\w+\\)\\s +\\([0-9]+\\)\\s +\\([0-9]+\\)\\s +\\([A-Z].*\\)$"
;; 1.名前 空白 2.得点 空白 3.レベル 空白 4.日付
"スコアファイルのフォーマットの正規表現.")
(defun gnyo*current-score-id ()
(concat "\\(" (int-to-string gnyo:score) "\\)\\s +"
(int-to-string gnyo:level) "\\s +"
gnyo:time-over "$"))
(defun gnyo*update-score ()
(let (user sbuf found (gnyo-buffer (current-buffer)) updatep)
(if (catch 'update
(if (or (not (integerp gnyo:score))
(or (> gnyo:width gnyo:default-width)
(> gnyo:height gnyo:default-height)
(< gnyo:nzap 4)))
(progn (message "スコアのアップデートはできないっす.")
(sit-for 2)
(throw 'update nil)))
(find-file-read-only gnyo:score-file)
(setq sbuf (current-buffer))
(setq buffer-read-only nil)
(widen)
(goto-char (point-min))
(save-excursion
(if (re-search-forward (gnyo*current-score-id) nil t)
(progn (message "すでに登録してあるよん.")
(setq updatep t)
(throw 'update nil))))
(if gnyo:single-user-mode
(progn
(goto-line 10)
(beginning-of-line)
(re-search-forward gnyo:score-field-regexp nil t)
(if (or (null (match-beginning 2))
(< (gnyo*str2int
(buffer-substring
(match-beginning 2) (match-end 2)))
gnyo:score))
(progn
(if (gnyo*lock-score) (throw 'update 'cease))
(setq user (or (getenv "USER")
(read-string "Your name: ")))
(end-of-line)
(newline 1)
(delete-blank-lines)
(gnyo*insert-new-score user)
(delete-blank-lines)
(delete-blank-lines)
(goto-char (point-max))
(delete-blank-lines)
(if (string< "19" emacs-version)
(progn ;Boo!
(sort-numeric-fields 2 (point-min) (point-max))
(reverse-region (point-min) (point-max)))
(sort-numeric-fields -2 (point-min) (point-max)))
(goto-line 10)
(forward-line 1)
(delete-region (point) (point-max)))))
;;マルチユーザモード
(setq user (user-login-name))
(setq found (re-search-forward (concat "^" user "\\>") nil t))
(beginning-of-line)
(re-search-forward gnyo:score-field-regexp nil t 1)
(if (or (null found)
(< (gnyo*str2int
(buffer-substring (match-beginning 2) (match-end 2)))
gnyo:score))
(progn
(if (gnyo*lock-score) (throw 'update 'cease))
(if found
(progn
(beginning-of-line)
(if (not (eobp)) (kill-line)))
(goto-char (point-max))
(newline 1)
(delete-blank-lines))
(gnyo*insert-new-score user)
(delete-blank-lines)
(delete-blank-lines)
(goto-char (point-max))
(delete-blank-lines)
(if (string< "19" emacs-version)
(progn
(sort-numeric-fields 2 (point-min) (point-max))
(reverse-region (point-min) (point-max)))
(sort-numeric-fields -2 (point-min) (point-max)))
))) ;endif (single-user-mode)
(if (buffer-modified-p)
(progn
(goto-char (point-max))
(newline 1)
(delete-blank-lines)
(cond
((file-writable-p gnyo:score-file)
(basic-save-buffer))
(t
(shell-command-on-region
(point-min) (point-max) gnyo:score-update-command)))
(set-buffer-modified-p nil)
(while (input-pending-p) (read-char))
(goto-char (point-min))
(setq updatep t)
(kill-buffer (current-buffer))
(delete-file gnyo:score-lock-file) ;ロック解除
)))
(message
"誰かがスコア更新中. ゲーム画面でuを押すか、M-x gnyo-update-score"))
(if sbuf (kill-buffer sbuf))
(switch-to-buffer gnyo-buffer)
updatep))
;;;
;;ここらインタラクティブ関数の定義
;;;
;;;###autoload
(defun gnyognyo (arg)
"ぐにょぐにょだ〜
ARGがnon-nilならreplay
プレイ中のキー:
左移動 4,h 回転 5,k 右移動 6,l
一つ落とす 2,j
下まで落とす 0,SPC
ゲームオーバー画面のキー:
\\[gnyo-quit] やめ
\\[gnyo-replay] もっかい
\\[gnyo-score] スコアが見たい
\\[gnyo-update-score] ハイスコア更新に失敗した後で再トライ
\\[gnyo-config] パラメータの調整
"
(interactive "P")
(or arg (setq gnyo:save-config (current-window-configuration)))
(delete-other-windows)
(switch-to-buffer (get-buffer-create gnyo:buffer))
(buffer-disable-undo)
(setq major-mode 'gnyognyo mode-name "ぐにょぐにょ")
(use-local-map gnyo:key-map)
(gnyo*init-value)
(gnyo*setup-screen)
(let ((gnyo:timer (if gnyo:colorful (/ (* 2 gnyo:timer) 3) gnyo:timer))
rank-in xcode back fore name sf)
(if gnyo:colorful
(progn
(setq sf (selected-frame)
back (assq 'background-color (frame-parameters))
fore (assq 'foreground-color (frame-parameters))
name (assq 'name (frame-parameters)))
(modify-frame-parameters ;ふつ〜ゲームは黒地と思うけど
nil '((background-color . "black") ;勝手に反転しちゃっていいよね?
(foreground-color . "white")
;;(name . "*** GNYOGNYO ***")
))))
(setq xcode (unwind-protect
(gnyo*gnyo) ;ぐにょぐにょメインループの実行
(if gnyo:colorful ;ちゃんと反転は元に戻すので許して
(modify-frame-parameters
sf (list back fore name)))))
(while (input-pending-p) (read-char))
(cond
((eq xcode t)
(if gnyo:stand-alone (message "げーむおーばー")
(message "がーん, 負けちったー...")))
((eq xcode 'win) (message "いえー, 勝った勝ったー!")))
(sleep-for 3)
(while (input-pending-p) (read-char)) ;念のため
(gnyo*final-screen)
(cond
(gnyo:stand-alone
(setq rank-in (gnyo*update-score))
(if rank-in (gnyo-score t "よっしゃハイスコア更新!"))))
(if (eq xcode 'replay)
(progn (message "もう一回!") (sit-for 1) (gnyo-replay)))))
(defun gnyo-quit ()
"やめる."
(interactive)
(set-window-configuration gnyo:save-config)
(gnyo*close-gnyoserver)
(message "またあそんでね〜."))
(defun gnyo*kill-buffer ()
"カレントバッファの削除."
(interactive) (kill-buffer nil))
(defun gnyo-replay ()
"くそ〜、もう一回!"
(interactive)
(if (and gnyo:server-process (process-status gnyo:server-process))
(progn
(set-window-configuration gnyo:save-config)
(gnyo-fight nil nil))
(gnyognyo t)))
(defun gnyo-config ()
"ぐにょぐにょパラメータの変更."
(interactive)
(setq gnyo:timer (gnyo*str2int
(read-string "ウェイト値: " (int-to-string gnyo:timer)))
gnyo:nzap (gnyo*str2int
(read-string "いくつ隣接したときに消すか: "
(int-to-string gnyo:nzap)))
gnyo:mute (y-or-n-p "音を消す?")
gnyo:width (gnyo*str2int
(read-string "ステージの幅: " (int-to-string gnyo:width)))
gnyo:width (min (max 2 gnyo:width)
(/ (- (screen-width) 28) gnyo:char-width))
gnyo:height (gnyo*str2int
(read-string "ステージの高さ: "
(int-to-string gnyo:height)))
gnyo:height (min (max 6 gnyo:height) (- (screen-height) 5))
gnyo:stlength (* gnyo:width gnyo:height)
gnyo:score 0 gnyo:level 0)
(if (> (* gnyo:width gnyo:height) (length gnyo:stage))
(let ((len gnyo:stlength))
(setq gnyo:stlength len
gnyo:stage (make-vector len nil)
gnyo:stflags (make-vector len nil)
gnyo:work-array (make-vector len nil))))
(if (or (> gnyo:width gnyo:default-width)
(> gnyo:height gnyo:default-height)
(< gnyo:nzap 4))
(message
"デフォルトのステージより広いのでハイスコア更新は無効化されます")))
(defun gnyo-score (&optional momentary msg)
"ぐにょぐにょスコアの表示"
(interactive)
(find-file-read-only gnyo:score-file)
(message "")
(widen)
(goto-char (point-min))
(if (re-search-forward (gnyo*current-score-id) nil t)
(progn
(goto-char (match-beginning 1))
(let*((rank (count-lines (point-min) (point)))
(eval (cond ((<= rank 1) "だぜいえ〜")
((<= rank 2) "かよ惜しいなくそ〜")
((<= rank 5) "か、もう一頑張りだな.")
((<= rank 10) "じゃちっともうれしくないな")
(t "って話にならん"))))
(setq msg (concat msg (format " %d位%s" rank eval))))))
(message "%s (Hit any key)." (or msg ""))
(if momentary
(progn
(read-char)
(kill-buffer (current-buffer)))
(use-local-map gnyo:score-key-map)))
(defun gnyo-update-score ()
"ハイスコアの更新"
(interactive)
(or (gnyo*update-score)
(message "もしこれでもダメなら %s を消してね" gnyo:score-lock-file)))
(defun gnyo-fight (host &optional port)
"対戦型ぐにょぐにょだ〜!
エラーチェックはあまりしてない。"
(interactive "sGnyoserver's host: ")
(setq gnyo:save-config (current-window-configuration))
(delete-other-windows)
(unwind-protect
(let ((gnyo:timer (/ (* 3 gnyo:timer) 4)) ready passive)
(condition-case nil
(gnyo*open-gnyoserver host port)
(error (error "Server not found on %s" host)))
(setq gnyo:stand-alone nil ;対戦型です
gnyo:server-output-string nil ;バッファクリア
gnyo:germans 0 ;ペナルティじゃーまんクリア
gnyo:clistates (make-vector 10 nil))
(switch-to-buffer (get-buffer-create gnyo:buffer))
(erase-buffer)
(insert "
対戦型
ぐにょぐにょはじめまーす
準備ができたら g を押してくださいな
(C)1994, 1995, 1999 by yuuji@gentei.org")
;; gnus.el からのパクりなり
;; And then hack it.
;; 45 is the longest line.
(indent-rigidly
(point-min) (point-max) (/ (max (- (window-width) 43) 0) 2))
(goto-char (point-min))
;; +4 is fuzzy factor.
(insert-char ?\n (/ (max (- (window-height) 18) 0) 2))
(while (not ready)
(message (if passive "ほかの者が出揃うまで待たれよ..."
"Type g to start."))
(gnyo*parse-output)
(if (and (input-pending-p)
(= (read-char) ?g)
(not passive))
(progn (process-send-string gnyo:server-process "i\n")
(process-send-string gnyo:server-process "!\n")
(setq passive t)))
(sit-for 1))
(process-send-string gnyo:server-process "v\n");;対戦相手リストを取得
(message "よおおおおおおおおおーーーーい...")
(sleep-for 1) ;1秒間待って
(accept-process-output) ;
(gnyo*parse-output) ;結果を変数に入れる
(gnyognyo t)
(set-process-filter gnyo:server-process 'gnyo*server-filter2))
(setq gnyo:stand-alone t)))
;;; Initialization
(setq gnyo:timer (gnyo*check-performance))
(random t)
(run-hooks 'gnyo:load-hook)
(or (fboundp 'gg) (fset 'gg 'gnyognyo))
(or (fboundp 'ggf) (fset 'ggf 'gnyo-fight))
;; gnyognyo.el はここでおしまい.
; Local variables:
; fill-prefix: ";;; "
; paragraph-start: "^$\\| \\|;;;$"
; paragraph-separate: "^$\\| \\|;;;$"
; End:
HIROSE Yuuji