Turbo Pascal sample programs

WELCOME.PAS

The program the IDE opens with: asks for your name, then prints a table of factorials.

Demonstrates: ReadLn input, recursive functions, for loops, Crt text colors · 38 lines

Open in the IDE ›

program Welcome;
uses Crt;
var
  name: string;
  i, fact: integer;

function Factorial(n: integer): integer;
begin
  if n <= 1 then
    Factorial := 1
  else
    Factorial := n * Factorial(n - 1);
end;

begin
  ClrScr;
  TextColor(Yellow);
  WriteLn('Turbo Pascal Online IDE');
  TextColor(LightGray);
  WriteLn('------------------------');
  WriteLn;

  Write('What is your name? ');
  ReadLn(name);
  WriteLn('Hello, ', name, '! Welcome back to 1992.');
  WriteLn;

  for i := 1 to 6 do
  begin
    fact := Factorial(i);
    WriteLn(i, '! = ', fact);
  end;

  WriteLn;
  TextColor(LightCyan);
  WriteLn('Press any key to exit...');
  ReadKey;
end.

HELLO.PAS

The smallest complete Turbo Pascal program there is.

Demonstrates: program/begin/end structure, WriteLn · 5 lines

Open in the IDE ›

program Hello;
begin
  WriteLn('Hello, World!');
  ReadLn;
end.

FIBO.PAS

Prints the first ten Fibonacci numbers with an iterative three-variable swap.

Demonstrates: for loops, integer variables, comments · 15 lines

Open in the IDE ›

program Fibo;
{ Prints the first Fibonacci numbers }
var
  a, b, t, i: Integer;
begin
  a := 0;
  b := 1;
  for i := 1 to 10 do
  begin
    WriteLn(a);
    t := a + b;
    a := b;
    b := t;
  end;
end.

STARS.PAS

Clears the screen and draws a small block of asterisks.

Demonstrates: the Crt unit, ClrScr, for loops · 10 lines

Open in the IDE ›

program Stars;
uses Crt;
var
  i: Integer;
begin
  ClrScr;
  for i := 1 to 5 do
    WriteLn('*****');
  WriteLn('Done.');
end.

QSORT.PAS

Classic recursive quicksort with Hoare partitioning over a randomly filled array.

Demonstrates: arrays, recursion, var parameters, Random, procedures · 74 lines

Open in the IDE ›

program QuickSort;
uses Crt;
{ Classic recursive quicksort (Hoare partition) on a random array. }

const
  N = 20;

var
  a: array[1..20] of integer;
  i: integer;

procedure Swap(var x, y: integer);
var
  t: integer;
begin
  t := x;
  x := y;
  y := t;
end;

procedure Sort(lo, hi: integer);
var
  i, j, pivot: integer;
begin
  if lo >= hi then Exit;
  pivot := a[(lo + hi) div 2];
  i := lo;
  j := hi;
  repeat
    while a[i] < pivot do i := i + 1;
    while a[j] > pivot do j := j - 1;
    if i <= j then
    begin
      Swap(a[i], a[j]);
      i := i + 1;
      j := j - 1;
    end;
  until i > j;
  Sort(lo, j);
  Sort(i, hi);
end;

procedure PrintArray(msg: string);
var
  i: integer;
begin
  Write(msg);
  for i := 1 to N do
    Write(a[i]:4);
  WriteLn;
end;

begin
  ClrScr;
  Randomize;
  TextColor(White);
  WriteLn('QuickSort demo');
  WriteLn('--------------');
  TextColor(LightGray);

  for i := 1 to N do
    a[i] := Random(90) + 10;
  PrintArray('Before: ');

  Sort(1, N);

  TextColor(LightGreen);
  PrintArray('After:  ');

  WriteLn;
  TextColor(LightCyan);
  WriteLn('Press any key...');
  ReadKey;
end.

BLOOM.PAS

A Bloom filter -- a probabilistic set that answers "definitely not present" or "probably present" -- built from a boolean bit array and three hash functions, with the false-positive rate measured at the end.

Demonstrates: boolean arrays, string handling, Ord/Copy/Length, real arithmetic · 127 lines

Open in the IDE ›

program BloomFilter;
uses Crt;
{ Bloom filter: a probabilistic set. K hash functions set K bits per
  added word. Lookups answer "definitely not present" or "probably
  present" -- false positives are possible, false negatives are not. }

const
  M = 32;  { filter size in bits }
  K = 3;   { number of hash functions }

var
  bits: array[0..31] of boolean;
  words: array[1..6] of string;
  i, j, fp: integer;
  pct: real;
  w: string;

function Hash(w: string; seed: integer): integer;
var
  i, h: integer;
begin
  h := seed;
  for i := 1 to Length(w) do
    h := (h * 31 + Ord(Copy(w, i, 1))) mod M;
  Hash := h;
end;

procedure AddWord(w: string);
var
  n: integer;
begin
  for n := 1 to K do
    bits[Hash(w, n * 7 + 1)] := true;
end;

function Contains(w: string): boolean;
var
  n: integer;
begin
  for n := 1 to K do
    if not bits[Hash(w, n * 7 + 1)] then Exit(false);
  Contains := true;
end;

procedure ShowBits;
var
  i: integer;
begin
  Write('  [');
  for i := 0 to M - 1 do
    if bits[i] then
    begin
      TextColor(LightGreen);
      Write('#');
    end
    else
    begin
      TextColor(DarkGray);
      Write('.');
    end;
  TextColor(LightGray);
  WriteLn(']');
end;

begin
  ClrScr;
  TextColor(White);
  WriteLn('Bloom filter demo');
  WriteLn('-----------------');
  TextColor(LightGray);
  WriteLn;

  for i := 0 to M - 1 do
    bits[i] := false;

  WriteLn('Adding: pascal, turbo, borland');
  AddWord('pascal');
  AddWord('turbo');
  AddWord('borland');
  ShowBits;
  WriteLn;

  words[1] := 'pascal';
  words[2] := 'turbo';
  words[3] := 'borland';
  words[4] := 'python';
  words[5] := 'java';
  words[6] := 'linux';

  for i := 1 to 6 do
  begin
    Write(words[i]:10, ' -> ');
    if Contains(words[i]) then
    begin
      TextColor(LightGreen);
      WriteLn('probably in the set');
    end
    else
    begin
      TextColor(LightRed);
      WriteLn('definitely not');
    end;
    TextColor(LightGray);
  end;

  WriteLn;
  WriteLn('Testing all 676 two-letter words (none were added):');
  fp := 0;
  for i := 65 to 90 do
    for j := 65 to 90 do
    begin
      w := Chr(i) + Chr(j);
      if Contains(w) then
      begin
        fp := fp + 1;
        if fp <= 8 then Write('  ', w);
      end;
    end;
  WriteLn;
  pct := fp * 100.0 / 676;
  WriteLn(fp, ' false positives (', pct:0:1, '% of lookups for absent words)');

  WriteLn;
  TextColor(LightCyan);
  WriteLn('Press any key...');
  ReadKey;
end.

CUBE.PAS

A rotating 3D wireframe cube. There is no Graph/BGI unit here, so the vertices are projected onto the character grid by hand and the edges drawn with Bresenham -- the way demos did it in text mode.

Demonstrates: real arithmetic, Sin/Cos, arrays of records-worth of state, GotoXY animation · 111 lines

Open in the IDE ›

program Cube;
uses Crt;
{ A rotating 3D wireframe cube, text-mode style. There's no Graph/BGI
  unit here, so "graphics" means projecting 3D points onto the
  character grid by hand: classic demoscene technique. }

const
  Scale = 7.0;
  YSquash = 0.5;
  Dist = 4.0;

var
  vx, vy, vz: array[1..8] of real;
  sx, sy: array[1..8] of integer;
  ea, eb: array[1..12] of integer;
  oldx, oldy: array[1..600] of integer;
  ax, ay, x0, y0, z0, x1, z1, xr, yr, zr, fx, fy: real;
  cx, cy, i, k, j, n, dx, dy, s, px, py, qx, qy, numOld, frame: integer;

begin
  ClrScr;
  cx := 40;
  cy := 12;

  { unit cube vertices }
  vx[1] := -1; vy[1] := -1; vz[1] := -1;
  vx[2] :=  1; vy[2] := -1; vz[2] := -1;
  vx[3] :=  1; vy[3] :=  1; vz[3] := -1;
  vx[4] := -1; vy[4] :=  1; vz[4] := -1;
  vx[5] := -1; vy[5] := -1; vz[5] :=  1;
  vx[6] :=  1; vy[6] := -1; vz[6] :=  1;
  vx[7] :=  1; vy[7] :=  1; vz[7] :=  1;
  vx[8] := -1; vy[8] :=  1; vz[8] :=  1;

  { 12 edges, each a pair of vertex indices }
  ea[1] := 1; eb[1] := 2;   ea[2]  := 2; eb[2]  := 3;
  ea[3] := 3; eb[3] := 4;   ea[4]  := 4; eb[4]  := 1;
  ea[5] := 5; eb[5] := 6;   ea[6]  := 6; eb[6]  := 7;
  ea[7] := 7; eb[7] := 8;   ea[8]  := 8; eb[8]  := 5;
  ea[9] := 1; eb[9] := 5;   ea[10] := 2; eb[10] := 6;
  ea[11] := 3; eb[11] := 7; ea[12] := 4; eb[12] := 8;

  ax := 0.4;
  ay := 0.0;
  numOld := 0;
  frame := 0;
  TextColor(LightCyan);

  while (not KeyPressed) and (frame < 100000) do
  begin
    { erase last frame's pixels }
    for i := 1 to numOld do
    begin
      GotoXY(oldx[i], oldy[i]);
      Write(' ');
    end;
    numOld := 0;

    { rotate + project all 8 vertices }
    for i := 1 to 8 do
    begin
      x0 := vx[i];
      y0 := vy[i];
      z0 := vz[i];

      x1 := x0 * Cos(ay) + z0 * Sin(ay);
      z1 := z0 * Cos(ay) - x0 * Sin(ay);

      yr := y0 * Cos(ax) - z1 * Sin(ax);
      zr := y0 * Sin(ax) + z1 * Cos(ax);
      xr := x1;

      s := Trunc(Scale * Dist / (Dist + zr));
      sx[i] := cx + Trunc(xr * s);
      sy[i] := cy + Trunc(yr * s * YSquash);
    end;

    { draw the 12 edges by stepping along each line }
    for k := 1 to 12 do
    begin
      px := sx[ea[k]];
      py := sy[ea[k]];
      qx := sx[eb[k]];
      qy := sy[eb[k]];
      dx := qx - px;
      dy := qy - py;
      if Abs(dx) > Abs(dy) then n := Abs(dx) else n := Abs(dy);
      if n = 0 then n := 1;
      for j := 0 to n do
      begin
        fx := px + (qx - px) * j / n;
        fy := py + (qy - py) * j / n;
        numOld := numOld + 1;
        oldx[numOld] := Trunc(fx);
        oldy[numOld] := Trunc(fy);
        GotoXY(Trunc(fx), Trunc(fy));
        Write('#');
      end;
    end;

    ay := ay + 0.12;
    ax := ax + 0.05;
    frame := frame + 1;
    Delay(40);
  end;

  GotoXY(1, 24);
  TextColor(LightGray);
  WriteLn('Rotating cube. Press any key to exit...');
  ReadKey;
end.

MANDEL.PAS

The Mandelbrot set rendered as shaded ASCII, each cell colored by how fast that point escapes.

Demonstrates: nested loops, real arithmetic, escape-time iteration, TextColor · 78 lines

Open in the IDE ›

program Mandel;
uses Crt;
{ The Mandelbrot set, rendered as shaded ASCII. Escape-time per
  character cell, colored by how fast each point diverges. }

const
  Cols = 78;
  Rows = 20;
  MaxIter = 20;

var
  px, py, iter: integer;
  x0, y0, x, y, xx, yy, tmp: real;
  ch: char;

begin
  ClrScr;
  for py := 0 to Rows - 1 do
  begin
    GotoXY(1, py + 1);
    for px := 0 to Cols - 1 do
    begin
      x0 := (px / Cols) * 3.2 - 2.3;
      y0 := (py / Rows) * 2.0 - 1.0;
      x := 0;
      y := 0;
      xx := 0;
      yy := 0;
      iter := 0;
      while (xx + yy <= 4.0) and (iter < MaxIter) do
      begin
        tmp := xx - yy + x0;
        y := 2 * x * y + y0;
        x := tmp;
        xx := x * x;
        yy := y * y;
        iter := iter + 1;
      end;

      if iter = MaxIter then
      begin
        ch := ' ';
        TextColor(Black);
      end
      else if iter > 12 then
      begin
        ch := '.';
        TextColor(Blue);
      end
      else if iter > 8 then
      begin
        ch := '*';
        TextColor(Cyan);
      end
      else if iter > 5 then
      begin
        ch := 'o';
        TextColor(LightGreen);
      end
      else if iter > 3 then
      begin
        ch := 'O';
        TextColor(Yellow);
      end
      else
      begin
        ch := '@';
        TextColor(LightRed);
      end;
      Write(ch);
    end;
  end;

  GotoXY(1, Rows + 2);
  TextColor(LightGray);
  WriteLn('Mandelbrot set. Press any key...');
  ReadKey;
end.

FIRE.PAS

The demoscene fire effect: random heat is seeded along the bottom row, then cools and drifts upward each frame. Text mode only offers eight background colors, so the ramp stops at light gray.

Demonstrates: flat arrays as 2D grids, TextBackground, animation loops, KeyPressed · 69 lines

Open in the IDE ›

program Fire;
uses Crt;
{ The classic demoscene fire effect: seed random heat along the
  bottom row, let it cool and drift upward each frame. Text-mode
  backgrounds only give 8 colors, so the ramp is black-red-brown-
  light gray rather than the full black-to-white you'd get in Graph
  mode. }

const
  W = 40;
  H = 12;
  MaxFrames = 800;

var
  heat: array[1..480] of integer;
  x, y, idx, below, left, right, avg, decay: integer;
  frame: integer;

begin
  ClrScr;
  Randomize;
  for idx := 1 to W * H do heat[idx] := 0;

  frame := 0;
  while (not KeyPressed) and (frame < MaxFrames) do
  begin
    for x := 1 to W do
      heat[(H - 1) * W + x] := 8 + Random(8);

    for y := 1 to H - 1 do
      for x := 1 to W do
      begin
        idx := (y - 1) * W + x;
        below := y * W + x;
        if x > 1 then left := below - 1 else left := below;
        if x < W then right := below + 1 else right := below;
        avg := (heat[below] + heat[left] + heat[right]) div 3;
        decay := Random(2);
        if avg - decay < 0 then heat[idx] := 0
        else heat[idx] := avg - decay;
      end;

    for y := 1 to H do
    begin
      GotoXY(21, y);
      for x := 1 to W do
      begin
        idx := (y - 1) * W + x;
        case heat[idx] of
          0: TextBackground(Black);
          1..4: TextBackground(Red);
          5..9: TextBackground(Brown);
        else
          TextBackground(LightGray);
        end;
        Write(' ');
      end;
    end;

    frame := frame + 1;
    Delay(50);
  end;

  TextBackground(Black);
  GotoXY(1, H + 2);
  TextColor(LightGray);
  WriteLn('Fire demo. Press any key...');
  ReadKey;
end.

STARFLD.PAS

Warp-speed starfield -- every star has a random direction and a depth that shrinks each frame.

Demonstrates: arrays of reals, Random, KeyPressed, per-frame redraw · 84 lines

Open in the IDE ›

program Starfield;
uses Crt;
{ Warp-speed starfield: each star has a random direction and a depth
  that shrinks every frame, so it appears to fly past the viewer. }

const
  NumStars = 50;
  Cx = 40;
  Cy = 12;
  MaxFrames = 100000;

var
  dx, dy, ox, oy: array[1..50] of integer;
  z: array[1..50] of real;
  i, px, py, frame: integer;
  ch: char;

begin
  ClrScr;
  Randomize;
  for i := 1 to NumStars do
  begin
    dx[i] := Random(61) - 30;
    if dx[i] = 0 then dx[i] := 1;
    dy[i] := Random(41) - 20;
    if dy[i] = 0 then dy[i] := 1;
    z[i] := 4.0 + Random(300) / 10.0;
    ox[i] := -1;
    oy[i] := -1;
  end;

  frame := 0;
  while (not KeyPressed) and (frame < MaxFrames) do
  begin
    for i := 1 to NumStars do
    begin
      if ox[i] >= 0 then
      begin
        GotoXY(ox[i], oy[i]);
        Write(' ');
      end;

      z[i] := z[i] - 0.15;
      if z[i] <= 0.5 then
      begin
        z[i] := 20.0 + Random(200) / 10.0;
        dx[i] := Random(61) - 30;
        if dx[i] = 0 then dx[i] := 1;
        dy[i] := Random(41) - 20;
        if dy[i] = 0 then dy[i] := 1;
      end;

      px := Cx + Trunc(dx[i] / z[i]);
      py := Cy + Trunc(dy[i] / z[i] / 2.0);

      if (px >= 1) and (px <= 79) and (py >= 1) and (py <= 24) then
      begin
        if z[i] > 12 then ch := '.'
        else if z[i] > 5 then ch := '+'
        else ch := '*';
        if z[i] > 12 then TextColor(DarkGray)
        else if z[i] > 5 then TextColor(LightGray)
        else TextColor(White);
        GotoXY(px, py);
        Write(ch);
        ox[i] := px;
        oy[i] := py;
      end
      else
      begin
        ox[i] := -1;
        oy[i] := -1;
      end;
    end;

    frame := frame + 1;
    Delay(40);
  end;

  GotoXY(1, 24);
  TextColor(LightGray);
  WriteLn('Warp speed. Press any key...');
  ReadKey;
end.

CUBE3D.PAS

The same cube, but in real graphics mode: 640x480 pixels and 16 colors via the Graph unit, with each face drawn as a solid filled polygon. Faces turned away from the viewer are dropped by checking the winding order of their projected corners.

Demonstrates: InitGraph, FillPoly, PointType records, back-face culling, perspective projection · 138 lines

Open in the IDE ›

program Cube3D;
uses Graph, Crt;
{ A solid, shaded cube spinning in 640x480 VGA graphics mode -- real pixels
  this time, not characters. Each face is one FillPoly; the faces pointing
  away from the viewer are skipped by looking at the winding order of their
  projected corners, which is all the hidden-surface removal a convex solid
  needs. }

const
  Scale = 170.0;   { model units to pixels }
  Dist  = 3.4;     { how far away the viewer sits, in model units }

type
  Vec = record
    x, y, z: real;
  end;

var
  gd, gm: integer;
  v: array[1..8] of Vec;            { cube corners, model space }
  sx, sy: array[1..8] of integer;   { the same corners, projected }
  face: array[1..6] of array[1..4] of integer;
  faceCol: array[1..6] of integer;
  poly: array[1..4] of PointType;
  angX, angY: real;
  cx, cy, i, f, a, b, c, d, area: integer;
  ch: char;

procedure SetCorner(n: integer; x, y, z: real);
begin
  v[n].x := x;
  v[n].y := y;
  v[n].z := z;
end;

procedure SetFace(n, p1, p2, p3, p4, col: integer);
begin
  face[n][1] := p1;
  face[n][2] := p2;
  face[n][3] := p3;
  face[n][4] := p4;
  faceCol[n] := col;
end;

{ Yaw, then pitch, then a perspective divide onto the screen. }
procedure Project(n: integer);
var
  x, y, z, t, k: real;
begin
  x := v[n].x;
  y := v[n].y;
  z := v[n].z;

  t := x * Cos(angY) - z * Sin(angY);
  z := x * Sin(angY) + z * Cos(angY);
  x := t;

  t := y * Cos(angX) - z * Sin(angX);
  z := y * Sin(angX) + z * Cos(angX);
  y := t;

  k := Scale / (z + Dist);
  sx[n] := cx + Round(x * k);
  sy[n] := cy - Round(y * k);
end;

begin
  gd := Detect;
  InitGraph(gd, gm, '');

  cx := GetMaxX div 2;
  cy := GetMaxY div 2;

  SetCorner(1, -1, -1, -1);
  SetCorner(2,  1, -1, -1);
  SetCorner(3,  1,  1, -1);
  SetCorner(4, -1,  1, -1);
  SetCorner(5, -1, -1,  1);
  SetCorner(6,  1, -1,  1);
  SetCorner(7,  1,  1,  1);
  SetCorner(8, -1,  1,  1);

  { Corners are listed the same way round on every face, so one sign test
    tells us which faces are turned towards us. }
  SetFace(1, 1, 2, 3, 4, LightRed);      { front }
  SetFace(2, 5, 8, 7, 6, LightGreen);    { back }
  SetFace(3, 1, 4, 8, 5, LightBlue);     { left }
  SetFace(4, 2, 6, 7, 3, Yellow);        { right }
  SetFace(5, 1, 5, 6, 2, LightMagenta);  { bottom }
  SetFace(6, 4, 3, 7, 8, LightCyan);     { top }

  angX := 0.0;
  angY := 0.0;

  while not KeyPressed do
  begin
    ClearDevice;

    for i := 1 to 8 do
      Project(i);

    for f := 1 to 6 do
    begin
      a := face[f][1];
      b := face[f][2];
      c := face[f][3];
      d := face[f][4];

      { Signed area of the projected quad: negative means we are looking at
        the outside of this face. }
      area := (sx[b] - sx[a]) * (sy[c] - sy[a]) - (sy[b] - sy[a]) * (sx[c] - sx[a]);

      if area < 0 then
      begin
        poly[1].x := sx[a];  poly[1].y := sy[a];
        poly[2].x := sx[b];  poly[2].y := sy[b];
        poly[3].x := sx[c];  poly[3].y := sy[c];
        poly[4].x := sx[d];  poly[4].y := sy[d];

        SetFillStyle(SolidFill, faceCol[f]);
        SetColor(White);
        FillPoly(4, poly);
      end;
    end;

    SetColor(LightGray);
    OutTextXY(8, 8, 'Graph unit: 640x480, 16 colors');
    OutTextXY(8, GetMaxY - 16, 'Press any key to return to the IDE');

    angX := angX + 0.031;
    angY := angY + 0.019;
    Delay(20);
  end;

  ch := ReadKey;
  CloseGraph;
  WriteLn('Back in text mode. That was ', ch, ' you pressed.');
end.

Writing your own

Start from any of these, or open a blank window with File › New. The About page lists exactly which Turbo Pascal features the interpreter supports, and File › Share link... will turn whatever you write into a link you can send to someone else.