|
|
|
RIM Micro-Messenger - Source CodeVery simple peer-to-peer instant messenger. |
|
REBOL [
Title: "RIM - REBOL Instant Messenger"
Date: 5-Jul-2001/3:45-7:00
Version: 1.2.3
File: %rim.r
Author: "Sean & Carl Sassenrath"
Purpose: "A true peer-to-peer instant messenger."
]
me: any [request-text/title/default "Enter your name:" user-prefs/name]
if none? me [quit]
site: http://www.reboltech.com/cgi/rebol
timestamp: yes
user: replace/all copy me " " "%20"
pop-to-top: on
log-file: off ; Set to %rim-save.txt to save msgs
greeting: none
poll-time: 0:01
users: either exists? %rim-users.r [load %rim-users.r][[]]
; Only strings allowed:
forall users [
if not string? users/1 [remove users][users: next users]
]
users: head users
user-list: []
ports: []
instructions: trim/auto {
If you are using a firewall, it will block incoming connections.
However, outgoing connections will work (if no firewall on other side).
Click on one or more names in the list to connect directly to them.
Click Greet to provide a greeting when people connect to you.
}
open-listen: does [
if error? try [listener: open/lines tcp://:7070][
alert "Computer will not allow connections." quit
]
ports: reduce [poll-time listener]
]
quit-prog: does [
read join site/lookup.r?cmd=remove&service=chat&name= user
foreach p next ports [close p]
quit
]
announce: has [active] [
li/effect: [gradcol 255.0.0 200.200.0] show li
if error? try [
user-list: load join site/lookup.r?cmd=post&service=chat&name= [user "&data=7070"]
][
show-msg "Cannot connect to name lookup server."
exit
]
active: extract user-list 4
if not empty? exclude active users [
users: union users active
save %rim-users.r users
]
sort/compare users func [a b] [
if not find active a [return 1]
if not find active b [return -1]
0
]
li/effect: none
show [ul li]
]
toggle-user: func [user] [
if not disconnect-user user [connect-to user]
]
disconnect-user: func [user] [
if port: is-here? user [
close port
remove find ports port
return true
]
]
connect-to: func [user /local port] [
if not user: find user-list user [exit]
flash rejoin ["Connecting directly to " user/1 "..."]
if error? try [port: open/lines join tcp:// [user/2 ":" user/4]][
unview
show-msg rejoin ["Cannot connect to: " user/1 " Could be behind a firewall."]
exit
]
unview
append ports port
show-msg reform ["Connected to:" user/1 "on" port/remote-ip]
insert port join me " is here."
]
is-here?: func [user /local ip] [
if ip: select user-list user [
foreach port next next ports [
if ip = port/remote-ip [return port]
]
]
]
port-to-user: func [port /local user] [
either user: find user-list port/remote-ip [first back user]["Someone"]
]
main-loop: has [port line time new] [
time: now
forever [
port: wait ports
if port [
either port = listener [
append ports new: first listener
insert new join "Hello from " me
if greeting [
insert new greeting
show-msg join "I said: " greeting
]
if not find user-list new/remote-ip [time: now - 1]
][
if error? try [line: first port][
line: reform [port-to-user port "disconnected."]
remove find ports port
]
show-msg line
if log-file [write/append log-file reform [now line newline]]
]
if pop-to-top [win/changes: 'activate show win]
]
if now - poll-time > time [announce time: now]
]
]
scroll-para: func [tf sf /local tmp][ ;!!! fix bug in View! (not - 0x30)
if none? tf/para [exit]
tmp: min 0x0 tf/size - (size-text tf)
either sf/size/x > sf/size/y [tf/para/scroll/x: sf/data * first tmp] [
tf/para/scroll/y: sf/data * second tmp]
show tf
]
send-msg: has [line] [
if empty? trim/all copy talk/text [exit]
li/effect: [colorize 180.180.180] show li
either timestamp [
line: rejoin [me " [" now/time "] : " talk/text]
][
line: rejoin [me ": " talk/text]
]
foreach p next next ports [insert p line]
if log-file [write/append log-file reform [now line newline]]
li/effect: none show li
show-msg join "I said: " talk/text
unfocus
clear talk/text
talk/line-list: none
focus talk
]
show-msg: func [txt] [
append msg/text txt
append msg/text newline
update-para
]
update-para: does [
sld/data: 1
show sld
scroll-para msg sld
]
cnt: 0
win: center-face layout [
origin 0x0 space 0x0
backcolor black
style menu text 50x24 white center middle bold
here: at
text "On-line Users:" white black bold 120x24 middle [announce]
across
ul: list 108x300 [
space 0
text 160x16 font-size 10 [toggle-user bud]
] supply [
count: count + cnt
face/text: face/color: none
if count > length? users [return none]
face/text: bud: pick users count
face/font/color: either find user-list bud [black][pewter]
if is-here? bud [face/color: yellow]
]
sl: slider ul/size * 0x1 + 12x0 [
c: to-integer value * ((length? users) - 8)
if cnt <> c [cnt: c show ul]
]
return
at here + 120x0 guide
pad 6
menu "Send" [send-msg]
menu "Greet" [greeting: any [request-text/title/default "Greeting Message:" greeting greeting]]
menu "Options" [alert "Need to make an option dialog. See the source!"]
menu "Quit" [quit-prog]
pad 186
li: image logo.gif [browse http://www.rebol.com]
return
msg: area 480x250 wrap instructions
sld: slider 12x250 [scroll-para msg sld]
return below
talk: field 480x50 wrap [send-msg]
]
resize-window: func [size] [
win/size: size
ul/size/y: sl/size/y: size/y - 24
talk/size/x: msg/size/x: size/x - ul/size/x - sl/size/x - sld/size/x
sld/size/y: msg/size/y: size/y - talk/size/y - 24
talk/offset/y: msg/offset/y + msg/size/y
sld/offset/x: msg/offset/x + msg/size/x
li/offset/x: size/x - li/size/x
show win
]
view/new/title/options win reform [system/script/header/title system/script/header/version] [resize]
deflag-face talk tabbed
insert-event-func [
switch event/type [
close [quit-prog]
resize [resize-window win/size]
]
event
]
focus talk
flash "Announcing presence..."
announce
unview
open-listen
main-loop
|
