Skip to content

Instantly share code, notes, and snippets.

@alex-hhh
Created January 22, 2020 23:14
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save alex-hhh/eebc1cec17e0fa741fc2cef6b58b6b91 to your computer and use it in GitHub Desktop.
Save alex-hhh/eebc1cec17e0fa741fc2cef6b58b6b91 to your computer and use it in GitHub Desktop.
Snip instances with copy - paste functionality -- note that snips are pasted on top of each other, so you need to drag them around with the mouse to see that they were copied
#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 (copy)
(new chess-piece% [glyph glyph] [font font] [size size]))
(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]))
(define mb (new menu-bar% [parent toplevel]))
(define m-edit (new menu% [label "Edit"] [parent mb]))
(define m-font (new menu% [label "Font"] [parent mb]))
(append-editor-operation-menu-items m-edit #f)
(append-editor-font-menu-items m-font)
(send board set-max-undo-history 100)
(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