Pictionary — File Browser
Pictionaryv0.9997 / Pictionaryv0.9997 / piction / pictionary.mrc
pictionary.mrc — 47.82 KB — Download this file
; pictionary!
; by Brad "oS\2" Huizenga
; /piction
; /piction <USER|IP> [port]
; todo later
; add hotkeys
; add undo
; add sending pic to new players
; merge drawtools into main window (mebbe)
; chatbox scrolly
; textbox better behavior
; proxy support???
; multiple possible answers for word IE word|sokoban|lala
; votekick
; todo before 1.0 release
; fix bug where cant select top of palette DONE
; add kicking easily
; add banning (mebbe)
; add wordlist.txt generation/downloading from central server
; add game timer DONE
; add visible game timer/countdown timer DONE
; add solid color palette squares DONE
; artist gets points DONE
; isin to test per word basis, report back with "x is close" DONE
; make server config with options: DONE
; minscoreaward, maxscoreaward, countdowntime, gametime, playerselectmode, winscore, maxusers, port
; piction IP DONE
alias piction {
if ($window(@Pictionary)) { window -a @Pictionary | return }
if (!$isfile($+(",$scriptdir,pict_pal.bmp,"))) pict_ makepal
if (!$1) {
m_init mainMenu Pictionary Menu
return
}
window -fdBk0p +nft @Pictionary -1 -1 645 350
init
r_main
r_timer
r_clear
if (. isin $1) {
if (!$2) tokenize 32 $1 27009
sockopen pict_conn $1 $2
note s Attempting Connection to $1 on port $+($2,...)
}
else {
.notice $1 pictionary server? $ver
note s Initialized, requesting IP
}
}
on *:LOAD: {
if ($version < 6) echo -a Pictionary needs mIRC version 6
else {
echo -a Type /piction for the menu, /piction <USER or IP> [PORT] to connect to a server
echo -a If you are hosting and no one can connect to you and you have a uPnP router, close your server, run the uPnP port forwarder from the pictionary menu, and start your server again.
}
}
alias pict_ if ($isid) return $ [ $+ [ $1- ] ] | $1-
alias -l ver return .9997
alias -l init {
if (%pt.nextscreenshot == $null) %pt.nextscreenshot = 1
%pt.font = verdana
%pt.fsize = 12
%pt.drawmode = 0
%pt.curtool = 1
%pt.curcolor = 0
%pt.cursize = 2
%pt.timer = 1
%pt.timerMax = 1
if (!$window(@pict_names)) window -snhl @pict_names
if (!$window(@pict_txt)) window -nhl @pict_txt
}
; MENU
alias -l m_init {
if (!$window(@PictionMenu)) window -pdoBfhk0 +d @PictionMenu 500 500 200 110
window -a @PictionMenu
unset %pt.menu.*
%pt.menu.state = $1
if ($1 == mainMenu) {
m_set setTitle Pictionary Menu
m_set setMeter 0
m_set setItem 1 1 Host
m_set setItem 2 1 Search for games
m_set setItem 3 1 Internet Updates
m_set updItem 5 1 Close Menu
}
if ($1 == serverMenu) {
m_set setTitle Pictionary Server Start
m_set setMeter 0
m_set setItem 1 1 Start dedicated server
m_set setItem 2 1 Start server + join
m_set setItem 3 0
m_set setItem 4 1 Back
m_set updItem 5 1 Close Menu
}
if ($1 == servOptMenu) {
m_set setTitle Pictionary Server Menu
m_set setMeter 0
m_set setItem 1 1 Open router port with uPnP
m_set setItem 2 1 Start server
m_set setItem 3 1 Setup server
m_set setItem 4 1 Back
m_set updItem 5 1 Close Menu
}
if ($1 == setupServer) {
m_set setTitle Pictionary Server Setup
m_set setMeter 0
m_set setItem 1 1 Configure dedicated server
m_set setItem 2 1 Edit wordlist
m_set setItem 3 0
m_set setItem 4 1 Back
m_set updItem 5 1 Close Menu
}
if ($1 == updateMenu) {
m_set setTitle Pictionary Menu
m_set setMeter 0
m_set setItem 1 1 Check for script updates
m_set setItem 2 0 Download wordlists (not done)
m_set setItem 4 1 Back
m_set updItem 5 1 Close Menu
}
if ($1 == PDLchecking) {
m_set setTitle Checking for updates...
m_set setMeter 1 0 1
m_draw
}
if ($1 == PDLgotver) {
m_set setTitle Checking for updates...
m_set setMeter 1 1 1
}
if ($1 == PDLgotscript) {
m_set setTitle Checking for updates...
m_set setMeter 1 1 1
}
if ($1 == makePal) {
m_set setTitle Generating Palette
m_set setMeter 1 0 1
m_set setItem 1 0 Generating...
m_set setItem 3 0 This may take a second or two, but will
m_set setItem 4 0 only run once, ever. You might also be
m_set updItem 5 0 disconnected from your IRC network.
}
if ($1 == PDLfail) {
m_set setTitle An Error Occurred
m_set setItem 5 1 Close
}
}
alias -l m_handler {
if ($1 == mainMenu) {
if ($2 == 1) {
m_init servOptMenu
}
if ($2 == 2) {
m_set close
if ($active ischan) msg $active Anyone hosting a Pictionary game?
}
if ($2 == 3) {
m_init updateMenu
}
if ($2 == 5) {
m_set close
}
}
if ($1 == serverMenu) {
if ($2 == 1) {
if (!$s_start) s_log Started
m_set close
}
if ($2 == 2) {
if (!$s_start) .timer 1 0 piction $me
m_set close
}
if ($2 == 4) m_init servOptMenu
if ($2 == 5) m_set close
}
if ($1 == servOptMenu) {
if ($2 == 1) {
if (!$isfile($+(",$scriptdir,serverConfig.ini,"))) s_makeConf
s_loadConf
upnp %pts.port
m_set close
}
if ($2 == 2) {
m_init serverMenu
}
if ($2 == 3) {
m_init setupServer
}
if ($2 == 4) m_init mainMenu
if ($2 == 5) m_set close
}
if ($1 == setupServer) {
if ($2 == 1) {
if (!$isfile($+(",$scriptdir,serverConfig.ini,"))) s_makeConf
.run $+(",$scriptdir,serverConfig.ini,")
m_set close
}
if ($2 == 2) {
if (!$isfile($+(",$scriptdir,serverConfig.ini,"))) s_makeConf
s_loadConf
if (!$isfile(%pts.wordListFile)) s_makeWordlist
.run notepad $+(",%pts.wordListFile,")
m_set close
}
if ($2 == 4) m_init servOptMenu
if ($2 == 5) m_set close
}
if ($1 == updateMenu) {
if ($2 == 1) pictiondownload
if ($2 == 4) m_init mainMenu
if ($2 == 5) m_set close
}
if ($1 == PDLchecking) {
if ($2 == 5) m_set close
}
if ($1 == PDLgotver) {
if (($2 == 4) && (%pt.rfname)) pictiondownload %pt.rfname
if ($2 == 5) m_set close
}
if ($1 == PDLgotscript) {
if ($2 == 4) {
m_init PDLchecking
m_set setTitle Reloading...
m_set setMeter 0
m_set setItem 1 0 Please wait...
m_set updItem 2 0 Pictionary is shutting down...
.mkdir $shortfn($scriptdir) $+ archives
.copy $shortfn($script) $shortfn($scriptdir) $+ archives\pict_ $+ $chr(91) $+ $asctime(mmmm.dd.yyyy) $+ $chr(93) $+ _ $+ $ctime $+ .mrc
m_set updItem 3 0 Archival operation complete.. Unloading
.copy -o " $+ $scriptdir $+ p_temp.txt $+ " " $+ $scriptdir $+ %pt.rfname $+ "
m_set updItem 4 0 Update complete. Reloading.
.timer -mo 1 500 .unload -rs " $+ $scriptdir $+ %pt.rfname $+ "
.timer -mo 1 1000 .load -rs " $+ $scriptdir $+ %pt.rfname $+ "
.timer -mo 1 1500 pict_ m_set setItem 1 0 Reload Successful.
.timer -mo 1 1500 pict_ m_set setItem 2 0 Update Completed!
.timer -mo 1 1500 pict_ m_set setItem 3 0 Â
.timer -mo 1 1500 pict_ m_set setItem 4 0
.timer -mo 1 1500 pict_ m_set updItem 5 1 Close
}
if ($2 == 5) m_set close
}
if ($1 == PDLfail) {
if ($2 == 5) m_set close
}
}
menu @PictionMenu {
sclick: m_set click $mouse.x $mouse.y
dclick: m_set click $mouse.x $mouse.y
mouse: m_set mouse $mouse.x $mouse.y
leave: m_set leave -1 -1
$iif(%pt.menu.choice == 2,Download) : pictiondownload %pt.rfname
$iif(%pt.menu.choice == 3,Unload this old copy and load the new copy): {
%pt.menu.choice = 0
; .timer -mo 1 1500 piction
}
}
alias m_set {
if ($1 == setItem) {
set $+(%,pt.menu.item.,$2,.txt) $4-
if ($3) set $+(%,pt.menu.item.,$2,.command) $true
else set $+(%,pt.menu.item.,$2,.command) $false
}
if ($1 == setMeter) {
if ($2) {
%pt.menu.meter.show = 1
%pt.menu.meter.cur = $3
%pt.menu.meter.max = $4
}
else %pt.menu.meter.show = 0
}
if ($1 == setTitle) {
%pt.menu.title = $2-
}
if ($1 == updItem) {
set $+(%,pt.menu.item.,$2,.txt) $4-
if ($3) set $+(%,pt.menu.item.,$2,.command) $true
else set $+(%,pt.menu.item.,$2,.command) $false
m_draw
}
if ($1 == updMeterCur) {
%pt.menu.meter.cur = $2
m_draw
}
if ($1 == updMeterMax) {
%pt.menu.meter.max = $2
m_draw
}
if ($1 == close) {
window -c @PictionMenu
unset %pt.menu.*
}
if ($1 == click) {
var %h = $int($calc(($3 - 15) / 15))
if (%h >= 1) && (%h <= 5) {
if ($eval($+(%,pt.menu.item.,%h,.command),2)) .timer 1 0 pict_ m_handler %pt.menu.state %h
}
}
if (($1 == mouse) || ($1 == leave)) {
if (!$window(@PictionMenu)) return
unset %pt.menu.highlight
var %h = $int($calc(($3 - 15) / 15))
if (((%h >= 1) && (%h <= 5)) && ($eval($+(%,pt.menu.item.,%h,.command),2))) %pt.menu.highlight = %h
m_draw
}
if (($1 == click) || ($1 == drag)) {
if (!$window(@PictionMenu)) return
if ($mouse.key & 1) {
window @PictionMenu $calc($mouse.dx - $2) $calc($mouse.dy - $3)
.timer 1 0 pict_ m_set drag $2 $3
}
}
}
alias -l m_draw {
if (%pt.menu.state) {
if (!$window(@PictionMenu)) return
if (!%pt.menu.meter.max) %pt.menu.meter.max = 1
if (%pt.menu.meter.cur == $null) %pt.menu.meter.cur = 0
if (%pt.menu.meter.cur > %pt.menu.meter.max) %pt.menu.meter.cur = %pt.menu.meter.max
drawrect -nrf @PictionMenu $rgb(252,252,252) 0 0 0 201 111
; bg
drawrect -nr @PictionMenu $rgb(0,0,0) 1 0 0 200 110
; border
drawrect -nrf @PictionMenu $rgb(220,220,220) 0 1 1 198 15 98
drawline -nr @PictionMenu $rgb(0,0,0) 1 0 15 200 15
; topbar
if (%pt.menu.meter.show) drawrect -nr @PictionMenu $rgb(0,0,0) 1 10 20 180 8
; meter border
if (%pt.menu.meter.show) drawrect -nrf @PictionMenu $rgb(200,200,250) 0 11 21 $round($calc(178* (%pt.menu.meter.cur / %pt.menu.meter.max)),0) 6
; meter fill
if (%pt.menu.highlight) drawrect -nrf @PictionMenu $rgb(220,220,220) 0 1 $calc(15+ (15* %pt.menu.highlight)) 198 15 98
if (%pt.menu.item.1.txt) drawtext -nr @PictionMenu $rgb(0,0,0) helvetica 12 10 30 %pt.menu.item.1.txt
if (%pt.menu.item.2.txt) drawtext -nr @PictionMenu $rgb(0,0,0) helvetica 12 10 45 %pt.menu.item.2.txt
if (%pt.menu.item.3.txt) drawtext -nr @PictionMenu $rgb(0,0,0) helvetica 12 10 60 %pt.menu.item.3.txt
if (%pt.menu.item.4.txt) drawtext -nr @PictionMenu $rgb(0,0,0) helvetica 12 10 75 %pt.menu.item.4.txt
if (%pt.menu.item.5.txt) drawtext -nr @PictionMenu $rgb(0,0,0) helvetica 12 10 90 %pt.menu.item.5.txt
drawtext -nro @PictionMenu $rgb(0,0,0) verdana 11 10 1 %pt.menu.title
drawdot @PictionMenu
}
}
; ==================
; AUTO UPDATE
; ==================
; = this next part was very stolen from andy's snippet because i am lazy, not because i am incapable
alias pictiondownload {
if ($sock(pictionsocket)) {
m_draw
window -a @PictionMenu
return
}
; connect to server
m_init PDLchecking
unset %pt.dl.*
if ($1) %pt.dl.remote_loc = $1-
sockopen pictionsocket tinymp3.woggle.org 80
}
on *:sockopen:pictionsocket: {
if ($sockerr) {
m_init PDLfail
m_set setItem 1 0 Error
m_set updItem 2 0 Could Not Contact Server
return
}
; initialize variables/files
write -c $shortfn($scriptdir) $+ p_temp.txt
unset %pt.dl.rdy %pt.dl.len
m_set updItem 1 0 Initiating connection..
; request file
sockwrite -n $sockname GET /piction/ $+ $iif(%pt.dl.remote_loc,%pt.dl.remote_loc,checkver.php) HTTP/1.0
sockwrite -n $sockname Accept: */*
sockwrite -n $sockname Host: tinymp3.woggle.org
sockwrite -n $sockname
}
on *:sockread:pictionsocket: {
; if we're not ready to start writing the file (didn't get header info yet)..
if (%pt.dl.rdy != 1) {
; begin reading header info
var %header
sockread %header
while ($sockbr) {
if (Content-length: * iswm %header) {
; got the length of the file
%pt.dl.len = $gettok(%header,2,32)
m_set updMeterMax %pt.dl.len
}
elseif (* !iswm %header) {
; got the header info, ready..
%pt.dl.rdy = 1
; because we've received some bytes from the header.. we need to offset the progress thingy a bit.
%pt.dl.offset = $sock($sockname).rcvd
; ready to download, got content length.. so break out of this header loop
break
}
sockread %header
}
}
; begin binary download
m_set updItem 2 0 Starting download...
sockread 4096 &d
while ($sockbr) {
m_set updMeterCur $calc(($sock($sockname).rcvd - %pt.dl.offset))
; write the data to the end of the file
bwrite $shortfn($scriptdir) $+ p_temp.txt -1 -1 &d
; read the next bit
sockread 4096 &d
}
}
on *:sockclose:pictionsocket: {
var %file = $shortfn($scriptdir) $+ p_temp.txt
if ($read(%file,nt,1) == curversion) {
m_init PDLgotver
m_set setItem 1 0 Your version: $ver
m_set setItem 2 0 Current version: $read(%file,nt,2)
%pt.rfname = $read(%file,nt,3)
if ($ver < $read(%file,nt,2)) {
m_set setItem 3 0 NEW VERSION AVAILABLE
m_set setItem 4 1 Download New Version
m_set updItem 5 1 Close
}
else {
m_set setItem 3 0 Up to date!
m_set updItem 5 1 Close
}
}
elseif ($read($shortfn($scriptdir) $+ p_temp.txt,nt,1) == ; pictionary!) {
m_init PDLgotscript
m_set setItem 1 0 Downloaded file.
m_set setItem 4 1 Click to load new version
m_set updItem 5 1 Close
}
else {
m_init PDLfail
m_set setItem 1 0 Error
m_set updItem 2 0 Bad Data (404?)
return
}
}
; ==============================================================
; palette
alias -l makepal {
echo -a 3Pictionary: Since this is the first time you've run pictionary, a palette must be created. This may take a second or two and may disconnect you from the network.
m_init makePal
m_set updMeterMax 57
window -nfph +d @pal 0 0 57 114
var %x = 0, %y = 100, %xmax = 57, %ymult = $calc(1535 / %y), %xmult = $calc(2 / %xmax), %sat, %lum, %r, %g, %b, %c
while (%x <= %xmax) {
m_set updMeterCur %x
%y = 100
while (%y >= 0) {
%lum = %x * %xmult
%sat = $calc((%lum -1) * 255)
%c = %y * %ymult
%r = %c - 767
if (%r < 0) %r = -1 * %r
if (%r > 511) %r = 511
if (%r < 256) %r = 256
%r = %r - 256
if (%lum <= 1) %r = %lum * %r
if ((%lum > 1) && (%r < %sat)) %r = %sat
%g = %c + 255
if (%g > 1535) %g = %g - 1536
if (%g > 767) %g = $calc(-1*(1536+-1*%g))
if (%g < 0) %g = -1 * %g
if (%g > 511) %g = 511
if (%g < 256) %g = 256
%g = %g - 256
if (%lum <= 1) %g = %lum * %g
if ((%lum > 1) && (%g < %sat)) %g = %sat
%b = %c - 255
if (%b > 767) %b = $calc(-1*(1536+-1*%b))
if (%b < 0) %b = -1 * %b
if (%b > 511) %b = 511
if (%b < 256) %b = 256
%b = %b - 256
if (%lum <= 1) %b = %lum * %b
if ((%lum > 1) && (%b < %sat)) %b = %sat
drawdot -nr @pal $rgb(%r,%g,%b) 1 %x %y
dec %y
}
inc %x
}
drawrect -nf @pal 0 0 0 100 7 7
drawrect -nf @pal 1 0 7 100 7 7
drawrect -nf @pal 2 0 14 100 7 7
drawrect -nf @pal 3 0 21 100 7 7
drawrect -nf @pal 4 0 28 100 7 7
drawrect -nf @pal 5 0 35 100 7 7
drawrect -nf @pal 6 0 42 100 7 7
drawrect -nf @pal 7 0 49 100 7 7
drawrect -nf @pal 8 0 0 107 7 7
drawrect -nf @pal 9 0 7 107 7 7
drawrect -nf @pal 10 0 14 107 7 7
drawrect -nf @pal 11 0 21 107 7 7
drawrect -nf @pal 12 0 28 107 7 7
drawrect -nf @pal 13 0 35 107 7 7
drawrect -nf @pal 14 0 42 107 7 7
drawrect -nf @pal 15 0 49 107 7 7
drawsave -b24 @pal $+(",$scriptdir,pict_pal.bmp,")
window -c @pal
m_set close
}
; render
alias -l r_main {
drawrect -nrf @pictionary $rgb(255,255,255) 0 0 0 645 350
drawrect -nrf @pictionary 0 0 0 0 645 30
drawrect -nrf @pictionary $rgb(180,180,180) 0 321 30 3 350
drawline -nr @pictionary $rgb(130,130,130) 1 320 30 320 350
drawline -nr @pictionary $rgb(110,110,110) 1 324 30 324 350
drawline -nr @pictionary $rgb(70,70,70) 1 90 30 90 350
drawline -nr @pictionary $rgb(128,128,128) 1 90 330 320 330
drawtext -nr @pictionary $rgb(255,255,255) verdana 22 10 0 P i c t i o n a r y
drawdot @pictionary
}
alias -l r_word {
drawrect -nrf @pictionary 0 0 400 5 300 25
if (%pt.word) drawtext -nr @pictionary $rgb(255,255,255) verdana 14 400 5 word: %pt.word
drawdot @pictionary
}
alias -l r_timer {
if (!$window(@pictionary)) return
drawrect -nrf @pictionary 0 0 210 5 100 20
var %w = $int($calc(98 * (%pt.timer / %pt.timerMax)))
drawrect -nr @pictionary $rgb($calc(20+(2 * (98 - %w))),90,90) 0 210 7 100 16
drawrect -nrf @pictionary $rgb($calc(20+(2 * (98 - %w))),90,90) 0 $calc(309 - %w) 8 %w 14
if (%pt.timer > 0) dec %pt.timer
drawdot @pictionary
}
alias -l r_clear drawrect -rf @pictionary $rgb(255,255,255) 0 325 30 320 320
alias -l r_txt {
var %lines = $line(@pict_txt,0), %x = 1, %max = $int($calc(296 / $height(X,%pt.font,%pt.fsize)))
if (%lines > %max) %lines = %max
drawrect -nrf @pictionary $rgb(255,255,255) 0 91 30 229 300
while (%x <= %lines) {
tokenize 32 $line(@pict_txt,%x)
if ($1 == s) drawtext -nr @pictionary $rgb(0,150,0) %pt.font %pt.fsize 92 $calc(328 - (%x * $height(X,%pt.font,%pt.fsize))) $2-
elseif ($1 == g) drawtext -nr @pictionary $rgb(0,0,150) %pt.font %pt.fsize 92 $calc(328 - (%x * $height(X,%pt.font,%pt.fsize))) $2-
elseif ($1 == a) drawtext -nr @pictionary $rgb(150,0,0) %pt.font %pt.fsize 92 $calc(328 - (%x * $height(X,%pt.font,%pt.fsize))) $2-
else drawtext -nr @pictionary 0 %pt.font %pt.fsize 92 $calc(328 - (%x * $height(X,%pt.font,%pt.fsize))) $2-
inc %x
}
drawdot @pictionary
}
alias -l r_editbox {
if (!$window(@pict_editcache)) window -hnp +d @pict_editcache 0 0 600 20
var %txt = $+(%pt.curtext,¦), %w = $width(%txt,%pt.font,%pt.fsize), %x = $calc(300 - %w)
drawrect -nrf @pict_editcache $rgb(255,255,255) 1 0 0 600 20
drawtext -nr @pict_editcache 0 %pt.font %pt.fsize %x 0 %txt
if (%w < 230) drawcopy -n @pict_editcache %x 0 229 20 @pictionary 91 331
else drawcopy -n @pict_editcache 71 0 229 20 @pictionary 91 331
drawdot @pictionary
}
alias -l r_names {
var %lines = $line(@pict_names,0), %x = 0, %lineX = $calc(2.45 * $width(X,%pt.font,%pt.fsize))
drawrect -nrf @pictionary $rgb(240,240,240) 0 0 30 90 350
drawrect -nrf @pictionary $rgb(220,220,220) 0 0 30 %lineX 350
drawline -nr @pictionary $rgb(200,200,200) 1 %lineX 30 %lineX 350
while (%lines) {
tokenize 32 $line(@pict_names,%lines)
drawtext -nrc @pictionary $iif($4 & 1,$iif($4 & 2,$rgb(220,250,220),$rgb(220,220,250)),$rgb(250,250,250)) %pt.font %pt.fsize 3 $calc(33 + (%x * $height(X,%pt.font,%pt.fsize))) 86 100 $base($1,10,10,2) $3
drawtext -nrc @pictionary $iif($4 & 1,$iif($4 & 2,$rgb(0,150,0),$rgb(0,0,150)),0) %pt.font %pt.fsize 2 $calc(32 + (%x * $height(X,%pt.font,%pt.fsize))) 87 100 $base($1,10,10,2) $3
inc %x
dec %lines
}
drawdot @pictionary
}
alias -l r_tools {
drawrect -nrf @drawtools $rgb(245,245,245) 0 0 0 150 140
drawrect -nr @drawtools $rgb(90,90,90) 1 82 2 66 136
drawrect -nrf @drawtools $rgb(230,230,230) 1 83 3 64 134
; drawtext -nr @drawtools 0 verdana 12 85 3 Colors
drawrect -nr @drawtools 0 1 88 124 11 11
drawtext -nr @drawtools 0 verdana 10 102 123 Current
drawtext -nr @drawtools 0 verdana 12 10 3 Tools
drawrect -nr @drawtools 0 1 10 25 11 11 10 40 11 11 10 55 11 11 10 70 11 11 10 90 61 14
drawtext -nr @drawtools 0 verdana 10 25 24 Pencil
drawtext -nr @drawtools 0 verdana 10 25 39 Fill
drawtext -nr @drawtools 0 verdana 10 25 54 Rectangle
drawtext -nr @drawtools 0 verdana 10 25 69 Circle
drawrect -nrf @drawtools $rgb(255,255,255) 0 11 91 59 12
drawtext -nr @drawtools 0 verdana 10 25 90 Clear
drawtext -nr @drawtools 0 verdana 10 10 108 Line Size
drawpic -nc @drawtools 87 6 $+(",$scriptdir,pict_pal.bmp,")
drawrect -nr @drawtools 0 1 86 5 58 116
r_updtools
}
alias -l r_updtools {
drawrect -nrf @drawtools $rgb(255,255,255) 0 11 26 9 9 11 41 9 9 11 56 9 9 11 71 9 9
drawrect -nrf @drawtools $rgb(245,245,245) 0 10 120 70 30
drawrect -nrf @drawtools $rgb(0,255,255) 0 11 $calc(11 + (%pt.curtool * 15)) 9 9
drawrect -nrf @drawtools %pt.curcolor 0 89 125 9 9
var %pos = $calc(%pt.cursize * 5)
drawrect -nrf @drawtools 0 0 10 125 %pos %pt.cursize
drawrect -nrf @drawtools 0 0 $calc(%pos +8) 120 5 4
drawdot -nr @drawtools $rgb(255,255,255) 1 $calc(%pos +8) 123 $calc(%pos +9) 123 $calc(%pos +11) 123 $calc(%pos +12) 123 $calc(%pos +8) 122 $calc(%pos +12) 122
drawdot @drawtools
}
menu @drawtools {
sclick: drawtoolsclick x
mouse: if ($mouse.key & 1) drawtoolsclick
}
alias -l drawtoolsclick {
var %x = $mouse.x, %y = $mouse.y
if (%x <= 80) {
if ((%y <= 35) && (%y >= 20)) %pt.curtool = 1
if ((%y <= 50) && (%y >= 36)) %pt.curtool = 2
if ((%y <= 65) && (%y >= 51)) %pt.curtool = 3
if ((%y <= 80) && (%y >= 66)) %pt.curtool = 4
}
if ((%y > 105) && (%x <= 70) && (%x > 15)) %pt.cursize = $int($calc((%x - 10) / 5))
if ($inrect(%x,%y,85,6,57,114)) %pt.curcolor = $getdot(@drawtools,%x,%y)
if (($1 == x) && ($inrect(%x,%y,10,90,61,14))) nc_send d_clear
r_updtools
}
; draw tools
menu @pictionary {
sclick: pict_click x
uclick: pict_click u
leave: pict_click u
Save Screenshot: {
window -hnp +d @pict_save 0 0 320 320
drawcopy -n @pictionary 325 30 320 320 @pict_save 0 0
var %d = $+(",$scriptdir,sshots\,"), %f = $+(",$scriptdir,sshots\screen,$base(%pt.nextscreenshot,10,10,3),.jpg,")
if (!$isdir(%d)) mkdir %d
drawsave -b24q100 @pict_save %f
note s Saved Screenshot to %f
window -c @pict_save
inc %pt.nextscreenshot
}
}
alias -l pict_click {
if (%pt.drawmode == 1) {
if (!$window(@drawtools)) drawswitch
if (($mouse.x >= 325) && ($mouse.y >= 30)) {
if (%pt.curtool == 1) {
if ($1 == x) .timerpencilsample -mo 1 20 t_pencil_sample 0 1
}
if ((%pt.curtool == 3) || (%pt.curtool == 4)) {
if ($1 == x) {
window -hnp +d @pict_cache 0 0 320 320
drawcopy @pictionary 325 30 320 320 @pict_cache 0 0
.timerrectdraw -mo 1 1 t_rect_draw $mouse.x $mouse.y
}
}
if (%pt.curtool == 2) {
var %x = $calc($mouse.x - 325), %y = $calc($mouse.y - 30)
window -hnp +d @pict_cache 0 0 320 320
drawcopy -n @pictionary 325 30 320 320 @pict_cache 0 0
drawfill -nrs @pict_cache %pt.curcolor $getdot(@pict_cache,$calc($mouse.x - 325),$calc($mouse.y - 30)) $calc($mouse.x - 325) $calc($mouse.y - 30)
drawcopy -n @pict_cache 0 0 320 320 @pictionary 325 30
window -c @pict_cache
drawdot @pictionary
nc_send t 2 %pt.curcolor %x %y
}
}
}
}
alias -l t_rect_draw {
if ($mouse.key & 1) {
drawcopy -n @pict_cache 0 0 320 320 @pictionary 325 30
if ($inrect($mouse.x,$mouse.y,325,30,320,320)) {
tokenize 32 $1-2 $calc($mouse.x - $1) $calc($mouse.y - $2)
if (%pt.curtool == 3) drawrect -nr @pictionary %pt.curcolor %pt.cursize $1-4
if (%pt.curtool == 4) drawrect -nre @pictionary %pt.curcolor %pt.cursize $1-4
}
drawdot @pictionary
.timerrectdraw -mo 1 1 t_rect_draw $1-
}
else {
window -c @pict_cache
if ($inrect($mouse.x,$mouse.y,325,30,320,320)) nc_send t %pt.curtool %pt.curcolor %pt.cursize $1-4
}
}
alias -l t_pencil_sample {
if (($mouse.key & 1) && (%pt.drawmode)) {
if ($inrect($mouse.x,$mouse.y,325,30,320,320)) {
if (!$window(@pict_pencil)) window -nhl @pict_pencil
var %x = $mouse.x, %y = $mouse.y
if (%x < 325) %x = 325
if (%x > 645) %x = 645
if (%y < 30) %y = 30
if (%y > 350) %y = 350
iline @pict_pencil 1 %x %y
drawline -r @pictionary %pt.curcolor %pt.cursize $line(@pict_pencil,2) %x %y
if ($2 > 15) {
.timerpencilsample -mo 1 20 t_pencil_sample 1 1
t_pencil_send 0
}
else .timerpencilsample -mo 1 20 t_pencil_sample 1 $calc($2 + 1)
return
}
elseif ($1) { t_pencil_send 1 }
.timerpencilsample -mo 1 20 t_pencil_sample 0 $calc($2 + 1)
}
else { t_pencil_send 1 }
}
alias -l t_pencil_send {
var %x = $line(@pict_pencil,0), %list, %last = $line(@pict_pencil,1)
while (%x) {
%list = %list $line(@pict_pencil,%x)
dec %x
}
nc_send t 1 %pt.curcolor %pt.cursize %list
clear @pict_pencil
if (!$1) iline @pict_pencil 1 %last
}
; textbox
alias -l note {
if (!$window(@pict_txt)) { window -nhl @pict_txt }
if ($1 == s) tokenize 32 s « $2-
if ($1 == g) tokenize 32 g » $2-
if ($1 == a) tokenize 32 a * $2-
var %x = $wrap($2-,%pt.font,%pt.fsize,226,0), %i = 1
while (%i <= %x) {
iline @pict_txt 1 $1 $wrap($2-,%pt.font,%pt.fsize,226,%i)
inc %i
}
r_txt
}
on *:keydown:@pictionary:*: {
var %key = $keychar
if ($asc(%key) == 32) %key = $chr(160)
if ($asc(%key) == 8) { %pt.curtext = $left(%pt.curtext,-1) | r_editbox | return }
if ($asc(%key) == 13) { if ($len(%pt.curtext)) nc_send chat %pt.curtext | %pt.curtext = | r_editbox | return }
if ($len(%pt.curtext) < 255) %pt.curtext = $+(%pt.curtext,%key)
r_editbox
}
; game
alias -l drawswitch {
if (%pt.drawmode) {
window -pdoBfhk0 +ltb @DrawTools -1 -1 150 140
window -a @DrawTools
r_tools
}
else { if ($window(@drawtools)) window -c @drawtools }
}
; netcode
on ^*:notice:pict_serv*:?: {
if (($2 == yes) && ($window(@pictionary)) && ($4 isnum)) {
sockopen pict_conn $3 $4
note s Attempting Connection to $3 on port $+($4,...)
}
if ($2 == no) echo -a 3Pictionary: User $nick is not running a pictionary server
if ($2 == versionerr) echo -a 3Pictionary: Your version $ver does not match server's version $3
haltdef
}
on *:sockopen:pict_conn: {
if ($sockerr) note s Sockerror: $sock(pict_conn).wsmsg
else {
note s Connection Established
nc_send getnames
}
}
; recognized commands
; sendname setname clearnames addname note d_clear yourIDis setDrawing t exit
on *:sockread:pict_conn: {
:moreclient
sockread %data
if ($sockbr == 0) return
tokenize 32 %data
if ($1 == note) {
note $2-
}
if ($1 == sendname) {
nc_send setname $me
}
if ($1 == clearnames) {
if (!$window(@pict_names)) window -snhl @pict_names
clear @pict_names
}
if ($1 == addname) {
; x id score name flags
if (!$window(@pict_names)) window -snhl @pict_names
aline @pict_names $base($3,10,10,2) $2 $4 $5
r_names
}
if ($1 == setname) {
; x id score oldname flags newname
if (!$window(@pict_names)) return
rline @pict_names $fline(@pict_names,$+(*,$4,*),1) $base($3,10,10,2) $2 $6 $5
r_names
}
if ($1 == updname) {
; x id score name flags
if (!$window(@pict_names)) return
rline @pict_names $fline(@pict_names,$+(*,$4,*),1) $base($3,10,10,2) $2 $4 $5
r_names
}
if ($1 == yourIDis) {
%pt.myID = $2
}
if ($1 == setDrawing) {
; id playername
%pt.drawing = $2 $3
if ($2 == %pt.myID) { %pt.drawmode = 1 }
else { %pt.drawmode = 0 }
drawswitch
}
if ($1 == d_clear) r_clear
if ($1 == t) {
if (!%pt.drawmode) {
if ($2 == 1) {
drawline -nr @pictionary $3 $4 $5-
}
if ($2 == 2) {
window -hnp +d @pict_cache 0 0 320 320
drawcopy -n @pictionary 325 30 320 320 @pict_cache 0 0
drawfill -nrs @pict_cache $3 $getdot(@pict_cache,$4,$5) $4 $5
drawcopy -n @pict_cache 0 0 320 320 @pictionary 325 30
window -c @pict_cache
}
if ($2 == 3) {
drawrect -nr @pictionary $3 $4 $5-
}
if ($2 == 4) {
drawrect -nre @pictionary $3 $4 $5-
}
drawdot @pictionary
}
}
if ($1 == exit) {
; id score name
note s $4 quit
dline @pict_names $fline(@pict_names,$+(*,$4,*),1)
r_names
}
if ($1 == word) {
%pt.word = $2-
r_word
}
if ($1 == timer) {
%pt.timerMax = $2
%pt.timer = $3
r_timer
.timerpict_count_down_timer_display -o 13 1 pict_ r_timer
}
goto moreclient
}
on *:sockclose:pict_conn: {
if ($sockerr) note s Sockerror: $sock(pict_conn).wsmsg
note s Connection Closed
}
alias -l nc_send {
if ($sock(pict_conn)) sockwrite -n pict_conn $1-
}
; shutdown
on *:close:@pictionary: exit
on *:close:@picts_serv: .timer 1 0 s_ask_shutdown
on *:close:@drawtools: .timer 1 0 drawswitch
alias -l exit {
sockclose pict_conn
close -@ @pict_*
if ($window(@drawtools)) window -c @drawtools
if (%pts.enabled) .timer 1 0 s_ask_shutdown
}
; ==========================
; ==========================
; ==========================
; ==========================
; server
; ==========================
; ==========================
; ==========================
; ==========================
alias -l s_start {
if (!$isfile($+(",$scriptdir,serverConfig.ini,"))) s_makeConf
s_loadConf
if (!$isfile(%pts.wordListFile)) return $input(The server could not start because the wordlist $+(<,%pts.wordListFile,>) is missing. $crlf Edit the server config if the file is located elsewhere. $crlf Edit the wordlist in the server setup menu to create it.,o,Error)
if (%pts.enabled) return $input(Server already started.,o,Error)
if ($ip) {
if (!$portfree(%pts.port)) {
if ($sock(pict_serv)) sockclose pict_serv
%pts.enabled = 0
return $input(The server could not start because port %pts.port is not free.,o,Error)
}
if ((%pts.port !isnum) || (%pts.port < 0) || (%pts.port >= 65255)) {
if ($sock(pict_serv)) sockclose pict_serv
%pts.enabled = 0
return $input(The server could not start because port %pts.port is not a valid port.,o,Error)
}
socklisten pict_serv %pts.port
%pts.curnum = 1
%pts.enabled = 1
%pts.drawing = 0
%pts.nextword = $rand(1,$lines(%pts.wordListFile))
%pts.nextdrawer = 1
%pts.lastwinner = 1
return $false
}
else {
%pts.enabled = 0
return $input(The server could not start because mIRC cannot detect your IP address.,o,Error)
}
}
alias -l s_loadConf {
var %f = $+(",$scriptdir,serverConfig.ini,"), %s = serverConf
%pts.wordListFile = $readini(%f,n,%s,wordListFile)
%pts.minScoreAward = $readini(%f,n,%s,minScoreAward)
%pts.maxScoreAward = $readini(%f,n,%s,maxScoreAward)
%pts.artistAward = $readini(%f,n,%s,artistAward)
%pts.artistMaxAwards = $readini(%f,n,%s,artistMaxAwards)
%pts.guessedCountDownTime = $readini(%f,n,%s,guessedCountDownTime)
%pts.winScore = $readini(%f,n,%s,winScore)
%pts.gameCountDownTime = $readini(%f,n,%s,gameCountDownTime)
%pts.playerSelectMode = $readini(%f,n,%s,playerSelectMode)
%pts.maxUsers = $readini(%f,n,%s,maxUsers)
%pts.respondToChan = $readini(%f,n,%s,respondToChan)
%pts.port = $readini(%f,n,%s,port)
}
alias -l s_makeConf {
var %f = $+(",$scriptdir,serverConfig.ini,")
write -c %f
write %f [serverConf]
write %f $+(wordListFile=,",$mircdir,wordlist.txt,")
write %f ; the location of the wordlist with quotes around it ex: "c:\wordlist.txt"
write -i %f
write %f minScoreAward=1
write %f ; the minimum score given for a correct guess
write -i %f
write %f maxScoreAward=3
write %f ; the maximum score given for a correct guess
write -i %f
write %f artistAward=1
write %f ; the number of points given to an artist when a player guesses correctly
write -i %f
write %f artistMaxAwards=2
write %f ; the maximum number of times to give the award to an artist
write -i %f
write %f guessedCountDownTime=20
write %f ; the amount of time the timer is set to upon the first correct guess
write -i %f
write %f winScore=20
write %f ; the score that will reset the game and trigger a win
write -i %f
write %f gameCountDownTime=160
write %f ; the number of seconds for a game before it is ended and drawing awarded to another player
write -i %f
write %f playerSelectMode=1
write %f ; if set to 1, the player who guessed correctly first in the last game will draw next
write %f ; if set to 0, the players are selected for drawing in sequential order
write -i %f
write %f maxUsers=9999
write %f ; maximum number of users permitted to join the server
write -i %f
write %f respondToChan=1
write %f ; the server will automatically respond to "Anyone hosting a Pictionary game?" in channels with "I am"
write -i %f
write %f port=27009
write %f ; port that the server hosts on
}
alias -l s_makeWordlist {
var %f = $+(",%pts.wordListFile,")
write -c %f
write %f dog
write %f cat
write %f computer
write %f sailboat
write %f truck
write %f cow
write %f airplane
}
on *:socklisten:pict_serv: {
if ($sock(pict_client*,0) <= %pts.maxUsers) {
sockaccept $+(pict_client_,%pts.curnum)
sockmark $+(pict_client_,%pts.curnum) %pts.curnum 0 newPlayer 0
s_log accepted client tcp/ip connection // clientid: %pts.curnum ip: $sock($+(pict_client_,%pts.curnum)).ip
ncs_send 0 addname $sock($+(pict_client_,%pts.curnum)).mark
s_log sent new name to clients: $sock($+(pict_client_,%pts.curnum)).mark
ncs_send %pts.curnum sendname
ncs_send %pts.curnum yourIDis %pts.curnum
ncs_send %pts.curnum note g Welcome to Pictionary!
if ($sock(pict_client*,0) < 2) ncs_send %pts.curnum note g The game will start when there are at least two players.
if ($sock(pict_client*,0) == 2) .timerstartgame 1 1 s_start_game
inc %pts.curnum
}
}
on ^*:notice:pictionary*:?: {
if (%pts.enabled) {
if ($2 == server?) {
if ($ver == $3) { .notice $nick pict_serv yes $ip %pts.port | s_log no versionerr! }
else { .notice $nick pict_serv versionerr $ver | s_log oh noes versionerr }
s_log sent ip to requesting nick $nick
}
}
else .notice $nick pict_serv no
haltdef
}
; "search" pahaha
on *:text:Anyone hosting a Pictionary game?:#: {
if ((%pts.enabled) && (%pts.respondToChan)) {
msg $chan I'm hosting a Pictionary server.
}
}
; recognized commands
; setname getnames
on *:sockread:pict_client_*: {
:more
sockread %data
if ($sockbr == 0) return
tokenize 32 $sock($sockname).mark %data
; id score name flags type data
if ($5 == t) {
; tool data
if ((($0 > 10) || ($6 == 2)) && ($1 == %pts.drawing)) {
ncs_send 0 $5-
}
s_log recvd paint data containing roughly $0 items
}
elseif ($5 == chat) {
if ($4 & 1) return
tokenize 32 $1-5 $replace($6-,$chr(160),$chr(32))
if ($6- == %pts.word) {
s_log correct guess by $3 gave %pts.givescore points
s_updname $1 $calc($2 + %pts.givescore) $3 1
if (%pts.artistMaxAwards) {
var %temp = $1-
tokenize 32 $sock($+(pict_client_,%pts.drawing)).mark
s_updname $1 $calc($2 + %pts.artistAward) $3 3
tokenize 32 %temp
dec %pts.artistMaxAwards
}
ncs_send 0 note g $3 guessed the word!
if (%pts.givescore == %pts.maxscoreaward) {
ncs_send 0 note g This game will end in %pts.guessedCountDownTime seconds!
%pts.lastwinner = $1
.timergameend -o %pts.guessedCountDownTime 1 pict_ s_countdown
}
if (%pts.givescore > %pts.minscoreaward) dec %pts.givescore
}
elseif ((($6 isin %pts.word) && ($len($6) >= 4)) || (($7 isin %pts.word) && ($len($7) >= 4))) {
s_log CLOSE guess by $3
ncs_send $1 note g $+(",$6-,") is close!
}
else {
if ($6 == /me) ncs_send 0 note a $3 $replace($7-,$chr(160),$chr(32))
elseif ($6 == /quit) s_kick $sock($sockname).mark
elseif ($6 == /name) {
if ($7 isalnum) {
sockmark $sockname $1 $2 $7 $4
ncs_send 0 setname $1 $2 $3 $4 $7
ncs_send 0 note s $3 changed name to $7
s_log sent name change request by $3 to $7 to all
}
}
else ncs_send 0 note c $+(<,$3,>) $replace($6-,$chr(160),$chr(32))
}
s_log $+(<,$3,>) $6-
}
elseif ($5 == setname) {
if ($6) {
sockmark $sockname $1 $2 $6 $4
ncs_send 0 setname $1 $2 $3 $4 $6
s_log sent name change request by $3 to $6 to all
}
}
elseif ($5 == getnames) {
s_send_names $1 $3
}
elseif ($5 == d_clear) {
ncs_send 0 d_clear
s_log cleared drawings
}
goto more
}
alias -l s_send_names {
ncs_send $1 clearnames
var %x = $sock(pict_client*,0)
while (%x) {
ncs_send $1 addname $sock(pict_client*,%x).mark
dec %x
}
s_log sent names list to $2
}
alias -l ncs_send {
if ($1) {
sockwrite -n $+(pict_client_,$1) $2-
}
else {
if ($sock(pict_client*)) sockwrite -n pict_client* $2-
}
}
on *:sockclose:pict_client*: {
s_kick $sock($sockname).mark
}
alias -l s_kick {
; id
var %sockname = $+(pict_client_,$1)
tokenize 32 $sock(%sockname).mark
if ($1 == %pts.drawing) .timergameend -o 1 1 pict_ s_countdown
s_log QUIT $sock(%sockname).mark
ncs_send 0 exit $sock(%sockname).mark
if ($sock(%sockname)) sockclose %sockname
}
; GAME
alias -l s_start_game {
s_loadConf
if (%pts.drawing) && ($sock($+(pict_client_,%pts.drawing))) ncs_send %pts.drawing word
; reset all players
var %x = $sock(pict_client*,0), %c
while (%x) {
tokenize 32 $sock(pict_client*,%x).mark
if ($4 & 1) s_updname $1 $2 $3 0
if ($2 >= %pts.winscore) %c = $3
dec %x
}
if ($sock(pict_client*,0) < 2) { ncs_send 0 note s Game will resume when there are two players. | return }
if (%c) {
ncs_send 0 note g %c wins!
ncs_send 0 note g %c wins!
ncs_send 0 note g %c wins!
ncs_send 0 note g %c wins!
ncs_send 0 note g %c wins with %pts.winscore points!
; reset all players's scores
var %x = $sock(pict_client*,0)
while (%x) {
tokenize 32 $sock(pict_client*,%x).mark
s_updname $1 0 $3 $4
dec %x
}
}
; id score player flags
if ((%pts.lastwinner) && (%pts.playerSelectMode) && ($sock($+(pict_client_,%pts.lastwinner)))) tokenize 32 $sock($+(pict_client_,%pts.lastwinner)).mark
else tokenize 32 $sock(pict_client*,%pts.nextdrawer).mark
inc %pts.nextdrawer
if (%pts.nextdrawer > $sock(pict_client*,0)) %pts.nextdrawer = 1
s_updname $1 $2 $3 3
ncs_send 0 setDrawing $1 $3
ncs_send 0 note g $3 will draw this round!
ncs_send $1 note g You are drawing this round!
s_log set $3 as the drawing player [ id: $1 ]
%pts.drawing = $1
%pts.word = $read(%pts.wordListFile,%pts.nextword)
inc %pts.nextword $rand(1,5)
if (%pts.nextword > $lines(%pts.wordListFile)) %pts.nextword = $rand(1,5)
%pts.givescore = %pts.maxscoreaward
ncs_send %pts.drawing word %pts.word
ncs_send 0 d_clear
s_log new game: word: (edited from log in v.9997)[XXXXXX] player: $3
%pts.lastwinner = 0
ncs_send 0 timer %pts.gameCountDownTime %pts.gameCountDownTime
.timergameend -o %pts.gameCountDownTime 1 pict_ s_countdown
}
alias -l s_countdown {
if ($timer(gameend).reps <= 3) ncs_send 0 note g $+($timer(gameend).reps,!)
if (!$calc($timer(gameend).reps % 10)) ncs_send 0 timer %pts.gameCountDownTime $timer(gameend).reps
if ($timer(gameend).reps == 0) goto endgame
else {
var %x = $sock(pict_client*,0)
while (%x) {
tokenize 32 $sock(pict_client*,%x).mark
if ($4 !& 1) return
dec %x
}
.timergameend off
goto endgame
}
:endgame
ncs_send 0 note g Game ended! The word was: %pts.word
s_start_game
}
alias -l s_log {
if (!$window(@picts_serv)) { window -e @picts_serv | titlebar @picts_serv Pictionary Server: Running }
aline @picts_serv $1-
}
on *:input:@picts_serv: ncs_send 0 note s console: $1-
alias s_ask_shutdown {
if ($input(Shutdown Server?,y,Exit)) s_exit
elseif (!$window(@picts_serv)) s_log reopened window
}
alias -l s_exit {
ncs_send 0 note s Server Shutting Down
if ($sock(pict_client*)) sockclose pict_client*
if ($sock(pict_serv)) sockclose pict_serv
if ($window(@picts_serv)) window -c @picts_serv
%pts.enabled = 0
}
alias -l s_updname {
; id score name flags
ncs_send 0 updname $1-
sockmark $+(pict_client_,$1) $1-
}
; ===================================
; ================ UPnP =============
;====================================
alias upnp {
if (($1 isnum) && ($1 > 0) && ($1 < 65255)) {
unset %upnp.*
if ($window(@upnpstatus).w) clear @upnpstatus
%upnp.tempfile = $+($shortfn($scriptdir),upnp_temp.txt)
%upnp.portToForward = $1
probe
}
}
alias -l probe {
var %probe = $+(M-SEARCH * HTTP/1.1,$crlf,Host:239.255.255.250:1900,$crlf,ST:upnp:rootdevice,$crlf,Man:"ssdp:discover",$crlf,MX:3,$crlf,$crlf)
sockudp -k upnp_probe 239.255.255.250 1900 %probe
upnp_info Searching for Devices...
window -c @upnp-list
window -nhl @upnp-list
.timerstage2 -om 1 3600 upnp_stage2
}
alias -l upnp_info {
if (!$window(@upnpstatus)) window -fBp +d @upnpstatus 10 10 400 50
drawrect -fnr @upnpstatus $rgb(255,255,255) 1 0 0 400 50
drawrect -fnr @upnpstatus $rgb(200,200,200) 1 0 0 400 18
drawrect -nr @upnpstatus $rgb(20,20,20) 1 0 0 400 50
drawtext -nr @upnpstatus $rgb(0,0,0) helvetica 12 2 2 Pictionary uPnP Status
drawtext -nr @upnpstatus $rgb(0,0,0) helvetica 12 20 23 $1-
drawdot @upnpstatus
}
on 1:udpread:upnp_probe: {
if ($sockerr > 0) return
sockread %info
while ($sockbr) {
if (LOCATION: isin %info) aline @upnp-list $gettok(%info,2-,58)
sockread %info
}
}
alias upnp_stage2 {
upnp_info Done searching.
sockclose upnp_probe
set %upnp.totaldevices $line(@upnp-list,0)
aline @upnp-list ---------------------
aline @upnp-list ..
if (%upnp.totaldevices > 0) {
upnp_info Number devices found: %upnp.totaldevices
set %upnp.curdevice 1
upnploadXMLFromSource $line(@upnp-list,%upnp.curdevice)
}
else { upnp_info No Devices Found. Sorry! | upnp_shutdown }
}
alias upnploadXMLFromSource {
if ($1) {
; connect to server
var %ip_port = $gettok($1,2,47), %port = $gettok(%ip_port,2,58), %ip = $gettok(%ip_port,1,58), %req = $gettok($1,3-,47)
if (%port == $null) %port = 80
%upnp.url = $1
%upnp.ip = %ip
%upnp.port = %port
%upnp.req = $+(/,%req)
sockclose upnp_xml
if (%ip) sockopen upnp_xml %ip %port
else upnp_info Failure: starting connect for xml download (ip-port %ip_port ip %ip port %port )
}
}
on *:sockopen:upnp_xml: {
if ($sockerr) {
upnp_info Failure: sockerr: $sockerr
return
}
; initialize variables/files
if (%upnp.tempfile == $null) %upnp.tempfile = $+($shortfn($scriptdir),upnp_temp.txt)
write -c %upnp.tempfile
unset %upnp.dl.rdy %upnp.dl.len
; request file
sockwrite -n $sockname GET %upnp.req HTTP/1.0
sockwrite -n $sockname Accept: */*
sockwrite -n $sockname Host: %upnp.ip
sockwrite -n $sockname
}
on *:sockread:upnp_xml: {
if (%upnp.dl.rdy != 1) {
var %header
sockread %header
while ($sockbr) {
if (Content-length: * iswm %header) {
%upnp.dl.len = $gettok(%header,2,32)
}
elseif (* !iswm %header) {
%upnp.dl.rdy = 1
%upnp.dl.offset = $sock($sockname).rcvd
break
}
sockread %header
}
}
sockread 4096 &d
while ($sockbr) {
bset &crlf 1 $asc($cr) $asc($lf)
var %inc = 1
while (($bfind(&d,1,</)) && (%inc < 1000)) {
bcopy &d $bfind(&d,1,</) &crlf 1 2
inc %inc
}
bwrite %upnp.tempfile -1 -1 &d
sockread 4096 &d
}
}
on *:sockclose:upnp_xml: {
var %dtype = $read(%upnp.tempfile, w, *<deviceType>*)
%upnp.devicetype = $gettok(%dtype, $gettok(%dtype,0,62), 62)
if (internetgateway isin %upnp.devicetype) {
var %findwanip = $read(%upnp.tempfile, w, *WANIPConnection*)
var %readn = $readn
var %cURL = $read(%upnp.tempfile, w, *<controlurl>*, %readn)
%upnp.controlURL = $gettok(%cURL, $gettok(%cURL,0,62), 62)
aline @upnp-list >>>> This is your router <<<<
aline @upnp-list WANIPConnection ControlURL: %upnp.controlURL
%upnp.router.ip = %upnp.ip
%upnp.router.port = %upnp.port
if (http:// isin %upnp.controlURL) {
var %ip_port = $gettok(%upnp.controlURL,2,47), %port = $gettok(%ip_port,2,58), %ip = $gettok(%ip_port,1,58), %req = $gettok(%upnp.controlURL,3-,47)
%upnp.router.ip = %ip
%upnp.router.port = %port
%upnp.router.req = $+(/,%req)
}
else {
%upnp.router.req = %upnp.controlURL
}
var %name = $read(%upnp.tempfile, w, *<friendlyName>*)
%upnp.router.name = $gettok(%name, $gettok(%name,0,62), 62)
upnp_info Found router! Name: %upnp.router.name
upnp_portforward %upnp.router.ip %upnp.router.port %upnp.router.req
}
else {
aline @upnp-list .. device %upnp.curdevice is not router, IP: %upnp.ip
if (%upnp.curdevice == %upnp.totaldevices) {
aline @upnp-list LISTING COMPLETE
upnp_info Failure: Could not identify router.
}
inc %upnp.curdevice
if (%upnp.curdevice <= %upnp.totaldevices) {
upnploadXMLFromSource $line(@upnp-list,%upnp.curdevice)
}
}
}
alias upnp_portforward {
if ($1) {
%upnp.pf.port = $2
%upnp.pf.ip = $1
%upnp.pf.req = $3-
sockclose upnp_portforward
sockopen upnp_portforward $1 $2
}
}
on *:sockopen:upnp_portforward: {
if ($sockerr) {
upnp_info Failure: portforwarding request: sockerr: $sockerr
return
}
unset %upnp.dl.rdy %upnp.dl.len
%upnp.localip = $sock(upnp_portforward).bindip
sockwrite -n $sockname POST %upnp.pf.req HTTP/1.0
sockwrite -n $sockname Host: $+(%upnp.pf.ip,:,%upnp.pf.port)
sockwrite -n $sockname Content-Length: $calc(597 + ($len(%upnp.portToForward) *2) + $len(%upnp.localip))
sockwrite -n $sockname Content-Type: text/xml; charset="utf-8"
sockwrite -n $sockname SOAPACTION: "urn:schemas-upnp-org:service:WANIPConnection:1#AddPortMapping"
sockwrite -n $sockname
sockwrite -n $sockname <?xml version="1.0"?>
sockwrite -n $sockname <s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
sockwrite -n $sockname <s:Body>
sockwrite -n $sockname <u:AddPortMapping xmlns:u="urn:schemas-upnp-org:service:WANIPConnection:1">
sockwrite -n $sockname <NewRemoteHost></NewRemoteHost>
sockwrite -n $sockname $+(<NewExternalPort>,%upnp.portToForward,</NewExternalPort>)
sockwrite -n $sockname <NewProtocol>TCP</NewProtocol>
sockwrite -n $sockname $+(<NewInternalPort>,%upnp.portToForward,</NewInternalPort>)
sockwrite -n $sockname $+(<NewInternalClient>,%upnp.localip,</NewInternalClient>)
sockwrite -n $sockname <NewEnabled>1</NewEnabled>
sockwrite -n $sockname <NewPortMappingDescription>Piction</NewPortMappingDescription>
sockwrite -n $sockname <NewLeaseDuration>0</NewLeaseDuration>
sockwrite -n $sockname </u:AddPortMapping>
sockwrite -n $sockname </s:Body>
sockwrite -n $sockname </s:Envelope>
sockwrite -n $sockname
upnp_info Sent Port Forwarding Request
upnp_shutdown
}
alias -l upnp_shutdown {
window -c @upnp-list
.timercloseupnpstatus 1 1 window -c @upnpstatus
if ($isfile(%upnp.tempfile)) .remove %upnp.tempfile
}
; uncomment this to get a file containing the router response to the request
on *:sockread:upnp_portforward: {
if ($true) {
if (%upnp.dl.rdy != 1) {
var %header
sockread %header
while ($sockbr) {
if (* !iswm %header) {
%upnp.dl.rdy = 1
%upnp.dl.offset = $sock($sockname).rcvd
break
}
sockread %header
}
}
sockread 4096 &d
while ($sockbr) {
bwrite $shortfn($scriptdir) $+ upnp_temp_response.txt -1 -1 &d
sockread 4096 &d
}
}
}