Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 99 lines (74 sloc) 2.867 kb
7378c1b Final messing
amosteo authored
1 with Player.Graphics2d.Buffered;
2
3 package Player.Graphics2d.Double is
4
5 -- Avoid stage flickering by double buffering.
6 -- You need to create two different models sharing the same
7 -- reference frame, with consecutive indexes. This is due to a lone model
8 -- sharing its paint queue with all its clients.
9
10 -- E.g.:
11 -- stage.world:
12 -- position (
13 -- size [0 0]
14 -- pose [0 0 0]
15 -- name "transit1"
16 -- ) # Used to draw changing elements with double buffering
17 -- position (
18 -- Size [0 0]
19 -- pose [0 0 0]
20 -- name "transit2"
21 -- ) # Used to draw changing elements with double buffering
22
23
24 -- player.cfg:
25 -- driver(
26 -- name "stage"
27 -- provides ["7780:graphics2d:0" "7780:position2d:0"]
28 -- model "permanent1"
29 -- )
30 -- driver(
31 -- name "stage"
32 -- provides ["7780:graphics2d:1" "7780:position2d:1"]
33 -- model "permanent2"
34 -- )
35
36 -- In the avobe example, the position2d are needed because otherwise the
37 -- reading on the graphics2d client blocks, even in pull mode!!
38
39
40 pragma Elaborate_Body;
41
42 type Object is new Graphics2d.Object with private;
43
44 overriding
45 procedure Create
46 (This : in out Object;
47 Conn : in Client.Connection_Type;
48 Index : in Natural := 0);
49
50 overriding
51 procedure Subscribe (This : in out Object; Mode : in Access_Modes);
52
53 overriding
54 procedure Unsubscribe (This : in out Object);
55
56 overriding
57 procedure Clear (This : in out Object);
58 -- This forces a clearing. Not needed if you only want a redraw.
59 -- In that case, flush switches the visible canvas and takes care of
60 -- clearing off-screen canvases.
61
62 overriding
63 procedure Set_Color (This : in out Object;
64 Color : in Types.Player_Color_Type);
65
66 overriding
67 procedure Draw_Polyline (This : in out Object;
68 Points : in Types.Point_2d_Array);
69
70 overriding
71 procedure Draw_Polyline (This : in out Object;
72 Points : in Types.Point_2d_Vector);
73
74 overriding
75 procedure Fill_Polygon (This : in out Object;
76 Points : in Types.Point_2d_Array);
77
78 overriding
79 procedure Fill_Polygon (This : in out Object;
80 Points : in Types.Point_2d_Vector);
81
82 not overriding
83 procedure Flush (This : in out Object);
84 -- Causes switch and draw. No need to use Clear.
85
86 private
87
88 type Parent_Access is access all Graphics2d.Buffered.Object;
89
90 type Canvases_Range is mod 2;
91 type Canvases_Array is array (Canvases_Range) of Parent_Access;
92
93 type Object is new Graphics2d.Object with record
94 Canvases : Canvases_array;
95 Active : Canvases_Range := Canvases_Range'First;
96 end record;
97
98 end Player.Graphics2d.Double;
Something went wrong with that request. Please try again.