暇潰しのミニゲームは自作しよう

暇潰しの時にしたいミニゲームがあっても、手元にある事は稀です。
そんなときは、ちょっとしたミニゲームなら自作して遊んでしまうのが一番です。
自分がプレイするのでインターフェイスに凝る必要もないので、簡単です。

糸通し

(ql:quickload :lispbuilder-sdl)
(ql:quickload :lispbuilder-sdl-gfx)
(ql:quickload :lispbuilder-sdl-ttf)

(defvar *font-path* "/usr/share/fonts/truetype/sazanami/sazanami-mincho.ttf")
(defvar *font-size* 30)

(defun get-font ()
  (make-instance 'sdl:ttf-font-definition
                 :size *font-size*
                 :filename (sdl:create-path *font-path*)))

(defclass <pos> ()
  ((x :initform 0 :initarg :x :accessor x)
   (y :initform 0 :initarg :y :accessor y)))

(defclass <area> (<pos>)
 ((y2 :initform 0 :initarg :y2 :accessor y2)))

(defmethod collision-p ((pos <pos>) (area <area>))
  (and (= (x pos) (x area))
       (<= (y area) (y pos) (y2 area))))

(defun gen-random-hari (xpos)
  (let ((random-y (+ 160 (random 75)))
	(random-hole-size (+ 20 (random 10))))
  (make-instance '<area>
     :x xpos :y random-y :y2 (+ random-hole-size random-y))))

(defun ito ()
  (let* ((ito-pos (make-instance '<pos>
                      :x 300 :y 240))
	 (hari-list (list (gen-random-hari 480)))
 	(hari-speed 1)
	 (score 0)
	 (curr-hari (car hari-list)))
  (sdl:with-init ()
    (sdl:window 600 480 :title-caption "Ito")
    (sdl:clear-display sdl:*black*)
    (sdl:enable-key-repeat 1 1)
    (sdl:initialise-default-font (get-font))
    (sdl:with-events ()
      (:quit-event () t)
      (:key-down-event ()
        (decf (y ito-pos) (1+ hari-speed)))
      (:idle ()
	(sdl:clear-display sdl:*black*)
	(sdl-gfx:draw-circle-* (x ito-pos) (y ito-pos) 3 :color sdl:*white*)
	(sdl-gfx:draw-string-solid-* (format nil "Score: ~A" score) 400 30)
	(loop for hari in hari-list
		do
		(sdl-gfx:draw-box-* (x hari) (- (y hari) 10)
				    5
				    (- 480 (y hari) 10) :color sdl:*white*)
		(sdl-gfx:draw-box-* (x hari) (y hari) 5 (- (y2 hari) (y hari))
		 :color sdl:*blue*))
	(incf (y ito-pos) hari-speed)
	(loop for hari in hari-list
		do
		(decf (x hari) hari-speed))
	(when (= (x curr-hari) 300)
	  (if (not (collision-p ito-pos curr-hari))
		(sdl:push-quit-event)
		(progn (push (gen-random-hari 480) hari-list)
			(incf score 5)
			(setf hari-speed (1+ (truncate score 30)))
			(setf curr-hari (car hari-list)))))
        (sdl:update-display))))))

Touch the numbers

(ql:quickload :lispbuilder-sdl)
(ql:quickload :lispbuilder-sdl-gfx)
(ql:quickload :lispbuilder-sdl-ttf)

(defun iota (num)
 (loop for n from 1 upto num
	collect n))

(defun random-map ()
 (let ((num-list (iota 25))
       (game-map (make-array '(5 5))))
  (loop for y from 0 upto 4
	do
	(loop for x from 0 upto 4
		do
		(let ((item (nth (if (= 1 (length num-list))
					0
					(random (length num-list))) num-list)))
		  (setf (aref game-map y x) (cons item nil))
			(setf num-list (remove item num-list)))))
	game-map))

(defvar *font-path* "/usr/share/fonts/truetype/sazanami/sazanami-mincho.ttf")
(defvar *font-size* 30)

(defun get-font (size)
  (make-instance 'sdl:ttf-font-definition
                 :size size
                 :filename (sdl:create-path *font-path*)))

(defparameter *btn-size* 100)

(defun game-end-p (map)
  (loop for y from 0 upto 4
       always
       (loop for x from 0 upto 4
	    always (cdr (aref map y x)))))


(defun display-map (map)
  (loop for y from 0 upto 4
       do
       (loop
	  for x from 0 upto 4
	  for btn = (aref map y x)
	  if (null (cdr btn))
	  do
	    (sdl:draw-box-*
	     (+ 5 (* *btn-size* x))
	     (+ 5 (* *btn-size* y)) (- *btn-size* 5)
	     (-  *btn-size* 5)
	     :color sdl:*blue*)
	  else
	  do
	    (sdl:draw-box-*
	     (+ 5 (* *btn-size* x))
	     (+ 5 (* *btn-size* y)) (- *btn-size* 5)
	     (-  *btn-size* 5)
	     :color sdl:*red*)
	  do
	    (sdl:draw-string-solid-*
	     (format nil "~D" (car (aref map y x)))
	     (+ 30 (* *btn-size* x))
	     (+ 30 (* *btn-size* y))
	     :color sdl:*white*))))

(defun sec-to-time-string (sec)
  (let ((minutes (truncate sec 60))
	(rest-sec (mod sec 60)))
    (format nil "~D:~2,'0,,D" minutes rest-sec)))

(defun numclick ()
  (let ((my-map (random-map))
	(start-time (get-universal-time))
	(end-time)
	(curr-num 0))
    (sdl:with-init ()
      (sdl:window (+ 5 (* *btn-size* 5))
		  (+ 5 (* *btn-size* 5))
		  :title-caption "Num Click")
      (sdl:clear-display sdl:*black*)
      (sdl:initialise-default-font (get-font 30))
      (sdl:with-events ()
	(:quit-event () t)
	(:mouse-button-down-event (:x mouse-x :y mouse-y)
	    (let* ((btn-x (truncate mouse-x *btn-size*))
		   (btn-y (truncate mouse-y *btn-size*))
		   (btn-num (car (aref my-map btn-y btn-x))))
	      (when (= (1+ curr-num) btn-num)
		(incf curr-num)
		(setf (cdr (aref my-map btn-y btn-x)) t))))
	(:idle ()
	       (sdl:clear-display sdl:*black*)
	       (display-map my-map)
	       (when (and (null end-time) (game-end-p my-map))
		 (setf end-time (get-universal-time)))
	       (when (not (null end-time))
		 (sdl:with-font (f (get-font 50))
		   (sdl:draw-string-solid-* (sec-to-time-string (- end-time start-time))
					    30 250
					    :font f)))
	       (sdl:update-display))))))