Algorithms |
|
Graphics |
|
Draw a dragon curve
The output of this program is shown here.
$ include "seed7_05.s7i"; include "float.s7i"; include "math.s7i"; include "draw.s7i"; include "keybd.s7i"; var float: angle is 0.0; var integer: x is 220; var integer: y is 220; const proc: turn (in integer: degrees) is func begin angle +:= flt(degrees) * PI / 180.0 end func; const proc: forward (in float: length) is func local var integer: x2 is 0; var integer: y2 is 0; begin x2 := x + trunc(cos(angle) * length); y2 := y + trunc(sin(angle) * length); lineTo(x, y, x2, y2, black); x := x2; y := y2; end func; const proc: dragon (in float: length, in integer: split, in integer: direct) is func begin if split = 0 then forward(length); else turn(direct * 45); dragon(length/1.4142136, pred(split), 1); turn(-direct * 90); dragon(length/1.4142136, pred(split), -1); turn(direct * 45); end if; end func; const proc: main is func begin screen(976, 654); clear(curr_win, white); KEYBOARD := GRAPH_KEYBOARD; dragon(768.0, 14, 1); ignore(getc(KEYBOARD)); end func;
Display the bifurcation diagram
The output of this program is shown here.
$ include "seed7_05.s7i"; include "float.s7i"; include "draw.s7i"; include "keybd.s7i"; const integer: DRAW_START is 100; const integer: DRAW_END is 200; const float: G_MIN is 0.0; const float: G_MAX is 4.0; const float: KRES is (G_MAX - G_MIN) / 1000.0; const float: XSTART is 0.5; const proc: bifurk is func local var float: k is 0.0; var float: x is 0.0; var integer: i is 0; var integer: xPos is 0; begin k := G_MIN; while k < G_MAX do x := XSTART; for i range 0 to pred(DRAW_START) do x := k * x * (1.0 - x); end for; xPos := round(k * 250.0); for i range DRAW_START to DRAW_END do x := k * x * (1.0 - x); point(xPos, round(x * 700.0), black); end for; k +:= KRES; end while; end func; const proc: main is func begin screen(1024, 768); clear(curr_win, white); KEYBOARD := GRAPH_KEYBOARD; bifurk; flushGraphic; ignore(getc(KEYBOARD)); end func;
Simulate a one-dimensional cellular automaton
This program simulates one-dimensional cellular automata, with two possible states per cell. The output of this program is shown here.
$ include "seed7_05.s7i"; include "float.s7i"; include "draw.s7i"; include "keybd.s7i"; const type: generationType is array boolean; const func generationType: nextGeneration (in bitset: rule, in generationType: currGeneration) is func result var generationType: nextGeneration is 0 times FALSE; local var integer: index is 0; var integer: pattern is 0; begin nextGeneration := length(currGeneration) times FALSE; for index range 2 to pred(length(currGeneration)) do pattern := ord(currGeneration[pred(index)]) * 4 + ord(currGeneration[index]) * 2 + ord(currGeneration[succ(index)]); nextGeneration[index] := pattern in rule; end for; end func; const proc: drawGeneration (in integer: generationNumber, in generationType: currentGeneration) is func local var integer: index is 0; begin for index range 1 to length(currentGeneration) do if currentGeneration[index] then point(index, generationNumber, black); end if; end for; end func; const proc: main is func local const bitset: rule30 is bitset conv 30; const bitset: rule110 is bitset conv 110; var text: win is STD_NULL; var integer: generationNumber is 0; var generationType: currentGeneration is 0 times FALSE; begin screen(1024, 768); clear(white); KEYBOARD := GRAPH_KEYBOARD; win := open(curr_win); currentGeneration := 1024 times FALSE; currentGeneration[512] := TRUE; drawGeneration(generationNumber, currentGeneration); for generationNumber range 1 to 500 do currentGeneration := nextGeneration(rule30, currentGeneration); drawGeneration(generationNumber, currentGeneration); end for; flushGraphic; readln(KEYBOARD); end func;
Draw a fractal tree
The output of this program is shown here.
$ include "seed7_05.s7i"; include "float.s7i"; include "math.s7i"; include "draw.s7i"; include "keybd.s7i"; const float: DEG_TO_RAD is PI / 180.0; const proc: drawTree (in integer: x1, in integer: y1, in float: angle, in integer: depth) is func local var integer: x2 is 0; var integer: y2 is 0; begin if depth <> 0 then x2 := x1 + trunc(cos(angle * DEG_TO_RAD) * flt(depth * 10)); y2 := y1 + trunc(sin(angle * DEG_TO_RAD) * flt(depth * 10)); lineTo(x1, y1, x2, y2, white); drawTree(x2, y2, angle - 20.0, depth - 1); drawTree(x2, y2, angle + 20.0, depth - 1); end if; end func; const proc: main is func begin screen(600, 500); clear(curr_win, black); KEYBOARD := GRAPH_KEYBOARD; drawTree(300, 470, -90.0, 9); ignore(getc(KEYBOARD)); end func;
Display a sierpinski triangle
The output of this program is shown here.
$ include "seed7_05.s7i"; include "draw.s7i"; include "keybd.s7i"; include "bin64.s7i"; const proc: main is func local const integer: order is 8; const integer: width is 1 << order; const integer: margin is 10; var integer: x is 0; var integer: y is 0; begin screen(width + 2 * margin, width + 2 * margin); clear(curr_win, white); KEYBOARD := GRAPH_KEYBOARD; for y range 0 to pred(width) do for x range 0 to pred(width) do if bin64(x) & bin64(y) = bin64(0) then point(margin + x, margin + y, black); end if; end for; end for; ignore(getc(KEYBOARD)); end func;
Display a voronoi diagram
In a Voronoi diagram space is divided into a number of regions. A set of seed points is given and all points closer to a seed point than to any other belong to a region. The voronoi program below uses random seed points in a 2 dimensional area. A sample output of the program is shown here.
$ include "seed7_05.s7i"; include "draw.s7i"; include "keybd.s7i"; const type: point is new struct var integer: xPos is 0; var integer: yPos is 0; var color: col is black; end struct; const proc: generateVoronoiDiagram (in integer: width, in integer: height, in integer: numCells) is func local var array point: points is 0 times point.value; var integer: index is 0; var integer: x is 0; var integer: y is 0; var integer: distSquare is 0; var integer: minDistSquare is 0; var integer: indexOfNearest is 0; begin screen(width, height); points := numCells times point.value; for index range 1 to numCells do points[index].xPos := rand(0, width); points[index].yPos := rand(0, height); points[index].col := color(rand(0, 65535), rand(0, 65535), rand(0, 65535)); end for; for y range 0 to height do for x range 0 to width do minDistSquare := width ** 2 + height ** 2; for index range 1 to numCells do distSquare := (points[index].xPos - x) ** 2 + (points[index].yPos - y) ** 2; if distSquare < minDistSquare then minDistSquare := distSquare; indexOfNearest := index; end if; end for; point(x, y, points[indexOfNearest].col); end for; end for; for index range 1 to numCells do line(points[index].xPos - 2, points[index].yPos, 4, 0, black); line(points[index].xPos, points[index].yPos - 2, 0, 4, black); end for; end func; const proc: main is func begin generateVoronoiDiagram(500, 500, 25); KEYBOARD := GRAPH_KEYBOARD; readln(KEYBOARD); end func;
Display the Mandelbrot set
A mandelbrot program which is able to zoom can be found here.
$ include "seed7_05.s7i"; include "float.s7i"; include "complex.s7i"; include "draw.s7i"; include "keybd.s7i"; # Display the Mandelbrot set, that are points z[0] in the complex plane # for which the sequence z[n+1] := z[n] ** 2 + z[0] (n >= 0) is bounded. # Since this program is computing intensive it should be compiled with # s7c -O2 mandelbr const integer: pix is 200; const integer: max_iter is 256; var array color: colorTable is max_iter times black; const func integer: iterate (in complex: z0) is func result var integer: iter is 1; local var complex: z is complex.value; begin z := z0; while sqrAbs(z) < 4.0 and # not diverged iter < max_iter do # not converged z *:= z; z +:= z0; incr(iter); end while; end func; const proc: displayMandelbrotSet (in complex: center, in float: zoom) is func local var integer: x is 0; var integer: y is 0; var complex: z0 is complex.value; begin for x range -pix to pix do for y range -pix to pix do z0 := center + complex(flt(x) * zoom, flt(y) * zoom); point(x + pix, y + pix, colorTable[iterate(z0)]); end for; end for; end func; const proc: main is func local const integer: num_pix is 2 * pix + 1; var integer: col is 0; begin screen(num_pix, num_pix); clear(curr_win, black); KEYBOARD := GRAPH_KEYBOARD; for col range 1 to pred(max_iter) do colorTable[col] := color(65535 - (col * 5003) mod 65535, (col * 257) mod 65535, (col * 2609) mod 65535); end for; displayMandelbrotSet(complex(-0.75, 0.0), 1.3 / flt(pix)); flushGraphic; readln(KEYBOARD); end func;
Display a brownian tree
A Brownian tree is built with these steps:
- A seed particle is placed somewhere on the window.
- Another particle is placed in a random position on the window, and moved randomly until it bumps against the seed. The particle is left there.
- Another particle is placed in a random position and moved until it bumps against the seed or any previous particle, and so on.
The output of the program below is shown here.
$ include "seed7_05.s7i"; include "draw.s7i"; include "keybd.s7i"; const integer: SIZE is 300; const integer: SCALE is 1; const proc: genBrownianTree (in integer: fieldSize, in integer: numParticles) is func local var array array integer: world is 0 times 0 times 0; var integer: px is 0; var integer: py is 0; var integer: dx is 0; var integer: dy is 0; var integer: i is 0; var boolean: bumped is FALSE; begin world := fieldSize times fieldSize times 0; world[rand(1, fieldSize)][rand(1, fieldSize)] := 1; # Set the seed for i range 1 to numParticles do # Set particle's initial position px := rand(1, fieldSize); py := rand(1, fieldSize); bumped := FALSE; repeat # Randomly choose a direction dx := rand(-1, 1); dy := rand(-1, 1); if dx + px < 1 or dx + px > fieldSize or dy + py < 1 or dy + py > fieldSize then # Plop the particle into some other random location px := rand(1, fieldSize); py := rand(1, fieldSize); elsif world[py + dy][px + dx] <> 0 then # Bumped into something world[py][px] := 1; rect(SCALE * pred(px), SCALE * pred(py), SCALE, SCALE, white); flushGraphic; bumped := TRUE; else py +:= dy; px +:= dx; end if; until bumped; end for; end func; const proc: main is func begin screen(SIZE * SCALE, SIZE * SCALE); KEYBOARD := GRAPH_KEYBOARD; genBrownianTree(SIZE, 20000); readln(KEYBOARD); end func;
Read a bitmap file into a pixmap
The function below reads the most common BMP file format. A more general version of readBmp is defined in the "bmp.s7i" library.
const func PRIMITIVE_WINDOW: readBmp (in string: file_name) is func result var PRIMITIVE_WINDOW: image is PRIMITIVE_WINDOW.value; local var file: bmp_file is STD_NULL; var string: stri is ""; var integer: size is 0; var integer: offset is 0; var integer: width is 0; var integer: height is 0; var integer: planes is 0; var integer: bits is 0; var integer: padding is 0; var integer: line is 0; var integer: column is 0; begin bmp_file := open(file_name, "r"); if bmp_file <> STD_NULL then stri := gets(bmp_file, 2); if stri = "BM" then size := getUInt32Le(bmp_file); stri := gets(bmp_file, 4); (* reserved1, reserved2 *) offset := getUInt32Le(bmp_file); stri := gets(bmp_file, 4); (* header size *) width := getUInt32Le(bmp_file); height := getUInt32Le(bmp_file); planes := getUInt16Le(bmp_file); bits := getUInt16Le(bmp_file); stri := gets(bmp_file, 26); padding := -(3 * width) mod 4; image := newPixmap(width, height); seek(bmp_file, offset + 1); for line range pred(height) downto 0 do for column range 0 to pred(width) do stri := gets(bmp_file, 3); DRAW_PPOINT(image, column, line, rgbPixel(ord(stri[3]) * 256, ord(stri[2]) * 256, ord(stri[1]) * 256)); end for; ignore(gets(bmp_file, padding)); end for; end if; close(bmp_file); end if; end func;
|
|