[plt-scheme] Layout and grids with MrEd?

 From: Jens Axel Søgaard (jensaxel at soegaard.net) Date: Fri Apr 21 20:03:53 EDT 2006 Previous message: [plt-scheme] Layout and grids with MrEd? Next message: [plt-scheme] Layout and grids with MrEd? Messages sorted by: [date] [thread] [subject] [author]

```Danny Yoo wrote:
> Hi everyone,

>
> I'm starting to write a tutorial on MrEd.  (My motivating way to learn
> something new is to try to explain it).
>
> But I'm running into some awkward code that I want to fix before posting
> this to the Schematics Cookbook.  It involves writing a grid% class to
> practice with simple geometry management:

I can't figure out whether you can use the rearrangement code from
this little game of fifteen or not - but nevetheless here it is:

;;;
;;; The game of FIFTEEN
;;;

;; Remember to choose a language including MrEd.

;;
;; HELPERS
;;

; interval: integer integer -> list-of-integers
;   produces a list of the integers in the interval from m to n
(define (interval m n)
(if (> m n)
(list)
(cons m (interval (+ m 1) n))))

; id: alpha -> alpha
(define id (lambda x x))

;;;
;;; MODEL
;;;

; The 16 fields of the board holds the numbers from 1 to 15 and a blank.
(define board (vector 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 'blank))

; contents : integer -> integer or symbol
;   returns the number on the field
(define (contents field)
(vector-ref board field))

; contents! : integer -> void
;   changes the contents of a field to new-contents
(define (contents! field new-contents)
(vector-set! board field new-contents))

; swap : integer integer -> void
;   swap the contents of two fields
(define (swap field1 field2)
(let ([contents1 (vector-ref board field1)])
(contents! field1 (contents field2))
(contents! field2 contents1)))

(define (distance field1 field2)
(let ([x (lambda (field) (remainder field 4))]
[y (lambda (field) (quotient field 4))])
(+ (abs (- (x field1) (x field2)))
(abs (- (y field1) (y field2))))))

(define (legal? field1 field2)
(= (distance field1 field2) 1))

(define (push field1 field2)
(if (legal? field1 field2)
(swap field1 field2)))

; field-of-blank : void -> number
;   return the number of the blank field
(define (field-of-blank)
(letrec ([loop (lambda (n l)
(if (equal? (car l) 'blank)
n
(loop (+ n 1) (cdr l))))])
(loop 0 (vector->list board))))

(define (scramble n)
(if (> n 0)
(let ([f1 (random 16)]
[f2 (random 16)])
(if #t ; TODO: is the permutation even?
(swap f1 f2))
(scramble (sub1 n)))))

(scramble 100)

;;;
;;; VIEW
;;;

; A GUI consists of a frame.
; A frame can hold controls.
; Buttons and messages are controls.

;; a frame is created and shown
(define frame (make-object frame% "Femtenspillet"))
(send frame show #t)

(define (make-explanation text)
(make-object message% text frame))

(make-explanation "Your job is to arrange the numbers")
(make-explanation "as 1, 2, 3, ...")
(make-explanation "")
(make-explanation "Swap the numbers until they are ordered.")
(make-explanation "")

; we want to make a grid of buttons each representing a field

;   b1  b2  b3  b4
;   b5  b6  b7  bf8
;   b9  b10 b11 b12
;   b13 b14 b15 bblank

; and at all time we need to know where the blank one is
(define blank-button #f)

(define (make-button number panel)
(let ([button (make-object button%
(number->string
(if (symbol? (contents number))
-1 (contents number)) )
panel
; on-click callback-procedure
(lambda (button event)
(let ([prev-number-of-blank (field-of-blank)])
; update the model
(push prev-number-of-blank number)
; update the view
(if (legal? prev-number-of-blank number)
(begin
(update-field button number)
(update-field blank-button
prev-number-of-blank)
; remember the blank one
(set! blank-button   button)
(send frame refresh))))))])
(if (equal? (contents number) 'blank)
(begin
(send button show #f)
(set! blank-button button)))
button))

(define (update-field button number)
(let ([contents (contents number)])
(if (equal? contents 'blank)
(begin
(send button show #f))
(begin
(send button set-label (number->string contents))
(send button show #t)))))

; the buttons of the board are put in a panel

(define board-panel (make-object vertical-panel% frame ))
(send board-panel set-alignment 'center 'center)
(send board-panel stretchable-width #f)
(send board-panel stretchable-height #f)

; each row of buttons are put in a horizontal panel
(define (make-horizontal-panel far)
(let ([panel (make-object horizontal-panel% far )])
(send panel set-alignment 'center 'center)
(send panel stretchable-width #f)
(send panel stretchable-height #f)
panel))

(define panel1 (make-horizontal-panel board-panel))
(define panel2 (make-horizontal-panel board-panel))
(define panel3 (make-horizontal-panel board-panel))
(define panel4 (make-horizontal-panel board-panel))

; now we make the buttons

(make-button 0 panel1)
(make-button 1 panel1)
(make-button 2 panel1)
(make-button 3 panel1)

(make-button 4 panel2)
(make-button 5 panel2)
(make-button 6 panel2)
(make-button 7 panel2)

(make-button 8  panel3)
(make-button 9  panel3)
(make-button 10 panel3)
(make-button 11 panel3)

(make-button 12 panel4)
(make-button 13 panel4)
(make-button 14 panel4)
(make-button 15 panel4)

; from now we need to adjust the alignment and sizing
; of the buttons

(define (align-center sub-areas)
(map (lambda (sub-area)
(send sub-area set-alignment 'center 'center)
sub-area)
sub-areas))

(define (traverse container combine process)
(let* ([result 0]
[filter (lambda (sub-areas)
(set! result (apply combine (map process sub-areas)))
sub-areas)])
(send container change-children filter)
result))

(define (max-width-of-children container)
(traverse container max (lambda (c)
(send c get-width))))

(max-width-of-children board-panel)

(define (max-height-of-children container)
(traverse container max (lambda (c)
(send c get-height))))

(define (map-grid container f)
(traverse container list (lambda (c)
(traverse c list f))))

(define (squarify container)
(let* ([max-width  (traverse container max max-width-of-children)]
[max-height (traverse container max max-height-of-children)]
[size       (max max-width max-height)])
(map-grid container (lambda (c)
(send c min-width size)
(send c min-height size)))))

; comment this line out to see what happens with no alignment
; and resizing
(squarify board-panel)

--
Jens Axel Søgaard

```

 Posted on the users mailing list. Previous message: [plt-scheme] Layout and grids with MrEd? Next message: [plt-scheme] Layout and grids with MrEd? Messages sorted by: [date] [thread] [subject] [author]