#lang racket (require 2htdp/image) (require 2htdp/universe) (require test-engine/racket-tests) ;;Zustände: ;; 1. w=(wait ("X" "X" "X" "O" "O" "O" "X" "X" "X")) - Abwarten ;; 2. w=(play ("X" "X" "X" "O" "O" "O" "X" "X" "X")) - An der Reihe ;; 3. w=(won ("X" "X" "X" "O" "O" "O" "X" "X" "X")) - Gewonnen ;; 4. w=(lost ("X" "X" "X" "O" "O" "O" "X" "X" "X")) - Verloren ;; 4. w=(remis ("X" "X" "X" "O" "O" "O" "X" "X" "X")) - Unentschieden ;;Startzustand (define WORLD0 (list 'wait (make-list 9 ""))) ;;Falls ein korrekter Weltzustand empfangen wird ;; --> setze die Welt auf die empfangene Nachricht ;;sonst: verharre im alten Weltzustand (define (receive w m) (if (and (list? m) (= (length m) 2) (symbol? (first m)) (list? (second m)) (= (length (second m)) 9)) m w)) ;;Zeichnen einer Welt ;;Hilfsfunktionen (define field (rectangle 50 50 "outline" "grey")) (define new_game_text (above(text "Für ein neues Spiel" 16 'black) (text "bitte klicken" 16 'black))) (define (fields->images xs) (map (lambda (c) (overlay (text c 20 'black) field)) xs)) ;;Eigentliches Zeichen (define (draw name) (lambda (w) (cond ;;Won [(equal? (car w) 'won) (above (text "Gewonnen" 22 'green) new_game_text)] ;;Lost [(equal? (car w) 'lost) (above (text "Verloren" 22 'red) new_game_text)] ;;Remis [(equal? (car w) 'remis) (above (text "Remis" 22 'blue) new_game_text)] ;;Sonst wird normal gespielt [else (let ((board_fields (fields->images (second w)))) (above (beside (first board_fields) (second board_fields) (third board_fields)) (beside (fourth board_fields) (fifth board_fields) (sixth board_fields)) (beside (seventh board_fields) (eighth board_fields) (ninth board_fields)) (if (equal? (car w) 'wait) (text "warte auf Gegner..." 16 'red) (text "bitte Zelle markieren!" 16 'green))) )]))) ;;Maus-Interaktionen (define (handle-mouse name) (lambda (w x_pos y_pos mouse_event) (if(mouse=? mouse_event "button-up") (if (or (equal? (car w) 'won) (equal? (car w) 'lost) (equal? (car w) 'remis)) (make-package w 'restart) (let* ((column (quotient x_pos 50)) (row (quotient y_pos 50)) (index (+ (* 3 row) column))) (if (< -1 index 9) (make-package w (list 'set index)) w))) w))) ;;Erstelle eine Welt und verbinde sie mit dem LOCALHOST Server (define (create-world n) (big-bang WORLD0 (on-receive receive) (to-draw (draw n)) (on-mouse (handle-mouse n)) (name n) (state #t) (register LOCALHOST))) ;;Macht zwei Welten auf (launch-many-worlds (create-world "X") (create-world "O") (create-world "B"))