From 87d0aac5831396ce5e7e1810e78c1359bb4db170 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 5 Feb 2016 15:19:30 -0700 Subject: [PATCH] Remove (gtk_render_focus), the last stylish ink. Use a rectangle ink in the demo instead. It is too hard to calculate a stylish ink's extent, because it depends on the style context -- the current theme's colors, line widths, etc. --- src/gtk/fix-demo.scm | 24 +++++++++++++++++------- src/gtk/fix-layout.scm | 36 ------------------------------------ src/gtk/gtk.pkg | 6 ------ src/gtk/gtk.scm | 9 ++++++++- src/gtk/gtk.texinfo | 34 ++-------------------------------- 5 files changed, 27 insertions(+), 82 deletions(-) diff --git a/src/gtk/fix-demo.scm b/src/gtk/fix-demo.scm index 3f0447a6a..b18dad324 100644 --- a/src/gtk/fix-demo.scm +++ b/src/gtk/fix-demo.scm @@ -57,8 +57,8 @@ USA. (gtk-widget-show-all window) (let ((drawing (make-demo-drawing layout1))) - (let ((cursor1 (make-box-ink)) - (cursor2 (make-box-ink))) + (let ((cursor1 (make-cursor-ink)) + (cursor2 (make-cursor-ink))) (fix-drawing-add-ink! drawing cursor1 'bottom) (fix-drawing-add-ink! drawing cursor2 'bottom) (set-demo-drawing-cursor-inks! @@ -79,6 +79,13 @@ USA. (%trace ";created "layout1" and "layout2"\n")) unspecific) +(define (make-cursor-ink) + (let ((cursor (make-rectangle-ink))) + (set-rectangle-ink-width! cursor 2) + (set-rectangle-ink-color! cursor "green") + (set-rectangle-ink-fill-color! cursor (make-rgba-color 0. 1. 0. .5)) + cursor)) + (define-class ( (constructor () (width height))) ()) @@ -109,7 +116,7 @@ USA. (poly (make-polygon-ink)) (arc (make-arc-ink)) (text (make-simple-text-ink)) - (box (make-box-ink)) + (box (make-rectangle-ink)) (image (make-image-ink-from-file (merge-pathnames "conses.png" (or @@ -136,7 +143,10 @@ USA. (set-simple-text-ink-text! text widget "Hello, World!") (fix-drawing-add-ink! drawing text) - (set-box-ink! box 120 120 20 20) + (set-rectangle-ink! box 120 120 20 20) + (set-rectangle-ink-width! box 2) + (set-rectangle-ink-color! box "green") + (set-rectangle-ink-fill-color! box (make-rgba-color 0. 1. 0. .5)) (fix-drawing-add-ink! drawing box) (set-image-ink! image 170 100) @@ -217,7 +227,7 @@ USA. (cursor-inks define standard initial-value '())) (define (demo-motion-handler layout modifiers window-x window-y) - (%trace2 ";motion-handler "layout" "modifiers" "window-x" "window-y"\n") + (%trace2 ";demo-motion-handler "layout" "modifiers" "window-x" "window-y"\n") (let* ((drawing (fix-layout-drawing layout)) (view (fix-layout-view layout)) (x (+ window-x (fix-rect-x view))) @@ -236,7 +246,7 @@ USA. (lambda (cursor.widgets) (if (memq layout (cdr cursor.widgets)) (begin - (set-box-ink! + (set-rectangle-ink! (car cursor.widgets) (+ xG (fix-rect-x text-extent)) (+ yG (fix-rect-y text-extent)) @@ -250,7 +260,7 @@ USA. #t) (define (demo-button-release-handler layout type button modifiers window-x window-y) - (%trace2 ";button-release-handler "layout" "type" "button" "modifiers" "window-x" "window-y"\n") + (%trace2 ";demo-button-release-handler "layout" "type" "button" "modifiers" "window-x" "window-y"\n") (let* ((drawing (fix-layout-drawing layout)) (view (fix-layout-view layout)) (x (+ window-x (fix-rect-x view))) diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm index d8fdd235c..107c6f6bb 100644 --- a/src/gtk/fix-layout.scm +++ b/src/gtk/fix-layout.scm @@ -1738,42 +1738,6 @@ USA. (define (set-surface-ink-position! ink x y) (set-fix-rect-position! (fix-ink-extent ink) x y)) - -;;; Inks implemented by gtk_render_*, using widget style/state. - -(define-class ( (constructor ())) - () - ;; Just hoping that the effects of style xthickness, ythickness, - ;; etc. do not drop ink beyond the ink-extent. - (%shadow define standard initial-value (C-enum "GTK_SHADOW_NONE"))) - -(define-method fix-ink-draw-callback ((ink ) widget window cr area) - (declare (ignore window area)) - (%trace2 ";drawing "ink" on "widget"\n") - (let ((view (fix-layout-view widget)) - (extent (fix-ink-extent ink)) - (style (gtk-widget-style-context widget))) - (let ((x (->flonum (fix:- (fix-rect-x extent) (fix-rect-x view)))) - (y (->flonum (fix:- (fix-rect-y extent) (fix-rect-y view)))) - (width (->flonum (fix-rect-width extent))) - (height (->flonum (fix-rect-height extent)))) - (C-call "gtk_render_focus" style cr x y width height)))) - -(define-method fix-ink-move! ((ink ) dx dy) - (generic-fix-ink-move! ink dx dy)) - -(define (set-box-ink! ink x y width height) - (guarantee-fixnum x 'set-box-ink!) - (guarantee-fixnum y 'set-box-ink!) - (guarantee-size width 'set-box-ink!) - (guarantee-size height 'set-box-ink!) - (set-fix-ink! ink x y width height)) - -(define (set-box-ink-position! ink x y) - (guarantee-fixnum x 'set-box-ink!) - (guarantee-fixnum y 'set-box-ink!) - (set-fix-ink-%position! ink x y)) - ;;;; Fixnum Rectangles (define-structure (fix-rect (constructor make-fix-rect (#!optional x y width height)) diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg index b294cdb39..c9c1d504c 100644 --- a/src/gtk/gtk.pkg +++ b/src/gtk/gtk.pkg @@ -241,12 +241,6 @@ USA. surface-ink? make-surface-ink surface-ink-surface set-surface-ink-position! - - box-ink? make-box-ink - set-box-ink! set-box-ink-position! - - ;; make-hline-ink set-hline-ink-size! - ;; make-vline-ink set-vline-ink-size! )) (define-package (gtk keys) diff --git a/src/gtk/gtk.scm b/src/gtk/gtk.scm index 780cf46f3..91b144d8a 100644 --- a/src/gtk/gtk.scm +++ b/src/gtk/gtk.scm @@ -98,4 +98,11 @@ USA. (define-integrable-operator (set-color-blue! o b) (if (color? o) (flo:vector-set! o 2 b)(error:wrong-type-argument o"a color"))) (define-integrable-operator (set-color-alpha! o a) - (if (color? o) (flo:vector-set! o 3 a)(error:wrong-type-argument o"a color"))) \ No newline at end of file + (if (color? o) (flo:vector-set! o 3 a)(error:wrong-type-argument o"a color"))) +(define-integrable-operator (make-rgba-color red green blue alpha) + (let ((color (make-color))) + (set-color-red! color red) + (set-color-green! color green) + (set-color-blue! color blue) + (set-color-alpha! color alpha) + color)) \ No newline at end of file diff --git a/src/gtk/gtk.texinfo b/src/gtk/gtk.texinfo index bc220601e..1d998899d 100644 --- a/src/gtk/gtk.texinfo +++ b/src/gtk/gtk.texinfo @@ -1525,10 +1525,8 @@ in fixnum pixels. Thus flonums are rarely needed, and actually avoided. For a flonum-oriented canvas (with scale, rotate, splines, etc.), a cairo-layout seems inevitable. -Just a few types of fix-ink been implemented: line-ink, -rectangle-ink, arc-ink, simple-text-ink, image-ink and -box-ink. The last three are rendered by more modern toolkit -functions, from libraries like Pango and GdkPixbuf. +Just a few types of fix-ink have been implemented: line-ink, +rectangle-ink, arc-ink, simple-text-ink, and image-ink. Each fix-ink has a position on the canvas and a position in the drawing's display list. The display list determines the order in @@ -1997,34 +1995,6 @@ on this surface, you need to call @code{drawing-damage} to notify any widgets. @end deffn -@subsection Box Ink - -A fix-ink rendered by @code{gtk_paint_box}. - -@deffn Class -A direct subclass of fix-ink. -@end deffn - -@deffn Procedure box-ink? object -Type predicate. -@end deffn - -@deffn Procedure make-box-ink -A new box-ink. -@end deffn - -@deffn Procedure set-box-ink! box x y width height -Resizes @var{box} to @var{width} and @var{height}, and moves it -to (@var{x}, @var{y}). If @var{box} is already at the specified -position and size, this procedure does nothing. -@end deffn - -@deffn Procedure set-box-ink-position! box x y -Moves @var{box} to place its upper-left corner at point (@var{x}, -@var{y}). If @var{box} is already at the specified position, this -procedure does nothing. -@end deffn - @node Gdk Functions, Debugging Facilities, Fix Layout, API Reference @section Gdk Functions -- 2.25.1