diff --git a/collects/graphics/scribblings/graphics.scrbl b/collects/graphics/scribblings/graphics.scrbl index 450be32bd8..62dfeafc28 100644 --- a/collects/graphics/scribblings/graphics.scrbl +++ b/collects/graphics/scribblings/graphics.scrbl @@ -11,7 +11,7 @@ The viewport graphics library is a relatively simple toolbox of graphics commands. The library is not very powerful; it is intended as -a simplified alternative to @schememodname[scheme/gui]'s full +a simplified alternative to @racketmodname[racket/gui]'s full graphical toolbox. The graphics library originated as SIXlib, a library of X Windows @@ -32,9 +32,13 @@ Initializes the library's graphics routines. It must be called before @defproc[(close-graphics) void?]{ -Closes all of the windows. Until @scheme[open-graphics] is called +Closes all of the windows. Until @racket[open-graphics] is called again, no graphics routines will work.} +@defproc[(graphics-open?) boolean?]{ + Determines if the graphics have been opened (or not). +} + @defproc*[([(open-viewport [name string?] [horiz exact-nonnegative-integer?] [vert exact-nonnegative-integer?]) @@ -43,10 +47,10 @@ again, no graphics routines will work.} [dimensions posn?]) viewport?])]{ -Creates a new window called @scheme[name]. The window is -@scheme[horiz] pixels wide and @scheme[vert] pixels high. For -backward compatibility, a single @scheme[posn] value can be submitted -in the place of @scheme[horiz] and @scheme[vert]. The result is a +Creates a new window called @racket[name]. The window is +@racket[horiz] pixels wide and @racket[vert] pixels high. For +backward compatibility, a single @racket[posn] value can be submitted +in the place of @racket[horiz] and @racket[vert]. The result is a viewport descriptor.} @@ -58,10 +62,10 @@ viewport descriptor.} [dimensions posn?]) viewport?])]{ -Like @scheme[open-viewport], but the resulting viewport is not +Like @racket[open-viewport], but the resulting viewport is not displayed on the screen. Offscreen pixmaps are useful for executing a sequence of drawing commands and displaying them all at once with -@scheme[copy-viewport]. +@racket[copy-viewport]. Offscreen pixmaps are also useful in conjunction with viewport->snip (see below). This allows functions to compute with graphical objects @@ -77,8 +81,8 @@ dealing with the viewport illegal.} @defproc[(viewport? [v any/c]) boolean?]{ -Returns @scheme[#t] if @scheme[v] is a viewport (i.e., a destination -for drawing), @scheme[#f] otherwise.} +Returns @racket[#t] if @racket[v] is a viewport (i.e., a destination +for drawing), @racket[#f] otherwise.} @; ---------------------------------------------------------------------- @@ -96,15 +100,15 @@ Represents a positions.} @defproc[((get-pixel [viewport viewport?]) [p posn?]) (one-of/c 0 1)]{ -Returns the color of the pixel at position @scheme[p] in -@scheme[viewport]; @scheme[0] denotes white and @scheme[1] denotes not +Returns the color of the pixel at position @racket[p] in +@racket[viewport]; @racket[0] denotes white and @racket[1] denotes not white.} @defproc[((get-color-pixel [viewport viewport?]) [p posn?]) rgb?]{ -Returns an @scheme[rgb] value for color of the pixel at position -@scheme[p] in @scheme[viewport].} +Returns an @racket[rgb] value for color of the pixel at position +@racket[p] in @racket[viewport].} @defproc[((test-pixel [viewport viewport?]) [color (or/c (integer-in 0 299) @@ -112,7 +116,7 @@ Returns an @scheme[rgb] value for color of the pixel at position rgb?)]) rgb?]{ -Returns the color that will actually be used if @scheme[color] is used +Returns the color that will actually be used if @racket[color] is used to draw.} @; ---------------------------------------------------------------------- @@ -120,31 +124,31 @@ to draw.} @section{Color Operations} A color can be represented in three ways: as a color index (an integer -in 0 to 299, inclusive), as a color name string, or as a @scheme[rgb] +in 0 to 299, inclusive), as a color name string, or as a @racket[rgb] value. All drawing functions which take a color argument accept colors -in any form. An @scheme[rgb] value is assigned to an index with -@scheme[change-color]. +in any form. An @racket[rgb] value is assigned to an index with +@racket[change-color]. @defstruct[rgb ([red (real-in 0 1)][green (real-in 0 1)][blue (real-in 0 1)])]{ Takes three values in the range 0 (dark) to 1 (bright) and returns an -@scheme[rgb] (a color).} +@racket[rgb] (a color).} @defproc[(change-color [index (integer-in 0 299)] [rgb rgb?]) void?]{ -Changes the color at @scheme[index] in the color table to the -color specified in @scheme[rgb]. Only the first twenty-one indices +Changes the color at @racket[index] in the color table to the +color specified in @racket[rgb]. Only the first twenty-one indices are initialized; a color index should not be used until it has been initialized.} @defproc[(default-display-is-color?) boolean?]{ -Returns @scheme[#t] if the default display screen for viewports is in -color or @scheme[#f] otherwise.} +Returns @racket[#t] if the default display screen for viewports is in +color or @racket[#f] otherwise.} @; ---------------------------------------------------------------------- @@ -153,14 +157,14 @@ color or @scheme[#f] otherwise.} The following are the basic graphics operations for drawing to a viewport. Each function takes a viewport as its argument and returns a function operating within that viewport. Further arguments, if any, -are curried. For example, @scheme[(draw-line _viewport)] returns a +are curried. For example, @racket[(draw-line _viewport)] returns a function, that can then be applied to the proper arguments to draw a line in the viewport corresponding to viewport descriptor -@scheme[_viewport]. +@racket[_viewport]. -In general, @schemeidfont{draw-} functions make pixels black or -colored, @schemeidfont{clear-} functions make them white, and -@schemeidfont{flip-} commands @deftech{invert} pixels (which makes +In general, @racketidfont{draw-} functions make pixels black or +colored, @racketidfont{clear-} functions make them white, and +@racketidfont{flip-} commands @deftech{invert} pixels (which makes black white, white black, and is otherwise ill-defined). @subsection{Viewports} @@ -172,23 +176,23 @@ black white, white black, and is otherwise ill-defined). "black"]) void?]{ -Colors the entire contents of @scheme[viewport] with @scheme[color].} +Colors the entire contents of @racket[viewport] with @racket[color].} @defproc[((clear-viewport [viewport viewport?])) void?]{ -Whitens the entire contents of @scheme[viewport].} +Whitens the entire contents of @racket[viewport].} @defproc[((flip-viewport [viewport viewport?])) void?]{ -@tech{Inverts} the entire contents of @scheme[viewport].} +@tech{Inverts} the entire contents of @racket[viewport].} @defproc[(copy-viewport [source viewport?] [dest viewport?]) void?]{ -Copies the content of @scheme[source] into @scheme[dest].} +Copies the content of @racket[source] into @racket[dest].} @; ---------------------------------------- @@ -202,19 +206,19 @@ Copies the content of @scheme[source] into @scheme[dest].} "black"]) void?]{ -Colors the pixel in @scheme[viewport] at @scheme[p].} +Colors the pixel in @racket[viewport] at @racket[p].} @defproc[((clear-pixel [viewport viewport?]) [p posn?]) void?]{ -Whitens the pixel in @scheme[viewport] at @scheme[p].} +Whitens the pixel in @racket[viewport] at @racket[p].} @defproc[((flip-pixel [viewport viewport?]) [p posn?]) void?]{ -@tech{Inverts} the pixel in @scheme[viewport] at @scheme[p].} +@tech{Inverts} the pixel in @racket[viewport] at @racket[p].} @; ---------------------------------------- @@ -229,8 +233,8 @@ Whitens the pixel in @scheme[viewport] at @scheme[p].} "black"]) void?]{ -Draws a line in @scheme[viewport] connecting positions @scheme[p1] and -@scheme[p2].} +Draws a line in @racket[viewport] connecting positions @racket[p1] and +@racket[p2].} @defproc[((clear-line [viewport viewport?]) @@ -238,8 +242,8 @@ Draws a line in @scheme[viewport] connecting positions @scheme[p1] and [p2 posn?]) void?]{ -Whitens a line in @scheme[viewport] connecting positions @scheme[p1] -and @scheme[p2].} +Whitens a line in @racket[viewport] connecting positions @racket[p1] +and @racket[p2].} @defproc[((flip-line [viewport viewport?]) @@ -247,8 +251,8 @@ and @scheme[p2].} [p2 posn?]) void?]{ -@tech{Inverts} a line in @scheme[viewport] connecting positions -@scheme[p1] and @scheme[p2].} +@tech{Inverts} a line in @racket[viewport] connecting positions +@racket[p1] and @racket[p2].} @; ---------------------------------------- @@ -264,9 +268,9 @@ and @scheme[p2].} "black"]) void?]{ -Draws a rectangle border in the @scheme[viewport] with the top-left of -the rectangle at the position @scheme[p] and with sides @scheme[width] -across and @scheme[height] tall.} +Draws a rectangle border in the @racket[viewport] with the top-left of +the rectangle at the position @racket[p] and with sides @racket[width] +across and @racket[height] tall.} @defproc[((clear-rectangle [viewport viewport?]) @@ -275,8 +279,8 @@ across and @scheme[height] tall.} [height (and/c real? (not/c negative?))]) void?]{ -Whitens a rectangle border in the @scheme[viewport], analogous to -@scheme[draw-rectangle].} +Whitens a rectangle border in the @racket[viewport], analogous to +@racket[draw-rectangle].} @defproc[((flip-rectangle [viewport viewport?]) @@ -285,8 +289,8 @@ Whitens a rectangle border in the @scheme[viewport], analogous to [height (and/c real? (not/c negative?))]) void?]{ -@tech{Inverts} a rectangle border in the @scheme[viewport], analogous -to @scheme[draw-rectangle].} +@tech{Inverts} a rectangle border in the @racket[viewport], analogous +to @racket[draw-rectangle].} @defproc[((draw-solid-rectangle [viewport viewport?]) @@ -299,9 +303,9 @@ to @scheme[draw-rectangle].} "black"]) void?]{ -Draws a solid rectangle in the @scheme[viewport] with the top-left of -the rectangle at the position @scheme[p] and with sides @scheme[width] -across and @scheme[height] tall.} +Draws a solid rectangle in the @racket[viewport] with the top-left of +the rectangle at the position @racket[p] and with sides @racket[width] +across and @racket[height] tall.} @defproc[((clear-solid-rectangle [viewport viewport?]) @@ -310,8 +314,8 @@ across and @scheme[height] tall.} [height (and/c real? (not/c negative?))]) void?]{ -Whitens a rectangle border in the @scheme[viewport], analogous to -@scheme[draw-solid-rectangle].} +Whitens a rectangle border in the @racket[viewport], analogous to +@racket[draw-solid-rectangle].} @defproc[((flip-solid-rectangle [viewport viewport?]) @@ -320,8 +324,8 @@ Whitens a rectangle border in the @scheme[viewport], analogous to [height (and/c real? (not/c negative?))]) void?]{ -@tech{Inverts} a rectangle border in the @scheme[viewport], analogous -to @scheme[draw-solid-rectangle].} +@tech{Inverts} a rectangle border in the @racket[viewport], analogous +to @racket[draw-solid-rectangle].} @; ---------------------------------------- @@ -337,9 +341,9 @@ to @scheme[draw-solid-rectangle].} "black"]) void?]{ -Draws a ellipse border in the @scheme[viewport]. The ellipse is -inscribed with a rectangle whose top-left is at position @scheme[p] -and with sides @scheme[width] across and @scheme[height] tall.} +Draws a ellipse border in the @racket[viewport]. The ellipse is +inscribed with a rectangle whose top-left is at position @racket[p] +and with sides @racket[width] across and @racket[height] tall.} @defproc[((clear-ellipse [viewport viewport?]) @@ -348,8 +352,8 @@ and with sides @scheme[width] across and @scheme[height] tall.} [height (and/c real? (not/c negative?))]) void?]{ -Whitens a ellipse border in the @scheme[viewport], analogous to -@scheme[draw-ellipse].} +Whitens a ellipse border in the @racket[viewport], analogous to +@racket[draw-ellipse].} @defproc[((flip-ellipse [viewport viewport?]) @@ -358,8 +362,8 @@ Whitens a ellipse border in the @scheme[viewport], analogous to [height (and/c real? (not/c negative?))]) void?]{ -@tech{Inverts} a ellipse border in the @scheme[viewport], analogous -to @scheme[draw-ellipse].} +@tech{Inverts} a ellipse border in the @racket[viewport], analogous +to @racket[draw-ellipse].} @defproc[((draw-solid-ellipse [viewport viewport?]) @@ -372,9 +376,9 @@ to @scheme[draw-ellipse].} "black"]) void?]{ -Draws a solid ellipse in the @scheme[viewport]. The ellipse is -inscribed with a rectangle whose top-left is at position @scheme[p] -and with sides @scheme[width] across and @scheme[height] tall.} +Draws a solid ellipse in the @racket[viewport]. The ellipse is +inscribed with a rectangle whose top-left is at position @racket[p] +and with sides @racket[width] across and @racket[height] tall.} @defproc[((clear-solid-ellipse [viewport viewport?]) @@ -383,8 +387,8 @@ and with sides @scheme[width] across and @scheme[height] tall.} [height (and/c real? (not/c negative?))]) void?]{ -Whitens a ellipse border in the @scheme[viewport], analogous to -@scheme[draw-solid-ellipse].} +Whitens a ellipse border in the @racket[viewport], analogous to +@racket[draw-solid-ellipse].} @defproc[((flip-solid-ellipse [viewport viewport?]) @@ -393,8 +397,8 @@ Whitens a ellipse border in the @scheme[viewport], analogous to [height (and/c real? (not/c negative?))]) void?]{ -@tech{Inverts} a ellipse border in the @scheme[viewport], analogous -to @scheme[draw-solid-ellipse].} +@tech{Inverts} a ellipse border in the @racket[viewport], analogous +to @racket[draw-solid-ellipse].} @; ---------------------------------------- @@ -409,8 +413,8 @@ to @scheme[draw-solid-ellipse].} "black"]) void?]{ -Draws a polygon border in @scheme[viewport] using @scheme[points] for -the polygon vertices and @scheme[offset] as an offset added to all +Draws a polygon border in @racket[viewport] using @racket[points] for +the polygon vertices and @racket[offset] as an offset added to all points.} @@ -419,8 +423,8 @@ points.} [offset posn?]) void?]{ -Whitens a polygon border in @scheme[viewport], analogous to -@scheme[draw-polygon].} +Whitens a polygon border in @racket[viewport], analogous to +@racket[draw-polygon].} @defproc[((flip-polygon [viewport viewport?]) @@ -428,8 +432,8 @@ Whitens a polygon border in @scheme[viewport], analogous to [offset posn?]) void?]{ -@tech{Inverts} a polygon border in @scheme[viewport], analogous to -@scheme[draw-polygon].} +@tech{Inverts} a polygon border in @racket[viewport], analogous to +@racket[draw-polygon].} @defproc[((draw-solid-polygon [viewport viewport?]) @@ -441,8 +445,8 @@ Whitens a polygon border in @scheme[viewport], analogous to "black"]) void?]{ -Draws a solid polygon in @scheme[viewport] using @scheme[points] for -the polygon vertices and @scheme[offset] as an offset added to all +Draws a solid polygon in @racket[viewport] using @racket[points] for +the polygon vertices and @racket[offset] as an offset added to all points.} @@ -451,8 +455,8 @@ points.} [offset posn?]) void?]{ -Whitens a polygon border in @scheme[viewport], analogous to -@scheme[draw-solid-polygon].} +Whitens a polygon border in @racket[viewport], analogous to +@racket[draw-solid-polygon].} @defproc[((flip-solid-polygon [viewport viewport?]) @@ -460,8 +464,8 @@ Whitens a polygon border in @scheme[viewport], analogous to [offset posn?]) void?]{ -@tech{Inverts} a polygon border in @scheme[viewport], analogous to -@scheme[draw-solid-polygon].} +@tech{Inverts} a polygon border in @racket[viewport], analogous to +@racket[draw-solid-polygon].} @; ---------------------------------------- @@ -476,8 +480,8 @@ Whitens a polygon border in @scheme[viewport], analogous to "black"]) void?]{ -Draws a string at a specified location in the @scheme[viewport]. -The lower left of the string begins at @scheme[p].} +Draws a string at a specified location in the @racket[viewport]. +The lower left of the string begins at @racket[p].} @defproc[((clear-string [viewport viewport?]) @@ -485,8 +489,8 @@ The lower left of the string begins at @scheme[p].} [str string?]) void?]{ -Whitens a string at a specified location in the @scheme[viewport]. -The lower left of the string begins at @scheme[p].} +Whitens a string at a specified location in the @racket[viewport]. +The lower left of the string begins at @racket[p].} @defproc[((flip-string [viewport viewport?]) [p posn?] @@ -494,8 +498,8 @@ The lower left of the string begins at @scheme[p].} void?]{ @tech{Inverts} a string at a specified location in the -@scheme[viewport]. The lower left of the string begins at -@scheme[p].} +@racket[viewport]. The lower left of the string begins at +@racket[p].} @; ---------------------------------------- @@ -514,17 +518,17 @@ The lower left of the string begins at @scheme[p].} "black"]) void?]{ -Draws a pixmap into @scheme[viewport] with its upper left corner at -position @scheme[p]. If @scheme[type] is @scheme['unknown] or -@scheme['unknown/mask], then the content of the file is examined to +Draws a pixmap into @racket[viewport] with its upper left corner at +position @racket[p]. If @racket[type] is @racket['unknown] or +@racket['unknown/mask], then the content of the file is examined to determine the type. All formats are supported on all platforms, -except @scheme['pict] which is only supported under Mac OS X. The -@scheme['gif/mask], @scheme['png/mask], and @scheme['unknown/mask] +except @racket['pict] which is only supported under Mac OS X. The +@racket['gif/mask], @racket['png/mask], and @racket['unknown/mask] types draw the bitmap with a transparent background if -@scheme[filename] refers to a GIF/PNG file with a transparent +@racket[filename] refers to a GIF/PNG file with a transparent background. -The argument @scheme[color] is only used when the loaded pixmap is +The argument @racket[color] is only used when the loaded pixmap is monochrome. In that case, the color is used instead of black in the drawn image.} @@ -537,15 +541,15 @@ drawn image.} "black"]) void?]{ -Equivalent to @scheme[(((draw-pixmap-posn file) viewport) p color)].} +Equivalent to @racket[(((draw-pixmap-posn file) viewport) p color)].} @defproc[((save-pixmap [viewport viewport?]) [file path-string?] [type (one-of/c 'gif 'jpeg 'png 'xbm 'xpm 'bmp) 'xpm]) void?]{ -Saves the current content of @scheme[viewport] to @scheme[file]. -The @scheme[type] argument determines the kind of file that is written.} +Saves the current content of @racket[viewport] to @racket[file]. +The @racket[type] argument determines the kind of file that is written.} @; ---------------------------------------- @@ -557,26 +561,26 @@ with tick events (the clock ticks) and keyboard inputs (keyevents). @defproc[((init-world [viewport viewport?]) [v any/c]) void?]{ -Sets the initial value of @scheme[viewport]'s world to @scheme[v].} +Sets the initial value of @racket[viewport]'s world to @racket[v].} @defproc[((set-on-tick-event [viewport viewport?]) [secs real?] [update-callback (any/c . -> . any/c)]) void?]{ -For @scheme[viewport], sets @scheme[update-callback] to be invoked to -transform the world value every @scheme[secs] seconds. Only one +For @racket[viewport], sets @racket[update-callback] to be invoked to +transform the world value every @racket[secs] seconds. Only one callback is installed at a time.} @defproc[((stop-tick [viewport viewport?])) void?]{ -Stops updating @scheme[viewport]'s world via a callback installed with -@scheme[set-on-tick-event].} +Stops updating @racket[viewport]'s world via a callback installed with +@racket[set-on-tick-event].} @defproc[((set-on-key-event [viewport viewport?]) [key-callback (any/c any/c . -> . any/c)]) void?]{ -Sets @scheme[key-callback] as the function to call whenever a key -event is received for @scheme[viewport]. The @scheme[key-callback] is +Sets @racket[key-callback] as the function to call whenever a key +event is received for @racket[viewport]. The @racket[key-callback] is given a key event and the current world, and it produces an updated world.} @@ -586,7 +590,7 @@ world.} @defproc[((get-string-size [viewport viewport?]) [str string?]) (list/c real? real?)]{ -Returns the size of @scheme[str] as drawn into @scheme[viewport] as a +Returns the size of @racket[str] as drawn into @racket[viewport] as a list of two numbers: width and height.} @defproc[(viewport->snip [viewport viewport?]) (is-a?/c snip%)] @@ -600,21 +604,21 @@ DrRacket shows the snip in the interactions window.} @defproc[(viewport-dc [viewport viewport?]) (is-a?/c dc<%>)]{ -Returns an object for direct drawing into @scheme[viewport]'s +Returns an object for direct drawing into @racket[viewport]'s on-screen representation (if any). Mirror all such drawing to the -result of @scheme[(viewport-buffer-dc viewport)], too.} +result of @racket[(viewport-buffer-dc viewport)], too.} @defproc[(viewport-buffer-dc [viewport viewport?]) (is-a?/c dc<%>)]{ -Returns an object for direct drawing into @scheme[viewport]'s +Returns an object for direct drawing into @racket[viewport]'s off-screen representation. Mirror all such drawing to the -result of @scheme[(viewport-dc viewport)], too.} +result of @racket[(viewport-dc viewport)], too.} @; ---------------------------------------- @section{An Example} -@schemeblock[ +@racketblock[ (open-graphics) (code:comment @#,t{nothing appears to happen, but the library is initialized...}) @@ -638,12 +642,12 @@ The use of multiple viewports, viewport descriptors, drawing operations for multiple viewports is as easy as the use of a single viewport: -@schemeblock[ +@racketblock[ (open-graphics) -(let* ((code:comment @#,t{@scheme[w1] and @scheme[w2] are viewports for different windows}) +(let* ((code:comment @#,t{@racket[w1] and @racket[w2] are viewports for different windows}) [w1 (open-viewport "viewport 1" 300 300)] [w2 (open-viewport "viewport 2" 200 500)] - (code:comment @#,t{@scheme[d1] and @scheme[d2] draw lines in different viewports}) + (code:comment @#,t{@racket[d1] and @racket[d2] draw lines in different viewports}) [d1 (draw-line w1)] [d2 (draw-line w2)]) (code:comment @#,t{draws a line in viewport labeled ``viewport 1''}) @@ -652,7 +656,7 @@ viewport: (d2 (make-posn 100 100) (make-posn 101 400))) (code:comment @#,t{we no longer have access to viewports 1 and 2,}) -(code:comment @#,t{since their descriptors did not escape the @scheme[let]}) +(code:comment @#,t{since their descriptors did not escape the @racket[let]}) (close-graphics) (code:comment @#,t{removes the viewports}) ] @@ -661,9 +665,9 @@ viewport: To guarantee the proper closing of viewports in cases of errors, especially when a program manages several viewports simultaneously, a -programmer should use @scheme[dynamic-wind:] +programmer should use @racket[dynamic-wind:] -@schemeblock[ +@racketblock[ (let ([w (open-viewport "hello" 100 100)]) (dynamic-wind (code:comment @#,t{what we want to happen first: nothing}) @@ -681,40 +685,40 @@ programmer should use @scheme[dynamic-wind:] The graphics library contains functions that determine where the mouse is, if there are any clicks, etc. The functions -@scheme[get-mouse-click] and @scheme[ready-mouse-click] first return a +@racket[get-mouse-click] and @racket[ready-mouse-click] first return a ``mouse-click descriptor,'' and then other functions take the descriptor and return the mouse's position, which button was pushed, etc. Mouse clicks are buffered and returned in the same order in which they occurred. Thus, the descriptors returned by -@scheme[get-mouse-click] and @scheme[ready-mouse-click] may be from +@racket[get-mouse-click] and @racket[ready-mouse-click] may be from clicks that occurred long before these functions were called. @defproc[(get-mouse-click [viewport viewport?]) mouse-click?]{ -Returns the next mouse click in @scheme[viewport], waiting for a click +Returns the next mouse click in @racket[viewport], waiting for a click if necessary.} @defproc[(ready-mouse-click [viewport viewport?]) (or/c mouse-click? false/c)]{ -Returns either a mouse click descriptor or @scheme[#f] if none is -available. Unlike @scheme[get-mouse-click], -@scheme[ready-mouse-click] always returns immediately.} +Returns either a mouse click descriptor or @racket[#f] if none is +available. Unlike @racket[get-mouse-click], +@racket[ready-mouse-click] always returns immediately.} @defproc[(ready-mouse-release [viewport viewport?]) (or/c mouse-click? false/c)]{ Returns either a click descriptor from a mouse-release (button-up) -event or @scheme[#f] if none is available.} +event or @racket[#f] if none is available.} @defproc[(query-mouse-posn [viewport viewport?]) (or/c posn? false/c)]{ Returns either the position of the mouse cursor within -@scheme[viewport] or else @scheme[#f] if the cursor is currently -outside @scheme[viewport].} +@racket[viewport] or else @racket[#f] if the cursor is currently +outside @racket[viewport].} @defproc[(mouse-click-posn [mouse-click mouse-click?]) posn?]{ @@ -725,49 +729,49 @@ mouse click occurred.} @defproc[(left-mouse-click? [mouse-click mouse-click?]) boolean?]{ -Returns @scheme[#t] if the mouse click occurred with the left mouse -button, @scheme[#f] otherwise.} +Returns @racket[#t] if the mouse click occurred with the left mouse +button, @racket[#f] otherwise.} @defproc[(middle-mouse-click? [mouse-click mouse-click?]) boolean?]{ -Returns @scheme[#t] if the mouse click occurred with the middle mouse -button, @scheme[#f] otherwise.} +Returns @racket[#t] if the mouse click occurred with the middle mouse +button, @racket[#f] otherwise.} @defproc[(right-mouse-click? [mouse-click mouse-click?]) boolean?]{ -Returns @scheme[#t] if the mouse click occurred with the right mouse -button, @scheme[#f] otherwise.} +Returns @racket[#t] if the mouse click occurred with the right mouse +button, @racket[#f] otherwise.} @; ---------------------------------------- @section{Keyboard Operations} The graphics library contains functions that report key presses from -the keyboard. The functions @scheme[get-key-press] and -@scheme[ready-key-press] return a ``key-press descriptor,'' and then -@scheme[key-value] takes the descriptor and returns a character or +the keyboard. The functions @racket[get-key-press] and +@racket[ready-key-press] return a ``key-press descriptor,'' and then +@racket[key-value] takes the descriptor and returns a character or symbol (usually a character) representing the key that was pressed. Key presses are buffered and returned in the same order in which they -occurred. Thus, the descriptors returned by @scheme[get-key-press] -and @scheme[ready-key-press] may be from presses that occurred long +occurred. Thus, the descriptors returned by @racket[get-key-press] +and @racket[ready-key-press] may be from presses that occurred long before these functions were called. @defproc[(get-key-press [viewport viewport?]) key-press?]{ -Returns the next key press in the @scheme[viewport], waiting for a +Returns the next key press in the @racket[viewport], waiting for a key press if necessary.} @defproc[(ready-key-press [viewport viewport?]) key-press?]{ -Returns the next key press in the @scheme[viewport] or returns -@scheme[#f] if none is available. Unlike @scheme[get-key-press], -@scheme[ready-key-press] always returns immediately.} +Returns the next key press in the @racket[viewport] or returns +@racket[#f] if none is available. Unlike @racket[get-key-press], +@racket[ready-key-press] always returns immediately.} @defproc[(key-value [key-press key-press?]) (or/c character? symbol?)]{ Returns a character or special symbol for the key that was -pressed. For example, the Enter key generates @scheme[#\return], and the -up-arrow key generates @scheme['up]. For a complete list of possible +pressed. For example, the Enter key generates @racket[#\return], and the +up-arrow key generates @racket['up]. For a complete list of possible return values, see @method[key-event% get-key-code].} @; ---------------------------------------- @@ -777,7 +781,7 @@ return values, see @method[key-event% get-key-code].} @defproc[(viewport-flush-input [viewport viewport?]) void?]{ Empties all mouse and keyboard events in the input buffer of -@scheme[viewport].} +@racket[viewport].} @; ---------------------------------------- @@ -790,28 +794,28 @@ Empties all mouse and keyboard events in the input buffer of @defsignature[graphics^ ()] Includes all of the bindings defined earlier in this chapter, except -the @scheme[posn] bindings of @secref["posn"]. +the @racket[posn] bindings of @secref["posn"]. @defsignature[graphics:posn^ ()] -Includes the @scheme[posn] bindings of @secref["posn"]. +Includes the @racket[posn] bindings of @secref["posn"]. -@subsection{Unit with @scheme[posn]} +@subsection{Unit with @racket[posn]} @defmodule[graphics/graphics-unit] @defthing[graphics@ unit?]{ -Imports @scheme[mred^] and exports both @scheme[graphics^] and -@scheme[graphics:posn^].} +Imports @racket[mred^] and exports both @racket[graphics^] and +@racket[graphics:posn^].} -@subsection{Unit without @scheme[posn]} +@subsection{Unit without @racket[posn]} @defmodule[graphics/graphics-posn-less-unit] @defthing[graphics-posn-less@ unit?]{ -Imports @scheme[mred^] and @scheme[graphics:posn^] and exports -@scheme[graphics^].} +Imports @racket[mred^] and @racket[graphics:posn^] and exports +@racket[graphics^].} diff --git a/collects/graphics/scribblings/traditional-turtles.scrbl b/collects/graphics/scribblings/traditional-turtles.scrbl index f1b18620c3..664c832c04 100644 --- a/collects/graphics/scribblings/traditional-turtles.scrbl +++ b/collects/graphics/scribblings/traditional-turtles.scrbl @@ -10,20 +10,20 @@ @defproc*[([(turtles [on? any/c]) void?] [(turtles) void?])]{ -Shows and hides the turtles window based on @scheme[on?]. If -@scheme[on?] is not supplied, the state is toggled.} +Shows and hides the turtles window based on @racket[on?]. If +@racket[on?] is not supplied, the state is toggled.} @defproc[(move [n real?]) void?]{ -Moves the turtle @scheme[n] pixels without drawing.} +Moves the turtle @racket[n] pixels without drawing.} @defproc[(draw [n real?]) void?]{ -Moves the turtle @scheme[n] pixels and draws a line on the path.} +Moves the turtle @racket[n] pixels and draws a line on the path.} @defproc[(erase [n real?]) void?]{ -Moves the turtle @scheme[n] pixels and erase along the path.} +Moves the turtle @racket[n] pixels and erase along the path.} @deftogether[( @defproc[(move-offset [h real?][v real?]) void?] @@ -31,17 +31,17 @@ Moves the turtle @scheme[n] pixels and erase along the path.} @defproc[(erase-offset [h real?][v real?]) void?] )]{ -Like @scheme[move], @scheme[draw], and @scheme[erase], but using a +Like @racket[move], @racket[draw], and @racket[erase], but using a horizontal and vertical offset from the turtle's current position.} @defproc[(turn [theta real?]) void?]{ -Turns the turtle @scheme[theta] degrees counter-clockwise.} +Turns the turtle @racket[theta] degrees counter-clockwise.} @defproc[(turn/radians [theta real?]) void?]{ -Turns the turtle @scheme[theta] radians counter-clockwise.} +Turns the turtle @racket[theta] radians counter-clockwise.} @defproc[(clear) void?]{ @@ -55,17 +55,17 @@ Leaves only one turtle, in the start position.} Spawns a new turtle where the turtle is currently located. In order to distinguish the two turtles, only the new one evaluates -@scheme[expr]. For example, if you start with a fresh turtle-window -and type: +@racket[expr]. For example, if you start with a fresh turtle-window +and evaluate: -@schemeblock[ +@racketblock[ (split (turn/radians (/ pi 2))) ] you will have two turtles, pointing at right angles to each other. Continue with -@schemeblock[ +@racketblock[ (draw 100) ] @@ -74,34 +74,34 @@ again, you will have four turtles, etc.} @defform[(split* expr ...)]{ -Like @scheme[(split expr ...)], except that one turtle is created for -each @scheme[expr]. +Like @racket[(split expr ...)], except that one turtle is created for +each @racket[expr]. For example, to create two turtles, one pointing at @math["\u3C0/2"] and one at @math["\u3C0/3"], evaluate -@schemeblock[ +@racketblock[ (split* (turn/radians (/ pi 3)) (turn/radians (/ pi 2))) ]} @defform[(tprompt expr ...)]{ -Limits the splitting of the turtles. Before@scheme[expr] is evaluated, +Limits the splitting of the turtles. Before@racket[expr] is evaluated, the state of the turtles (how many, their positions and headings) is -``checkpointed.'' Then @scheme[expr] is evaluated, and then the state +``checkpointed.'' Then @racket[expr] is evaluated, and then the state of the turtles is restored, but all drawing that may have occurred -during execution of @scheme[expr] remains. +during execution of @racket[expr] remains. For example -@schemeblock[ +@racketblock[ (tprompt (draw 100)) ] moves a turtle forward 100 pixel while drawing a line, and then moves the turtle be immediately back to its original position. Similarly, -@schemeblock[ +@racketblock[ (tprompt (split (turn/radians (/ pi 2)))) ] @@ -109,7 +109,17 @@ splits the turtle into two, rotates one 90 degrees, and then collapses back to a single turtle. The fern functions below demonstrate more advanced use of -@scheme[tprompt].} +@racket[tprompt].} + +@defproc[(save-turtle-bitmap [name (or/c path-string? output-port?)] + [kind (or/c 'png 'jpeg 'xbm 'xpm 'bmp)]) + void?]{ + Saves the current state of the turtles window in an image file. +} + +@defthing[turtle-window-size exact-positive-integer?]{ + The size of the turtles window. +} @; ---------------------------------------- @@ -117,19 +127,19 @@ The fern functions below demonstrate more advanced use of @defmodule[graphics/turtle-examples] -The @schememodname[graphics/turtle-examples] library's source is meant +The @racketmodname[graphics/turtle-examples] library's source is meant to be read, but it also exports the following examples. @defproc[(regular-poly [sides exact-nonnegative-integer?] [radius real?]) void?]{ -Draws a regular poly centered at the turtle with @scheme[sides] sides -and with radius @scheme[radius].} +Draws a regular poly centered at the turtle with @racket[sides] sides +and with radius @racket[radius].} @defproc[(regular-polys [n exact-nonnegative-integer?] [s any/c]) void?]{ -Draws @scheme[n] regular polys each with @scheme[n] sides centered at +Draws @racket[n] regular polys each with @racket[n] sides centered at the turtle.} @defproc[(radial-turtles [n exact-nonnegative-integer?]) void?]{ @@ -143,8 +153,13 @@ same direction as the original turtle.} @defproc[(spokes) void?]{ -Draws some spokes, using @scheme[radial-turtles] and -@scheme[spaced-turtles].} +Draws some spokes, using @racket[radial-turtles] and +@racket[spaced-turtles].} + +@defproc[(gapped-lines) void?]{ + Draw a bunch of parallel line segments, using + @racket[spaced-turtles]. +} @defproc[(spyro-gyra) void?]{ @@ -155,12 +170,12 @@ Draws a spyro-grya reminiscent shape.} As the name says...} @defproc[(graphics-bexam) void?]{ - -Draws a fractal that came up on an exam that the author took.} + Draws a fractal that came up on an exam given at Rice in 1997 or so. +} @defthing[serp-size real?]{ -A constant that is a good size for the @scheme[serp] procedures.} +A constant that is a good size for the @racket[serp] procedures.} @deftogether[( @defproc[(serp [serp-size real?]) void?] @@ -168,17 +183,17 @@ A constant that is a good size for the @scheme[serp] procedures.} )]{ Draws the @as-index{Serpinski triangle} in two different ways, the -first using @scheme[split] heavily. After running the first one, try -executing @scheme[(draw 10)].} +first using @racket[split] heavily. After running the first one, try +executing @racket[(draw 10)].} @defthing[koch-size real?]{ -A constant that is a good size for the @scheme[koch] procedures.} +A constant that is a good size for the @racket[koch] procedures.} @deftogether[( -@defproc[(koch [koch-size real?]) void?] -@defproc[(koch-nosplit [koch-size real?]) void?] +@defproc[(koch-split [koch-size real?]) void?] +@defproc[(koch-draw [koch-size real?]) void?] )]{ Draws the same @as-index{Koch snowflake} in two different ways.} @@ -186,23 +201,28 @@ Draws the same @as-index{Koch snowflake} in two different ways.} @defproc[(lorenz [a real?] [b real?] [c real?]) void?]{ Watch the @as-index{Lorenz attractor} (a.k.a. @as-index{butterfly attractor}) -initial values @scheme[a], @scheme[b], and @scheme[c].} +initial values @racket[a], @racket[b], and @racket[c].} @defproc[(lorenz1) void?]{ -Calls @scheme[lorenze] with good initial values.} +Calls @racket[lorenze] with good initial values.} -@deftogether[( -@defproc[(peano1 [peano-size real?]) void?] -@defproc[(peano2 [peano-size real?]) void?] -)]{ +@defproc[(peano [peano-size real?]) void?]{ + Draws the @as-index{Peano space-filling curve}. +} -Draws the @as-index{Peano space-filling curve}, where @scheme[peano1] uses -@scheme[split].} +@defproc[(peano-position-turtle) void?]{ + Moves the turtle to a good place to prepare for + a call to @racket[peano]. +} + +@defthing[peano-size exact-nonnegative-integer?]{ + One size to use with @racket[peano]. +} @defthing[fern-size exact-nonnegative-integer?]{ -A good size for the @scheme[fern1] and @scheme[fern2] functions.} +A good size for the @racket[fern1] and @racket[fern2] functions.} @deftogether[( @defproc[(fern1 [fern-size exact-nonnegative-integer?]) void?] @@ -211,12 +231,12 @@ A good size for the @scheme[fern1] and @scheme[fern2] functions.} Draws a @as-index{fern fractal}. -For @scheme[fern1], you will probably want to point the turtle up +For @racket[fern1], you will probably want to point the turtle up before running this one, with something like: -@schemeblock[ +@racketblock[ (turn/radians (- (/ pi 2))) ] -For @scheme[fern2], you may need to backup a little.} +For @racket[fern2], you may need to backup a little.} diff --git a/collects/graphics/scribblings/value-turtles.scrbl b/collects/graphics/scribblings/value-turtles.scrbl index cae378cde0..62ccac8bac 100644 --- a/collects/graphics/scribblings/value-turtles.scrbl +++ b/collects/graphics/scribblings/value-turtles.scrbl @@ -9,7 +9,7 @@ The value turtles are a variation on traditional turtles. Rather than having just a single window where each operation changes the state of -that window, in the @scheme[graphics/value-turtles] library, the +that window, in the @racket[graphics/value-turtles] library, the entire turtles window is treated as a value. This means that each of the primitive operations accepts, in addition to the usual arguments, a turtles-window value; instead of returning nothing, each returns a @@ -20,67 +20,113 @@ turtles-window value. [init-x real? (/ width 2)] [init-y real? (/ height 2)] [init-angle real? 0]) - turtles-window?]{ + turtles?]{ -Creates a new turtles window with the given @scheme[width] and -@scheme[height]. The remaining arguments specify position of the -initial turtle and the direction in radians (where @scheme[0] is to +Creates a new turtles window with the given @racket[width] and +@racket[height]. The remaining arguments specify position of the +initial turtle and the direction in radians (where @racket[0] is to the right).} -@defproc[(move [n real?] [turtles turtles-window?]) turtles-window?]{ +@defproc[(turtles? [v any/c]) boolean?]{ + Determines if @racket[v] is a turtles drawing. +} + +@defproc[(move [n real?] [turtles turtles?]) turtles?]{ -Moves the turtle @scheme[n] pixels, returning a new turtles window.} +Moves the turtle @racket[n] pixels, returning a new turtles window.} -@defproc[(draw [n real?] [turtles turtles-window?]) turtles-window?]{ +@defproc[(draw [n real?] [turtles turtles?]) turtles?]{ -Moves the turtle @scheme[n] pixels and draws a line along the path, +Moves the turtle @racket[n] pixels and draws a line along the path, returning a new turtles window.} -@defproc[(erase [n real?] [turtles turtles-window?]) turtles-window?]{ +@defproc[(erase [n real?] [turtles turtles?]) turtles?]{ -Moves the turtle @scheme[n] pixels and erases a line along the path, +Moves the turtle @racket[n] pixels and erases a line along the path, returning a new turtles window.} @deftogether[( -@defproc[(move-offset [h real?] [v real?] [turtles turtles-window?]) turtles-window?] -@defproc[(draw-offset [h real?] [v real?] [turtles turtles-window?]) turtles-window?] -@defproc[(erase-offset [h real?] [v real?] [turtles turtles-window?]) turtles-window?] +@defproc[(move-offset [h real?] [v real?] [turtles turtles?]) turtles?] +@defproc[(draw-offset [h real?] [v real?] [turtles turtles?]) turtles?] +@defproc[(erase-offset [h real?] [v real?] [turtles turtles?]) turtles?] )]{ -Like @scheme[move], @scheme[draw], and @scheme[erase], but using a +Like @racket[move], @racket[draw], and @racket[erase], but using a horizontal and vertical offset from the turtle's current position.} -@defproc[(turn [theta real?] [turtles turtles-window?]) turtles-window?]{ +@defproc[(turn [theta real?] [turtles turtles?]) turtles?]{ -Turns the turtle @scheme[theta] degrees counter-clockwise, returning a +Turns the turtle @racket[theta] degrees counter-clockwise, returning a new turtles window.} -@defproc[(turn/radians [theta real?] [turtles turtles-window?]) turtles-window?]{ +@defproc[(turn/radians [theta real?] [turtles turtles?]) turtles?]{ -Turns the turtle @scheme[theta] radians counter-clockwise, returning a +Turns the turtle @racket[theta] radians counter-clockwise, returning a new turtles window.} -@defproc[(merge [turtles1 turtles-window?] [turtles2 turtles-window?]) turtles-window?]{ +@defproc[(merge [turtles1 turtles?] [turtles2 turtles?]) turtles?]{ -The @scheme[split] and @scheme[tprompt] forms provided by -@schememodname[graphics/turtles] isn't needed for -@schememodname[graphics/value-turtles], since the turtles window is a +The @racket[split] and @racket[tprompt] forms provided by +@racketmodname[graphics/turtles] isn't needed for +@racketmodname[graphics/value-turtles], since the turtles window is a value. -Instead, the @scheme[merge] accepts two turtles windows and combines +Instead, the @racket[merge] accepts two turtles windows and combines the state of the two turtles windows into a single window. The new window contains all of the turtles of the previous two windows, but only the line drawings of the first turtles argument.} +@defproc[(clean [turtles turtles?]) turtles?]{ + Produces a turtles like @racket[turtles], but with only a single + turtle, positioned in the center. +} + @; ---------------------------------------- @section[#:tag "value-examples"]{Examples} @defmodule[graphics/value-turtles-examples] -The @schememodname[graphics/value-turtles-examples] library is similar -to @schememodname[graphics/turtle-examples], but using -@schememodname[graphics/value-turtles] instead of -@schememodname[graphics/turtles]. +The @racketmodname[graphics/turtle-examples] library's source is meant +to be read, but it also exports the following examples. + +@defproc[(radial-turtles [n exact-nonnegative-integer?] [turtles turtles?]) turtles?]{ + +Places @math{2^n} turtles spaced evenly pointing radially outward.} + +@defproc[(spaced-turtles [n exact-nonnegative-integer?] [turtles turtles?]) turtles?]{ + +Places @math{2^n} turtles evenly spaced in a line and pointing in the +same direction as the original turtle.} + + +@defproc[(neato [turtles turtles?]) turtles?]{ + As the name says... +} + +@defproc[(regular-poly [sides exact-nonnegative-integer?] + [radius real?] + [turtles turtles?]) + turtles?]{ + +Draws a regular poly centered at the turtle with @racket[sides] sides +and with radius @racket[radius].} + +@defproc[(regular-polys [n exact-nonnegative-integer?] + [s any/c] + [turtles turtles?]) + turtles?]{ + +Draws @racket[n] regular polys each with @racket[n] sides centered at +the turtle.} + +@defproc[(spokes [turtles turtles?]) turtles?]{ + +Draws some spokes, using @racket[radial-turtles] and +@racket[spaced-turtles].} + +@defproc[(spyro-gyra [turtles turtles?]) turtles?]{ + +Draws a spyro-grya reminiscent shape.} diff --git a/collects/graphics/turtle-examples.rkt b/collects/graphics/turtle-examples.rkt index fd3c5826a0..928c041f38 100644 --- a/collects/graphics/turtle-examples.rkt +++ b/collects/graphics/turtle-examples.rkt @@ -1,310 +1,310 @@ -(module turtle-examples mzscheme - (require mzlib/math - mzlib/etc - "turtles.ss") - (provide regular-poly regular-polys radial-turtles spaced-turtles - spokes spyro-gyra neato graphics-bexam serp-size serp serp-nosplit - koch-size koch-split koch-draw lorenz lorenz1 peano-size - peano-position-turtle peano fern-size fern1 fern2 gapped-lines) - - (define (regular-poly sides radius) - (local [(define theta (/ (* 2 pi) sides)) - (define side-len (* 2 radius (sin (/ theta 2)))) - (define (draw-sides n) - (cond - [(zero? n) (void)] - [else - (draw side-len) - (turn/radians theta) - (draw-sides (sub1 n))]))] - (tprompt (move radius) - (turn/radians (/ (+ pi theta) 2)) - (draw-sides sides)))) - - (define (regular-polys sides s) - (local [(define (make-polys n) - (cond - [(zero? n) (void)] - [else - (regular-poly sides (* n 5)) - (make-polys (sub1 n))]))] - (make-polys sides))) - - (define (radial-turtles n) - (cond - [(zero? n) (void)] - [else - (split (turn/radians (/ pi (expt 2 (sub1 n))))) - (radial-turtles (sub1 n))])) - - (define (spaced-turtles n) - (cond - [(zero? n) (void)] - [else - (split (move (expt 2 (+ n 1)))) - (spaced-turtles (sub1 n))])) - - (define (spokes) +#lang racket + +(require graphics/turtles) + +(provide regular-poly regular-polys radial-turtles spaced-turtles + spokes spyro-gyra neato graphics-bexam serp-size serp serp-nosplit + koch-size koch-split koch-draw lorenz lorenz1 peano-size + peano-position-turtle peano fern-size fern1 fern2 gapped-lines) + +(define (regular-poly sides radius) + (local [(define theta (/ (* 2 pi) sides)) + (define side-len (* 2 radius (sin (/ theta 2)))) + (define (draw-sides n) + (cond + [(zero? n) (void)] + [else + (draw side-len) + (turn/radians theta) + (draw-sides (sub1 n))]))] + (tprompt (move radius) + (turn/radians (/ (+ pi theta) 2)) + (draw-sides sides)))) + +(define (regular-polys sides s) + (local [(define (make-polys n) + (cond + [(zero? n) (void)] + [else + (regular-poly sides (* n 5)) + (make-polys (sub1 n))]))] + (make-polys sides))) + +(define (radial-turtles n) + (cond + [(zero? n) (void)] + [else + (split (turn/radians (/ pi (expt 2 (sub1 n))))) + (radial-turtles (sub1 n))])) + +(define (spaced-turtles n) + (cond + [(zero? n) (void)] + [else + (split (move (expt 2 (+ n 1)))) + (spaced-turtles (sub1 n))])) + +(define (spokes) + (radial-turtles 4) + (spaced-turtles 5) + (turn/radians (/ pi 2)) + (draw 10)) + +(define (spyro-gyra) + (radial-turtles 4) + (regular-poly 3 100)) + +(define (neato) + (local [(define (spiral d t) + (cond + [(<= 1 d) + (draw d) + (turn/radians t) + (spiral (- d 1) t)] + [else (void)]))] (radial-turtles 4) - (spaced-turtles 5) - (turn/radians (/ pi 2)) - (draw 10)) - - (define (spyro-gyra) - (radial-turtles 4) - (regular-poly 3 100)) - - (define (neato) - (local [(define (spiral d t) - (cond - [(<= 1 d) - (draw d) - (turn/radians t) - (spiral (- d 1) t)] - [else (void)]))] - (radial-turtles 4) - (spiral 30 (/ pi 12)))) - - (define (graphics-bexam) - (local [(define (gb d) - (cond - [(<= d 3) - (draw d)] - [else - (local [(define new-d (/ d 3))] - (gb new-d) - (turn/radians (- (/ pi 2))) - (gb new-d) - (turn/radians (/ pi 2)) - (gb new-d) - (turn/radians (/ pi 2)) - (gb new-d) - (turn/radians (- (/ pi 2))) - (gb new-d))])) - (define square-size (expt 3 5))] - (split (turn/radians (/ pi 2)) - (move square-size) - (turn/radians (- (/ pi 2))) - (move square-size) - (turn/radians pi)) - (split (move square-size) - (turn/radians (/ pi 2))) - (gb square-size))) - - (define serp-size 120) - - (define (serp distance) - (local [(define sqrt3 (sqrt 3)) - (define -2pi/3 (- 0 (/ (* 2 pi) 3))) - (define pi/6 (/ pi 6)) - (define -5pi/6 (- 0 (/ (* 5 pi) 6))) - (define pi/2 (/ pi 2)) - (define (engine distance) - (cond - [(< distance 1) (void)] - [else - (local [(define side-half (* distance sqrt3)) - (define side (* 2 side-half))] - (turn/radians -2pi/3) - (move distance) - (split (move distance) - (turn/radians -5pi/6) - (draw side) - (turn/radians -5pi/6) - (move distance) - (turn/radians pi) - (split (turn/radians -5pi/6) - (move side-half) - (turn/radians pi/6))) - (engine (/ distance 2)))]))] - (move (* 2 distance)) - (turn/radians (/ (* 5 pi) 6)) - (draw (* distance 2 (sqrt 3))) - (turn/radians (/ (* 2 pi) 3)) - (move (* distance 2 (sqrt 3))) - (turn/radians (/ (* 2 pi) 3)) - (draw (* distance 2 (sqrt 3))) - (turn/radians (/ (* 2 pi) 3)) - (turn/radians (/ pi 6)) - (move (* 2 distance)) - (turn/radians pi) - (engine distance))) - - (define (serp-nosplit distance) - (local [(define sqrt3 (sqrt 3)) - (define -2pi/3 (- 0 (/ (* 2 pi) 3))) - (define pi/6 (/ pi 6)) - (define -5pi/6 (- 0 (/ (* 5 pi) 6))) - (define pi/2 (/ pi 2)) - (define (engine distance) - (cond - [(< distance 1) (void)] - [else - (local [(define side-half (* distance sqrt3)) - (define side (* 2 side-half))] - (turn/radians -2pi/3) - (move distance) - (engine (/ distance 2)) - (move distance) - (turn/radians -5pi/6) - (draw side) - (turn/radians -5pi/6) - (move distance) - (turn/radians pi) - (engine (/ distance 2)) - (turn/radians -5pi/6) - (move side-half) - (turn/radians pi/6) - (engine (/ distance 2)) - (move (- distance)))]))] - (move (* 2 distance)) - (turn/radians (/ (* 5 pi) 6)) - (draw (* distance 2 (sqrt 3))) - (turn/radians (/ (* 2 pi) 3)) - (move (* distance 2 (sqrt 3))) - (turn/radians (/ (* 2 pi) 3)) - (draw (* distance 2 (sqrt 3))) - (turn/radians (/ (* 2 pi) 3)) - (turn/radians (/ pi 6)) - (move (* 2 distance)) - (turn/radians pi) - (engine distance))) - - (define koch-size (expt 3 5)) - - (define (koch-split koch-size) - (local [(define (build-up-turtles n) - (cond - [(<= n 3) 'built] - [else (local [(define third (/ n 3))] - (split* 'stay-put - (move (* 2 third)) - (begin (move third) - (turn/radians (- (/ pi 3)))) - (begin (move third) - (turn/radians (- (/ pi 3))) - (move third) - (turn/radians (* 2 (/ pi 3))))) - (build-up-turtles third))]))] - (split* 'stay-put - (begin (move koch-size) - (turn/radians (/ (* 2 pi) 3))) - (begin (turn/radians (/ pi 3)) - (move koch-size) - (turn/radians pi))) - (build-up-turtles koch-size) - (draw 3))) - - (define (koch-draw koch-size) - (local [(define (side n) - (cond - [(<= n 3) (draw n)] - [else (local [(define third (/ n 3))] - (side third) - (turn/radians (- (/ pi 3))) - (side third) - (turn/radians (* 2 (/ pi 3))) - (side third) - (turn/radians (- (/ pi 3))) - (side third))]))] - (split* 'stay-put - (begin (move koch-size) - (turn/radians (/ (* 2 pi) 3))) - (begin (turn/radians (/ pi 3)) - (move koch-size) - (turn/radians pi))) - (side koch-size))) - - (define (lorenz a b c) - (local [(define (loop x y z) - (local [(define delta 0.01) - (define dx (* delta (* a (- y x)))) - (define dy (* delta (- (* x b) y (* x z)))) - (define dz (* delta (- (* x y) (* c z))))] - (draw-offset dx dz) - (sleep 0.05) - (erase-offset (- dx) (- dz)) - (move-offset dx dz) - (loop (+ x dx) - (+ y dy) - (+ z dz))))] - (loop 1 1 1))) - - (define (lorenz1) (lorenz 50 60 11)) - - (define peano-size (expt 3 6)) - (define (peano-position-turtle) - (clear) - (move -270) - (turn/radians (/ pi 2)) - (move 250) - (turn/radians (- (/ (* 3 pi) 4)))) - - (define (peano l) - (cond - [(<= l 3) - (draw l)] - [else - (local [(define new-l (/ l 3))] - (peano new-l) - (tprompt (peano new-l) - (split* (turn/radians (/ pi 2)) - (turn/radians (- (/ pi 2)))) - (peano new-l)) - (tprompt (split* (turn/radians (/ pi 2)) - (turn/radians (- (/ pi 2)))) - (peano new-l)) - (tprompt (split* (move new-l) - (begin (turn/radians (/ pi 2)) - (move new-l) - (turn/radians (- (/ pi 2)))) - (begin (turn/radians (- (/ pi 2))) - (move new-l) - (turn/radians (/ pi 2)))) - (peano l)) - (move (* 2 new-l)))])) - - (define fern-size 30) - - (define (fern1 n) - (cond - [(< 1 n) - (draw (/ n 2)) - (tprompt (split* (turn/radians (/ pi 3)) - (turn/radians (- (/ pi 3)))) - (fern1 (/ n 2))) - (draw (/ n 2)) - (turn/radians 0.08) - (fern1 (- n 1))] - [else (void)])) - - - ;; need to backup a little for this one. - (define (fern2 n) - (local [(define d 0.04) - (define (fernd n sign) - (cond - [(< 1 n) - (draw (/ n 2)) - (tprompt (turn/radians (/ pi 3)) - (fernd (/ n 2) -)) - (tprompt (turn/radians (- (/ pi 3))) - (fernd (/ n 2) +)) - (draw (/ n 2)) - (turn/radians (sign d)) - (fernd (- n 1) sign)] - [else (void)]))] - (fernd n +))) - - (define (gapped-lines) - (local [(define gaps 5) - (define lines 3)] - (tprompt - (turn/radians (/ pi 2)) - (spaced-turtles lines) - (turn/radians (- (/ pi 2))) - (draw (* 4 (expt 2 gaps)))) - (tprompt - (spaced-turtles gaps) - (turn/radians (/ pi 2)) - (erase (* 4 (expt 2 lines))))))) + (spiral 30 (/ pi 12)))) + +(define (graphics-bexam) + (local [(define (gb d) + (cond + [(<= d 3) + (draw d)] + [else + (local [(define new-d (/ d 3))] + (gb new-d) + (turn/radians (- (/ pi 2))) + (gb new-d) + (turn/radians (/ pi 2)) + (gb new-d) + (turn/radians (/ pi 2)) + (gb new-d) + (turn/radians (- (/ pi 2))) + (gb new-d))])) + (define square-size (expt 3 5))] + (split (turn/radians (/ pi 2)) + (move square-size) + (turn/radians (- (/ pi 2))) + (move square-size) + (turn/radians pi)) + (split (move square-size) + (turn/radians (/ pi 2))) + (gb square-size))) + +(define serp-size 120) + +(define (serp distance) + (local [(define sqrt3 (sqrt 3)) + (define -2pi/3 (- 0 (/ (* 2 pi) 3))) + (define pi/6 (/ pi 6)) + (define -5pi/6 (- 0 (/ (* 5 pi) 6))) + (define pi/2 (/ pi 2)) + (define (engine distance) + (cond + [(< distance 1) (void)] + [else + (local [(define side-half (* distance sqrt3)) + (define side (* 2 side-half))] + (turn/radians -2pi/3) + (move distance) + (split (move distance) + (turn/radians -5pi/6) + (draw side) + (turn/radians -5pi/6) + (move distance) + (turn/radians pi) + (split (turn/radians -5pi/6) + (move side-half) + (turn/radians pi/6))) + (engine (/ distance 2)))]))] + (move (* 2 distance)) + (turn/radians (/ (* 5 pi) 6)) + (draw (* distance 2 (sqrt 3))) + (turn/radians (/ (* 2 pi) 3)) + (move (* distance 2 (sqrt 3))) + (turn/radians (/ (* 2 pi) 3)) + (draw (* distance 2 (sqrt 3))) + (turn/radians (/ (* 2 pi) 3)) + (turn/radians (/ pi 6)) + (move (* 2 distance)) + (turn/radians pi) + (engine distance))) + +(define (serp-nosplit distance) + (local [(define sqrt3 (sqrt 3)) + (define -2pi/3 (- 0 (/ (* 2 pi) 3))) + (define pi/6 (/ pi 6)) + (define -5pi/6 (- 0 (/ (* 5 pi) 6))) + (define pi/2 (/ pi 2)) + (define (engine distance) + (cond + [(< distance 1) (void)] + [else + (local [(define side-half (* distance sqrt3)) + (define side (* 2 side-half))] + (turn/radians -2pi/3) + (move distance) + (engine (/ distance 2)) + (move distance) + (turn/radians -5pi/6) + (draw side) + (turn/radians -5pi/6) + (move distance) + (turn/radians pi) + (engine (/ distance 2)) + (turn/radians -5pi/6) + (move side-half) + (turn/radians pi/6) + (engine (/ distance 2)) + (move (- distance)))]))] + (move (* 2 distance)) + (turn/radians (/ (* 5 pi) 6)) + (draw (* distance 2 (sqrt 3))) + (turn/radians (/ (* 2 pi) 3)) + (move (* distance 2 (sqrt 3))) + (turn/radians (/ (* 2 pi) 3)) + (draw (* distance 2 (sqrt 3))) + (turn/radians (/ (* 2 pi) 3)) + (turn/radians (/ pi 6)) + (move (* 2 distance)) + (turn/radians pi) + (engine distance))) + +(define koch-size (expt 3 5)) + +(define (koch-split koch-size) + (local [(define (build-up-turtles n) + (cond + [(<= n 3) 'built] + [else (local [(define third (/ n 3))] + (split* 'stay-put + (move (* 2 third)) + (begin (move third) + (turn/radians (- (/ pi 3)))) + (begin (move third) + (turn/radians (- (/ pi 3))) + (move third) + (turn/radians (* 2 (/ pi 3))))) + (build-up-turtles third))]))] + (split* 'stay-put + (begin (move koch-size) + (turn/radians (/ (* 2 pi) 3))) + (begin (turn/radians (/ pi 3)) + (move koch-size) + (turn/radians pi))) + (build-up-turtles koch-size) + (draw 3))) + +(define (koch-draw koch-size) + (local [(define (side n) + (cond + [(<= n 3) (draw n)] + [else (local [(define third (/ n 3))] + (side third) + (turn/radians (- (/ pi 3))) + (side third) + (turn/radians (* 2 (/ pi 3))) + (side third) + (turn/radians (- (/ pi 3))) + (side third))]))] + (split* 'stay-put + (begin (move koch-size) + (turn/radians (/ (* 2 pi) 3))) + (begin (turn/radians (/ pi 3)) + (move koch-size) + (turn/radians pi))) + (side koch-size))) + +(define (lorenz a b c) + (local [(define (loop x y z) + (local [(define delta 0.01) + (define dx (* delta (* a (- y x)))) + (define dy (* delta (- (* x b) y (* x z)))) + (define dz (* delta (- (* x y) (* c z))))] + (draw-offset dx dz) + (sleep 0.05) + (erase-offset (- dx) (- dz)) + (move-offset dx dz) + (loop (+ x dx) + (+ y dy) + (+ z dz))))] + (loop 1 1 1))) + +(define (lorenz1) (lorenz 50 60 11)) + +(define peano-size (expt 3 6)) +(define (peano-position-turtle) + (clear) + (move -270) + (turn/radians (/ pi 2)) + (move 250) + (turn/radians (- (/ (* 3 pi) 4)))) + +(define (peano l) + (cond + [(<= l 3) + (draw l)] + [else + (local [(define new-l (/ l 3))] + (peano new-l) + (tprompt (peano new-l) + (split* (turn/radians (/ pi 2)) + (turn/radians (- (/ pi 2)))) + (peano new-l)) + (tprompt (split* (turn/radians (/ pi 2)) + (turn/radians (- (/ pi 2)))) + (peano new-l)) + (tprompt (split* (move new-l) + (begin (turn/radians (/ pi 2)) + (move new-l) + (turn/radians (- (/ pi 2)))) + (begin (turn/radians (- (/ pi 2))) + (move new-l) + (turn/radians (/ pi 2)))) + (peano l)) + (move (* 2 new-l)))])) + +(define fern-size 30) + +(define (fern1 n) + (cond + [(< 1 n) + (draw (/ n 2)) + (tprompt (split* (turn/radians (/ pi 3)) + (turn/radians (- (/ pi 3)))) + (fern1 (/ n 2))) + (draw (/ n 2)) + (turn/radians 0.08) + (fern1 (- n 1))] + [else (void)])) + + +;; need to backup a little for this one. +(define (fern2 n) + (local [(define d 0.04) + (define (fernd n sign) + (cond + [(< 1 n) + (draw (/ n 2)) + (tprompt (turn/radians (/ pi 3)) + (fernd (/ n 2) -)) + (tprompt (turn/radians (- (/ pi 3))) + (fernd (/ n 2) +)) + (draw (/ n 2)) + (turn/radians (sign d)) + (fernd (- n 1) sign)] + [else (void)]))] + (fernd n +))) + +(define (gapped-lines) + (local [(define gaps 5) + (define lines 3)] + (tprompt + (turn/radians (/ pi 2)) + (spaced-turtles lines) + (turn/radians (- (/ pi 2))) + (draw (* 4 (expt 2 gaps)))) + (tprompt + (spaced-turtles gaps) + (turn/radians (/ pi 2)) + (erase (* 4 (expt 2 lines)))))) diff --git a/collects/graphics/turtles.rkt b/collects/graphics/turtles.rkt index a759184fee..a7681e4577 100644 --- a/collects/graphics/turtles.rkt +++ b/collects/graphics/turtles.rkt @@ -1,6 +1,7 @@ -#lang scheme +#lang racket/base -(require (prefix-in mred: mred) +(require racket/gui/base + (for-syntax racket/base) mzlib/class mzlib/class100 mzlib/list @@ -15,10 +16,8 @@ save-turtle-bitmap - splitfn split*fn tpromptfn turtle-window-size - display-lines-in-drawing split split* tprompt) (define turtles:window #f) @@ -27,11 +26,11 @@ (define pi 3.141592653589793) (define pi/2 (/ pi 2)) -(define icon-pen (send mred:the-pen-list find-or-create-pen "SALMON" 1 'xor)) -(define icon-brush (send mred:the-brush-list find-or-create-brush "SALMON" 'xor)) -(define blank-pen (send mred:the-pen-list find-or-create-pen "BLACK" 1 'transparent)) -(define w-pen (send mred:the-pen-list find-or-create-pen "white" 1 'solid)) -(define b-pen (send mred:the-pen-list find-or-create-pen "black" 1 'solid)) +(define icon-pen (send the-pen-list find-or-create-pen "SALMON" 1 'solid)) +(define icon-brush (send the-brush-list find-or-create-brush "SALMON" 'solid)) +(define blank-pen (send the-pen-list find-or-create-pen "BLACK" 1 'transparent)) +(define w-pen (send the-pen-list find-or-create-pen "white" 1 'solid)) +(define b-pen (send the-pen-list find-or-create-pen "black" 1 'solid)) (define show-turtle-icons? #t) @@ -39,17 +38,17 @@ (define turtle-style 'triangle) (define plot-window% - (class100 mred:frame% (name width height) + (class100 frame% (name width height) (private-field - [bitmap (make-object mred:bitmap% width height #t)]) + [bitmap (make-bitmap width height)]) (inherit show) (private-field - [memory-dc (make-object mred:bitmap-dc%)] - [pl (make-object mred:point% 0 0)] - [pr (make-object mred:point% 0 0)] - [ph (make-object mred:point% 0 0)] + [memory-dc (make-object bitmap-dc%)] + [pl (make-object point% 0 0)] + [pr (make-object point% 0 0)] + [ph (make-object point% 0 0)] [points (list pl pr ph)]) (public [get-canvas @@ -103,20 +102,21 @@ (sequence (send memory-dc set-bitmap bitmap) (send memory-dc clear) + (send memory-dc set-smoothing 'aligned) (super-init name #f width height)) (public [on-menu-command (lambda (op) (turtles #f))]) (private-field - [menu-bar (make-object mred:menu-bar% this)] - [file-menu (make-object mred:menu% "File" menu-bar)]) + [menu-bar (make-object menu-bar% this)] + [file-menu (make-object menu% "File" menu-bar)]) (sequence - (make-object mred:menu-item% + (make-object menu-item% "Print" file-menu (lambda (_1 _2) (print))) - (make-object mred:menu-item% + (make-object menu-item% "Close" file-menu (lambda (_1 _2) @@ -128,8 +128,8 @@ (send bitmap save-file fn type))]) (private-field - [canvas% - (class100 mred:canvas% args + [t-canvas% + (class100 canvas% args (inherit get-dc) (override [on-paint @@ -139,7 +139,7 @@ (send dc draw-bitmap (send memory-dc get-bitmap) 0 0) (flip-icons)))]) (sequence (apply super-init args)))] - [canvas (make-object canvas% this)] + [canvas (make-object t-canvas% this)] [dc (send canvas get-dc)]) (public @@ -159,7 +159,7 @@ (send this clear)))) (define turtle-window-size - (let-values ([(w h) (mred:get-display-size)] + (let-values ([(w h) (get-display-size)] [(user/client-offset) 65] [(default-size) 800]) (min default-size @@ -449,7 +449,7 @@ ;; used to test printing (define (display-lines-in-drawing) (let* ([lines-in-drawing-canvas% - (class100 mred:canvas% (frame) + (class100 canvas% (frame) (inherit get-dc) (override [on-paint @@ -457,30 +457,30 @@ (draw-lines-into-dc (get-dc)))]) (sequence (super-init frame)))] - [frame (make-object mred:frame% "Lines in Drawing")] + [frame (make-object frame% "Lines in Drawing")] [canvas (make-object lines-in-drawing-canvas% frame)]) (send frame show #t))) (define (print) (case (system-type) - [(macos macosx windows) - (let ([dc (make-object mred:printer-dc%)]) + [(macosx windows) + (let ([dc (make-object printer-dc%)]) (send dc start-doc "Turtles") (send dc start-page) (draw-lines-into-dc dc) (send dc end-page) (send dc end-doc))] [(unix) - (let ([dc (make-object mred:post-script-dc%)]) + (let ([dc (make-object post-script-dc%)]) (send dc start-doc "Turtles") (send dc start-page) (draw-lines-into-dc dc) (send dc end-page) (send dc end-doc))] [else - (mred:message-box "Turtles" - "Printing is not supported on this platform")])) + (message-box "Turtles" + "Printing is not supported on this platform")])) (define-syntaxes (split) diff --git a/collects/graphics/value-turtles.rkt b/collects/graphics/value-turtles.rkt index 3af1784142..2f5ba93cd2 100644 --- a/collects/graphics/value-turtles.rkt +++ b/collects/graphics/value-turtles.rkt @@ -5,7 +5,7 @@ (all-except mzlib/list merge) mzlib/struct) - (provide turtles move draw turn turn/radians merge clean) + (provide turtles move draw turn turn/radians merge clean turtles?) ;; a turtle is: ;; - (make-turtle x y theta) @@ -339,6 +339,8 @@ (quotient height 2) 0)])) + (define (turtles? x) (is-a? x turtle-snip%)) + (define (move d tv) (send tv move-op d)) (define (draw d tv) (send tv draw-op d)) (define (turn/radians d tv) (send tv turn-op d))