--* From postmaster%watson.vnet.ibm.com@yktvmv.watson.ibm.com Wed Feb 16 11:59:25 1994 --* Received: from yktvmv.watson.ibm.com by leonardo.watson.ibm.com (AIX 3.2/UCB 5.64/4.03) --* id AA02978; Wed, 16 Feb 1994 11:59:25 -0500 --* X-External-Networks: yes --* Received: from watson.vnet.ibm.com by yktvmv.watson.ibm.com (IBM VM SMTP V2R3) --* with BSMTP id 3353; Wed, 16 Feb 94 12:05:29 EST --* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0" --* id --* for asbugs@watson; Wed, 16 Feb 94 12:05:28 -0500 --* Received: from ganesa.inria.fr by watson.ibm.com (IBM VM SMTP V2R3) with TCP; --* Wed, 16 Feb 94 12:05:09 EST --* Received: by ganesa.inria.fr --* (5.65/IDA-1.2.8) id AA05072; Wed, 16 Feb 1994 18:09:38 +0100 --* Message-Id: <9402161709.AA05072@ganesa.inria.fr> --* To: themos@nag.co.uk, asbugs@watson.ibm.com --* Subject: bug report from A# beta-testers at INRIA Sophia --* Date: Wed, 16 Feb 1994 18:09:37 +0100 --* From: Stephane Dalmas --@ Fixed by: SSD Thu May 11 11:05:03 EDT 1995 --@ Tested by: none --@ Summary: A version of this file now compiles, links, and runs using the current version of the compiler. See the detailed description. This is the first bug report in a series of 3 as indicated in the previous message of Marc Gaetano. -- beginning of shell session ------------- [korrigan@misc/asharp] asharp -v -F x xmandel.as A# version 31.0 for SPARC (debug version) (Warning) The file `xmandel.aso' will now be out of date. Exec: unicl -I/net/safir/asharp/base/suncc/include -c xmandel.c Exec: cc -I/net/safir/asharp/base/suncc/include -I/usr/include -c xmandel.c "xmandel.c", line 1072: void function C19_setMouseColors cannot return value "xmandel.c", line 1072: void type illegal in expression "xmandel.c", line 1292: warning: statement not reached "xmandel.c", line 1351: warning: statement not reached ld in sc sy li pa ma ab ck sb ti gf of pb pl pc po mi Time 15.7s 0 1 3 .9 3 3 1 1 .1 3 51 5 1 0 .1 5 15 .9 % Alloc 8275K 0 1 3 .0 5 3 2 .5 .0 3 66 3 .3 .0 0 8 .0 .0 % Free 2319K 0 .0 .0 .0 21 1 8 2 .0 3 22 1 3 .0 0 15 .0 19 % Store 5991K : 8311K alloc - 2320K free - 0K gc (6584K pool) Source2134L : 8112 lines per minute Exec: unicl -I/net/safir/asharp/base/suncc/include -c asmain.c Exec: cc -I/net/safir/asharp/base/suncc/include -I/usr/include -c asmain.c ld in sc sy li pa ma ab ck sb ti gf of pb pl pc po mi Time 0.5s 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0100 0 % Alloc 3K 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 79 4 15 % Free 0K 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 44 36 18 % Store 5694K : 8313K alloc - 2619K free - 0K gc (6584K pool) Source2134L : 232800 lines per minute Exec: unicl xmandel.o asmain.o -L/net/safir/asharp/base/suncc/lib -o xmandel -laslib -lfoam -lm Exec: cc -I/usr/include -o xmandel xmandel.o asmain.o -L/net/safir/asharp/base/suncc/lib -L/lib -L/usr/lib -L/usr/local/lib -laslib -lfoam -lm ld: xmandel.o: No such file or directory -- end of shell session ------------ -- beginning of xmandel.as --------- ------------------------------------------------------------------------------ -- -- xmandel.as X Windows version of the Mandelbrot set explorer -- ------------------------------------------------------------------------------ #include "aslib" #include "X11" macro { DF == DoubleFloat; CDF == Complex DoubleFloat; Pixel == ULong; } ------------------------------------------------------------------------------ -- -- Workaround for Ref(BuiltinSInt) -- ------------------------------------------------------------------------------ #assert BadRefULong #if BadRefULong import Foreign: with { macro { RefULong == Ref UInt; RefWindow == Ref UInt; } XAllocColorCells: (Display, Colormap, Bool, RefULong, UInt, RefULong, UInt) -> Status; XQueryPointer: (Display, Window, RefWindow, RefWindow, Ref Int, Ref Int, Ref Int, Ref Int, Ref UInt) -> Bool; } #endif ------------------------------------------------------------------------------ -- -- HLS Color values in the HLS color system. -- ------------------------------------------------------------------------------ HLS: with { hls: (DF, DF, DF) -> %; hue: % -> DF; lightness: % -> DF; saturation: % -> DF; setHLSValues: (%, DF, DF, DF) -> %; setHLSColors!: (XColor, %) -> (); setHLSColors!: (XColor, DF, DF, DF) -> (); } == add { Rep ==> Record(hue: DF, lightness: DF, saturation: DF); import Rep; hls (h: DF, l: DF, s: DF) : % == per [h, l, s]; hue (hls: %): DF == rep(hls).hue; lightness (hls: %): DF == rep(hls).lightness; saturation (hls: %): DF == rep(hls).saturation; setHLSValues (hls: %, h: DF, l:DF, s: DF) : % == { rep(hls).hue := h; rep(hls).lightness := l; rep(hls).saturation := s; hls } setHLSColors! (c: XColor, hls: %) : () == setHLSColors!(c, hue hls, lightness hls, saturation hls); setHLSColors! (c: XColor, h: DF, l: DF, s: DF) : () == { (r: UShort, g: UShort, b: UShort) := hlsToRgb(h, l, s); setColors!(c, r, g, b); } hlsToRgb (h: DF, l: DF, s: DF) : Cross(UShort, UShort, UShort) == { local r, g, b: UShort; local m1, m2: DF; m2 := if l <= 0.5 then l * (1.0 + s) else l + s - l * s; m1 := 2.0*l - m2; r := hlsScale hlsValue(m1, m2, h + 120.0); g := hlsScale hlsValue(m1, m2, h); b := hlsScale hlsValue(m1, m2, h - 120.0); (r, g, b) } coerce (d: DF) : UShort == retract(round d)$Integer :: UShort; hlsScale (d: DF) : UShort == { local FFFF: Int == (2 << 16) - 1; (FFFF::DF * d)::UShort; } hlsValue(n1: DF, n2: DF, hue:DF): DF == { if hue > 360.0 then hue := hue - 360.0; if hue < 0.0 then hue := hue + 360.0; hue < 60.0 => (n1 + (n2 - n1) * hue / 60.0); hue < 180.0 => n2; hue < 240.0 => (n1 + (n2 - n1) * (240.0 - hue) / 60.0); n1 } } ------------------------------------------------------------------------------ -- -- xmandel -- ------------------------------------------------------------------------------ import DF; inline { CDF; Display; XEvent; Screen; XSizeHints; XGCValues; Ref(Int); } local { display: Display; -- The X-Windows display structure. screen: Int; -- The X-Windows screen index. colormap: Colormap; -- The X-Windows colormap id. w: Window; -- The X-Windows top-level window. width: UInt; -- The dimensions of the window. height: UInt; gc: GC; -- Graphics contex for drawing pixels. lgc: GC; -- Graphics contex for drawing boxes. savedWindow: Pixmap; -- A backing pixmap for expose events. saved: Bool := false; -- True if window has been saved. c0: CDF; -- co and c1 define the bounding of the c1: CDF; -- region of the set we will display. bandSize: Int := 1; -- Number of colors per iteration. numShades: Int := 100; -- Total colors in colormap. -- Data structures mapping color indices into pixel values. maxColors: Int := 256; planes: PrimitiveArray UInt == new(maxColors); pixVals: PrimitiveArray UInt == new(maxColors); -- Up ahead we have a little local color. color: XColor := XColor(); -- A color function for the initial colors. hls: HLS := hls(0.0, 0.0, 0.0); } coerce(v: PrimitiveArray UInt): Ref(Int) == v pretend Ref(Int); -- Create a top-level window of the given size, and map it. createWindow(width: UInt, height: UInt): Window == { free { display: Display; screen: Int; colormap: Colormap; w: Window; gc, lgc: GC; } local { borderWidth: Int == 4; -- inputMask: ULong == ButtonPressMask \/ ExposureMask -- \/ StructureNotifyMask; inputMask: ULong == coerce((coerce(ButtonPressMask) :: SingleInteger) \/ (coerce(ExposureMask) :: SingleInteger)); sizeHints: XSizeHints == XSizeHints(); values: XGCValues == XGCValues(); } -- Initialize the display. display := XOpenDisplay(""); if not display then print("Cannot connect to the X11 sever.")(); -- Initialize the screen. screen := DefaultScreen(display); -- Initialize the colormap. colormap := DefaultColormap(display, screen); -- Create the window. w := XCreateSimpleWindow(display, RootWindow(display, screen), 0, 0, width, height, borderWidth, BlackPixel(display, screen), WhitePixel(display, screen)); -- Select the input events the window will process. XSelectInput(display, w, inputMask); -- Select the size hints for the window manager. setFlags! (sizeHints, coerce (PPosition \/ PSize \/ PMinSize)); setX! (sizeHints, 0); setY! (sizeHints, 0); setWidth! (sizeHints, width); setHeight! (sizeHints, height); setMinWidth! (sizeHints, 50); setMinHeight! (sizeHints, 50); XSetNormalHints(display, w, sizeHints); -- Create the graphics context for drawing pixels. gc := XCreateGC(display, w, coerce 0, values); XSetLineAttributes(display, gc, 0, LineSolid, CapButt, JoinMiter); -- Create the graphics context for drawing boxes. lgc := XCreateGC(display, w, coerce 0, values); XSetLineAttributes(display, lgc, 0, LineSolid, CapButt, JoinMiter); XSetFunction(display, lgc, GXxor); XSetForeground(display, lgc, WhitePixel(display, screen)); -- Map the window on the display. XMapWindow(display, w); w } -- Allocate read/write color cells for our pallette. allocColorCells(numColors: UInt): () == { status := XAllocColorCells(display, colormap, false, planes::Ref(Int), 0, pixVals::Ref(Int), numColors); if (status = 0) then print("AllocColorCells failed")(); } -- Set the pallette according to the given color function. -- The color function takes a number in the range 0.0..1.0, and -- returns a value in the HLS color system. setPallette(shades: Int, colorFunction: (DF -> HLS)): () == { for i in 1..shades for t: DF in step(shades)(0.0, 1.0) repeat { setHLSColors!(color, colorFunction t); setPixel!(color, pixVals.i::Pixel); XStoreColor(display, colormap, color); } } -- The initial color function for setPallette. rainbowColors(t: DF): HLS == { free { hls: HLS; } import DoubleFloatElementaryFunctions: with { sin: DF -> DF; cos: DF -> DF; } local pi: DF == 3.14159; light: DF := 0.4 + (0.5 - cos (5.0*pi*t)/2.0)/4.0; -- hue: DF := 225.0 + (0.5 + sin (5.0*pi*t)/2.0)*5.0; hue: DF := if t < 0.5 then 240.0 else 30.0; setHLSValues(hls, hue, light, 0.9); hls } -- Set the pallette according to the mouse position. local { ox: Int := -1; oy: Int := -1; } setMouseColors(x: Int,y: Int): () == { free ox, oy: Int; if x = ox and y = oy then return; (ox, oy) := (x, y); setRainbow(x::DF * 360.0 / width::DF, y::DF * 360.0 / height::DF) } local { hue0: DF; delHue: DF; } setRainbow(h0: DF, h1: DF): () == { free hue0, delHue: DF; hue0 := h0; delHue := h1 - h0; setPallette(numShades, mouseRainbow); } -- A color function for setPallette. mouseRainbow(t: DF): HLS == { free hls: HLS; local colorDelta: DF == 0.5; l: DF := 0.4 + t * colorDelta; setHLSValues(hls, hue0 + t*delHue, l, 0.9 - l/2.0); hls } -- Save the screen to a pixmap for later expose events. savePixmap(): () == { free saved: Bool; free savedWindow: Pixmap; savedWindow := XCreatePixmap(display, w, width, height, DisplayPlanes(display, screen)); XCopyArea(display, w, savedWindow, gc, 0, 0, width, height, 0, 0); saved := true; } -- Display the backing pixmap. showPixmap(): () == XCopyArea(display, savedWindow, w, gc, 0, 0, width, height, 0, 0); -- Draw a single point with the n iterations and iters maximum -- iterations at position (i, j) in the top-level window. local gcv: XGCValues := XGCValues(); plotPoint(i: Int, j: Int, iters: Int, n: Int): Int == { color: Int := n mod numShades; pixel: Pixel := BlackPixel(display, screen); if (color > 0) then pixel := pixVals.(color+1)::Pixel; setForeground!(gcv, pixel); XChangeGC(display, gc, coerce GCForeground, gcv); XDrawPoint(display, w, gc, i, j); i } -- Draw a bounding box. drawBox(x0: Int, y0: Int, x1: Int, y1: Int): () == { XDrawLine(display, w, lgc, x0, y0, x1, y0); XDrawLine(display, w, lgc, x1, y0, x1, y1); XDrawLine(display, w, lgc, x1, y1, x0, y1); XDrawLine(display, w, lgc, x0, y1, x0, y0); } -- Reads and create a bounding zoom box. readZoom(): () == { free { c0, c1: CDF; saved: Bool; } local { newEvent: XEvent == XEvent(); nr0, nr1, ni0, ni1, t: DF; } pw: Ref(Int) := make 0; rx: Ref(Int) := make 0; ry: Ref(Int) := make 0; x : Ref(Int) := make 0; y : Ref(Int) := make 0; kb: Ref(Int) := make 0; XQueryPointer(display, w, pw, pw, rx, ry, x, y, kb); nx: Ref(Int) := make value x; ny: Ref(Int) := make value y; onx: Int := value x; ony: Int := value y; drawBox(value(x), value(y), onx, ony); repeat { if XPending(display) = 0 then { XQueryPointer(display, w, pw, pw, rx, ry, nx, ny, kb); if value(nx) ~= onx or value(ny) ~= ony then { drawBox(value(x), value(y), onx, ony); onx := value(nx); ony := value(ny); drawBox(value(x), value(y), onx, ony); } } else { XNextEvent(display, newEvent); if XEventType(newEvent) ~= ButtonPress then iterate; t := (real(c1) - real(c0)) / width::DF; nr0 := value(x)::DF * t + real(c0); t := (real(c1) - real(c0)) / width::DF; nr1 := value(nx)::DF * t + real(c0); if value(ny) > height then ny := make(height); ni0 := (value(y)::DF * (imag(c1) - imag(c0))) / height::DF + imag(c0); ni1 := (value(ny)::DF * (imag(c1) - imag(c0))) / height::DF + imag(c0); c0 := complex(min(nr0, nr1), min(ni0,ni1)); c1 := complex(max(nr0, nr1), max(ni0,ni1)); saved := false; drawBox(value(x), value(y), value(nx), value(ny)); drawMand(); break } } } readPallete(): () == { local newEvent: XEvent == XEvent(); pw: Ref(Int) := make 0; x : Ref(Int) := make 0; y : Ref(Int) := make 0; rx: Ref(Int) := make 0; ry: Ref(Int) := make 0; kb: Ref(Int) := make 0; XQueryPointer(display, w, pw, pw, rx, ry, x, y, kb); nx: Ref(Int) := make value x; ny: Ref(Int) := make value y; onx: Int := value x; ony: Int := value y; setMouseColors(onx, ony); repeat { if XPending(display) = 0 then { XQueryPointer(display, w, pw, pw, rx, ry, nx, ny, kb); if value(nx) ~= onx or value(ny) ~= ony then { onx := value(nx); ony := value(ny); setMouseColors(onx, ony); } } else { XNextEvent(display, newEvent); if XEventType(newEvent) ~= ButtonPress then iterate; break; } } } -- Handles expose events. Draws the set if it hasn't yet, otherwise -- it displays the backing pixmap. drawMand(): () == { if saved then showPixmap(); else { drawMandSet(real(c0), real(c1), width, imag(c0), imag(c1), height, plotPoint); savePixmap() } } +++ Draw the Mnadelbrot set in the given region. +++ The pixel drawing function is passed as a parameter. macro { MaxIters == 200; Infinity == 0; } drawMandSet(minR: DF, maxR: DF, numR: Int, minI: DF, maxI: DF, numI: Int, drawFun: (Int, Int, Int, Int) -> Int): Int == { mandel(c: CDF): Int == { z: CDF := 0; nc: Int := 0; for n in 1..MaxIters while norm z < 4.0 repeat { z := z*z + c; nc := n; } if nc = MaxIters then nc := Infinity; nc; } for i in step(numI)(minI, maxI) for ic in 0..numI-1 repeat for r in step(numR)(minR, maxR) for rc in 0..numR-1 repeat drawFun(rc, ic, MaxIters, mandel complex(r,i)); MaxIters; } -- Main initialization and event loop. main(): () == { free { width: Int; height: Int; c0: CDF; c1: CDF; saved: Bool; } local event: XEvent == XEvent(); width := 200; height := 200; c0 := complex(-2.1, -1.8); c1 := complex( 1.5, 1.8); createWindow(width, height); allocColorCells(numShades); setPallette(numShades, rainbowColors); repeat { XNextEvent(display, event); if XEventType(event) = Expose then drawMand(); else if XEventType(event) = ConfigureNotify then { cevent == event::XConfigureEvent; if width ~= XConfigureWidth cevent and height ~= XConfigureHeight cevent then { width := XConfigureWidth cevent; height := XConfigureHeight cevent; saved := false; } } else if XEventType(event) = ButtonPress then { xevent == event::XButtonEvent; if XButtonButton xevent = Button1 then readZoom(); else readPallete(); } } } -- When the program starts, it shows a top-level view of -- the Mandelbrot set. To zoom in, click the left mouse -- button on one corner of a bounding box, then click -- again on the other corner, and the box will expand to -- fill the entire window. main(); --- end of xmandel.as ---------- --+ --* From postmaster%watson.vnet.ibm.com@yktvmv.watson.ibm.com Wed Feb 16 11:59:25 1994 --+ --* Received: from yktvmv.watson.ibm.com by leonardo.watson.ibm.com (AIX 3.2/UCB 5.64/4.03) --+ --* id AA02978; Wed, 16 Feb 1994 11:59:25 -0500 --+ --* X-External-Networks: yes --+ --* Received: from watson.vnet.ibm.com by yktvmv.watson.ibm.com (IBM VM SMTP V2R3) --+ --* with BSMTP id 3353; Wed, 16 Feb 94 12:05:29 EST --+ --* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0" --+ --* id --+ --* for asbugs@watson; Wed, 16 Feb 94 12:05:28 -0500 --+ --* Received: from ganesa.inria.fr by watson.ibm.com (IBM VM SMTP V2R3) with TCP; --+ --* Wed, 16 Feb 94 12:05:09 EST --+ --* Received: by ganesa.inria.fr --+ --* (5.65/IDA-1.2.8) id AA05072; Wed, 16 Feb 1994 18:09:38 +0100 --+ --* Message-Id: <9402161709.AA05072@ganesa.inria.fr> --+ --* To: themos@nag.co.uk, asbugs@watson.ibm.com --+ --* Subject: bug report from A# beta-testers at INRIA Sophia --+ --* Date: Wed, 16 Feb 1994 18:09:37 +0100 --+ --* From: Stephane Dalmas --+ --+ --@ Fixed by: --+ --@ Tested by: --+ --@ Summary: --+ --+ --+ -- This is the first bug report in a series of 3 as indicated in the previous --+ -- message of Marc Gaetano. --+ --+ -- SSD: Compile this file using 'asharp -Fx -lasX11 -lX11 xmandel.as' --+ --+ -- beginning of shell session ------------- --+ #if 0 --+ [korrigan@misc/asharp] asharp -v -F x xmandel.as --+ A# version 31.0 for SPARC (debug version) --+ (Warning) The file `xmandel.aso' will now be out of date. --+ Exec: unicl -I/net/safir/asharp/base/suncc/include -c xmandel.c --+ Exec: cc -I/net/safir/asharp/base/suncc/include -I/usr/include -c xmandel.c --+ "xmandel.c", line 1072: void function C19_setMouseColors cannot return value --+ "xmandel.c", line 1072: void type illegal in expression --+ "xmandel.c", line 1292: warning: statement not reached --+ "xmandel.c", line 1351: warning: statement not reached --+ ld in sc sy li pa ma ab ck sb ti gf of pb pl pc po mi --+ Time 15.7s 0 1 3 .9 3 3 1 1 .1 3 51 5 1 0 .1 5 15 .9 % --+ Alloc 8275K 0 1 3 .0 5 3 2 .5 .0 3 66 3 .3 .0 0 8 .0 .0 % --+ Free 2319K 0 .0 .0 .0 21 1 8 2 .0 3 22 1 3 .0 0 15 .0 19 % --+ Store 5991K : 8311K alloc - 2320K free - 0K gc (6584K pool) --+ Source2134L : 8112 lines per minute --+ Exec: unicl -I/net/safir/asharp/base/suncc/include -c asmain.c --+ Exec: cc -I/net/safir/asharp/base/suncc/include -I/usr/include -c asmain.c --+ ld in sc sy li pa ma ab ck sb ti gf of pb pl pc po mi --+ Time 0.5s 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0100 0 % --+ Alloc 3K 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 79 4 15 % --+ Free 0K 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 44 36 18 % --+ Store 5694K : 8313K alloc - 2619K free - 0K gc (6584K pool) --+ Source2134L : 232800 lines per minute --+ Exec: unicl xmandel.o asmain.o -L/net/safir/asharp/base/suncc/lib -o xmandel -laslib -lfoam -lm --+ Exec: cc -I/usr/include -o xmandel xmandel.o asmain.o -L/net/safir/asharp/base/suncc/lib -L/lib -L/usr/lib -L/usr/local/lib -laslib -lfoam -lm --+ ld: xmandel.o: No such file or directory --+ #endif --+ -- end of shell session ------------ --+ --+ -- beginning of xmandel.as --------- --+ ------------------------------------------------------------------------------ --+ -- --+ -- xmandel.as X Windows version of the Mandelbrot set explorer --+ -- --+ ------------------------------------------------------------------------------ --+ --+ #include "aslib" --+ #include "X11" --+ --+ macro { --+ DF == DoubleFloat; --+ CDF == Complex DoubleFloat; --+ Pixel == ULong; --+ Bool == Boolean; --+ } --+ --+ ------------------------------------------------------------------------------ --+ -- --+ -- Workaround for Ref(BuiltinSInt) --+ -- --+ ------------------------------------------------------------------------------ --+ --+ #assert BadRefULong --+ --+ #if BadRefULong --+ import with { --+ macro { --+ RefULong == Ref UInt; --+ RefWindow == Ref UInt; --+ } --+ --+ XAllocColorCells: --+ (Display, Colormap, Bool, RefULong, UInt, RefULong, UInt) --+ -> Status; --+ XQueryPointer: --+ (Display, Window, RefWindow, RefWindow, Ref Int, Ref Int, --+ Ref Int, Ref Int, Ref UInt) -> Bool; --+ } from Foreign; --+ #endif --+ --+ ------------------------------------------------------------------------------ --+ -- --+ -- HLS Color values in the HLS color system. --+ -- --+ ------------------------------------------------------------------------------ --+ --+ HLS: with { --+ hls: (DF, DF, DF) -> %; --+ --+ hue: % -> DF; --+ lightness: % -> DF; --+ saturation: % -> DF; --+ --+ setHLSValues: (%, DF, DF, DF) -> %; --+ --+ setHLSColors!: (XColor, %) -> (); --+ setHLSColors!: (XColor, DF, DF, DF) -> (); --+ } --+ == add { --+ Rep ==> Record(hue: DF, lightness: DF, saturation: DF); --+ --+ import from Rep; --+ --+ hls (h: DF, l: DF, s: DF) : % == per [h, l, s]; --+ --+ hue (hls: %): DF == rep(hls).hue; --+ lightness (hls: %): DF == rep(hls).lightness; --+ saturation (hls: %): DF == rep(hls).saturation; --+ --+ setHLSValues (hls: %, h: DF, l:DF, s: DF) : % == { --+ rep(hls).hue := h; --+ rep(hls).lightness := l; --+ rep(hls).saturation := s; --+ hls --+ } --+ --+ setHLSColors! (c: XColor, hls: %) : () == --+ setHLSColors!(c, hue hls, lightness hls, saturation hls); --+ --+ setHLSColors! (c: XColor, h: DF, l: DF, s: DF) : () == { --+ (r: UShort, g: UShort, b: UShort) := hlsToRgb(h, l, s); --+ setColors!(c, r, g, b); --+ } --+ --+ hlsToRgb (h: DF, l: DF, s: DF) : Cross(UShort, UShort, UShort) == { --+ local r, g, b: UShort; --+ local m1, m2: DF; --+ --+ m2 := if l <= 0.5 then l * (1.0 + s) else l + s - l * s; --+ m1 := 2.0*l - m2; --+ --+ r := hlsScale hlsValue(m1, m2, h + 120.0); --+ g := hlsScale hlsValue(m1, m2, h); --+ b := hlsScale hlsValue(m1, m2, h - 120.0); --+ --+ (r, g, b) --+ } --+ --+ coerce (d: DF) : UShort == --+ retract(round d)$Integer :: UShort; --+ --+ hlsScale (d: DF) : UShort == { --+ local FFFF: Int == shift(2, 16) - 1; --+ (FFFF::DF * d)::UShort; --+ } --+ --+ hlsValue(n1: DF, n2: DF, hue:DF): DF == { --+ if hue > 360.0 then hue := hue - 360.0; --+ if hue < 0.0 then hue := hue + 360.0; --+ hue < 60.0 => (n1 + (n2 - n1) * hue / 60.0); --+ hue < 180.0 => n2; --+ hue < 240.0 => (n1 + (n2 - n1) * (240.0 - hue) / 60.0); --+ n1 --+ } --+ } --+ --+ ------------------------------------------------------------------------------ --+ -- --+ -- xmandel --+ -- --+ ------------------------------------------------------------------------------ --+ --+ import from DF; --+ --+ inline from { --+ CDF; --+ Display; --+ XEvent; --+ Screen; --+ XSizeHints; --+ XGCValues; --+ Ref(Int); --+ } --+ --+ local { --+ display: Display; -- The X-Windows display structure. --+ screen: Int; -- The X-Windows screen index. --+ colormap: Colormap; -- The X-Windows colormap id. --+ w: Window; -- The X-Windows top-level window. --+ --+ width: UInt; -- The dimensions of the window. --+ height: UInt; --+ --+ gc: GC; -- Graphics contex for drawing pixels. --+ lgc: GC; -- Graphics contex for drawing boxes. --+ --+ savedWindow: Pixmap; -- A backing pixmap for expose events. --+ saved: Bool := false; -- True if window has been saved. --+ --+ c0: CDF; -- co and c1 define the bounding of the --+ c1: CDF; -- region of the set we will display. --+ --+ bandSize: Int := 1; -- Number of colors per iteration. --+ numShades: Int := 100; -- Total colors in colormap. --+ --+ -- Data structures mapping color indices into pixel values. --+ maxColors: Int := 256; --+ planes: PrimitiveArray UInt == new(maxColors); --+ pixVals: PrimitiveArray UInt == new(maxColors); --+ --+ -- Up ahead we have a little local color. --+ color: XColor := XColor(); --+ --+ -- A color function for the initial colors. --+ hls: HLS := hls(0.0, 0.0, 0.0); --+ } --+ --+ coerce(v: PrimitiveArray UInt): Ref(Int) == v pretend Ref(Int); --+ --+ -- Create a top-level window of the given size, and map it. --+ --+ createWindow(width: UInt, height: UInt): Window == { --+ free { --+ display: Display; --+ screen: Int; --+ colormap: Colormap; --+ w: Window; --+ gc, lgc: GC; --+ } --+ local { --+ borderWidth: Int == 4; --+ -- inputMask: ULong == ButtonPressMask \/ ExposureMask --+ -- \/ StructureNotifyMask; --+ inputMask: ULong == coerce((coerce(ButtonPressMask) :: SingleInteger) \/ --+ (coerce(ExposureMask) :: SingleInteger)); --+ sizeHints: XSizeHints == XSizeHints(); --+ values: XGCValues == XGCValues(); --+ } --+ --+ -- Initialize the display. --+ display := XOpenDisplay(""); --+ if not display then --+ print("Cannot connect to the X11 sever.")(); --+ --+ -- Initialize the screen. --+ screen := DefaultScreen(display); --+ --+ -- Initialize the colormap. --+ colormap := DefaultColormap(display, screen); --+ --+ -- Create the window. --+ w := XCreateSimpleWindow(display, RootWindow(display, screen), --+ 0, 0, width, height, borderWidth, --+ BlackPixel(display, screen), --+ WhitePixel(display, screen)); --+ --+ -- Select the input events the window will process. --+ XSelectInput(display, w, inputMask); --+ --+ -- Select the size hints for the window manager. --+ setFlags! (sizeHints, PPosition \/ PSize \/ PMinSize); --+ setX! (sizeHints, 0); --+ setY! (sizeHints, 0); --+ setWidth! (sizeHints, width); --+ setHeight! (sizeHints, height); --+ setMinWidth! (sizeHints, 50); --+ setMinHeight! (sizeHints, 50); --+ XSetNormalHints(display, w, sizeHints); --+ --+ -- Create the graphics context for drawing pixels. --+ gc := XCreateGC(display, w, coerce 0, values); --+ XSetLineAttributes(display, gc, 0, LineSolid, CapButt, JoinMiter); --+ --+ -- Create the graphics context for drawing boxes. --+ lgc := XCreateGC(display, w, coerce 0, values); --+ XSetLineAttributes(display, lgc, 0, LineSolid, CapButt, JoinMiter); --+ XSetFunction(display, lgc, GXxor); --+ XSetForeground(display, lgc, WhitePixel(display, screen)); --+ --+ -- Map the window on the display. --+ XMapWindow(display, w); --+ w --+ } --+ --+ -- Allocate read/write color cells for our pallette. --+ --+ allocColorCells(numColors: UInt): () == { --+ status := XAllocColorCells(display, colormap, false, --+ planes::Ref(Int), 0, pixVals::Ref(Int), numColors); --+ if (status = 0) then --+ print("AllocColorCells failed")(); --+ } --+ --+ -- Set the pallette according to the given color function. --+ -- The color function takes a number in the range 0.0..1.0, and --+ -- returns a value in the HLS color system. --+ --+ setPallette(shades: Int, colorFunction: (DF -> HLS)): () == { --+ for i in 1..shades for t: DF in step(shades)(0.0, 1.0) repeat { --+ setHLSColors!(color, colorFunction t); --+ setPixel!(color, pixVals.i::Pixel); --+ XStoreColor(display, colormap, color); --+ } --+ } --+ --+ -- The initial color function for setPallette. --+ --+ rainbowColors(t: DF): HLS == { --+ free { --+ hls: HLS; --+ } --+ import { --+ sin: DF -> DF; --+ cos: DF -> DF; --+ } from DoubleFloatElementaryFunctions; --+ local pi: DF == 3.14159; --+ --+ light: DF := 0.4 + (0.5 - cos (5.0*pi*t)/2.0)/4.0; --+ -- hue: DF := 225.0 + (0.5 + sin (5.0*pi*t)/2.0)*5.0; --+ hue: DF := if t < 0.5 then 240.0 else 30.0; --+ setHLSValues(hls, hue, light, 0.9); --+ --+ hls --+ } --+ --+ -- Set the pallette according to the mouse position. --+ --+ local { --+ ox: Int := -1; --+ oy: Int := -1; --+ } --+ --+ setMouseColors(x: Int,y: Int): () == { --+ free ox, oy: Int; --+ --+ if x = ox and y = oy then return; --+ (ox, oy) := (x, y); --+ setRainbow(x::DF * 360.0 / width::DF, --+ y::DF * 360.0 / height::DF) --+ } --+ --+ local { --+ hue0: DF; --+ delHue: DF; --+ } --+ --+ setRainbow(h0: DF, h1: DF): () == { --+ free hue0, delHue: DF; --+ --+ hue0 := h0; --+ delHue := h1 - h0; --+ setPallette(numShades, mouseRainbow); --+ } --+ --+ -- A color function for setPallette. --+ --+ mouseRainbow(t: DF): HLS == { --+ free hls: HLS; --+ local colorDelta: DF == 0.5; --+ --+ l: DF := 0.4 + t * colorDelta; --+ setHLSValues(hls, hue0 + t*delHue, l, 0.9 - l/2.0); --+ hls --+ } --+ --+ -- Save the screen to a pixmap for later expose events. --+ --+ savePixmap(): () == { --+ free saved: Bool; --+ free savedWindow: Pixmap; --+ savedWindow := XCreatePixmap(display, w, width, height, --+ DisplayPlanes(display, screen)); --+ XCopyArea(display, w, savedWindow, gc, 0, 0, width, height, 0, 0); --+ saved := true; --+ } --+ --+ -- Display the backing pixmap. --+ --+ showPixmap(): () == --+ XCopyArea(display, savedWindow, w, gc, 0, 0, width, height, 0, 0); --+ --+ --+ -- Draw a single point with the n iterations and iters maximum --+ -- iterations at position (i, j) in the top-level window. --+ --+ local gcv: XGCValues := XGCValues(); --+ --+ plotPoint(i: Int, j: Int, iters: Int, n: Int): Int == { --+ color: Int := n mod numShades; --+ pixel: Pixel := BlackPixel(display, screen); --+ if (color > 0) then --+ pixel := pixVals.(color+1)::Pixel; --+ setForeground!(gcv, pixel); --+ XChangeGC(display, gc, GCForeground, gcv); --+ XDrawPoint(display, w, gc, i, j); --+ i --+ } --+ --+ -- Draw a bounding box. --+ --+ drawBox(x0: Int, y0: Int, x1: Int, y1: Int): () == { --+ XDrawLine(display, w, lgc, x0, y0, x1, y0); --+ XDrawLine(display, w, lgc, x1, y0, x1, y1); --+ XDrawLine(display, w, lgc, x1, y1, x0, y1); --+ XDrawLine(display, w, lgc, x0, y1, x0, y0); --+ } --+ --+ -- Reads and create a bounding zoom box. --+ --+ readZoom(): () == { --+ free { --+ c0, c1: CDF; --+ saved: Bool; --+ } --+ local { --+ newEvent: XEvent == XEvent(); --+ (nr0, nr1, ni0, ni1, t): DF; --+ } --+ --+ pw: Ref(Int) := make 0; --+ rx: Ref(Int) := make 0; --+ ry: Ref(Int) := make 0; --+ x : Ref(Int) := make 0; --+ y : Ref(Int) := make 0; --+ kb: Ref(Int) := make 0; --+ --+ XQueryPointer(display, w, pw, pw, rx, ry, x, y, kb); --+ --+ nx: Ref(Int) := make value x; --+ ny: Ref(Int) := make value y; --+ onx: Int := value x; --+ ony: Int := value y; --+ --+ drawBox(value(x), value(y), onx, ony); --+ --+ repeat { --+ if XPending(display) = 0 then { --+ XQueryPointer(display, w, pw, pw, --+ rx, ry, nx, ny, kb); --+ if value(nx) ~= onx or value(ny) ~= ony then { --+ drawBox(value(x), value(y), onx, ony); --+ onx := value(nx); --+ ony := value(ny); --+ drawBox(value(x), value(y), onx, ony); --+ } --+ } --+ else { --+ XNextEvent(display, newEvent); --+ if XEventType(newEvent) ~= ButtonPress then iterate; --+ t := (real(c1) - real(c0)) / width::DF; --+ nr0 := value(x)::DF * t + real(c0); --+ t := (real(c1) - real(c0)) / width::DF; --+ nr1 := value(nx)::DF * t + real(c0); --+ --+ if value(ny) > height then ny := make(height); --+ ni0 := (value(y)::DF * (imag(c1) - imag(c0))) / --+ height::DF + imag(c0); --+ ni1 := (value(ny)::DF * (imag(c1) - imag(c0))) / --+ height::DF + imag(c0); --+ c0 := complex(min(nr0, nr1), min(ni0,ni1)); --+ c1 := complex(max(nr0, nr1), max(ni0,ni1)); --+ saved := false; --+ drawBox(value(x), value(y), value(nx), value(ny)); --+ drawMand(); --+ break --+ } --+ } --+ } --+ --+ readPallete(): () == { --+ local newEvent: XEvent == XEvent(); --+ --+ pw: Ref(Int) := make 0; --+ x : Ref(Int) := make 0; --+ y : Ref(Int) := make 0; --+ rx: Ref(Int) := make 0; --+ ry: Ref(Int) := make 0; --+ kb: Ref(Int) := make 0; --+ --+ XQueryPointer(display, w, pw, pw, rx, ry, x, y, kb); --+ --+ nx: Ref(Int) := make value x; --+ ny: Ref(Int) := make value y; --+ onx: Int := value x; --+ ony: Int := value y; --+ --+ setMouseColors(onx, ony); --+ --+ repeat { --+ if XPending(display) = 0 then { --+ XQueryPointer(display, w, pw, pw, --+ rx, ry, nx, ny, kb); --+ if value(nx) ~= onx or value(ny) ~= ony then { --+ onx := value(nx); --+ ony := value(ny); --+ setMouseColors(onx, ony); --+ } --+ } --+ else { --+ XNextEvent(display, newEvent); --+ if XEventType(newEvent) ~= ButtonPress then iterate; --+ break; --+ } --+ } --+ } --+ --+ -- Handles expose events. Draws the set if it hasn't yet, otherwise --+ -- it displays the backing pixmap. --+ --+ drawMand(): () == { --+ if saved then --+ showPixmap(); --+ else { --+ drawMandSet(real(c0), real(c1), width, imag(c0), imag(c1), --+ height, plotPoint); --+ savePixmap() --+ } --+ } --+ --+ +++ Draw the Mnadelbrot set in the given region. --+ +++ The pixel drawing function is passed as a parameter. --+ --+ macro { --+ MaxIters == 200; --+ Infinity == 0; --+ } --+ --+ drawMandSet(minR: DF, maxR: DF, numR: Int, --+ minI: DF, maxI: DF, numI: Int, --+ drawFun: (Int, Int, Int, Int) -> Int): Int == { --+ mandel(c: CDF): Int == { --+ z: CDF := 0; --+ nc: Int := 0; --+ --+ for n in 1..MaxIters while norm z < 4.0 repeat { --+ z := z*z + c; --+ nc := n; --+ } --+ if nc = MaxIters then nc := Infinity; --+ nc; --+ } --+ --+ for i in step(numI)(minI, maxI) for ic in 0..numI-1 repeat --+ for r in step(numR)(minR, maxR) for rc in 0..numR-1 repeat --+ drawFun(rc, ic, MaxIters, mandel complex(r,i)); --+ --+ MaxIters; --+ } --+ --+ -- Main initialization and event loop. --+ --+ main(): () == { --+ free { --+ width: Int; --+ height: Int; --+ c0: CDF; --+ c1: CDF; --+ saved: Bool; --+ } --+ local event: XEvent == XEvent(); --+ --+ width := 200; --+ height := 200; --+ c0 := complex(-2.1, -1.8); --+ c1 := complex( 1.5, 1.8); --+ createWindow(width, height); --+ allocColorCells(numShades); --+ setPallette(numShades, rainbowColors); --+ --+ repeat { --+ XNextEvent(display, event); --+ --+ if XEventType(event) = Expose then --+ drawMand(); --+ --+ else if XEventType(event) = ConfigureNotify then { --+ cevent == event::XConfigureEvent; --+ --+ if width ~= XConfigureWidth cevent --+ and height ~= XConfigureHeight cevent --+ then { --+ width := XConfigureWidth cevent; --+ height := XConfigureHeight cevent; --+ saved := false; --+ } --+ } --+ else if XEventType(event) = ButtonPress then { --+ xevent == event::XButtonEvent; --+ if XButtonButton xevent = Button1 then --+ readZoom(); --+ else --+ readPallete(); --+ } --+ } --+ } --+ --+ -- When the program starts, it shows a top-level view of --+ -- the Mandelbrot set. To zoom in, click the left mouse --+ -- button on one corner of a bounding box, then click --+ -- again on the other corner, and the box will expand to --+ -- fill the entire window. --+ --+ main(); --+ --- end of xmandel.as ----------