REBOL [ title: "RebCon Map" author: "Christopher Ross-Gill" date: 30-Sep-2005 version: 0.1.0 ] ;--## PREFS ;-------------------------------------------------------------------## def-prefs: context [ name: "Anonymous" location: -10x-10 ] prefs: all [ exists? prefs-file: view-root/rebcon-map.txt attempt [load prefs-file] ] prefs: construct/with any [prefs []] def-prefs current: make prefs [] insert-event-func [ switch event/type [ close [attempt [save prefs-file third prefs]] ] event ] ;--## FROM SERVER ;-------------------------------------------------------------------## rgc: http://www.ross-gill.com maps: rgc/r/daylight lookup: rgc/cgi-bin/lookup.r images: context [ back: load-image maps/bg-metal.png day: load-image maps/map.jpg night: load-image maps/map-night.jpg shade: load-image maps/map-shading.png zones: load-image maps/map-zones.png pin: load 64#{ R0lGODlhBAAEALMAAAAAAP+ZM+7u7hQAA59yJ0AQGEAQGAAAAgAFxMxTUEARH0Bg rkARMMxTUEBFkgAAASH5BAEAAAIALAAAAAAEAAQAAAQIUAAgQ5iWThEAOw== } ] chars-u: #[bitset! 64#{AAAAAIJk/wP+//+H/v//RwAAAAAAAAAAAAAAAAAAAAA=}] url-encode: func [str [any-string!]][ parse/all copy str [ copy str any [ some chars-u | #" " str: (change back str #"+") | skip str: (change/part back str join "%" enbase/base to-string str/-1 16 1) ] ] str ] get-users: does [ join ["DevCon" none none "171x40"] load join lookup [ "?cmd=post" "&service=map" "&name=" url-encode prefs/name "&data=" prefs/location ] ] ;--## TIME FUNCTIONS ;-------------------------------------------------------------------## shade-offset: has [time gmt gmt-hour os][ time: now - now/zone gmt: time/time gmt-hour: gmt/hour if gmt-hour < 0 [gmt-hour: gmt-hour + 24] if gmt-hour > 23 [gmt-hour: gmt-hour - 24] os: as-pair 14 * (12 - gmt-hour) 0 if positive? os/x [os/x: os/x - 342] return os ] get-zone: has [zone][ zone: select [ 255.0.0 -11:00 255.153.0 -10:00 255.255.0 -9:00 153.255.0 -8:00 0.255.0 -7:00 0.255.153 -6:00 0.255.255 -5:00 0.153.255 -4:00 0.0.255 -3:00 153.0.255 -2:00 255.0.255 -1:00 255.0.153 +0:00 204.0.0 +1:00 204.102.0 +2:00 204.204.0 +3:00 102.204.0 +4:00 0.204.0 +5:00 0.204.102 +6:00 0.204.204 +7:00 0.102.204 +8:00 0.0.204 +9:00 102.0.204 +10:00 204.0.204 +11:00 204.0.102 +12:00 102.102.0 +3:30 0.102.0 +5:30 0.0.102 +9:30 102.0.102 +13:00 ] pick images/zones (current/location + 3x3) either current/location = prefs/location [now/zone][any [zone 0:00]] ] get-time: has [gmt zone time][ gmt: now/time - now/zone zone: get-zone time: gmt + zone // 24:00 if 7 > length? time: form time [append time ":00"] return time ] ;--## LOCATION FUNCTIONS ;-------------------------------------------------------------------## people: [] users: [] update-pin: func [os][prefs/location: os - 3x3 show map-face] update-users: does [ insert clear people extract users: any [attempt [get-users] users] 4 user-list/update update-map ] update-map: has [shade][ shade: shade-offset map-face/effect/draw: compose [ image images/shade (shade) image images/shade (shade + 342x0) image prefs/location images/pin ] foreach [user ip date data] users [ data: any [attempt [to-pair data] 10x85] repend map-face/effect/draw ['image 'images/pin data] if user = current/name [ repend map-face/effect/draw ['circle data + 1x1 4] ] ] show map-face ] ;--## GUI ;-------------------------------------------------------------------## map-layout: center-face layout compose [ style field field edge [size: 1x1 color: 102.102.102 effect: none] space 10 backtile images/back map-face: image 344x173 images/day edge [size: 1x1 color: black] rate 0:01:00 effect [draw []] feel [ engage: func [face action event][ ; if find [down over] event/type [face/effect/alphamul: 221] either event/type = 'time [ update-users ][ update-pin event/offset ] ; if find [up away] event/type [face/effect/alphamul: 255] ] ] across name?: field prefs/name [update-map] clock: text bold 120 get-time rate 1 feel [ engage: func [face action event][ face/text: get-time show face ] ] return text 342 { Type your name, then click on the map where you are located. Then leave running in the background. } below return user-list: text-list 200x300 data people [ current/name: value current/location: any [ attempt [to-pair third select/skip users current/name 4] prefs/location ] show clock update-map ] ] update-users view map-layout