| 1 | REBOL [
|
|---|
| 2 | Title: "ReKini"
|
|---|
| 3 | File: %rKini.r
|
|---|
| 4 | Authors: "Shadwolf(rkini.r), Oldes(irc client)"
|
|---|
| 5 | Date: 23/05/09
|
|---|
| 6 | Purpose: "IRC Client based on VID"
|
|---|
| 7 | Download: http://my-svn.assembla.com/svn/shadwolforge/
|
|---|
| 8 | Docstrack: { docs, source diff and time tracs available on
|
|---|
| 9 | http://my-trac.assembla.com/shadwolforge/
|
|---|
| 10 | }
|
|---|
| 11 | ]
|
|---|
| 12 |
|
|---|
| 13 | VERSION: "0.1"
|
|---|
| 14 | ;---------
|
|---|
| 15 | ; ---- STYLIZED FACES -----
|
|---|
| 16 | ;--------
|
|---|
| 17 |
|
|---|
| 18 | split-text: func [txt [string!] n [integer!]
|
|---|
| 19 | /local frag fraglet bl frag-rule bs ws
|
|---|
| 20 | ] [ws: charset [#" " #"^-" #"^/"]
|
|---|
| 21 | bs: complement ws
|
|---|
| 22 | bl: copy []
|
|---|
| 23 | frag-rule: [
|
|---|
| 24 | any ws
|
|---|
| 25 | copy frag [
|
|---|
| 26 | [1 n skip
|
|---|
| 27 | opt [copy fraglet some bs]
|
|---|
| 28 | ]
|
|---|
| 29 | | to end skip
|
|---|
| 30 | ]
|
|---|
| 31 | (all [fraglet join frag fraglet]
|
|---|
| 32 | insert tail bl frag
|
|---|
| 33 | ; print frag
|
|---|
| 34 | )
|
|---|
| 35 | ]
|
|---|
| 36 | parse/all txt [some frag-rule]
|
|---|
| 37 | bl
|
|---|
| 38 | ]
|
|---|
| 39 |
|
|---|
| 40 | stylize/master [
|
|---|
| 41 |
|
|---|
| 42 |
|
|---|
| 43 | chat-box: box with [
|
|---|
| 44 | pane: []
|
|---|
| 45 | data: []
|
|---|
| 46 | chan-name: ""
|
|---|
| 47 | xy: 0x0
|
|---|
| 48 | line-length: 0
|
|---|
| 49 | nb-lines: 0 ;nombre de ligne a affich�e
|
|---|
| 50 | font-obj: make face/font [name: "lucida console" size: 14 style: none offset: 0x0]
|
|---|
| 51 | effect: [draw [pen none font font-obj line-width 1 translate xy]]
|
|---|
| 52 | insert-text: func [ msg col][
|
|---|
| 53 | ; graham idea on the matter
|
|---|
| 54 | foreach frag split-text msg line-length [
|
|---|
| 55 | ; we remove as many entries at the head of data that we insert item in data
|
|---|
| 56 | if 500 = length? data [ remove/part data 1 ]
|
|---|
| 57 | ; insertion of the new "line" with the corresponding color
|
|---|
| 58 | insert/only tail data compose [ (frag) (col) ]
|
|---|
| 59 | ]
|
|---|
| 60 | ; call render-text to draw the last X lines to the screen
|
|---|
| 61 | render-text 1
|
|---|
| 62 | ]
|
|---|
| 63 |
|
|---|
| 64 | render-text: func [ inc /stay /local n dt max-line
|
|---|
| 65 | line color test-face sub-line
|
|---|
| 66 |
|
|---|
| 67 | ][
|
|---|
| 68 | ;case [
|
|---|
| 69 | ; stay []
|
|---|
| 70 | ; 0 < inc []
|
|---|
| 71 | ; 0 > inc []
|
|---|
| 72 | ; ]
|
|---|
| 73 | ;probe data
|
|---|
| 74 | ;probe nb-lines
|
|---|
| 75 | ;a: make face [ font: make face/font [name: "lucida console" size: 14 style: none offset: 0x0 ]]
|
|---|
| 76 |
|
|---|
| 77 | decal: 0x0
|
|---|
| 78 | clear effect/draw
|
|---|
| 79 | effect/draw: reduce ['pen none 'font (font-obj) 'line-width 1 'translate (xy)]
|
|---|
| 80 | max-lines: length? data ; on prend le fond du tampon
|
|---|
| 81 | either nb-lines < max-lines [ n: max-lines - nb-lines + 1 ][ n: 1]
|
|---|
| 82 | dt: head data
|
|---|
| 83 | ;color: 255.255.255
|
|---|
| 84 | while [ n <= max-lines] [
|
|---|
| 85 | ;probe data/:n halt
|
|---|
| 86 | line: first data/:n
|
|---|
| 87 | color: second data/:n
|
|---|
| 88 | insert tail effect/draw 'push
|
|---|
| 89 | ;if find line user-conf/nick [ color: 128.128.0 ]
|
|---|
| 90 | ;a/text: line
|
|---|
| 91 | ;if size/x < first size-text a [ print "Shadwolf you need to cut that line !!"]
|
|---|
| 92 | insert/only tail effect/draw reduce [ 'pen (color) 'text (line) (decal) ]
|
|---|
| 93 | decal/y: decal/y + 20
|
|---|
| 94 | n: n + 1
|
|---|
| 95 | ]
|
|---|
| 96 | show self
|
|---|
| 97 | ]
|
|---|
| 98 | append init [
|
|---|
| 99 | nb-lines: size/y / 20
|
|---|
| 100 | line-length: to integer! size/x / 8.5
|
|---|
| 101 | ]
|
|---|
| 102 | ]
|
|---|
| 103 |
|
|---|
| 104 | channel-list-box: box with [
|
|---|
| 105 | ; tree view that allows to swap betwin channels
|
|---|
| 106 | ;content and server notice window
|
|---|
| 107 |
|
|---|
| 108 | ;internal images used to draw the tree
|
|---|
| 109 | root-img: load 64#{
|
|---|
| 110 | Qk2OAAAAAAAAAD4AAAAoAAAADwAAABQAAAABAAEAAAAAAFAAAAAAAAAAAAAAAAAA
|
|---|
| 111 | AAAAAAAAAAAAAP///wD+/gAA/v4AAP7+AAD+/gAA/v4AAP7+AAD+/gAA/n4AAP1+
|
|---|
| 112 | AAD9vgAA+74AAPveAAD33gAA9+4AAO/uAADv5gAA3/YAAMAGAAD//gAA//4AAA==
|
|---|
| 113 | }
|
|---|
| 114 | root-img2: load 64#{
|
|---|
| 115 | Qk2OAAAAAAAAAD4AAAAoAAAADwAAABQAAAABAAEAAAAAAFAAAAAAAAAAAAAAAAAA
|
|---|
| 116 | AAAAAAAAAAAAAP///wD//gAA//4AAP/+AAD//gAA//4AAP/+AAD//gAA//4AAOf+
|
|---|
| 117 | AADp/gAA7n4AAO+eAADv5gAA7/oAAO/yAADvzgAA7z4AAOj+AADj/gAA//4AAA==
|
|---|
| 118 | }
|
|---|
| 119 | leaf-img: load 64#{
|
|---|
| 120 | Qk2OAAAAAAAAAD4AAAAoAAAADwAAABQAAAABAAEAAAAAAFAAAAAAAAAAAAAAAAAA
|
|---|
| 121 | AAAAAAAAAAAAAP///wD+/gAA//4AAP7+AAD+/gAA//4AAP7+AAD+/gAA//4AAP5I
|
|---|
| 122 | AAD+/gAA//4AAP7+AAD+/gAA//4AAP7+AAD+/gAA//4AAP7+AAD+/gAA//4AAA==
|
|---|
| 123 | }
|
|---|
| 124 | leaf-img2: load 64#{
|
|---|
| 125 | Qk2OAAAAAAAAAD4AAAAoAAAADwAAABQAAAABAAEAAAAAAFAAAAAAAAAAAAAAAAAA
|
|---|
| 126 | AAAAAAAAAAAAAP///wD//gAA//4AAP/+AAD//gAA//4AAP/+AAD//gAA//4AAP5I
|
|---|
| 127 | AAD+/gAA//4AAP7+AAD+/gAA//4AAP7+AAD+/gAA//4AAP7+AAD+/gAA//4AAA==
|
|---|
| 128 | }
|
|---|
| 129 | data: []
|
|---|
| 130 | pane: []
|
|---|
| 131 | color: white
|
|---|
| 132 | expand-tree?: false
|
|---|
| 133 | sel-ind: 0 ;index to know what line is selected
|
|---|
| 134 | font-obj: make face/font [name: "lucida console" size: 14 style: none offset: 0x0]
|
|---|
| 135 | effect: [draw [ pen 0.0.0 font font-obj line-width 1 translate 0x0]]
|
|---|
| 136 |
|
|---|
| 137 | ins-entry: func [entry /leaf /local dt ][
|
|---|
| 138 | ;insert/tail data entry
|
|---|
| 139 | either leaf [
|
|---|
| 140 | either 2 = length? data [
|
|---|
| 141 | dt: data/2
|
|---|
| 142 | insert tail dt entry ; we insert a leaf
|
|---|
| 143 | ][
|
|---|
| 144 | ; we create the sub block and we insert the first leaf
|
|---|
| 145 | insert/only tail data reduce [(entry)]
|
|---|
| 146 | ]
|
|---|
| 147 | ][ insert tail data entry ] ; we insert a root
|
|---|
| 148 | render-tree
|
|---|
| 149 | ]
|
|---|
| 150 |
|
|---|
| 151 | render-tree: func [/local n decal decal2 n2 ][
|
|---|
| 152 | decal2: 20x0
|
|---|
| 153 | decal: 0x0
|
|---|
| 154 | clear effect/draw
|
|---|
| 155 | effect/draw: reduce ['pen 0.0.0 'font (font-obj) 'line-width 1 'translate 0x0]
|
|---|
| 156 | n: 1
|
|---|
| 157 | foreach [ root leafs ] data [
|
|---|
| 158 | either expand-tree? [
|
|---|
| 159 | insert tail effect/draw 'push
|
|---|
| 160 | insert/only tail effect/draw reduce [ 'image root-img (decal) 'pen ( either n = sel-ind [ 0.150.0 ][ 0.0.0]) 'text 'anti-aliased (root) (decal2) ]
|
|---|
| 161 | decal/y: decal/y + 20
|
|---|
| 162 | decal2/y: decal2/y + 20
|
|---|
| 163 | n2: 1
|
|---|
| 164 | foreach leaf leafs [
|
|---|
| 165 | n: n + 1
|
|---|
| 166 | insert tail effect/draw 'push
|
|---|
| 167 | either n2 = length? leafs [
|
|---|
| 168 | insert/only tail effect/draw reduce [ 'image leaf-img2 (decal) 'pen ( either n = sel-ind [ 0.150.0 ][ 0.0.0]) 'text 'anti-aliased (leaf) (decal2) ]
|
|---|
| 169 | ][
|
|---|
| 170 | insert/only tail effect/draw reduce [ 'image leaf-img (decal) 'pen ( either n = sel-ind [ 0.150.0 ][ 0.0.0]) 'text 'anti-aliased (leaf) (decal2) ]
|
|---|
| 171 | ]
|
|---|
| 172 | decal/y: decal/y + 20
|
|---|
| 173 | decal2/y: decal2/y + 20
|
|---|
| 174 | n2: n2 + 1
|
|---|
| 175 | ]
|
|---|
| 176 | ][
|
|---|
| 177 | insert tail effect/draw 'push
|
|---|
| 178 | insert/only tail effect/draw reduce [ 'image root-img2 (decal) 'pen ( either n = sel-ind [ 0.150.0 ][ 0.0.0]) 'text 'anti-aliased (root) (decal2) ]
|
|---|
| 179 | ]
|
|---|
| 180 | ]
|
|---|
| 181 | ;probe effect/draw ;dbg purpose ...
|
|---|
| 182 | show self
|
|---|
| 183 | ]
|
|---|
| 184 | feel: make feel [
|
|---|
| 185 |
|
|---|
| 186 | engage: func [f a e /local click-pos laylist-ind ] [
|
|---|
| 187 | switch a [
|
|---|
| 188 | down [
|
|---|
| 189 | click-pos: e/offset
|
|---|
| 190 | either all [ 10 >= click-pos/x 10 >= click-pos/y ][ ; expand / shrink the tree
|
|---|
| 191 | either f/expand-tree? [ f/expand-tree?: false ][f/expand-tree?: true]
|
|---|
| 192 | f/render-tree
|
|---|
| 193 | ][
|
|---|
| 194 | if f/expand-tree? [
|
|---|
| 195 | laylist-ind: to-integer click-pos/y / 20
|
|---|
| 196 | laylist-ind: laylist-ind + 1
|
|---|
| 197 | f/sel-ind: laylist-ind ; store the index to higlight it on the rendering
|
|---|
| 198 | if laylist-ind <= length? lay-list [
|
|---|
| 199 | f/render-tree
|
|---|
| 200 | handle-bx/pane: lay-list/:laylist-ind
|
|---|
| 201 | show handle-bx
|
|---|
| 202 | ]
|
|---|
| 203 | ]
|
|---|
| 204 | ]
|
|---|
| 205 | ]
|
|---|
| 206 | ]
|
|---|
| 207 | ]
|
|---|
| 208 | ]
|
|---|
| 209 | append init [
|
|---|
| 210 |
|
|---|
| 211 | ]
|
|---|
| 212 | ]
|
|---|
| 213 |
|
|---|
| 214 | ]
|
|---|
| 215 |
|
|---|
| 216 |
|
|---|
| 217 |
|
|---|
| 218 | ;---------
|
|---|
| 219 | ; ---- IRC CLIENT FUNCTION -----
|
|---|
| 220 | ;--------
|
|---|
| 221 |
|
|---|
| 222 | user-conf: make object! [
|
|---|
| 223 | nick: make string! 0
|
|---|
| 224 | pwd: make string! 0
|
|---|
| 225 | irc-url: "irc.rezosup.org"
|
|---|
| 226 | irc-port: "6667"
|
|---|
| 227 | joinchannel: make string! 0
|
|---|
| 228 | quit-msg: make string! 0
|
|---|
| 229 | away-msg: make string! 0
|
|---|
| 230 | part-msg: make string! 0
|
|---|
| 231 | memo-serv: "MemoServ"
|
|---|
| 232 | nick-serv: "NickServ"
|
|---|
| 233 | new-user: false ; usage interne non sauvegarder dasn le ficheir de conf
|
|---|
| 234 | connecting-state: false ; false= offline true = online
|
|---|
| 235 | e-mail: make email! 0
|
|---|
| 236 | ]
|
|---|
| 237 |
|
|---|
| 238 | ident-name: botuser: to-string rejoin ["rKini-" VERSION]
|
|---|
| 239 | ;channels: make block! 5
|
|---|
| 240 | tchannel: make object! [
|
|---|
| 241 | name: none ; nom du channel
|
|---|
| 242 | topic: none ; titre du channel
|
|---|
| 243 | mode: none ; mode du channel
|
|---|
| 244 | users: make block! 10 ;list des utilisateurs
|
|---|
| 245 | lay: none ; layout
|
|---|
| 246 | ]
|
|---|
| 247 | l-channel: make block! 1
|
|---|
| 248 |
|
|---|
| 249 | remove-colors?: either system/version/4 = 3 [true][false]
|
|---|
| 250 | ;it's not possible to see colors in the Windows console :(
|
|---|
| 251 | escapechar: charset "^Q^C^A" ;there are probably more of them
|
|---|
| 252 | normalchar: complement escapechar
|
|---|
| 253 | digits: charset "0123456789"
|
|---|
| 254 | space: charset [#" "]
|
|---|
| 255 | non-space: complement space
|
|---|
| 256 | to-space: [some non-space | end]
|
|---|
| 257 | cprint?: true ; for normal printing :)
|
|---|
| 258 | idents: none
|
|---|
| 259 | debug?: false ; for debuging printing ...
|
|---|
| 260 |
|
|---|
| 261 | params: prefix: nick: user: host: servername: none
|
|---|
| 262 |
|
|---|
| 263 | ; enl�ve les couleurs du texte
|
|---|
| 264 | preptxt: func[txt /local tmp][
|
|---|
| 265 | if not remove-colors? [return txt]
|
|---|
| 266 | tmp: make string! 512
|
|---|
| 267 | parse/all txt [any [
|
|---|
| 268 | #"^Q"
|
|---|
| 269 | | #"^A" ;action
|
|---|
| 270 | | #"^C" some digits #"," some digits;on vire les couleurs ;)
|
|---|
| 271 | | copy t some normalchar (insert tail tmp t)
|
|---|
| 272 | ]]
|
|---|
| 273 | tmp
|
|---|
| 274 | ]
|
|---|
| 275 | pad: func[txt c][head insert/dup tail txt " " c - length? txt]
|
|---|
| 276 |
|
|---|
| 277 | ;c la que l'on g�re l'affichage des txt dans la console
|
|---|
| 278 | cprint: func[msg /err /inf /local color lay][
|
|---|
| 279 | color: 0.0.0
|
|---|
| 280 | if block? msg [msg: rejoin msg]
|
|---|
| 281 | either err [color: 175.0.0 insert msg "!!! "][if inf [ color: 0.151.0 msg ]]
|
|---|
| 282 | console?: true
|
|---|
| 283 | ;]
|
|---|
| 284 | either any [inf err ] [
|
|---|
| 285 | lay-list/1/pane/2/insert-text msg color
|
|---|
| 286 | ][
|
|---|
| 287 | ; locate the layout corresponding to the tchannel/name to display the message
|
|---|
| 288 | if 0 < length? lay-list[
|
|---|
| 289 | foreach lay lay-list [
|
|---|
| 290 | if find lay/pane/2/chan-name tchannel/name [
|
|---|
| 291 | lay/pane/2/insert-text msg color
|
|---|
| 292 | show handle-bx
|
|---|
| 293 | break
|
|---|
| 294 | ]
|
|---|
| 295 |
|
|---|
| 296 | ]
|
|---|
| 297 |
|
|---|
| 298 | ]
|
|---|
| 299 | ]
|
|---|
| 300 | ]
|
|---|
| 301 |
|
|---|
| 302 | dprint: func[msg][
|
|---|
| 303 | if debug? [
|
|---|
| 304 | ;if not empty? console/buffer [console/clear-line]
|
|---|
| 305 | print msg
|
|---|
| 306 | ;if not empty? console/buffer [prin console/buffer]
|
|---|
| 307 | ]
|
|---|
| 308 | ]
|
|---|
| 309 |
|
|---|
| 310 | ; bot-error: func[err /local type id arg1 arg2 arg3][
|
|---|
| 311 | ; set [type id arg1 arg2 arg3] reduce [err/type err/id err/arg1 err/arg2 err/arg3]
|
|---|
| 312 | ; cprint/err [
|
|---|
| 313 | ; "Bot-" system/error/:type/type ": "
|
|---|
| 314 | ; reduce bind system/error/:type/:id 'arg1
|
|---|
| 315 | ; ]
|
|---|
| 316 | ; cprint/err ["** Where: " mold err/where]
|
|---|
| 317 | ; cprint/err ["** Near: " mold err/near]
|
|---|
| 318 | ; ]
|
|---|
| 319 | ; envoi des donn�es vers le server
|
|---|
| 320 | irc-port-send: func[msg [block! string!]][
|
|---|
| 321 | msg: either string? msg [msg][rejoin msg]
|
|---|
| 322 | dprint ["IRCOUT: " msg]
|
|---|
| 323 | insert irc-open-port msg
|
|---|
| 324 | ]
|
|---|
| 325 |
|
|---|
| 326 | say: func[txt /to whom /action][
|
|---|
| 327 | if not to [whom: tchannel/name]
|
|---|
| 328 | if block? txt [txt: rejoin txt]
|
|---|
| 329 | txt: parse/all txt "^/"
|
|---|
| 330 | forall txt [
|
|---|
| 331 | irc-port-send either action [
|
|---|
| 332 | ["PRIVMSG " whom " :^AACTION " txt/1 #"^A" ]
|
|---|
| 333 | ][
|
|---|
| 334 | ["PRIVMSG " whom " :" txt/1 ]
|
|---|
| 335 | ]
|
|---|
| 336 | ]
|
|---|
| 337 | ]
|
|---|
| 338 | reply: func[txt /action /local whom][
|
|---|
| 339 | whom: either params/1 = user-conf/nick [nick][params/1]
|
|---|
| 340 | either action [say/action/to txt whom][say/to txt whom]
|
|---|
| 341 | ]
|
|---|
| 342 |
|
|---|
| 343 | chat-rules: [
|
|---|
| 344 | ;add your own rules here:
|
|---|
| 345 | [thru "Rebol" to end][
|
|---|
| 346 | reply/action "is a IRC client coded in REBOL langage"
|
|---|
| 347 | reply "Check out http://www.rebol.com for Rebol related informations"
|
|---|
| 348 | ]
|
|---|
| 349 | ]
|
|---|
| 350 |
|
|---|
| 351 | ; chat-parser: func[msg /local err tmp][
|
|---|
| 352 | ; foreach [rule action] chat-rules [
|
|---|
| 353 | ; if parse/all msg rule [
|
|---|
| 354 | ; if error? err: try [do action][ bot-error disarm err]
|
|---|
| 355 | ; ]
|
|---|
| 356 | ; ]
|
|---|
| 357 | ; ]
|
|---|
| 358 |
|
|---|
| 359 | ; this function is called by irc-parser when the msg JOIN is detected
|
|---|
| 360 | joining-a-chan: func [chan-name /local lay ][
|
|---|
| 361 | insert tail lay-list layout [
|
|---|
| 362 | origin 0x0 space 2x2 below
|
|---|
| 363 | ;chan-name + topic #1
|
|---|
| 364 | text 600x25 black white chan-name font [size: 14 ]
|
|---|
| 365 | ;chat-box #2
|
|---|
| 366 | chat-box 600x400 white
|
|---|
| 367 | ;send-line #3
|
|---|
| 368 | field 600x25 white
|
|---|
| 369 | return
|
|---|
| 370 | ;chan-user-list #4
|
|---|
| 371 | text-list 100x400
|
|---|
| 372 | key #"^M" [
|
|---|
| 373 | either 0 < length? face/parent-face/pane/3/text [
|
|---|
| 374 | textis: face/parent-face/pane/3/text
|
|---|
| 375 | chanis: face/parent-face/pane/2/chan-name
|
|---|
| 376 | either #"/" = textis/1 [
|
|---|
| 377 | remove textis 1
|
|---|
| 378 | irc-port-send textis
|
|---|
| 379 | ][
|
|---|
| 380 | face/parent-face/pane/2/insert-text rejoin [ user-conf/nick "-->" textis ] orange
|
|---|
| 381 | say/to textis chanis
|
|---|
| 382 | ]
|
|---|
| 383 | unfocus face/parent-face/pane/3
|
|---|
| 384 | clear face/parent-face/pane/3/text
|
|---|
| 385 | show face/parent-face/pane/3
|
|---|
| 386 |
|
|---|
| 387 | ][
|
|---|
| 388 | focus face/parent-face/pane/3 show face/parent-face/pane/3
|
|---|
| 389 | ]
|
|---|
| 390 | ]
|
|---|
| 391 | ]
|
|---|
| 392 |
|
|---|
| 393 | lay: last lay-list
|
|---|
| 394 | lay/offset: 0x0
|
|---|
| 395 | lay/pane/2/chan-name: tchannel/name ; store the channel name used as index to locate the corresponding layout
|
|---|
| 396 | handle-bx/pane: lay
|
|---|
| 397 | show handle-bx
|
|---|
| 398 | ]
|
|---|
| 399 |
|
|---|
| 400 | irc-parser: func[msg /local tmp][
|
|---|
| 401 | params: make block! 10
|
|---|
| 402 | prefix: none
|
|---|
| 403 | parse/all msg [
|
|---|
| 404 | opt [#":" copy prefix some non-space some space ]
|
|---|
| 405 | copy command some non-space
|
|---|
| 406 | any [
|
|---|
| 407 | some space #":" copy tmp to end (append params tmp)
|
|---|
| 408 | | some space copy tmp to-space (append params tmp)
|
|---|
| 409 | ]
|
|---|
| 410 | ]
|
|---|
| 411 | nick: user: host: servername: none
|
|---|
| 412 | if not none? prefix [
|
|---|
| 413 | either found? find prefix "@" [
|
|---|
| 414 | set [nick user host] parse prefix "!@"
|
|---|
| 415 | ][ servername: copy prefix]
|
|---|
| 416 | ]
|
|---|
| 417 | dprint msg
|
|---|
| 418 | dprint reform ["PARSED: " mold prefix mold command mold params]
|
|---|
| 419 | switch/default command [
|
|---|
| 420 | "PING" [irc-port-send ["PONG " params]]
|
|---|
| 421 | "JOIN" [
|
|---|
| 422 | tchannel/name: copy first params
|
|---|
| 423 | cprint/inf either nick = user-conf/nick [
|
|---|
| 424 | joining-a-chan tchannel/name
|
|---|
| 425 | chan-lst/ins-entry/leaf tchannel/name
|
|---|
| 426 | ["You have joined channel " tchannel/name]
|
|---|
| 427 | ][
|
|---|
| 428 | insert tchannel/users nick
|
|---|
| 429 | [nick " (" user "@" host ") has joined channel " tchannel/name]
|
|---|
| 430 | ]
|
|---|
| 431 | tchannel/name: " "
|
|---|
| 432 | ]
|
|---|
| 433 | "PART" [
|
|---|
| 434 | tchannel/name: copy first params
|
|---|
| 435 | cprint/inf rejoin [nick " has left channel " params/1]
|
|---|
| 436 | tchannel/name: " "
|
|---|
| 437 | ]
|
|---|
| 438 |
|
|---|
| 439 | "PRIVMSG" [
|
|---|
| 440 | ; preparation tchannel/name
|
|---|
| 441 | tchannel/name: copy first params
|
|---|
| 442 | ;probe tchannel/name
|
|---|
| 443 | cprint rejoin either find params/1 "#" [
|
|---|
| 444 | either "^AACTION" = copy/part params/2 7 [
|
|---|
| 445 | ["["to string! now/time"] " "* " nick skip params/2 7]
|
|---|
| 446 | ][
|
|---|
| 447 | ["["to string! now/time"]" "<" nick "> " params/2 ]
|
|---|
| 448 | ]
|
|---|
| 449 | ][
|
|---|
| 450 | either find params/2 #"^A" [
|
|---|
| 451 | either ctcp-cloack? [
|
|---|
| 452 | [ "*** CTCP request attempt by " nick " blocked (CTCPCloak On)" ] red
|
|---|
| 453 | ][
|
|---|
| 454 | ; Algo emprunt� a botnet de ZeKiller(kiki)
|
|---|
| 455 | ;REPONSE AUX REQUETTES CTCP ajout� le 28/02/03
|
|---|
| 456 | ctcpKW: handle-ctcp-req params/2
|
|---|
| 457 | ; on imprime le message sur la console
|
|---|
| 458 | ["*** CTCP(" ctcpKW ") - request by " nick]
|
|---|
| 459 | ]
|
|---|
| 460 | ][ ["*" nick "* " params/2 ] ]
|
|---|
| 461 | ]
|
|---|
| 462 | ; handler-service-msg nick params/2 ; traitement des msg service
|
|---|
| 463 | ; chat-parser params/2 ; traitement des mg des channels..
|
|---|
| 464 | tchannel/name: " "
|
|---|
| 465 | ]
|
|---|
| 466 | "NOTICE" [
|
|---|
| 467 | either none? nick [cprint/inf params/2][
|
|---|
| 468 | cprint/inf either #"#" = params/1/1 [
|
|---|
| 469 | ["-" nick ":" params/1 "- " params/2]
|
|---|
| 470 | ][
|
|---|
| 471 | ["-" nick "- " params/2]
|
|---|
| 472 | ]
|
|---|
| 473 | ]
|
|---|
| 474 | ; handler-service-msg nick params/2; nick message a passer en vu du declenchement d'une action :)
|
|---|
| 475 | ]
|
|---|
| 476 | "MODE" [
|
|---|
| 477 | if find params "+r" [ identified?: true]; quand le nick est enregistrer :)
|
|---|
| 478 | cprint/inf [
|
|---|
| 479 | {Mode change "} next params {" }
|
|---|
| 480 | either params/1/1 = #"#" ["on channel "]["for user "] params/1 { by } nick
|
|---|
| 481 |
|
|---|
| 482 | ]
|
|---|
| 483 | if tchannel/name = params/1 [tchannel/mode: copy next params]
|
|---|
| 484 | ]
|
|---|
| 485 | "NICK" [
|
|---|
| 486 | cprint/inf either nick = user-conf/nick [
|
|---|
| 487 | user-conf/nick: copy params/1
|
|---|
| 488 | ["You are now known as " params/1]
|
|---|
| 489 | ] [[nick " is now known as " params/1]]
|
|---|
| 490 | ]
|
|---|
| 491 | "QUIT" [
|
|---|
| 492 | cprint/inf [
|
|---|
| 493 | "Signoff: " nick " (" user ") "
|
|---|
| 494 | either find/part params/1 "WinSock error" 13 [params/2][""]
|
|---|
| 495 | ]
|
|---|
| 496 | error? try [remove find tchannel/users nick]
|
|---|
| 497 | ]
|
|---|
| 498 | "INVITE" [
|
|---|
| 499 | cprint/inf [nick " invites you to channel " last params]
|
|---|
| 500 | ]
|
|---|
| 501 | "TOPIC" [
|
|---|
| 502 | tchannel/name: copy first params
|
|---|
| 503 | cprint either nick = user-conf/nick [
|
|---|
| 504 | ["You have changed the topic on channel " params/1 " to " params/2]
|
|---|
| 505 | ][ [nick " has changed the topic on channel " params/1 " to " params/2] ]
|
|---|
| 506 | tchannel/name: " "
|
|---|
| 507 | ]
|
|---|
| 508 | "KICK" [
|
|---|
| 509 | cprint/inf [
|
|---|
| 510 | either user-conf/nick = params/2 ["You have"][rejoin [params/2 " has"]]
|
|---|
| 511 | " been kicked off channel " params/1 " by " nick " (" params/3 ")"
|
|---|
| 512 | ]
|
|---|
| 513 | ]
|
|---|
| 514 | ;errors:
|
|---|
| 515 | "401" [cprint/err [ params/2 " - " params/3]] ;ERR_NOSUCHNICK
|
|---|
| 516 | "402" [cprint/err [ params/2 " - " params/3]] ;ERR_NOSUCHSERVER
|
|---|
| 517 | "403" [cprint/err [ params/2 " - " params/3]] ;ERR_NOSUCHCHANNEL
|
|---|
| 518 | "404" [cprint/err [ params/2 " - " params/3]] ;ERR_CANNOTSENDTOCHAN
|
|---|
| 519 | "405" [cprint/err [ params/2 " - " params/3]] ;ERR_TOOMANYCHANNELS
|
|---|
| 520 | "406" [cprint/err [ params/2 " - " params/3]] ;ERR_WASNOSUCHNICK
|
|---|
| 521 | "407" [cprint/err [ params/2 " - " params/3]] ;ERR_TOOMANYTARGETS
|
|---|
| 522 | "409" [cprint/err [ params/2]] ;ERR_NOORIGIN
|
|---|
| 523 | "411" [cprint/err [ params/2]] ;ERR_NORECIPIENT
|
|---|
| 524 | "412" [cprint/err [ params/2]] ;ERR_NOTEXTTOSEND
|
|---|
| 525 | "413" [cprint/err [ params/2 " - " params/3]] ;ERR_NOTOPLEVEL
|
|---|
| 526 | "414" [cprint/err [ params/2 " - " params/3]] ;ERR_WILDTOPLEVEL
|
|---|
| 527 | "421" [cprint/err [ params/2 " - " params/3]] ;ERR_UNKNOWNCOMMAND
|
|---|
| 528 | "422" [cprint/err [ params/2]] ;ERR_NOMOTD
|
|---|
| 529 | "423" [cprint/err [ params/2 " - " params/3]] ;ERR_NOADMININFO
|
|---|
| 530 | "424" [cprint/err [ params/2]] ;ERR_FILEERROR
|
|---|
| 531 | "431" [cprint/err [ params/2]] ;ERR_NONICKNAMEGIVEN
|
|---|
| 532 | "432" [cprint/err [ params/2 " - " params/3]] ;ERR_ERRONEUSNICKNAME
|
|---|
| 533 | "433" [cprint/err [ params/1 " - " params/2]] ;ERR_NICKNAMEINUSE
|
|---|
| 534 | "436" [cprint/err [ params/2 " - " params/3]] ;ERR_NICKCOLLISION
|
|---|
| 535 | "441" [cprint/err [ params/2 " " params/3 " - " params/4]] ;ERR_USERNOTINCHANNEL
|
|---|
| 536 | "442" [cprint/err [ params/2 " - " params/3]] ;ERR_NOTONCHANNEL
|
|---|
| 537 | "443" [cprint/err [ params/2 " " params/3 " - " params/4]] ;ERR_USERONCHANNEL
|
|---|
| 538 | "444" [cprint/err [ params/2 " - " params/3]] ;ERR_NOLOGIN
|
|---|
| 539 | "445" [cprint/err [ params/2]] ;ERR_SUMMONDISABLED
|
|---|
| 540 | "446" [cprint/err [ params/2]] ;ERR_USERSDISABLED
|
|---|
| 541 | "451" [cprint/err [ params/2]] ;ERR_NOTREGISTERED
|
|---|
| 542 | "461" [cprint/err [ params/2 " - " params/3]] ;ERR_NEEDMOREPARAMS
|
|---|
| 543 | "462" [cprint/err [ params/2]] ;ERR_ALREADYREGISTRED
|
|---|
| 544 | "463" [cprint/err [ params/2]] ;ERR_NOPERMFORHOST
|
|---|
| 545 | "464" [cprint/err [ params/2]] ;ERR_PASSWDMISMATCH
|
|---|
| 546 | "465" [cprint/err [ params/2]] ;ERR_YOUREBANNEDCREEP
|
|---|
| 547 | "467" [cprint/err [ params/2 " - " params/3]] ;ERR_KEYSET
|
|---|
| 548 | "471" [cprint/err [ params/2 " - " params/3]] ;ERR_CHANNELISFULL
|
|---|
| 549 | "472" [cprint/err [ params/2 " - " params/3]] ;ERR_UNKNOWNMODE
|
|---|
| 550 | "473" [cprint/err [ params/2 " - " params/3]] ;ERR_INVITEONLYCHAN
|
|---|
| 551 | "474" [cprint/err [ params/2 " - " params/3]] ;ERR_BANNEDFROMCHAN
|
|---|
| 552 | "475" [cprint/err [ params/2 " - " params/3]] ;ERR_BADCHANNELKEY
|
|---|
| 553 | "481" [cprint/err [ params/2]] ;ERR_NOPRIVILEGES
|
|---|
| 554 | "482" [cprint/err [ params/2 " - " params/3]] ;ERR_CHANOPRIVSNEEDED
|
|---|
| 555 | "483" [cprint/err [ params/2]] ;ERR_CANTKILLSERVER
|
|---|
| 556 | "491" [cprint/err [ params/2]] ;ERR_NOOPERHOST
|
|---|
| 557 | "501" [cprint/err [ params/2]] ;ERR_UMODEUNKNOWNFLAG
|
|---|
| 558 | "502" [cprint/err [ params/2]] ;ERR_USERSDONTMATCH
|
|---|
| 559 | "999" [cprint/err [ params/2]] ;ERR_COMMNOTFOUND
|
|---|
| 560 | ;Command responses:
|
|---|
| 561 | "300" [];RPL_NONE
|
|---|
| 562 | "204" [cprint/inf ["Oper [" params/3 "] ==> " params/4]];RPL_TRACEOPERATOR
|
|---|
| 563 | "211" [cprint/inf next params];RPL_STATSLINKINFO
|
|---|
| 564 | "212" [cprint/inf next params];RPL_STATSCOMMANDS
|
|---|
| 565 | "213" [cprint/inf next params];RPL_STATSCLINE
|
|---|
| 566 | "214" [cprint/inf next params];RPL_STATSNLINE
|
|---|
| 567 | "215" [cprint/inf next params];RPL_STATSILINE
|
|---|
| 568 | "216" [cprint/inf next params];RPL_STATSKLINE
|
|---|
| 569 | "218" [cprint/inf next params];RPL_STATSYLINE
|
|---|
| 570 | "219" [];RPL_ENDOFSTATS
|
|---|
| 571 | "221" [cprint/inf next params];RPL_UMODEIS
|
|---|
| 572 | "205" [cprint/inf ["User [" params/3 "] ==>"]];RPL_TRACEUSER
|
|---|
| 573 | "242" [cprint/inf next params];RPL_STATSUPTIME
|
|---|
| 574 | "243" [cprint/inf next params];RPL_STATSOLINE
|
|---|
| 575 | "244" [cprint/inf next params];RPL_STATSHLINE
|
|---|
| 576 | "250" [cprint/inf params/2] ;RPL_STATSDLINE
|
|---|
| 577 | "251" [cprint/inf params/2 irc-port-send ["JOIN " user-conf/joinchannel] ];RPL_LUSERCLIENT
|
|---|
| 578 | "252" [cprint/inf [params/2 " " params/3]] ;RPL_LUSEROP
|
|---|
| 579 | "253" [cprint/inf [params/2 " " params/3]] ;RPL_LUSERUNKNOWN
|
|---|
| 580 | "254" [cprint/inf [params/2 " " params/3]] ;RPL_LUSERCHANNELS
|
|---|
| 581 | "255" [cprint/inf params/2] ;RPL_LUSERME
|
|---|
| 582 | "256" [cprint/inf [params/2 " - " params/3]] ;RPL_ADMINME
|
|---|
| 583 | "257" [cprint/inf params/2] ;RPL_ADMINLOC1
|
|---|
| 584 | "258" [cprint/inf params/2] ;RPL_ADMINLOC2
|
|---|
| 585 | "259" [cprint/inf params/2] ;RPL_ADMINEMAIL
|
|---|
| 586 | "301" [cprint/inf [params/2 " is away (" params/3 ")"]];RPL_AWAY
|
|---|
| 587 | "303" [cprint/inf either 1 < length? params ["Currently online: " next params]["Nobody is online"]];RPL_ISON
|
|---|
| 588 | "305" [cprint/inf reform next params]
|
|---|
| 589 | "306" [cprint/inf reform next params]
|
|---|
| 590 | "311" [cprint/inf [params/2 " is " params/3 "@" params/4 " (" last params ")"]];RPL_WHOISUSER
|
|---|
| 591 | "312" [cprint/inf ["on irc via server " params/3 " (" params/4 ")"]];RPL_WHOISSERVER
|
|---|
| 592 | "313" [cprint/inf [params/2 " is " params/3]];RPL_WHOISOPERATOR
|
|---|
| 593 | "315" [update-state params/2 ];RPL_ENDOFWHO
|
|---|
| 594 | "317" [;use [t][
|
|---|
| 595 | ;t: to-time params/3
|
|---|
| 596 | cprint/inf [params/2 " has been idle: " to-time to-integer params/3]
|
|---|
| 597 | cprint/inf [params/2 " is online since: " 1-1-1970/0:0:0 + to-time to-integer params/4]
|
|---|
| 598 | ];];RPL_WHOISIDLE
|
|---|
| 599 | "318" [];RPL_ENDOFWHOIS
|
|---|
| 600 | "319" [cprint/inf rejoin ["on channels: " mold parse last params ""]] ;RPL_WHOISCHANNELS
|
|---|
| 601 |
|
|---|
| 602 | "321" [cprint/inf "Channel Users Topic" ];RPL_LISTSTART
|
|---|
| 603 | "322" [cprint/inf [pad params/2 11 pad params/3 7 params/4]];RPL_LIST
|
|---|
| 604 | "323" [];RPL_LISTEND
|
|---|
| 605 | "331" [cprint/inf reform next params];RPL_NOTOPIC
|
|---|
| 606 | "332" [tchannel/name: copy second params
|
|---|
| 607 | cprint/inf ["Topic for " params/2 ": " params/3]
|
|---|
| 608 | ;locate layout corresponding in the lay-list
|
|---|
| 609 | foreach lay lay-list [
|
|---|
| 610 | if find lay/pane/2/chan-name tchannel/name [
|
|---|
| 611 | lay/pane/1/text: params/3 show lay/pane/1
|
|---|
| 612 | break
|
|---|
| 613 | ]
|
|---|
| 614 | ]
|
|---|
| 615 | tchannel/name: " "
|
|---|
| 616 | ];RPL_TOPIC
|
|---|
| 617 | "341" [cprint/inf ["Inviting " params/2 " to channel " params/3]];RPL_INVITING
|
|---|
| 618 | "351" [cprint/inf ["Server " params/3 ": " params/2 " " params/4]];RPL_VERSION
|
|---|
| 619 | "352" [cprint/inf [
|
|---|
| 620 | pad params/2 11
|
|---|
| 621 | pad params/3 10
|
|---|
| 622 | pad params/7 4
|
|---|
| 623 | params/6 "@" params/4
|
|---|
| 624 | " (" find/tail params/8 " " ")"
|
|---|
| 625 | ]];RPL_WHOREPLY
|
|---|
| 626 | "353" [ ; USER_LIST
|
|---|
| 627 | ;params/4: sort parse params/4 ""
|
|---|
| 628 | ;if tchannel/name = params/3 [tchannel/users: copy params/4]
|
|---|
| 629 | ;print in the server window... not needed i think ...
|
|---|
| 630 | ;cprint/inf ["Users at " pad params/3 10 mold params/4]
|
|---|
| 631 | ;locate in lay-list the good item
|
|---|
| 632 | foreach lay lay-list [
|
|---|
| 633 | if find lay/pane/2/chan-name params/3 [
|
|---|
| 634 | tmp: parse params/4 " "
|
|---|
| 635 | foreach user tmp [
|
|---|
| 636 | ; once we have the good layout we build the user list in it and show it
|
|---|
| 637 | insert tail lay/pane/4/data user
|
|---|
| 638 | ]
|
|---|
| 639 | show lay/pane/4
|
|---|
| 640 | break
|
|---|
| 641 | ]
|
|---|
| 642 | ]
|
|---|
| 643 | ;liste de sutilistaeur d'un channel affich�e dans la fenetre de dial correspondante.
|
|---|
| 644 | ; chan_user_lst/data: mold copy params/4
|
|---|
| 645 | ;show chan_user_lst
|
|---|
| 646 | ]
|
|---|
| 647 | "366" [];RPL_ENDOFNAMES
|
|---|
| 648 | "375" [cprint/inf params/2] ;RPL_MOTDSTART
|
|---|
| 649 | "372" [cprint/inf reform next params] ;RPL_MOTD
|
|---|
| 650 | "376" [];RPL_ENDOFMOTD
|
|---|
| 651 |
|
|---|
| 652 | "371" [cprint/inf params/2] ;RPL_INFO
|
|---|
| 653 | "374" [];RPL_ENDOFINFO
|
|---|
| 654 | "381" [cprint/inf last params];RPL_YOUREOPER
|
|---|
| 655 | "391" [cprint/inf ["Server (" params/2 ") time: " params/3]]
|
|---|
| 656 |
|
|---|
| 657 | "392" [cprint/inf params/2];RPL_USERSSTART
|
|---|
| 658 | "393" [cprint/inf params/2];RPL_USERS
|
|---|
| 659 | "394" [];RPL_ENDOFUSERS
|
|---|
| 660 | ;Other responses:
|
|---|
| 661 | "001" [cprint/inf params/2 error? try [close idents] ]
|
|---|
| 662 | "002" [cprint/inf params/2]
|
|---|
| 663 | "003" [cprint/inf params/2]
|
|---|
| 664 | "004" [cprint/inf reform next params]
|
|---|
| 665 | ][
|
|---|
| 666 | if 0 < length? lay-list [ cprint/inf msg ]
|
|---|
| 667 | ]
|
|---|
| 668 | ]
|
|---|
| 669 | ; lecture des donn�es provennant du socket IRC
|
|---|
| 670 | getirc-port-data: does [
|
|---|
| 671 | either error? getirc-port-data-error: try [irc-input-buffer: copy/part irc-open-port 1] [
|
|---|
| 672 | getirc-port-data-error: disarm getirc-port-data-error
|
|---|
| 673 | error-proc getirc-port-data-error
|
|---|
| 674 | print "Error Generated at GETIRC-PORT-DATA function!"
|
|---|
| 675 | return ""
|
|---|
| 676 | ][
|
|---|
| 677 | if type? irc-input-buffer = block! [irc-input-buffer: to-string irc-input-buffer]
|
|---|
| 678 | if irc-input-buffer = "none" [
|
|---|
| 679 | ;disconnected
|
|---|
| 680 | cprint "Connection to IRC closed"
|
|---|
| 681 | close irc-open-port
|
|---|
| 682 | identified?: false
|
|---|
| 683 | ]
|
|---|
| 684 | ]
|
|---|
| 685 | return irc-input-buffer
|
|---|
| 686 | ]
|
|---|
| 687 |
|
|---|
| 688 |
|
|---|
| 689 | ;focntion de traitement des requettes CTCP
|
|---|
| 690 | handle-ctcp-req: func [ctcp-req]
|
|---|
| 691 | [
|
|---|
| 692 | days: ["Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday"]
|
|---|
| 693 | parse next find ctcp-req #"^A" [copy ctcpcmd to #"^A"]
|
|---|
| 694 | ctcpcmd: parse ctcpcmd none
|
|---|
| 695 | ;CTCP - PING
|
|---|
| 696 | switch (first ctcpcmd) [
|
|---|
| 697 | "PING" [
|
|---|
| 698 | irc-port-send [ "NOTICE " nick " :" #"^A" ctcpcmd #"^A"#"^M" ]
|
|---|
| 699 | ]
|
|---|
| 700 | ;CTCP TIME
|
|---|
| 701 | "TIME"[
|
|---|
| 702 | irc-port-send [ "NOTICE " nick " :^ATIME " (first skip days (now/weekday - 1)) ", " now/date " " now/time "^A"#"^M" ]
|
|---|
| 703 | ]
|
|---|
| 704 | ;CTCP - VERSION
|
|---|
| 705 | "VERSION" [
|
|---|
| 706 | irc-port-send [ "NOTICE " nick " :^AVERSION rKini (" Version ") [htpp://kini.rezosup.net]^A"#"^M" ]
|
|---|
| 707 | "CLIENTINFO" [
|
|---|
| 708 | irc-send ["NOTICE " nick " :^ACLIENTINFO VERSION TIME PING CLIENTINFO ^A"#"^M" ]
|
|---|
| 709 | ]
|
|---|
| 710 | ]] return first ctcpcmd]
|
|---|
| 711 | ;fonction d'ouverture de la session cliente
|
|---|
| 712 | handshake: does [
|
|---|
| 713 | irc-port-send ["NICK " user-conf/nick] cprint/inf ["User is sending " user-conf/nick]
|
|---|
| 714 | irc-port-send ["USER " "KiniUser" " " system/network/host-address " ircserv :" "KINI-REBOL"]
|
|---|
| 715 | cprint/inf "Kini is sending USER data"
|
|---|
| 716 | connected: true
|
|---|
| 717 | ;irc-port-send ["JOIN " joinchannel] cprint ["Bot is joining " joinchannel]
|
|---|
| 718 | ]
|
|---|
| 719 | ; ;serv identd
|
|---|
| 720 | ; start-ident: does [
|
|---|
| 721 | ; cprint/inf "IDENT SERVER IS LISTENING ON PORT TCP:113"
|
|---|
| 722 | ; idents: open/direct/lines tcp://:113
|
|---|
| 723 | ; ]
|
|---|
| 724 |
|
|---|
| 725 | irc-open-port: none
|
|---|
| 726 |
|
|---|
| 727 | connect-to-irc: func [host /port p /local tmp-buf]
|
|---|
| 728 | [
|
|---|
| 729 | cprint/inf rejoin ["opening IRC connection to %% " host " %%" ]
|
|---|
| 730 | ;start-ident ;ouverture du port d'identd
|
|---|
| 731 | irc-open-port: open/lines/direct/no-wait to-url rejoin [ "tcp://" host ":" p ]
|
|---|
| 732 | tmp-buf: make string! 0
|
|---|
| 733 | handshake ; overture de session IRC
|
|---|
| 734 |
|
|---|
| 735 | forever [
|
|---|
| 736 | ready: wait/all waitports: [irc-open-port 120 ] ;idents]
|
|---|
| 737 | if ready [
|
|---|
| 738 | foreach port ready [
|
|---|
| 739 | wait 0.01
|
|---|
| 740 | ;ajouter la recu�ration des donn�es depuis les diff�rentes interfaces de dilaogue
|
|---|
| 741 | ;if port = idents [
|
|---|
| 742 | ; cprint/inf rejoin [ host " has make an IDENT request!!!!" ]
|
|---|
| 743 | ; ident-connection: first idents
|
|---|
| 744 | ; ident-buffer: first ident-connection
|
|---|
| 745 | ; if find/any reform ident-buffer "* , *" [
|
|---|
| 746 | ; insert ident-connection rejoin [ident-buffer " : USERID : REBOL : " ident-name]
|
|---|
| 747 | ; ]
|
|---|
| 748 | ;]
|
|---|
| 749 |
|
|---|
| 750 | if port = irc-open-port [
|
|---|
| 751 | tmp-buf: getirc-port-data
|
|---|
| 752 | if tmp-buf = "none" [
|
|---|
| 753 | break
|
|---|
| 754 | ]
|
|---|
| 755 | irc-parser tmp-buf
|
|---|
| 756 | ]
|
|---|
| 757 |
|
|---|
| 758 | ]
|
|---|
| 759 | ]
|
|---|
| 760 | ]
|
|---|
| 761 | ]
|
|---|
| 762 |
|
|---|
| 763 |
|
|---|
| 764 | ;---------
|
|---|
| 765 | ; ---- GUI INTERFACE -----
|
|---|
| 766 | ;--------
|
|---|
| 767 |
|
|---|
| 768 | ; callback function to connect
|
|---|
| 769 | login-serv: func [ nick chan blk /local p serv tmp ] [
|
|---|
| 770 | either all [
|
|---|
| 771 | 0 < length? nick
|
|---|
| 772 | 0 < length? blk
|
|---|
| 773 | 0 < length? chan
|
|---|
| 774 | ][
|
|---|
| 775 | unview/only serv-list-win
|
|---|
| 776 | user-conf/nick: nick
|
|---|
| 777 | if not #"#" = chan/1 [ insert chan "#" ]
|
|---|
| 778 | user-conf/joinchannel: chan
|
|---|
| 779 | tmp: parse first blk ":"
|
|---|
| 780 | serv: first tmp
|
|---|
| 781 | p: second tmp
|
|---|
| 782 | chan-lst/ins-entry serv
|
|---|
| 783 | ; create the new layout and we store it in the layout list
|
|---|
| 784 | lay-list: []
|
|---|
| 785 | insert tail lay-list layout [
|
|---|
| 786 | origin 0x0 space 2x2 below
|
|---|
| 787 | ;topic #1
|
|---|
| 788 | text 700x25 black white font [size: 14 ]
|
|---|
| 789 | ;chat-box #2
|
|---|
| 790 | chat-box 700x400 white
|
|---|
| 791 | ;send-line #3
|
|---|
| 792 | field 700x25 white
|
|---|
| 793 | ; return
|
|---|
| 794 | ;chan-user-list #4
|
|---|
| 795 | ; text-list 100x400
|
|---|
| 796 | ]
|
|---|
| 797 |
|
|---|
| 798 | ; insert tail lay-list face [ pane: [
|
|---|
| 799 | ; text [size: 600x25 colors: [black white] font: [size: 14] offset: 0x0]
|
|---|
| 800 | ; chat-box [ size: 700x400 color: white offset: 0x25]
|
|---|
| 801 | ; field [size: 600x25 offset: 0x425]
|
|---|
| 802 | ; ]]
|
|---|
| 803 | ; we set the new layout store in the layout list to the handle-bx/pane
|
|---|
| 804 | lay-list/1/offset: 0x0
|
|---|
| 805 | handle-bx/pane: lay-list/1
|
|---|
| 806 | show handle-bx
|
|---|
| 807 | ;we connect to irc serv
|
|---|
| 808 | connect-to-irc/port serv p
|
|---|
| 809 | ][
|
|---|
| 810 | alert "Fill the fields and choose and server !"
|
|---|
| 811 | ]
|
|---|
| 812 | ]
|
|---|
| 813 |
|
|---|
| 814 | serv-list-win: layout [
|
|---|
| 815 | origin 2x2 space 2x2
|
|---|
| 816 | across
|
|---|
| 817 | text "Nickname:" nick-fd: field 100 return
|
|---|
| 818 | text "Channel:" chan-fd: field 130 return
|
|---|
| 819 | below
|
|---|
| 820 | text "Choose an IRC server"
|
|---|
| 821 | cnx-tl: text-list data ["www.compkarori.co.nz:6667"]
|
|---|
| 822 | return
|
|---|
| 823 | btn "Connect" [ login-serv nick-fd/text chan-fd/text cnx-tl/picked ]
|
|---|
| 824 | btn "Close" [ unview/only serv-list-win ]
|
|---|
| 825 | ]
|
|---|
| 826 |
|
|---|
| 827 |
|
|---|
| 828 |
|
|---|
| 829 | jchan-cb: func [ text /local ][
|
|---|
| 830 | if 0 < length? text [
|
|---|
| 831 | if not #"#" = text/1 [ insert text "#" ]
|
|---|
| 832 | irc-port-send rejoin [ "JOIN " text ]
|
|---|
| 833 | ]
|
|---|
| 834 | ]
|
|---|
| 835 |
|
|---|
| 836 | j-chanwin: layout [
|
|---|
| 837 | origin 2x2 space 3x2
|
|---|
| 838 | across
|
|---|
| 839 | text "Channel name:"
|
|---|
| 840 | return
|
|---|
| 841 | field 100
|
|---|
| 842 | return
|
|---|
| 843 | btn "Join" [ jchan-cb face/parent-face/pane/2/text unview/only j-chanwin ]
|
|---|
| 844 | btn "Cancel" [unview/only j-chanwin]
|
|---|
| 845 | ]
|
|---|
| 846 |
|
|---|
| 847 | ;callback function main window
|
|---|
| 848 |
|
|---|
| 849 | ; send-mesg: func [text][
|
|---|
| 850 | ; either text/1 = #"/" [
|
|---|
| 851 | ; remove text 1
|
|---|
| 852 | ; irc-port-send text
|
|---|
| 853 | ; ][
|
|---|
| 854 | ; chat-bx/insert-text rejoin [ user-conf/nick "-->" text ] orange
|
|---|
| 855 | ; say/to text user-conf/joinchannel
|
|---|
| 856 | ; ]
|
|---|
| 857 | ; ]
|
|---|
| 858 |
|
|---|
| 859 | ; config-win: layout [
|
|---|
| 860 | ; style t80 text 80
|
|---|
| 861 | ; style f150 field 150
|
|---|
| 862 | ; style bt50 btn 50
|
|---|
| 863 | ; across
|
|---|
| 864 | ; h4 "User informations"
|
|---|
| 865 | ; return
|
|---|
| 866 | ; t80 "Nickname:" f150
|
|---|
| 867 | ; return
|
|---|
| 868 | ; t80 "2nd Nick:" f150
|
|---|
| 869 | ; return
|
|---|
| 870 | ; t80 "3rd Nick" f150
|
|---|
| 871 | ; return
|
|---|
| 872 | ; h4 "Networks"
|
|---|
| 873 | ; return
|
|---|
| 874 | ; text-list 200 data [ "www.compkarori.co.nz:6667" ]
|
|---|
| 875 | ; return
|
|---|
| 876 | ; btn "Close" [ unview/only config-win ]
|
|---|
| 877 | ; btn "Connect" []
|
|---|
| 878 | ; below at 225x170
|
|---|
| 879 | ; bt50 "Add" []
|
|---|
| 880 | ; bt50 "Remove" []
|
|---|
| 881 | ; bt50 "Edit..." []
|
|---|
| 882 | ; bt50 "Sort" []
|
|---|
| 883 | ; ]
|
|---|
| 884 |
|
|---|
| 885 | main-win: layout [
|
|---|
| 886 | origin 2x2
|
|---|
| 887 | space 2x2
|
|---|
| 888 | across
|
|---|
| 889 | ;connect
|
|---|
| 890 | btn "Log In" [ view/new serv-list-win ]
|
|---|
| 891 | btn "Log Out" [ if not none? irc-open-port [ if request "Really Log out ?" [irc-port-send "QUIT Byebye" ] ] ]
|
|---|
| 892 | tab
|
|---|
| 893 | btn "Join" [ view/new j-chanwin ]
|
|---|
| 894 | tab
|
|---|
| 895 | btn "Quit" [ if request "Really quit ?" [if not none? irc-open-port [ irc-port-send "QUIT Byebye" wait 1 ] quit]]
|
|---|
| 896 | return
|
|---|
| 897 | ;topic-v: text 600x25 black white font [size: 14 ]
|
|---|
| 898 | return
|
|---|
| 899 | chan-lst: channel-list-box 150x450
|
|---|
| 900 | ; box to display the irc messages
|
|---|
| 901 | handle-bx: box 700x450
|
|---|
| 902 |
|
|---|
| 903 | ]
|
|---|
| 904 |
|
|---|
| 905 |
|
|---|
| 906 | ;---------
|
|---|
| 907 | ; ---- Software Start -----
|
|---|
| 908 | ;--------
|
|---|
| 909 | view/new main-win
|
|---|
| 910 | do-events
|
|---|
| 911 | ; unless exists? %./user-cnf.dat[
|
|---|
| 912 | ; view/new config-win
|
|---|
| 913 | ; do-events][ ] |
|---|
