dutt (OP)
|
|
June 28, 2011, 08:20:13 PM |
|
Screenshot: This is a clone of MD TRADER in perl/tk. I don't have any trading functionality implemented as of yet, because I don't have enough bitcoins to deposit to MtGox. So if you want me to continue develop send me bitcoins until I reach 1 BTC on the address below. Or you could just implement it yourself, which should be easy if you know perl. If you have windows you need activeperl first, and maybe install some packages through the package manager, but I'm not sure actually, I developed and tested it on windows ONLY but I don't know which packages aren't vanilla activeperl. Please leave a comment. Oh and it uses the bitcoincharts telnet stream for time+sales instead of websockets because port 80 is blocked by my isp use Tk; use JSON; use LWP::Simple; use Net::Telnet; use strict; #use warnings;
#todo #ticker #multiple markets #min volume / increment filter #scrolling the ladder #options #actual trading lol
my $pid = fork(); if($pid){
my ($ask,$bid,$price,%bidx,%askx,$lastprice); my $fixprice = 0; ##TK Shiznet my($change,$volume,$ordersize,$defaultordersize,$togglecenter); my $mw = MainWindow->new; $mw->optionAdd('*font', 'Helvetica 10'); $mw->title("BT Trader"); $mw->configure(-menu => my $menubar = $mw->Menu); #menubar
my $filemb = $menubar->cascade(-label =>'File'); my $viewmb = $menubar->cascade(-label =>'View'); $filemb->command( -label => 'Config', -command => \&configure, ); $filemb->command( -label => 'Exit', -command => sub {$mw->destroy();}, );
$viewmb->command( -label => 'Time&Sales', -command => \×ales, ); $viewmb->command( -label => 'Ticker', -command => \&ticker, ); my $leftside = $mw->Frame; $leftside->Checkbutton(-text => "Fixed", -variable=>\$togglecenter,-font => ['Helvetica', '8', 'bold'])->pack(-side =>'top'); $leftside->pack(-side => 'left', -anchor => 'n'); #md ladder my $ladder = $mw->Frame(-borderwidth=>2, -relief => 'groove'); for(my $i = 28; $i>0; $i--){ my($b,$p,$a); $ladder->Button(-width => 2)->grid( $b = $ladder->Button(-textvariable => \$bid->[$i], -background => 'DodgerBlue4', -foreground => 'white'), $p = $ladder->Button(-textvariable => \$price->[$i], -background => 'snow4', -foreground => 'white'), $a = $ladder->Button(-textvariable => \$ask->[$i], -background => 'red4', -foreground => 'white'), $ladder->Button(-textvariable => \$lastprice->[$i], -width => 4), -sticky => "nsew", -pady => 0 ); $b->configure(-command => [\&button_test, $b, $p ]); $p->configure(-command => [\&button_test, $p, $p ]); $a->configure(-command => [\&button_test, $a, $p ]); #$ladder->Canvas(-background=>red, height=>1)->grid("-","-","-","-",-pady => 0); } $ladder->pack(-side=>'left'); $ladder->repeat(500, \&refresh);
sub button_test{ my ($var, $var2) = @_; $var = $var->cget(-textvariable); $var2= $var2->cget(-textvariable); print("$$var $$var2\n"); } #config window my $cfg; sub configure { if (! Exists($cfg)) { $cfg = $mw->Toplevel(); $cfg->title("Config"); } else { $cfg->deiconify( ); $cfg->raise( ); }
} #time + sales my ($tns,$tnsLB); sub timesales{ if (! Exists($tns)) { $tns = $mw->Toplevel(); $tns->title("Time&Sales"); $tnsLB = $tns->Listbox(-height => 30, -background => 'gray95', -relief => 'flat')->pack(-expand => 'y', -side=> 'left', -anchor => 'n'); } else { $tns->deiconify( ); $tns->raise( ); } } #ticker my ($tkr,); my @exchanges = ("MT Gox"); my (%thi, %tlo, %tla, %tby, %tsl, %tvol); sub ticker{ if (! Exists($tkr)) { $tkr = $mw->Toplevel(); $tkr->title("Ticker"); $tkr->Button(-text => "Exchange")->grid( $tkr->Button(-text => "High"), $tkr->Button(-text => "Low"), $tkr->Button(-text => "Last"), $tkr->Button(-text => "Bid"), $tkr->Button(-text => "Ask"), $tkr->Button(-text => "Volume"), -sticky => "nsew"); foreach my $ex(@exchanges){ $tkr->Button(-text => "$ex")->grid( $tkr->Button(-textvariable => \$thi{$ex}), $tkr->Button(-textvariable => \$tlo{$ex}), $tkr->Button(-textvariable => \$tla{$ex}), $tkr->Button(-textvariable => \$tby{$ex}), $tkr->Button(-textvariable => \$tsl{$ex}), $tkr->Button(-textvariable => \$tvol{$ex}), -sticky => "nsew"); } } else { $tns->deiconify( ); $tns->raise( ); } } my $last; sub refresh{ my($json,$json_txt,$json_ticker,$json_tl,$lastt); #market data open FILE, "md"; $json = JSON->new->utf8; $json_txt = $json->decode( <FILE> ); close FILE; #ticker open FILE, "ticker"; $json_ticker = $json->decode( <FILE> ); close FILE; $thi{"MT Gox"} = $json_ticker->{ticker}->{high}; $tlo{"MT Gox"} = $json_ticker->{ticker}->{low}; $tla{"MT Gox"} = $json_ticker->{ticker}->{last}; $tby{"MT Gox"} = $json_ticker->{ticker}->{buy}; $tsl{"MT Gox"} = $json_ticker->{ticker}->{sell}; $tvol{"MT Gox"}= $json_ticker->{ticker}->{vol}; #telnet feed open FILE, "telnet_mtg"; my($lasttime,$lastvol,@lst); #add time & sales while(<FILE> ){ $json_tl = $json->decode( $_ ); if($lasttime != $json_tl->{timestamp} && Exists($tns) ){ print("$last $json_tl->{price}\n"); $lasttime = $json_tl->{volume}."@".$json_tl->{price}; $tnsLB->insert(0,$lasttime); if($last > $json_tl->{price}){ $tnsLB->itemconfigure(0, -foreground => "red"); } if($last < $json_tl->{price}){ $tnsLB->itemconfigure(0, -foreground => "green4"); } $last = $json_tl->{price}; } $lasttime = $json_tl->{timestamp}; $last = $json_tl->{price}; $lastvol = $json_tl->{volume}; } close FILE; if(Exists($tns)){ unlink("telnet_mtg"); } #extract new data my @newprice; my %lp; #cleanup for (keys %askx){ delete $askx{$_}; } for (keys %bidx){ delete $bidx{$_}; } for (keys %lp){ delete $lp{$_}; } #extract data from dom json dump foreach my $item(@{$json_txt->{bids}}){ $bidx{ @{$item}->[0] } = @{$item}->[1]; push(@newprice,@{$item}->[0]); } foreach my $item(@{$json_txt->{asks}}){ $askx{ @{$item}->[0] } = @{$item}->[1]; push(@newprice,@{$item}->[0]); } @newprice = sort { $a <=> $b } @newprice; #last $lp{$last} = $lastvol; #fill the arrays my (@aska,@bida,@lpa); my $x = 0; foreach my $item(@newprice){ push(@bida,$bidx{$item}||""); push(@aska,$askx{$item}||""); push(@lpa,$lp{$item}||""); } #count offset + shift arrays my $i = 0; if($togglecenter || $fixprice == 0){ while($askx{$newprice[$i]} eq ""){ $i++; } $fixprice = $newprice[$i]; } else{ while($newprice[$i]<$fixprice){ $i++; } } my $toshift = $i-15; for($i=0;$i<$toshift;$i++){ shift(@newprice); shift(@aska); shift(@bida); shift(@lpa); } deep_copy(\@newprice,$price); deep_copy(\@aska,$ask); deep_copy(\@bida,$bid); deep_copy(\@lpa,$lastprice); }
sub deep_copy{ my ($src,$tgt)=@_; if (ref $_[0] eq 'HASH'){copy_href(@_)} elsif (ref $_[0] eq 'ARRAY'){copy_aref(@_)} }
sub copy_href{ $_[1]||={}; for my $key (keys %{$_[0]}){ if (ref $_[0]->{$key}){ deep_copy($_[0]->{$key},$_[1]->{$key}) } else { $_[1]->{$key} = $_[0]->{$key} } } }
sub copy_aref{ $_[1]||=[];
for my $i (0..$#{$_[0]}){ if (ref $_[0]->[$i]){ deep_copy($_[0]->[$i],$_[1]->[$i]) } else { $_[1]->[$i] = $_[0]->[$i] } } } MainLoop; kill 1, $pid; } else{ $pid = fork; if($pid){ while(1){ getstore("https://mtgox.com/code/data/getDepth.php","md"); getstore("https://mtgox.com/code/data/ticker.php","ticker"); sleep 1; } } else{ my $t = new Net::Telnet(Host=>"bitcoincharts.com", Port=>27007, Timeout=>999); my $line; while(1){ $line = $t->getline(); if($line =~ /mtgoxUSD/){ open OUT, ">>telnet_mtg"; print OUT "$line"; close OUT; } sleep 1; } } }
|