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;
}
}
}
Show Posts
