gyudon_addict◆hawaiiZtQ6: this is from october 17th
#!/usr/bin/tclsh
# Creative Commons Zero (CC0)
package require http
package require json
package require tls
package require Tclx
namespace eval ::config {
set server play.gikopoi.com
set user_name golem.tcl
set character onigiri
set password npc
set area for
set room cafe_st
set net_bifpoi 0
set net_warn_unsupported 0
set net_flush_ms 100
set net_poll_ms 1000
set net_ca_dir "/etc/ssl/certs"
}
namespace eval ::state {}
namespace eval ::state::room {}
namespace eval ::scmd {}
namespace eval ::event {
set logged_in {};
set logging_out {};
set joined {}; # uid
set leaving {}; # uid
set moved {}; # uid position direction
set chatted {}; # uid message
set acted {}; # uid action
set changed_inactivity {}; # uid inactive
set chatbubble_turned {}; # uid direction
set character_changed {}; # uid character
set sys_announce {}; # message
}
proc main {} {
set ::state::main_loaded 1
foreach file $::argv {
source $file
}
::http::register https 443 [ list ::tls::socket -autoservername true \
-require true -cadir $::config::net_ca_dir ]
signal trap SIGINT { quit "quitting by user request" }
login [ formatLoginData ]
sockShell stdin stdout
# exit via 'quit'
vwait forever
}
proc formatLoginData {} {
dict set d userName [ s ${::config::user_name}]
dict set d characterId [ s ${::config::character}]
dict set d areaId [ s ${::config::area}]
dict set d roomId [ s ${::config::room}]
dict set d password [ s ${::config::password}]
return $d
}
proc sockShell { s_in s_out } {
set script "set s_in $s_in ; set s_out $s_out"
append script {
if {[ catch [ gets $s_in ] out ]} {
puts $s_out $::errorInfo
} elseif { $out ne "" } {
puts $s_out $out
}
flush $s_out
}
fileevent $s_in readable $script
}
proc connect { event arguments body } {
set id [ incr ::state::event_acc ]
dict set $event $id [ list $arguments $body ]
return [ list $event $id ]
}
proc fire { event args } {
dict for { id lambda } $event {
if {[ catch { apply $lambda {*}$args }]} {
puts stderr $::errorInfo
}
}
}
proc disconnect { connection } {
set event [ lindex $connection 0 ]
set id [ lindex $connection 1 ]
dict unset $event $id
return
}
proc map { lambda list } {
set result {}
foreach item $list {
lappend result [ apply $lambda $item ]
}
return $result
}
proc s { txt } { return \"${txt}\" }
proc xy { d } { list [ dict get $d x ] [ dict get $d y ]}
proc xyDiff { a b } {
list [ expr {[ lindex $a 0 ] - [ lindex $b 0 ]}] \
[ expr {[ lindex $a 1 ] - [ lindex $b 1 ]}]
}
proc sleep { ms } { after $ms set t 1; vwait t }
proc every { ms body } {
eval $body
after $ms [ namespace code [ info level 0 ]]
}
proc request { url args } {
set headers [ dict create ]
if {[ info exists ::state::puid ]} {
dict set headers private-user-id $::state::puid
}
set token [ ::http::geturl $url -headers $headers {*}$args ]
if {[ ::http::status $token ] ne "ok" } {
set message [ ::http::error $token ]
::http::cleanup $token
error $message
}
set data [ ::http::data $token ]
::http::cleanup $token
return $data
}
proc post { url data { type text/plain }} {
request $url -type $type -query "${data}\n"
}
proc get { url } { request $url }
proc eio { type { data "" }} {
set id [ switch -- $type {
open { expr 0 }
close { expr 1 }
ping { expr 2 }
pong { expr 3 }
message { expr 4 }
default { error "eio type not known: $type" }
}]
lappend ::state::eio_queue $id$data
if {[ info exists ::state::eio_timer ]} return
set ::state::eio_timer [ after $::config::net_flush_ms flushEio ]
return
}
proc flushEio {} {
set data [ join $::state::eio_queue "\x1e" ]
set ::state::eio_queue [ list ]
unset ::state::eio_timer
# post last, so it wont cause eventloop problems
post $::state::api$::state::sid $data
}
proc waitForEioFlush {} { vwait ::state::eio_timer }
proc sio { type { data "" }} {
set id [ switch -- $type {
connect { expr 0 }
disconnect { expr 1 }
event { expr 2 }
ack { expr 3 }
connect_error { expr 4 }
default { error "sio type not known: $type" }
}]
eio message $id$data
}
proc cmd { args } { sio event "\[[ join $args , ]\]" }
proc poll {} {
set raw [ get $::state::api$::state::sid ]
foreach packet [ split $raw "\x1e" ] {
inEio $packet
}
}
proc inEio { packet } {
set id [ string index $packet 0 ]
set payload [ string range $packet 1 end ]
switch -- $id {
0 { # open
set data [ ::json::json2dict $payload ]
set ::state::sid &sid=[ dict get $data sid ]
sio connect
}
1 { # close
puts $payload
quit "remote host closing eio socket"
}
2 { # ping
eio pong
}
3 { # pong
puts ping
}
4 { # message
inSio $payload
}
default {
puts "ewhat $packet"
}
}
}
proc inSio { packet } {
set packet_type [ string index $packet 0 ]
set payload [ string range $packet 1 end ]
switch -- $packet_type {
0 { # connect
# do nothing
}
1 { # disconnect
puts $payload
quit "remote host closing sio socket"
}
2 { # event
inCmd {*}[ ::json::json2dict $payload ]
}
default {
puts "swhat $packet"
}
}
}
proc inCmd { name args } {
if {[ llength [ info procs ::scmd::$name ]] != 1 } {
if { $::config::net_warn_unsupported } {
puts stderr "unsupported cmd: $name"
}
return
}
::scmd::$name {*}$args
}
proc login { data } {
set bifpoi ""
if { $::config::net_bifpoi } { set bifpoi "/api" }
set login_data [ ::json::json2dict [
post https://${::config::server}${bifpoi}/login [
::json::dict2json $data ] application/json ]]
if { ![ dict get $login_data isLoginSuccessful ]} {
error [ dict get $login_data error ]
}
set ::state::uid [ dict get $login_data userId ]
set ::state::puid [ dict get $login_data privateUserId ]
set ::state::api \
https://${::config::server}/socket.io/?EIO=4&transport=polling
set ::state::sid ""
every $::config::net_poll_ms poll
waitForEioFlush
fire $::event::logged_in
}
proc quit {{ reason "" }} {
fire $::event::logging_out
if { $reason ne "" } { puts stderr $reason }
after 4000 exit; # force if taking too long
sio disconnect
eio close
waitForEioFlush
exit
}
proc updateUser { d } {
set id [ dict get $d id ]
set inactive [ expr {[ dict get $d isInactive ] eq true ? 1 : 0 }]
dict set u name [ dict get $d name ]
dict set u position [ xy [ dict get $d position ]]
dict set u direction [ dict get $d direction ]
dict set u character [ dict get $d characterId ]
dict set u inactive $inactive
set ::state::users($id) $u
}
proc updateRoom { d } {
set ::state::room::id [ dict get $d id ]
set ::state::room::size [ xy [ dict get $d size ]]
set ::state::room::forbids [ list ]
foreach forbid [ dict get $d forbiddenMovements ] {
lappend ::state::room::forbids [ list [
list [ dict get $forbid xFrom ] [
dict get $forbid yFrom ]] [
list [ dict get $forbid xTo ] [
dict get $forbid yTo ]
]
]
}
set ::state::room::blocked [ map {{ p } { xy $p }} \
[ dict get $d blocked ]]
set ::state::room::seats [ map {{ p } { xy $p }} [ dict get $d sit ]]
}
proc ::scmd::server-update-current-room-state { d } {
updateRoom [ dict get $d currentRoom ]
foreach user_data [ dict get $d connectedUsers ] {
updateUser $user_data
}
}
proc ::scmd::server-cant-log-you-in {} {
quit "server can't log you in"
}
proc ::scmd::server-user-joined-room { user_data } {
updateUser $user_data
set uid [ dict get $user_data id ]
fire $::event::joined $uid
}
proc ::scmd::server-user-left-room { uid } {
fire $::event::leaving $uid
catch { array unset ::state::users $uid }
}
proc ::scmd::server-move { d } {
set uid [ dict get $d userId ]
set pos [ xy $d ]
set direction [ dict get $d direction ]
dict set ::state::users($uid) position $pos
dict set ::state::users($uid) direction $direction
fire $::event::moved $uid $pos $direction
}
proc ::scmd::server-msg { uid msg } { fire $::event::chatted $uid $msg }
proc ::scmd::server-roleplay { uid msg } { fire $::event::acted $uid $msg }
proc ::scmd::server-user-active { uid } {
dict set ::state::users($uid) inactive 0
fire $::event::changed_inactivity $uid 0
}
proc ::scmd::server-user-inactive { uid } {
dict set ::state::users($uid) inactive 1
fire $::event::changed_inactivity $uid 1
}
proc ::scmd::server-character-changed { uid character is_alternate } {
dict set ::state::users($uid) character $character
fire $::event::character_changed $uid $character
}
proc ::scmd::server-bubble-position { uid direction } {
dict set ::state::users($uid) chatbubble_direction $direction
fire $::event::chatbubble_turned $uid $direction
}
proc ::scmd::server-system-message { msg } { fire $::event::sys_announce $msg }
proc ::scmd::server-stats { d } { # do nothing }
proc userInfo { uid info } { dict get $::state::users($uid) $info }
proc searchForUsers { exp } {
set users [ list ]
foreach { uid user } [ array get ::state::users ] {
if {[ regexp -- $exp [ dict get $user name ]]} {
lappend users $uid
}
}
return $users
}
proc forbiddenMove? { from to } {
set to_x [ lindex $to 0 ]
set to_y [ lindex $to 1 ]
set s_x [ lindex $::state::room::size 0 ]
set s_y [ lindex $::state::room::size 1 ]
expr {$to_x < 0 || $to_x >= $s_x || $to_y < 0 || $to_y >= $s_y
|| [ lsearch -exact $::state::room::blocked $to ] >= 0
|| [ lsearch -exact $::state::room::forbids [ list $from $to ]] >= 0 }
}
proc pathfind { from to } {
array set visited {}
set paths [ list [ list $from ]]
if {[ forbiddenMove? $to $to ]} { return [ list 0 [ list ]]}
while {[ llength $paths ] > 0 } {
foreach path $paths {
set head [ lindex $path end ]
set h_x [ lindex $head 0 ]
set h_y [ lindex $head 1 ]
set visited($head) 1
if { $head eq $to } { return [ list 1 $path ]}
set adjacents [ list \
[ list [ expr { $h_x - 1 }] $h_y ] \
[ list [ expr { $h_x + 1 }] $h_y ] \
[ list $h_x [ expr { $h_y - 1 }]] \
[ list $h_x [ expr { $h_y + 1 }]]
]
foreach adj $adjacents {
if {[ info exists visited($adj) ]
|| [ forbiddenMove? $head $adj ]} {
continue
}
set new_path $path
lappend new_path $adj
lappend paths $new_path
}
set where [ lsearch -exact $paths $path ]
set paths [ lreplace $paths $where $where ]
}
}
return [ list 0 [ list ]]
}
proc pathToMoves { current_face path } {
set lookup { {-1 0} right {1 0} left {0 -1} up {0 1} down }
set my_pos [ lindex $path 0 ]
set path [ lrange $path 1 end ]
set moves [ list ]
foreach tile_pos $path {
set way [ dict get $lookup [ xyDiff $my_pos $tile_pos ]]
if { $current_face ne $way } {
lappend moves $way
set current_face $way
}
lappend moves $way
set my_pos $tile_pos
}
return $moves
}
proc say { txt } { cmd [ s user-msg ] [ s $txt ]}
proc turnChatbubble { way } { cmd [ s user-bubble-position ] [ s $way ]}
proc move { way } { cmd [ s user-move ] [ s $way ]}
proc moveTo { to } {
set me $::state::users($::state::uid)
set path [ pathfind [ dict get $me position ] $to ]
if { ![ lindex $path 0 ]} {
error "no path available"
}
set path [ lindex $path 1 ]
foreach way [ pathToMoves [ dict get $me direction ] $path ] {
move $way
}
}
# so we can source golem.tcl as it's running
if { ! ([ info exists ::state::main_loaded ] && $::state::main_loaded) } main