From: Javier Sancho Date: Tue, 26 May 2020 10:37:38 +0000 (+0200) Subject: user interface example X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=2d5101a54220c88c752ea4b5e54891f5a6e31678;p=guile-irrlicht.git user interface example --- diff --git a/examples/05-user-interface.scm b/examples/05-user-interface.scm new file mode 100644 index 0000000..e723f94 --- /dev/null +++ b/examples/05-user-interface.scm @@ -0,0 +1,192 @@ +;;; guile-irrlicht --- FFI bindings for Irrlicht Engine +;;; Copyright (C) 2020 Javier Sancho +;;; +;;; This file is part of guile-irrlicht. +;;; +;;; Guile-irrlicht is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; Guile-irrlicht is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-irrlicht. If not, see +;;; . + + +;;; Irrlicht 05.User Interface example +;;; http://irrlicht.sourceforge.net/docu/example005.html + + +(use-modules (irrlicht) + (ice-9 match)) + +;; ask user for driver +(format #t + "Please select the driver you want for this example: + (a) OpenGL 1.5 + (b) Direct3D 9.0c + (c) Direct3D 8.1 + (d) Burning's Software Renderer + (e) Software Renderer + (f) NullDevice + (otherKey) exit~%~%") + +(define device-type (match (read-char) + (#\a 'opengl) + (#\b 'direct3d9) + (#\c 'direct3d8) + (#\d 'burnings) + (#\e 'software) + (#\f 'null) + (_ #f))) + +(when (not device-type) + (exit #f)) + +;; set the skin transparency by changing the alpha values of all skin-colors +(define (set-skin-transparency alpha skin) + (let loop ((default-colors '(3d-dark-shadow 3d-shadow 3d-face 3d-high-light 3d-light + active-border active-caption app-workspace button-text + gray-text high-light high-light-text inactive-border + inactive-caption tooltip tooltip-background scrollbar + window window-symbol icon icon-high-light gray-window-symbol + editable gray-editable focused-editable))) + (cond ((not (null? default-colors)) + (let* ((default-color (car default-colors)) + (color (get-color skin default-color)) + (new-color (cons alpha (cdr color)))) + (set-color! skin default-color new-color)) + (loop (cdr default-colors)))))) + +;; create device +(define device + (create-device + #:device-type device-type + #:window-size '(640 480))) + +(set-window-caption! device "Irrlicht Engine - User Interface Demo") +(set-resizable! device #t) + +(define driver (get-video-driver device)) +(define gui-env (get-gui-environment device)) + +;; load an external font and set it as the new default font in the skin +(let ((skin (get-skin gui-env)) + (font (get-font gui-env "media/fonthaettenschweiler.bmp"))) + (set-font! skin font) + (set-font! skin (get-built-in-font gui-env) #:which 'tooltip)) + +;; define some values that we'll use to identify individual GUI controls +(define GUI-ID-QUIT-BUTTON 101) +(define GUI-ID-NEW-WINDOW-BUTTON 102) +(define GUI-ID-FILE-OPEN-BUTTON 103) +(define GUI-ID-TRANSPARENCY-SCROLLBAR 104) + +;; add three buttons, the first one closes the engine, the second creates a window +;; and the third opens a file open dialog +(add-button! gui-env '(10 240 110 272) + #:id GUI-ID-QUIT-BUTTON + #:text "Quit" + #:tooltiptext "Exits Program") +(add-button! gui-env '(10 280 110 312) + #:id GUI-ID-NEW-WINDOW-BUTTON + #:text "New Window" + #:tooltiptext "Launches a new window") +(add-button! gui-env '(10 320 110 352) + #:id GUI-ID-FILE-OPEN-BUTTON + #:text "File Open" + #:tooltiptext "Opens a file") + +;; we add a scrollbar and a listbox +(add-static-text! gui-env "Transparent Control:" '(150 20 350 40) #:border #t) +(let ((scrollbar (add-scrollbar! gui-env #t '(150 45 350 60) #:id GUI-ID-TRANSPARENCY-SCROLLBAR))) + (set-max! scrollbar 255) + (set-position! scrollbar 255) + (set-skin-transparency (get-position scrollbar) (get-skin gui-env)) + (let ((alpha (car (get-color (get-skin gui-env) 'window)))) + (set-position! scrollbar alpha))) + +(add-static-text! gui-env "Logging ListBox:" '(50 110 250 130 #t)) +(define listbox (add-listbox! gui-env '(50 140 250 210))) +(add-editbox! gui-env "Editable Text" '(350 80 550 100)) + +;; create the event receiver +(define open-new-window #f) +(let ((counter 0)) + (set! open-new-window + (lambda () + (add-item! listbox "Window created") + (set! counter (+ counter 30)) + (if (> counter 200) + (set! counter 0)) + (let* ((window-size (list (+ counter 100) + (+ counter 100) + (+ counter 300) + (+ counter 200))) + (window (add-window! gui-env window-size #:text "Test window"))) + (add-static-text! gui-env "Please close me" '(35 35 140 50) + #:border #t + #:word-wrap #f + #:parent window))))) + +(define (on-event event) + (if (equal? (get-event-type event) 'gui-event) + (let* ((caller (get-event-gui-caller event)) + (id (get-id caller)) + (event-type (get-event-gui-type event))) + + (cond ((equal? event-type 'scrollbar-changed) + (if (= id GUI-ID-TRANSPARENCY-SCROLLBAR) + (let ((pos (get-position caller))) + (set-skin-transparency pos (get-skin gui-env)))) + #f) + + ((equal? event-type 'button-clicked) + (cond ((= id GUI-ID-QUIT-BUTTON) + ;; quit + (close-device device) + #t) + + ((= id GUI-ID-NEW-WINDOW-BUTTON) + ;; new-window + (open-new-window) + #t) + + ((= id GUI-ID-FILE-OPEN-BUTTON) + ;; open file + (add-item! listbox "File open") + (add-file-open-dialog! gui-env + #:title "Please choose a file" + #:restore-cwd #t) + #t) + + (else #f))) + + ((equal? event-type 'file-selected) + (add-item! listbox (get-file-name caller)) + #f) + + (else #f))) + + #f)) + +(set-event-receiver! device (make-event-receiver on-event)) + +;; Irrlicht Engine logo in the top left corner +(add-image! gui-env (get-texture driver "media/irrlichtlogo2.png") '(10 10)) + +;; game loop +(while (run device) + (when (is-window-active? device) + (begin-scene driver #:color '(0 200 200 200)) + (draw-all gui-env) + (end-scene driver))) + +;; delete device +(drop! device) +(exit #t) diff --git a/examples/media/fonthaettenschweiler.bmp b/examples/media/fonthaettenschweiler.bmp new file mode 100644 index 0000000..ca301da Binary files /dev/null and b/examples/media/fonthaettenschweiler.bmp differ diff --git a/examples/media/irrlichtlogo2.png b/examples/media/irrlichtlogo2.png new file mode 100644 index 0000000..9086b12 Binary files /dev/null and b/examples/media/irrlichtlogo2.png differ