164 lines
3.6 KiB
Racket
164 lines
3.6 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/class
|
|
racket/list
|
|
"../../misc/utils.rkt")
|
|
|
|
(provide renderer%
|
|
renderer-preferences%)
|
|
|
|
(define renderer-preferences%
|
|
(class object%
|
|
(init-field settings)
|
|
|
|
(define cfg
|
|
(send settings clone 'renderers))
|
|
|
|
(define/private (stored)
|
|
(send cfg get
|
|
'volume-curves
|
|
'()))
|
|
|
|
(define/public (get-volume-curve id)
|
|
(let ((entry
|
|
(assoc id
|
|
(stored)
|
|
equal?)))
|
|
(if entry
|
|
(cadr entry)
|
|
'linear)))
|
|
|
|
(define/public (set-volume-curve! id curve)
|
|
(check/c renderer-preferences%
|
|
set-volume-curve!
|
|
curve
|
|
(or/c 'linear
|
|
'logarithmic))
|
|
(let ((without-id
|
|
(filter
|
|
(lambda (entry)
|
|
(not
|
|
(equal? (car entry)
|
|
id)))
|
|
(stored))))
|
|
(send cfg
|
|
set!
|
|
'volume-curves
|
|
(cons (list id curve)
|
|
without-id))))
|
|
|
|
(super-new)))
|
|
|
|
(module+ test
|
|
(require rackunit)
|
|
|
|
(define values (make-hash))
|
|
(define test-settings%
|
|
(class object%
|
|
(define/public (clone name)
|
|
(void name)
|
|
this)
|
|
(define/public (get name default)
|
|
(hash-ref values name default))
|
|
(define/public (set! name value)
|
|
(hash-set! values name value))
|
|
(super-new)))
|
|
|
|
(define preferences
|
|
(new renderer-preferences%
|
|
[settings (new test-settings%)]))
|
|
(define renderer
|
|
(new renderer%
|
|
[id "renderer-id"]
|
|
[name "Renderer"]
|
|
[kind 'test]
|
|
[device 'device]
|
|
[preferences preferences]))
|
|
|
|
(check-= (send renderer
|
|
logical-volume->device
|
|
25)
|
|
25
|
|
0.001)
|
|
(send renderer
|
|
set-volume-curve!
|
|
'logarithmic)
|
|
(check-eq? (send renderer get-volume-curve)
|
|
'logarithmic)
|
|
(check-= (send renderer
|
|
logical-volume->device
|
|
50)
|
|
25
|
|
0.001)
|
|
(check-= (send renderer
|
|
device-volume->logical
|
|
25)
|
|
50
|
|
0.001))
|
|
|
|
(define renderer%
|
|
(class object%
|
|
(init-field
|
|
id
|
|
name
|
|
kind
|
|
device
|
|
preferences)
|
|
|
|
(check/c* renderer%
|
|
(id string?)
|
|
(name string?)
|
|
(kind symbol?)
|
|
(preferences
|
|
(is-a?/c renderer-preferences%)))
|
|
|
|
(define/public (get-id)
|
|
id)
|
|
|
|
(define/public (get-name)
|
|
name)
|
|
|
|
(define/public (get-kind)
|
|
kind)
|
|
|
|
(define/public (get-device)
|
|
device)
|
|
|
|
(define/public (get-volume-curve)
|
|
(send preferences
|
|
get-volume-curve
|
|
id))
|
|
|
|
(define/public (set-volume-curve! curve)
|
|
(send preferences
|
|
set-volume-curve!
|
|
id
|
|
curve))
|
|
|
|
(define/private (clamp percentage)
|
|
(min 100.0
|
|
(max 0.0
|
|
percentage)))
|
|
|
|
(define/public (logical-volume->device percentage)
|
|
(let ((value
|
|
(/ (clamp percentage)
|
|
100.0)))
|
|
(* 100.0
|
|
(case (send this get-volume-curve)
|
|
((logarithmic)
|
|
(* value value))
|
|
(else value)))))
|
|
|
|
(define/public (device-volume->logical percentage)
|
|
(let ((value
|
|
(/ (clamp percentage)
|
|
100.0)))
|
|
(* 100.0
|
|
(case (send this get-volume-curve)
|
|
((logarithmic)
|
|
(sqrt value))
|
|
(else value)))))
|
|
|
|
(super-new)))
|