Last active
October 20, 2018 01:10
-
-
Save alex-hhh/4b534a8f5633a4ee65a605822a85dfe3 to your computer and use it in GitHub Desktop.
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
#lang racket/gui | |
(define chess-piece-snip-class | |
(make-object | |
(class snip-class% | |
(super-new) | |
(send this set-classname "chess-piece-snip")))) | |
(send (get-the-snip-class-list) add chess-piece-snip-class) | |
(define chess-piece% | |
(class snip% | |
(init-field glyph font size) | |
(super-new) | |
(send this set-snipclass chess-piece-snip-class) | |
(define/override (get-extent dc x y width height descent space lspace rspace) | |
(when width (set-box! width size)) | |
(when height (set-box! height size)) | |
(when descent (set-box! descent 0.0)) | |
(when space (set-box! space 0.0)) | |
(when lspace (set-box! lspace 0.0)) | |
(when rspace (set-box! rspace 0.0))) | |
(define/override (draw dc x y . other) | |
(send dc set-font font) | |
(send dc set-text-foreground "black") | |
(define-values (glyph-width glyph-height baseline extra-space) | |
(send dc get-text-extent glyph font #t)) | |
(let ((ox (/ (- size glyph-width) 2)) | |
(oy (/ (- size glyph-height 2)))) | |
(send dc draw-text glyph (+ x ox) (+ y oy)))) | |
)) | |
(define chess-piece-data | |
(hash | |
"K" #\u2654 "Q" #\u2655 "R" #\u2656 "B" #\u2657 "N" #\u2658 "P" #\u2659 | |
"k" #\u265A "q" #\u265B "r" #\u265C "b" #\u265D "n" #\u265E "p" #\u265F)) | |
(define (make-chess-piece id) | |
(define glyph (hash-ref chess-piece-data id)) | |
(define font (send the-font-list find-or-create-font 20 'default 'normal 'normal)) | |
(new chess-piece% [glyph (string glyph)] [font font] [size 35])) | |
;; A test program for our chess-piece% objects: | |
;; The pasteboard% that will hold and manage the chess pieces | |
(define board (new pasteboard%)) | |
;; Toplevel window for our application | |
(define toplevel (new frame% [label "Chess Board"] [width (* 50 8)] [height (* 50 8)])) | |
;; The canvas which will display the pasteboard contents | |
(define canvas (new editor-canvas% | |
[parent toplevel] | |
[style '(no-hscroll no-vscroll)] | |
[horizontal-inset 0] | |
[vertical-inset 0] | |
[editor board])) | |
(send toplevel show #t) | |
;; Insert one of each of the chess pieces onto the board, so we can see them | |
;; and drag them around. | |
(for ([id (in-hash-keys chess-piece-data)]) | |
(define piece (make-chess-piece id)) | |
(send board insert piece (random (* 50 6)) (random (* 50 6)))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment