cdkk/project.rkt at master · oplS17projects/cdkk · GitHub

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
#lang racket


(require mutt)
(require csv-reading)
(require net/url)
(require xml)
(require html)
(require (prefix-in htdp: htdp/gui))
(require (prefix-in goo: racket/gui))


(define (get-stock-values stksymbol)
  (map cadr (cdadr (csv->sxml (pcdata-string (car (read-html-as-xml (get-pure-port (string->url (string-append "http://download.finance.yahoo.com/d/quotes.csv?s=" stksymbol "&f=bop"))))))))))


(define (make-stock-list)
  (let ((stocklst (list))
        (stocksend #f)
        (lastsend (current-seconds)))
    (lambda (command . opt)
      (cond [(eq? command 'add_stock) (set! stocklst (append stocklst (list (cons (first opt) (get-stock-values (first opt))))))]
            [(eq? command 'remove_stock) (set! stocklst (remove (first opt) stocklst (lambda (x y) (equal? x (car y)))))]
            [(eq? command 'toggle_send) (if stocksend (set! stocksend #f) (set! stocksend #t))]
            [(eq? command 'send?) stocksend]
            [(eq? command 'get_list)  stocklst]))))

(define stock_list (make-stock-list))

(define (make-stock symbolname)
  (let ((stocksymbol symbolname)
        (stockvals (get-stock-values symbolname)))
        (lambda (command)
          (cond [(eq? command 'symbol) stocksymbol]
                [(eq? command 'open) (cadr stockvals)]
                [(eq? command 'close) (car stockvals)]
                [(eq? command 'send) (send-txt stocksymbol)]))))


;(define (add_stock a) (begin (print "as") #t))
;(define (remove_stock a)  (begin  (print "stock") #t))
;(define (view_open a) (begin  (print "view_open") (htdp:draw-message i "<print open price>") #t))
;(define (view_purchase a)  (begin  (print "view_purchase") (htdp:draw-message i "<print current price>") #t))
;(define (view_close a)  (begin (print "close") (htdp:draw-message i "<print close price>") #t))
;(define (set_auto a)  (begin (print "set_auto") #t))
;(define (send a)  (begin (print "sent") #t))
(define (nothing a) #t)


(define (add_stock a)
  (begin (stock_list 'add_stock (htdp:text-contents text_box)) #t))
(define (remove_stock a)
  (begin (stock_list 'remove_stock (htdp:text-contents text_box)) #t))
(define (view_purchase a)
  (begin (htdp:draw-message i (first (get-stock-values (htdp:text-contents text_box)))) #t))
(define (view_open a)
  (begin (htdp:draw-message i (second (get-stock-values (htdp:text-contents text_box)))) #t))
(define (view_close a)
  (begin (htdp:draw-message i (third (get-stock-values (htdp:text-contents text_box)))) #t))
(define (send a)
  (begin (send-txt (htdp:text-contents text_box)) #t))
(define (set_auto a)
  (begin (stock_list 'toggle_send) #t))
(define (set_config a)
  (begin (write-to-file (string-append (htdp:text-contents conf) (index->prov (htdp:choice-index prov))) "./config.txt" #:exists 'replace) #t))
(define (index->prov idx) (cond ((= idx 0) "@txt.att.net")
                                ((= idx 1) "@tmomail.net")
                                ((= idx 2) "@vtext.com")
                                ((= idx 3) "@pm.sprint.com")
                                ((= idx 4) "@vmobl.com")))

(define a (htdp:make-button "Add Stock" add_stock))
(define b (htdp:make-button "Remove Stock" remove_stock))
(define c (htdp:make-button "View Purchase" view_purchase))
(define d (htdp:make-button "View Open" view_open))
(define e (htdp:make-button "View Close" view_close))
(define f (htdp:make-button "Send" send))
(define g (htdp:make-button "Auto Send" set_auto))
(define h (htdp:make-text "STOCK SYMB"))
(define i (htdp:make-button " " nothing))
(define j (htdp:make-text "Notify when stock changes by:"))
(define conf (htdp:make-text "PHONE#"))
(define prov (htdp:make-choice (list "ATT" "T-Mobile" "Verizon" "Sprint" "Virgin")))
(define set_conf (htdp:make-button "Set" set_config))

(htdp:create-window  (list (list conf)(list prov)(list set_conf)(list h) (list g j) (list a b f) (list c d e) (list i)))


(define text_box h)
(define (check_stocks)
  (if (stock_list 'send?) (map (lambda (x) (if
                                            (> (first (get-stock-values (first x)))
                                               (* (second (first (member
                                                                  (first x)
                                                                  (stock_list 'get_list)
                                                                  (lambda (findval listval) (equal? findval (first listval))))))
                                                  1.1)) (send-txt (first x)) 0)) (stock_list 'get_list)) 0))

(define timeguy (new goo:timer% [notify-callback check_stocks]
                                [interval 1000]
                                [just-once? #f]))

(define (send-txt txtm)
  (mutt (string-join(get-stock-values txtm))
      #:to (string-join (file->lines "./config.txt"))
      #:subject txtm))