ADDED examples/canvas-sample.scm Index: examples/canvas-sample.scm ================================================================== --- /dev/null +++ examples/canvas-sample.scm @@ -0,0 +1,11 @@ + (use iup canvas-draw canvas-draw-iup) + + (define dlg + (dialog #:title "Test" #:minsize "320x240" + (canvas #:action (make-canvas-action + (lambda (cnv x y) + (canvas-clear! cnv) + (canvas-text! cnv 40 40 "Hello world!")))))) + + (show dlg) + (main-loop) ADDED examples/sample.scm Index: examples/sample.scm ================================================================== --- /dev/null +++ examples/sample.scm @@ -0,0 +1,259 @@ +(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)