Seed7 - The extensible programming language
Seed7 FAQ Manual Screenshots Examples Libraries Algorithms Download Links
Algorithms Sorting Searching Date & Time String Float Mathematics Message digest Graphics File Puzzles Others
Algorithms
Graphics
 previous   up   next 

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;
    DRAW_FLUSH;
    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;
    DRAW_FLUSH;
    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";

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 bitset conv x & bitset conv y = bitset.value 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));
    DRAW_FLUSH;
    readln(KEYBOARD);
  end func;

Display a brownian tree

A Brownian tree is built with these steps:

  1. A seed particle is placed somewhere on the window.
  2. 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.
  3. 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);
          DRAW_FLUSH;
          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

This function is part of the "draw.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 :=   get_uint32_le(bmp_file);
        stri :=   gets(bmp_file, 4);        (* reserved1, reserved2 *)
        offset := get_uint32_le(bmp_file);
        stri :=   gets(bmp_file, 4);        (* header size *)
        width :=  get_uint32_le(bmp_file);
        height := get_uint32_le(bmp_file);
        planes := get_uint16_le(bmp_file);
        bits :=   get_uint16_le(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;

 previous   up   next