← Back to branch summary

~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/packages/extra/ptc/examples/clear.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
http://bugs.debian.org/498882
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/extra/ptc/examples/clear.pp
1
 
{
2
 
Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net)
3
 
}
4
 
 
5
 
{
6
 
 Clear example for OpenPTC 1.0 C++ Implementation
7
 
 Copyright (c) Glenn Fiedler (ptc@gaffer.org)
8
 
 This source code is in the public domain
9
 
}
10
 
 
11
 
Program ClearExample;
12
 
 
13
 
{$MODE objfpc}
14
 
 
15
 
Uses
16
 
  ptc;
17
 
 
18
 
Var
19
 
  console : TPTCConsole;
20
 
  format : TPTCFormat;
21
 
  surface : TPTCSurface;
22
 
  width, height : Integer;
23
 
  x, y : Integer;
24
 
  size : Integer;
25
 
  area : TPTCArea;
26
 
  color : TPTCColor;
27
 
 
28
 
Begin
29
 
  Try
30
 
    { create console }
31
 
    console := TPTCConsole.Create;
32
 
 
33
 
    { create format }
34
 
    format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
35
 
 
36
 
    { open the console }
37
 
    console.open('Clear example', format);
38
 
 
39
 
    { create surface matching console dimensions }
40
 
    surface := TPTCSurface.Create(console.width, console.height, format);
41
 
 
42
 
    { loop until a key is pressed }
43
 
    While Not console.KeyPressed Do
44
 
    Begin
45
 
      { get surface dimensions }
46
 
      width := surface.width;
47
 
      height := surface.height;
48
 
 
49
 
      { get random position }
50
 
      x := Random(width);
51
 
      y := Random(height);
52
 
 
53
 
      { get random area size }
54
 
      size := Random(width Div 8);
55
 
 
56
 
      { setup clear area }
57
 
      area := TPTCArea.Create(x-size, y-size, x+size, y+size);
58
 
 
59
 
      { create random color }
60
 
      color := TPTCColor.Create(Random, Random, Random);
61
 
 
62
 
      { clear surface area with color }
63
 
      surface.clear(color, area);
64
 
 
65
 
      { copy to console }
66
 
      surface.copy(console);
67
 
 
68
 
      { update console }
69
 
      console.update;
70
 
      area.Free;
71
 
      color.Free;
72
 
    End;
73
 
    console.close;
74
 
    console.Free;
75
 
    surface.Free;
76
 
  Except
77
 
    On error : TPTCError Do
78
 
      { report error }
79
 
      error.report;
80
 
  End;
81
 
End.