#lang scheme/gui
(require net/sendurl
"mreddesigner-misc.ss"
)
(define/provide (help-online-help)
(send-url "http://mred-designer.origo.ethz.ch/wiki/doc"))
(define/provide (help-mred-help)
(send-url "http://docs.plt-scheme.org/gui/Windowing_Classes.html"))
(define (mail-to user-list domain-list)
(apply string-append
"mailto:"
(append (add-between user-list ".")
(list "@")
(add-between domain-list "."))))
(provide help-about-dialog)
(define (help-about-dialog)
(let* ((dialog (new dialog%
(label (string-append "About " application-name "..."))
(parent #f)
(width 510)
(height 259)))
(vertical-pane (new vertical-pane% (parent dialog) (border 5)))
(canvas (new canvas%
(parent vertical-pane)
(style '(border))
(min-width 510)
(min-height 259)
(paint-callback
(lambda (canvas dc)
(let
((k-logo (make-object bitmap% (build-path "images" "about.png") 'png #f))
(k-font (make-object font% 11 'system 'normal 'light #f 'smoothed #t))
)
(send dc draw-bitmap k-logo 0 0 'solid (make-object color% 0 0 0) #f)
(send dc set-font k-font)
(send dc draw-text (string-append " - Version " application-version) 354 183)
(send dc draw-text "(C) Jean-Pierre Lozi, 2004" 41 200)
(send dc draw-text "(C) Peter Ivanyi, 2007, 2008" 41 220)
(send dc draw-text "(C) Laurent Orseau, 2010" 41 240)
)
)
)
)
)
(message1 (new message% (label "This software is distributed under the terms of the General Public License (GPL),") (parent vertical-pane)))
(message2 (new message% (label "either version 2 of the license, or (at your option) any later version.") (parent vertical-pane)))
(horizontal-pane (new horizontal-panel% (parent vertical-pane) (alignment '(center center))))
(button (new button% (label "Contact...") (min-width 166)(parent horizontal-pane)
(callback (lambda (button control-event)
(send-url (mail-to
'("laurent" "orseau")
'("gmail" "com"))
)))))
(button (new button% (label "Website...") (min-width 166)(parent horizontal-pane)
(callback (lambda (button control-event)
(send-url "http://mred-designer.origo.ethz.ch")))))
(button (new button% (label "Close") (min-width 166)(parent horizontal-pane)
(callback (lambda (button control-event)
(send dialog show #f))))))
(send dialog center)
(send dialog show #t)))