Add new widgets GTK::Simple::Scale and GTK::Simple::MarkUpLabel with …

…example
finanalyst · May 16, 2016 · 462f141 · 462f141
1 parent 7ffd587
commit 462f141
Show file tree

Hide file tree

Showing 2 changed files with 171 additions and 0 deletions.
diff --git a/examples/04_marked_scale.p6 b/examples/04_marked_scale.p6
@@ -0,0 +1,73 @@
+#!/usr/bin/env perl6
+
+use v6;
+use lib 'lib';
+use GTK::Simple;
+
+my GTK::Simple::App $app .=new( :title( 'More widgets') );
+=comment
+    We introduce the MarkUpLabel and Scale widgets
+
+my %texts = <red blue> Z=>
+    '<span foreground="blue" size="x-large">Blue text</span> is <i>cool</i>!',
+    '<span foreground="red" size="x-large">Red text</span> is <b>hot</b>!'
+;
+
+$app.set_content(
+    GTK::Simple::VBox.new( 
+        GTK::Simple::HBox.new(
+            GTK::Simple::VBox.new( 
+                my $normal-label = GTK::Simple::Label.new(:text("Normal label: %texts<blue>" ) ),
+=comment
+    a vanilla label shows up the mark up text as text
+
+                my $marked-label = GTK::Simple::MarkUpLabel.new(:text("Label with markup: %texts<blue>") ),
+=comment
+    a MarkUpLabel is almost the same as a vanilla Label, but it renders the Pango markup.
+    See https://developer.gnome.org/pango/unstable/PangoMarkupFormat.html for more information
+
+                my $bR = GTK::Simple::CheckButton.new(:label('Make Red')),
+                my $bB = GTK::Simple::ToggleButton.new(:label('Make Blue')),
+                my $label-for-vertical = GTK::Simple::MarkUpLabel.new(:text('Vertical scale value is:')),
+	        my $label-for-horizontal = GTK::Simple::MarkUpLabel.new(:text('Horizontal scale value is:')),
+            ),
+            my $scale-vertical = GTK::Simple::Scale.new(:orientation<vertical>, :max(31), :min(2.4), :step(0.3), :value(21) ),
+=comment
+    A scale widget is used to provide a numerical value
+    Here is the vertical form. The maximum value is at the top.
+
+        ),
+        my $scale-horizontal = GTK::Simple::Scale.new()
+=comment
+    The default GTK::Simple::Scale behavior is horizontal orientation, with :min(0) :max(1) :step(0.1) :value(0.5)
+
+    )
+);
+
+sub make-blue($b) {
+    $normal-label.text = "Normal label: %texts<blue>";
+    $marked-label.text = "Label with markup: %texts<blue>";
+}
+
+sub make-red($b) {
+    $normal-label.text = "Normal label: %texts<red>";
+    $marked-label.text = "Label with markup: %texts<red>";
+}
+
+sub vertical-changes($b) {
+    $label-for-vertical.text = 'Number is <span foreground="green" size="large">' ~ $scale-vertical.value ~'</span>';
+}
+
+sub horizontal-changes($b) {
+    $label-for-horizontal.text = 'Number is <span foreground="green" size="large">' ~ $scale-horizontal.value ~'</span>';
+}
+
+$bB.toggled.tap: &make-blue;
+$bR.toggled.tap: &make-red;
+$scale-vertical.value-changed.tap: &vertical-changes;
+=comment
+    Note the call-back name is value-changed, not changed for a text entry
+
+$scale-horizontal.value-changed.tap: &horizontal-changes;
+
+$app.run;
diff --git a/lib/GTK/Simple.pm6 b/lib/GTK/Simple.pm6
@@ -463,6 +463,104 @@ class GTK::Simple::Label does GTK::Simple::Widget {
     }
 }
 
+# RNH additions 
+class GTK::Simple::MarkUpLabel does GTK::Simple::Widget {
+    sub gtk_label_new(Str $text)
+        is native(&gtk-lib)
+        returns GtkWidget
+        {*}
+
+    sub gtk_label_get_text(GtkWidget $label)
+        is native(&gtk-lib)
+        returns Str
+        {*}
+
+    sub gtk_label_set_text(GtkWidget $label, Str $text)
+        is native(&gtk-lib)
+        {*}
+
+    sub gtk_label_set_markup(GtkWidget $label, Str $text)
+        is native(&gtk-lib)
+        {*}
+
+    submethod BUILD(:$text = '') {
+        $!gtk_widget = gtk_label_new(''.Str);
+        gtk_label_set_markup($!gtk_widget,$text.Str);
+    }
+
+    method text() {
+        Proxy.new:
+            FETCH => { gtk_label_get_text($!gtk_widget) },
+            STORE => -> \c, \text {
+                gtk_label_set_markup($!gtk_widget, text.Str);
+            }
+    }
+}
+
+class GTK::Simple::Scale does GTK::Simple::Widget {
+    has $!orientation;
+    has $!max;
+    has $!min;
+    has $!step;
+
+    sub gtk_scale_new_with_range( int32 $orientation, num64 $min, num64 $max, num64 $step )
+        is native(&gtk-lib)
+        returns GtkWidget
+        {*}
+    # orientation:
+    # horizontal = 0
+    # vertical = 1 , inverts so that big numbers at top.
+    sub gtk_scale_set_digits( GtkWidget $scale, int32 $digits )
+        is native( &gtk-lib)
+        {*}
+
+    sub gtk_range_get_value( GtkWidget $scale )
+        is native(&gtk-lib)
+        returns num64
+        {*}
+
+    sub gtk_range_set_value( GtkWidget $scale, num64 $value )
+        is native(&gtk-lib)
+        {*}
+
+    sub gtk_range_set_inverted( GtkWidget $scale, Bool $invertOK )
+        is native(&gtk-lib)
+        {*}
+
+    submethod BUILD(:$orientation = 'horizontal', :$value = 0.5, :$max = 1, :$min = 0, :$step = 0.01) {
+        my $d = $orientation eq 'vertical' ?? 1 !! 0;
+        $!gtk_widget = gtk_scale_new_with_range(
+            $d.Int, $min.Num, $max.Num, $step.Num
+        );
+        gtk_range_set_inverted(self.WIDGET , True ) if $d == 1;
+        gtk_scale_set_digits( self.WIDGET, 2 );
+        gtk_range_set_value(self.WIDGET, $value.Num);
+    }
+
+    method value() {
+        Proxy.new:
+            FETCH => { gtk_range_get_value($!gtk_widget) },
+            STORE => -> \c, \value {
+                gtk_range_set_value($!gtk_widget, value.Num);
+            }
+    }
+
+    has $!changed_supply;
+    method value-changed() {
+        $!changed_supply //= do {
+            my $s = Supplier.new;
+            g_signal_connect_wd($!gtk_widget, "value-changed",
+                -> $, $ {
+                    $s.emit(self);
+                    CATCH { default { note $_; } }
+                },
+                OpaquePointer, 0);
+            $s.Supply;
+        }
+    }
+}
+# RNH end
+
 class GTK::Simple::Entry does GTK::Simple::Widget {
     sub gtk_entry_new()
         is native(&gtk-lib)