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.
(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!
(%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 (<demo-layout> (constructor () (width height)))
(<fix-layout>))
(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
(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)
(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)))
(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))
#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)))
(define (set-surface-ink-position! ink x y)
(set-fix-rect-position! (fix-ink-extent ink) x y))
\f
-
-;;; Inks implemented by gtk_render_*, using widget style/state.
-
-(define-class (<box-ink> (constructor ()))
- (<fix-ink>)
- ;; 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 <box-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 <box-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))
-\f
;;;; Fixnum Rectangles
(define-structure (fix-rect (constructor make-fix-rect (#!optional x y width height))
<surface-ink> surface-ink? make-surface-ink
surface-ink-surface set-surface-ink-position!
-
- <box-ink> box-ink? make-box-ink
- set-box-ink! set-box-ink-position!
-
- ;;<hline-ink> make-hline-ink set-hline-ink-size!
- ;;<vline-ink> make-vline-ink set-vline-ink-size!
))
(define-package (gtk keys)
(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
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
widgets.
@end deffn
-@subsection Box Ink
-
-A fix-ink rendered by @code{gtk_paint_box}.
-
-@deffn Class <box-ink>
-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
projects / mit-scheme.git / commitdiff