Screenshots

Here is the entry widget which allow to enter a line of text


And the code used to make this screenshot

(include "gtklos-demo.stk")

(define (main args)
  (let* ((window (make <demo-window>
                        :title "STklos Entry and Events"
                        :width 400
                        :file "entry2"
                        :message "
This is a demonstration of the <entry> widget. In this demo,
an event handler is associated to the widget. This event handler
manages the \"Enter\" and \"Control-q\" keys. The former prints
a message and the second exits the demonstration.
"))
          (entry  (make <entry>
                        :max-length 50
                        :value "This is an entry"
                        :parent window
                        :event (make <event-handler> :key
                                     (lambda (e)
                                       (let ((ch (event-char e)))
                                         (cond
                                           ((char=? ch #\newline)
                                            (format #t "entry value: ~S\n"
                                                    (value (event-widget e))))
                                           ((char=? ch #\q)
                                            (when (memq 'control (event-modifiers e))
                                              (format #t "Quit\n")
                                              (exit 0))))))))))
    
    'nothing))

The following screenshot shows a usage of the Gauge widget


And the code used to make this screenshot

(include "gtklos-demo.stk")

(define (main args)
  (let* ((win  (make <demo-window> :title "Gauge Demo" 
                                         :file "gauge" :border-width 5 
                                    :message "
This is a simple demo showing a gauge and the various styles it can be given.
"))
          (grid  (make <grid> :rows 3 :columns 3 :homogeneous #f :parent win))
          (gauge (make <gauge>
                   :text "Gauge"
                   :orientation 'left-to-right
                   :style '()
                   :width 250
                   :height 20
                   :parent `(,grid :x 0 :y 0 :width 3 :pad-x 40)))
          (sep1  (make <separator>
                   :orientation 'horizontal
                   :parent `(,grid :x 0 :y 1 :width 3 :pad-y 10)))
          (show  (make <check-button>
                   :text "Show value"
                   :parent `(,grid :x 0 :y 2)
                   :command (lambda(_)
                              (let ((s (style gauge)))
                                (set! (style gauge)
                                  (if (memq 'percent s)
                                      (delete 'percent s)
                                      (cons 'percent s)))))))
          (act    (make <check-button>
                    :text "Activity mode"
                    :parent `(,grid :x 0 :y 3)
                    :command (lambda (_)
                               (let ((s (style gauge)))
                                 (set! (style gauge)
                                   (if (memq 'activity s)
                                       (delete 'activity s)
                                       (cons 'activity s)))))))
          (sep2   (make <separator>
                    :orientation 'vertical
                    :parent `(,grid :x 1 :y 2 :height 2)))
          (radio (make <radio-button>
                   :parent `(,grid :x 2 :y 2 :height 2)
                   :border-width 10
                   :title "Style"
                   :text "Radio Demo"
                   :texts '("Continuous" "Discrete")
                   :command (lambda (e)
                              (let ((s (style gauge)))
                                (set! (style gauge)
                                  (if (equal? (text (event-widget e))
                                              "Discrete")
                                      (cons 'discrete s)
                                      (delete 'discrete s))))))))
    
    ;; Animate the gauge
    (timeout 10
              (lambda ()
                (let ((v    (value gauge))
                      (from (from gauge))
                      (to   (to gauge)))
                  (set! (value gauge) (if (> v to) from (+ v 1))))))))

This is a demo using the canvas widget. The current version of STklos implement only a subset of the Gnome canvas. Note that you need to have Gnome installed to use this widget.


And the code used to make this screenshot

(include "gtklos-demo.stk")

(define canvas-msg "
This is a demo of the GTklos Canvas Widget.
This is very incomplete for now.
Canvases will be fully implemented in a
next release.
")

(define (polish-diamond c)
  (let ((vertices 10)
         (radius   60.0)
         (pi       (* 4 (atan 1)))
         (posx     100)
         (posy           100))
    
    (do ((i 0 (+ i 1)))
         ((>= i vertices))
      (let* ((a  (/ (* 2 pi i) vertices))
              (x1 (+ posx (* radius (cos a))))
              (y1 (+ posy (* radius (sin a)))))
         (do ((j (+ i 1) (+ j 1)))
             ((>= j vertices))
           (let* ((a  (/ (* 2 pi j) vertices))
                  (x2 (+ posx (* radius (cos a))))
                  (y2 (+ posy (* radius (sin a)))))
             (make <canvas-line> :parent c :points (list x1 y1 x2 y2))))))))


(define (main args)
  (let* ((win  (make <demo-window> :title "Canvas Demo" :x 100 :y 100
                      :file "canvas" :border-width 5
                      :padding 20 :message canvas-msg))
          (c    (make <canvas> :parent win))
          (poly (make <canvas-polygon> :parent c
                                            :points '(270 330 270 430 390 430 390
                                                 330 310 330 310 390 350 390
                                                 350 370 330 370 330 350 370
                                                 350 370 410 290 410 290 330)))
          
          (rect (make <canvas-rectangle> :parent c :fill-color "Goldenrod"
                      :x1 200 :y1 200 :x2 300 :y2 300)))   
    (polish-diamond c)
    rect))

Grid is one of the geometry managers available to make GUIs with STklos. The example below show a rather exhaustive usage of this manager:


And the code used to make this screenshot

(include "gtklos-demo.stk")

(define (main args)
  (let* ((win (make <demo-window> :title "GTklos Grid Demo" :file "grid2"
                     :message "
This is a simple demonstration of the grid widget.
See the code to view the options used
"))
          (g (make <grid> :columns 5 :rows 5 :parent win)))

    ;; Make a bunch of buttons with various "gridding" options
    (dotimes (i 9)
      (make <button> :text (format #f "Button ~S" i) :width 70 :height 30
             :parent `(,g :pad-x 5 :pad-y 5)))
  
    (make <button> :text "Button 8" :parent `(,g :width 3 :pad-x 50 :pad-y 5))
    (make <button> :text "Button 9" :parent `(,g :height 6 :pad-x 5 :pad-y 5))
    (make <button> :text "Button 10" :parent `(,g :height 3 :pad-x 5 :pad-y 5))
    (make <button> :text "Button 11" :parent `(,g :height 3 :pad-x 5 :pad-y 5))
  
    (dotimes (i 2)
      (make <button> :text (format #f "Button ~S" (+ i 12)) :width 70 :height 30
             :parent `(,g :pad-x 5 :pad-y 5)))
    
    (make <button> :text "Button 14" :parent `(,g :x 4 :y 7 :pad-x 5 :pad-y 5))))

GTK+ can be themed. Hereafter are some scheenshots of the Gauge seen above using different GTK+ themes