keyboard/altgr: c64 layout of petscii graphics

[sheet.git] / Shiar_Sheet / Keyboard.pm

diff --git a/Shiar_Sheet/Keyboard.pm b/Shiar_Sheet/Keyboard.pm
index 846a2a2eeaade58f4ae7fda3600ebbb544cc80b5..47c1cf015dc5023792a0ffa0989f89940ce37465 100644 (file)
--- a/Shiar_Sheet/Keyboard.pm
+++ b/Shiar_Sheet/Keyboard.pm
@@ -6,7 +6,7 @@ use warnings;
 no  warnings 'uninitialized';  # save some useless checks for more legible code
 use Carp;
 
 no  warnings 'uninitialized';  # save some useless checks for more legible code
 use Carp;
 

-our $VERSION = '2.07';
+our $VERSION = '3.00';

 
 my @casedesc = (undef, qw/shift ctrl meta/, 'shift meta');
 my @rowdesc = qw(numeric top home bottom);
 
 my @casedesc = (undef, qw/shift ctrl meta/, 'shift meta');
 my @rowdesc = qw(numeric top home bottom);


@@ -14,12 +14,12 @@ my %keyrows = do 'keys.inc.pl';
 # add first two cases of each row again with each char prepended by + (alt)
 push @$_, map { [map {"+$_"} @$_] } @$_[0,1] for map {@$_} values %keyrows;
 
 # add first two cases of each row again with each char prepended by + (alt)
 push @$_, map { [map {"+$_"} @$_] } @$_[0,1] for map {@$_} values %keyrows;
 

-my %keytrans = qw(
-       ^@ NUL ^a SOH ^b STX ^c ETX  ^d EOT ^e ENQ ^f ACK ^g BEL
-       ^h BS  ^i tab ^j LF  ^k VT   ^l FF  ^m CR  ^n SO  ^o SI
-       ^p DLE ^q DC1 ^r DC2 ^s DC3  ^t DC4 ^u NAK ^v SYN ^w ETB
-       ^x CAN ^y EM  ^z SUB ^[ ESC  ^\ FS  ^] GS  ^^ RS  ^_ US
-       ^? DEL
+my %keytrans = (
+       '^h' => "\x{232B}", # BS
+       '^i' => "\x{21E5}", # TAB
+       '^m' => "\x{21B5}", # CR
+       '^?' => "\x{2326}", # DEL
+       '^[' => "\x{238B}", # ESC

 );
 
 sub new {
 );
 
 sub new {


@@ -56,6 +56,7 @@ sub escapeclass {
        s/\+/_m/g;
        s/\[/_sbo/g;
        s/\]/_sbc/g;
        s/\+/_m/g;
        s/\[/_sbo/g;
        s/\]/_sbc/g;

+       s/\\/_b/g;

        s/^$/_/;
        return $_;
 }
        s/^$/_/;
        return $_;
 }


@@ -79,12 +80,13 @@ sub keyunalias {
        my $self = shift;
        my ($key, $ancestry) = @_;
 
        my $self = shift;
        my ($key, $ancestry) = @_;
 

-       $key =~ s/(\S*?)(\+?\^?\S)($|\s.*)/$2/;
+       $key =~ s/(\S*?)(\+?\^?\S$)/$2/;

        my $mode = $1;
        my $keyinfo = $self->{def}->{$mode}->{$key};
 
        return unless defined $keyinfo;
        my $mode = $1;
        my $keyinfo = $self->{def}->{$mode}->{$key};
 
        return unless defined $keyinfo;

-       $keyinfo =~ s/^=// or return $keyinfo;
+       return $keyinfo unless ref $keyinfo eq 'SCALAR';
+       $keyinfo = ${$keyinfo};

        return '' if $ancestry->{$key}++;  # endless loop failsafe
        return $self->keyunalias($keyinfo, $ancestry);
 }
        return '' if $ancestry->{$key}++;  # endless loop failsafe
        return $self->keyunalias($keyinfo, $ancestry);
 }


@@ -95,7 +97,7 @@ sub print_letter {
 
        return if $key eq '^0';
        return 'Esc' if $key eq "\e";
 
        return if $key eq '^0';
        return 'Esc' if $key eq "\e";

-#      return $keytrans{$key} if defined $keytrans{$key};
+       return $keytrans{$key} if defined $keytrans{$key};

        my $html = $self->{def}{$mode}{lead} . escapehtml($key);
           $html =~ s{\^(?=.)}{<small>^</small>};  # element around ctrl-identifier
           $html =~ s{\+(?=.)}{<small>+</small>};  # meta
        my $html = $self->{def}{$mode}{lead} . escapehtml($key);
           $html =~ s{\^(?=.)}{<small>^</small>};  # element around ctrl-identifier
           $html =~ s{\+(?=.)}{<small>+</small>};  # meta


@@ -104,24 +106,32 @@ sub print_letter {
 
 sub print_key {
        my $self = shift;
 
 sub print_key {
        my $self = shift;

-       my ($mode, $key, $flags) = @_;
-       my ($desc, $mnem);
+       my ($mode, $key, $def) = @_;

 
 

-       if (not defined $flags) {
-               $flags = $key eq '^0' ? 'ni' : 'no';
+       if (not defined $def) {
+               $def = [$key eq '^0' ? 'ni' : 'no'];

        }
        }

-       elsif ($flags =~ s/^=//) { # alias
-               $desc = $self->{sign}->{alias};
-               $desc .= $flags eq "\e" ? 'esc' : $flags;
-               $flags = $self->keyunalias($flags) . ' alias';
+       elsif (ref $def eq 'SCALAR') {
+               $def = [undef, $def];

        }
        }

-       if (my $txt = $self->{key}->{$mode.$key}) {
-               ($desc, $mnem) = split /\n/, $self->escapedesc($txt);
+       if (ref $def ne 'ARRAY') {
+               carp "print_key: invalid definition for $mode$key: $def";
+               return;

        }
        }

+       my ($flags, $txt) = @{$def};
+       if (ref $txt eq 'SCALAR') {
+               my $ref = ${$txt};
+               $def = $self->keyunalias($ref);
+               $ref = 'esc' if $ref eq "\e";
+               $flags //= $def->[0] if ref $def eq 'ARRAY';
+               $txt = $self->{sign}->{alias} . $ref;
+               $flags .= ' alias';
+       }
+       my ($desc, $mnem) = split /\n/, $self->escapedesc($txt);

 
        my $keytxt = $self->print_letter($key, $mode);
 
        my $keytxt = $self->print_letter($key, $mode);

-          $keytxt .= $self->{sign}->{$1} while $flags =~ s/(?:^| )(arg[a-ln-z]?)\b//;  # arguments

           $keytxt .= "<small>$self->{sign}->{motion}</small>" if $flags =~ s/ ?\bargm\b//;  # motion argument
           $keytxt .= "<small>$self->{sign}->{motion}</small>" if $flags =~ s/ ?\bargm\b//;  # motion argument

+          $keytxt .= $self->{sign}->{$1} while $flags =~ s/(?:^| )(arg[a-ln-z]?)\b//;  # arguments

        my $keyhint = defined($mnem) && qq{ title="$mnem"};
           $keytxt  = "<b$keyhint>$keytxt</b>";
           $keytxt .= ' '.$desc if defined $desc;
        my $keyhint = defined($mnem) && qq{ title="$mnem"};
           $keytxt  = "<b$keyhint>$keytxt</b>";
           $keytxt .= ' '.$desc if defined $desc;


@@ -130,6 +140,8 @@ sub print_key {
                ' onclick="setmode(%s)"',
                $1 eq '' ? '' : sprintf(q{'mode%s'}, escapeclass($1))
        );
                ' onclick="setmode(%s)"',
                $1 eq '' ? '' : sprintf(q{'mode%s'}, escapeclass($1))
        );

+       $flags =~ s/\bx\w+/ext/;
+       $flags =~ s/\bv\d+/new/;

        $flags .= ' chr'.ord(substr $key, -1) if $key ne '^0';
 
        print qq{\t\t<td class="$flags"$onclick>$keytxt};
        $flags .= ' chr'.ord(substr $key, -1) if $key ne '^0';
 
        print qq{\t\t<td class="$flags"$onclick>$keytxt};


@@ -147,11 +159,16 @@ sub print_rows {
        );
        my @modes = sort keys %{ $self->{def} };
 
        );
        my @modes = sort keys %{ $self->{def} };
 

-       print '<table id="rows" class="keys">'."\n\n";
+       printf '<table id="rows" class="%s">'."\n\n", $self->{tableclass} // 'keys';

 
 

+print_row:

        for (my $row = -1; $row <= $#{ $keyrows{$self->{map}} }; $row++) {
                my $keyrow = $row < 0 ? [["\e"]] : $keyrows{$self->{map}}->[$row];
 
        for (my $row = -1; $row <= $#{ $keyrows{$self->{map}} }; $row++) {
                my $keyrow = $row < 0 ? [["\e"]] : $keyrows{$self->{map}}->[$row];
 

+#              grep {
+#                      defined $self->{def}->{''}->{$_} or defined $self->{def}->{g}->{$_}
+#              } map { @{$_} } @{$keyrow} or next;
+

                printf qq{<tbody class="row row%d">\n}, $row+1;
                for my $basemode (@modes) {
                        my @moderows = split /\s+/,
                printf qq{<tbody class="row row%d">\n}, $row+1;
                for my $basemode (@modes) {
                        my @moderows = split /\s+/,


@@ -160,8 +177,8 @@ sub print_rows {
 
                for my $submode (@moderows ? @moderows : '') {
                        my $mode = $basemode . $submode;
 
                for my $submode (@moderows ? @moderows : '') {
                        my $mode = $basemode . $submode;

-                       my @caserows = $mode =~ s/(\d+)(?:-(\d+))?$//
-                               ? (map {$_ - 1} split //, $row == 0 && $2 || $1)  # user override
+                       my @caserows = $mode =~ s/(\d+)(?:-(\d*))?$//
+                               ? (map {$_ - 1} split //, $row == 0 ? $2 // $1 : $1)  # user override

                                : @$defrows;  # default
                        my $modekeys = $self->{def}{$mode};
 
                                : @$defrows;  # default
                        my $modekeys = $self->{def}{$mode};
 


@@ -199,44 +216,12 @@ sub print_legend {
        my ($class, $flags) = @_;
 
        say qq{\t\t<dl class="legend $class">};
        my ($class, $flags) = @_;
 
        say qq{\t\t<dl class="legend $class">};

-       printf("\t\t".'<dt class="%s">%s'."\n\t\t\t".'<dd>%s'."\n",
+       printf("\t\t".'<dt class="%s">%s'."\n\t\t\t".'<dd>%s</dd>'."\n",

                $_, map { $self->escapedesc($_) } @{ $self->{flag}->{$_} || ["($_)", '...'] }
        ) for @$flags;
        say "\t\t</dl>";
 }
 
                $_, map { $self->escapedesc($_) } @{ $self->{flag}->{$_} || ["($_)", '...'] }
        ) for @$flags;
        say "\t\t</dl>";
 }
 

-sub print_legends {
-       my $self = shift;
-       my ($input) = @_;
-
-       say "<hr/>\n";
-       say '<div class="help">';
-
-       say "\t", '<div class="left">';
-       my @groups = sort grep {/^g\d/} keys %{ $self->{flag} };
-       $self->print_legend('legend-types', \@groups);
-       say "\t</div>\n";
-
-       say "\t", '<div class="right">';
-       my @attr = sort grep {!/^g\d/} keys %{ $self->{flag} };
-       $self->print_legend('legend-options', \@attr);
-       say '';
-
-       say "\t\t", '<ul class="legend legend-set">';
-
-       say "\t\t<li>keyboard <strong>map</strong> is ",
-               ($input->{map} ? 'set to ' : ''), "<em>$self->{map}</em>";
-       say "\t\t<li><strong>keys</strong> are ",
-               "<em>", ($self->{showkeys} ? 'always shown' : 'hidden if unassigned'), "</em>",
-               (!defined $self->{showkeys} && ' by default');
-       say "\t\t<li>default <strong>style</strong> is ",
-               (defined $input->{style} && 'set to '), "<em>$self->{style}</em>";
-
-       say "\t\t</ul>";
-       say "\t</div>\n";
-       say "</div>\n";
-}
-

 1;
 
 =head1 NAME
 1;
 
 =head1 NAME


@@ -250,13 +235,10 @@ Shiar_Sheet::Keyboard - Output HTML for key sheets
        my $keys = Shiar_Sheet::Keyboard({
                def => {
                        'lead' => {
        my $keys = Shiar_Sheet::Keyboard({
                def => {
                        'lead' => {

-                               'A' => '=a', # alias
-                               'a' => 'classes',
+                               'A' => \'a', # alias
+                               'a' => ['classes', 'description', 'hover comments'],

                        },
                },
                        },
                },

-               key => {
-                       'leada' => ['description', 'comments (on hover)'],
-               },

                mode => {
                        'lead' => 'mode description',
                },
                mode => {
                        'lead' => 'mode description',
                },


@@ -267,7 +249,7 @@ Shiar_Sheet::Keyboard - Output HTML for key sheets
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 

-Used by http://sheet.shiar.nl to display keyboard sheets.
+Used by https://sheet.shiar.nl to display keyboard sheets.

 Assumes specific stylesheets and javascript from this site,
 so probably not of much use elsewhere.
 
 Assumes specific stylesheets and javascript from this site,
 so probably not of much use elsewhere.