Mastermind in scheme. Now with GUI!!

plt scheme has a wide collection of libraries, some bundled with the basic package, and some which have to be installed through PLaneT.

GUI library is from the first group, so if you have plt-scheme already installed (not mzshceme alone, but the complete suite, with drscheme and so) you already have everything you need.

WARNING: It seems there's some programming course in NY with an assignment related to writing a mastermind. If it's your case, please, do not use my code blindly. I'm a novice scheme programmer, and probaly, my code is not very idiomatic. Anyway, have fun.

I've been using the mastermind game as a toy project to learn scheme for the last month. And now, it even has a little GUI. I also have a solver in 5 tries (in the worst case) but I haven't embedded it yet in the GUI.

The process of writing GUIs using plt-scheme is easier than I thought. It's great to write little things (we could say it makes easy things really easy). I don't know how difficult it'd be to write a more complex GUI, for example, I haven't found any grid component. Only comboboxes, radiobuttons, buttons and text-fields.

The good part is that it's really easy to assemble these compoonents in layouts, panels, frames, and so. It's also really easy adding menus to windows.

Here follows a little code that lets you play mastermind, fully coded in scheme.

	#lang scheme/gui
	(define (sum l) (foldl + 0 l))
	(define (solution num max)
	(define (sol num max l)
	(cond ((zero? num) l)
	(else (sol (- num 1) max (cons (random max) l)))))
	(sol num max '()))
	(define max-val 6)
	(define sol (solution 4 max-val))
	;;; returns how many blacks
	(define (blacks l1 l2)
	(define (my-blacks l1 l2 res)
	(cond ((null? l1) res)
	((= (car l1) (car l2)) (my-blacks (cdr l1)
	(cdr l2)
	(+ res 1)))
	(else (my-blacks (cdr l1) (cdr l2) res))))
	(my-blacks l1 l2 0))
	;; counts how many whites should go,
	;; without looking @ positions, so
	;; counting blacks as whites too
	(define (whites l1 l2)
	(define (minim x l1 l2)
	(min (length (filter (lambda (y) (= y x)) l1))
	(length (filter (lambda (y) (= y x)) l2))))
	(define (my-whites l1 l2 res)
	(sum (map (lambda (x) (minim x l1 l2))
	(build-list max-val values))))
	(my-whites l1 l2 0))
	(define (check-sols my-sol l2)
	(let* ((black (blacks my-sol l2))
	(white (- (whites my-sol l2) black)))
	(string-append
	(make-string black #\B)
	(make-string white #\W)
	(make-string (- (length l2) black white) #\. ))))
	(define (check-real l)
	(check-sols l sol))
	; end mm master
	;begin frame
	(define frame (new frame% [label "Mastermind"]))
	(define msg (new message%
	[parent frame]
	[label "No events so far..."]))
	;end frame
	;build menus
	(define menu-bar (new menu-bar% [parent frame]))
	(define file-menu (new menu% [label "&File"] [parent menu-bar]))
	(define help-menu (new menu%
	[label "&Help"]
	[parent menu-bar]
	[help-string "this is a help string"]))
	(new menu-item%
	[label "Cheat"]
	[parent help-menu]
	[callback (lambda (c e) (cheat))])
	(new menu-item%
	[label "About"]
	[parent help-menu]
	[callback (lambda (x y)
	(message-box "About..." "OH HAI!\nraimonster at gmail dot com"))])
	(new menu-item%
	[label "New game"]
	[parent file-menu]
	[callback (lambda (x y) (new-game))])
	;; end menus
	(define (cheat)
	(send msg set-label
	(format "~a" sol)))
	(define (new-game)
	(let [(tmp-sol (solution 4 6))]
	(set! sol tmp-sol)))
	(define my-panel2 (new horizontal-panel% [parent frame]))
	(define (create-combos which-panel n)
	(cond ((zero? n) '())
	(else
	(new choice%
	[label ""]
	[parent which-panel]
	[choices '("0" "1" "2" "3" "4" "5")]
	[callback (lambda (c e)
	(send msg set-label
	(number->string
	(send c
	get-selection))))])
	(create-combos which-panel (- n 1)))))
	(create-combos my-panel2 4)
	(define (output c e)
	(let [(play (map
	(lambda (x) (number->string (send x get-selection)))
	(send my-panel2 get-children)))]
	(write play)
	(send lb
	append
	(format "~a => ~a"
	play
	(check-real
	(map (lambda (x) (string->number x)) play))))))
	(define p3 (new panel% [parent frame]))
	(new button%
	[parent p3]
	[label "try"]
	[callback output])
	(define lb (new list-box%
	[parent frame]
	[label "log"]
	[choices '()]))
	(send frame show #t)

view raw scheme-gui.ss hosted with ❤ by GitHub

Btw, This is (more or less) what I used last wednesday at flibug meeting to show an example of GUIs in plt. I really enjoyed the meeting: Learning, sharing, having fun, and beers :) .There's some more info about the last flibug meeting in my last post.