viewer.pl (3758B)
1 #!/usr/bin/env perl 2 3 use strict; 4 use warnings; 5 use utf8; 6 use open qw< :encoding(UTF-8) >; 7 binmode(STDOUT, ":utf8"); 8 use Tkx; 9 Tkx::package_require('img::png'); 10 use Data::Dumper; 11 use JSON qw(decode_json encode_json); 12 use List::Util qw(min); 13 14 sub load_cards { 15 my %cards; 16 opendir my $dir, "cache" or die "Unable to open cache directory.\n"; 17 while (my $filename = readdir($dir)) { 18 next if ($filename =~ /\A\.\.?\z/); 19 if ($filename =~ /(\A\d\d-\d\d-\d\d_\d\d\D\D)_(.+)\.png\z/) { 20 $cards{$1}{$2} = $filename; 21 } 22 } 23 closedir $dir; 24 return \%cards; 25 } 26 27 sub load_config { 28 my $path = shift; 29 my $config; 30 if (-e $path) { 31 open my $fh, "<", $path or die "Unable to open config \"$config\".\n"; 32 my $json_raw = do {local $/; <$fh>}; 33 $config = decode_json $json_raw; 34 close $fh; 35 } else { 36 $config = {}; 37 } 38 return $config; 39 } 40 41 sub remove_cruft { 42 my ($config, $cards) = @_; 43 my $clean_config; 44 my $max_view_count = 0; 45 foreach my $card (keys %$cards) { 46 if (exists $config->{cards}->{$card}) { 47 $clean_config->{cards}->{$card} = $config->{cards}->{$card}; 48 } else { 49 $clean_config->{cards}->{$card} = 0; 50 } 51 } 52 return $clean_config; 53 } 54 55 sub sort_cards { 56 my ($config, $cards) = @_; 57 my $sorted_cards; 58 foreach my $card (keys %$cards) { 59 my $view_count = $config->{cards}->{$card}; 60 $sorted_cards->{$view_count}->{$card} = $cards->{$card}; 61 } 62 return $sorted_cards; 63 } 64 65 sub get_rand_card { 66 my $cards = shift; 67 my $min_view_count = min keys(%$cards); 68 my @card_ids = keys %{$cards->{$min_view_count}}; 69 my $card = $card_ids[rand @card_ids]; 70 return ($min_view_count, $card); 71 } 72 73 sub next_card { 74 my ($config, $cards, $mw, $frame) = @_; 75 76 $$frame->g_destroy; 77 $$frame = $mw->new_ttk__frame(); 78 $$frame->g_grid(-column => 0, -row => 0, -sticky => "nsew"); 79 80 my ($view_count, $card_id) = get_rand_card $cards; 81 $mw->g_wm_title($card_id); 82 Tkx::image_create_photo("front1", -file => "cache/${card_id}_front1.png"); 83 Tkx::image_create_photo("front2", -file => "cache/${card_id}_front2.png"); 84 my $front1 = $$frame->new_ttk__label(-image => "front1"); 85 my $front2 = $$frame->new_ttk__label(-image => "front2"); 86 $front1->g_grid(-column => 0, -row => 0); 87 $front2->g_grid(-column => 0, -row => 1); 88 return ($view_count, $card_id); 89 } 90 91 sub gui { 92 my $config = load_config("config.json"); 93 my $cards = load_cards; 94 $config = remove_cruft $config, $cards; 95 $cards = sort_cards $config, $cards; 96 97 my $mw = Tkx::widget->new("."); 98 $mw->g_wm_minsize(500,500); 99 my $frame = $mw->new_ttk__frame(); 100 $frame->g_grid(-column => 0, -row => 0, -sticky => "nsew"); 101 Tkx::grid(rowconfigure => $mw, 0, -weight => 1); 102 Tkx::grid(columnconfigure => $mw, 0, -weight => 1); 103 104 my $view_count; 105 my $card_id; 106 107 # so you can press space bar multiple times without increasing the view count 108 # again (useful for reloading edited cards) 109 my $view_count_increased = 0; 110 $mw->g_bind("<Return>", sub { 111 $view_count_increased = 0; 112 ($view_count, $card_id) = next_card $config, $cards, $mw, \$frame; 113 }); 114 $mw->g_bind("<space>", sub { 115 Tkx::image_create_photo("back", -file => "cache/${card_id}_back.png"); 116 my $back = $frame->new_ttk__label(-image => "back"); 117 $back->g_grid(-column => 0, -row => 2); 118 if (!$view_count_increased) { 119 $view_count_increased = 1; 120 $config->{cards}->{$card_id}++; 121 $cards->{$view_count+1}->{$card_id} = $cards->{$view_count}->{$card_id}; 122 delete $cards->{$view_count}->{$card_id}; 123 if (!%{$cards->{$view_count}}) { 124 delete $cards->{$view_count}; 125 } 126 $frame->new_ttk__label(-text => $view_count + 1)->g_grid(-column => 1, -row => 0); 127 } 128 }); 129 130 Tkx::MainLoop; 131 open my $fh, ">", "config.json" or die "Unable to save config.\n"; 132 my $json_encoded = encode_json $config; 133 print $fh "$json_encoded\n"; 134 close $fh; 135 } 136 137 gui;