47 |
|
|
48 |
(*************************************************************************) |
(*************************************************************************) |
49 |
(* *) |
(* *) |
50 |
|
(* room_num *) |
51 |
|
(* *) |
52 |
|
(*************************************************************************) |
53 |
|
|
54 |
|
let room_num key = |
55 |
|
try int_of_string key with _ -> raise Not_found |
56 |
|
|
57 |
|
(*************************************************************************) |
58 |
|
(* *) |
59 |
|
(* room_of_key *) |
60 |
|
(* *) |
61 |
|
(*************************************************************************) |
62 |
|
|
63 |
|
let room_of_key key = |
64 |
|
try |
65 |
|
let num = room_num key in |
66 |
|
Hashtbl.find G.rooms num |
67 |
|
with _ -> raise Not_found |
68 |
|
|
69 |
|
(*************************************************************************) |
70 |
|
(* *) |
71 |
|
(* keys_to_rooms *) |
72 |
|
(* *) |
73 |
|
(*************************************************************************) |
74 |
|
|
75 |
|
let keys_to_rooms keys = |
76 |
|
let l = ref [] in |
77 |
|
List.iter (fun k -> |
78 |
|
try |
79 |
|
let s = room_of_key k in |
80 |
|
l := s :: !l |
81 |
|
with _ -> ()) keys; |
82 |
|
!l |
83 |
|
|
84 |
|
(*************************************************************************) |
85 |
|
(* *) |
86 |
|
(* room_key *) |
87 |
|
(* *) |
88 |
|
(*************************************************************************) |
89 |
|
|
90 |
|
let room_key room_num = |
91 |
|
Printf.sprintf "%d" room_num |
92 |
|
|
93 |
|
(*************************************************************************) |
94 |
|
(* *) |
95 |
(* Global tables *) |
(* Global tables *) |
96 |
(* *) |
(* *) |
97 |
(*************************************************************************) |
(*************************************************************************) |
134 |
module Column = GuiColumns.Room |
module Column = GuiColumns.Room |
135 |
|
|
136 |
type item = room_info |
type item = room_info |
|
type key = int |
|
137 |
|
|
138 |
let columns = O.rooms_columns |
let columns = O.rooms_columns |
139 |
let get_key = (fun r -> r.room_num) |
let get_key = (fun r -> room_key r.room_num) |
140 |
let module_name = "Rooms" |
let module_name = "Rooms" |
141 |
|
|
142 |
end) |
end) |
253 |
(* *) |
(* *) |
254 |
(*************************************************************************) |
(*************************************************************************) |
255 |
|
|
256 |
method sort_items c ro1 ro2 = |
method sort_items c k1 k2 = |
257 |
match c with |
try |
258 |
|
let ro1 = room_of_key k1 in |
259 |
|
let ro2 = room_of_key k2 in |
260 |
|
match c with |
261 |
Col_room_name -> compare (String.lowercase ro1.room_name) (String.lowercase ro2.room_name) |
Col_room_name -> compare (String.lowercase ro1.room_name) (String.lowercase ro2.room_name) |
262 |
| Col_room_nusers -> compare ro1.room_nusers ro2.room_nusers |
| Col_room_nusers -> compare ro1.room_nusers ro2.room_nusers |
263 |
| Col_room_state -> compare ro1.room_state ro2.room_state |
| Col_room_state -> compare ro1.room_state ro2.room_state |
264 |
| Col_room_network -> compare ro1.room_network ro2.room_network |
| Col_room_network -> compare ro1.room_network ro2.room_network |
265 |
|
with _ -> 0 |
266 |
|
|
267 |
(*************************************************************************) |
(*************************************************************************) |
268 |
(* *) |
(* *) |
271 |
(*************************************************************************) |
(*************************************************************************) |
272 |
|
|
273 |
method force_update_icons () = |
method force_update_icons () = |
274 |
List.iter (fun ro -> |
List.iter (fun k -> |
275 |
try |
try |
276 |
let (row, _) = self#find_item ro.room_num in |
let row = self#find_row k in |
277 |
|
let ro = room_of_key k in |
278 |
store#set ~row ~column:room_network_pixb (Mi.network_pixb ro.room_network ~size:A.SMALL ()); |
store#set ~row ~column:room_network_pixb (Mi.network_pixb ro.room_network ~size:A.SMALL ()); |
279 |
store#set ~row ~column:room_name_pixb (Mi.room_state_to_icon ro.room_state ~size:A.SMALL); |
store#set ~row ~column:room_name_pixb (Mi.room_state_to_icon ro.room_state ~size:A.SMALL); |
280 |
with _ -> () |
with _ -> () |
328 |
(*************************************************************************) |
(*************************************************************************) |
329 |
|
|
330 |
let close_open_room sel () = |
let close_open_room sel () = |
331 |
|
let l = keys_to_rooms sel in |
332 |
List.iter (fun ro -> |
List.iter (fun ro -> |
333 |
match ro.room_state with |
match ro.room_state with |
334 |
RoomOpened -> GuiCom.send (SetRoomState (ro.room_num, RoomClosed)) |
RoomOpened -> GuiCom.send (SetRoomState (ro.room_num, RoomClosed)) |
335 |
| _ -> GuiCom.send (SetRoomState (ro.room_num, RoomOpened)) |
| _ -> GuiCom.send (SetRoomState (ro.room_num, RoomOpened)) |
336 |
) sel |
) l |
337 |
|
|
338 |
let on_entry_return num s = |
let on_entry_return num s = |
339 |
GuiCom.send (SendMessage (num, PublicMessage (0, s))) |
GuiCom.send (SendMessage (num, PublicMessage (0, s))) |
347 |
(* *) |
(* *) |
348 |
(*************************************************************************) |
(*************************************************************************) |
349 |
|
|
350 |
let room_menu (sel : room_info list) = |
let room_menu sel = |
351 |
match sel with |
match sel with |
352 |
[] -> [] |
[] -> [] |
353 |
| _ -> |
| _ -> |
361 |
(* *) |
(* *) |
362 |
(*************************************************************************) |
(*************************************************************************) |
363 |
|
|
364 |
let on_select_room (sel : room_info list) = |
let on_select_room sel = |
365 |
try |
try |
366 |
userstore#clear (); |
userstore#clear (); |
367 |
update_users_label (); |
update_users_label (); |
373 |
in |
in |
374 |
match sel with |
match sel with |
375 |
[] -> (if !!verbose then lprintf' "No room selected\n") |
[] -> (if !!verbose then lprintf' "No room selected\n") |
376 |
| ro :: tail -> |
| k :: tail -> |
377 |
begin |
begin |
378 |
current_room := Some ro.room_num; |
try |
379 |
match ro.room_state with |
let ro = room_of_key k in |
380 |
RoomOpened -> |
current_room := Some ro.room_num; |
381 |
begin |
match ro.room_state with |
382 |
List.iter (fun user_num -> |
RoomOpened -> |
383 |
|
begin |
384 |
|
List.iter (fun user_num -> |
385 |
|
try |
386 |
|
let u = Hashtbl.find G.users user_num in |
387 |
|
ignore (userstore#add_item u); |
388 |
|
with _ -> get_user_info user_num |
389 |
|
) ro.room_users; |
390 |
|
update_users_label (); |
391 |
try |
try |
392 |
let u = Hashtbl.find G.users user_num in |
let chat_buf = List.assoc ro.room_num !dialogs in |
393 |
ignore (userstore#add_item u); |
box#set_buffer chat_buf |
394 |
with _ -> get_user_info user_num |
with _ -> (if !!verbose then lprintf' "No chat dialog availabale\n") |
395 |
) ro.room_users; |
end |
396 |
update_users_label (); |
| _ -> (if !!verbose then lprintf' "room_users empty\n") |
397 |
try |
with _ -> () |
|
let chat_buf = List.assoc ro.room_num !dialogs in |
|
|
box#set_buffer chat_buf |
|
|
with _ -> (if !!verbose then lprintf' "No chat dialog availabale\n") |
|
|
end |
|
|
| _ -> (if !!verbose then lprintf' "room_users empty\n") |
|
|
|
|
398 |
end |
end |
|
|
|
399 |
with _ -> (if !!verbose then lprintf' "No chat_box found\n") |
with _ -> (if !!verbose then lprintf' "No chat_box found\n") |
400 |
|
|
401 |
(*************************************************************************) |
(*************************************************************************) |
404 |
(* *) |
(* *) |
405 |
(*************************************************************************) |
(*************************************************************************) |
406 |
|
|
407 |
let on_double_click_room (ro : room_info) = |
let on_double_click_room k = |
408 |
close_open_room [ro] () |
close_open_room [k] () |
409 |
|
|
410 |
(*************************************************************************) |
(*************************************************************************) |
411 |
(* *) |
(* *) |
413 |
(* *) |
(* *) |
414 |
(*************************************************************************) |
(*************************************************************************) |
415 |
|
|
416 |
let filter_room (ro : room_info) = |
let filter_room k = |
417 |
not (List.memq ro.room_network !G.networks_filtered) |
try |
418 |
|
let ro = room_of_key k in |
419 |
|
not (List.memq ro.room_network !G.networks_filtered) |
420 |
|
with _ -> true |
421 |
|
|
422 |
(*************************************************************************) |
(*************************************************************************) |
423 |
(* *) |
(* *) |
457 |
(* *) |
(* *) |
458 |
(*************************************************************************) |
(*************************************************************************) |
459 |
|
|
460 |
|
let hashtbl_rooms_update ro ro_new = |
461 |
|
ro.room_state <- ro_new.room_state; |
462 |
|
ro.room_users <- ro_new.room_users; |
463 |
|
ro.room_messages <- ro_new.room_messages; |
464 |
|
ro.room_nusers <- ro_new.room_nusers |
465 |
|
|
466 |
let add_chat_to_room ro = |
let add_chat_to_room ro = |
467 |
match ro.room_state with |
match ro.room_state with |
468 |
RoomOpened -> |
RoomOpened -> |
500 |
(if !!verbose then lprintf' "Adding room %s num: %d\n" ro.room_name ro.room_num); |
(if !!verbose then lprintf' "Adding room %s num: %d\n" ro.room_name ro.room_num); |
501 |
add_chat_to_room ro; |
add_chat_to_room ro; |
502 |
ignore (roomstore#add_item ro); |
ignore (roomstore#add_item ro); |
503 |
|
Hashtbl.add G.rooms ro.room_num ro; |
504 |
update_rooms_label () |
update_rooms_label () |
505 |
end |
end |
506 |
|
|
507 |
let room_info r = |
let room_info r = |
508 |
try |
try |
509 |
(if !!verbose then lprintf' "Room_info of %s\n" r.room_name); |
(if !!verbose then lprintf' "Room_info of %s\n" r.room_name); |
510 |
let (row, ro) = roomstore#find_item r.room_num in |
let ro = Hashtbl.find G.rooms r.room_num in |
511 |
|
let row = roomstore#find_row (room_key r.room_num) in |
512 |
(* no need to keep ro.room_messages, it is stored in dialogs *) |
(* no need to keep ro.room_messages, it is stored in dialogs *) |
513 |
let ro_new = {r with room_users = ro.room_users} in |
let ro_new = {r with room_users = ro.room_users} in |
514 |
(if ro_new.room_state <> ro.room_state |
(if ro_new.room_state <> ro.room_state |
515 |
then add_chat_to_room ro_new); |
then add_chat_to_room ro_new); |
516 |
roomstore#update_item row ro ro_new |
roomstore#update_item row ro ro_new; |
517 |
|
hashtbl_rooms_update ro ro_new |
518 |
with _ -> add_room r |
with _ -> add_room r |
519 |
|
|
520 |
let find_user_name user_num = |
let find_user_name user_num = |
558 |
let remove_room_user room_num user_num = |
let remove_room_user room_num user_num = |
559 |
(if !!verbose then lprintf' "Removing user to room %d\n" room_num); |
(if !!verbose then lprintf' "Removing user to room %d\n" room_num); |
560 |
try |
try |
561 |
let (row, ro) = roomstore#find_item room_num in |
let ro = Hashtbl.find G.rooms room_num in |
562 |
|
let row = roomstore#find_row (room_key room_num) in |
563 |
(if List.mem user_num ro.room_users |
(if List.mem user_num ro.room_users |
564 |
then ro.room_users <- List.filter (fun n -> n <> user_num) ro.room_users); |
then ro.room_users <- List.filter (fun n -> n <> user_num) ro.room_users); |
565 |
let _ = |
let _ = |
568 |
begin |
begin |
569 |
try |
try |
570 |
let u = Hashtbl.find G.users user_num in |
let u = Hashtbl.find G.users user_num in |
571 |
userstore#remove_item u; |
userstore#remove_item (GuiUsers.user_key user_num); |
572 |
update_users_label (); |
update_users_label (); |
573 |
with _ -> () |
with _ -> () |
574 |
end |
end |
584 |
let add_room_user room_num user_num = |
let add_room_user room_num user_num = |
585 |
(if !!verbose then lprintf' "Adding user to room %d\n" room_num); |
(if !!verbose then lprintf' "Adding user to room %d\n" room_num); |
586 |
try |
try |
587 |
let (row, ro) = roomstore#find_item room_num in |
let ro = Hashtbl.find G.rooms room_num in |
588 |
|
let row = roomstore#find_row (room_key room_num) in |
589 |
(if not (List.mem user_num ro.room_users) |
(if not (List.mem user_num ro.room_users) |
590 |
then ro.room_users <- user_num :: ro.room_users); |
then ro.room_users <- user_num :: ro.room_users); |
591 |
match (!current_room, ro.room_state) with |
match (!current_room, ro.room_state) with |
610 |
Some room_num -> |
Some room_num -> |
611 |
begin |
begin |
612 |
try |
try |
613 |
let (_, ro) = roomstore#find_item room_num in |
let ro = Hashtbl.find G.rooms room_num in |
614 |
if List.mem u_new.user_num ro.room_users |
if List.mem u_new.user_num ro.room_users |
615 |
then begin |
then begin |
616 |
try |
try |
617 |
let (row, u) = userstore#find_item u_new.user_num in |
let u = Hashtbl.find G.users u_new.user_num in |
618 |
userstore#update_item row u u_new |
let row = userstore#find_row (GuiUsers.user_key u_new.user_num) in |
619 |
|
userstore#update_item row u u_new; |
620 |
|
GuiUsers.hashtbl_users_update u u_new |
621 |
with _ -> () |
with _ -> () |
622 |
end |
end |
623 |
with _ -> () |
with _ -> () |