ADDED canvas-draw/LICENSE.txt Index: canvas-draw/LICENSE.txt ================================================================== --- /dev/null +++ canvas-draw/LICENSE.txt @@ -0,0 +1,19 @@ +Copyright (C) 2010 Thomas Chust . All rights reserved. + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the Software), +to deal in the Software without restriction, including without limitation +the rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED ASIS, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR +OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. ADDED canvas-draw/api/base.wiki Index: canvas-draw/api/base.wiki ================================================================== --- /dev/null +++ canvas-draw/api/base.wiki @@ -0,0 +1,349 @@ +

base Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/base))
CHICKEN(require-extension canvas-draw-base)
+ +Basic CD library support. Initializes the CD library when loaded. + +

Data Types

+ +

(canvas? [v any/c]) → boolean?

+ +Check whether a value is a CD canvas. + +

(context? [v any/c]) → boolean?

+ +Check whether a value is a CD driver context. + +

(state? [v any/c]) → boolean?

+ +Check whether a value is a CD canvas state. + +

Canvas Management

+ +

(context-capabilities [context context?]) → (listof symbol?)

+ +Returns a list of flags describing the capabilities supported by the given +context. + +The following flags may show up in the list: + * 'flush + * 'clear + * 'play + * 'y-axis + * 'clip-area + * 'clip-polygon + * 'region + * 'rectangle + * 'chord + * 'image/rgb + * 'image/rgba + * 'image/map + * 'get-image/rgb + * 'image/server + * 'background + * 'background-opacity + * 'write-mode + * 'line-style + * 'line-width + * 'fprimtives + * 'hatch + * 'stipple + * 'pattern + * 'font + * 'font-dimensions + * 'text-size + * 'text-orientation + * 'palette + * 'line-cap + * 'line-join + * 'path + * 'bezier + +

[use-context+ (parameter/c any)]

+ +A parameter determining whether calls to [#make-canvas|make-canvas] +should use extended variants of the passed context drivers. + +Defaults to #f. + +

(make-canvas [context context?] [data (or/c string? pointer?)]) → canvas?

+ +Creates a new canvas with the given driver context. The data is +context specific and is either a string describing the setup of the new canvas +or a pointer to some native data object. + +

+ (call-with-canvas [canvas canvas?] [proc (-> canvas? any)]) → any
+ (call-with-canvas [context context?] [data (or/c string? pointer?)] [proc (-> canvas? any)]) → any +

+ +Calls the given procedure with the given canvas and makes sure the canvas is +synchronized with external resources around the call. + +If called in the three argument form, a fresh canvas is created using the given +context and is automatically destroyed upon return from the given procedure. + +

(canvas-context [canvas canvas?]) → context?

+ +Retrieves the context from a given canvas. + +

(canvas-simulate! [canvas canvas?] [flags (listof symbol?)]) → (listof symbol?)

+ +Sets flags determining which operations should be simulated by the given canvas. +Returns the previous set of flags. + +The following flags may show up in the list: + * 'line + * 'rectangle + * 'box + * 'arc + * 'sector + * 'chord + * 'polyline + * 'polygon + * 'text + * 'all + * 'lines + * 'fills + +

(canvas-attribute [canvas canvas?] [name (or/c symbol? string?)]) → (or/c string? #f)

+ +Retrieves the value of a context specific canvas attribute. + +

+ (canvas-attribute-set! [canvas canvas?] [name (or/c symbol? string?)] [value (or/c string? #f)]) → void?
+ (set! (canvas-attribute [canvas canvas?] [name (or/c symbol? string?)]) [value (or/c string? #f)]) → void? +

+ +Sets the value of a context specific canvas attribute. + +

(canvas-state [canvas canvas?]) → state?

+ +Extracts a representation of the current state from a canvas. + +

+ (canvas-state-set! [canvas canvas?] [state state?]) → void?
+ (set! (canvas-state [canvas canvas?]) [state state?]) → void? +

+ +Restores the given state of a canvas. + +

(canvas-clear! [canvas canvas?]) → void?

+ +Clears a canvas to the background color. + +

(canvas-flush [canvas canvas?]) → void?

+ +Flushes all pending drawing operations in a canvas to its backend. + +

Coordinate System

+ +

(canvas-size [canvas canvas?]) → (values integer? integer? real? real?)

+ +Retrieves the width and height of the given canvas in pixels and millimeters. + +

(canvas-mm->px [canvas canvas?] [x/mm real?] [y/mm real?]) → (values integer? integer?)

+ +Converts a position given in millimeters into a pixel position in the given +canvas. + +

(canvas-px->mm [canvas canvas?] [x/px integer?] [y/px integer?]) → (values real? real?)

+ +Converts a position given in pixels into a physical position in the given +canvas. + +

(canvas-origin [canvas canvas?]) → (values integer? integer?)

+ +Retrieves the position of the canvas' origin. + +

(canvas-origin-set! [canvas canvas?] [x integer?] [y integer?]) → void?

+ +Defines the position of the canvas' origin. + +

(canvas-transform [canvas canvas?]) → (or/c (-> real? real? (values integer? integer?)) #f)

+ +Retrieves the active coordinate transformation of the given canvas. + +

+ (canvas-transform-set! [canvas canvas?] [proc (or/c (-> real? real? (values integer? integer?)) #f)]) → void?
+ (set! (canvas-transform [canvas canvas?]) [proc (or/c (-> real? real? (values integer? integer?)) #f)]) → void? +

+ +Defines the active coordinate transformation for the given canvas. The given +procedure must represent a linear transformation. + +

(canvas-transform-compose! [canvas canvas?] [proc (-> real? real? (values integer? integer?))]) → void?

+ +Modifies the active coordinate transformation for the given canvas by +left-multiplication with the given transformation. The given procedure must +represent a linear transformation. + +

(canvas-transform-translate! [canvas canvas?] [dx real?] [dy real?]) → void?

+ +Modifies the active coordinate transformation for the given canvas applying +a translation. + +

(canvas-transform-scale! [canvas canvas?] [sx real?] [sy real?]) → void?

+ +Modifies the active coordinate transformation for the given canvas applying +a scaling. + +

(canvas-transform-rotate! [canvas canvas?] [alpha real?]) → void?

+ +Modifies the active coordinate transformation for the given canvas applying +a rotation around the origin. + +

General Attributes

+ +

(canvas-foreground [canvas canvas?]) → integer?

+ +Retrieves the foreground color of the given canvas. + +

+ (canvas-foreground-set! [canvas canvas?] [color integer?]) → void?
+ (set! (canvas-foreground [canvas canvas?]) [color integer?]) → void? +

+ +Sets the foreground color of the given canvas. + +

(canvas-background [canvas canvas?]) → integer?

+ +Retrieves the background color of the given canvas. + +

+ (canvas-background-set! [canvas canvas?] [color integer?]) → void?
+ (set! (canvas-background [canvas canvas?]) [color integer?]) → void? +

+ +Sets the background color of the given canvas. + +

(canvas-write-mode [canvas canvas?]) → symbol?

+ +Retrieves the write mode of the given canvas. + +The mode may be one of the following symbols: + * 'replace + * 'xor + * 'not-xor + +

+ (canvas-write-mode-set! [canvas canvas?] [mode symbol?]) → void?
+ (set! (canvas-write-mode [canvas canvas?]) [mode symbol?]) → void? +

+ +Sets the write mode of the given canvas. + +

Clipping

+ +

(canvas-clip-mode [canvas canvas?]) → (or/c symbol? #f)

+ +Retrieves the clipping mode of the given canvas. + +The mode may be one of the following values: + * 'area + * 'polygon + * 'region + * #f + +In fact, #t is never returned but may be used when setting the +clipping mode. + +

+ (canvas-clip-mode-set! [canvas canvas?] [mode (or/c symbol? #f)]) → void?
+ (set! (canvas-clip-mode [canvas canvas?]) [mode (or/c symbol? #f)]) → void? +

+ +Sets the clipping mode of the given canvas. + +

(canvas-clip-area [canvas canvas?]) → (values real? real? real? real?)

+ +Retrieves the current rectangular clipping area of the given canvas. + +

(canvas-clip-area-set! [canvas canvas?] [x0 double?] [x1 double?] [y0 double?] [y1 double?]) → void?

+ +Sets the current rectangular clipping area of the given canvas. + +

Racket Specifics

+ +

+ [_canvas ctype?]
+ [_canvas/null ctype?]
+

+ +Foreign type of CD canvasses, which may optionally be NULL. + +Not re-exported from the [./main.wiki|main] module. + +

+ [_context ctype?]
+ [_context/null ctype?]
+

+ +Foreign type of CD contexts, which may optionally be NULL. + +Not re-exported from the [./main.wiki|main] module. + +

+ [_state ctype?]
+ [_state/null ctype?]
+

+ +Foreign type of CD states, which may optionally be NULL. + +Not re-exported from the [./main.wiki|main] module. + +

CHICKEN Specifics

+ +The base module only exports checking type conversion functions +instead of foreign types since the latter cannot be exported. To define +the types canvas, nonnull-canvas, +context, nonnull-context, state and +nonnull-state in your own module, include the file +"canvas-draw-types.scm". + +

((canvas->pointer [nonnull? any/c]) [canvas (or/c canvas? #f)]) → (or/c pointer? #f)

+ +Checking conversion from canvasses to pointers. + +Not re-exported from the [./main.wiki|main] module. + +

((pointer->canvas [nonnull? any/c]) [canvas (or/c pointer? #f)]) → (or/c canvas? #f)

+ +Checking conversion from pointers to canvasses. + +Not re-exported from the [./main.wiki|main] module. + +

((context->pointer [nonnull? any/c]) [context (or/c context? #f)]) → (or/c pointer? #f)

+ +Checking conversion from contexts to pointers. + +Not re-exported from the [./main.wiki|main] module. + +

((pointer->context [nonnull? any/c]) [context (or/c pointer? #f)]) → (or/c context? #f)

+ +Checking conversion from pointers to contexts. + +Not re-exported from the [./main.wiki|main] module. + +

((state->pointer [nonnull? any/c]) [state (or/c state? #f)]) → (or/c pointer? #f)

+ +Checking conversion from states to pointers. + +Not re-exported from the [./main.wiki|main] module. + +

((pointer->state [nonnull? any/c]) [state (or/c pointer? #f)]) → (or/c state? #f)

+ +Checking conversion from pointers to states. + +Not re-exported from the [./main.wiki|main] module. ADDED canvas-draw/api/cgm.wiki Index: canvas-draw/api/cgm.wiki ================================================================== --- /dev/null +++ canvas-draw/api/cgm.wiki @@ -0,0 +1,22 @@ +

cgm Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/cgm))
CHICKEN(require-extension canvas-draw-cgm)
+ +CGM context support. + +

Context Types

+ +

[context:cgm context?]

+ +Context type for CGM files. ADDED canvas-draw/api/client.wiki Index: canvas-draw/api/client.wiki ================================================================== --- /dev/null +++ canvas-draw/api/client.wiki @@ -0,0 +1,43 @@ +

client Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/client))
CHICKEN(require-extension canvas-draw-client)
+ +Client context support. + +

Context Types

+ +

[context:image context?]

+ +Context type for client side pixel buffers. + +

[context:double-buffer context?]

+ +Context type for client side double buffers. + +

Auxiliary Functions

+ +

(canvas-image/rgb [canvas canvas?] [x integer?] [y integer?] [width integer?] [height integer?]) → blob?

+ +Retrieve a region of the given canvas as an RGB image. + +

+ (canvas-image-put/rgb! [canvas canvas?] [x integer?] [y integer?] [width integer?] [height integer?] [data blob?] #:width [dst-width integer? 0] #:height [dst-height integer? 0] #:x0 [src-x0 integer? 0] #:x1 [src-x1 integer? 0] #:y0 [src-y0 integer? 0] #:y1 [src-y1 integer? 0]) → void?
+ (set! (canvas-image/rgb [canvas canvas?] [x integer?] [y integer?] [width integer?] [height integer?]) [data blob?]) → void? +

+ +Replace a region of the given canvas with an RGB image. + +

(canvas-image-put/rgba! [canvas canvas?] [x integer?] [y integer?] [width integer?] [height integer?] [data blob?] #:width [dst-width integer? 0] #:height [dst-height integer? 0] #:x0 [src-x0 integer? 0] #:x1 [src-x1 integer? 0] #:y0 [src-y0 integer? 0] #:y1 [src-y1 integer? 0]) → void?

+ +Replace a region of the given canvas with an RGBA image. ADDED canvas-draw/api/clipboard.wiki Index: canvas-draw/api/clipboard.wiki ================================================================== --- /dev/null +++ canvas-draw/api/clipboard.wiki @@ -0,0 +1,22 @@ +

clipboard Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/clipboard))
CHICKEN(require-extension canvas-draw-clipboard)
+ +Clipboard context support. + +

Context Types

+ +

[context:clipboard context?]

+ +Context type for the system clipboard. ADDED canvas-draw/api/debug.wiki Index: canvas-draw/api/debug.wiki ================================================================== --- /dev/null +++ canvas-draw/api/debug.wiki @@ -0,0 +1,22 @@ +

debug Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/debug))
CHICKEN(require-extension canvas-draw-debug)
+ +Debug log context support. + +

Context Types

+ +

[context:debug context?]

+ +Context type for debug log files. ADDED canvas-draw/api/dgn.wiki Index: canvas-draw/api/dgn.wiki ================================================================== --- /dev/null +++ canvas-draw/api/dgn.wiki @@ -0,0 +1,22 @@ +

dgn Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/dgn))
CHICKEN(require-extension canvas-draw-dgn)
+ +DGN context support. + +

Context Types

+ +

[context:dgn context?]

+ +Context type for DGN files. ADDED canvas-draw/api/dxf.wiki Index: canvas-draw/api/dxf.wiki ================================================================== --- /dev/null +++ canvas-draw/api/dxf.wiki @@ -0,0 +1,22 @@ +

dxf Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/dxf))
CHICKEN(require-extension canvas-draw-dxf)
+ +DXF context support. + +

Context Types

+ +

[context:dxf context?]

+ +Context type for DXF files. ADDED canvas-draw/api/emf.wiki Index: canvas-draw/api/emf.wiki ================================================================== --- /dev/null +++ canvas-draw/api/emf.wiki @@ -0,0 +1,22 @@ +

emf Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/emf))
CHICKEN(require-extension canvas-draw-emf)
+ +EMF context support. + +

Context Types

+ +

[context:emf context?]

+ +Context type for EMF files. ADDED canvas-draw/api/gl.wiki Index: canvas-draw/api/gl.wiki ================================================================== --- /dev/null +++ canvas-draw/api/gl.wiki @@ -0,0 +1,22 @@ +

gl Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/gl))
CHICKEN(require-extension canvas-draw-gl)
+ +OpenGL context support. + +

Context Types

+ +

[context:gl context?]

+ +Context type for OpenGL rendering. ADDED canvas-draw/api/iup.wiki Index: canvas-draw/api/iup.wiki ================================================================== --- /dev/null +++ canvas-draw/api/iup.wiki @@ -0,0 +1,29 @@ +

iup Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/iup))
CHICKEN(require-extension canvas-draw-iup)
+ +IUP context support. + +

Context Types

+ +

[context:iup context?]

+ +Context type for IUP canvas widgets. + +

Auxiliary Functions

+ +

(make-canvas-action [proc (-> canvas-draw:canvas? integer? integer? any)]) → (-> iup:canvas? integer? integer? any)

+ +Creates an IUP canvas action callback from a function operating on a Canvas Draw +canvas. ADDED canvas-draw/api/main.wiki Index: canvas-draw/api/main.wiki ================================================================== --- /dev/null +++ canvas-draw/api/main.wiki @@ -0,0 +1,30 @@ +

main Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0))
CHICKEN(require-extension canvas-draw)
+ +This module re-exports most bindings from the [./base.wiki|base], +[./play.wiki|play] and [./primitives.wiki|primitives] modules. + +To create canvasses you also have to import bindings from at least one of the +context modules: [./iup.wiki|iup], [./native.wiki|native], +[./gl.wiki|gl], [./clipboard.wiki|clipboard], +[./printer.wiki|printer], [./picture.wiki|picture], +[./server.wiki|server], [./client.wiki|client], +[./pdf.wiki|pdf], [./ps.wiki|ps], [./svg.wiki|svg], +[./metafile.wiki|metafile], [./debug.wiki|debug], +[./cgm.wiki|cgm], [./dgn.wiki|dgn], [./dxf.wiki|dxf], +[./emf.wiki|emf], [./wmf.wiki|wmf]. + +The foreign types and conversion procedures defined in [./base.wiki|base] +are not re-exported. ADDED canvas-draw/api/metafile.wiki Index: canvas-draw/api/metafile.wiki ================================================================== --- /dev/null +++ canvas-draw/api/metafile.wiki @@ -0,0 +1,22 @@ +

metafile Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/metafile))
CHICKEN(require-extension canvas-draw-metafile)
+ +Canvas Draw metafile context support. + +

Context Types

+ +

[context:metafile context?]

+ +Context type for MF files. ADDED canvas-draw/api/native.wiki Index: canvas-draw/api/native.wiki ================================================================== --- /dev/null +++ canvas-draw/api/native.wiki @@ -0,0 +1,28 @@ +

native Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/native))
CHICKEN(require-extension canvas-draw-native)
+ +Native context support. Initializes context+ support when loaded. + +

Context Types

+ +

[context:native context?]

+ +Context type for native windows. + +

Auxiliary Functions

+ +

(screen-size) → (values integer? integer? real? real?)

+ +Determines the width and height of the whole screen in pixels and millimeters. ADDED canvas-draw/api/pdf.wiki Index: canvas-draw/api/pdf.wiki ================================================================== --- /dev/null +++ canvas-draw/api/pdf.wiki @@ -0,0 +1,22 @@ +

pdf Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/pdf))
CHICKEN(require-extension canvas-draw-pdf)
+ +PDF context support. + +

Context Types

+ +

[context:pdf context?]

+ +Context type for PDF files. ADDED canvas-draw/api/picture.wiki Index: canvas-draw/api/picture.wiki ================================================================== --- /dev/null +++ canvas-draw/api/picture.wiki @@ -0,0 +1,22 @@ +

picture Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/picture))
CHICKEN(require-extension canvas-draw-picture)
+ +Picture context support. + +

Context Types

+ +

[context:picture context?]

+ +Context type for in-memory pictures. ADDED canvas-draw/api/play.wiki Index: canvas-draw/api/play.wiki ================================================================== --- /dev/null +++ canvas-draw/api/play.wiki @@ -0,0 +1,23 @@ +

play Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/play))
CHICKEN(require-extension canvas-draw-play)
+ +Replay functionality. + +

Context Content Replay

+ +

(canvas-play! [canvas canvas?] [context context?] [x0 integer?] [x1 integer?] [y0 integer?] [y1 integer?] [data (or/c string? pointer?)]) → void?

+ +Replays the drawing contained in the context with the given data in the given +canvas. ADDED canvas-draw/api/primitives.wiki Index: canvas-draw/api/primitives.wiki ================================================================== --- /dev/null +++ canvas-draw/api/primitives.wiki @@ -0,0 +1,312 @@ +

primitives Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/primitives))
CHICKEN(require-extension canvas-draw-primitives)
+ +Drawing primitives. + +

Points

+ +

(canvas-pixel! [canvas canvas?] [x integer?] [y integer?] [color integer? (canvas-foreground canvas)]) → void?

+ +Draws a single pixel of the given color on the given canvas. + +

(canvas-mark! [canvas canvas?] [x integer?] [y integer?]) → void?

+ +Draws a marker symbol on the given canvas. + +

(canvas-mark-type [canvas canvas?]) → symbol?

+ +Retrieves the current marker symbol type for the given canvas. Possible values +are + + * '+ or 'plus + * '* or 'star + * '0 or 'circle + * 'O or 'hollow-circle + * 'X or 'x + * 'box + * 'hollow-box + * 'diamond + * 'hollow-diamond + +

+ (canvas-mark-type-set! [canvas canvas?] [mark-type symbol?]) → void?
+ (set! (canvas-mark-type [canvas canvas?]) [mark-type symbol?]) → void? +

+ +Sets the current marker symbol type for the given canvas. + +

(canvas-mark-size [canvas canvas?]) → integer?

+ +Retrieves the current marker symbol size for the given canvas. + +

+ (canvas-mark-size-set! [canvas canvas?] [size integer?]) → void?
+ (set! (canvas-mark-size [canvas canvas?]) [size integer?]) → void? +

+ +Sets the current marker symbol size for the given canvas. + +

Lines

+ +

(canvas-line! [canvas canvas?] [x0 real?] [y0 real?] [x1 real?] [y1 real?]) → void?

+ +Draws a line on the given canvas. + +

(canvas-rectangle! [canvas canvas?] [x0 real?] [x1 real?] [y0 real?] [y1 real?]) → void?

+ +Draws a hollow rectangle on the given canvas. + +

(canvas-arc! [canvas canvas?] [x real?] [y real?] [width real?] [height real?] [alpha0 real?] [alpha1 real?]) → void?

+ +Draws a hollow ellipsis segment on the given canvas. + +

(canvas-line-style [canvas canvas?]) → symbol?

+ +Retrieves the current line style of the given canvas. Possible values are + + * 'continuous + * 'dashed + * 'dotted + * 'dash-dotted + * 'dash-dot-dotted + * 'custom + +

+ (canvas-line-style-set! [canvas canvas?] [line-style (or/c symbol? list?)]) → symbol?
+ (set! (canvas-line-style [canvas canvas?]) [line-style (or/c symbol? list?)]) → symbol? +

+ +Sets the current line style of the given canvas and returns the previous value. + +In addition to the possible return values of [#canvas-line-style|canvas-line-style] +a custom line-style can be fully specified using the form +(list 'custom [len integer?] ...). + +

(canvas-line-width [canvas canvas?]) → integer?

+ +Retrieves the current line width of the given canvas. + +

+ (canvas-line-width-set! [canvas canvas?] [line-width integer?]) → integer?
+ (set! (canvas-line-width [canvas canvas?]) [line-width integer?]) → integer? +

+ +Sets the current line width of the given canvas and returns the previous value. + +

(canvas-line-join [canvas canvas?]) → symbol?

+ +Retrieves the current line join style of the given canvas. Possible values are + + * 'miter + * 'bevel + * 'round + +

+ (canvas-line-join-set! [canvas canvas?] [line-join symbol?]) → symbol?
+ (set! (canvas-line-join [canvas canvas?]) [line-join symbol?]) → symbol? +

+ +Sets the current line join style of the given canvas and returns the previous +value. + +

(canvas-line-cap [canvas canvas?]) → symbol?

+ +Retrieves the current line cap style of the given canvas. + + * 'flat + * 'square + * 'round + +

+ (canvas-line-cap-set! [canvas canvas?] [line-cap symbol?]) → symbol?
+ (set! (canvas-line-cap [canvas canvas?]) [line-cap symbol?]) → symbol? +

+ +Sets the current line cap style of the given canvas and returns the previous +value. + +

Filled Areas

+ +

(canvas-box! [canvas canvas?] [x0 real?] [x1 real?] [y0 real?] [y1 real?]) → void?

+ +Draws a filled rectangle on the given canvas. + +

(canvas-sector! [canvas canvas?] [x real?] [y real?] [width real?] [height real?] [alpha0 real?] [alpha1 real?]) → void?

+ +Draws a filled ellipsis sector on the given canvas. + +

(canvas-chord! [canvas canvas?] [x real?] [y real?] [width real?] [height real?] [alpha0 real?] [alpha1 real?]) → void?

+ +Draws a filled ellipsis arc on the given canvas. + +

(canvas-background-opacity [canvas canvas?]) → symbol?

+ +Retrieves the current background opacity of the given canvas. Possible values +are + + * 'transparent + * 'opaque + +

+ (canvas-background-opacity-set! [canvas canvas?] [background-opacity symbol?]) → symbol?
+ (set! (canvas-background-opacity-set! [canvas canvas?]) [background-opacity symbol?]) → symbol? +

+ +Sets the current background opacity of the given canvas and returns the previous +value. + +

(canvas-fill-mode [canvas canvas?]) → symbol?

+ +Retrieves the current polygon fill mode of the given canvas. Possible values are + + * 'even-odd + * 'winding + +

+ (canvas-fill-mode-set! [canvas canvas?] [fill-mode symbol?]) → symbol?
+ (set! (canvas-fill-mode [canvas canvas?]) [fill-mode symbol?]) → symbol? +

+ +Sets the current polygon fill mode of the given canvas and returns the previous +value. + +

(canvas-interior-style [canvas canvas?]) → (or/c symbol? list?)

+ +Retrieves the current interior style of the given canvas. Possible values are + + * 'solid + * '(hatch horizontal) + * '(hatch vertical) + * '(hatch forward-diagonal) + * '(hatch backward-diagonal) + * '(hatch cross) + * '(hatch diagonal-cross) + * (list 'stipple [width integer?] [height integer?] [data blob?]) + * (list 'pattern/rgb [width integer?] [height integer?] [data blob?]) + * (list 'pattern/rgba [width integer?] [height integer?] [data blob?]) + * #f + +

+ (canvas-interior-style-set! [canvas canvas?] [interior-style (or/c symbol? list?)]) → void?
+ (set! (canvas-interior-style [canvas canvas?]) [interior-style (or/c symbol? list?)]) → void? +

+ +Sets the current interior style of the given canvas and returns the previous +value. + +

Text

+ +

(canvas-text! [canvas canvas?] [x real?] [y real?] [text string?]) → void?

+ +Draws a string of text on the given canvas. + +

(canvas-font [canvas canvas?]) → string?

+ +Retrieves the current font of the given canvas. + +

+ (canvas-font-set! [canvas canvas?] [font string?]) → void?
+ (set! (canvas-font [canvas canvas?]) [font string?]) → void? +

+ +Sets the current font of the given canvas and returns the previous value. + +

(canvas-text-alignment [canvas canvas?]) → symbol?

+ +Retrieves the current text alignment of the given canvas. Possible values are + + * 'north + * 'south + * 'east + * 'west + * 'north-east + * 'north-west + * 'south-east + * 'south-west + * 'center + * 'base-left + * 'base-center + * 'base-right + +

+ (canvas-text-alignment-set! [canvas canvas?] [text-alignment symbol?]) → void?
+ (set! (canvas-text-alignment [canvas canvas?]) [text-alignment symbol?]) → void? +

+ +Sets the current text alignment of the given canvas and returns the previous +value. + +

(canvas-text-orientation [canvas canvas?]) → real?

+ +Retrieves the current text orientation of the given canvas. + +

+ (canvas-text-orientation-set! [canvas canvas?] [orientation real?]) → void?
+ (set! (canvas-text-orientation [canvas canvas?]) [orientation real?]) → void? +

+ +Sets the current text orientation of the given canvas and returns the previous +value. + +

(canvas-font-dimensions [canvas canvas?]) → (values integer? integer? integer? integer?)

+ +Returns the maximum width, height, ascent and descent of the current font +of the given canvas. + +

(canvas-text-size [canvas canvas?] [text string?]) → (values integer? integer?)

+ +Computes the width and height of the given text when drawn on the given canvas. + +

(canvas-text-box [canvas canvas?] [x integer?] [y integer?] [text string?]) → (values integer? integer? integer? integer?)

+ +Computes the bounding box of the given text when drawn on the given canvas. +Returns the minimum and maximum x and y coordinates. + +

Vertices

+ +

(call-with-canvas-in-mode [canvas canvas?] [mode symbol?] [proc (-> canvas? any)]) → any

+ +Calls proc with the given canvas and ready to receive vertex data +in the given mode. Returns whatever proc returns. + +Possible modes are + + * 'open-lines + * 'closed-lines + * 'fill + * 'clip + * 'bezier + * 'region + * 'path + +

(canvas-path-set! [canvas canvas?] [path-action symbol?]) → void?

+ +Configures the action between sequences of vertex data sent to the given canvas. +Possible actions are + + * 'new + * 'move-to + * 'line-to + * 'arc + * 'curve-to + * 'close + * 'fill + * 'stroke + * 'fill+stroke + * 'clip + +

(canvas-vertex! [canvas canvas?] [x real?] [y real?]) → void?

+ +Sends a vertex to the given canvas. ADDED canvas-draw/api/printer.wiki Index: canvas-draw/api/printer.wiki ================================================================== --- /dev/null +++ canvas-draw/api/printer.wiki @@ -0,0 +1,22 @@ +

printer Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/printer))
CHICKEN(require-extension canvas-draw-printer)
+ +Printer context support. + +

Context Types

+ +

[context:printer context?]

+ +Context type for a system printer. ADDED canvas-draw/api/ps.wiki Index: canvas-draw/api/ps.wiki ================================================================== --- /dev/null +++ canvas-draw/api/ps.wiki @@ -0,0 +1,22 @@ +

ps Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/ps))
CHICKEN(require-extension canvas-draw-ps)
+ +PostScript context support. + +

Context Types

+ +

[context:ps context?]

+ +Context type for PS files. ADDED canvas-draw/api/server.wiki Index: canvas-draw/api/server.wiki ================================================================== --- /dev/null +++ canvas-draw/api/server.wiki @@ -0,0 +1,26 @@ +

server Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/server))
CHICKEN(require-extension canvas-draw-server)
+ +Server context support. + +

Context Types

+ +

[context:image context?]

+ +Context type for server side pixel buffers. + +

[context:double-buffer context?]

+ +Context type for server side double buffers. ADDED canvas-draw/api/svg.wiki Index: canvas-draw/api/svg.wiki ================================================================== --- /dev/null +++ canvas-draw/api/svg.wiki @@ -0,0 +1,22 @@ +

svg Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/svg))
CHICKEN(require-extension canvas-draw-svg)
+ +Scalable vector graphics context support. + +

Context Types

+ +

[context:svg context?]

+ +Context type for SVG files. ADDED canvas-draw/api/wmf.wiki Index: canvas-draw/api/wmf.wiki ================================================================== --- /dev/null +++ canvas-draw/api/wmf.wiki @@ -0,0 +1,22 @@ +

wmf Module

+ +

Synopsis

+ + + + + + + + + + +
Racket(require (planet murphy/canvas-draw:1:0/wmf))
CHICKEN(require-extension canvas-draw-wmf)
+ +WMF context support. + +

Context Types

+ +

[context:wmf context?]

+ +Context type for WMF files. ADDED canvas-draw/chicken/canvas-draw-base.scm Index: canvas-draw/chicken/canvas-draw-base.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-base.scm @@ -0,0 +1,554 @@ +(require-library lolevel data-structures srfi-1 srfi-4 srfi-13) + +(module canvas-draw-base + (canvas? canvas->pointer pointer->canvas + context? context->pointer pointer->context + state? state->pointer pointer->state + context-capabilities + use-context+ make-canvas call-with-canvas + canvas-context + canvas-simulate! + canvas-attribute canvas-attribute-set! + canvas-state canvas-state-set! + canvas-clear! canvas-flush + canvas-size + canvas-mm->px canvas-px->mm + canvas-origin canvas-origin-set! + canvas-transform canvas-transform-set! + canvas-transform-compose! + canvas-transform-translate! + canvas-transform-scale! + canvas-transform-rotate! + canvas-foreground canvas-foreground-set! + canvas-background canvas-background-set! + canvas-write-mode canvas-write-mode-set! + canvas-clip-mode canvas-clip-mode-set! + canvas-clip-area canvas-clip-area-set!) + (import + scheme chicken foreign + lolevel data-structures srfi-1 srfi-4 srfi-13) + +;; {{{ Data types + +(foreign-declare + "#include \n") + +(define *canvas-tag* "cdCanvas") +(define canvas? (cut tagged-pointer? <> *canvas-tag*)) + +(define (canvas->pointer nonnull?) + (if nonnull? + (lambda (canvas) + (ensure canvas? canvas) + canvas) + (lambda (canvas) + (ensure (disjoin not canvas?) canvas) + canvas))) + +(define (pointer->canvas nonnull?) + (if nonnull? + (lambda (canvas) + (tag-pointer canvas *canvas-tag*)) + (lambda (canvas) + (and canvas (tag-pointer canvas *canvas-tag*))))) + +(define *context-tag* "cdContext") +(define context? (cut tagged-pointer? <> *context-tag*)) + +(define (context->pointer nonnull?) + (if nonnull? + (lambda (context) + (ensure context? context) + context) + (lambda (context) + (ensure (disjoin not context?) context) + context))) + +(define (pointer->context nonnull?) + (if nonnull? + (lambda (context) + (tag-pointer context *context-tag*)) + (lambda (context) + (and context (tag-pointer context *context-tag*))))) + +(define *state-tag* "cdState") +(define state? (cut tagged-pointer? <> *state-tag*)) + +(define (state->pointer nonnull?) + (if nonnull? + (lambda (state) + (ensure state? state) + state) + (lambda (state) + (ensure (disjoin not state?) state) + state))) + +(define (pointer->state nonnull?) + (if nonnull? + (lambda (state) + (tag-pointer state *state-tag*)) + (lambda (state) + (and state (tag-pointer state *state-tag*))))) + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Canvas management + +(define context-capabilities + (letrec ([context-capabilities/raw + (foreign-lambda int "cdContextCaps" nonnull-context)] + [capabilities + (list + (cons + 'flush + (foreign-value "CD_CAP_FLUSH" int)) + (cons + 'clear + (foreign-value "CD_CAP_CLEAR" int)) + (cons + 'play + (foreign-value "CD_CAP_PLAY" int)) + (cons + 'y-axis + (foreign-value "CD_CAP_YAXIS" int)) + (cons + 'clip-area + (foreign-value "CD_CAP_CLIPAREA" int)) + (cons + 'clip-polygon + (foreign-value "CD_CAP_CLIPPOLY" int)) + (cons + 'region + (foreign-value "CD_CAP_REGION" int)) + (cons + 'rectangle + (foreign-value "CD_CAP_RECT" int)) + (cons + 'chord + (foreign-value "CD_CAP_CHORD" int)) + (cons + 'image/rgb + (foreign-value "CD_CAP_IMAGERGB" int)) + (cons + 'image/rgba + (foreign-value "CD_CAP_IMAGERGBA" int)) + (cons + 'image/map + (foreign-value "CD_CAP_IMAGEMAP" int)) + (cons + 'get-image/rgb + (foreign-value "CD_CAP_GETIMAGERGB" int)) + (cons + 'image/server + (foreign-value "CD_CAP_IMAGESRV" int)) + (cons + 'background + (foreign-value "CD_CAP_BACKGROUND" int)) + (cons + 'background-opacity + (foreign-value "CD_CAP_BACKOPACITY" int)) + (cons + 'write-mode + (foreign-value "CD_CAP_WRITEMODE" int)) + (cons + 'line-style + (foreign-value "CD_CAP_LINESTYLE" int)) + (cons + 'line-width + (foreign-value "CD_CAP_LINEWITH" int)) + (cons + 'fprimtives + (foreign-value "CD_CAP_FPRIMTIVES" int)) + (cons + 'hatch + (foreign-value "CD_CAP_HATCH" int)) + (cons + 'stipple + (foreign-value "CD_CAP_STIPPLE" int)) + (cons + 'pattern + (foreign-value "CD_CAP_PATTERN" int)) + (cons + 'font + (foreign-value "CD_CAP_FONT" int)) + (cons + 'font-dimensions + (foreign-value "CD_CAP_FONTDIM" int)) + (cons + 'text-size + (foreign-value "CD_CAP_TEXTSIZE" int)) + (cons + 'text-orientation + (foreign-value "CD_CAP_TEXTORIENTATION" int)) + (cons + 'palette + (foreign-value "CD_CAP_PALETTE" int)) + (cons + 'line-cap + (foreign-value "CD_CAP_LINECAP" int)) + (cons + 'line-join + (foreign-value "CD_CAP_LINEJOIN" int)) + (cons + 'path + (foreign-value "CD_CAP_PATH" int)) + (cons + 'bezier + (foreign-value "CD_CAP_BEZIER" int)))]) + (lambda (context) + (let ([capabilities/raw (context-capabilities/raw context)]) + (filter-map + (lambda (info) + (let ([mask (cdr info)]) + (and (= (bitwise-and mask capabilities/raw) mask) (car info)))) + capabilities))))) + +(define use-context+ + (make-parameter #f)) + +(define make-canvas/ptr + (foreign-lambda* canvas ([nonnull-context context] [bool plus] [c-pointer data]) + "cdUseContextPlus(plus);\n" + "C_return(cdCreateCanvas(context, data));")) + +(define make-canvas/string + (foreign-lambda* canvas ([nonnull-context context] [bool plus] [c-string data]) + "cdUseContextPlus(plus);\n" + "C_return(cdCreateCanvas(context, (void *)data));")) + +(define canvas-kill! + (foreign-lambda void "cdKillCanvas" nonnull-canvas)) + +(define canvas-activate! + (foreign-lambda void "cdCanvasActivate" nonnull-canvas)) + +(define canvas-deactivate! + (foreign-lambda void "cdCanvasDeactivate" nonnull-canvas)) + +(define (make-canvas context data) + (let ([make-canvas/data (if (string? data) make-canvas/string make-canvas/ptr)]) + (cond + [(make-canvas/data context (use-context+) data) + => (cut set-finalizer! <> canvas-kill!)] + [else + (error 'make-canvas "failed to create canvas")]))) + +(define call-with-canvas + (case-lambda + [(canvas proc) + (dynamic-wind + (cut canvas-activate! canvas) + (cut proc canvas) + (cut canvas-deactivate! canvas))] + [(context data proc) + (let* ([make-canvas/data (if (string? data) make-canvas/string make-canvas/ptr)] + [canvas (make-canvas/data context (use-context+) data)]) + (unless canvas (error 'call-with-canvas "failed to create canvas")) + (dynamic-wind + (cut canvas-activate! canvas) + (cut proc canvas) + (lambda () + (when canvas + (canvas-kill! canvas) + (set! canvas #f)))))])) + +(define canvas-context + (foreign-lambda nonnull-context "cdCanvasGetContext" nonnull-canvas)) + +(define canvas-simulate! + (letrec ([canvas-simulate/raw! + (foreign-lambda int "cdCanvasSimulate" nonnull-canvas int)] + [flags + (list + (cons + 'line + (foreign-value "CD_SIM_LINE" int)) + (cons + 'rectangle + (foreign-value "CD_SIM_RECT" int)) + (cons + 'box + (foreign-value "CD_SIM_BOX" int)) + (cons + 'arc + (foreign-value "CD_SIM_ARC" int)) + (cons + 'sector + (foreign-value "CD_SIM_SECTOR" int)) + (cons + 'chord + (foreign-value "CD_SIM_CHORD" int)) + (cons + 'polyline + (foreign-value "CD_SIM_POLYLINE" int)) + (cons + 'polygon + (foreign-value "CD_SIM_POLYGON" int)) + (cons + 'text + (foreign-value "CD_SIM_TEXT" int)) + (cons + 'all + (foreign-value "CD_SIM_ALL" int)) + (cons + 'lines + (foreign-value "CD_SIM_LINES" int)) + (cons + 'fills + (foreign-value "CD_SIM_FILLS" int)))]) + (lambda (canvas flags-in) + (let ([flags-out + (canvas-simulate/raw! + canvas + (fold + bitwise-ior 0 + (map + (lambda (flag) + (cond + [(assq flag flags) => cdr] + [else (error 'canvas-simulate! "unknown flag" flag)])) + flags-in)))]) + (filter-map + (lambda (info) + (let ([mask (cdr info)]) + (and (= (bitwise-and mask flags-out) mask) (car info)))) + flags))))) + +(define (name->string name) + (cond + [(symbol? name) + (string-upcase (string-translate (symbol->string name) #\- #\_))] + [else + name])) + +(define canvas-attribute-set! + (letrec ([canvas-attribute-set/raw! (foreign-lambda void "cdCanvasSetAttribute" nonnull-canvas nonnull-c-string c-string)]) + (lambda (canvas name value) + (canvas-attribute-set/raw! canvas (name->string name) value)))) + +(define canvas-attribute + (letrec ([canvas-attribute/raw (foreign-lambda c-string "cdCanvasGetAttribute" nonnull-canvas nonnull-c-string)]) + (getter-with-setter + (lambda (canvas name) + (canvas-attribute/raw canvas (name->string name))) + canvas-attribute-set!))) + +(define canvas-state-set! + (foreign-lambda void "cdCanvasRestoreState" nonnull-canvas nonnull-state)) + +(define canvas-state + (letrec ([save-state (foreign-lambda nonnull-state "cdCanvasSaveState" nonnull-canvas)] + [release-state! (foreign-lambda void "cdReleaseState" nonnull-state)]) + (getter-with-setter + (lambda (canvas) + (set-finalizer! (save-state canvas) release-state!)) + canvas-state-set!))) + +(define canvas-clear! + (foreign-lambda void "cdCanvasClear" nonnull-canvas)) + +(define canvas-flush + (foreign-lambda void "cdCanvasFlush" nonnull-canvas)) + +;; }}} + +;; {{{ Coordinate system + +(define canvas-size + (letrec ([canvas-size/raw (foreign-lambda void "cdCanvasGetSize" nonnull-canvas (c-pointer int) (c-pointer int) (c-pointer double) (c-pointer double))]) + (lambda (canvas) + (let-location ([width/px int 0] [height/px int 0] + [width/mm double 0] [height/mm double 0]) + (canvas-size/raw + canvas + (location width/px) (location height/px) + (location width/mm) (location height/mm)) + (values + width/px height/px + width/mm height/mm))))) + +(define canvas-mm->px + (letrec ([canvas-mm->px/raw (foreign-lambda void "cdCanvasMM2Pixel" nonnull-canvas double double (c-pointer int) (c-pointer int))]) + (lambda (canvas x/mm y/mm) + (let-location ([x/px int 0] [y/px int 0]) + (canvas-mm->px/raw canvas x/mm y/mm (location x/px) (location y/px)) + (values x/px y/px))))) + +(define canvas-px->mm + (letrec ([canvas-mm->px/raw (foreign-lambda void "cdCanvasPixel2MM" nonnull-canvas int int (c-pointer double) (c-pointer double))]) + (lambda (canvas x/px y/px) + (let-location ([x/mm double +nan.0] [y/mm double +nan.0]) + (canvas-mm->px/raw canvas x/px y/px (location x/mm) (location y/mm)) + (values x/mm y/mm))))) + +(define canvas-origin-set! + (foreign-lambda void "cdCanvasOrigin" nonnull-canvas int int)) + +(define canvas-origin + (letrec ([canvas-origin/raw (foreign-lambda void "cdCanvasGetOrigin" nonnull-canvas (c-pointer int) (c-pointer int))]) + (lambda (canvas) + (let-location ([x int 0] [y int 0]) + (canvas-origin/raw canvas (location x) (location y)) + (values x y))))) + +(define (transform->f64vector proc) + (let ([v (make-f64vector 6)]) + (let-values ([(dx dy) (proc 0 0)]) + (f64vector-set! v 4 dx) + (f64vector-set! v 5 dy) + (let-values ([(x y) (proc 1 0)]) + (f64vector-set! v 0 (- x dx)) + (f64vector-set! v 1 (- y dy))) + (let-values ([(x y) (proc 0 1)]) + (f64vector-set! v 2 (- x dx)) + (f64vector-set! v 3 (- y dy)))) + v)) + +(define ((f64vector->transform v) x y) + (values + (+ (* (f64vector-ref v 0) x) (* (f64vector-ref v 2) y) (f64vector-ref v 4)) + (+ (* (f64vector-ref v 1) x) (* (f64vector-ref v 3) y) (f64vector-ref v 5)))) + +(define canvas-transform-set! + (letrec ([canvas-transform-set/raw! (foreign-lambda void "cdCanvasTransform" nonnull-canvas f64vector)]) + (lambda (canvas proc) + (canvas-transform-set/raw! canvas (and proc (transform->f64vector proc)))))) + +(define canvas-transform + (letrec ([canvas-transform/raw + (foreign-lambda* bool ([nonnull-canvas canvas] [nonnull-f64vector v]) + "double *w = cdCanvasGetTransform(canvas);\n" + "if (w) memcpy(v, w, 6 * sizeof(double));\n" + "C_return(w);")]) + (getter-with-setter + (lambda (canvas) + (let ([v (make-f64vector 6)]) + (and (canvas-transform/raw canvas v) (f64vector->transform v)))) + canvas-transform-set!))) + +(define canvas-transform-compose! + (letrec ([canvas-transform-compose/raw! (foreign-lambda void "cdCanvasTransformMultiply" nonnull-canvas nonnull-f64vector)]) + (lambda (canvas proc) + (canvas-transform-compose/raw! canvas (transform->f64vector proc))))) + +(define canvas-transform-translate! + (foreign-lambda void "cdCanvasTransformTranslate" nonnull-canvas double double)) + +(define canvas-transform-scale! + (foreign-lambda void "cdCanvasTransformScale" nonnull-canvas double double)) + +(define canvas-transform-rotate! + (foreign-lambda void "cdCanvasTransformRotate" nonnull-canvas double)) + +;; }}} + +;; {{{ General attributes + +(define canvas-foreground-set! + (foreign-lambda void "cdCanvasSetForeground" nonnull-canvas unsigned-long)) + +(define canvas-foreground + (getter-with-setter + (foreign-lambda* unsigned-long ([nonnull-canvas canvas]) + "C_return(cdCanvasForeground(canvas, CD_QUERY));") + canvas-foreground-set!)) + +(define canvas-background-set! + (foreign-lambda void "cdCanvasSetBackground" nonnull-canvas unsigned-long)) + +(define canvas-background + (getter-with-setter + (foreign-lambda* unsigned-long ([nonnull-canvas canvas]) + "C_return(cdCanvasBackground(canvas, CD_QUERY));") + canvas-background-set!)) + +(define-values (canvas-write-mode canvas-write-mode-set!) + (letrec ([write-modes + (list + (cons + 'replace + (foreign-value "CD_REPLACE" int)) + (cons + 'xor + (foreign-value "CD_XOR" int)) + (cons + 'not-xor + (foreign-value "CD_NOT_XOR" int)))] + [canvas-write-mode-set/raw! + (foreign-lambda void "cdCanvasWriteMode" nonnull-canvas int)] + [canvas-write-mode-set! + (lambda (canvas write-mode) + (canvas-write-mode-set/raw! + canvas + (cond + [(assq write-mode write-modes) => cdr] + [else (error 'canvas-write-mode-set! "unknown write mode" write-mode)])))] + [canvas-write-mode/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasWriteMode(canvas, CD_QUERY));")] + [canvas-write-mode + (lambda (canvas) + (let ([write-mode (canvas-write-mode/raw canvas)]) + (cond + [(rassoc write-mode write-modes) => car] + [else (error 'canvas-write-mode "unknown write mode" write-mode)])))]) + (values + (getter-with-setter canvas-write-mode canvas-write-mode-set!) + canvas-write-mode-set!))) + +;; }}} + +;; {{{ Clipping + +(define-values (canvas-clip-mode canvas-clip-mode-set!) + (letrec ([clip-modes + (list + (cons + 'area + (foreign-value "CD_CLIPAREA" int)) + (cons + 'polygon + (foreign-value "CD_CLIPPOLYGON" int)) + (cons + 'region + (foreign-value "CD_CLIPREGION" int)) + (cons + #f + (foreign-value "CD_CLIPOFF" int)))] + [canvas-clip-mode-set/raw! + (foreign-lambda void "cdCanvasClip" nonnull-canvas int)] + [canvas-clip-mode-set! + (lambda (canvas clip-mode) + (canvas-clip-mode-set/raw! + canvas + (cond + [(assq clip-mode clip-modes) => cdr] + [else (error 'canvas-clip-mode-set! "unknown clip mode" clip-mode)])))] + [canvas-clip-mode/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasClip(canvas, CD_QUERY));")] + [canvas-clip-mode + (lambda (canvas) + (let ([clip-mode (canvas-clip-mode/raw canvas)]) + (cond + [(rassoc clip-mode clip-modes) => car] + [else (error 'canvas-write-mode "unknown clip mode" clip-mode)])))]) + (values + (getter-with-setter canvas-clip-mode canvas-clip-mode-set!) + canvas-clip-mode-set!))) + +(define canvas-clip-area-set! + (foreign-lambda void "cdfCanvasClipArea" nonnull-canvas double double double double)) + +(define canvas-clip-area + (letrec ([canvas-clip-area/raw (foreign-lambda void "cdfCanvasGetClipArea" nonnull-canvas (c-pointer double) (c-pointer double) (c-pointer double) (c-pointer double))]) + (lambda (canvas) + (let-location ([x0 double 0] [x1 double 0] [y0 double 0] [y1 double 0]) + (canvas-clip-area/raw canvas (location x0) (location x1) (location y0) (location y1)) + (values x0 x1 y0 y1))))) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-cgm.scm Index: canvas-draw/chicken/canvas-draw-cgm.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-cgm.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-cgm + (context:cgm) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:cgm + (foreign-value "CD_CGM" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-client.scm Index: canvas-draw/chicken/canvas-draw-client.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-client.scm @@ -0,0 +1,109 @@ +(require-library canvas-draw-base) + +(module canvas-draw-client + (context:image context:double-buffer + canvas-image/rgb canvas-image-put/rgb! canvas-image-put/rgba!) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:image + (foreign-value "CD_IMAGERGB" nonnull-context)) + +(define context:double-buffer + (foreign-value "CD_DBUFFERRGB" nonnull-context)) + +;; }}} + +;; {{{ Auxiliary functions + +(define canvas-image-put/rgb! + (letrec ([canvas-image-set/rgb/raw! + (foreign-lambda* void ([nonnull-canvas canvas] [int dst_x] [int dst_y] + [int src_width] [int src_height] [nonnull-blob data] + [int dst_width] [int dst_height] + [int src_x0] [int src_x1] [int src_y0] [int src_y1]) + "const int nchans = 3;\n" + "unsigned char chans[nchans][src_width * src_height];\n" + "int i;\n" + "\n" + "for (i = 0; i < nchans * src_width * src_height; ++i)\n" + " chans[i % nchans][i / nchans] = data[i];\n" + "\n" + "cdCanvasPutImageRectRGB(\n" + " canvas, src_width, src_height,\n" + " chans[0], chans[1], chans[2],\n" + " dst_x, dst_y, dst_width, dst_height," + " src_x0, src_x1, src_y0, src_y1" + ");")]) + (lambda (canvas dst-x dst-y src-width src-height data + #!key [width 0] [height 0] [x0 0] [x1 0] [y0 0] [y1 0]) + (unless (= (blob-size data) (* 3 src-width src-height)) + (error 'canvas-image-set/rgb! "bad image size" (blob-size data) (* 3 src-width src-height))) + (canvas-image-set/rgb/raw! + canvas dst-x dst-y src-width src-height data + width height x0 x1 y0 y1)))) + +(define canvas-image-put/rgba! + (letrec ([canvas-image-set/rgba/raw! + (foreign-lambda* void ([nonnull-canvas canvas] [int dst_x] [int dst_y] + [int src_width] [int src_height] [nonnull-blob data] + [int dst_width] [int dst_height] + [int src_x0] [int src_x1] [int src_y0] [int src_y1]) + "const int nchans = 4;\n" + "unsigned char chans[nchans][src_width * src_height];\n" + "int i;\n" + "\n" + "for (i = 0; i < nchans * src_width * src_height; ++i)\n" + " chans[i % nchans][i / nchans] = data[i];\n" + "\n" + "cdCanvasPutImageRectRGBA(\n" + " canvas, src_width, src_height,\n" + " chans[0], chans[1], chans[2], chans[3],\n" + " dst_x, dst_y, dst_width, dst_height," + " src_x0, src_x1, src_y0, src_y1" + ");")]) + (lambda (canvas dst-x dst-y src-width src-height data + #!key [width 0] [height 0] [x0 0] [x1 0] [y0 0] [y1 0]) + (unless (= (blob-size data) (* 4 src-width src-height)) + (error 'canvas-image-set/rgba! "bad image size" (blob-size data) (* 4 src-width src-height))) + (canvas-image-set/rgba/raw! + canvas dst-x dst-y src-width src-height data + width height x0 x1 y0 y1)))) + +(define canvas-image/rgb + (getter-with-setter + (letrec ([canvas-image/rgb/raw + (foreign-lambda* void ([nonnull-canvas canvas] [int x] [int y] + [int width] [int height] [nonnull-blob data]) + "const int nchans = 3;\n" + "unsigned char chans[nchans][width * height];\n" + "int i;\n" + "\n" + "cdCanvasGetImageRGB(\n" + " canvas,\n" + " chans[0], chans[1], chans[2],\n" + " x, y, width, height\n" + ");\n" + "\n" + "for (i = 0; i < nchans * width * height; ++i)\n" + " data[i] = chans[i % nchans][i / nchans];\n")]) + (lambda (canvas x y width height) + (let ([data (make-blob (* 3 width height))]) + (canvas-image/rgb/raw canvas x y width height data) + data))) + canvas-image-put/rgb!)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-clipboard.scm Index: canvas-draw/chicken/canvas-draw-clipboard.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-clipboard.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-clipboard + (context:clipboard) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:clipboard + (foreign-value "CD_CLIPBOARD" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-debug.scm Index: canvas-draw/chicken/canvas-draw-debug.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-debug.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-debug + (context:debug) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:debug + (foreign-value "CD_DEBUG" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-dgn.scm Index: canvas-draw/chicken/canvas-draw-dgn.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-dgn.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-dgn + (context:dgn) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:dgn + (foreign-value "CD_DGN" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-dxf.scm Index: canvas-draw/chicken/canvas-draw-dxf.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-dxf.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-dxf + (context:dxf) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:dxf + (foreign-value "CD_DXF" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-emf.scm Index: canvas-draw/chicken/canvas-draw-emf.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-emf.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-emf + (context:emf) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:emf + (foreign-value "CD_EMF" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-gl.scm Index: canvas-draw/chicken/canvas-draw-gl.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-gl.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-gl + (context:gl) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:gl + (foreign-value "CD_GL" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-iup.scm Index: canvas-draw/chicken/canvas-draw-iup.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-iup.scm @@ -0,0 +1,34 @@ +(require-library canvas-draw-base) + +(module canvas-draw-iup + (context:iup make-canvas-action) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:iup + (foreign-value "CD_IUP" nonnull-context)) + +;; }}} + +;; {{{ Auxiliary functions + +(define (make-canvas-action proc) + (let ([canvas #f]) + (lambda (handle x y) + (unless canvas (set! canvas (make-canvas context:iup handle))) + (call-with-canvas canvas (cut proc <> x y))))) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-metafile.scm Index: canvas-draw/chicken/canvas-draw-metafile.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-metafile.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-metafile + (context:metafile) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:metafile + (foreign-value "CD_METAFILE" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-native.scm Index: canvas-draw/chicken/canvas-draw-native.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-native.scm @@ -0,0 +1,47 @@ +(require-library canvas-draw-base) + +(module canvas-draw-native + (context:native-window + screen-size) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:native-window + (foreign-value "CD_NATIVEWINDOW" nonnull-context)) + +;; }}} + +;; {{{ Auxiliary functions + +(define screen-size + (letrec ([screen-size/raw (foreign-lambda void "cdGetScreenSize" (c-pointer int) (c-pointer int) (c-pointer double) (c-pointer double))]) + (lambda () + (let-location ([width/px int 0] [height/px int 0] + [width/mm double 0] [height/mm double 0]) + (screen-size/raw + (location width/px) (location height/px) + (location width/mm) (location height/mm)) + (values + width/px height/px + width/mm height/mm))))) + +;; }}} + +;; {{{ Library initialization + +(foreign-code "cdInitContextPlus();") + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-pdf.scm Index: canvas-draw/chicken/canvas-draw-pdf.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-pdf.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-pdf + (context:pdf) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:pdf + (foreign-value "CD_PDF" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-picture.scm Index: canvas-draw/chicken/canvas-draw-picture.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-picture.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-picture + (context:picture) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:picture + (foreign-value "CD_PICTURE" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-play.scm Index: canvas-draw/chicken/canvas-draw-play.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-play.scm @@ -0,0 +1,31 @@ +(require-library canvas-draw-base) + +(module canvas-draw-play + (canvas-play!) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context content playback + +(define canvas-play/ptr! + (foreign-lambda int "cdCanvasPlay" nonnull-canvas nonnull-context int int int int c-pointer)) + +(define canvas-play/string! + (foreign-lambda int "cdCanvasPlay" nonnull-canvas nonnull-context int int int int c-string)) + +(define (canvas-play! canvas context x0 x1 y0 y1 data) + (let ([canvas-play/data! (if (string? data) canvas-play/string! canvas-play/ptr!)]) + (unless (zero? (canvas-play/data! canvas context x0 x1 y0 y1 data)) + (error 'canvas-play! "failed to replay graphics")))) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-primitives.scm Index: canvas-draw/chicken/canvas-draw-primitives.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-primitives.scm @@ -0,0 +1,738 @@ +(require-library data-structures srfi-4 canvas-draw-base) + +(module canvas-draw-primitives + (canvas-pixel! + canvas-mark! + canvas-mark-type canvas-mark-type-set! + canvas-mark-size canvas-mark-size-set! + canvas-line! canvas-rectangle! canvas-arc! + canvas-line-style canvas-line-style-set! + canvas-line-width canvas-line-width-set! + canvas-line-join canvas-line-join-set! + canvas-line-cap canvas-line-cap-set! + canvas-box! canvas-sector! canvas-chord! + canvas-background-opacity canvas-background-opacity-set! + canvas-fill-mode canvas-fill-mode-set! + canvas-interior-style canvas-interior-style-set! + canvas-text! + canvas-font canvas-font-set! + canvas-text-alignment canvas-text-alignment-set! + canvas-text-orientation canvas-text-orientation-set! + canvas-font-dimensions canvas-text-size canvas-text-box + call-with-canvas-in-mode canvas-path-set! + canvas-vertex!) + (import scheme chicken foreign data-structures srfi-4 canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Point drawing functions + +(define canvas-pixel! + (letrec ([canvas-pixel/raw! + (foreign-lambda void "cdCanvasPixel" nonnull-canvas int int unsigned-long)]) + (lambda (canvas x y #!optional [color (canvas-foreground canvas)]) + (canvas-pixel/raw! canvas x y color)))) + +(define canvas-mark! + (foreign-lambda void "cdCanvasMark" nonnull-canvas int int)) + +(define-values (canvas-mark-type canvas-mark-type-set!) + (letrec ([mark-types + (list + (cons + '+ + (foreign-value "CD_PLUS" int)) + (cons + 'plus + (foreign-value "CD_PLUS" int)) + (cons + '* + (foreign-value "CD_STAR" int)) + (cons + 'star + (foreign-value "CD_STAR" int)) + (cons + '0 + (foreign-value "CD_CIRCLE" int)) + (cons + 'circle + (foreign-value "CD_CIRCLE" int)) + (cons + 'O + (foreign-value "CD_HOLLOW_CIRCLE" int)) + (cons + 'hollow-circle + (foreign-value "CD_HOLLOW_CIRCLE" int)) + (cons + 'X + (foreign-value "CD_X" int)) + (cons + 'x + (foreign-value "CD_X" int)) + (cons + 'box + (foreign-value "CD_BOX" int)) + (cons + 'hollow-box + (foreign-value "CD_HOLLOW_BOX" int)) + (cons + 'diamond + (foreign-value "CD_DIAMOND" int)) + (cons + 'hollow-diamond + (foreign-value "CD_HOLLOW_DIAMOND" int)))] + [canvas-mark-type-set/raw! + (foreign-lambda void "cdCanvasMarkType" nonnull-canvas int)] + [canvas-mark-type-set! + (lambda (canvas mark-type) + (canvas-mark-type-set/raw! + canvas + (cond + [(assq mark-type mark-types) => cdr] + [else (error 'canvas-mark-type-set! "unknown mark type" mark-type)])))] + [canvas-mark-type/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasMarkType(canvas, CD_QUERY));")] + [canvas-mark-type + (lambda (canvas) + (let ([mark-type (canvas-mark-type/raw canvas)]) + (cond + [(rassoc mark-type mark-types) => car] + [else (error 'canvas-mark-type "unknown mark type" mark-type)])))]) + (values + (getter-with-setter canvas-mark-type canvas-mark-type-set!) + canvas-mark-type-set!))) + +(define canvas-mark-size-set! + (foreign-lambda void "cdCanvasMarkSize" nonnull-canvas int)) + +(define canvas-mark-size + (getter-with-setter + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasMarkSize(canvas, CD_QUERY));") + canvas-mark-size-set!)) + +;; }}} + +;; {{{ Line functions + +(define canvas-line! + (foreign-lambda void "cdfCanvasLine" nonnull-canvas double double double double)) + +(define canvas-rectangle! + (foreign-lambda void "cdfCanvasRect" nonnull-canvas double double double double)) + +(define canvas-arc! + (foreign-lambda void "cdfCanvasArc" nonnull-canvas double double double double double double)) + +(define-values (canvas-line-style canvas-line-style-set!) + (letrec ([line-styles + (list + (cons + 'continuous + (foreign-value "CD_CONTINUOUS" int)) + (cons + 'dashed + (foreign-value "CD_DASHED" int)) + (cons + 'dotted + (foreign-value "CD_DOTTED" int)) + (cons + 'dash-dotted + (foreign-value "CD_DASH_DOT" int)) + (cons + 'dash-dot-dotted + (foreign-value "CD_DASH_DOT_DOT" int)) + (cons + 'custom + (foreign-value "CD_CUSTOM" int)))] + [canvas-line-style-set/raw! + (foreign-lambda void "cdCanvasLineStyle" nonnull-canvas int)] + [canvas-line-style-dashes-set/raw! + (foreign-lambda void "cdCanvasLineStyleDashes" nonnull-canvas nonnull-s32vector int)] + [canvas-line-style-set! + (lambda (canvas line-style) + (cond + [(and (pair? line-style) (eq? (car line-style) 'custom)) + (let ([dashes (list->s32vector (cdr line-style))]) + (canvas-line-style-dashes-set/raw! canvas dashes (s32vector-length dashes)) + (canvas-line-style-set/raw! canvas (cdr (assq 'custom line-styles))))] + [else + (canvas-line-style-set/raw! + canvas + (cond + [(assq line-style line-styles) => cdr] + [else (error 'canvas-line-style-set! "unknown line style" line-style)]))]))] + [canvas-line-style/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasLineStyle(canvas, CD_QUERY));")] + [canvas-line-style + (lambda (canvas) + (let ([line-style (canvas-line-style/raw canvas)]) + (cond + [(rassoc line-style line-styles) => car] + [else (error 'canvas-line-style "unknown line style" line-style)])))]) + (values + (getter-with-setter canvas-line-style canvas-line-style-set!) + canvas-line-style-set!))) + +(define canvas-line-width-set! + (foreign-lambda int "cdCanvasLineWidth" nonnull-canvas int)) + +(define canvas-line-width + (getter-with-setter + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasLineWidth(canvas, CD_QUERY));") + canvas-line-width-set!)) + +(define-values (canvas-line-join canvas-line-join-set!) + (letrec ([line-joins + (list + (cons + 'miter + (foreign-value "CD_MITER" int)) + (cons + 'bevel + (foreign-value "CD_BEVEL" int)) + (cons + 'round + (foreign-value "CD_ROUND" int)))] + [canvas-line-join-set/raw! + (foreign-lambda void "cdCanvasLineJoin" nonnull-canvas int)] + [canvas-line-join-set! + (lambda (canvas line-join) + (canvas-line-join-set/raw! + canvas + (cond + [(assq line-join line-joins) => cdr] + [else (error 'canvas-line-join-set! "unknown line join" line-join)])))] + [canvas-line-join/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasLineJoin(canvas, CD_QUERY));")] + [canvas-line-join + (lambda (canvas) + (let ([line-join (canvas-line-join/raw canvas)]) + (cond + [(rassoc line-join line-joins) => car] + [else (error 'canvas-line-join "unknown line join" line-join)])))]) + (values + (getter-with-setter canvas-line-join canvas-line-join-set!) + canvas-line-join-set!))) + +(define-values (canvas-line-cap canvas-line-cap-set!) + (letrec ([line-caps + (list + (cons + 'flat + (foreign-value "CD_CAPFLAT" int)) + (cons + 'square + (foreign-value "CD_CAPSQUARE" int)) + (cons + 'round + (foreign-value "CD_CAPROUND" int)))] + [canvas-line-cap-set/raw! + (foreign-lambda void "cdCanvasLineCap" nonnull-canvas int)] + [canvas-line-cap-set! + (lambda (canvas line-cap) + (canvas-line-cap-set/raw! + canvas + (cond + [(assq line-cap line-caps) => cdr] + [else (error 'canvas-line-cap-set! "unknown line cap" line-cap)])))] + [canvas-line-cap/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasLineCap(canvas, CD_QUERY));")] + [canvas-line-cap + (lambda (canvas) + (let ([line-cap (canvas-line-cap/raw canvas)]) + (cond + [(rassoc line-cap line-caps) => car] + [else (error 'canvas-line-cap "unknown line cap" line-cap)])))]) + (values + (getter-with-setter canvas-line-cap canvas-line-cap-set!) + canvas-line-cap-set!))) + +;; }}} + +;; {{{ Filled area functions + +(define canvas-box! + (foreign-lambda void "cdfCanvasBox" nonnull-canvas double double double double)) + +(define canvas-sector! + (foreign-lambda void "cdfCanvasSector" nonnull-canvas double double double double double double)) + +(define canvas-chord! + (foreign-lambda void "cdfCanvasChord" nonnull-canvas double double double double double double)) + +(define-values (canvas-background-opacity canvas-background-opacity-set!) + (letrec ([opacities + (list + (cons + 'opaque + (foreign-value "CD_OPAQUE" int)) + (cons + 'transparent + (foreign-value "CD_TRANSPARENT" int)))] + [canvas-background-opacity-set/raw! + (foreign-lambda void "cdCanvasBackOpacity" nonnull-canvas int)] + [canvas-background-opacity-set! + (lambda (canvas opacity) + (canvas-background-opacity-set/raw! + canvas + (cond + [(assq opacity opacities) => cdr] + [else (error 'canvas-background-opacity-set! "unknown line cap" opacity)])))] + [canvas-background-opacity/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasBackOpacity(canvas, CD_QUERY));")] + [canvas-background-opacity + (lambda (canvas) + (let ([opacity (canvas-background-opacity/raw canvas)]) + (cond + [(rassoc opacity opacities) => car] + [else (error 'canvas-background-opacity "unknown opacity" opacity)])))]) + (values + (getter-with-setter canvas-background-opacity canvas-background-opacity-set!) + canvas-background-opacity-set!))) + +(define-values (canvas-fill-mode canvas-fill-mode-set!) + (letrec ([fill-modes + (list + (cons + 'even-odd + (foreign-value "CD_EVENODD" int)) + (cons + 'winding + (foreign-value "CD_WINDING" int)))] + [canvas-fill-mode-set/raw! + (foreign-lambda void "cdCanvasFillMode" nonnull-canvas int)] + [canvas-fill-mode-set! + (lambda (canvas fill-mode) + (canvas-fill-mode-set/raw! + canvas + (cond + [(assq fill-mode fill-modes) => cdr] + [else (error 'canvas-fill-mode-set! "unknown fill mode" fill-mode)])))] + [canvas-fill-mode/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasFillMode(canvas, CD_QUERY));")] + [canvas-fill-mode + (lambda (canvas) + (let ([fill-mode (canvas-fill-mode/raw canvas)]) + (cond + [(rassoc fill-mode fill-modes) => car] + [else (error 'canvas-fill-mode "unknown fill mode" fill-mode)])))]) + (values + (getter-with-setter canvas-fill-mode canvas-fill-mode-set!) + canvas-fill-mode-set!))) + +(define-values (canvas-interior-style canvas-interior-style-set!) + (letrec ([interior-styles + (list + (cons + 'solid + (foreign-value "CD_SOLID" int)) + (cons + 'hollow + (foreign-value "CD_HOLLOW" int)) + (cons + 'hatch + (foreign-value "CD_HATCH" int)) + (cons + 'stipple + (foreign-value "CD_STIPPLE" int)) + (cons + 'pattern + (foreign-value "CD_PATTERN" int)))] + [hatch-styles + (list + (cons + 'horizontal + (foreign-value "CD_HORIZONTAL" int)) + (cons + 'vertical + (foreign-value "CD_VERTICAL" int)) + (cons + 'forward-diagonal + (foreign-value "CD_FDIAGONAL" int)) + (cons + 'backward-diagonal + (foreign-value "CD_BDIAGONAL" int)) + (cons + 'cross + (foreign-value "CD_CROSS" int)) + (cons + 'diagonal-cross + (foreign-value "CD_DIAGCROSS" int)))] + [canvas-hatch-style-set/raw! + (foreign-lambda int "cdCanvasHatch" nonnull-canvas int)] + [canvas-hatch-style/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasHatch(canvas, CD_QUERY));")] + [canvas-stipple-set/raw! + (foreign-lambda* void ([nonnull-canvas canvas] [int width] [int height] [nonnull-blob data]) + "unsigned char mask[width * height];\n" + "int i, j;\n" + "\n" + "for (j = 0; j < height; ++j) {\n" + " for (i = 0; i < width; ++i) {\n" + " const int ofs = (j * width) + i;\n" + " mask[ofs] = (data[ofs / 8] >> (ofs % 8)) & 1;\n" + " }\n" + "}\n" + "cdCanvasStipple(canvas, width, height, mask);\n")] + [canvas-stipple/raw + (foreign-lambda* void ([nonnull-canvas canvas] [(c-pointer int) pwidth] [(c-pointer int) pheight] [blob data]) + "unsigned char *mask = cdCanvasGetStipple(canvas, pwidth, pheight);\n" + "\n" + "if (data) {\n" + " int width = *pwidth, height = *pheight;\n" + " int i, j;\n" + " \n" + " for (j = 0; j < height; ++j) {\n" + " for (i = 0; i < width; ++i) {\n" + " const int ofs = (j * width) + i;\n" + " const int vofs = ofs / 8, bofs = ofs % 8;\n" + " const unsigned char bit = mask[ofs] & 1;\n" + " \n" + " if (bofs > 0)\n" + " data[vofs] |= bit << bofs;\n" + " else\n" + " data[vofs] = bit;\n" + " }\n" + " }\n" + "}\n")] + [canvas-pattern-set/rgb/raw! + (foreign-lambda* void ([nonnull-canvas canvas] [int width] [int height] [nonnull-blob data]) + "long color[width * height];\n" + "int i, j;\n" + "\n" + "for (j = 0; j < height; ++j) {\n" + " for (i = 0; i < width; ++i, data += 3) {\n" + " color[(j * width) + i] =\n" + " (data[0] << 16) | (data[1] << 8) | (data[2]);\n" + " }\n" + "}\n" + "cdCanvasPattern(canvas, width, height, color);\n")] + [canvas-pattern-set/rgba/raw! + (foreign-lambda* void ([nonnull-canvas canvas] [int width] [int height] [nonnull-blob data]) + "long color[width * height];\n" + "int i, j;\n" + "\n" + "for (j = 0; j < height; ++j) {\n" + " for (i = 0; i < width; ++i, data += 4) {\n" + " color[(j * width) + i] =\n" + " ((0xff - data[3]) << 24) | (data[0] << 16) | (data[1] << 8) | (data[2]);\n" + " }\n" + "}\n" + "cdCanvasPattern(canvas, width, height, color);\n")] + [canvas-pattern/rgba/raw + (foreign-lambda* void ([nonnull-canvas canvas] [(c-pointer int) pwidth] [(c-pointer int) pheight] [blob data]) + "long *color = cdCanvasGetPattern(canvas, pwidth, pheight);\n" + "\n" + "if (data) {\n" + " int width = *pwidth, height = *pheight;\n" + " int i, j;\n" + " \n" + " for (j = 0; j < height; ++j) {\n" + " for (i = 0; i < width; ++i, data += 4) {\n" + " long c = color[(j * width) + i];\n" + " data[3] = 0xff - ((c >> 24) & 0xff);\n" + " data[0] = (c >> 16) & 0xff;\n" + " data[1] = (c >> 8) & 0xff;\n" + " data[2] = c & 0xff;\n" + " }\n" + " }\n" + "}\n")] + [canvas-interior-style-set/raw! + (foreign-lambda void "cdCanvasInteriorStyle" nonnull-canvas int)] + [canvas-interior-style-set! + (lambda (canvas interior-style) + (case (and (pair? interior-style) (car interior-style)) + [(hatch) + (let ([hatch-style (cadr interior-style)]) + (canvas-hatch-style-set/raw! + canvas + (cond + [(assq hatch-style hatch-styles) => cdr] + [else (error 'canvas-interior-style-set! "unknown hatch style" hatch-style)])) + (canvas-interior-style-set/raw! canvas (cdr (assq 'hatch interior-styles))))] + [(stipple) + (let ([width (cadr interior-style)] + [height (caddr interior-style)] + [data (cadddr interior-style)]) + (unless (= (blob-size data) (ceiling (/ (* width height) 8))) + (error 'canvas-interior-style-set! "bad stipple data length" (blob-size data) (ceiling (/ (* width height) 8)))) + (canvas-stipple-set/raw! canvas width height data) + (canvas-interior-style-set/raw! canvas (cdr (assq 'stipple interior-styles))))] + [(pattern/rgb) + (let ([width (cadr interior-style)] + [height (caddr interior-style)] + [data (cadddr interior-style)]) + (unless (= (blob-size data) (* 3 width height)) + (error 'canvas-interior-style-set! "bad pattern data length" (blob-size data) (* 3 width height))) + (canvas-pattern-set/rgb/raw! canvas width height data) + (canvas-interior-style-set/raw! canvas (cdr (assq 'pattern interior-styles))))] + [(pattern/rgba) + (let ([width (cadr interior-style)] + [height (caddr interior-style)] + [data (cadddr interior-style)]) + (unless (= (blob-size data) (* 4 width height)) + (error 'canvas-interior-style-set! "bad pattern data length" (blob-size data) (* 4 width height))) + (canvas-pattern-set/rgba/raw! canvas width height data) + (canvas-interior-style-set/raw! canvas (cdr (assq 'pattern interior-styles))))] + [else + (canvas-interior-style-set/raw! + canvas + (cond + [(assq interior-style interior-styles) => cdr] + [else (error 'canvas-interior-style-set! "unknown interior style" interior-style)]))]))] + [canvas-interior-style/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasInteriorStyle(canvas, CD_QUERY));")] + [canvas-interior-style + (lambda (canvas) + (let* ([interior-style (canvas-interior-style/raw canvas)] + [interior-style + (cond + [(rassoc interior-style interior-styles) => car] + [else (error 'canvas-interior-style "unknown interior style" interior-style)])]) + (case interior-style + [(hatch) + (let ([hatch-style (canvas-hatch-style/raw canvas)]) + (list + 'hatch + (cond + [(rassoc hatch-style hatch-styles) => car] + [else (error 'canvas-interior-style "unknown hatch style" hatch-style)])))] + [(stipple) + (let-location ([width int 0] [height int 0]) + (canvas-stipple/raw canvas (location width) (location height) #f) + (let ([data (make-blob (inexact->exact (ceiling (/ (* width height) 8))))]) + (canvas-stipple/raw canvas (location width) (location height) data) + (list 'stipple width height data)))] + [(pattern) + (let-location ([width int 0] [height int 0]) + (canvas-pattern/rgba/raw canvas (location width) (location height) #f) + (let ([data (make-blob (* 4 width height))]) + (canvas-pattern/rgba/raw canvas (location width) (location height) data) + (list 'pattern/rgba width height data)))] + [else + interior-style])))]) + (values + (getter-with-setter canvas-interior-style canvas-interior-style-set!) + canvas-interior-style-set!))) + +;; }}} + +;; {{{ Text functions + +(define canvas-text! + (foreign-lambda void "cdfCanvasText" nonnull-canvas double double nonnull-c-string)) + +(define canvas-font-set! + (foreign-lambda c-string "cdCanvasNativeFont" nonnull-canvas nonnull-c-string)) + +(define canvas-font + (getter-with-setter + (foreign-lambda* c-string ([nonnull-canvas canvas]) + "C_return(cdCanvasNativeFont(canvas, NULL));") + canvas-font-set!)) + +(define-values (canvas-text-alignment canvas-text-alignment-set!) + (letrec ([alignments + (list + (cons + 'north + (foreign-value "CD_NORTH" int)) + (cons + 'south + (foreign-value "CD_SOUTH" int)) + (cons + 'east + (foreign-value "CD_EAST" int)) + (cons + 'west + (foreign-value "CD_WEST" int)) + (cons + 'north-east + (foreign-value "CD_NORTH_EAST" int)) + (cons + 'north-west + (foreign-value "CD_NORTH_WEST" int)) + (cons + 'south-east + (foreign-value "CD_SOUTH_EAST" int)) + (cons + 'south-west + (foreign-value "CD_SOUTH_WEST" int)) + (cons + 'center + (foreign-value "CD_CENTER" int)) + (cons + 'base-left + (foreign-value "CD_BASE_LEFT" int)) + (cons + 'base-center + (foreign-value "CD_BASE_CENTER" int)) + (cons + 'base-right + (foreign-value "CD_BASE_RIGHT" int)))] + [canvas-text-alignment-set/raw! + (foreign-lambda void "cdCanvasTextAlignment" nonnull-canvas int)] + [canvas-text-alignment-set! + (lambda (canvas alignment) + (canvas-text-alignment-set/raw! + canvas + (cond + [(assq alignment alignments) => cdr] + [else (error 'canvas-text-alignment-set! "unknown alignment" alignment)])))] + [canvas-text-alignment/raw + (foreign-lambda* int ([nonnull-canvas canvas]) + "C_return(cdCanvasTextAlignment(canvas, CD_QUERY));")] + [canvas-text-alignment + (lambda (canvas) + (let ([alignment (canvas-text-alignment/raw canvas)]) + (cond + [(rassoc alignment alignments) => car] + [else (error 'canvas-text-alignment "unknown alignment" alignment)])))]) + (values + (getter-with-setter canvas-text-alignment canvas-text-alignment-set!) + canvas-text-alignment-set!))) + +(define canvas-text-orientation-set! + (foreign-lambda void "cdCanvasTextOrientation" nonnull-canvas double)) + +(define canvas-text-orientation + (getter-with-setter + (foreign-lambda* double ([nonnull-canvas canvas]) + "C_return(cdCanvasTextOrientation(canvas, CD_QUERY));") + canvas-text-orientation-set!)) + +(define canvas-font-dimensions + (letrec ([canvas-font-dimensions/raw + (foreign-lambda void "cdCanvasGetFontDim" nonnull-canvas (c-pointer int) (c-pointer int) (c-pointer int) (c-pointer int))]) + (lambda (canvas) + (let-location ([max-width int 0] + [height int 0] + [ascent int 0] + [descent int 0]) + (canvas-font-dimensions/raw canvas (location max-width) (location height) (location ascent) (location descent)) + (values max-width height ascent descent))))) + +(define canvas-text-size + (letrec ([canvas-text-size/raw + (foreign-lambda void "cdCanvasGetTextSize" nonnull-canvas nonnull-c-string (c-pointer int) (c-pointer int))]) + (lambda (canvas text) + (let-location ([width int 0] [height int 0]) + (canvas-text-size/raw canvas text (location width) (location height)) + (values width height))))) + +(define canvas-text-box + (letrec ([canvas-text-box/raw + (foreign-lambda void "cdCanvasGetTextBox" nonnull-canvas int int nonnull-c-string (c-pointer int) (c-pointer int) (c-pointer int) (c-pointer int))]) + (lambda (canvas x y text) + (let-location ([x0 int 0] [x1 int 0] + [y0 int 0] [y1 int 0]) + (canvas-text-box/raw canvas x y text (location x0) (location x1) (location y0) (location y1)) + (values x0 x1 y0 y1))))) + +;; }}} + +;; {{{ Vertex functions + +(define call-with-canvas-in-mode + (letrec ([canvas-modes + (list + (cons + 'open-lines + (foreign-value "CD_OPEN_LINES" int)) + (cons + 'closed-lines + (foreign-value "CD_CLOSED_LINES" int)) + (cons + 'fill + (foreign-value "CD_FILL" int)) + (cons + 'clip + (foreign-value "CD_CLIP" int)) + (cons + 'bezier + (foreign-value "CD_BEZIER" int)) + (cons + 'region + (foreign-value "CD_REGION" int)) + (cons + 'path + (foreign-value "CD_PATH" int)))] + [canvas-begin + (foreign-lambda void "cdCanvasBegin" nonnull-canvas int)] + [canvas-end + (foreign-lambda void "cdCanvasEnd" nonnull-canvas)]) + (lambda (canvas canvas-mode proc) + (let ([canvas-mode + (cond + [(assq canvas-mode canvas-modes) => cdr] + [else (error 'with-canvas-mode "unknown canvas mode" canvas-mode)])]) + (dynamic-wind + (cut canvas-begin canvas canvas-mode) + (cut proc canvas) + (cut canvas-end canvas)))))) + +(define canvas-path-set! + (letrec ([path-actions + (list + (cons + 'new + (foreign-value "CD_PATH_NEW" int)) + (cons + 'move-to + (foreign-value "CD_PATH_MOVETO" int)) + (cons + 'line-to + (foreign-value "CD_PATH_LINETO" int)) + (cons + 'arc + (foreign-value "CD_PATH_ARC" int)) + (cons + 'curve-to + (foreign-value "CD_PATH_CURVETO" int)) + (cons + 'close + (foreign-value "CD_PATH_CLOSE" int)) + (cons + 'fill + (foreign-value "CD_PATH_FILL" int)) + (cons + 'stroke + (foreign-value "CD_PATH_STROKE" int)) + (cons + 'fill+stroke + (foreign-value "CD_PATH_FILLSTROKE" int)) + (cons + 'clip + (foreign-value "CD_PATH_CLIP" int)))] + [canvas-path-set/raw! + (foreign-lambda void "cdCanvasPathSet" nonnull-canvas int)]) + (lambda (canvas path-action) + (canvas-path-set/raw! + canvas + (cond + [(assq path-action path-actions) => cdr] + [else (error 'canvas-path-set! "unknown path action" path-action)]))))) + +(define canvas-vertex! + (foreign-lambda void "cdfCanvasVertex" nonnull-canvas double double)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-printer.scm Index: canvas-draw/chicken/canvas-draw-printer.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-printer.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-printer + (context:printer) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:printer + (foreign-value "CD_PRINTER" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-ps.scm Index: canvas-draw/chicken/canvas-draw-ps.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-ps.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-ps + (context:ps) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:ps + (foreign-value "CD_PS" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-server.scm Index: canvas-draw/chicken/canvas-draw-server.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-server.scm @@ -0,0 +1,28 @@ +(require-library canvas-draw-base) + +(module canvas-draw-server + (context:image context:double-buffer) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:image + (foreign-value "CD_IMAGE" nonnull-context)) + +(define context:double-buffer + (foreign-value "CD_DBUFFER" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-svg.scm Index: canvas-draw/chicken/canvas-draw-svg.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-svg.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-svg + (context:svg) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:svg + (foreign-value "CD_SVG" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw-types.scm Index: canvas-draw/chicken/canvas-draw-types.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-types.scm @@ -0,0 +1,23 @@ +(define-foreign-type canvas (c-pointer "cdCanvas") + (canvas->pointer #f) + (pointer->canvas #f)) + +(define-foreign-type nonnull-canvas (nonnull-c-pointer "cdCanvas") + (canvas->pointer #t) + (pointer->canvas #t)) + +(define-foreign-type context (c-pointer "cdContext") + (context->pointer #f) + (pointer->context #f)) + +(define-foreign-type nonnull-context (nonnull-c-pointer "cdContext") + (context->pointer #t) + (pointer->context #t)) + +(define-foreign-type state (c-pointer "cdState") + (state->pointer #f) + (pointer->state #f)) + +(define-foreign-type nonnull-state (nonnull-c-pointer "cdState") + (state->pointer #t) + (pointer->state #t)) ADDED canvas-draw/chicken/canvas-draw-wmf.scm Index: canvas-draw/chicken/canvas-draw-wmf.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw-wmf.scm @@ -0,0 +1,24 @@ +(require-library canvas-draw-base) + +(module canvas-draw-wmf + (context:wmf) + (import scheme chicken foreign canvas-draw-base) + +;; {{{ Data types + +(foreign-declare + "#include \n" + "#include \n") + +(include "canvas-draw-types.scm") + +;; }}} + +;; {{{ Context types + +(define context:wmf + (foreign-value "CD_WMF" nonnull-context)) + +;; }}} + +) ADDED canvas-draw/chicken/canvas-draw.meta Index: canvas-draw/chicken/canvas-draw.meta ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw.meta @@ -0,0 +1,5 @@ +((category graphics) + (license "BSD") + (author "Thomas Chust") + (synopsis "Bindings to the CD graphics library") + (documentation "http://www.chust.org/fossils/canvas-draw")) ADDED canvas-draw/chicken/canvas-draw.scm Index: canvas-draw/chicken/canvas-draw.scm ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw.scm @@ -0,0 +1,13 @@ +(require-library + canvas-draw-base canvas-draw-primitives canvas-draw-play) + +(module canvas-draw + () + (import scheme chicken) + (reexport + (except canvas-draw-base + canvas->pointer pointer->canvas + context->pointer pointer->context + state->pointer pointer->state) + canvas-draw-primitives + canvas-draw-play)) ADDED canvas-draw/chicken/canvas-draw.setup Index: canvas-draw/chicken/canvas-draw.setup ================================================================== --- /dev/null +++ canvas-draw/chicken/canvas-draw.setup @@ -0,0 +1,345 @@ +(if (find-library "cd" "cdCreateCanvas") + (begin + (compile -s -O2 -d1 "canvas-draw-base.scm" -j canvas-draw-base "-lcd") + (compile -c -O2 -d1 "canvas-draw-base.scm" -j canvas-draw-base -unit canvas-draw-base) + (compile -s -O2 -d0 "canvas-draw-base.import.scm") + + (install-extension + 'canvas-draw-base + '("canvas-draw-base.so" "canvas-draw-base.o" "canvas-draw-base.import.so" "canvas-draw-types.scm") + '((version 1.0.0) + (static "canvas-draw-base.o") + (static-options "-lcd"))) + + (compile -s -O2 -d1 "canvas-draw-primitives.scm" -j canvas-draw-primitives "-lcd") + (compile -c -O2 -d1 "canvas-draw-primitives.scm" -j canvas-draw-primitives -unit canvas-draw-primitives) + (compile -s -O2 -d0 "canvas-draw-primitives.import.scm") + + (install-extension + 'canvas-draw-primitives + '("canvas-draw-primitives.so" "canvas-draw-primitives.o" "canvas-draw-primitives.import.so" "canvas-draw-types.scm") + '((version 1.0.0) + (static "canvas-draw-primitives.o") + (static-options "-lcd"))) + + (compile -s -O2 -d1 "canvas-draw-play.scm" -j canvas-draw-play "-lcd") + (compile -c -O2 -d1 "canvas-draw-play.scm" -j canvas-draw-play -unit canvas-draw-play) + (compile -s -O2 -d0 "canvas-draw-play.import.scm") + + (install-extension + 'canvas-draw-play + '("canvas-draw-play.so" "canvas-draw-play.o" "canvas-draw-play.import.so" "canvas-draw-types.scm") + '((version 1.0.0) + (static "canvas-draw-play.o") + (static-options "-lcd"))) + + (if (find-library "iupcd" "cdContextIup") + (begin + (compile -s -O2 -d1 "canvas-draw-iup.scm" -j canvas-draw-iup "-liupcd") + (compile -c -O2 -d1 "canvas-draw-iup.scm" -j canvas-draw-iup -unit canvas-draw-iup) + (compile -s -O2 -d0 "canvas-draw-iup.import.scm") + + (install-extension + 'canvas-draw-iup + '("canvas-draw-iup.so" "canvas-draw-iup.o" "canvas-draw-iup.import.so") + '((version 1.0.0) + (static "canvas-draw-iup.o") + (static-options "-liupcd")))) + (warning "CD IUP driver not found, some bindings cannot be compiled")) + + (cond + [(find-library "cdx11" "cdContextNativeWindow") + (compile -s -O2 -d1 "canvas-draw-native.scm" -j canvas-draw-native "-lcdx11 -lcdcontextplus") + (compile -c -O2 -d1 "canvas-draw-native.scm" -j canvas-draw-native -unit canvas-draw-native) + (compile -s -O2 -d0 "canvas-draw-native.import.scm") + + (install-extension + 'canvas-draw-native + '("canvas-draw-native.so" "canvas-draw-native.o" "canvas-draw-native.import.so") + '((version 1.0.0) + (static "canvas-draw-native.o") + (static-options "-lcdx11 -lcdcontextplus")))] + [(find-library "cd" "cdContextNativeWindow") + (compile -s -O2 -d1 "canvas-draw-native.scm" -j canvas-draw-native "-lcd -lcdcontextplus") + (compile -c -O2 -d1 "canvas-draw-native.scm" -j canvas-draw-native -unit canvas-draw-native) + (compile -s -O2 -d0 "canvas-draw-native.import.scm") + + (install-extension + 'canvas-draw-native + '("canvas-draw-native.so" "canvas-draw-native.o" "canvas-draw-native.import.so") + '((version 1.0.0) + (static "canvas-draw-native.o") + (static-options "-lcd -lcdcontextplus")))] + [else + (warning "CD native window driver not found, some bindings cannot be compiled")]) + + (if (find-library "cdgl" "cdContextGL") + (begin + (compile -s -O2 -d1 "canvas-draw-gl.scm" -j canvas-draw-gl "-lcdgl") + (compile -c -O2 -d1 "canvas-draw-gl.scm" -j canvas-draw-gl -unit canvas-draw-gl) + (compile -s -O2 -d0 "canvas-draw-gl.import.scm") + + (install-extension + 'canvas-draw-gl + '("canvas-draw-gl.so" "canvas-draw-gl.o" "canvas-draw-gl.import.so") + '((version 1.0.0) + (static "canvas-draw-gl.o") + (static-options "-lcdgl")))) + (warning "CD OpenGL driver not found, some bindings cannot be compiled")) + + (cond + [(find-library "cdx11" "cdContextClipboard") + (compile -s -O2 -d1 "canvas-draw-clipboard.scm" -j canvas-draw-clipboard "-lcdx11") + (compile -c -O2 -d1 "canvas-draw-clipboard.scm" -j canvas-draw-clipboard -unit canvas-draw-clipboard) + (compile -s -O2 -d0 "canvas-draw-clipboard.import.scm") + + (install-extension + 'canvas-draw-clipboard + '("canvas-draw-clipboard.so" "canvas-draw-clipboard.o" "canvas-draw-clipboard.import.so") + '((version 1.0.0) + (static "canvas-draw-clipboard.o") + (static-options "-lcdx11")))] + [(find-library "cd" "cdContextClipboard") + (compile -s -O2 -d1 "canvas-draw-clipboard.scm" -j canvas-draw-clipboard "-lcd") + (compile -c -O2 -d1 "canvas-draw-clipboard.scm" -j canvas-draw-clipboard -unit canvas-draw-clipboard) + (compile -s -O2 -d0 "canvas-draw-clipboard.import.scm") + + (install-extension + 'canvas-draw-clipboard + '("canvas-draw-clipboard.so" "canvas-draw-clipboard.o" "canvas-draw-clipboard.import.so") + '((version 1.0.0) + (static "canvas-draw-clipboard.o") + (static-options "-lcd")))] + [else + (warning "CD clipboard driver not found, some bindings cannot be compiled")]) + + (cond + [(find-library "cdx11" "cdContextPrinter") + (compile -s -O2 -d1 "canvas-draw-printer.scm" -j canvas-draw-printer "-lcdx11") + (compile -c -O2 -d1 "canvas-draw-printer.scm" -j canvas-draw-printer -unit canvas-draw-printer) + (compile -s -O2 -d0 "canvas-draw-printer.import.scm") + + (install-extension + 'canvas-draw-printer + '("canvas-draw-printer.so" "canvas-draw-printer.o" "canvas-draw-printer.import.so") + '((version 1.0.0) + (static "canvas-draw-printer.o") + (static-options "-lcdx11")))] + [(find-library "cd" "cdContextPrinter") + (compile -s -O2 -d1 "canvas-draw-printer.scm" -j canvas-draw-printer "-lcd") + (compile -c -O2 -d1 "canvas-draw-printer.scm" -j canvas-draw-printer -unit canvas-draw-printer) + (compile -s -O2 -d0 "canvas-draw-printer.import.scm") + + (install-extension + 'canvas-draw-printer + '("canvas-draw-printer.so" "canvas-draw-printer.o" "canvas-draw-printer.import.so") + '((version 1.0.0) + (static "canvas-draw-printer.o") + (static-options "-lcd")))] + [else + (warning "CD printer driver not found, some bindings cannot be compiled")]) + + (if (find-library "cd" "cdContextPicture") + (begin + (compile -s -O2 -d1 "canvas-draw-picture.scm" -j canvas-draw-picture "-lcd") + (compile -c -O2 -d1 "canvas-draw-picture.scm" -j canvas-draw-picture -unit canvas-draw-picture) + (compile -s -O2 -d0 "canvas-draw-picture.import.scm") + + (install-extension + 'canvas-draw-picture + '("canvas-draw-picture.so" "canvas-draw-picture.o" "canvas-draw-picture.import.so") + '((version 1.0.0) + (static "canvas-draw-picture.o") + (static-options "-lcd")))) + (warning "CD picture driver not found, some bindings cannot be compiled")) + + (cond + [(find-library "cdx11" "cdContextImage") + (compile -s -O2 -d1 "canvas-draw-server.scm" -j canvas-draw-server "-lcdx11") + (compile -c -O2 -d1 "canvas-draw-server.scm" -j canvas-draw-server -unit canvas-draw-server) + (compile -s -O2 -d0 "canvas-draw-server.import.scm") + + (install-extension + 'canvas-draw-server + '("canvas-draw-server.so" "canvas-draw-server.o" "canvas-draw-server.import.so") + '((version 1.0.0) + (static "canvas-draw-server.o") + (static-options "-lcdx11")))] + [(find-library "cd" "cdContextImage") + (compile -s -O2 -d1 "canvas-draw-server.scm" -j canvas-draw-server "-lcd") + (compile -c -O2 -d1 "canvas-draw-server.scm" -j canvas-draw-server -unit canvas-draw-server) + (compile -s -O2 -d0 "canvas-draw-server.import.scm") + + (install-extension + 'canvas-draw-server + '("canvas-draw-server.so" "canvas-draw-server.o" "canvas-draw-server.import.so") + '((version 1.0.0) + (static "canvas-draw-server.o") + (static-options "-lcd")))] + [else + (warning "CD server image driver not found, some bindings cannot be compiled")]) + + (if (find-library "cd" "cdContextImageRGB") + (begin + (compile -s -O2 -d1 "canvas-draw-client.scm" -j canvas-draw-client "-lcd") + (compile -c -O2 -d1 "canvas-draw-client.scm" -j canvas-draw-client -unit canvas-draw-client) + (compile -s -O2 -d0 "canvas-draw-client.import.scm") + + (install-extension + 'canvas-draw-client + '("canvas-draw-client.so" "canvas-draw-client.o" "canvas-draw-client.import.so") + '((version 1.0.0) + (static "canvas-draw-client.o") + (static-options "-lcd")))) + (warning "CD client image driver not found, some bindings cannot be compiled")) + + (if (find-library "cdpdf" "cdContextPDF") + (begin + (compile -s -O2 -d1 "canvas-draw-pdf.scm" -j canvas-draw-pdf "-lcdpdf") + (compile -c -O2 -d1 "canvas-draw-pdf.scm" -j canvas-draw-pdf -unit canvas-draw-pdf) + (compile -s -O2 -d0 "canvas-draw-pdf.import.scm") + + (install-extension + 'canvas-draw-pdf + '("canvas-draw-pdf.so" "canvas-draw-pdf.o" "canvas-draw-pdf.import.so") + '((version 1.0.0) + (static "canvas-draw-pdf.o") + (static-options "-lcdpdf")))) + (warning "CD PDF driver not found, some bindings cannot be compiled")) + + (if (find-library "cd" "cdContextPS") + (begin + (compile -s -O2 -d1 "canvas-draw-ps.scm" -j canvas-draw-ps "-lcd") + (compile -c -O2 -d1 "canvas-draw-ps.scm" -j canvas-draw-ps -unit canvas-draw-ps) + (compile -s -O2 -d0 "canvas-draw-ps.import.scm") + + (install-extension + 'canvas-draw-ps + '("canvas-draw-ps.so" "canvas-draw-ps.o" "canvas-draw-ps.import.so") + '((version 1.0.0) + (static "canvas-draw-ps.o") + (static-options "-lcd")))) + (warning "CD PostScript driver not found, some bindings cannot be compiled")) + + (if (find-library "cd" "cdContextSVG") + (begin + (compile -s -O2 -d1 "canvas-draw-svg.scm" -j canvas-draw-svg "-lcd") + (compile -c -O2 -d1 "canvas-draw-svg.scm" -j canvas-draw-svg -unit canvas-draw-svg) + (compile -s -O2 -d0 "canvas-draw-svg.import.scm") + + (install-extension + 'canvas-draw-svg + '("canvas-draw-svg.so" "canvas-draw-svg.o" "canvas-draw-svg.import.so") + '((version 1.0.0) + (static "canvas-draw-svg.o") + (static-options "-lcd")))) + (warning "CD SVG driver not found, some bindings cannot be compiled")) + + (if (find-library "cd" "cdContextMetafile") + (begin + (compile -s -O2 -d1 "canvas-draw-metafile.scm" -j canvas-draw-metafile "-lcd") + (compile -c -O2 -d1 "canvas-draw-metafile.scm" -j canvas-draw-metafile -unit canvas-draw-metafile) + (compile -s -O2 -d0 "canvas-draw-metafile.import.scm") + + (install-extension + 'canvas-draw-metafile + '("canvas-draw-metafile.so" "canvas-draw-metafile.o" "canvas-draw-metafile.import.so") + '((version 1.0.0) + (static "canvas-draw-metafile.o") + (static-options "-lcd")))) + (warning "CD metafile driver not found, some bindings cannot be compiled")) + + (if (find-library "cd" "cdContextDebug") + (begin + (compile -s -O2 -d1 "canvas-draw-debug.scm" -j canvas-draw-debug "-lcd") + (compile -c -O2 -d1 "canvas-draw-debug.scm" -j canvas-draw-debug -unit canvas-draw-debug) + (compile -s -O2 -d0 "canvas-draw-debug.import.scm") + + (install-extension + 'canvas-draw-debug + '("canvas-draw-debug.so" "canvas-draw-debug.o" "canvas-draw-debug.import.so") + '((version 1.0.0) + (static "canvas-draw-debug.o") + (static-options "-lcd")))) + (warning "CD debug driver not found, some bindings cannot be compiled")) + + (if (find-library "cd" "cdContextCGM") + (begin + (compile -s -O2 -d1 "canvas-draw-cgm.scm" -j canvas-draw-cgm "-lcd") + (compile -c -O2 -d1 "canvas-draw-cgm.scm" -j canvas-draw-cgm -unit canvas-draw-cgm) + (compile -s -O2 -d0 "canvas-draw-cgm.import.scm") + + (install-extension + 'canvas-draw-cgm + '("canvas-draw-cgm.so" "canvas-draw-cgm.o" "canvas-draw-cgm.import.so") + '((version 1.0.0) + (static "canvas-draw-cgm.o") + (static-options "-lcd")))) + (warning "CD CGM driver not found, some bindings cannot be compiled")) + + (if (find-library "cd" "cdContextDGN") + (begin + (compile -s -O2 -d1 "canvas-draw-dgn.scm" -j canvas-draw-dgn "-lcd") + (compile -c -O2 -d1 "canvas-draw-dgn.scm" -j canvas-draw-dgn -unit canvas-draw-dgn) + (compile -s -O2 -d0 "canvas-draw-dgn.import.scm") + + (install-extension + 'canvas-draw-dgn + '("canvas-draw-dgn.so" "canvas-draw-dgn.o" "canvas-draw-dgn.import.so") + '((version 1.0.0) + (static "canvas-draw-dgn.o") + (static-options "-lcd")))) + (warning "CD DGN driver not found, some bindings cannot be compiled")) + + (if (find-library "cd" "cdContextDXF") + (begin + (compile -s -O2 -d1 "canvas-draw-dxf.scm" -j canvas-draw-dxf "-lcd") + (compile -c -O2 -d1 "canvas-draw-dxf.scm" -j canvas-draw-dxf -unit canvas-draw-dxf) + (compile -s -O2 -d0 "canvas-draw-dxf.import.scm") + + (install-extension + 'canvas-draw-dxf + '("canvas-draw-dxf.so" "canvas-draw-dxf.o" "canvas-draw-dxf.import.so") + '((version 1.0.0) + (static "canvas-draw-dxf.o") + (static-options "-lcd")))) + (warning "CD DXF driver not found, some bindings cannot be compiled")) + + (if (find-library "cd" "cdContextEMF") + (begin + (compile -s -O2 -d1 "canvas-draw-emf.scm" -j canvas-draw-emf "-lcd") + (compile -c -O2 -d1 "canvas-draw-emf.scm" -j canvas-draw-emf -unit canvas-draw-emf) + (compile -s -O2 -d0 "canvas-draw-emf.import.scm") + + (install-extension + 'canvas-draw-emf + '("canvas-draw-emf.so" "canvas-draw-emf.o" "canvas-draw-emf.import.so") + '((version 1.0.0) + (static "canvas-draw-emf.o") + (static-options "-lcd")))) + (warning "CD EMF driver not found, some bindings cannot be compiled")) + + (if (find-library "cd" "cdContextWMF") + (begin + (compile -s -O2 -d1 "canvas-draw-wmf.scm" -j canvas-draw-wmf "-lcd") + (compile -c -O2 -d1 "canvas-draw-wmf.scm" -j canvas-draw-wmf -unit canvas-draw-wmf) + (compile -s -O2 -d0 "canvas-draw-wmf.import.scm") + + (install-extension + 'canvas-draw-wmf + '("canvas-draw-wmf.so" "canvas-draw-wmf.o" "canvas-draw-wmf.import.so") + '((version 1.0.0) + (static "canvas-draw-wmf.o") + (static-options "-lcd")))) + (warning "CD WMF driver not found, some bindings cannot be compiled")) + + (compile -s -O2 -d1 "canvas-draw.scm" -j canvas-draw) + (compile -c -O2 -d1 "canvas-draw.scm" -j canvas-draw -unit canvas-draw) + (compile -s -O2 -d0 "canvas-draw.import.scm") + + (install-extension + 'canvas-draw + '("canvas-draw.so" "canvas-draw.o" "canvas-draw.import.so") + '((version 1.0.0) + (static "canvas-draw.o")))) + (error "CD not found, none of the bindings can be compiled")) ADDED canvas-draw/manifest Index: canvas-draw/manifest ================================================================== --- /dev/null +++ canvas-draw/manifest @@ -0,0 +1,77 @@ +C Changed\swith-canvas-mode\sinto\scall-with-canvas-in-mode +D 2010-10-22T02:35:02 +F LICENSE.txt 0f326ce34f5e3196925dcb3937b90d96971e17d6 +F api/base.wiki 01dd0798b9c4453ce6282feeb5e1503cee26ae1c +F api/cgm.wiki 2b71cdedb4227aaf72723673a575641cd0d1a2c3 +F api/client.wiki 239992612ebc61eeab4170181248f71be3e245a4 +F api/clipboard.wiki 3cffe76749de3ef0e14b4223d470a595174c78f1 +F api/debug.wiki e61598f3ec7b96a7e62c0b56f4b42040a4ed446d +F api/dgn.wiki d803d2e8b886fbc5563cf9186d04dd9d47ca2f44 +F api/dxf.wiki 7456a1e3e96f7dbf39aec7cd99cb7b0fb6bef284 +F api/emf.wiki f046287334295eff404a8e5b29d5054abf1afbca +F api/gl.wiki 0fb6b8938a4ee8ffd2e56d9761499d55afe35bef +F api/iup.wiki f2ac6fadac1035fa2ef8dbb829cf310c3dc7e578 +F api/main.wiki f30493803812062cec5e65b89b376476b755d790 +F api/metafile.wiki cc4eafd9d5f948afcddcc4b1c2caa5d731a7cc4a +F api/native.wiki 907ab1647b4a587464b836acefdd6f73b021117c +F api/pdf.wiki 17ab6eed22b52fab61a48b963f5c8e7831d40ff2 +F api/picture.wiki 242f6b8a92d5b46ca1cbe14e3f10d9acf0fcb852 +F api/play.wiki 06ca7a82a61fef85ace33c80d677822977232a88 +F api/primitives.wiki 36cfca72a54c325c13954fa0e6e9152aac432a16 +F api/printer.wiki 4f3bac13f70c5b43b4b08c4dcd1b6c2a0d94ebe0 +F api/ps.wiki 534b9c33560d082cc8501e6c5899f409d4f26e80 +F api/server.wiki 1fc6ea53d8526211e902e1a43b1f2f1a13e96710 +F api/svg.wiki 3cffd2303f1e2c34468d16bcaae111d70bc95f38 +F api/wmf.wiki 8976c2a3fbd25bb0ecf0008e19ae8ad7b79e4248 +F chicken/canvas-draw-base.scm a398b8328d3370f893d185c7b4a4e3ec2c88ed63 +F chicken/canvas-draw-cgm.scm a689b8a73f0ec69e6c134b6baa1cbcebc174d6bf +F chicken/canvas-draw-client.scm b7d557a7f82f5b22cba521bc83bc4c5d8618d720 +F chicken/canvas-draw-clipboard.scm e0d6041291334a9530a5611840f93c4aed75418e +F chicken/canvas-draw-debug.scm d0e3d962720987a7ca47c6b269e8e23085186352 +F chicken/canvas-draw-dgn.scm 561a4a7057f70a9bddcdb89b3b61ae5d7afee586 +F chicken/canvas-draw-dxf.scm 461f2e8836d6f57d8c0755bbce572d6ce13b6150 +F chicken/canvas-draw-emf.scm 057c88a2dd79d619bdaa350ce5a0e4ed349198f1 +F chicken/canvas-draw-gl.scm b3ceb42ae9205318196aa218dd7c453d2815a190 +F chicken/canvas-draw-iup.scm 9b1370885d4e6b704b76640180802dbbb64de2bb +F chicken/canvas-draw-metafile.scm dff4d2cf55f2f16907dcc954aff0a1d6d3eca440 +F chicken/canvas-draw-native.scm 54e46d244fdec7ea2e53e685a7891d98090bf795 +F chicken/canvas-draw-pdf.scm 2ecd6081ed3dc94062363a9fa6f5bbebe679f549 +F chicken/canvas-draw-picture.scm 401583817f5579edc979ba5a27baccab5fec87b4 +F chicken/canvas-draw-play.scm 1da93abfbca5dcacebac2d2d7ca04e92e566dca3 +F chicken/canvas-draw-primitives.scm 188fe57c8d275ad747e64921281199c09cb47c01 +F chicken/canvas-draw-printer.scm 663846f6249066674ff1afca289f68ab1e499dfb +F chicken/canvas-draw-ps.scm a5eb1aed85d1db9283f069cc59d02f6e4663b2ef +F chicken/canvas-draw-server.scm eb1228217e7d9f91e6cddc7993e9af2a8924102d +F chicken/canvas-draw-svg.scm d20d221b427dbf2098d342cf5e533e22ed807772 +F chicken/canvas-draw-types.scm 63aba3e3b863e40c4b6ba08fd6892cce6fc71b1b +F chicken/canvas-draw-wmf.scm 840e4fc7fc554a20f25e3aa227cbee478c683e19 +F chicken/canvas-draw.meta b9b1e49fadca38a134afe7c7ac8c36b39c693090 +F chicken/canvas-draw.scm a2bd02e214c70ad6b978e5f84379582047956032 +F chicken/canvas-draw.setup 901a63a1f85c529a15c0dbb6e0810c7f6d13c77d +F racket/base.rkt 90a071f77daa2e97eb1576112d98d411484c62b3 +F racket/cgm.rkt 450ed8492b949db1d3338716d9c9ae509534c260 +F racket/client.rkt 1a260d97ea8351f86874a0479dfbcdcb87257715 +F racket/clipboard.rkt ea82433da2d8c221147bdd0764d71869ddbf51db +F racket/debug.rkt e12561359f155699f1f97a887609e534e2ee786a +F racket/dgn.rkt 0f7fe3de34d385ada742a1b06aa42e522cda7951 +F racket/dxf.rkt 6c38a90ce75f2b18bc961fd96d8e333e36526736 +F racket/emf.rkt daeb9e090c57f92481ecb8876fa7ccf686a9e3ef +F racket/gl.rkt b2f08fa5b6b063528c00f716006e19457f7945df +F racket/info.rkt 32fcbd61f85f5cdbe26978840aa76df25cabb8c0 +F racket/iup.rkt cde98249f51821b0038afe248dc5c460101425c8 +F racket/main.rkt 92e540e2fff6fba7b8d33465343259ceab7c3c6f +F racket/metafile.rkt 7c81a9e55c72ad608411ed1af54d42a9955761dc +F racket/native.rkt c102ec574f10efe8711167f1f2856e42e0d88dca +F racket/pdf.rkt 75e477e6d1a4d8d6ff583937a5c8299477f03937 +F racket/picture.rkt 1d85f63ef04a9550045ece803c5ddc16887474c9 +F racket/play.rkt 799196508db45b0bf23e1c8b4d7d316faa22b1b0 +F racket/primitives.rkt ed1ac7e149327202a2533bbced8ecfd6163a1a63 +F racket/printer.rkt 5a4515ba82414f18d45ccb4df530545eb5aec406 +F racket/ps.rkt fc8e7865424b549146a89d991b554fb0c558fd57 +F racket/server.rkt b01bbbfe5d1e59f2eefa0494a2a03590046ddada +F racket/svg.rkt 36d0f855de7190e184a5eef27db71f37b1eaf95c +F racket/wmf.rkt 52ea848f8b60748809e3d9ffad603ace915a5354 +P acecf54f4fcf8950fbfce3e4df9d575e4623db76 +R 6d34495bd98f29b23f00e3b02170c376 +U murphy +Z 0ec981d3607579245a2d8668e79d0222 ADDED canvas-draw/manifest.uuid Index: canvas-draw/manifest.uuid ================================================================== --- /dev/null +++ canvas-draw/manifest.uuid @@ -0,0 +1,1 @@ +33bf93359307b97701634526a6b6212d9397e04e ADDED canvas-draw/racket/base.rkt Index: canvas-draw/racket/base.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/base.rkt @@ -0,0 +1,430 @@ +#lang racket +(require + srfi/2 + srfi/17 + srfi/26 + ffi/unsafe + ffi/unsafe/cvector + ffi/unsafe/alloc + ffi/unsafe/atomic) + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Data types + +(define-cpointer-type _canvas) + +(define-cpointer-type _context) + +(define-cpointer-type _state) + +(provide + _canvas _canvas/null canvas? + _context _context/null context? + _state _state/null state?) + +;; }}} + +;; {{{ Canvas management + +(define _capability-mask + (_bitmask + '(flush = #x00000001 + clear = #x00000002 + play = #x00000004 + y-axis = #x00000008 + clip-area = #x00000010 + clip-polygon = #x00000020 + region = #x00000040 + rectangle = #x00000080 + chord = #x00000100 + image/rgb = #x00000200 + image/rgba = #x00000400 + image/map = #x00000800 + get-image/rgb = #x00001000 + image/server = #x00002000 + background = #x00004000 + background-opacity = #x00008000 + write-mode = #x00010000 + line-style = #x00020000 + line-width = #x00040000 + fprimitives = #x00080000 + hatch = #x00100000 + stipple = #x00200000 + pattern = #x00400000 + font = #x00800000 + font-dimensions = #x01000000 + text-size = #x02000000 + text-orientation = #x04000000 + palette = #x08000000 + line-cap = #x10000000 + line-join = #x20000000 + path = #x40000000 + bezier = #x80000000) + _int)) + +(define context-capabilities + (get-ffi-obj + "cdContextCaps" libcd + (_fun [context : _context] -> [capabilities : _capability-mask]))) + +(define use-context+ + (make-parameter #f)) + +(define use-context+! + (get-ffi-obj + "cdUseContextPlus" libcd + (_fun [plus? : _bool = (use-context+)] -> _void))) + +(define make-canvas/ptr + (get-ffi-obj + "cdCreateCanvas" libcd + (_fun [context : _context] [data : _pointer] -> [canvas : _canvas/null]))) + +(define make-canvas/string + (get-ffi-obj + "cdCreateCanvas" libcd + (_fun [context : _context] [data : _string/utf-8] -> [canvas : _canvas/null]))) + +(define canvas-kill + ((deallocator) + (get-ffi-obj + "cdKillCanvas" libcd + (_fun [canvas : _canvas] -> _void)))) + +(define canvas-activate! + (get-ffi-obj + "cdCanvasActivate" libcd + (_fun [canvas : _canvas] -> _void))) + +(define canvas-deactivate! + (get-ffi-obj + "cdCanvasDeactivate" libcd + (_fun [canvas : _canvas] -> _void))) + +(define make-canvas + ((allocator canvas-kill) + (λ (context data) + (let ([make-canvas/data (if (string? data) make-canvas/string make-canvas/ptr)]) + (use-context+!) + (cond + [(make-canvas/data context data) => values] + [else (error 'make-canvas "failed to create canvas")]))))) + +(define call-with-canvas + (case-lambda + [(canvas proc) + (dynamic-wind + (cut canvas-activate! canvas) + (cut proc canvas) + (cut canvas-deactivate! canvas))] + [(context data proc) + (let* ([make-canvas/data + (if (string? data) make-canvas/string make-canvas/ptr)] + [canvas + (call-as-atomic + (λ () + (use-context+!) + (make-canvas/data context data)))]) + (unless canvas (error 'call-with-canvas "failed to create canvas")) + (dynamic-wind + (cut canvas-activate! canvas) + (cut proc canvas) + (λ () + (when canvas + (canvas-kill canvas) + (set! canvas #f)))))])) + +(define canvas-context + (get-ffi-obj + "cdCanvasGetContext" libcd + (_fun [canvas : _canvas] -> [context : _context]))) + +(define _simulation-mask + (_bitmask + '(none = #x0000 + line = #x0001 + rectangle = #x0002 + box = #x0004 + arc = #x0008 + sector = #x0010 + chord = #x0020 + polyline = #x0040 + polygon = #x0080 + text = #x0100 + all = #xFFFF + lines = #x004B + fills = #x00B4) + _int)) + +(define canvas-simulate! + (get-ffi-obj + "cdCanvasSimulate" libcd + (_fun [canvas : _canvas] [simulate : _simulation-mask] -> [simulate : _simulation-mask]))) + +(define _name + (make-ctype + _string/utf-8 + (λ (name) + (cond + [(symbol? name) + (string-upcase (regexp-replace* #rx"-" (symbol->string name) "_"))] + [else + name])) + #f)) + +(define canvas-attribute-set! + (get-ffi-obj + "cdCanvasSetAttribute" libcd + (_fun [canvas : _canvas] [name : _name] [value : _string/utf-8] -> _void))) + +(define canvas-attribute + (getter-with-setter + (get-ffi-obj + "cdCanvasGetAttribute" libcd + (_fun [canvas : _canvas] [name : _name] -> [value : _string/utf-8])) + canvas-attribute-set!)) + +(define canvas-state-set! + (get-ffi-obj + "cdCanvasRestoreState" libcd + (_fun [canvas : _canvas] [state : _state] -> _void))) + +(define state-release + ((deallocator) + (get-ffi-obj + "cdReleaseState" libcd + (_fun [state : _state] -> _void)))) + +(define canvas-state + (getter-with-setter + ((allocator state-release) + (get-ffi-obj + "cdCanvasSaveState" libcd + (_fun [canvas : _canvas] -> [state : _state]))) + canvas-state-set!)) + +(define canvas-clear! + (get-ffi-obj + "cdCanvasClear" libcd + (_fun [canvas : _canvas] -> _void))) + +(define canvas-flush + (get-ffi-obj + "cdCanvasFlush" libcd + (_fun [canvas : _canvas] -> _void))) + +(provide + context-capabilities + use-context+ make-canvas call-with-canvas + canvas-context + canvas-simulate! + canvas-attribute canvas-attribute-set! + canvas-state canvas-state-set! + canvas-clear! canvas-flush) + +;; }}} + +;; {{{ Coordinate system + +(define canvas-size + (get-ffi-obj + "cdCanvasGetSize" libcd + (_fun [canvas : _canvas] + [width/px : (_ptr o _int)] [height/px : (_ptr o _int)] + [width/mm : (_ptr o _double)] [height/mm : (_ptr o _double)] + -> _void + -> (values + width/px height/px + width/mm height/mm)))) + +(define canvas-mm->px + (get-ffi-obj + "cdCanvasMM2Pixel" libcd + (_fun [canvas : _canvas] + [x/mm : _double*] [y/mm : _double*] + [x/px : (_ptr o _int)] [y/px : (_ptr o _int)] + -> _void + -> (values x/px y/px)))) + +(define canvas-px->mm + (get-ffi-obj + "cdCanvasPixel2MM" libcd + (_fun [canvas : _canvas] + [x/px : _int] [y/px : _int] + [x/mm : (_ptr o _double)] [y/mm : (_ptr o _double)] + -> _void + -> (values x/mm y/mm)))) + +(define canvas-origin-set! + (get-ffi-obj + "cdCanvasOrigin" libcd + (_fun [canvas : _canvas] [x : _int] [y : _int] -> _void))) + +(define canvas-origin + (get-ffi-obj + "cdCanvasGetOrigin" libcd + (_fun [canvas : _canvas] [x : (_ptr o _int)] [y : (_ptr o _int)] + -> _void + -> (values x y)))) + +(define _transform + (make-ctype + _gcpointer + (λ (proc) + (and + proc + (let* ([v (make-cvector _double* 6)]) + (let-values ([(dx dy) (proc 0 0)]) + (cvector-set! v 4 dx) + (cvector-set! v 5 dy) + (let-values ([(x y) (proc 1 0)]) + (cvector-set! v 0 (- x dx)) + (cvector-set! v 1 (- y dy))) + (let-values ([(x y) (proc 0 1)]) + (cvector-set! v 2 (- x dx)) + (cvector-set! v 3 (- y dy)))) + (cvector-ptr v)))) + (λ (v) + (and-let* ([v (and v (make-cvector* v _double* 6))]) + (let ([sx0 (cvector-ref v 0)] [sx1 (cvector-ref v 1)] + [sy0 (cvector-ref v 2)] [sy1 (cvector-ref v 3)] + [dx (cvector-ref v 4)] [dy (cvector-ref v 5)]) + (λ (x y) + (values + (+ (* sx0 x) (* sy0 y) dx) + (+ (* sx1 x) (* sy1 y) dy)))))))) + +(define canvas-transform-set! + (get-ffi-obj + "cdCanvasTransform" libcd + (_fun [canvas : _canvas] [transform : _transform] -> _void))) + +(define canvas-transform + (getter-with-setter + (get-ffi-obj + "cdCanvasGetTransform" libcd + (_fun [canvas : _canvas] -> [transform : _transform])) + canvas-transform-set!)) + +(define canvas-transform-compose! + (get-ffi-obj + "cdCanvasTransformMultiply" libcd + (_fun [canvas : _canvas] [transform : _transform] -> _void))) + +(define canvas-transform-translate! + (get-ffi-obj + "cdCanvasTransformTranslate" libcd + (_fun [canvas : _canvas] [dx : _double*] [dy : _double*] -> _void))) + +(define canvas-transform-scale! + (get-ffi-obj + "cdCanvasTransformScale" libcd + (_fun [canvas : _canvas] [sx : _double*] [sy : _double*] -> _void))) + +(define canvas-transform-rotate! + (get-ffi-obj + "cdCanvasTransformRotate" libcd + (_fun [canvas : _canvas] [alpha : _double*] -> _void))) + +(provide + canvas-size + canvas-mm->px canvas-px->mm + canvas-origin canvas-origin-set! + canvas-transform canvas-transform-set! + canvas-transform-compose! + canvas-transform-translate! + canvas-transform-scale! + canvas-transform-rotate!) + +;; }}} + +;; {{{ General attributes + +(define canvas-foreground-set! + (get-ffi-obj + "cdCanvasSetForeground" libcd + (_fun [canvas : _canvas] [color : _ulong] -> _void))) + +(define canvas-foreground + (getter-with-setter + (get-ffi-obj + "cdCanvasForeground" libcd + (_fun [canvas : _canvas] [query : _long = -1] -> [color : _ulong])) + canvas-foreground-set!)) + +(define canvas-background-set! + (get-ffi-obj + "cdCanvasSetBackground" libcd + (_fun [canvas : _canvas] [color : _ulong] -> _void))) + +(define canvas-background + (getter-with-setter + (get-ffi-obj + "cdCanvasBackground" libcd + (_fun [canvas : _canvas] [query : _long = -1] -> [color : _ulong])) + canvas-background-set!)) + +(define _write-mode + (_enum '(replace xor not-xor))) + +(define canvas-write-mode-set! + (get-ffi-obj + "cdCanvasWriteMode" libcd + (_fun [canvas : _canvas] [mode : _write-mode] -> _void))) + +(define canvas-write-mode + (getter-with-setter + (get-ffi-obj + "cdCanvasWriteMode" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> [mode : _write-mode])) + canvas-write-mode-set!)) + +(provide + canvas-foreground canvas-foreground-set! + canvas-background canvas-background-set! + canvas-write-mode canvas-write-mode-set!) + +;; }}} + +;; {{{ Clipping + +(define _clip-mode + (_enum '(#f area polygon region))) + +(define canvas-clip-mode-set! + (get-ffi-obj + "cdCanvasClip" libcd + (_fun [canvas : _canvas] [mode : _clip-mode] -> _void))) + +(define canvas-clip-mode + (getter-with-setter + (get-ffi-obj + "cdCanvasClip" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> [mode : _clip-mode])) + canvas-clip-mode-set!)) + +(define canvas-clip-area-set! + (get-ffi-obj + "cdfCanvasClipArea" libcd + (_fun [canvas : _canvas] [x0 : _double*] [x1 : _double*] [y0 : _double*] [y1 : _double*] -> _void))) + +(define canvas-clip-area + (get-ffi-obj + "cdfCanvasGetClipArea" libcd + (_fun [canvas : _canvas] + [x0 : (_ptr o _double)] [x1 : (_ptr o _double)] + [y0 : (_ptr o _double)] [y1 : (_ptr o _double)] + -> _void + -> (values x0 x1 y0 y1)))) + +(provide + canvas-clip-mode canvas-clip-mode-set! + canvas-clip-area canvas-clip-area-set!) + +;; }}} ADDED canvas-draw/racket/cgm.rkt Index: canvas-draw/racket/cgm.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/cgm.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:cgm + ((get-ffi-obj "cdContextCGM" libcd (_fun -> [context : _context])))) + +(provide + context:cgm) + +;; }}} ADDED canvas-draw/racket/client.rkt Index: canvas-draw/racket/client.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/client.rkt @@ -0,0 +1,102 @@ +#lang racket +(require + srfi/17 + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:image + ((get-ffi-obj "cdContextImageRGB" libcd (_fun -> [context : _context])))) + +(define context:double-buffer + ((get-ffi-obj "cdContextDBufferRGB" libcd (_fun -> [context : _context])))) + +(provide + context:image context:double-buffer) + +;; }}} + +;; {{{ Auxiliary functions + +(define (bytes-slice bstr n k slen) + (let ([blen (bytes-length bstr)]) + (unless (= blen (* n slen)) + (error 'bytes-slice "data length mismatch (actual ~s, required ~s)" blen (* n slen))) + (let ([slice (make-bytes slen)]) + (for ([bi (in-range k blen n)] [si (in-range slen)]) + (bytes-set! slice si (bytes-ref bstr bi))) + slice))) + +(define (bytes-mix slice0 . slice*) + (let* ([n (add1 (length slice*))] + [blen (* n (bytes-length slice0))] + [bstr (make-bytes blen)]) + (for ([slice (in-cycle (in-value slice0) (in-list slice*))] + [bi (in-range blen)] #:when #t [si (in-value (quotient bi n))]) + (bytes-set! bstr bi (bytes-ref slice si))) + bstr)) + +(define canvas-image-put/rgb! + (get-ffi-obj + "cdCanvasPutImageRectRGB" libcd + (_fun (canvas dst-x dst-y src-width src-height data + #:width [dst-width 0] #:height [dst-height 0] + #:x0 [src-x0 0] #:x1 [src-x1 0] + #:y0 [src-y0 0] #:y1 [src-y1 0]) + :: [canvas : _canvas] + [src-width : _int] [src-height : _int] + [red : _bytes = (bytes-slice data 3 0 (* src-width src-height))] + [green : _bytes = (bytes-slice data 3 1 (* src-width src-height))] + [blue : _bytes = (bytes-slice data 3 2 (* src-width src-height))] + [dst-x : _int] [dst-y : _int] + [dst-width : _int] [dst-height : _int] + [src-x0 : _int] [src-x1 : _int] + [src-y0 : _int] [src-y1 : _int] + -> _void))) + +(define canvas-image-put/rgba! + (get-ffi-obj + "cdCanvasPutImageRectRGBA" libcd + (_fun (canvas dst-x dst-y src-width src-height data + #:width [dst-width 0] #:height [dst-height 0] + #:x0 [src-x0 0] #:x1 [src-x1 0] + #:y0 [src-y0 0] #:y1 [src-y1 0]) + :: [canvas : _canvas] + [src-width : _int] [src-height : _int] + [red : _bytes = (bytes-slice data 4 0 (* src-width src-height))] + [green : _bytes = (bytes-slice data 4 1 (* src-width src-height))] + [blue : _bytes = (bytes-slice data 4 2 (* src-width src-height))] + [alpha : _bytes = (bytes-slice data 4 3 (* src-width src-height))] + [dst-x : _int] [dst-y : _int] + [dst-width : _int] [dst-height : _int] + [src-x0 : _int] [src-x1 : _int] + [src-y0 : _int] [src-y1 : _int] + -> _void))) + +(define canvas-image/rgb + (getter-with-setter + (get-ffi-obj + "cdCanvasGetImageRGB" libcd + (_fun (canvas x y width height) + :: [canvas : _canvas] + [red : (_bytes o (* width height))] + [green : (_bytes o (* width height))] + [blue : (_bytes o (* width height))] + [x : _int] [y : _int] + [width : _int] [height : _int] + -> _void + -> (bytes-mix red green blue))) + canvas-image-put/rgb!)) + +(provide + canvas-image/rgb canvas-image-put/rgb! canvas-image-put/rgba!) + +;; }}} ADDED canvas-draw/racket/clipboard.rkt Index: canvas-draw/racket/clipboard.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/clipboard.rkt @@ -0,0 +1,23 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd-native + (case (system-type 'os) + [(unix macosx) + (ffi-lib "libcdx11")] + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:clipboard + ((get-ffi-obj "cdContextClipboard" libcd-native (_fun -> [context : _context])))) + +(provide + context:clipboard) + +;; }}} ADDED canvas-draw/racket/debug.rkt Index: canvas-draw/racket/debug.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/debug.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:debug + ((get-ffi-obj "cdContextDebug" libcd (_fun -> [context : _context])))) + +(provide + context:debug) + +;; }}} ADDED canvas-draw/racket/dgn.rkt Index: canvas-draw/racket/dgn.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/dgn.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:dgn + ((get-ffi-obj "cdContextDGN" libcd (_fun -> [context : _context])))) + +(provide + context:dgn) + +;; }}} ADDED canvas-draw/racket/dxf.rkt Index: canvas-draw/racket/dxf.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/dxf.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:dxf + ((get-ffi-obj "cdContextDXF" libcd (_fun -> [context : _context])))) + +(provide + context:dxf) + +;; }}} ADDED canvas-draw/racket/emf.rkt Index: canvas-draw/racket/emf.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/emf.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:emf + ((get-ffi-obj "cdContextEMF" libcd (_fun -> [context : _context])))) + +(provide + context:emf) + +;; }}} ADDED canvas-draw/racket/gl.rkt Index: canvas-draw/racket/gl.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/gl.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd-gl + (case (system-type 'os) + [(windows) + (ffi-lib "cdgl")] + [else + (ffi-lib "libcdgl")])) + +;; {{{ Context types + +(define context:gl + ((get-ffi-obj "cdContextGL" libcd-gl (_fun -> [context : _context])))) + +(provide + context:gl) + +;; }}} ADDED canvas-draw/racket/info.rkt Index: canvas-draw/racket/info.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/info.rkt @@ -0,0 +1,18 @@ +#lang setup/infotab +(define name + "Canvas Draw") +(define blurb + '("Bindings to the CD graphics library")) +(define categories + '(graphics)) +(define repositories + '("4.x")) +(define version + "1.0") +(define release-notes + '((dl + (dt "1.0") (dd "Initial release")))) +(define primary-file + "main.rkt") +(define homepage + "http://www.chust.org/fossils/canvas-draw") ADDED canvas-draw/racket/iup.rkt Index: canvas-draw/racket/iup.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/iup.rkt @@ -0,0 +1,35 @@ +#lang racket +(require + srfi/26 + ffi/unsafe + "base.rkt") + +(define libiup-cd + (case (system-type 'os) + [(windows) + (ffi-lib "iupcd")] + [else + (ffi-lib "libiupcd")])) + +;; {{{ Context types + +(define context:iup + ((get-ffi-obj "cdContextCGM" libiup-cd (_fun -> [context : _context])))) + +(provide + context:iup) + +;; }}} + +;; {{{ Auxiliary functions + +(define (make-canvas-action proc) + (let ([canvas #f]) + (λ (handle x y) + (unless canvas (set! canvas (make-canvas context:iup handle))) + (call-with-canvas canvas (cut proc <> x y))))) + +(provide + make-canvas-action) + +;; }}} ADDED canvas-draw/racket/main.rkt Index: canvas-draw/racket/main.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/main.rkt @@ -0,0 +1,11 @@ +#lang racket/base +(require + "base.rkt" "primitives.rkt" "play.rkt") + +(provide + (except-out (all-from-out "base.rkt") + _canvas _canvas/null + _context _context/null + _state _state/null) + (all-from-out "primitives.rkt") + (all-from-out "play.rkt")) ADDED canvas-draw/racket/metafile.rkt Index: canvas-draw/racket/metafile.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/metafile.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:metafile + ((get-ffi-obj "cdContextMetafile" libcd (_fun -> [context : _context])))) + +(provide + context:metafile) + +;; }}} ADDED canvas-draw/racket/native.rkt Index: canvas-draw/racket/native.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/native.rkt @@ -0,0 +1,55 @@ +#lang racket +(require + ffi/unsafe + "base.rkt") + +(define libcd-native + (case (system-type 'os) + [(unix macosx) + (ffi-lib "libcdx11")] + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +(define libcd-context+ + (case (system-type 'os) + [(windows) + (ffi-lib "cdcontextplus")] + [else + (ffi-lib "libcdcontextplus")])) + +;; {{{ Context types + +(define context:native-window + ((get-ffi-obj "cdContextNativeWindow" libcd-native (_fun -> [context : _context])))) + +(provide + context:native-window) + +;; }}} + +;; {{{ Auxiliary functions + +(define screen-size + (get-ffi-obj + "cdGetScreenSize" libcd-native + (_fun [width/px : (_ptr o _int)] [height/px : (_ptr o _int)] + [width/mm : (_ptr o _double)] [height/mm : (_ptr o _double)] + -> _void + -> (values + width/px height/px + width/mm height/mm)))) + +(provide + screen-size) + +;; }}} + +;; {{{ Library initialization + +((get-ffi-obj + "cdInitContextPlus" libcd-context+ + (_fun -> _void))) + +;; }}} ADDED canvas-draw/racket/pdf.rkt Index: canvas-draw/racket/pdf.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/pdf.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd-pdf + (case (system-type 'os) + [(windows) + (ffi-lib "cdpdf")] + [else + (ffi-lib "libcdpdf")])) + +;; {{{ Context types + +(define context:pdf + ((get-ffi-obj "cdContextPDF" libcd-pdf (_fun -> [context : _context])))) + +(provide + context:pdf) + +;; }}} ADDED canvas-draw/racket/picture.rkt Index: canvas-draw/racket/picture.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/picture.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:picture + ((get-ffi-obj "cdContextPicture" libcd (_fun -> [context : _context])))) + +(provide + context:picture) + +;; }}} ADDED canvas-draw/racket/play.rkt Index: canvas-draw/racket/play.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/play.rkt @@ -0,0 +1,39 @@ +#lang racket +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context content playback + +(define canvas-play/ptr! + (get-ffi-obj + "cdCanvasPlay" libcd + (_fun [canvas : _canvas] [context : _context] + [x0 : _int] [x1 : _int] [y0 : _int] [y1 : _int] + [data : _pointer] + -> [rc : _int]))) + +(define canvas-play/string! + (get-ffi-obj + "cdCanvasPlay" libcd + (_fun [canvas : _canvas] [context : _context] + [x0 : _int] [x1 : _int] [y0 : _int] [y1 : _int] + [data : _string/utf-8] + -> [rc : _int]))) + +(define (canvas-play! canvas context x0 x1 y0 y1 data) + (let ([canvas-play/data! (if (string? data) canvas-play/string! canvas-play/ptr!)]) + (unless (zero? (canvas-play/data! canvas context x0 x1 y0 y1 data)) + (error 'canvas-play! "failed to replay graphics")))) + +(provide + canvas-play!) + +;; }}} ADDED canvas-draw/racket/primitives.rkt Index: canvas-draw/racket/primitives.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/primitives.rkt @@ -0,0 +1,496 @@ +#lang racket +(require + srfi/17 + srfi/26 + ffi/unsafe + ffi/unsafe/cvector + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Point drawing functions + +(define canvas-pixel! + (get-ffi-obj + "cdCanvasPixel" libcd + (_fun (canvas x y [color (canvas-foreground canvas)]) + :: [canvas : _canvas] [x : _int] [y : _int] [color : _ulong] -> _void))) + +(define canvas-mark! + (get-ffi-obj + "cdCanvasMark" libcd + (_fun [canvas : _canvas] [x : _int] [y : _int] -> _void))) + +(define _mark-type + (_enum + '(+ = 0 plus = 0 + * = 1 star = 1 + 0 = 2 circle = 2 + X = 3 x = 3 + box + diamond + O = 6 hollow-circle = 6 + hollow-box + hollow-diamond) + _fixint)) + +(define canvas-mark-type-set! + (get-ffi-obj + "cdCanvasMarkType" libcd + (_fun [canvas : _canvas] [mark-type : _mark-type] -> _void))) + +(define canvas-mark-type + (getter-with-setter + (get-ffi-obj + "cdCanvasMarkType" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> [mark-type : _mark-type])) + canvas-mark-type-set!)) + +(define canvas-mark-size-set! + (get-ffi-obj + "cdCanvasMarkSize" libcd + (_fun [canvas : _canvas] [size : _int] -> _void))) + +(define canvas-mark-size + (getter-with-setter + (get-ffi-obj + "cdCanvasMarkSize" libcd + (_fun [canvas : _canvas] [query : _int = -1] -> [size : _int])) + canvas-mark-size-set!)) + +(provide + canvas-pixel! + canvas-mark! + canvas-mark-type canvas-mark-type-set! + canvas-mark-size canvas-mark-size-set!) + +;; }}} + +;; {{{ Line functions + +(define canvas-line! + (get-ffi-obj + "cdfCanvasLine" libcd + (_fun [canvas : _canvas] [x0 : _double*] [y0 : _double*] [x1 : _double*] [y1 : _double*] -> _void))) + +(define canvas-rectangle! + (get-ffi-obj + "cdfCanvasRect" libcd + (_fun [canvas : _canvas] [x0 : _double*] [x1 : _double*] [y0 : _double*] [y1 : _double*] -> _void))) + +(define canvas-arc! + (get-ffi-obj + "cdfCanvasArc" libcd + (_fun [canvas : _canvas] + [x : _double*] [y : _double*] [width : _double*] [height : _double*] + [alpha0 : _double*] [alpha1 : _double*] + -> _void))) + +(define _line-style + (_enum + '(continuous dashed dotted dash-dotted dash-dot-dotted custom) + _fixint)) + +(define canvas-line-style-set! + (letrec ([canvas-line-style-set/raw! + (get-ffi-obj + "cdCanvasLineStyle" libcd + (_fun [canvas : _canvas] [line-style : _line-style] -> _void))] + [canvas-line-style-dashes-set/raw! + (get-ffi-obj + "cdCanvasLineStyleDashes" libcd + (_fun [canvas : _canvas] [dashes : _cvector] [len : _int = (cvector-length dashes)] -> _void))]) + (λ (canvas line-style) + (match line-style + [(list-rest 'custom dashes) + (canvas-line-style-dashes-set/raw! canvas (list->cvector dashes _int)) + (canvas-line-style-set/raw! canvas 'dashes)] + [_ + (canvas-line-style-set/raw! canvas line-style)])))) + +(define canvas-line-style + (getter-with-setter + (get-ffi-obj + "cdCanvasLineStyle" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> [line-style : _line-style])) + canvas-line-style-set!)) + +(define canvas-line-width-set! + (get-ffi-obj + "cdCanvasLineWidth" libcd + (_fun [canvas : _canvas] [width : _int] -> _void))) + +(define canvas-line-width + (getter-with-setter + (get-ffi-obj + "cdCanvasLineWidth" libcd + (_fun [canvas : _canvas] [query : _int = -1] -> [width : _int])) + canvas-line-width-set!)) + +(define _line-join + (_enum + '(miter bevel round) + _fixint)) + +(define canvas-line-join-set! + (get-ffi-obj + "cdCanvasLineJoin" libcd + (_fun [canvas : _canvas] [line-join : _line-join] -> _void))) + +(define canvas-line-join + (getter-with-setter + (get-ffi-obj + "cdCanvasLineJoin" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> _void)) + canvas-line-join-set!)) + +(define _line-cap + (_enum + '(flat square round) + _fixint)) + +(define canvas-line-cap-set! + (get-ffi-obj + "cdCanvasLineCap" libcd + (_fun [canvas : _canvas] [line-cap : _line-cap] -> _void))) + +(define canvas-line-cap + (getter-with-setter + (get-ffi-obj + "cdCanvasLineCap" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> [line-cap : _line-cap])) + canvas-line-cap-set!)) + +(provide + canvas-line! canvas-rectangle! canvas-arc! + canvas-line-style canvas-line-style-set! + canvas-line-width canvas-line-width-set! + canvas-line-join canvas-line-join-set! + canvas-line-cap canvas-line-cap-set!) + +;; }}} + +;; {{{ Filled area functions + +(define canvas-box! + (get-ffi-obj + "cdfCanvasBox" libcd + (_fun [canvas : _canvas] [x0 : _double*] [x1 : _double*] [y0 : _double*] [y1 : _double*] -> _void))) + +(define canvas-sector! + (get-ffi-obj + "cdfCanvasSector" libcd + (_fun [canvas : _canvas] + [x : _double*] [y : _double*] [width : _double*] [height : _double*] + [alpha0 : _double*] [alpha1 : _double*] + -> _void))) + +(define canvas-chord! + (get-ffi-obj + "cdfCanvasChord" libcd + (_fun [canvas : _canvas] + [x : _double*] [y : _double*] [width : _double*] [height : _double*] + [alpha0 : _double*] [alpha1 : _double*] + -> _void))) + +(define _opacity + (_enum + '(opaque transparent) + _fixint)) + +(define canvas-background-opacity-set! + (get-ffi-obj + "cdCanvasBackOpacity" libcd + (_fun [canvas : _canvas] [opacity : _opacity] -> _void))) + +(define canvas-background-opacity + (getter-with-setter + (get-ffi-obj + "cdCanvasBackOpacity" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> [opacity : _opacity])) + canvas-background-opacity-set!)) + +(define _fill-mode + (_enum + '(even-odd winding) + _fixint)) + +(define canvas-fill-mode-set! + (get-ffi-obj + "cdCanvasFillMode" libcd + (_fun [canvas : _canvas] [fill-mode : _fill-mode] -> _void))) + +(define canvas-fill-mode + (getter-with-setter + (get-ffi-obj + "cdCanvasFillMode" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> [fill-mode : _fill-mode])) + canvas-fill-mode-set!)) + +(define _interior-style + (_enum + '(solid hatch stipple pattern #f) + _fixint)) + +(define _hatch-style + (_enum + '(horizontal vertical forward-diagonal backward-diagonal cross diagonal-cross) + _fixint)) + +(define canvas-interior-style-set! + (letrec ([canvas-interior-style-set/raw! + (get-ffi-obj + "cdCanvasInteriorStyle" libcd + (_fun [canvas : _canvas] [interior-style : _interior-style] -> _void))] + [canvas-hatch-style-set/raw! + (get-ffi-obj + "cdCanvasHatch" libcd + (_fun [canvas : _canvas] [hatch-style : _hatch-style] -> _void))] + [canvas-stipple-set/raw! + (get-ffi-obj + "cdCanvasStipple" libcd + (_fun [canvas : _canvas] [width : _int] [height : _int] [data* : _cvector] -> _void))] + [canvas-pattern-set/raw! + (get-ffi-obj + "cdCanvasPattern" libcd + (_fun [canvas : _canvas] [width : _int] [height : _int] [data* : _cvector] -> _void))]) + (λ (canvas interior-style) + (match interior-style + [(list 'hatch hatch-style) + (canvas-hatch-style-set/raw! canvas hatch-style) + (canvas-interior-style-set/raw! canvas 'hatch)] + [(list 'stipple width height data) + (let ([data* (make-cvector _ubyte (* width height))]) + (for* ([j (in-range height)] [i (in-range width)] + [ofs* (in-value (+ (* j width) i))] + [vofs (in-value (quotient ofs* 8))] + [bofs (in-value (remainder ofs* 8))]) + (cvector-set! data* ofs* (bitwise-bit-field (bytes-ref data vofs) bofs (add1 bofs)))) + (canvas-stipple-set/raw! canvas width height data*)) + (canvas-interior-style-set/raw! canvas 'stipple)] + [(list 'pattern/rgb width height data) + (let ([data* (make-cvector _ulong (* width height))]) + (for* ([j (in-range height)] [i (in-range width)] + [ofs* (in-value (+ (* j width) i))] + [ofs (in-value (* 3 ofs*))]) + (cvector-set! data* ofs* + (bitwise-ior + (arithmetic-shift (bytes-ref data ofs) 16) + (arithmetic-shift (bytes-ref data (+ ofs 1)) 8) + (bytes-ref data (+ ofs 2))))) + (canvas-pattern-set/raw! canvas width height data*)) + (canvas-interior-style-set/raw! canvas 'pattern)] + [(list 'pattern/rgba width height data) + (let* ([data* (make-cvector _ulong (* width height))] + [elt-set! (cut ptr-set! data* _long <> <>)]) + (for* ([j (in-range height)] [i (in-range width)] + [ofs* (in-value (+ (* j width) i))] + [ofs (in-value (* 4 ofs*))]) + (cvector-set! data* ofs* + (bitwise-ior + (arithmetic-shift (- #xff (bytes-ref data (+ ofs 3))) 24) + (arithmetic-shift (bytes-ref data ofs) 16) + (arithmetic-shift (bytes-ref data (+ ofs 1)) 8) + (bytes-ref data (+ ofs 2))))) + (canvas-pattern-set/raw! canvas width height data*)) + (canvas-interior-style-set/raw! canvas 'pattern)] + [_ + (canvas-interior-style-set/raw! canvas interior-style)])))) + +(define canvas-interior-style + (getter-with-setter + (letrec ([canvas-interior-style/raw + (get-ffi-obj + "cdCanvasInteriorStyle" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> [interior-style : _interior-style]))] + [canvas-hatch-style/raw + (get-ffi-obj + "cdCanvasHatch" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> [hatch-style : _hatch-style]))] + [canvas-stipple/raw + (get-ffi-obj + "cdCanvasGetStipple" libcd + (_fun [canvas : _canvas] [width : (_ptr o _int)] [height : (_ptr o _int)] + -> [data : _gcpointer] + -> (values width height data)))] + [canvas-pattern/raw + (get-ffi-obj + "cdCanvasGetPattern" libcd + (_fun [canvas : _canvas] [width : (_ptr o _int)] [height : (_ptr o _int)] + -> [data : _gcpointer] + -> (values width height data)))]) + (λ (canvas) + (let ([interior-style (canvas-interior-style/raw canvas)]) + (case interior-style + [(hatch) + (list 'hatch (canvas-hatch-style/raw canvas))] + [(stipple) + (let*-values ([(width height data*) (canvas-stipple/raw canvas)] + [(data*) (make-cvector* data* _ubyte (* width height))] + [(data) (make-bytes (ceiling (/ (* width height) 8)) 0)]) + (for* ([j (in-range height)] [i (in-range width)] + [ofs* (in-value (+ (* j width) i))] + [vofs (in-value (quotient ofs* 8))] + [bofs (in-value (remainder ofs* 8))]) + (bytes-set! data vofs + (bitwise-ior + (bytes-ref data vofs) + (arithmetic-shift (bitwise-and (cvector-ref data* ofs*) 1) bofs)))) + (list 'stipple width height data))] + [(pattern) + (let*-values ([(width height data*) (canvas-pattern/raw canvas)] + [(data*) (make-cvector* data* _ulong (* width height))] + [(data) (make-bytes (* 4 width height))]) + (for* ([j (in-range height)] [i (in-range width)] + [ofs* (in-value (+ (* j width) i))] + [ofs (in-value (* 4 ofs*))] + [col (in-value (cvector-ref data* ofs*))]) + (bytes-set! data ofs (bitwise-bit-field col 16 24)) + (bytes-set! data (+ ofs 1) (bitwise-bit-field col 8 16)) + (bytes-set! data (+ ofs 2) (bitwise-bit-field col 0 8)) + (bytes-set! data (+ ofs 3) (- #xff (bitwise-bit-field col 24 32)))) + (list 'pattern/rgba width height data))] + [else + interior-style])))) + canvas-interior-style-set!)) + +(provide + canvas-box! canvas-sector! canvas-chord! + canvas-background-opacity canvas-background-opacity-set! + canvas-fill-mode canvas-fill-mode-set! + canvas-interior-style canvas-interior-style-set!) + +;; }}} + +;; {{{ Text functions + +(define canvas-text! + (get-ffi-obj + "cdfCanvasText" libcd + (_fun [canvas : _canvas] [x : _double*] [y : _double*] [text : _string/utf-8] -> _void))) + +(define canvas-font-set! + (get-ffi-obj + "cdCanvasNativeFont" libcd + (_fun [canvas : _canvas] [font : _string/utf-8] -> _void))) + +(define canvas-font + (getter-with-setter + (get-ffi-obj + "cdCanvasNativeFont" libcd + (_fun [canvas : _canvas] [query : _pointer = #f] -> [font : _string/utf-8])) + canvas-font-set!)) + +(define _alignment + (_enum + '(north south east west north-east north-west south-east south-west center base-left base-center base-right) + _fixint)) + +(define canvas-text-alignment-set! + (get-ffi-obj + "cdCanvasTextAlignment" libcd + (_fun [canvas : _canvas] [alignment : _alignment] -> _void))) + +(define canvas-text-alignment + (getter-with-setter + (get-ffi-obj + "cdCanvasTextAlignment" libcd + (_fun [canvas : _canvas] [query : _fixint = -1] -> [alignment : _alignment])) + canvas-text-alignment-set!)) + +(define canvas-text-orientation-set! + (get-ffi-obj + "cdCanvasTextOrientation" libcd + (_fun [canvas : _canvas] [orientation : _double*] -> _void))) + +(define canvas-text-orientation + (getter-with-setter + (get-ffi-obj + "cdCanvasTextOrientation" libcd + (_fun [canvas : _canvas] [query : _double = -1.0] -> [orientation : _double])) + canvas-text-orientation-set!)) + +(define canvas-font-dimensions + (get-ffi-obj + "cdCanvasGetFontDim" libcd + (_fun [canvas : _canvas] + [max-width : (_ptr o _int)] [height : (_ptr o _int)] + [ascent : (_ptr o _int)] [descent : (_ptr o _int)] + -> _void + -> (values + max-width height + ascent descent)))) + +(define canvas-text-size + (get-ffi-obj + "cdCanvasGetTextSize" libcd + (_fun [canvas : _canvas] [text : _string/utf-8] + [width : (_ptr o _int)] [height : (_ptr o _int)] + -> _void + -> (values width height)))) + +(define canvas-text-box + (get-ffi-obj + "cdCanvasGetTextBox" libcd + (_fun [canvas : _canvas] [x : _int] [y : _int] [text : _string/utf-8] + [x0 : (_ptr o _int)] [x1 : (_ptr o _int)] + [y0 : (_ptr o _int)] [y1 : (_ptr o _int)] + -> _void + -> (values x0 x1 y0 y1)))) + +(provide + canvas-text! + canvas-font canvas-font-set! + canvas-text-alignment canvas-text-alignment-set! + canvas-text-orientation canvas-text-orientation-set! + canvas-font-dimensions canvas-text-size canvas-text-box) + +;; }}} + +;; {{{ Vertex functions + +(define _canvas-mode + (_enum + '(fill open-lines closed-lines clip bezier region path) + _fixint)) + +(define call-with-canvas-in-mode + (letrec ([canvas-begin/raw + (get-ffi-obj + "cdCanvasBegin" libcd + (_fun [canvas : _canvas] [canvas-mode : _canvas-mode] -> _void))] + [canvas-end/raw + (get-ffi-obj + "cdCanvasEnd" libcd + (_fun [canvas : _canvas] -> _void))]) + (λ (canvas canvas-mode proc) + (dynamic-wind + (cut canvas-begin/raw canvas canvas-mode) + (cut proc canvas) + (cut canvas-end/raw canvas))))) + +(define _path-action + (_enum + '(new move-to line-to arc curve-to close fill stroke fill+stroke clip) + _fixint)) + +(define canvas-path-set! + (get-ffi-obj + "cdCanvasPathSet" libcd + (_fun [canvas : _canvas] [path-action : _path-action] -> _void))) + +(define canvas-vertex! + (get-ffi-obj + "cdfCanvasVertex" libcd + (_fun [canvas : _canvas] [x : _double*] [y : _double*] -> _void))) + +(provide + call-with-canvas-in-mode canvas-path-set! + canvas-vertex!) + +;; }}} ADDED canvas-draw/racket/printer.rkt Index: canvas-draw/racket/printer.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/printer.rkt @@ -0,0 +1,23 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd-native + (case (system-type 'os) + [(unix macosx) + (ffi-lib "libcdx11")] + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:printer + ((get-ffi-obj "cdContextPrinter" libcd-native (_fun -> [context : _context])))) + +(provide + context:printer) + +;; }}} ADDED canvas-draw/racket/ps.rkt Index: canvas-draw/racket/ps.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/ps.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:ps + ((get-ffi-obj "cdContextPS" libcd (_fun -> [context : _context])))) + +(provide + context:ps) + +;; }}} ADDED canvas-draw/racket/server.rkt Index: canvas-draw/racket/server.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/server.rkt @@ -0,0 +1,26 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd-native + (case (system-type 'os) + [(unix macosx) + (ffi-lib "libcdx11")] + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:image + ((get-ffi-obj "cdContextImage" libcd-native (_fun -> [context : _context])))) + +(define context:double-buffer + ((get-ffi-obj "cdContextDBuffer" libcd-native (_fun -> [context : _context])))) + +(provide + context:image context:double-buffer) + +;; }}} ADDED canvas-draw/racket/svg.rkt Index: canvas-draw/racket/svg.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/svg.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:svg + ((get-ffi-obj "cdContextSVG" libcd (_fun -> [context : _context])))) + +(provide + context:svg) + +;; }}} ADDED canvas-draw/racket/wmf.rkt Index: canvas-draw/racket/wmf.rkt ================================================================== --- /dev/null +++ canvas-draw/racket/wmf.rkt @@ -0,0 +1,21 @@ +#lang racket/base +(require + ffi/unsafe + "base.rkt") + +(define libcd + (case (system-type 'os) + [(windows) + (ffi-lib "cd")] + [else + (ffi-lib "libcd")])) + +;; {{{ Context types + +(define context:wmf + ((get-ffi-obj "cdContextWMF" libcd (_fun -> [context : _context])))) + +(provide + context:wmf) + +;; }}} Index: ffcall/Makefile ================================================================== --- ffcall/Makefile +++ ffcall/Makefile @@ -1,11 +1,11 @@ # Makefile for ffcall #### Start of system configuration section. #### # Directories used by "make install": -prefix = /mylibs/iup +prefix = C:/mylibs/iup local_prefix = /usr/local exec_prefix = ${prefix} libdir = ${exec_prefix}/lib includedir = ${prefix}/include mandir = ${prefix}/man Index: ffcall/avcall/Makefile ================================================================== --- ffcall/avcall/Makefile +++ ffcall/avcall/Makefile @@ -8,11 +8,11 @@ # Directories used by "make": srcdir = . # Directories used by "make install": -prefix = /mylibs/iup +prefix = C:/mylibs/iup local_prefix = /usr/local exec_prefix = ${prefix} libdir = ${exec_prefix}/lib includedir = ${prefix}/include mandir = ${prefix}/man Index: ffcall/avcall/config.log ================================================================== --- ffcall/avcall/config.log +++ ffcall/avcall/config.log @@ -2,11 +2,11 @@ running configure, to aid debugging if configure makes a mistake. It was created by configure, which was generated by GNU Autoconf 2.59. Invocation command line was - $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=. + $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=. ## --------- ## ## Platform. ## ## --------- ## @@ -36,10 +36,11 @@ PATH: /c/windows PATH: /c/windows/SYSTEM32/WBEM PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/ PATH: /mingw/bin PATH: /c/chicken/bin +PATH: /c/mylibs/iup PATH: /c/Program Files/Windows Live/Shared ## ----------- ## ## Core tests. ## @@ -523,12 +524,12 @@ conftest.c:28:34: warning: function called through a non-compatible type conftest.c:28:34: note: if this code is reached, the program will abort conftest.c:29:3: warning: incompatible implicit declaration of built-in function 'exit' configure:8039: $? = 0 configure:8041: ./conftest.exe -configure:8044: $? = 255 -configure: program exited with status 255 +configure:8044: $? = 29 +configure: program exited with status 29 configure: failed program was: | /* confdefs.h. */ | | #define PACKAGE_NAME "" | #define PACKAGE_TARNAME "" @@ -728,11 +729,11 @@ libdir='${exec_prefix}/lib' libexecdir='${exec_prefix}/libexec' localstatedir='${prefix}/var' mandir='${prefix}/man' oldincludedir='/usr/include' -prefix='/mylibs/iup' +prefix='C:/mylibs/iup' program_transform_name='s,x,x,' sbindir='${exec_prefix}/sbin' sharedstatedir='${prefix}/com' sysconfdir='${prefix}/etc' target_alias='' Index: ffcall/avcall/config.status ================================================================== --- ffcall/avcall/config.status +++ ffcall/avcall/config.status @@ -298,11 +298,11 @@ Report bugs to ." ac_cs_version="\ config.status configured by ./configure, generated by GNU Autoconf 2.59, - with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" + with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=. @@ -376,12 +376,12 @@ exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi if $ac_cs_recheck; then - echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 - exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion + echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 + exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion fi for ac_config_target in $ac_config_targets do case "$ac_config_target" in @@ -445,11 +445,11 @@ s,@PACKAGE_TARNAME@,,;t t s,@PACKAGE_VERSION@,,;t t s,@PACKAGE_STRING@,,;t t s,@PACKAGE_BUGREPORT@,,;t t s,@exec_prefix@,${prefix},;t t -s,@prefix@,/mylibs/iup,;t t +s,@prefix@,C:/mylibs/iup,;t t s,@program_transform_name@,s,x,x,,;t t s,@bindir@,${exec_prefix}/bin,;t t s,@sbindir@,${exec_prefix}/sbin,;t t s,@libexecdir@,${exec_prefix}/libexec,;t t s,@datadir@,${prefix}/share,;t t Index: ffcall/callback/Makefile ================================================================== --- ffcall/callback/Makefile +++ ffcall/callback/Makefile @@ -7,11 +7,11 @@ # Directories used by "make": srcdir = . # Directories used by "make install": -prefix = /mylibs/iup +prefix = C:/mylibs/iup local_prefix = /usr/local exec_prefix = ${prefix} libdir = ${exec_prefix}/lib includedir = ${prefix}/include mandir = ${prefix}/man Index: ffcall/callback/config.log ================================================================== --- ffcall/callback/config.log +++ ffcall/callback/config.log @@ -2,11 +2,11 @@ running configure, to aid debugging if configure makes a mistake. It was created by configure, which was generated by GNU Autoconf 2.59. Invocation command line was - $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=. + $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=. ## --------- ## ## Platform. ## ## --------- ## @@ -36,10 +36,11 @@ PATH: /c/windows PATH: /c/windows/SYSTEM32/WBEM PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/ PATH: /mingw/bin PATH: /c/chicken/bin +PATH: /c/mylibs/iup PATH: /c/Program Files/Windows Live/Shared ## ----------- ## ## Core tests. ## @@ -476,13 +477,13 @@ on hermes config.status:657: creating Makefile configure:8840: configuring in vacall_r -configure:8957: running /bin/sh './configure' --prefix=/mylibs/iup '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' --cache-file=/dev/null --srcdir=. +configure:8957: running /bin/sh './configure' --prefix=C:/mylibs/iup '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' --cache-file=/dev/null --srcdir=. configure:8840: configuring in trampoline_r -configure:8957: running /bin/sh './configure' --prefix=/mylibs/iup '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' --cache-file=/dev/null --srcdir=. +configure:8957: running /bin/sh './configure' --prefix=C:/mylibs/iup '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' --cache-file=/dev/null --srcdir=. ## ---------------- ## ## Cache variables. ## ## ---------------- ## @@ -616,11 +617,11 @@ libdir='${exec_prefix}/lib' libexecdir='${exec_prefix}/libexec' localstatedir='${prefix}/var' mandir='${prefix}/man' oldincludedir='/usr/include' -prefix='/mylibs/iup' +prefix='C:/mylibs/iup' program_transform_name='s,x,x,' sbindir='${exec_prefix}/sbin' sharedstatedir='${prefix}/com' subdirs=' vacall_r trampoline_r' sysconfdir='${prefix}/etc' Index: ffcall/callback/config.status ================================================================== --- ffcall/callback/config.status +++ ffcall/callback/config.status @@ -292,11 +292,11 @@ Report bugs to ." ac_cs_version="\ config.status configured by ./configure, generated by GNU Autoconf 2.59, - with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" + with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=. @@ -370,12 +370,12 @@ exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi if $ac_cs_recheck; then - echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 - exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion + echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 + exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion fi for ac_config_target in $ac_config_targets do case "$ac_config_target" in @@ -437,11 +437,11 @@ s,@PACKAGE_TARNAME@,,;t t s,@PACKAGE_VERSION@,,;t t s,@PACKAGE_STRING@,,;t t s,@PACKAGE_BUGREPORT@,,;t t s,@exec_prefix@,${prefix},;t t -s,@prefix@,/mylibs/iup,;t t +s,@prefix@,C:/mylibs/iup,;t t s,@program_transform_name@,s,x,x,,;t t s,@bindir@,${exec_prefix}/bin,;t t s,@sbindir@,${exec_prefix}/sbin,;t t s,@libexecdir@,${exec_prefix}/libexec,;t t s,@datadir@,${prefix}/share,;t t Index: ffcall/callback/trampoline_r/Makefile ================================================================== --- ffcall/callback/trampoline_r/Makefile +++ ffcall/callback/trampoline_r/Makefile @@ -8,11 +8,11 @@ # Directories used by "make": srcdir = . # Directories used by "make install": -prefix = /mylibs/iup +prefix = C:/mylibs/iup local_prefix = /usr/local exec_prefix = ${prefix} libdir = ${exec_prefix}/lib includedir = ${prefix}/include mandir = ${prefix}/man Index: ffcall/callback/trampoline_r/config.log ================================================================== --- ffcall/callback/trampoline_r/config.log +++ ffcall/callback/trampoline_r/config.log @@ -2,11 +2,11 @@ running configure, to aid debugging if configure makes a mistake. It was created by configure, which was generated by GNU Autoconf 2.59. Invocation command line was - $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=. --cache-file=/dev/null --srcdir=. + $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=. --cache-file=/dev/null --srcdir=. ## --------- ## ## Platform. ## ## --------- ## @@ -36,10 +36,11 @@ PATH: /c/windows PATH: /c/windows/SYSTEM32/WBEM PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/ PATH: /mingw/bin PATH: /c/chicken/bin +PATH: /c/mylibs/iup PATH: /c/Program Files/Windows Live/Shared ## ----------- ## ## Core tests. ## @@ -508,13 +509,13 @@ configure:8361: $? = 0 configure:8378: result: extern int getpagesize (void); configure:8540: checking for vm_allocate configure:8562: gcc -o conftest.exe -g -O2 conftest.c >&5 -C:\Users\matt\AppData\Local\Temp\ccPqD3og.o: In function `main': -c:\mylibs\src\ffcall-1.10\callback\trampoline_r/conftest.c:32: undefined reference to `vm_allocate' -c:\mylibs\src\ffcall-1.10\callback\trampoline_r/conftest.c:32: undefined reference to `task_self' +C:\Users\matt\AppData\Local\Temp\ccdI2c3e.o: In function `main': +c:\Users\matt\data\chicken-iup\ffcall\callback\trampoline_r/conftest.c:32: undefined reference to `vm_allocate' +c:\Users\matt\data\chicken-iup\ffcall\callback\trampoline_r/conftest.c:32: undefined reference to `task_self' collect2: ld returned 1 exit status configure:8568: $? = 1 configure: failed program was: | /* confdefs.h. */ | @@ -1050,11 +1051,11 @@ libdir='${exec_prefix}/lib' libexecdir='${exec_prefix}/libexec' localstatedir='${prefix}/var' mandir='${prefix}/man' oldincludedir='/usr/include' -prefix='/mylibs/iup' +prefix='C:/mylibs/iup' program_transform_name='s,x,x,' sbindir='${exec_prefix}/sbin' sharedstatedir='${prefix}/com' sysconfdir='${prefix}/etc' target_alias='' Index: ffcall/callback/trampoline_r/config.status ================================================================== --- ffcall/callback/trampoline_r/config.status +++ ffcall/callback/trampoline_r/config.status @@ -298,11 +298,11 @@ Report bugs to ." ac_cs_version="\ config.status configured by ./configure, generated by GNU Autoconf 2.59, - with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" + with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=. @@ -376,12 +376,12 @@ exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi if $ac_cs_recheck; then - echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 - exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion + echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 + exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion fi for ac_config_target in $ac_config_targets do case "$ac_config_target" in @@ -445,11 +445,11 @@ s,@PACKAGE_TARNAME@,,;t t s,@PACKAGE_VERSION@,,;t t s,@PACKAGE_STRING@,,;t t s,@PACKAGE_BUGREPORT@,,;t t s,@exec_prefix@,${prefix},;t t -s,@prefix@,/mylibs/iup,;t t +s,@prefix@,C:/mylibs/iup,;t t s,@program_transform_name@,s,x,x,,;t t s,@bindir@,${exec_prefix}/bin,;t t s,@sbindir@,${exec_prefix}/sbin,;t t s,@libexecdir@,${exec_prefix}/libexec,;t t s,@datadir@,${prefix}/share,;t t Index: ffcall/callback/vacall_r/Makefile ================================================================== --- ffcall/callback/vacall_r/Makefile +++ ffcall/callback/vacall_r/Makefile @@ -8,11 +8,11 @@ # Directories used by "make": srcdir = . # Directories used by "make install": -prefix = /mylibs/iup +prefix = C:/mylibs/iup local_prefix = /usr/local exec_prefix = ${prefix} libdir = ${exec_prefix}/lib includedir = ${prefix}/include mandir = ${prefix}/man Index: ffcall/callback/vacall_r/config.log ================================================================== --- ffcall/callback/vacall_r/config.log +++ ffcall/callback/vacall_r/config.log @@ -2,11 +2,11 @@ running configure, to aid debugging if configure makes a mistake. It was created by configure, which was generated by GNU Autoconf 2.59. Invocation command line was - $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=. --cache-file=/dev/null --srcdir=. + $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=. --cache-file=/dev/null --srcdir=. ## --------- ## ## Platform. ## ## --------- ## @@ -36,10 +36,11 @@ PATH: /c/windows PATH: /c/windows/SYSTEM32/WBEM PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/ PATH: /mingw/bin PATH: /c/chicken/bin +PATH: /c/mylibs/iup PATH: /c/Program Files/Windows Live/Shared ## ----------- ## ## Core tests. ## @@ -523,12 +524,12 @@ conftest.c:28:34: warning: function called through a non-compatible type conftest.c:28:34: note: if this code is reached, the program will abort conftest.c:29:3: warning: incompatible implicit declaration of built-in function 'exit' configure:8039: $? = 0 configure:8041: ./conftest.exe -configure:8044: $? = 29 -configure: program exited with status 29 +configure:8044: $? = 255 +configure: program exited with status 255 configure: failed program was: | /* confdefs.h. */ | | #define PACKAGE_NAME "" | #define PACKAGE_TARNAME "" @@ -740,11 +741,11 @@ libdir='${exec_prefix}/lib' libexecdir='${exec_prefix}/libexec' localstatedir='${prefix}/var' mandir='${prefix}/man' oldincludedir='/usr/include' -prefix='/mylibs/iup' +prefix='C:/mylibs/iup' program_transform_name='s,x,x,' sbindir='${exec_prefix}/sbin' sharedstatedir='${prefix}/com' sysconfdir='${prefix}/etc' target_alias='' Index: ffcall/callback/vacall_r/config.status ================================================================== --- ffcall/callback/vacall_r/config.status +++ ffcall/callback/vacall_r/config.status @@ -298,11 +298,11 @@ Report bugs to ." ac_cs_version="\ config.status configured by ./configure, generated by GNU Autoconf 2.59, - with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" + with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=. @@ -376,12 +376,12 @@ exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi if $ac_cs_recheck; then - echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 - exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion + echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 + exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion fi for ac_config_target in $ac_config_targets do case "$ac_config_target" in @@ -446,11 +446,11 @@ s,@PACKAGE_TARNAME@,,;t t s,@PACKAGE_VERSION@,,;t t s,@PACKAGE_STRING@,,;t t s,@PACKAGE_BUGREPORT@,,;t t s,@exec_prefix@,${prefix},;t t -s,@prefix@,/mylibs/iup,;t t +s,@prefix@,C:/mylibs/iup,;t t s,@program_transform_name@,s,x,x,,;t t s,@bindir@,${exec_prefix}/bin,;t t s,@sbindir@,${exec_prefix}/sbin,;t t s,@libexecdir@,${exec_prefix}/libexec,;t t s,@datadir@,${prefix}/share,;t t Index: ffcall/config.log ================================================================== --- ffcall/config.log +++ ffcall/config.log @@ -2,11 +2,11 @@ running configure, to aid debugging if configure makes a mistake. It was created by configure, which was generated by GNU Autoconf 2.59. Invocation command line was - $ ./configure --prefix=/mylibs/iup + $ ./configure --prefix=C:/mylibs/iup ## --------- ## ## Platform. ## ## --------- ## @@ -36,10 +36,11 @@ PATH: /c/windows PATH: /c/windows/SYSTEM32/WBEM PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/ PATH: /mingw/bin PATH: /c/chicken/bin +PATH: /c/mylibs/iup PATH: /c/Program Files/Windows Live/Shared ## ----------- ## ## Core tests. ## @@ -64,17 +65,17 @@ on hermes config.status:626: creating Makefile configure:2219: configuring in avcall -configure:2336: running /bin/sh './configure' --prefix=/mylibs/iup '--prefix=/mylibs/iup' --cache-file=/dev/null --srcdir=. +configure:2336: running /bin/sh './configure' --prefix=C:/mylibs/iup '--prefix=C:/mylibs/iup' --cache-file=/dev/null --srcdir=. configure:2219: configuring in vacall -configure:2336: running /bin/sh './configure' --prefix=/mylibs/iup '--prefix=/mylibs/iup' --cache-file=/dev/null --srcdir=. +configure:2336: running /bin/sh './configure' --prefix=C:/mylibs/iup '--prefix=C:/mylibs/iup' --cache-file=/dev/null --srcdir=. configure:2219: configuring in trampoline -configure:2336: running /bin/sh './configure' --prefix=/mylibs/iup '--prefix=/mylibs/iup' --cache-file=/dev/null --srcdir=. +configure:2336: running /bin/sh './configure' --prefix=C:/mylibs/iup '--prefix=C:/mylibs/iup' --cache-file=/dev/null --srcdir=. configure:2219: configuring in callback -configure:2336: running /bin/sh './configure' --prefix=/mylibs/iup '--prefix=/mylibs/iup' --cache-file=/dev/null --srcdir=. +configure:2336: running /bin/sh './configure' --prefix=C:/mylibs/iup '--prefix=C:/mylibs/iup' --cache-file=/dev/null --srcdir=. ## ---------------- ## ## Cache variables. ## ## ---------------- ## @@ -115,11 +116,11 @@ libdir='${exec_prefix}/lib' libexecdir='${exec_prefix}/libexec' localstatedir='${prefix}/var' mandir='${prefix}/man' oldincludedir='/usr/include' -prefix='/mylibs/iup' +prefix='C:/mylibs/iup' program_transform_name='s,x,x,' sbindir='${exec_prefix}/sbin' sharedstatedir='${prefix}/com' subdirs=' avcall vacall trampoline callback' sysconfdir='${prefix}/etc' Index: ffcall/config.status ================================================================== --- ffcall/config.status +++ ffcall/config.status @@ -292,11 +292,11 @@ Report bugs to ." ac_cs_version="\ config.status configured by ./configure, generated by GNU Autoconf 2.59, - with options \"'--prefix=/mylibs/iup'\" + with options \"'--prefix=C:/mylibs/iup'\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=. @@ -370,12 +370,12 @@ exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi if $ac_cs_recheck; then - echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' $ac_configure_extra_args " --no-create --no-recursion" >&6 - exec /bin/sh ./configure '--prefix=/mylibs/iup' $ac_configure_extra_args --no-create --no-recursion + echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' $ac_configure_extra_args " --no-create --no-recursion" >&6 + exec /bin/sh ./configure '--prefix=C:/mylibs/iup' $ac_configure_extra_args --no-create --no-recursion fi for ac_config_target in $ac_config_targets do case "$ac_config_target" in @@ -437,11 +437,11 @@ s,@PACKAGE_TARNAME@,,;t t s,@PACKAGE_VERSION@,,;t t s,@PACKAGE_STRING@,,;t t s,@PACKAGE_BUGREPORT@,,;t t s,@exec_prefix@,${prefix},;t t -s,@prefix@,/mylibs/iup,;t t +s,@prefix@,C:/mylibs/iup,;t t s,@program_transform_name@,s,x,x,,;t t s,@bindir@,${exec_prefix}/bin,;t t s,@sbindir@,${exec_prefix}/sbin,;t t s,@libexecdir@,${exec_prefix}/libexec,;t t s,@datadir@,${prefix}/share,;t t Index: ffcall/trampoline/Makefile ================================================================== --- ffcall/trampoline/Makefile +++ ffcall/trampoline/Makefile @@ -8,11 +8,11 @@ # Directories used by "make": srcdir = . # Directories used by "make install": -prefix = /mylibs/iup +prefix = C:/mylibs/iup local_prefix = /usr/local exec_prefix = ${prefix} libdir = ${exec_prefix}/lib includedir = ${prefix}/include mandir = ${prefix}/man Index: ffcall/trampoline/config.log ================================================================== --- ffcall/trampoline/config.log +++ ffcall/trampoline/config.log @@ -2,11 +2,11 @@ running configure, to aid debugging if configure makes a mistake. It was created by configure, which was generated by GNU Autoconf 2.59. Invocation command line was - $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=. + $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=. ## --------- ## ## Platform. ## ## --------- ## @@ -36,10 +36,11 @@ PATH: /c/windows PATH: /c/windows/SYSTEM32/WBEM PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/ PATH: /mingw/bin PATH: /c/chicken/bin +PATH: /c/mylibs/iup PATH: /c/Program Files/Windows Live/Shared ## ----------- ## ## Core tests. ## @@ -320,13 +321,13 @@ configure:3514: $? = 0 configure:3531: result: extern int getpagesize (void); configure:3693: checking for vm_allocate configure:3715: gcc -o conftest.exe -g -O2 conftest.c >&5 -C:\Users\matt\AppData\Local\Temp\ccCeAdyV.o: In function `main': -c:\mylibs\src\ffcall-1.10\trampoline/conftest.c:29: undefined reference to `vm_allocate' -c:\mylibs\src\ffcall-1.10\trampoline/conftest.c:29: undefined reference to `task_self' +C:\Users\matt\AppData\Local\Temp\cck3AH5m.o: In function `main': +c:\Users\matt\data\chicken-iup\ffcall\trampoline/conftest.c:29: undefined reference to `vm_allocate' +c:\Users\matt\data\chicken-iup\ffcall\trampoline/conftest.c:29: undefined reference to `task_self' collect2: ld returned 1 exit status configure:3721: $? = 1 configure: failed program was: | /* confdefs.h. */ | @@ -820,11 +821,11 @@ libdir='${exec_prefix}/lib' libexecdir='${exec_prefix}/libexec' localstatedir='${prefix}/var' mandir='${prefix}/man' oldincludedir='/usr/include' -prefix='/mylibs/iup' +prefix='C:/mylibs/iup' program_transform_name='s,x,x,' sbindir='${exec_prefix}/sbin' sharedstatedir='${prefix}/com' sysconfdir='${prefix}/etc' target_alias='' Index: ffcall/trampoline/config.status ================================================================== --- ffcall/trampoline/config.status +++ ffcall/trampoline/config.status @@ -298,11 +298,11 @@ Report bugs to ." ac_cs_version="\ config.status configured by ./configure, generated by GNU Autoconf 2.59, - with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" + with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=. @@ -376,12 +376,12 @@ exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi if $ac_cs_recheck; then - echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 - exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion + echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 + exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion fi for ac_config_target in $ac_config_targets do case "$ac_config_target" in @@ -445,11 +445,11 @@ s,@PACKAGE_TARNAME@,,;t t s,@PACKAGE_VERSION@,,;t t s,@PACKAGE_STRING@,,;t t s,@PACKAGE_BUGREPORT@,,;t t s,@exec_prefix@,${prefix},;t t -s,@prefix@,/mylibs/iup,;t t +s,@prefix@,C:/mylibs/iup,;t t s,@program_transform_name@,s,x,x,,;t t s,@bindir@,${exec_prefix}/bin,;t t s,@sbindir@,${exec_prefix}/sbin,;t t s,@libexecdir@,${exec_prefix}/libexec,;t t s,@datadir@,${prefix}/share,;t t Index: ffcall/vacall/Makefile ================================================================== --- ffcall/vacall/Makefile +++ ffcall/vacall/Makefile @@ -8,11 +8,11 @@ # Directories used by "make": srcdir = . # Directories used by "make install": -prefix = /mylibs/iup +prefix = C:/mylibs/iup local_prefix = /usr/local exec_prefix = ${prefix} libdir = ${exec_prefix}/lib includedir = ${prefix}/include mandir = ${prefix}/man Index: ffcall/vacall/config.log ================================================================== --- ffcall/vacall/config.log +++ ffcall/vacall/config.log @@ -2,11 +2,11 @@ running configure, to aid debugging if configure makes a mistake. It was created by configure, which was generated by GNU Autoconf 2.59. Invocation command line was - $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=. + $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=. ## --------- ## ## Platform. ## ## --------- ## @@ -36,10 +36,11 @@ PATH: /c/windows PATH: /c/windows/SYSTEM32/WBEM PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/ PATH: /mingw/bin PATH: /c/chicken/bin +PATH: /c/mylibs/iup PATH: /c/Program Files/Windows Live/Shared ## ----------- ## ## Core tests. ## @@ -504,11 +505,11 @@ libdir='${exec_prefix}/lib' libexecdir='${exec_prefix}/libexec' localstatedir='${prefix}/var' mandir='${prefix}/man' oldincludedir='/usr/include' -prefix='/mylibs/iup' +prefix='C:/mylibs/iup' program_transform_name='s,x,x,' sbindir='${exec_prefix}/sbin' sharedstatedir='${prefix}/com' sysconfdir='${prefix}/etc' target_alias='' Index: ffcall/vacall/config.status ================================================================== --- ffcall/vacall/config.status +++ ffcall/vacall/config.status @@ -298,11 +298,11 @@ Report bugs to ." ac_cs_version="\ config.status configured by ./configure, generated by GNU Autoconf 2.59, - with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" + with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=. @@ -376,12 +376,12 @@ exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi if $ac_cs_recheck; then - echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 - exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion + echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6 + exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion fi for ac_config_target in $ac_config_targets do case "$ac_config_target" in @@ -446,11 +446,11 @@ s,@PACKAGE_TARNAME@,,;t t s,@PACKAGE_VERSION@,,;t t s,@PACKAGE_STRING@,,;t t s,@PACKAGE_BUGREPORT@,,;t t s,@exec_prefix@,${prefix},;t t -s,@prefix@,/mylibs/iup,;t t +s,@prefix@,C:/mylibs/iup,;t t s,@program_transform_name@,s,x,x,,;t t s,@bindir@,${exec_prefix}/bin,;t t s,@sbindir@,${exec_prefix}/sbin,;t t s,@libexecdir@,${exec_prefix}/libexec,;t t s,@datadir@,${prefix}/share,;t t