suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cocoa: flip vertical slider direction

Browse Source
This commit is contained in:
Matthew Flatt 2011-03-10 18:37:43 -06:00
parent a5a7076fe0
commit 2ba8927ba5
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mred/private/wx/cocoa/slider.rkt
View File

@ -46,12 +46,15 @@
(define vert? (memq 'vertical style)) (define vert? (memq 'vertical style))
(define slider-lo lo)
(define slider-hi hi)
(define slider-cocoa (define slider-cocoa
(let ([cocoa (as-objc-allocation (let ([cocoa (as-objc-allocation
(tell (tell MySlider alloc) init))]) (tell (tell MySlider alloc) init))])
(tellv cocoa setMinValue: #:type _double* lo) (tellv cocoa setMinValue: #:type _double* lo)
(tellv cocoa setMaxValue: #:type _double* hi) (tellv cocoa setMaxValue: #:type _double* hi)
(tellv cocoa setDoubleValue: #:type _double* val) (tellv cocoa setDoubleValue: #:type _double* (flip val))
;; heuristic: show up to tick marks: ;; heuristic: show up to tick marks:
(when ((- hi lo) . < . 64) (when ((- hi lo) . < . 64)
(tellv cocoa setNumberOfTickMarks: #:type _NSUInteger (add1 (- hi lo))) (tellv cocoa setNumberOfTickMarks: #:type _NSUInteger (add1 (- hi lo)))
@ -148,13 +151,17 @@
[event-type 'slider] [event-type 'slider]
[time-stamp (current-milliseconds)]))) [time-stamp (current-milliseconds)])))
(define/private (flip v)
(if vert?
(+ slider-lo (- slider-hi v))
v))
(define/public (set-value v) (define/public (set-value v)
(atomically (atomically
(tellv slider-cocoa setDoubleValue: #:type _double* v) (tellv slider-cocoa setDoubleValue: #:type _double* (flip v))
(update-message v))) (update-message v)))
(define/public (get-value) (define/public (get-value)
(inexact->exact (floor (tell #:type _double slider-cocoa doubleValue)))) (flip (inexact->exact (floor (tell #:type _double slider-cocoa doubleValue)))))
(define/public (update-message [val (get-value)]) (define/public (update-message [val (get-value)])
(tellv message-cocoa setTitleWithMnemonic: #:type _NSString (format "~a" val))) (tellv message-cocoa setTitleWithMnemonic: #:type _NSString (format "~a" val)))