← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

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

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/extra/ptc/examples/clip.pp
 
1
{
 
2
Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net)
 
3
}
 
4
 
 
5
{
 
6
 Clip 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 ClipExample;
 
12
 
 
13
{$MODE objfpc}
 
14
 
 
15
Uses
 
16
  ptc;
 
17
 
 
18
Var
 
19
  console : TPTCConsole;
 
20
  surface : TPTCSurface;
 
21
  format : TPTCFormat;
 
22
  area : TPTCArea;
 
23
  x1, y1, x2, y2 : Integer;
 
24
  pixels : Pint32;
 
25
  width, height : Integer;
 
26
  i : Integer;
 
27
  x, y, r, g, b : Integer;
 
28
 
 
29
Begin
 
30
  format := Nil;
 
31
  surface := Nil;
 
32
  console := Nil;
 
33
  Try
 
34
    Try
 
35
      { create console }
 
36
      console := TPTCConsole.Create;
 
37
 
 
38
      { create format }
 
39
      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
 
40
 
 
41
      { open the console }
 
42
      console.open('Clip example', format);
 
43
 
 
44
      { create surface matching console dimensions }
 
45
      surface := TPTCSurface.Create(console.width, console.height, format);
 
46
 
 
47
      { calculate clip coordinates }
 
48
      x1 := console.width Div 4;
 
49
      y1 := console.height Div 4;
 
50
      x2 := console.width - x1;
 
51
      y2 := console.height - y1;
 
52
 
 
53
      { setup clip area }
 
54
      area := TPTCArea.Create(x1, y1, x2, y2);
 
55
      Try
 
56
        { set clip area }
 
57
        console.clip(area);
 
58
      Finally
 
59
        area.Free;
 
60
      End;
 
61
 
 
62
      { loop until a key is pressed }
 
63
      While Not console.KeyPressed Do
 
64
      Begin
 
65
        { lock surface }
 
66
        pixels := surface.lock;
 
67
        Try
 
68
          { get surface dimensions }
 
69
          width := surface.width;
 
70
          height := surface.height;
 
71
 
 
72
          { draw random pixels }
 
73
          For i := 1 To 100 Do
 
74
          Begin
 
75
            { get random position }
 
76
            x := Random(width);
 
77
            y := Random(height);
 
78
 
 
79
            { get random color }
 
80
            r := Random(256);
 
81
            g := Random(256);
 
82
            b := Random(256);
 
83
 
 
84
            { draw color [r,g,b] at position [x,y] }
 
85
            pixels[x + y * width] := (r Shl 16) + (g Shl 8) + b;
 
86
          End;
 
87
        Finally
 
88
          { unlock surface }
 
89
          surface.unlock;
 
90
        End;
 
91
 
 
92
        { copy to console }
 
93
        surface.copy(console);
 
94
 
 
95
        { update console }
 
96
        console.update;
 
97
      End;
 
98
    Finally
 
99
      console.close;
 
100
      console.Free;
 
101
      surface.Free;
 
102
      format.Free;
 
103
    End;
 
104
  Except
 
105
    On error : TPTCError Do
 
106
      { report error }
 
107
      error.report;
 
108
  End;
 
109
End.