#lang s-exp "../moby-lang.ss"
(define-struct player (time in-byo-yomi? periods))
(define TIME-DELTA (/ 1 5))
(define-struct world (black white turn running?))
(define (make-initial-world)
(make-world
(make-player (seconds->milliseconds 30) false 5)
(make-player (seconds->milliseconds 30) false 5)
'black
true false))
(define (update-player-time p t)
(make-player t
(player-in-byo-yomi? p)
(player-periods p)))
(define (tick w)
(cond
[(world-running? w)
(make-world (cond [(symbol=? (world-turn w) 'black)
(tick-player (world-black w))]
[(symbol=? (world-turn w) 'white)
(world-black w)])
(cond [(symbol=? (world-turn w) 'black)
(world-white w)]
[(symbol=? (world-turn w) 'white)
(tick-player (world-white w))])
(world-turn w)
(world-running? w))]
[else
w]))
(define (tick-player p)
(cond [(<= (- (player-time p)
(seconds->milliseconds TIME-DELTA))
0)
(cond [(player-in-byo-yomi? p)
(cond [(> (player-periods p) 0)
(make-player
BYO-YOMI-MILLISECONDS
(player-in-byo-yomi? p)
(sub1 (player-periods p)))]
[else
(make-player 0 true 0)])]
[else
(make-player BYO-YOMI-MILLISECONDS
true
(sub1 (player-periods p)))])]
[else
(update-player-time
p
(max 0
(- (player-time p)
(seconds->milliseconds TIME-DELTA))))]))
(define (game-over? w)
(or (player-loses? (world-black w))
(player-loses? (world-white w))))
(define (player-loses? p)
(and (= (player-time p) 0)
(player-in-byo-yomi? p)
(= (player-periods p) 0)))
(define (player-plays p)
(cond
[(player-in-byo-yomi? p)
(update-player-time p
BYO-YOMI-MILLISECONDS)]
[else
p]))
(define (someone-plays w)
(cond
[(symbol=? (world-turn w) 'black)
(make-world (player-plays (world-black w))
(world-white w)
'white
(world-running? w))]
[(symbol=? (world-turn w) 'white)
(make-world (world-black w)
(player-plays (world-white w))
'black
(world-running? w))]))
(define (minutes->seconds m)
(* m 60))
(define (seconds->milliseconds s)
(* s 1000))
(define (minutes->milliseconds m)
(seconds->milliseconds (minutes->seconds m)))
(define (milliseconds->seconds m)
(/ m 1000))
(define BYO-YOMI-MILLISECONDS
(seconds->milliseconds 10))
(define (time-string time)
(local [(define (pad s)
(cond
[(= (string-length s) 1)
(string-append "0" s)]
[else
s]))]
(format "~a:~a"
(quotient (floor
(milliseconds->seconds time))
60)
(pad
(number->string
(remainder
(ceiling (milliseconds->seconds time))
60))))))
(define (player-display p name)
(list (js-div '(("class" "player-display")))
(list (js-div '(("class" "player-name")))
(list (js-text name)))
(list (js-div '(("class" "player-periods")))
(list (js-text (format "Periods: ~a"
(player-periods p)))))
(list (js-div '(("class" "player-time")))
(list (js-text (time-string
(player-time p)))))
(cons (js-div '(("class" "player-time-up")))
(cond [(<= (player-time p) 0)
(list (list (js-text "Time's up!")))]
[else
empty]))))
(define (on-your-turn turn updater)
(lambda (w)
(cond
[(symbol=? (world-turn w) turn)
(updater w)]
[else
w])))
(define BLACK-BUTTON
(js-button (on-your-turn 'black
someone-plays)
'(("class" "play-button"))))
(define WHITE-BUTTON
(js-button (on-your-turn 'white
someone-plays)
'(("class" "play-button"))))
(define MAIN-DIV
(js-div '(("id" "main"))))
(define WHITE-SIDE-DIV
(js-div '(("id" "white-side"))))
(define WHITE-SIDE-CONTENT-DIV
(js-div '(("id" "white-side-content"))))
(define BLACK-SIDE-DIV
(js-div '(("id" "black-side"))))
(define (draw w)
(list MAIN-DIV
(list WHITE-SIDE-DIV
(list WHITE-BUTTON
(list WHITE-SIDE-CONTENT-DIV
(player-display (world-white w)
"white"))))
(list BLACK-SIDE-DIV
(list BLACK-BUTTON
(player-display (world-black w)
"black")))))
(define (pick-player-background w turn)
(cond
[(symbol=? turn (world-turn w))
"red"]
[else
"gray"]))
(define (draw-css w)
(list '("main" ("border-style" "solid")
("width" "100%")
("height" "100%"))
'(".player-display" ("text-align" "center"))
'(".player-name" ("font-size" "60px"))
'(".player-periods" ("font-size" "60px"))
'(".player-time" ("font-size" "150px"))
'(".player-time-up" ("font-size" "150px")
("color" "red"))
'(".play-button" ("width" "100%")
("height" "100%"))
(list "black-side"
'("border-style" "solid")
'("width" "100%")
'("height" "49%")
(list "border-color"
(pick-player-background w 'black))
'("border-width" "20px"))
(list "white-side"
'("border-style" "solid")
'("width" "100%")
'("height" "49%")
(list "border-color"
(pick-player-background w 'white))
'("border-width" "20px"))
(list "white-side-content"
'("-webkit-transform" "rotate(180deg)")
'("-moz-transform" "rotate(180deg)"))))
(define (key w k)
(cond
[(key=? k "space")
(someone-plays w)]
[else
w]))
(js-big-bang (make-initial-world)
(on-tick TIME-DELTA tick)
(on-key key)
(on-draw draw draw-css)
(stop-when game-over?))