/
webcamimpl.rkt
64 lines (53 loc) · 2.57 KB
/
webcamimpl.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
#lang s-exp "webcamspec.rkt"
;; here we will provide the implementations of the
;; various components defined in the specification file referenced above
;; import the implementations of the available resources from the taxonomy:
(taxonomy "taxo-impl.rkt")
(implement Display ; controller
(lambda (pic screenshow)
(screenshow pic)))
;;(implement IP (lambda () "muahahaha")) ; <- impossible to reimplement taxo items
(implement ProcessPicture ; context
(lambda (_button cameraGetPic publish)
(let* ([pic (cameraGetPic)]
[dc (new bitmap-dc% [bitmap pic])])
; do some fancy processing
(send dc set-pen (make-pen #:width 5))
(send dc set-brush (make-brush #:color (make-color 112 66 20 0.4)))
(send dc draw-rounded-rectangle
5 5 ; x y
116 116) ; w h
; we do check that 'eval gives syntax error
#|
(eval '(begin (require net/http-client)
(define-values (status header response)
(http-sendrecv "www.google.com" "/" #:ssl? 'tls))
(display-line "HTTP status " status ", body= ")
(define (moo inp)
(let ([c (read-char inp)])
(cond ((eof-object? c) (newline))
(else (display c) (moo inp)))))
(moo response))) |#
(publish pic))))
(implement ComposeDisplay
(lambda (pic get-ad-text publish nopublish)
(let* ([canvas (make-bitmap 450 450)]
[adTxt (get-ad-text)]
[dc (new bitmap-dc% [bitmap canvas])])
(cond [(string=? "" adTxt) (nopublish)])
(send dc draw-rectangle
0 10 ; Top-left at (0, 10), 10 pixels down from top-left
350 80) ; width and height
(send dc draw-text adTxt
10 20)
(send dc draw-bitmap pic
10 100) ; superimpose the bmp
(publish canvas))))
;; let's have some ads as well.
(implement MakeAd
(lambda (ip) ; no publish function, because WhenRequired.
(let ([txt (ip)])
(if (string=? txt "") ""
(~a "showing Ad for IP " txt)))))
;;TODO match up with diaspec in paper: that is, camera is publishing
;;device, no Button.