Redis client library for Tcl: Hex Artifact Content

Artifact bf7ce9e0b442f507673824d648495b4145790ff14ba3e5d72306d835fe06ff3e:

File examples/ping-pong.tcl — part of check-in [5806a5eaf7] at 2024-07-09 11:42:30 on branch trunk — Use new constructor syntax in the ping-pong example (user: gahr size: 931)
0000: 23 23 0a 23 20 53 69 6d 70 6c 65 20 70 69 6e 67  ##.# Simple ping
0010: 2d 70 6f 6e 67 20 67 61 6d 65 20 75 73 69 6e 67  -pong game using
0020: 20 52 65 64 69 73 27 20 50 75 62 2f 53 75 62 20   Redis' Pub/Sub 
0030: 70 61 72 61 64 69 67 6d 2e 20 4c 6f 6f 6b 20 61  paradigm. Look a
0040: 74 20 50 49 4e 47 20 61 6e 64 20 50 4f 4e 47 0a  t PING and PONG.
0050: 23 20 6d 65 73 73 61 67 65 73 20 67 6f 20 61 72  # messages go ar
0060: 6f 75 6e 64 20 6f 76 65 72 20 74 68 65 20 63 68  ound over the ch
0070: 6f 6e 20 61 6e 64 20 63 68 69 6e 20 63 68 61 6e  on and chin chan
0080: 6e 65 6c 73 2c 20 72 65 73 70 65 63 74 69 76 65  nels, respective
0090: 6c 79 2e 0a 23 0a 74 63 6c 3a 3a 74 6d 3a 3a 70  ly..#.tcl::tm::p
00a0: 61 74 68 20 61 64 64 20 2e 2e 0a 70 61 63 6b 61  ath add ...packa
00b0: 67 65 20 72 65 71 75 69 72 65 20 72 65 74 63 6c  ge require retcl
00c0: 0a 0a 73 65 74 20 63 68 61 6e 73 20 7b 63 68 69  ..set chans {chi
00d0: 6e 20 63 68 6f 6e 7d 0a 73 65 74 20 74 65 78 74  n chon}.set text
00e0: 73 20 7b 50 49 4e 47 20 50 4f 4e 47 7d 0a 0a 70  s {PING PONG}..p
00f0: 72 6f 63 20 70 69 6e 67 70 6f 6e 67 20 7b 72 20  roc pingpong {r 
0100: 69 64 20 74 79 70 65 20 70 61 74 74 65 72 6e 20  id type pattern 
0110: 63 68 61 6e 6e 65 6c 20 6d 73 67 7d 20 7b 0a 20  channel msg} {. 
0120: 20 20 20 69 66 20 7b 24 74 79 70 65 20 6e 65 20     if {$type ne 
0130: 7b 6d 65 73 73 61 67 65 7d 7d 20 7b 0a 20 20 20  {message}} {.   
0140: 20 20 20 20 20 72 65 74 75 72 6e 0a 20 20 20 20       return.    
0150: 7d 0a 20 20 20 20 70 75 74 73 20 22 5b 63 6c 6f  }.    puts "[clo
0160: 63 6b 20 66 6f 72 6d 61 74 20 5b 63 6c 6f 63 6b  ck format [clock
0170: 20 73 65 63 6f 6e 64 73 5d 5d 20 24 63 68 61 6e   seconds]] $chan
0180: 6e 65 6c 2f 24 6d 73 67 22 0a 0a 20 20 20 20 61  nel/$msg"..    a
0190: 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 24 72  fter 1000.    $r
01a0: 20 55 4e 53 55 42 53 43 52 49 42 45 20 5b 6c 69   UNSUBSCRIBE [li
01b0: 6e 64 65 78 20 24 3a 3a 63 68 61 6e 73 20 24 69  ndex $::chans $i
01c0: 64 5d 0a 20 20 20 20 24 72 20 50 55 42 4c 49 53  d].    $r PUBLIS
01d0: 48 20 5b 6c 69 6e 64 65 78 20 24 3a 3a 63 68 61  H [lindex $::cha
01e0: 6e 73 20 5b 65 78 70 72 20 7b 21 24 69 64 7d 5d  ns [expr {!$id}]
01f0: 5d 20 5b 6c 69 6e 64 65 78 20 24 3a 3a 74 65 78  ] [lindex $::tex
0200: 74 73 20 24 69 64 5d 0a 20 20 20 20 24 72 20 53  ts $id].    $r S
0210: 55 42 53 43 52 49 42 45 20 5b 6c 69 6e 64 65 78  UBSCRIBE [lindex
0220: 20 24 3a 3a 63 68 61 6e 73 20 24 69 64 5d 0a 7d   $::chans $id].}
0230: 0a 0a 70 72 6f 63 20 72 75 6e 20 7b 6f 70 74 73  ..proc run {opts
0240: 20 69 64 7d 20 7b 0a 0a 20 20 20 20 73 65 74 20   id} {..    set 
0250: 72 20 5b 72 65 74 63 6c 20 6e 65 77 20 7b 2a 7d  r [retcl new {*}
0260: 24 6f 70 74 73 5d 0a 20 20 20 20 24 72 20 63 61  $opts].    $r ca
0270: 6c 6c 62 61 63 6b 20 5b 6c 69 6e 64 65 78 20 24  llback [lindex $
0280: 3a 3a 63 68 61 6e 73 20 24 69 64 5d 20 5b 6c 69  ::chans $id] [li
0290: 73 74 20 70 69 6e 67 70 6f 6e 67 20 24 72 20 24  st pingpong $r $
02a0: 69 64 5d 0a 0a 20 20 20 20 69 66 20 7b 24 69 64  id]..    if {$id
02b0: 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 20 20 20   == 0} {.       
02c0: 20 24 72 20 50 55 42 4c 49 53 48 20 5b 6c 69 6e   $r PUBLISH [lin
02d0: 64 65 78 20 24 3a 3a 63 68 61 6e 73 20 5b 65 78  dex $::chans [ex
02e0: 70 72 20 7b 21 24 69 64 7d 5d 5d 20 5b 6c 69 6e  pr {!$id}]] [lin
02f0: 64 65 78 20 24 3a 3a 74 65 78 74 73 20 24 69 64  dex $::texts $id
0300: 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 24 72 20  ].    }..    $r 
0310: 53 55 42 53 43 52 49 42 45 20 5b 6c 69 6e 64 65  SUBSCRIBE [linde
0320: 78 20 24 3a 3a 63 68 61 6e 73 20 24 69 64 5d 0a  x $::chans $id].
0330: 7d 0a 0a 73 65 74 20 6f 70 74 73 20 5b 65 78 70  }..set opts [exp
0340: 72 20 7b 5b 6c 69 6e 64 65 78 20 24 3a 3a 61 72  r {[lindex $::ar
0350: 67 76 20 30 5d 20 65 71 20 7b 2d 2d 74 6c 73 7d  gv 0] eq {--tls}
0360: 20 3f 20 7b 2b 74 6c 73 7d 20 3a 20 7b 7d 7d 5d   ? {+tls} : {}}]
0370: 0a 72 75 6e 20 24 6f 70 74 73 20 31 0a 61 66 74  .run $opts 1.aft
0380: 65 72 20 31 30 30 30 0a 72 75 6e 20 24 6f 70 74  er 1000.run $opt
0390: 73 20 30 0a 0a 76 77 61 69 74 20 66 6f 72 65 76  s 0..vwait forev
03a0: 65 72 0a                                         er.