viewer.pl - flashcards - Stupid LaTeX flashcard viewer
HTML git clone git://lumidify.org/flashcards.git (fast, but not encrypted)
HTML git clone https://lumidify.org/git/flashcards.git (encrypted, but very slow)
HTML git clone git://4kcetb7mo7hj6grozzybxtotsub5bempzo4lirzc3437amof2c2impyd.onion/flashcards.git (over tor)
DIR Log
DIR Files
DIR Refs
DIR README
---
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;