Last active
August 22, 2016 03:54
-
-
Save VitoVan/d15c2c346d61910afad874ee82ff614e to your computer and use it in GitHub Desktop.
Chrome dino-ai(in-progress)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defpackage #:dino-ai | |
(:use #:common-lisp #:cl-autogui) | |
(:export #:dino-jump | |
#:dino-play)) | |
(in-package #:dino-ai) | |
(defvar *f5-key* 71) | |
(defvar *space-key* 65) | |
(defvar *down-key* 116) | |
(defparameter *scan-interval* 1/60) | |
;; game over text position (position of 'G' and 'R') | |
(defvar *game-over-points* '((385 175) (480 220) (575 173))) | |
;; dino on the ground | |
(defvar *dino-stand-points* '((207 238) (242 223))) | |
;; dino get-down | |
(defvar *dino-down-points* '((209 240) (262 243))) | |
;; the block search squre (x y weight height) | |
(defvar *block-search-squre* '(265 220 500 35)) | |
;; Position to click (focus the game) | |
(defvar *mouse-focus-point* '(190 150)) | |
;; the y of middle flying bird | |
(defvar *middle-bird-y* 220) | |
(defun first-pixel->color (snap-data) | |
(funcall | |
#'(lambda (data) (mapcar | |
#'(lambda (i) (aref data 0 0 i)) | |
'(0 1 2 3))) | |
snap-data)) | |
(defun points-exists? (points | |
&key color (test #'(lambda (a b) (not (equal a b))))) | |
(let* ((all-points | |
(if color | |
points | |
(push '(50 150) points))) | |
(all-colors | |
(apply #'x-getcolor all-points)) | |
(base-color (or color (pop all-colors))) | |
(other-colors all-colors)) | |
(every #'identity (mapcar #'(lambda (c) (funcall test base-color c)) other-colors)))) | |
(defun game-over? () | |
(points-exists? *game-over-points*)) | |
(defun find-block () | |
"find properties of the first block in front of dino, (x y)" | |
(let* ((x (first *block-search-squre*)) | |
(y (second *block-search-squre*)) | |
(w (third *block-search-squre*)) | |
(h (fourth *block-search-squre*)) | |
(snap-data (x-snapshot :x x :y y :width w :height h)) | |
(first-color (first-pixel->color snap-data))) | |
(x-snapsearch first-color :x x :y y :width w :height h | |
:test #'(lambda (a b) (not (equal a b))) | |
:snap-data snap-data))) | |
(defun dino-jump () | |
;;(format t "Jump?~%") | |
(let ((stand? (points-exists? *dino-stand-points*)) | |
(down? (points-exists? *dino-down-points*))) | |
(if (or stand? down?) ; only jump if dino is on the ground. | |
(progn (x-key-up *down-key*) | |
(x-press *space-key*) | |
(sleep 0.1)); let the dino fly~ | |
;;(format t "NO JUMP, tg: ~S stand:~S down:~S ~%" time-gap stand? down?) | |
))) | |
(defun dino-down () | |
(when (points-exists? *dino-stand-points*) ; only get-down if dino is on the ground. | |
(x-key-down *down-key*))) | |
(defparameter *distance-stack* nil) | |
(defun dino-restart () | |
;; move to dino and click | |
(setf *distance-stack* nil) | |
(x-click :x (car *mouse-focus-point*) :y (cadr *mouse-focus-point*)) | |
(sleep 1) | |
(x-press *f5-key*) | |
(sleep 1) | |
(x-press *space-key*) | |
;; move away, annoying mouse | |
(x-move (- (car *mouse-focus-point*) 150) (cadr *mouse-focus-point*))) | |
(defun find-gap (predicate lst &key (test #'>)) | |
(if (or | |
(null lst) | |
(null (cdr lst)) | |
(not (funcall predicate (car lst))) | |
(not (funcall predicate (cadr lst)))) | |
-1 | |
(if (funcall test (car lst) (cadr lst)) | |
1 | |
(1+ (find-gap predicate (cdr lst) :test test))))) | |
(defun chunk-list (predicate lst &key (test #'>)) | |
(labels ((rec (lst acc) | |
(let* ((n (find-gap predicate lst :test test)) | |
(rest (when (not (equal -1 n)) (nthcdr n lst)))) | |
(if (and (consp rest) (not (zerop n))) | |
(rec rest (cons (subseq lst 0 n) acc)) | |
(nreverse (cons lst acc)))))) | |
(if lst (rec lst nil) nil))) | |
(defun map-a/b (fn lst) | |
(if (cdr lst) | |
(cons (funcall fn (car lst) (cadr lst)) | |
(when (cddr lst) (map-a/b fn (cdr lst)))) | |
nil)) | |
;; (mapcar #'(lambda (dists) (round (/ (apply #'+ dists) (length dists)))) (chunk-list *distance-stack*)) | |
(defun avg-speed () | |
"px per second" | |
(when (< (length *distance-stack*) 2) (return-from avg-speed 1)) | |
;; cut *distance-stack*, only save recent 100 values, for memory good. | |
(when (> (length *distance-stack*) 1000) | |
(setf *distance-stack* (subseq *distance-stack* 0 1000))) | |
(let ((block-dist-group (chunk-list #'numberp *distance-stack*))) | |
;;(format t "Dist-Group-Sizes: ~S ~%" (mapcar #'length dist-group)) | |
(labels ((cal-avg (lst) | |
(if (> (length lst) 0) | |
(/ (apply #'+ lst) (length lst)) | |
0)) | |
(cal-speed (dist-list) | |
(cal-avg (map-a/b | |
#'(lambda (a b) (/ (- b a) *scan-interval*)) | |
dist-list)))) | |
(round | |
(cal-avg | |
(mapcar #'cal-speed block-dist-group)))))) | |
(defun cal-jump-distance (&key (speed (avg-speed))) | |
(format t "SPEED: ~S~%" speed) | |
(round (* 90 (expt (/ speed 400) 1)))) | |
(defun jump? (distance speed) | |
(when (and (numberp distance) (numberp speed) (not (zerop speed))) | |
(<= (/ distance speed) 0.1))) | |
(defun dino-play () | |
"Awesome! http://imgur.com/kjRnw5G" | |
(dino-restart) | |
(loop | |
(when (game-over?) (return)) | |
(let* ((block-position (find-block)) | |
(block-distance (when block-position | |
(- (car block-position) (first *block-search-squre*)))) | |
(block-y (cadr block-position)) | |
(speed (avg-speed)) | |
(should-jump (jump? block-distance speed))) | |
(when block-distance (push block-distance *distance-stack*)) | |
(format t "DS: ~S SJ: ~S SPD: ~S BY: ~S~%" block-distance should-jump speed block-y) | |
(cond | |
((null block-position) nil) | |
((= 220 block-y) (dino-down)) | |
((= block-distance 0) nil) | |
(should-jump (dino-jump)))) | |
(sleep *scan-interval*))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment