-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathrircc.rkt
198 lines (179 loc) · 6.7 KB
/
rircc.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
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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
#lang racket
(require "ui/curses.rkt")
(require "ui/irc-to.rkt")
(require "ui/curses/window.rkt")
(require "irc/irc.rkt")
(require racket/match)
(require racket/async-channel)
(define to-handlers
(make-hash (list
(cons 'default (new irc-text-object%
[fmt "~a"]))
(cons 'MOTD (new irc-text-object%
[fmt "-!- ~a"]
[mat (lambda (p v)
(regexp-match? #rx#"37[256]" v))]
[app
(lambda (msg)
(list (last (send msg args))))]))
(cons 'HIDDENHOST (new irc-text-object%
[fmt "-!- ~a is now your hidden host"]
[mat (lambda (p v)
(regexp-match? #rx#"396" v))]
[app (lambda (msg)
(list (list-ref (send msg args) 1)))]))
(cons 'PRIVMSGNOTICE (new irc-text-object%
[mat (lambda (p v)
(or (string=? v "PRIVMSG") (string=? v "NOTICE")))]
[fmt "[~a] <~a> ~a"]
[app (lambda (msg)
(let ([hs (new hostmask%
[prefix (send msg prefix)])])
(list
(first (send msg args))
(cond
[(send hs isserver?) (send hs host)]
[else (send hs nick)])
(last (send msg args)))))]))
(cons 'JOIN (new irc-text-object%
[mat (lambda (p v)
(string=? v "JOIN"))]
[fmt "* ~a (~a@~a) -> ~a"]
[app (lambda (msg)
(let ([hs (new hostmask% [prefix (send msg prefix)])])
(list
(send hs nick)
(send hs ident)
(send hs host)
(first (send msg args)))))])))))
(define (irc-output msg)
(last (sort (filter string? (for/list ([kv (hash->list to-handlers)])
(send (cdr kv) parse msg)))
(lambda (x y)
(cond
[(and (string=? (substring x 0 1) ":") (false? (string=? (substring y 0 1) ":"))) #t]
[(and (string=? (substring y 0 1) ":") (false? (string=? (substring x 0 1) ":"))) #f])))))
;; not using mat.
;(define (irc-ouput msg)
; (send (hash-ref to-handlers (string->symbol (send msg verb)) (hash-ref to-handlers 'default)) parse msg))
(define win
(new window-class%
[input-raw #t]
[input-echo #f]
[color #t]))
(define stderr (open-output-file "/dev/stderr" #:exists 'append))
;(keypad win #t)
(init_pair 1 COLOR_BLACK COLOR_RED)
(define x (send win maxx))
(define y (send win maxy))
(define titlewin
(new window-class%
[parent win]
[height 1]
[width x]
[y 0]
[x 0]
[syncup #t]))
(send titlewin attron (COLOR_PAIR 1))
(define displaywin
(new window-class%
[parent win]
[height (- y 2)]
[width x]
[y 1]
[x 0]
[syncup #t]
[scroll #t]))
(define inputwin
(new window-class%
[parent win]
[height 1]
[width x]
[y (- y 1)]
[x 0]
[syncup #t]
[input-timeout 50]))
(void (send titlewin addstr (string-append "rircc" (make-string (- x 6) #\space))))
(send win refresh)
(define s null)
(define running 1)
(define window "")
(define en (new irc%
[host "irc.entropynet.net"]
[port 6697]
[ssl #t]
[nick "AllieRacket"]
[user "Allie"]
[realname "Allie Fox"]))
(define (write_to_curses_format str)
(let ([maxx (send displaywin maxx)])
(let ([chars (string->list str)])
(let ([bold #f])
(let ([_write_formatted_char (lambda (ch)
(match (char->integer ch)
[2 (cond
[(false? bold)
(set! bold #t)
(send displaywin attron A_BOLD)]
[else
(send displaywin attroff A_BOLD)
(set! bold #f)])]
[1 #f]
[13 #f]
[_ (send displaywin addstr (string ch))]))])
(cond
[(> (length chars) maxx)
(map _write_formatted_char (take chars (- maxx 1)))
(send displaywin addstr "\n")
(write_to_curses_format (list->string (list-tail chars (- maxx 1))))]
(else
(map _write_formatted_char chars)
(send displaywin addstr "\n")))))))
(send displaywin attrset A_NORMAL)
#t)
(define (commandparse s)
(let ([str (list->string (filter (lambda (s) (char? s)) (reverse s)))])
(match str
[(pregexp "^/(.*?) (.*)$" (list _ cmd rest)) (match (string-downcase cmd)
["join" (send en join rest)]
["win" (set! window rest)])]
[(pregexp "^/(.*?)$" (list _ cmd)) (match (string-downcase cmd)
["quit" (set! running -1)])]
[_ (cond
[(string=? window "") #f]
[else
(send en msg window str)
(write_to_curses_format (irc-output (new irc-message%
[msg (string-append ":AllieRacket!fake@fake PRIVMSG " window " :" str)])))])])))
(void (write_to_curses_format "\x02helo\x02 helo"))
(void (sync (send en ready?)))
(define ircmsgs (send en hosepipe!))
(let loop ()
(define l (send inputwin getch))
(define raw (async-channel-try-get ircmsgs))
(define msg (match raw
[#f #f]
[_ raw]))
; (display msg
(void (match msg
[#f #f]
[_ (if (string? (irc-output msg)) (write_to_curses_format (format "~a" (irc-output msg))) #f)]))
;[_ (waddstr displaywin (format "bleh ~a\n" msg))])
; (if (> l -1)
; (waddstr displaywin (format "~a\n" l))
; #f)
(match l
[-1 #f]
[(or 263 127) (cond
[(pair? s) (set! s (cdr s))])]
[10 (commandparse s)(set! s null)]
[_ (set! s (cons (integer->char l) s))])
(send inputwin erase)
(send inputwin move (- y 1) 0)
(send inputwin addstr (list->string (filter (lambda (s) (char? s)) (reverse s))))
; refresh our displays, with input last.
(send win refresh)
(if (> running 0)
(loop)
#f))
(void (send win end))