Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch simple-draw Excluding Merge-Ins
This is equivalent to a diff from 72be863a1b to a1fa8c5f4f
2010-10-01
| ||
00:17 | Maintenance checkpoint for CHICKEN check-in: 4ef9e4a448 user: murphy tags: trunk | |
00:11 | Implemented the draw module in CHICKEN Leaf check-in: a1fa8c5f4f user: murphy tags: simple-draw | |
2010-09-30
| ||
23:53 | Added cases for different callback argument and return types in the CHICKEN callback_entry trampoline check-in: 72be863a1b user: murphy tags: trunk | |
23:03 | Documented the upcoming draw module check-in: 010b970f22 user: murphy tags: trunk | |
Changes to api/draw.wiki.
︙ | ︙ | |||
28 29 30 31 32 33 34 | Create a simple drawing canvas from a canvas control. <h3><a id="call-with-canvas"><code><nowiki>(call-with-canvas [canvas icanvas?] [proc (-> icanvas? any)]) → any</nowiki></code></a></h3> Calls the given procedure with the given simple drawing canvas and ensures that the canvas is synchronized with the underlying control. | | | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | Create a simple drawing canvas from a canvas control. <h3><a id="call-with-canvas"><code><nowiki>(call-with-canvas [canvas icanvas?] [proc (-> icanvas? any)]) → any</nowiki></code></a></h3> Calls the given procedure with the given simple drawing canvas and ensures that the canvas is synchronized with the underlying control. <h3><a id="make-canvas-action"><code><nowiki>(make-canvas-action [proc (-> icanvas? real? real? any)]) → (-> ihandle? real? real? any)</nowiki></code></a></h3> Creates a procedure that is suitable as an action callback for a canvas control. The resulting procedure creates a fresh simple drawing canvas when it is first called and runs <code>(call-with-canvas canvas proc)</code> every time it is called. The result of the call to <code>proc</code> is also the result of the new procedure. |
︙ | ︙ | |||
83 84 85 86 87 88 89 | vertical coordinates alternate in the vector <code>points</code>. <h3><a id="draw-text"><code><nowiki>(draw-text [canvas icanvas?] [text string?] [x integer?] [y integer?] [r integer?] [g integer?] [b integer?]) → void?</nowiki></code></a></h3> Draws the given string with its top left corner at the given coordinates using the given color. | | > > > | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | vertical coordinates alternate in the vector <code>points</code>. <h3><a id="draw-text"><code><nowiki>(draw-text [canvas icanvas?] [text string?] [x integer?] [y integer?] [r integer?] [g integer?] [b integer?]) → void?</nowiki></code></a></h3> Draws the given string with its top left corner at the given coordinates using the given color. <h3><a id="draw-image"><code><nowiki>(draw-image [canvas icanvas?] [name (or/c symbol? string?)] [inactive? any/c] [x integer?] [y integer?]) → void?</nowiki></code></a></h3> Draws the image identified by the given name with its top left corner at the given coordinates. If <code>inactive?</code> is true, the image is drawn in an inactive style, ie. with a superimposed gray shadow. |
Added chicken/iup-draw.scm.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | (require-library lolevel data-structures srfi-4 iup-base) (module iup-draw (icanvas? make-canvas call-with-canvas make-canvas-action canvas-size canvas-clip-rectangle-set! canvas-clip-reset! canvas-flush draw-parent-background draw-line draw-rectangle draw-arc draw-polygon draw-text draw-image) (import scheme chicken foreign lolevel data-structures srfi-4 iup-base) ;; {{{ Data types (foreign-declare "#include <iup.h>\n" "typedef struct _IdrawCanvas *IdrawCanvas;\n" "IdrawCanvas *iupDrawCreateCanvas(Ihandle *ih);\n" "void iupDrawKillCanvas(IdrawCanvas *dc);\n" "void iupDrawFlush(IdrawCanvas *dc);\n" "void iupDrawUpdateSize(IdrawCanvas *dc);\n" "void iupDrawGetSize(IdrawCanvas *dc, int *w, int *h);\n" "void iupDrawParentBackground(IdrawCanvas *dc);\n" "void iupDrawLine(IdrawCanvas *dc, int x1, int y1, int x2, int y2, unsigned char r, unsigned char g, unsigned char b);\n" "void iupDrawRectangle(IdrawCanvas *dc, int x1, int y1, int x2, int y2, unsigned char r, unsigned char g, unsigned char b, int filled);\n" "void iupDrawArc(IdrawCanvas *dc, int x1, int y1, int x2, int y2, double a1, double a2, unsigned char r, unsigned char g, unsigned char b, int filled);\n" "void iupDrawPolygon(IdrawCanvas *dc, int *points, int count, unsigned char r, unsigned char g, unsigned char b, int filled);\n" "void iupDrawText(IdrawCanvas *dc, const char *text, int len, int x, int y, unsigned char r, unsigned char g, unsigned char b);\n" "void iupDrawImage(IdrawCanvas *dc, const char *name, int make_inactive, int x, int y);\n" "void iupDrawSetClipRect(IdrawCanvas *dc, int x1, int y1, int x2, int y2);\n" "void iupDrawResetClip(IdrawCanvas *dc);\n") (include "iup-types.scm") (define *icanvas-tag* "IdrawCanvas") (define icanvas? (cut tagged-pointer? <> *icanvas-tag*)) (define (icanvas->pointer nonnull?) (if nonnull? (lambda (handle) (ensure icanvas? handle) handle) (lambda (handle) (ensure (disjoin not icanvas?) handle) handle))) (define (pointer->icanvas nonnull?) (if nonnull? (lambda (handle) (ensure pointer? handle) (tag-pointer handle *icanvas-tag*)) (lambda (handle) (and handle (tag-pointer handle *icanvas-tag*))))) (define-foreign-type icanvas (c-pointer "IdrawCanvas") (icanvas->pointer #f) (pointer->icanvas #f)) (define-foreign-type nonnull-icanvas (nonnull-c-pointer "IdrawCanvas") (icanvas->pointer #t) (pointer->icanvas #t)) ;; }}} ;; {{{ Canvas management (define make-canvas (letrec ([make-canvas/raw (foreign-lambda nonnull-icanvas "iupDrawCreateCanvas" nonnull-ihandle)] [canvas-kill! (foreign-lambda void "iupDrawKillCanvas" nonnull-icanvas)]) (lambda (handle) (set-finalizer! (make-canvas/raw handle) canvas-kill!)))) (define call-with-canvas (letrec ([canvas-update-size! (foreign-lambda void "iupDrawUpdateSize" nonnull-icanvas)]) (lambda (canvas proc) (dynamic-wind (cut canvas-update-size! canvas) (cut proc canvas) (cut canvas-flush canvas))))) (define (make-canvas-action proc) (let ([canvas #f]) (lambda (handle x y) (unless canvas (set! canvas (make-canvas handle))) (call-with-canvas canvas (cut proc <> x y))))) (define canvas-size (letrec ([canvas-size/raw (foreign-lambda void "iupDrawGetSize" nonnull-icanvas (c-pointer int) (c-pointer int))]) (lambda (canvas) (let-location ([width int -1] [height int -1]) (canvas-size/raw canvas (location width) (location height)) (values (and (not (negative? width)) width) (and (not (negative? height)) height)))))) ;; }}} ;; {{{ Drawing functions (define canvas-clip-rectangle-set! (foreign-lambda void "iupDrawSetClipRect" nonnull-icanvas int int int int)) (define canvas-clip-reset! (foreign-lambda void "iupDrawResetClip" nonnull-icanvas)) (define canvas-flush (foreign-lambda void "iupDrawFlush" nonnull-icanvas)) (define draw-parent-background (foreign-lambda void "iupDrawParentBackground" nonnull-icanvas)) (define draw-line (foreign-lambda void "iupDrawLine" nonnull-icanvas int int int int unsigned-byte unsigned-byte unsigned-byte)) (define draw-rectangle (foreign-lambda void "iupDrawRectangle" nonnull-icanvas int int int int unsigned-byte unsigned-byte unsigned-byte bool)) (define draw-arc (foreign-lambda void "iupDrawArc" nonnull-icanvas int int int int double double unsigned-byte unsigned-byte unsigned-byte bool)) (define draw-polygon (letrec ([draw-polygon/raw (foreign-lambda void "iupDrawPolygon" nonnull-icanvas s32vector int unsigned-byte unsigned-byte unsigned-byte bool)]) (lambda (canvas points r g b filled?) (let ([count (s32vector-length points)]) (ensure even? count) (draw-polygon/raw canvas points (/ count 2) r g b filled?))))) (define draw-text (letrec ([draw-text/raw (foreign-lambda void "iupDrawText" nonnull-icanvas nonnull-c-string int int int unsigned-byte unsigned-byte unsigned-byte)]) (lambda (canvas text x y r g b) (draw-text/raw canvas text (string-length text) x y r g b)))) (define draw-image (foreign-lambda void "iupDrawImage" nonnull-icanvas iname/downcase bool int int)) ;; }}} ) |
Changes to chicken/iup.setup.
1 2 3 4 5 6 7 8 9 10 11 12 | (if (and (find-library "callback" "alloc_trampoline_r") (find-library "iup" "IupOpen") (find-library "iupim" "IupLoadImage") (find-library "iupimglib" "IupImageLibOpen")) (begin (compile -s -O2 -d1 "iup-base.scm" -j iup-base "-lcallback -liup -liupim -liupimglib") (compile -c -O2 -d1 "iup-base.scm" -j iup-base -unit iup-base) (compile -s -O2 -d0 "iup-base.import.scm") (install-extension 'iup-base '("iup-base.so" "iup-base.o" "iup-base.import.so" "iup-types.scm") | | | | > > > > > > > > > > > | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | (if (and (find-library "callback" "alloc_trampoline_r") (find-library "iup" "IupOpen") (find-library "iupim" "IupLoadImage") (find-library "iupimglib" "IupImageLibOpen")) (begin (compile -s -O2 -d1 "iup-base.scm" -j iup-base "-lcallback -liup -liupim -liupimglib") (compile -c -O2 -d1 "iup-base.scm" -j iup-base -unit iup-base) (compile -s -O2 -d0 "iup-base.import.scm") (install-extension 'iup-base '("iup-base.so" "iup-base.o" "iup-base.import.so" "iup-types.scm") '((version 1.1.0) (static "iup-base.o") (static-options "-lcallback -liup -liupim -liupimglib"))) (compile -s -O2 -d1 "iup-controls.scm" -j iup-controls "-liup -liupcontrols") (compile -c -O2 -d1 "iup-controls.scm" -j iup-controls -unit iup-controls) (compile -s -O2 -d0 "iup-controls.import.scm") (install-extension 'iup-controls '("iup-controls.so" "iup-controls.o" "iup-controls.import.so") '((version 1.1.0) (static "iup-controls.o") (static-options "-liup -liupcontrols"))) (compile -s -O2 -d1 "iup-dialogs.scm" -j iup-dialogs "-liup") (compile -c -O2 -d1 "iup-dialogs.scm" -j iup-dialogs -unit iup-dialogs) (compile -s -O2 -d0 "iup-dialogs.import.scm") (install-extension 'iup-dialogs '("iup-dialogs.so" "iup-dialogs.o" "iup-dialogs.import.so") '((version 1.1.0) (static "iup-dialogs.o") (static-options "-liup"))) (compile -s -O2 -d1 "iup-draw.scm" -j iup-draw "-liup") (compile -c -O2 -d1 "iup-draw.scm" -j iup-draw -unit iup-draw) (compile -s -O2 -d0 "iup-draw.import.scm") (install-extension 'iup-draw '("iup-draw.so" "iup-draw.o" "iup-draw.import.so") '((version 1.1.0) (static "iup-draw.o") (static-options "-liup"))) (if (find-library "iupgl" "IupGLCanvasOpen") (begin (compile -s -O2 -d1 "iup-glcanvas.scm" -j iup-glcanvas "-liup -liupgl") (compile -c -O2 -d1 "iup-glcanvas.scm" -j iup-glcanvas -unit iup-glcanvas) (compile -s -O2 -d0 "iup-glcanvas.import.scm") (install-extension 'iup-glcanvas '("iup-glcanvas.so" "iup-glcanvas.o" "iup-glcanvas.import.so") '((version 1.1.0) (static "iup-glcanvas.o") (static-options "-liup -liupgl")))) (warning "IUP GLCanvas not found, bindings will not be compiled")) (if (find-library "iup_pplot" "IupPPlotOpen") (begin (compile -s -O2 -d1 "iup-pplot.scm" -j iup-pplot "-liup -liup_pplot") (compile -c -O2 -d1 "iup-pplot.scm" -j iup-pplot -unit iup-pplot) (compile -s -O2 -d0 "iup-pplot.import.scm") (install-extension 'iup-pplot '("iup-pplot.so" "iup-pplot.o" "iup-pplot.import.so") '((version 1.1.0) (static "iup-pplot.o") (static-options "-liup -liup_pplot")))) (warning "IUP PPlot not found, bindings will not be compiled")) (compile -s -O2 -d1 "iup.scm" -j iup) (compile -c -O2 -d1 "iup.scm" -j iup -unit iup) (compile -s -O2 -d0 "iup.import.scm") (install-extension 'iup '("iup.so" "iup.o" "iup.import.so") '((version 1.1.0) (static "iup.o")))) (warning "IUP not found, bindings will not be compiled")) (compile -s -O2 -d1 "iup-dynamic.scm" -j iup-dynamic) (compile -c -O2 -d1 "iup-dynamic.scm" -j iup-dynamic -unit iup-dynamic) (compile -s -O2 -d0 "iup-dynamic.import.scm") (install-extension 'iup-dynamic '("iup-dynamic.so" "iup-dynamic.o" "iup-dynamic.import.so") '((version 1.1.0) (static "iup-dynamic.o"))) |