File examples/sample.scm artifact f5c49562c2 part of check-in 8723100e73


(require-library iup)
(import (prefix iup iup:))
(use canvas-draw canvas-draw-iup)
(use srfi-4)

(define img-bits1 (u8vector->blob (u8vector
 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1
 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1
 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1
 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1
 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1
 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1
 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1
 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1
 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 2 2 2 0 2 0 2 0 2 2 0 2 2 2 0 0 0 2 2 2 0 0 2 0 2 2 0 0 0 2 2 2
 2 2 2 0 2 0 0 2 0 0 2 0 2 0 2 2 2 0 2 0 2 2 0 0 2 0 2 2 2 0 2 2
 2 2 2 0 2 0 2 2 0 2 2 0 2 2 2 2 2 0 2 0 2 2 2 0 2 0 2 2 2 0 2 2
 2 2 2 0 2 0 2 2 0 2 2 0 2 2 0 0 0 0 2 0 2 2 2 0 2 0 0 0 0 0 2 2
 2 2 2 0 2 0 2 2 0 2 2 0 2 0 2 2 2 0 2 0 2 2 2 0 2 0 2 2 2 2 2 2
 2 2 2 0 2 0 2 2 0 2 2 0 2 0 2 2 2 0 2 0 2 2 0 0 2 0 2 2 2 0 2 2
 2 2 2 0 2 0 2 2 0 2 2 0 2 2 0 0 0 0 2 2 0 0 2 0 2 2 0 0 0 2 2 2
 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 2 2 2 2 2 2 2 2
 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 2 2 2 0 2 2 2 2 2 2 2 2
 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 0 0 2 2 2 2 2 2 2 2 2
 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1
 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1
 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1
 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
)))

(define img-bits2 (u8vector->blob (u8vector
 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2
 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2
 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2
 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2
 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2
 2 2 2 2 2 2 2 2 2 2 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2
 2 2 2 2 2 2 2 2 2 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2
 2 2 2 2 2 2 2 2 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2
 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
 3 3 3 0 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
 3 3 3 0 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
 3 3 3 0 3 0 3 0 3 3 0 3 3 3 1 1 0 3 3 3 0 0 3 0 3 3 0 0 0 3 3 3
 3 3 3 0 3 0 0 3 0 0 3 0 3 0 1 1 3 0 3 0 3 3 0 0 3 0 3 3 3 0 3 3
 3 3 3 0 3 0 3 3 0 3 3 0 3 3 1 1 3 0 3 0 3 3 3 0 3 0 3 3 3 0 3 3
 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 3 3 3 0 3 0 3 3 0 3 3 0 3 0 1 1 3 0 3 0 3 3 0 0 3 0 3 3 3 0 3 3
 3 3 3 0 3 0 3 3 0 3 3 0 3 3 1 1 0 0 3 3 0 0 3 0 3 3 0 0 0 3 3 3
 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 0 3 3 3 3 3 3 3 3
 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 0 3 3 3 0 3 3 3 3 3 3 3 3
 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 0 0 0 3 3 3 3 3 3 3 3 3
 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
 2 2 2 2 2 2 2 3 3 3 3 3 3 3 1 1 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2
 2 2 2 2 2 2 3 3 3 3 3 3 3 3 1 1 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2
 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2
 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
)))

(define (iup:item-set-attributes! item . attrlst)
  (for-each (lambda (attrtok)
	      (let ((attrlst (string-split attrtok "=")))
		(iup:attribute-set! item (car attrlst)(cadr attrlst))))
	    attrlst)
  item)

(define (myaction)
  (print "My action called"))

(define (init-dialog)
  (let ((img1    (iup:image/palette 32 32 img-bits1))
	(img2    (iup:image/palette 32 32 img-bits2))
	(mnu     #f)
	(_frm-1  #f)
	(_frm-2  #f)
	(_frm-3  #f)
	(_frm-4  #f)
	(_frm-5  #f)
	(_list-1 #f)
	(_list-2 #f)
	(_list-3 #f)
	(_hbox-1 #f)
	(_vbox-1 #f)
	(_cnv-1  #f)
	(dlg     #f)
	(c1      #f))
    (iup:handle-name-set! img1 "img1")
    (iup:attribute-set! img1 "0" "0 0 0")
    (iup:attribute-set! img1 "1" "BGCOLOR")
    (iup:attribute-set! img1 "2" "255 0 0")

    (iup:handle-name-set! img2 "img2")
    (iup:attribute-set! img2 "0" "0 0 0")
    (iup:attribute-set! img2 "1" "0 255 0")
    (iup:attribute-set! img2 "2" "BGCOLOR")
    (iup:attribute-set! img2 "3" "255 0 0")

    (set! mnu (iup:menu
	       (iup:item-set-attributes!
		(iup:menu-item "IupSubmenu 1" 
			       (iup:menu
				(iup:item-set-attributes! 
				 (iup:menu-item "IupItem 1 Checked" "myaction")
				 "VALUE=ON")
				(iup:menu-separator)
				(iup:item-set-attributes!
				 (iup:menu-item "IupItem 2 Disabled" "myaction")
				 "ACTIVE=NO"))))))
    (iup:handle-name-set! mnu "mnu")

    (set! _frm-1 (iup:frame 
		  (iup:vbox 
		   (iup:button "Button Text" #:action (lambda (x)(print "Blah" x)))
		   (iup:item-set-attributes!
		    (iup:button "" #:action print) "IMAGE=img1")
		   (iup:item-set-attributes! 
		    (iup:button "" #:action print) "IMAGE=img1" "IMPRESS=img2"))))
    (iup:attribute-set! _frm-1 "TITLE" "IupButton")

    (set! _frm-2 (iup:frame
		  (iup:vbox
		   (iup:label "Label Text")
		   (iup:item-set-attributes! 
		    (iup:label "") "SEPARATOR=HORIZONTAL")
		   (iup:item-set-attributes!
		    (iup:label "") "IMAGE=img1"))))
    (iup:attribute-set! _frm-2 "TITLE" "IupLabel")

    (set! _frm-3 (iup:frame
		  (iup:vbox 
		   (iup:item-set-attributes! 
		    (iup:toggle "Toggle Text" "myaction") "VALUE=ON")
		   (iup:item-set-attributes!
		    (iup:toggle "" "myaction") "IMAGE=img1" "IMPRESS=img2")
		   (iup:item-set-attributes!
		    (iup:frame
		     (iup:radio
		      (iup:vbox
		       (iup:toggle "Toggle Text" "myaction")
		       (iup:toggle "Toggle Text" "myaction")))) "TITLE=IupRadio"))))
    (iup:attribute-set! _frm-3 "TITLE" "IupToggle")

    (set! _text-1 (iup:textbox "myaction"))
    (iup:attribute-set! _text-1 "VALUE" "IupText Text")
    (iup:attribute-set! _text-1 "SIZE" "80x")
    
    (set! _m1-1 (iup:textbox "myaction"))
    (iup:attribute-set! _m1-1 "MULTILINE" "YES")
    (iup:attribute-set! _m1-1 "VALUE" "IupMultiline Text\nSecond Line\nThird Line")
    (iup:attribute-set! _m1-1 "EXPAND" "YES")
    (iup:attribute-set! _m1-1 "SIZE" "80x60")

    (set! _frm-4 (iup:frame
		  (iup:vbox
		   _text-1
		   _m1-1)))
    (iup:attribute-set! _frm-4 "TITLE" "IupText/IupMultiline")

    (set! _list-1 
	  (iup:item-set-attributes! 
	   (iup:listbox "myaction")
	   "EXPAND=YES" 
	   "VALUE=1"
	   "1=Item 1 Text"
	   "2=Item 2 Text"
	   "3=Item 3 Text"))
	  
    (set! _list-2
	  (iup:item-set-attributes!
	   (iup:listbox "myaction")
	   "DROPDOWN=YES"
	   "EXPAND=YES"
	   "VALUE=2"
	   "1=Item 1 Text"
	   "2=Item 2 Text"
	   "3=Item 3 Text"))

    (set! _list-3
	  (iup:item-set-attributes!
	   (iup:listbox "myaction")
	   "EDITBOX=YES"
	   "EXPAND=YES"
	   "VALUE=3"
	   "1=Item 1 Text"
	   "2=Item 2 Text"
	   "3=Item 3 Text"))

    (set! _frm-5 (iup:frame
		  (iup:vbox
		   _list-1
		   _list-2
		   _list-3)))
    (iup:attribute-set! _frm-5 "TITLE" "IupList")
	   
    (set! _hbox-1 (iup:hbox
		   _frm-1
		   _frm-2
		   _frm-3
		   _frm-4
		   _frm-5))

    (set! _cnv-1 
	  ;; (iup:item-set-attributes!
	  ;;(iup:canvas)
	  ;; "BGCOLOR=128 255 0" 
	  ;; "SCROLLBAR=yes"))
	  ;; (iup:handle-name-set! _cnv-1 "cnv1")

	  ;; (use iup canvas-draw canvas-draw-iup)
	  ;; (define dlg
	  ;;   (dialog #:title "Test" #:minsize "320x240"
	  (iup:canvas #:action (make-canvas-action
				(lambda (cnv x y)
				  (canvas-clear! cnv)
				  (canvas-text! cnv 40 40 "Hello world!")
				  (canvas-rectangle! cnv 90 120 70 100)))
		      #:size "200x100"))
    ;; )
    ;; (show dlg)
    ;; (main-loop)
    (set! _vbox-1 (iup:vbox
		   _hbox-1
		   _cnv-1
		   ))

    (iup:attribute-set! _vbox-1 "MARGIN" "5x5")
    (iup:attribute-set! _vbox-1 "ALIGNMENT" "ARIGHT")
    (iup:attribute-set! _vbox-1 "GAP" "5")
    
    (set! dlg (iup:dialog _vbox-1))
    (iup:handle-name-set! dlg "dlg")
    (iup:attribute-set! dlg "MENU" "mnu")
    (iup:attribute-set! dlg "TITLE" "Iup Sample")

    ;; (set! c1 (make-canvas context:iup "cnv1"))
;; (iup:handle-ref "cnv1")))
;; _cnv-1))
    ;; (canvas-rectangle! c1 10 10 40 40)
    ))
    
(init-dialog)
(iup:show (iup:handle-ref "dlg"))
(iup:main-loop)