Changeset 25748 in project

Timestamp:

01/02/12 14:05:59 (8 years ago)

Author:

juergen

Message:

iup-tutor: webbrowser and inspector added

File:

• wiki/iup-tutor (modified) (2 diffs)

wiki/iup-tutor

@@ -895 +895 @@
 </enscript>
 
+=== Some other examples
+
+The following examples are a bit more involved. The first implements a
+primitive but fully functional web browser, the other a quick and dirty
+class inspector.
+
+==== webbrowser.scm
+
+Now an example which shows how mighty iup-web is, a Chicken
+implementation of the webkit engine. With some lines of code we can
+write a fully functional webbrowser. But there is one caveat with it:
+For reasons I don't understand, the program will crash unless you load
+libiupweb.so via the LD_PRELOAD environment variable.
+
+<enscript highlight="scheme">
+
+(use iup iup-web data-structures)
+
+;;; webbrowser callbacks
+
+(define (on-history self)
+  (let (
+    (back (attribute (handle-ref "dlg-web") backcount:))
+    (fwrd (attribute (handle-ref "dlg-web") forwardcount:))
+    )
+    (print "History items")
+    (let loop ((i (if (string? back) (- (string->number back)) 0)))
+      (unless (zero? i)
+        (printf "Backward ~a: ~a~%"
+                i (attribute (handle-ref "dlg-web")
+                             (string->keyword (sprintf "itemhistory~a" i))))
+        (loop (+ i 1))))
+    (printf "Current ~a: ~a~%"
+            0 (attribute (handle-ref "dlg-web") itemhistory0:))
+    (let ((fwd (if (string? fwrd) (string->number fwrd) 0)))
+      (let loop ((i 1))
+        (unless (> i fwd)
+          (printf "Forward ~a: ~a~%"
+                  i (attribute (handle-ref "dlg-web")
+                               (string->keyword (sprintf "itemhistory~a" i))))
+          (loop (+ i 1)))))
+    'default))
+
+(define (on-navigation self url)
+  (print "web-browser navigate-cb: url " url)
+  (if (substring-index "download" url)
+    'ignore
+    'default))
+
+(define (on-error self url)
+  (print "web-browser error-cb: url " url)
+  'default)
+      
+(define (on-completion self); url)
+  (print "web-browser completed-cb: value: " (attribute self value:)); url)
+  (attribute-set! (handle-ref "dlg-listbox") insertitem1:
+                  (attribute self value:))
+  (attribute-set! (handle-ref "dlg-listbox") value:
+                  (attribute self value:))
+  'default)
+; note, that the documentation required two arguments, but the attribute
+; completed-cb: accepted only one.
+      
+(define (on-newwindow self url)
+  (print "web-browser newwindow-cb: url " url)
+  (attribute-set! self value: url)
+  'default)
+
+;;; button callbacks
+
+(define (on-back self)
+  (attribute-set! (handle-ref "dlg-web") backforward: -1)
+  'default)
+      
+(define (on-forward self)
+  (attribute-set! (handle-ref "dlg-web") backforward: 1)
+  'default)
+      
+(define (on-stop self)
+  (attribute-set! (handle-ref "dlg-web") stop: 'no)
+  'default)
+      
+(define (on-reload self)
+  (attribute-set! (handle-ref "dlg-web") reload: 'no)
+  'default)
+      
+(define (on-load self)
+  (attribute-set! (handle-ref "dlg-web") value:
+                  (attribute (handle-ref "dlg-listbox") value:))
+  'default)
+
+(define (on-search self)
+  (attribute-set! (handle-ref "dlg-web") value:
+                  "https://eu.ixquick.com")
+  'default)
+
+(define (on-home self)
+  (attribute-set! (handle-ref "dlg-web") value:
+                  "http://www.call-cc.org")
+  'default)
+
+;;; listbox callbacks
+
+(define (on-valuechanged self)
+  (print "listbox valuechanged-cb: value: "(attribute self value:))
+  (attribute-set! (handle-ref "dlg-web") value:
+                  (attribute self value:))
+  'default)
+
+(define (on-dropdown self state)
+  (print "listbox dropdown-cb: state " state " value: " (attribute self value:))
+  'default)
+
+(define (on-action self text item state)
+  (print "listbox action: text " text " item " item " state " state)
+  (if (= state 1)
+    (attribute-set! (handle-ref "dlg-web") value: text))
+  'default)
+
+(define (on-key self key)
+  (print "listbox k-any: key " key)
+  (if (= key (char->integer #\return))
+    (attribute-set! (handle-ref "dlg-web") value:
+                    (attribute self value:)))
+  'continue)
+
+;;;;;;;;;;;;;;;;; WebBrowserTest
+
+;(define dlg-textbox
+;  (textbox value: "http://wiki.call-cc.org";www.tecgraf.puc-rio.br/iup"
+;           expand: 'horizontal))
+;(handle-name-set! dlg-textbox "dlg-textbox")
+
+(define dlg-listbox
+  (listbox value: "http://www.tecgraf.puc-rio.br/iup";call-cc.org"
+           expand: 'horizontal
+           dropdown: 'yes
+           editbox: 'yes
+           #:1 "http://api.call-cc.org"
+           action: on-action
+           k-any: on-key
+           dropdown-cb: on-dropdown
+           ;valuechanged-cb: on-valuechanged
+           ;edit-cb: on-edit
+           ))
+(handle-name-set! dlg-listbox "dlg-listbox")
+
+(define dlg-web
+  (web-browser value: (attribute dlg-listbox value:)
+               ;value: (attribute dlg-textbox value:)
+               newwindow-cb: on-newwindow
+               navigate-cb: on-navigation
+               error-cb: on-error
+               completed-cb: on-completion))
+                             ;(lambda (self)
+                             ;  (on-completion self (attribute self value:)))))
+                             ;  ;; wrapper replaces the C typecast (Icallback)
+(handle-name-set! dlg-web "dlg-web")
+
+(define dlg
+  (dialog
+    (vbox
+      (hbox
+        (button "&Home" action: on-home)
+        (button "&Back" action: on-back)
+        (button "&Forward" action: on-forward)
+        (button "&Load" action: on-load)
+        (button "&Reload" action: on-reload)
+        (button "S&top" action: on-stop)
+        (button "H&istory" action: on-history)
+        (button "&Search" action: on-search)
+        (fill)
+        (button "E&xit" action: (lambda (self) 'close))
+        )
+      dlg-listbox
+      dlg-web)
+    rastersize: '800x600
+    title: 'WebBrowser))
+    ;defaultenter: btn-load
+    ;margin: '10x10
+    ;gap: 10))
+
+(show dlg)
+(main-loop)
+(destroy! dlg)
+(exit 0)
+
+</enscript>
+
+==== inspector.scm
+
+The last example is an utility to help with development. When writing an
+Iup application, you have always the problem, that you don't know in
+advance, what are the available widgets and what are the registered
+attributes and callbacks of each widget. To help with problems like this
+you can, of course, study the original documentation, and as a method of
+last resort you have to do that. But for a quick overview you can start
+the program "inspector" below. You must compile it, because it ports the
+C-function IupElementPropertiesDialog to Chicken.  This function is
+originally intended as an object inspector. We use it on the most
+primitive instantiation of each class.
+
+I know, that in the real world, C-functions and Scheme functions
+shouldn't reside in the same module. Besides that, the inspector is
+rather ugly. But that's not important here.
+
+<enscript highlight="scheme">
+
+(require-library iup-base iup-controls iup-dialogs iup-web iup-pplot
+                 iup-glcanvas)
+
+(import foreign iup-base iup-controls iup-dialogs iup-web iup-pplot
+  iup-glcanvas)
+
+(foreign-declare
+  "#include <iup.h>\n")
+  
+(define-foreign-type nonnull-ihandle (nonnull-c-pointer "Ihandle")
+        (ihandle->pointer #t)
+        (pointer->ihandle #t))
+
+(define element-properties-dialog
+  (make-constructor-procedure
+    (foreign-lambda nonnull-ihandle "IupElementPropertiesDialog"
+                    nonnull-ihandle)))
+
+(define (popup dlg . args)
+  (apply show dlg #:modal? 'yes args)
+  (destroy! dlg))
+
+(define (properties ih)
+  (popup (element-properties-dialog ih))
+  'default)
+
+(define dlg
+  (dialog
+    (vbox
+      (hbox ; headline
+        (fill)
+        (frame (label " Inspect control and dialog classes "
+                      fontsize: 15))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Dialogs" fontsize: 12)
+      (hbox
+        (button "dialog"
+                action: (lambda (self) (properties (dialog (vbox)))))
+        (button "color-dialog"
+                action: (lambda (self) (properties (color-dialog))))
+        (button "file-dialog"
+                action: (lambda (self) (properties (file-dialog))))
+        (button "font-dialog"
+                action: (lambda (self) (properties (font-dialog))))
+        (button "message-dialog"
+                action: (lambda (self) (properties (message-dialog))))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Composition widgets" fontsize: 12)
+      (hbox
+        (button "fill"
+                action: (lambda (self) (properties (fill))))
+        (button "hbox"
+                action: (lambda (self) (properties (hbox))))
+        (button "vbox"
+                action: (lambda (self) (properties (vbox))))
+        (button "zbox"
+                action: (lambda (self) (properties (zbox))))
+        (button "radio"
+                action: (lambda (self) (properties (radio (vbox)))))
+        (button "normalizer"
+                action: (lambda (self) (properties (normalizer))))
+        (button "cbox"
+                action: (lambda (self) (properties (cbox))))
+        (button "sbox"
+                action: (lambda (self) (properties (sbox (vbox)))))
+        (button "split"
+                action: (lambda (self) (properties (split (vbox) (vbox)))))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Standard widgets" fontsize: 12)
+      (hbox
+        (button "button"
+                action: (lambda (self) (properties (button))))
+        (button "canvas"
+                action: (lambda (self) (properties (canvas))))
+        (button "frame"
+                action: (lambda (self) (properties (frame))))
+        (button "label"
+                action: (lambda (self) (properties (label))))
+        (button "listbox"
+                action: (lambda (self) (properties (listbox))))
+        (button "progress-bar"
+                action: (lambda (self) (properties (progress-bar))))
+        (button "spin"
+                action: (lambda (self) (properties (spin))))
+        (fill)
+        margin: '0x0)
+      (hbox
+        (button "tabs"
+                action: (lambda (self) (properties (tabs))))
+        (button "textbox"
+                action: (lambda (self) (properties (textbox))))
+        (button "toggle"
+                action: (lambda (self) (properties (toggle))))
+        (button "treebox"
+                action: (lambda (self) (properties (treebox))))
+        (button "valuator"
+                action: (lambda (self) (properties (valuator ""))))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Additional widgets" fontsize: 12)
+      (hbox
+        (button "cells"
+                action: (lambda (self) (properties (cells))))
+        (button "color-bar"
+                action: (lambda (self) (properties (color-bar))))
+        (button "color-browser"
+                action: (lambda (self) (properties (color-browser))))
+        (button "dial"
+                action: (lambda (self) (properties (dial ""))))
+        (button "matrix"
+                action: (lambda (self) (properties (matrix))))
+        (button "pplot"
+                action: (lambda (self) (properties (pplot))))
+        (button "glcanvas"
+                action: (lambda (self) (properties (glcanvas))))
+        (button "web-browser"
+                action: (lambda (self) (properties (web-browser))))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Menu widgets" fontsize: 12)
+      (hbox
+        (button "menu"
+                action: (lambda (self) (properties (menu))))
+        (button "menu-item"
+                action: (lambda (self) (properties (menu-item))))
+        (button "menu-separator"
+                action: (lambda (self) (properties (menu-separator))))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Other widgets" fontsize: 12)
+      (hbox
+        (button "clipboard"
+                action: (lambda (self) (properties (clipboard))))
+        (button "timer"
+                action: (lambda (self) (properties (timer))))
+        (button "spinbox"
+                action: (lambda (self) (properties (spinbox (vbox)))))
+        (fill)
+        margin: '0x0)
+
+      (fill)
+      (button "E&xit"
+              expand: 'horizontal
+              action: (lambda (self) 'close))
+      )
+    margin: '15x15
+    title: "Iup inspector"))
+
+(show dlg)
+(main-loop)
+(exit 0)
+
+</enscript>
+
+When you compile this program and use it, you will note, that some
+attributes can be inherited. That means, that all children of an object
+inherit those attributes. To override this, you must set those
+attributes in the children anew (look at the margin: attribute above).
+Moreover, you'll notice that there are tabs not only on attributes and
+callbacks, but on a hash-table as well.  This is how Iup handles class
+extension. If you want a widget to have an attribute "foo", you can
+simply use (attribute-set! widget "foo" "value").  Those hash-table
+attributes are inherited as well. By the way, you are not obliged, to
+use strings only in their definition.
+  
 === Concluding remark
 
@@ -909 +1297 @@
 == Last updated
 
-Dec 04, 2011
+Jan 02, 2012