guile-pstk

commit 7d4e127440b204f58ba189daa64264bf04361291
parent 9c7e54371502090b6135dd988ff14a92c7024ded
Author: KikyTokamuro <kiky.tokamuro@yandex.ru>
Date:   Wed,  1 Dec 2021 19:50:47 +0300

Added examples

Diffstat:
A
examples/hello-color.scm
 | 
24
++++++++++++++++++++++++
A
examples/hello.scm
 | 
18
++++++++++++++++++
A
examples/themes.scm
 | 
20
++++++++++++++++++++

3 files changed, 62 insertions(+), 0 deletions(-)
diff --git a/examples/hello-color.scm b/examples/hello-color.scm
@@ -0,0 +1,24 @@
+; PS/Tk Example Program "Hello World Color"
+; Copyright (C) 2021 Daniil Archangelsky aka Kiky Tokamuro
+; Copyright (C) 2006 Nils M Holm
+; See the PS/Tk license for conditions of use.
+
+(load "../pstk.scm")
+(tk-start)
+(let* ((label (tk 'create-widget 'label 'height: 5
+                  'text: "Hello, World!" 'font: "Helvetica 20"
+                  'fg: "#ffff00" 'bg: "#a00000"))
+       (change-color
+	 (lambda ()
+	   (let ((c (tk/choose-color)))
+	     (cond ((not (string=? c ""))
+	         (label 'configure 'bg: c))))))
+       (bt-color (tk 'create-widget 'button
+		     'text: "New Color"
+		     'command: change-color))
+       (bt-quit (tk 'create-widget 'button
+                    'text: "Goodbye"
+                    'command: tk-end)))
+  (tk/pack label 'side: 'top 'expand: #t 'fill: 'x)
+  (tk/pack bt-color bt-quit 'side: 'left 'expand: #t 'fill: 'x)
+  (tk-event-loop))
diff --git a/examples/hello.scm b/examples/hello.scm
@@ -0,0 +1,18 @@
+; PS/Tk Example Program "Hello World"
+; Copyright (C) 2021 Daniil Archangelsky aka Kiky Tokamuro
+; Copyright (C) 2006 Nils M Holm
+; See the PS/Tk license for conditions of use.
+
+(load "../pstk.scm")
+(tk-start)
+(let* ((label (tk 'create-widget 'label
+                  'width: 20
+		  'height: 5
+                  'text: "Hello, World!"
+                  'font: "Helvetica 20"
+                  'fg: "#ff0000"))
+       (bt-quit (tk 'create-widget 'button
+                    'text: "Goodbye"
+                    'command: (lambda () (tk-end)))))
+  (tk/pack label bt-quit)
+  (tk-event-loop))
diff --git a/examples/themes.scm b/examples/themes.scm
@@ -0,0 +1,20 @@
+; PS/Tk Example Program "Tile Themes"
+; Copyright (C) 2021 Daniil Archangelsky aka Kiky Tokamuro
+; Copyright (C) 2007 Nils M Holm
+; See the PS/Tk license for conditions of use.
+
+(load "../pstk.scm")
+(tk-start)
+(ttk-map-widgets 'all)
+(let ((button
+        (lambda (x)
+          (let ((b (tk 'create-widget 'button
+                       'text: (string-append "Select " x " theme")
+                       'command: (lambda ()
+                                   (ttk/set-theme x)))))
+            (tk/pack b 'side: 'top 'fill: 'x)))))
+  (map button (ttk/available-themes))
+  (tk/pack (tk 'create-widget 'button
+               'text: "Exit" 'command: tk-end)
+           'fill: 'x)
+  (tk-event-loop))