gistfile1.scm

#lang racket/gui 
;list with nought's moves ((1 1)(2 2)(3 3)(4 4))
(define noughts '())
(define (addNewNought x y)
  (set! noughts (append noughts (list (append (cons x '()) 
                                              (cons y '())))))) 

;list with cross's moves
(define crosses '())
(define (addNewCross x y)
  (set! crosses (append crosses (list (append (cons x '()) 
                                              (cons y '())))))) 

;draw crosses and noughts after refresh (need for refresh after change window size)
(define (re-drawNoughts L)
  (if (null? L) null
      (begin
        (drawNought (caar L) (cadar L))
        (re-drawNoughts (cdr L)))))

(define (re-drawCrosses L)
  (if (null? L) null
      (begin
        (drawCross (caar L) (cadar L))
        (re-drawCrosses (cdr L)))))


;check avability to move 
;ex. L = '((80 80)(12 12)(2 2)(1 1)) subL = (1 1) 
(define (sublist? L subL)
  (if (null? L) #f
      (if (equal? (car L) subL)
          #t
          (sublist? (cdr L) subL))))
;(sublist? '((12 12) (12 80) (80 80)) '(12 80))



;init button
(define my-button%
  (class button%
    (init-field [callback (lambda (btn event) (void))])
    (super-new [callback (lambda (btn event) (callback btn event))])))

;prepare the main window
(define game-canvas%
  (class canvas%
    (inherit get-width get-height refresh)   
    (define/private (my-paint-callback self dc)
      (let ([w (get-width)]
            [h (get-height)])
        (re-drawNoughts noughts)
        (re-drawCrosses crosses)
        ;draw grid
        (define (fill-field i j)
          (if (> i (send this get-height))
              (if (> j (send this get-width))
                  null
                  (begin
                    (send dc draw-line j 0 j (send this get-height))
                    
                    (fill-field i (+ j 24))))
              (begin
                (send dc draw-line 0 i (send this get-width) i)
                (fill-field (+ i 24) j))))
        (fill-field 0 0)))    
    
    ;define click left mouse button handler
    (define/override (on-event e)
      (when (equal? (send e get-event-type) 'left-down) (on-mouse-proc e)))
    (super-new (paint-callback (lambda (c dc) (my-paint-callback c dc))))))

;define game-frame
(define game-frame (new frame% (label "Noughts and crosses") (width 240) (height 295)))

;define game-canvas
(define game-canvas (new game-canvas% (parent game-frame)))

;define button frame, coordinates and label
(define btn (new my-button%                                    
                 [parent       game-frame]                                    
                 [label        "New game"]                                    
                 [vert-margin  0]	                                     
                 [horiz-margin 0]))

;define button action
(define (btn-event btn event) 
  (set! noughts '())
  (set! crosses '())
  (set! playMode #t)
  (send game-canvas refresh))

;я не знаю что это
(set-field! callback btn btn-event)

;show window with canvas
(send game-frame show #t)

;access to game-canvas drawing context
(define dc (send game-canvas get-dc)) 

;draw noughts
(define (drawNought x y)
  ;x y - centr coordinate
  (send dc draw-ellipse (- x 10) (- y 10) 21 21))

;draw crosses
(define (drawCross x y)
  ;x y - centr coordinate
  (send dc draw-line (- x 10) (- y 10) (+ x 10) (+ y 10))
  (send dc draw-line (+ x 10) (- y 10) (- x 10) (+ y 10)))

;determinate coordinates for nought or cross
(define (getNewC i x);init i=24
  (if (<= x i) (- i 12)
      (getNewC (+ i 24) x)))

;some flag for defines the current player #t - Noughts #f - Crosses
(define current #t)

;some flag determine game state #f - view mode (can not move)
(define playMode #t)

;next move actions
(define (on-mouse-proc e)
  (nextDraw (send e get-x) (send e get-y)))

(define (nextDraw x y)
  (checkAndDraw (getNewC 24 x) (getNewC 24 y) current))

(define (checkAndDraw x y nought)
  (if (and (availabilityToMove x y) playMode)
      (if nought
          (makeNoughtMove x y) 
          (makeCrossMove x y))
      (display "Нельзя ставить\n")))

(define (availabilityToMove x y)
  (and (not (sublist? noughts (getPair x y))) (not (sublist? crosses (getPair x y))))) 

(define (getPair x y)
  (append (cons x '())
          (cons y '())))

(define (makeNoughtMove x y)
  (set! current #f)
  (drawNought x y)
  (addNewNought x y)
  (winCheck x y noughts))

(define (makeCrossMove x y)
  (set! current #t)
  (drawCross x y)
  (addNewCross x y)
  (winCheck x y crosses)) 

;winning check
(define (winCheck x y L)
  (define vertWin (+ (checkWinHelp x y 1 L 0 -24)
                     (checkWinHelp x y 0 L 0 24)))
  (define gorWin (+ (checkWinHelp x y 1 L -24 0) 
                     (checkWinHelp x y 0 L 24 0)))
  (define mainDiag (+ (checkWinHelp x y 1 L 24 24) 
                     (checkWinHelp x y 0 L -24 -24)))
  (define dopDiag (+ (checkWinHelp x y 1 L 24 -24) 
                     (checkWinHelp x y 0 L -24 24)))
  (if (or (> vertWin 4) (> gorWin 4) (> mainDiag 4) (> dopDiag 4))
      (begin 
        (set! playMode #f)
        (if current
            (message-box "Congratulations!" "Crosses Win" game-frame)
            (message-box "Congratulations!" "Noughts Win" game-frame)))
        null))

(define (checkWinHelp x y points L xf yf)
  (if (> points 4) 
      5
      (if (sublist? L (getPair (+ x xf) (+ y yf)))
          (checkWinHelp (+ x xf) (+ y yf) (+ points  1) L xf yf)
          points)))