323 lines
11 KiB
Racket
323 lines
11 KiB
Racket
#lang racket/gui
|
|
|
|
(require "../main.rkt"
|
|
racket/runtime-path
|
|
racket/gui
|
|
simple-ini/class
|
|
racket/string
|
|
net/url
|
|
)
|
|
|
|
(provide
|
|
(all-from-out racket/gui)
|
|
example-1-window%
|
|
)
|
|
|
|
(define ww-debug displayln)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Example 1
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-runtime-path html-start "example-1.html")
|
|
(define-runtime-path dialog-html "example-1-dialog.html")
|
|
(define-runtime-path cur-dir ".")
|
|
|
|
#|
|
|
(define test-menu (menu 'main-menu
|
|
(menu-item 'm-file "File"
|
|
#:submenu
|
|
(menu (menu-item 'm-open "Open File")
|
|
(menu-item 'm-close "Close File")
|
|
(menu-item 'm-select-dir "Select Folder" #:separator #t)
|
|
(menu-item 'm-quit "Quit" #:separator #t)))
|
|
(menu-item 'm-edit "Edit"
|
|
#:submenu
|
|
(menu (menu-item 'm-copy "Copy")
|
|
(menu-item 'm-cut "Cut")
|
|
(menu-item 'm-paste "Paste")
|
|
(menu-item 'm-prefs "Preferences" #:separator #t)
|
|
))
|
|
(menu-item 'm-auto "Processes"
|
|
#:submenu
|
|
(menu (menu-item 'm-start "Start counter")
|
|
(menu-item 'm-sub "Submenu"
|
|
#:submenu
|
|
(menu (menu-item 'm-sub1 "Submenu 1")
|
|
(menu-item 'm-sub2 "Submenu 2")
|
|
(menu-item 'm-sub3 "Submenu 3")
|
|
)
|
|
)
|
|
(menu-item 'm-stop "Stop counter")
|
|
)
|
|
)
|
|
))
|
|
|#
|
|
|
|
(define example-1-dialog%
|
|
(class wv-dialog%
|
|
(inherit-field settings)
|
|
(super-new [html-path "example-1-dialog.html"]
|
|
)
|
|
|
|
(define/override (page-loaded oke)
|
|
(super page-loaded oke)
|
|
|
|
;(ww-debug "html-loaded for example-1-dialog%")
|
|
(send this bind! 'ok-btn 'click (λ (el evt data)
|
|
(send this close)))
|
|
|
|
(let* ((inp1 (send this element 'inp1 'text))
|
|
(inp2 (send this element 'inp2 'text))
|
|
(inp3 (send this element 'inp3 'text)))
|
|
(send inp1 set! (send settings get 'inp1 "<input 1 not set yet>"))
|
|
(send inp2 set! (send settings get 'inp2 "<input 2 not set yet>"))
|
|
(send inp3 set! (send settings get 'inp3 "<input 3 not set yet>"))
|
|
(send this bind! 'inp1 'change (λ (el evt data)
|
|
(displayln (format "~a ~a ~a" el evt data))
|
|
(displayln (format "get = ~a" (send el get)))
|
|
(send settings set! 'inp1 (send el get))))
|
|
(send this bind! 'inp2 'change (λ (el evt data) (send settings set! 'inp2 (send el get))))
|
|
(send this bind! 'inp3 'change (λ (el evt data) (send settings set! 'inp3 (send el get))))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(define-syntax inc
|
|
(syntax-rules ()
|
|
((_ var)
|
|
(λ ()
|
|
(set! var (+ var 1))
|
|
var))))
|
|
|
|
(define example-1-window%
|
|
(class wv-window%
|
|
|
|
(inherit-field settings wv-context)
|
|
(super-new [html-path "example-1.html"]
|
|
)
|
|
|
|
(define my-page 'first)
|
|
(define has-page #f)
|
|
(define go-on-counter #f)
|
|
(define c-counter 0)
|
|
(define counter-inc 1)
|
|
(define counter-thread #f)
|
|
(define div-counter #f)
|
|
(define my-dir (send settings get/global 'folder "."))
|
|
|
|
|
|
(define/override (can-close?)
|
|
(unless (eq? counter-thread #f)
|
|
(send this message 'warning "Cannot close window"
|
|
"Cannot close this window while the counter runs"))
|
|
(eq? counter-thread #f))
|
|
|
|
(define start-stop-btn #f)
|
|
|
|
(define/public (stop-counter)
|
|
(when (and (eq? my-page 'first)
|
|
has-page)
|
|
(send start-stop-btn set-innerHTML! "Start Counter")
|
|
)
|
|
(set! go-on-counter #f)
|
|
(set! counter-thread #f)
|
|
)
|
|
|
|
(define/public (reset-counter)
|
|
(stop-counter)
|
|
(set! c-counter 0)
|
|
)
|
|
|
|
(define/public (inc-counter)
|
|
(set! c-counter (+ c-counter counter-inc))
|
|
(when (>= c-counter 1000)
|
|
(set! counter-inc -1))
|
|
(when (<= c-counter 0)
|
|
(set! counter-inc 1))
|
|
(send this update-counter))
|
|
|
|
(define/public (update-counter)
|
|
(when (and (eq? my-page 'first) has-page)
|
|
(send div-counter set-innerHTML! (format "Count = ~a" c-counter))
|
|
(when (and (> c-counter 0) (<= c-counter 100))
|
|
(send div-counter set-style!
|
|
'((background white) (color blue))))
|
|
(when (and (> c-counter 100) (<= c-counter 200))
|
|
(send div-counter set-style!
|
|
'((background green) (color white))))
|
|
(when (and (> c-counter 200) (<= c-counter 300))
|
|
(send div-counter set-style!
|
|
'((background yellow) (color black) (font-size: 120%))))
|
|
(when (and (> c-counter 300) (<= c-counter 400))
|
|
(send div-counter set-style!
|
|
'((color white) (background orange) (font-size 110%))))
|
|
(when (and (> c-counter 400))
|
|
(send div-counter set-style!
|
|
'((color white) (background red) (font-size 120%) (font-weight bold))))
|
|
)
|
|
)
|
|
|
|
(define/public (start-counter)
|
|
(when (and (eq? my-page 'first) has-page)
|
|
(displayln "start-counter innerhtml")
|
|
(send start-stop-btn set-innerHTML! "Stop Counter"))
|
|
(set! counter-thread
|
|
(thread
|
|
(λ ()
|
|
(letrec ((f (λ ()
|
|
(when go-on-counter
|
|
(send this inc-counter)
|
|
(sleep 0.01)
|
|
(f)))))
|
|
(set! go-on-counter #t)
|
|
(f)))))
|
|
)
|
|
|
|
(define/public (set-folder new-dir)
|
|
(set! my-dir new-dir)
|
|
(send settings set/global! 'folder new-dir)
|
|
(when (and (eq? my-page 'first) has-page)
|
|
(let ((el (send this element 'folder)))
|
|
(displayln "set-folder innerhtml")
|
|
(send el set-innerHTML! (format "Selected folder: <b>~a</b>" my-dir))
|
|
)
|
|
)
|
|
)
|
|
|
|
(define/public (choose-dir*)
|
|
(let ((result (send this choose-dir "Select a folder" my-dir)))
|
|
(unless (eq? result 'showing)
|
|
(displayln (format "choosen dir handle: ~a" result))
|
|
(unless (eq? result #f)
|
|
(send this set-folder result))
|
|
)
|
|
)
|
|
)
|
|
|
|
(define/public (prefs)
|
|
;(stop-counter)
|
|
;(set! go-on-counter #f)
|
|
(new example-1-dialog%
|
|
[parent this]
|
|
)
|
|
) ; (send this clone-settings 'example-1-dialog)]))
|
|
|
|
(define/override (navigation-request type url)
|
|
(displayln url)
|
|
|
|
(when (eq? my-page 'first)
|
|
(send this reset-counter)
|
|
(displayln "counter reset")
|
|
)
|
|
|
|
(if (string-suffix? (url->string url) "example-1-second.html")
|
|
(set! my-page 'second)
|
|
(set! my-page 'first))
|
|
|
|
(super navigation-request type url)
|
|
|
|
(displayln "Super called")
|
|
)
|
|
|
|
(define/override (page-loaded oke)
|
|
(ww-debug (format "HTML LOADED ~a" oke))
|
|
(set! has-page oke)
|
|
(super page-loaded oke)
|
|
(displayln "super called")
|
|
(unless (eq? oke #f)
|
|
|
|
(displayln "Hi")
|
|
(set! div-counter (send this element 'div-counter))
|
|
(displayln "Hi1")
|
|
(send this update-counter)
|
|
(send this set-folder my-dir)
|
|
|
|
(ww-debug "CONNECTING BUTTONS")
|
|
(send this bind! 'dialog-button 'click (λ (el evt data)
|
|
(send this prefs)))
|
|
|
|
(set! start-stop-btn (send this element 'start-stop-button))
|
|
(send this bind! 'start-stop-button 'click
|
|
(λ (el evt data)
|
|
(if (eq? counter-thread #f)
|
|
(begin
|
|
(send this start-counter)
|
|
)
|
|
(begin
|
|
(send this reset-counter)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(send this bind! 'devtools 'click
|
|
(λ (el evt data) (send this devtools)))
|
|
|
|
(send this bind! 'select-dir-button 'click
|
|
(λ (el evt data)
|
|
(send this choose-dir*)))
|
|
)
|
|
(displayln "page-loaded done")
|
|
)
|
|
|
|
;(ww-debug "SETTING MENU")
|
|
#|(let* ((div-open (send this element 'div-open))
|
|
(c-open 0)
|
|
(div-close (send this element 'div-close))
|
|
(c-close 0)
|
|
(div-copy (send this element 'div-copy))
|
|
(c-copy 0)
|
|
(div-cut (send this element 'div-cut))
|
|
(c-cut 0)
|
|
(div-paste (send this element 'div-paste))
|
|
(c-paste 0)
|
|
)
|
|
|
|
(send this set-menu! test-menu)
|
|
(send this connect-menu! 'm-quit
|
|
(λ ()
|
|
(send this reset-counter)
|
|
(send this close))
|
|
)
|
|
(let ((make-menu-executor (λ (item elem string count)
|
|
(send this connect-menu! item
|
|
(λ ()
|
|
(send elem set-inner-html! (format "~a ~a" string (count)))))))
|
|
)
|
|
(make-menu-executor 'm-open div-open "Open file" (inc c-open))
|
|
(make-menu-executor 'm-close div-close "Close file" (inc c-close))
|
|
(make-menu-executor 'm-copy div-copy "Edit Copy" (inc c-copy))
|
|
(make-menu-executor 'm-cut div-cut "Edit Cut" (inc c-cut))
|
|
(make-menu-executor 'm-paste div-paste "Edit Paste" (inc c-paste))
|
|
|
|
(send this connect-menu! 'm-start
|
|
(λ () (send this start-counter)))
|
|
|
|
(send this connect-menu! 'm-stop
|
|
(λ () (send this reset-counter)))
|
|
|
|
(send this connect-menu! 'm-prefs
|
|
(λ () (send this prefs)))
|
|
|
|
(send this connect-menu! 'm-select-dir
|
|
(λ () (send this choose-dir)))
|
|
|
|
)
|
|
)|#
|
|
|
|
(begin
|
|
(displayln "Yes this works!")
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (run-example)
|
|
(let* ((ini (new ini% [file 'web-racket-example1]))
|
|
(context (new wv-context% [base-path cur-dir] [ini ini]))
|
|
(window (new example-1-window%
|
|
[wv-context context]))
|
|
)
|
|
window))
|