(defstruct (card (:print-function (lambda (p stream depth)
									(format stream "~a" (card-to-string p)))))
  (color 0)
  (num 0))

(defstruct (player (:print-function (lambda (p stream depth)
									  (format stream "seat:~a, ~acards: ~a" (player-seat p)
											  (if (player-dizhu-p p)
												  "[dizhu], "
												  "")
											  (player-cards p)))))
  (seat 0)
  (dizhu-p nil)
  (cards nil))  

(defstruct board
  (players (list (make-player :seat 0)
				 (make-player :seat 1)
				 (make-player :seat 2)))
  (left-cards (generate-one-desk-pokers)))

(defun game-start (board)
  ;; 初始化
  (format t "game initing ...~%")
  (init-board board)
  ;; 分牌
  (format t "dispatching cards ...~%")
  (dispatch-cards board)
  ;; 读取地主
  (let ((dizhu-seat (prompt-read-dizhu-seat)))
	;; 地主拿三张牌
	(format t "last 3 cards: ~{~a, ~}~%" (board-left-cards board))
	(set-board-dizhu board dizhu-seat)
	;; 进入游戏循环
	(format t "entering game loop : ~%")
	(let ((winner
		   (block  game-loop
			 (do ((round-start-seat dizhu-seat))	;每牌圈的起始玩家
				  (nil)
			   (do ((cur-seat round-start-seat (mod (1+ cur-seat) 3)) ;当前轮到的
					(round-last-act-seat nil)						   ;本牌圈上个行动者
					(round-last-card-info nil))					   ;本牌圈上个行动的牌
				   ((and round-last-card-info (= round-last-act-seat cur-seat))				   ;没人压我呀！
					(setf round-start-seat round-last-act-seat))
				 ;; 读取要打出的牌
				 (let ((cur-card-info (prompt-read-cur-player-act board cur-seat round-last-act-seat round-last-card-info)))
				   (when cur-card-info
					 (setf round-last-card-info cur-card-info)
					 (setf round-last-act-seat cur-seat)
					 ;; 是否牌出完了呢?
					 (when (null (player-cards (elt (board-players board) cur-seat)))
					   (return-from game-loop cur-seat)))))))))
	  (format t "~& winner: ~:[farmer~;dizhu~] (seat: ~a)~%"
			  (player-dizhu-p (elt (board-players board) winner)) winner))))

(defun prompt-read-cur-player-act (board cur-seat round-last-act-seat round-last-card-info)
  (format t "~&turn player: %~a~%" cur-seat)
  ;;
  (labels ((read-cards ()
			 (format t "mycards : ~a~%last player act: ~a~%~a input:" 
					 (player-cards (elt (board-players board)
										cur-seat))
					 round-last-card-info
					 cur-seat)
			 (let ((card-lst (read)))
			   card-lst))
		   (read-info ()				;读取行动
			 (let ((cards (read-cards)))
			   (if (not cards)
				   (if round-last-act-seat
					   (return-from read-info nil)
					   (progn (format t "you must input cards: ")
							  (read-info)))
				   ;; 验证是否合法
				   (let (card-info (calc-card-type-info cards))
					 (format t "inputed : ~a~%" cards)
					 (if (and (not (eql card-type-null (car card-info)))
							  (card-type-info> card-info round-last-card-info))
						 card-info
						 (progn (format t "invalid card type: ~a, retry: " card-info)
								(read-info))))))))
	(read-info)))

(defun prompt-read-dizhu-seat ()
  (format t "~&input dizhu seat [0-2]: ")
  (parse-integer (read-line)))

(defun init-board (board)
  (setf (board-left-cards board) (generate-one-desk-pokers))
  (mapc #'(lambda (player)
			(setf (player-cards player) nil)
			(setf (player-dizhu-p player) nil))
		(board-players board)))

(defun set-board-dizhu (board seat)
  (setf (player-dizhu-p (elt (board-players board) seat)) t)
  (setf (player-cards (elt (board-players board) seat))
		(append (player-cards (elt (board-players board) seat))
				(board-left-cards board)))
  (setf (board-left-cards board) nil)
  seat)

(defun dispatch-cards (board)
  ;; xixi
  (setf (board-left-cards board)
		(sort (generate-one-desk-pokers) #'(lambda (x y)
											 (= (random 2) 0))))
  ;; 每人 17张
  (dotimes (seat 3)
	(setf (player-cards (elt (board-players board) seat))
		  (sort (subseq (board-left-cards board)
						(* seat 17)
						(+ (* seat 17) 17))
				#'(lambda (x y)
					(> (card-num-to-compare-num (card-num x))
					   (card-num-to-compare-num (card-num y)))))))
  (setf (board-left-cards board) (subseq (board-left-cards board)
										 (* 17 3)))
  board)

(defun card-num-to-compare-num (num)
  (cond ((>= num 14) num)
		((>= num 3) (- num 2))
		((> num 0) (+ num 11))
		(t num)))

(defun card-to-string (card)
  (labels ((card-num-to-string (num)
			 (case num
			   ((1) "A")
			   ((10) "T")
			   ((11) "J")
			   ((12) "Q")
			   ((13) "K")
			   ((14) "w")
			   ((15) "W")
			   (t (format nil "~a" num))))
		   (card-color-to-string (color)
			 (case color
			   ((1) "s")
			   ((2) "d")
			   ((3) "h")
			   ((4) "c")
			   (t ""))))
	(format nil "~a~a" (card-num-to-string (card-num card))
			(card-color-to-string (card-color card)))))

(defun generate-one-desk-pokers ()
  (let ((cards '()))
	(dotimes (color 4)
	  (dotimes (num 13)
		(push (make-card :color (1+ color) :num (1+ num)) cards)))
	(push (make-card :color 5 :num 14) cards)
	(push (make-card :color 5 :num 15) cards)))

(defconstant card-type-null 'null)
(defconstant card-type-single 'single)
(defconstant card-type-pair 'pair)
(defconstant card-type-three 'three)
(defconstant card-type-three-1 'three-1)
(defconstant card-type-three-pair 'three-pair)
(defconstant card-type-four-2 'four-2)
(defconstant card-type-four 'four)
(defconstant card-type-wang-bomb 'wang-bomb)
(defconstant card-type-single-straight 'single-straight)
(defconstant card-type-pair-straight 'pair-straight)
(defconstant card-type-three-straight 'three-straight)
(defconstant card-type-three-1-straight 'three-1-straight)
(defconstant card-type-three-pair-straight 'three-pair-straight)

(defun card-info-card-count (info)
  (reduce #'(lambda (x y)
			  (+ x
				 (* (length y)
					(length (car y)))))
		  (cadr info) :initial-value 0))

;从牌中寻找顺子（大于某个值的)
(defun find-all-straight (classified-cards unit-length unit-count &optional (min-num 0))
  (let ((possible-cards '())
		(min-compare-num (card-num-to-compare-num min-num))
		(results '()))
	;; 天顺就不用想了
	(when (<= 13 min-compare-num)
	  (return-from find-all-straight-bigger-than NIL))

	;; 搜集可能的牌
	(dolist (num-cards classified-cards)
	  (when (< (length (car num-cards)) unit-length)
		(return))
	  (dolist (unit-cards num-cards)
		(push (subseq unit-cards 0 unit-length) possible-cards)))
	;; 排序
	(setf possible-cards
		  (sort possible-cards
				#'(lambda (x y)
					(> (card-num-to-compare-num (card-num (car x)))
					   (card-num-to-compare-num (card-num (car y)))))))
	
	;;
	(labels ((find-next-straight-iter (cards count left-compare-num product)
			   (cond ((= count unit-count) product)
					 ((null cards) NIL)
					 ((and (= 0 count)
						   (<= (card-num-to-compare-num (card-num (caar cards)))
							 min-compare-num))
					  NIL)
					 ((>= (card-num (caar cards)) 14)
					  (find-next-straight-iter (cdr cards) 0 0 (cdr cards)))
					 ((or (= 0 count)
						  (= 1 (- left-compare-num (card-num-to-compare-num (card-num (caar cards))))))
					  (find-next-straight-iter (cdr cards) (1+ count)
											   (card-num-to-compare-num (card-num (caar cards)))
											   product))
					 (t
					  (find-next-straight-iter (cdr cards) 0 0 (cdr cards)))))
			 (find-next-straight (cards)
			   (find-next-straight-iter cards 0 0 cards)))

	  (do* ((left-straight-cards (find-next-straight possible-cards)
								(find-next-straight (cdr left-straight-cards)))
			(results '()))
		  ((null left-straight-cards) results)
		(push (subseq left-straight-cards 0 unit-count) results)))))


(defun find-all-bigger-card-type-than (info cards)
  (if (or (null cards)
		  (eql card-type-wang-bomb (car info))) ;王炸是不可战胜的
	  NIL
	  (let ((my-classified-cards (cards-classified cards))
			(results '()))
		;; 王炸
		(when (= 2 (count-if #'(lambda (x)
							(or (= 14 (card-num x))
								(= 15 (card-num x))))
						cards))
		  (push (list card-type-wang-bomb
					  (list (make-card :color 4 :num 14)
							(make-card :color 4 :num 15)))
				results))
		;; 四张
		(when (and (not (eql card-type-four (car info)))
				   (= 4 (length (caar my-classified-cards))))
		  (dolist (bigcards (car my-classified-cards))
			(push (list card-type-four
						bigcards)
				  results)))
		;; 同类型的 数量至少要足了
		(when (and (>= (length cards)
					   (card-info-card-count info))
				   (>= (length (caar my-classified-cards))
					   (length (caar (cadr info)))))
		  (cond
			; 单张 对子 三张 四张： 找大的当主牌即可
			((or (eql (car info) card-type-three)
				 (eql (car info) card-type-single)
				 (eql (car info) card-type-pair)
				 (eql (car info) card-type-four))
			 (let ((first-count (length (caar (cadr info)))))
			 (dolist (num-cards my-classified-cards)
			   (when (< (length (car num-cards)) first-count)
				 (return))
			   (dolist (bigcards num-cards)
				 (when (> (card-num-to-compare-num (card-num (car bigcards)))
						  (card-num-to-compare-num (card-num (caaar (cadr info)))))
				   (push (list card-type-pair
							   (subseq bigcards 0 first-count))
						 results))))))
			; 三带1 三带对 四带二： 找到大的主牌 再找副牌
			((or (eql (car info) card-type-three-1)
				 (eql (car info) card-type-four-2)
				 (eql (car info) card-type-three-pair))
			 (let ((first-count (length (caar (cadr info))))
				   (second-count (if (eql (car info) card-type-three-1)
									 1 2))
				   (second-pair-p (if (eql (car info) card-type-three-pair)
									  T NIL)))
			   (dolist (first-cards my-classified-cards)
				 (when (< (length (car first-cards)) first-count)
				   (return))
				 (when (or (eql (car info) card-type-four-2)
						   (not (= (length (car first-cards)) 4))) ;四张的就不参与了
				   (dolist (first-card (remove-if #'(lambda (x)
													  (= (card-num (caaar (cadr info)))
														 (card-num (car x))))
												  first-cards))
					 ; 开始找寻副牌
					 (let ((second-card1 NIL)
						   (second-card2 NIL))
					   (find-if #'(lambda (x) ;num-cards
									;; 对子就算了吧
									(when (or (not second-pair-p)
											  (>= (length (car x)) 2))
									  (find-if #'(lambda (y) ;cards
												   (and (not (= (card-num (car y))
																(card-num (car first-card))))
														(cond
														  (second-pair-p
														   (setf second-card1 (car y)
																 second-card2 (cadr y)))
														  ((not second-card1)
														   (setf second-card1 (car y))
														   NIL)
														  ((not second-card2)
														   (setf second-card2 (car y))))))
											 (reverse x))))
								(reverse my-classified-cards))
					   (when second-card2
						 (push (list (car info)
									 (append first-card (list second-card1 second-card2)))
							   results))))))))
			;; 顺子：单顺 双顺 三顺； 搜罗所有的， 然后看是否有顺
			((or (eql (car info) card-type-single-straight)
				 (eql (car info) card-type-pair-straight)
				 (eql (car info) card-type-three-straight))
			 (setf results
				   (mapcar #'(lambda (x) (list (car info)
											   (reduce #'(lambda (x y)
														   (append y x))
													   x
													   :initial-value nil)))
						   (find-all-straight
							my-classified-cards
							(length (caar (cadr info)))
							(length (car (cadr info)))
							(card-num (caaar (cadr info)))))))
			;; 三顺1 三顺对
			((or (eql (car info) card-type-three-1-straight)
				 (eql (car info) card-type-three-pair-straight))
			 (let* ((three-straights (find-all-straight my-classified-cards
													   (length (caar (cadr info)))
													   (length (car (cadr info)))
													   (card-num (caaar (cadr info)))))
					(second-unit-count (length (car (cadr info))))
					(second-unit-length (/ (- (card-info-card-count info) (* 3 second-unit-count)) 2)))
			   (mapc #'(lambda (a-three-straight-classic)
						 (let ((second-cards '())
							   (a-three-straight (reduce #'append a-three-straight-classic)))
						   (when (find-if #'(lambda (num-cards)
											  (when (find-if #'(lambda (x)
																 ;; todo 不在三顺中，就加一张
																 (dolist (x x)
																   (unless (find-if #'(lambda (card)
																						(and (= (card-num x) (card-num card))
																							 (= (card-color x) (card-color card))))
																					a-three-straight)
																	 (push x second-cards)
																	 (when (= (length second-cards)
																			  (* second-unit-count second-unit-length))
																	   (return))))
																 (= (length second-cards)
																	(* second-unit-length second-unit-count))
																 t)
															 (reverse num-cards))
												(= (length second-cards) 
												   (* second-unit-count second-unit-length))))
										  (reverse my-classified-cards))
							 (push (list (car info) (append a-three-straight second-cards))
								   results))))
					 three-straights)))
		  ))
		results)))

(defun cards> (cards1 cards2)
  (card-type-info> (calc-card-type-info cards1)
				   (calc-card-type-info cards2)))

(defun card-type-info> (info1 info2)
  (cond 
	((and (or (null info1) (eql card-type-null (car info1)))
		  (or (null info2) (eql card-type-null (car info2))))
	 NIL)
	((or (null info2) (eql card-type-null (car info2))) t)
	((or (null info1) (eql card-type-null (car info1))) nil)
	((eql card-type-wang-bomb (car info1))
	 T)
	((eql card-type-wang-bomb (car info2))
	 NIL)
	((and (eql card-type-four (car info1))
		  (eql card-type-four (car info2)))
	 (> (card-num-to-compare-num (card-num (caaar (cadr info1))))
		(card-num-to-compare-num (card-num (caaar (cadr info2))))))
	((eql card-type-four (car info1))
	 T)
	((eql card-type-four (car info2))
	 NIL)
	((or (not (eql (car info1) (car info2)))
		 (not (= (length (car (cadr info1)))
				 (length (car (cadr info2))))))
	 NIL)
	(t
	 (> (card-num-to-compare-num (card-num (caaar (cadr info1))))
		(card-num-to-compare-num (card-num (caaar (cadr info2))))))))

(defun calc-card-type-info (cards)
  (let ((classified-cards (cards-classified cards)))
	(let ((card-type
		   (case (length cards)
			 ((1) card-type-single)
			 ((2) (cond
					((= 29 (+ (card-num (car cards))
							 (card-num (cadr cards))))
					 card-type-wang-bomb)
					((= (card-num (car cards))
						(card-num (cadr cards)))
					 card-type-pair)
					(t
					 card-type-null)))
			 ((3) (if (= 3 (length (caar classified-cards)))
					  card-type-three
					  card-type-null))
			 ((4) (case (length (caar classified-cards))
					((4) card-type-four)
					((3) card-type-three-1)
					(t card-type-null)))
			 ((5)
			  (if (and (= 2 (length classified-cards))
					   (= 3 (length (caar classified-cards)))
					   (= 2 (length (caadr classified-cards))))
				  card-type-three-pair
				  card-type-null))
			 ((6)
			  (if (= 4 (length (caar classified-cards)))
				  card-type-four-2
				  card-type-null))
			 (t
			  card-type-null))))

	  ; 以下是顺子类的判断
	  (when (and (eql card-type-null card-type)
				 (>= (length cards) 5)
				 (every #'(lambda (x) (< (card-num x) 14)) cards))
		(labels ((inc-sum-iter (cards product)
				   (if (< (length cards) 2)
					   product
					   (inc-sum-iter (cdr cards)
									 (+ product (- (card-num-to-compare-num (card-num (caar cards)))
												   (card-num-to-compare-num (card-num (caadr cards))))))))
				 (inc-sum (cards) (inc-sum-iter cards 0)))
		  (setf card-type
				(case (length classified-cards)
				  ((1)
				   (case (length (caar classified-cards))
					 ((1)
					  (if (= (length cards) (1+ (inc-sum (car classified-cards))))
						  card-type-single-straight
						  card-type-null))
					 ((2)
					  (if (= (/ (length cards) 2) (1+ (inc-sum (car classified-cards))))
						  card-type-pair-straight
						  card-type-null))
					 ((3)
					  (if (= (/ (length cards) 3) (1+ (inc-sum (car classified-cards))))
						  card-type-three-straight
						  card-type-null))
					 (t
					  card-type-null)))
				  (t ; 三顺-1 三顺-对的判断逻辑
				   (if (and (= 3 (length (caar classified-cards)))
							(>= (length (car classified-cards)) 2)
							(= (length (car classified-cards))
							   (1+ (inc-sum (car classified-cards))))) ; 到这里保证了三顺
					   (cond
						 ((= (- (length cards) (* 3 (length (car classified-cards)))) (length (car classified-cards)))
						  card-type-three-1-straight)
						 ((and (= 2 (length classified-cards))
							   (= 2 (length (caadr classified-cards)))
							   (= (length (cadr classified-cards))
								  (length (car classified-cards))))
						  card-type-three-pair-straight)
						 (t
						  card-type-null))
					   card-type-null))))))
	  (list card-type classified-cards))))

;; 分类
(defun cards-classified (cards)
  (let ((cards-hash-table (make-hash-table :test #'equal)))
	(dolist (card cards)
	  (let ((num-cards (gethash (card-num card) cards-hash-table)))
		(setf (gethash (card-num card) cards-hash-table) (push card num-cards))))
	; 整理
	(let ((num-count-hash-table (make-hash-table :test #'equal)))
	  (maphash #'(lambda (k v)
				   (setf (gethash (length v) num-count-hash-table)
						 (cons v (gethash (length v) num-count-hash-table))))
			   cards-hash-table)
	  ;; 转化成列表 4 -》 3 -》 2 -》 1
	  (let ((classified-cards '()))
		(dolist (count '(1 2 3 4))
		  (let ((cards (gethash count num-count-hash-table)))
			(when (> (length cards) 0)
			  (setf classified-cards
					(cons (sort cards 
								#'(lambda (x y)
									(> (card-num-to-compare-num (card-num (car x)))
									   (card-num-to-compare-num (card-num (car y))))))
						  classified-cards)))))
		classified-cards))))