racket/gui widgets -> scribble

gistfile1.rkt

#lang scribble/base

@(module widgets racket/gui
   (require ffi/unsafe
            mred/private/wx/gtk/types
            mred/private/wx/gtk/utils
            racket/draw/unsafe/cairo
            slideshow/pict)
   
   (provide screenshots)

   (define *width* 300)
   (define *height* 300)

   (define _GdkPixbuf (_cpointer 'GdkPixbuf))
   (define _GdkPixmap (_cpointer 'GdkPixmap))
   
   (define-cstruct _GtkAllocation
     ([x _int]
      [y _int]
      [width _int]
      [height _int]))

   (define-gtk gtk_offscreen_window_new (_fun -> _GtkWidget))
   (define-gtk gtk_window_set_default_size (_fun _GtkWidget _int _int -> _void))
   (define-gtk gtk_window_resize (_fun _GtkWidget _int _int -> _void))
   (define-gtk gtk_widget_show (_fun _GtkWidget -> _void))
   (define-gtk gtk_hbox_new (_fun _bool _int -> _GtkWidget))
   (define-gtk gtk_vbox_new (_fun _bool _int -> _GtkWidget))
   (define-gtk gtk_container_add (_fun _GtkWidget _GtkWidget -> _void))
   (define-gtk gtk_widget_reparent (_fun _GtkWidget _GtkWidget -> _void))
   (define-gtk gtk_widget_unparent (_fun _GtkWidget -> _void))
   (define-gtk gtk_offscreen_window_get_pixbuf (_fun _GtkWidget -> _GdkPixbuf))
   (define-gtk gtk_offscreen_window_get_pixmap (_fun _GtkWidget -> _GdkPixmap))
   (define-gdk gdk_cairo_set_source_pixbuf (_fun _cairo_t _GdkPixbuf _int _int -> _void))
   (define-gdk gdk_cairo_set_source_pixmap (_fun _cairo_t _GdkPixmap _int _int -> _void))
   (define-gtk gtk_fixed_new (_fun -> _GtkWidget))
   (define-gtk gtk_fixed_put (_fun _GtkWidget _GtkWidget _int _int -> _void))
   (define-gtk gtk_box_pack_start (_fun _GtkWidget _GtkWidget _bool _bool _int -> _void))
   (define-gtk gtk_widget_get_allocation (_fun _GtkWidget -> _GtkAllocation))
   (define-gtk gtk_alignment_new (_fun _double _double _double _double -> _GtkWidget))
   (define-gtk gtk_label_new (_fun _string -> _GtkWidget))

   ;; Set up Racket objects
   (define widgets
     (list (list message% "Message")
           (list button% "Button")
           (list check-box% "Check Box")
           (list radio-box% "Radio Box" '("a" "b" "c"))
           (list text-field% "Text Field")
           (list combo-field% "Combo Field" '("a" "b" "c"))
           (list choice% "Choice" '("a" "b" "c"))
           (list list-box% "List Box" '("a" "b" "c"))
           (list gauge% "Gauge" 100)
           (list slider% "Slider" 0 100)))

   (define screenshots
     (for/list ([w widgets])
       ;; Make an offscreen window to draw widgets to
       (define window (gtk_offscreen_window_new))
       (gtk_window_set_default_size window *width* *height*)
       
       (define canvas (gtk_vbox_new #t 0))
       (gtk_container_add window canvas)
       
       (define hbox (gtk_hbox_new #t 0))
       
       (define frame (new frame% [label "container"]))
       (define widget (apply make-object (car w) (append (cdr w) (list frame))))
       (define gtk-widget (send widget get-handle))
       (gtk_widget_unparent gtk-widget)
              
       (gtk_container_add hbox gtk-widget)
       (define valign (gtk_alignment_new 0.0 0.5 0.0 0.0))
       (gtk_container_add valign hbox)
       (gtk_box_pack_start canvas valign #f #f 0)
        
       (gtk_widget_show window)
       (gtk_widget_show canvas)
       (gtk_widget_show hbox)
       (gtk_widget_show valign)
       (gtk_widget_show gtk-widget)
       
       (flush-display)
       (sleep/yield 1)
       
       ;; Use Cairo to draw into a bitmap
       (define image (make-bitmap *width* *height*))
       (define target (send image get-handle))
       (define source (gtk_offscreen_window_get_pixbuf window))
       
       (define ctx (cairo_create target))
       (cairo_scale ctx 1 1)
       (gdk_cairo_set_source_pixbuf ctx source 0 0)
       (cairo_paint ctx)
       
       image)))

@(require 'widgets)

@screenshots