|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 58368 (0xe400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Draw, seg_00535b
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Text_Io;
with Board;
use Board;
with Button;
use Button;
with Main;
use Main;
with Tile;
use Tile;
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic;
use Xlbt_Basic;
with Xlbt_Event;
use Xlbt_Event;
with Xlbt_Graphics;
use Xlbt_Graphics;
with Xlbt_String;
use Xlbt_String;
with Xlbp_Event;
use Xlbp_Event;
with Xlbp_Graphics;
use Xlbp_Graphics;
package body Draw is
------------------------------------------------------------------------------
-- Dragon - a version of Mah-Jongg for X Windows
--
-- Author: Gary E. Barnes May 1989
--
-- Draw - Deals with the Mah-Jongg board. Setup and drawing.
------------------------------------------------------------------------------
-- 05/30/90 GEB - Translate to Ada
------------------------------------------------------------------------------
----Index into this array using a tile number in order to get the procedure
-- that knows how to draw the face of that tile.
type Draw_Xyz is (Do_Draw_Error, Do_Draw_Spring, Do_Draw_Summer,
Do_Draw_Fall, Do_Draw_Winter, Do_Draw_Bamboo, Do_Draw_Mum,
Do_Draw_Orchid, Do_Draw_Plum, Do_Draw_Gdragon,
Do_Draw_Rdragon, Do_Draw_Wdragon, Do_Draw_East,
Do_Draw_West, Do_Draw_North, Do_Draw_South, Do_Draw_Bam1,
Do_Draw_Bam2, Do_Draw_Bam3, Do_Draw_Bam4, Do_Draw_Bam5,
Do_Draw_Bam6, Do_Draw_Bam7, Do_Draw_Bam8, Do_Draw_Bam9,
Do_Draw_Dot1, Do_Draw_Dot2, Do_Draw_Dot3, Do_Draw_Dot4,
Do_Draw_Dot5, Do_Draw_Dot6, Do_Draw_Dot7, Do_Draw_Dot8,
Do_Draw_Dot9, Do_Draw_Crak1, Do_Draw_Crak2, Do_Draw_Crak3,
Do_Draw_Crak4, Do_Draw_Crak5, Do_Draw_Crak6,
Do_Draw_Crak7, Do_Draw_Crak8, Do_Draw_Crak9);
type Draw_Xyz_Array is array (S_Long range 0 .. N_Faces) of Draw_Xyz;
Faces : Draw_Xyz_Array :=
(Do_Draw_Error,
Do_Draw_Spring, Do_Draw_Summer, Do_Draw_Fall, Do_Draw_Winter,
Do_Draw_Bamboo, Do_Draw_Mum, Do_Draw_Orchid, Do_Draw_Plum,
Do_Draw_Gdragon, Do_Draw_Rdragon, Do_Draw_Wdragon,
Do_Draw_East, Do_Draw_West, Do_Draw_North, Do_Draw_South,
Do_Draw_Bam1, Do_Draw_Bam2, Do_Draw_Bam3, Do_Draw_Bam4, Do_Draw_Bam5,
Do_Draw_Bam6, Do_Draw_Bam7, Do_Draw_Bam8, Do_Draw_Bam9,
Do_Draw_Dot1, Do_Draw_Dot2, Do_Draw_Dot3, Do_Draw_Dot4, Do_Draw_Dot5,
Do_Draw_Dot6, Do_Draw_Dot7, Do_Draw_Dot8, Do_Draw_Dot9,
Do_Draw_Crak1, Do_Draw_Crak2, Do_Draw_Crak3, Do_Draw_Crak4,
Do_Draw_Crak5, Do_Draw_Crak6, Do_Draw_Crak7, Do_Draw_Crak8,
Do_Draw_Crak9
);
procedure Draw_Error is
begin
Text_Io.Put_Line ("Drew tile face 0??");
return;
end Draw_Error;
--\x0c
procedure Call (What : Draw_Xyz;
X : S_Short;
Y : S_Short) is
begin
case What is
when Do_Draw_Error =>
Draw_Error;
when Do_Draw_Spring =>
Draw_Spring (X, Y);
when Do_Draw_Summer =>
Draw_Summer (X, Y);
when Do_Draw_Fall =>
Draw_Fall (X, Y);
when Do_Draw_Winter =>
Draw_Winter (X, Y);
when Do_Draw_Bamboo =>
Draw_Bamboo (X, Y);
when Do_Draw_Mum =>
Draw_Mum (X, Y);
when Do_Draw_Orchid =>
Draw_Orchid (X, Y);
when Do_Draw_Plum =>
Draw_Plum (X, Y);
when Do_Draw_Gdragon =>
Draw_Gdragon (X, Y);
when Do_Draw_Rdragon =>
Draw_Rdragon (X, Y);
when Do_Draw_Wdragon =>
Draw_Wdragon (X, Y);
when Do_Draw_East =>
Draw_East (X, Y);
when Do_Draw_West =>
Draw_West (X, Y);
when Do_Draw_North =>
Draw_North (X, Y);
when Do_Draw_South =>
Draw_South (X, Y);
when Do_Draw_Bam1 =>
Draw_Bam1 (X, Y);
when Do_Draw_Bam2 =>
Draw_Bam2 (X, Y);
when Do_Draw_Bam3 =>
Draw_Bam3 (X, Y);
when Do_Draw_Bam4 =>
Draw_Bam4 (X, Y);
when Do_Draw_Bam5 =>
Draw_Bam5 (X, Y);
when Do_Draw_Bam6 =>
Draw_Bam6 (X, Y);
when Do_Draw_Bam7 =>
Draw_Bam7 (X, Y);
when Do_Draw_Bam8 =>
Draw_Bam8 (X, Y);
when Do_Draw_Bam9 =>
Draw_Bam9 (X, Y);
when Do_Draw_Dot1 =>
Draw_Dot1 (X, Y);
when Do_Draw_Dot2 =>
Draw_Dot2 (X, Y);
when Do_Draw_Dot3 =>
Draw_Dot3 (X, Y);
when Do_Draw_Dot4 =>
Draw_Dot4 (X, Y);
when Do_Draw_Dot5 =>
Draw_Dot5 (X, Y);
when Do_Draw_Dot6 =>
Draw_Dot6 (X, Y);
when Do_Draw_Dot7 =>
Draw_Dot7 (X, Y);
when Do_Draw_Dot8 =>
Draw_Dot8 (X, Y);
when Do_Draw_Dot9 =>
Draw_Dot9 (X, Y);
when Do_Draw_Crak1 =>
Draw_Crak1 (X, Y);
when Do_Draw_Crak2 =>
Draw_Crak2 (X, Y);
when Do_Draw_Crak3 =>
Draw_Crak3 (X, Y);
when Do_Draw_Crak4 =>
Draw_Crak4 (X, Y);
when Do_Draw_Crak5 =>
Draw_Crak5 (X, Y);
when Do_Draw_Crak6 =>
Draw_Crak6 (X, Y);
when Do_Draw_Crak7 =>
Draw_Crak7 (X, Y);
when Do_Draw_Crak8 =>
Draw_Crak8 (X, Y);
when Do_Draw_Crak9 =>
Draw_Crak9 (X, Y);
end case;
end Call;
--\x0c
procedure Hilite_Tile (Row : S_Short;
Col : S_Short) is
------------------------------------------------------------------------------
-- row - Specifies the row of the tile to hilite
-- col - specifies the column of the tile to hilite
--
-- Called to hilite a tile face.
------------------------------------------------------------------------------
Bp : Board_Position renames Board_Tiles (Row, Col);
Pnts : X_Point_Array (0 .. 19);
Pnti : S_Long := 0;
X, Y : S_Short;
W, H : S_Short;
Left, Bottom, Left_Bottom : S_Short;
procedure Pnt (X, Y : S_Short) is
begin
Pnts (Pnti).X := X;
Pnts (Pnti).Y := Y;
Pnti := Pnti + 1;
end Pnt;
begin
----See if we are one of the very special tiles on top.
if Board_Tiles (Spec4_Row, Spec4_Col).Level > 0 then
if Row = 3 then
if Col = 6 then
X := Bp.X + Side_X * 4 + 1;
Y := Bp.Y - Side_Y * 4 + 1;
W := Tile_Width / 2;
H := Tile_Height / 2;
Pnt (X, Y);
Pnt (Tile_Width, 0);
Pnt (0, H - 1);
Pnt (-(W + 1), 0);
Pnt (0, H + 1);
Pnt (-(W - 1), 0);
Pnt (0, -Tile_Height);
goto Hilite;
elsif Col = 7 then
X := Bp.X + Side_X * 4 + 1;
Y := Bp.Y - Side_Y * 4 + 1;
W := Board_Tiles (3, 7).X -
Board_Tiles (Spec4_Row, Spec4_Col).X + 3 * Side_X;
H := Tile_Height / 2;
Pnt (X, Y);
Pnt (Tile_Width, 0);
Pnt (0, Tile_Height);
Pnt (-W, 0);
Pnt (0, -(H + 1));
Pnt (-(Tile_Width - W), 0);
Pnt (0, -(H - 1));
goto Hilite;
end if;
elsif Row = 4 then
if Col = 6 then
X := Bp.X + Side_X * 4 + 1;
Y := Bp.Y - Side_Y * 4 + 1;
W := Tile_Width / 2;
H := Tile_Height / 2;
Pnt (X, Y);
Pnt (W - 1, 0);
Pnt (0, H + Side_Y);
Pnt (W + 1, 0);
Pnt (0, H - Side_Y);
Pnt (-Tile_Width, 0);
Pnt (0, -Tile_Height);
goto Hilite;
elsif Col = 7 then
X := Bp.X + Side_X * 4 + 1;
Y := Bp.Y - Side_Y * 4 + 1;
W := Board_Tiles (4, 7).X -
Board_Tiles (Spec4_Row, Spec4_Col).X + 3 * Side_X;
H := Tile_Height / 2;
Pnt (X + (Tile_Width - W), Y);
Pnt (W, 0);
Pnt (0, Tile_Height);
Pnt (-Tile_Width, 0);
Pnt (0, -(H - Side_Y));
Pnt ((Tile_Width - W), 0);
Pnt (0, -(H + Side_Y));
goto Hilite;
end if;
end if;
end if;
----We are a normal tile that may be partially overlapped by some other
-- normal tile.
X := Bp.X + Side_X * Bp.Level + 1;
Y := Bp.Y - Side_Y * Bp.Level + 1;
W := Tile_Width;
H := Tile_Height;
if Col > 0 then
Left := Board_Tiles (Row, Col - 1).Level - Bp.Level;
if Left < 0 then
Left := 0;
end if;
if Row < 7 then
Left_Bottom := Board_Tiles (Row + 1, Col - 1).Level - Bp.Level;
if Left_Bottom < 0 then
Left_Bottom := 0;
end if;
else
Left_Bottom := 0;
end if;
else
Left := 0;
Left_Bottom := 0;
end if;
if Row < 7 then
Bottom := Board_Tiles (Row + 1, Col).Level - Bp.Level;
if Bottom < 0 then
Bottom := 0;
end if;
else
Bottom := 0;
end if;
if Bottom > Left_Bottom and then Tile_Width = 28 then
Left_Bottom := Bottom;
end if;
if Left > 0 then
W := Left * Side_X;
else
W := 0;
end if;
Pnt (X + W, Y);
Pnt ((Tile_Width - W), 0);
if Bottom > 0 then
H := Bottom * Side_Y;
else
H := 0;
end if;
Pnt (0, (Tile_Height - H));
if Left_Bottom <= Left and then Left_Bottom <= Bottom then
Pnt (-(Tile_Width - Bottom * Side_X), 0);
if Left /= Bottom then
Pnt ((Left - Bottom) * Side_X, (Bottom - Left) * Side_Y);
end if;
Pnt (0, -(Tile_Height - H));
elsif Left_Bottom <= Left then -- left_bottom > bottom
Pnt (-(Tile_Width - Left_Bottom * Side_X), 0);
if Left_Bottom /= Left then
Pnt (0, (Bottom - Left_Bottom) * Side_Y);
Pnt ((Left - Left_Bottom) * Side_X,
(Left_Bottom - Left) * Side_Y);
Pnt (0, -(Tile_Height - Left * Side_Y));
else
Pnt (0, -(Tile_Height - H));
end if;
elsif Left_Bottom <= Bottom then -- left_bottom > left
if Left_Bottom = Bottom then
Pnt (-(Tile_Width - W), 0);
Pnt (0, -(Tile_Height - H));
else
Pnt (-(Tile_Width - Bottom * Side_X), 0);
Pnt ((Left_Bottom - Bottom) * Side_X,
(Bottom - Left_Bottom) * Side_Y);
Pnt (-Left_Bottom * Side_X, 0);
Pnt (0, -(Tile_Height - Left_Bottom * Side_Y));
end if;
else -- left_bottom > bottom && left_bottom > left
Pnt (-(Tile_Width - Left_Bottom * Side_X), 0);
Pnt (0, (Bottom - Left_Bottom) * Side_Y);
Pnt ((Left - Left_Bottom) * Side_X, 0);
Pnt (0, -(Tile_Height - Left_Bottom * Side_Y));
end if;
----Now do it.
<<Hilite>> null;
X_Fill_Polygon (Dpy, Main.Board.Drawable, Xor_Gc,
Pnts (0 .. Pnti - 1), Convex, Coord_Mode_Previous);
end Hilite_Tile;
--\x0c
procedure Clear_Tile (Bp : Board_Position;
Pleft : S_Short;
Pbottom : S_Short) is
------------------------------------------------------------------------------
-- bp - Specifies the Board_Position to draw
-- left - Specifies the level of the tile on the left of this thile
-- bottom - Specifies the level of the tile at the bottom of this tile
--
-- We clear (make totally white) the space occupied by the image of this tile.
-- We clear the face and the left and bottom sides. Any shadowing caused by
-- the last drawing of this tile is the responsibility of the caller.
------------------------------------------------------------------------------
Left : S_Short := Pleft;
Bottom : S_Short := Pbottom;
Poly : X_Point_Array (0 .. 9);
Polyi : S_Natural;
procedure Pnt (Xx, Yy : S_Short) is
begin
Poly (Polyi).X := (Xx);
Poly (Polyi).Y := (Yy);
Polyi := Polyi + 1;
end Pnt;
begin
----We will circle the tile outline clockwise.
Polyi := 0;
----Start with the upper left corner of the tile side. This is the "bottom"
-- of that tile side if it has one. Leave x/y at the upper-left corner of the
-- tile face.
if Left >= Bp.Level then
Left := Bp.Level;
Pnt (Bp.X + Side_X * Bp.Level, Bp.Y - Side_Y * Bp.Level);
else
Pnt (Bp.X + Side_X * Left, Bp.Y - Side_Y * Left);
Pnt (Side_X * (Bp.Level - Left), -Side_Y * (Bp.Level - Left));
end if;
----Cross the top and the right side of the tile.
Pnt (Tile_Width + 1, 0);
Pnt (0, Tile_Height + 1);
----Now do the bottom side of the tile.
if Bottom < Bp.Level then
Pnt (-Side_X * (Bp.Level - Bottom), Side_Y * (Bp.Level - Bottom));
else
Bottom := Bp.Level;
end if;
Pnt (-(Tile_Width + 1), 0);
----Now go up the left side of the tile.
if Left /= Bottom then
Pnt (Side_X * (Left - Bottom), -Side_Y * (Left - Bottom));
end if;
Pnt (0, -(Tile_Height + 1));
----Do the actual clearing.
X_Fill_Polygon (Dpy, Main.Board.Drawable, Reverse_Gc,
Poly (0 .. Polyi - 1), Convex, Coord_Mode_Previous);
end Clear_Tile;
--\x0c
procedure Tile (Row : S_Short;
Col : S_Short) is
------------------------------------------------------------------------------
-- row - Specifies the tile to draw
-- col - Specifies the tile to draw
--
-- Called to draw a tile. We draw the face, the sides, and the shadow.
------------------------------------------------------------------------------
Bp : Board_Position renames Board_Tiles (Row, Col);
Poly : X_Point_Array (0 .. 99);
Polyi : S_Natural;
Left : S_Short;
Bottom : S_Short;
Curx : S_Short;
Cury : S_Short;
Sidex : S_Short;
Sidey : S_Short;
I, J, K, L, M : S_Short;
L_Segs : constant := 7; -- keep this an odd number
R_Segs : constant := 6; -- keep this an even number
procedure Pnt (Xx, Yy : S_Short) is
begin
Poly (Polyi).X := (Xx);
Poly (Polyi).Y := (Yy);
Polyi := Polyi + 1;
end Pnt;
begin
----This tile no longer needs drawing.
Bp.Draw := False;
----Determine the level of the tile on the left of this tile.
if Col > 0 then
if Col = Spec1_Col and then Row = Spec1_Row then
Left := Board_Tiles (Spec2_Row, Spec2_Col).Level;
elsif Col = Spec2_Col and then Row = Spec2_Row then
if Board_Tiles (3, 12).Level = 0 or else
Board_Tiles (4, 12).Level = 0 then
Left := 0;
else
Left := 1;
end if;
else
Left := Board_Tiles (Row, Col - 1).Level;
end if;
else
Left := 0;
end if;
----Determine the level of the tile at the bottom of this tile.
if Row < 7 then
Bottom := Board_Tiles (Row + 1, Col).Level;
else
Bottom := 0;
end if;
----Clear the area that will be covered by this tile.
Clear_Tile (Bp, Left, Bottom);
----Draw the tile face.
Call (Faces (S_Long (Bp.Tiles (S_Long (Bp.Level - 1)))),
Bp.X + Bp.Level * Side_X + 1, Bp.Y - Bp.Level * Side_Y + 1);
----Now draw the tile edges.
if (Tile_Control and Blackside) /= 0 then
----We want black/gray sides.
X_Draw_Rectangle (Dpy, Main.Board.Drawable, Normal_Gc,
Bp.X + Bp.Level * Side_X,
Bp.Y - Bp.Level * Side_Y,
U_Short (Tile_Width + 1),
U_Short (Tile_Height + 1));
if Left < Bp.Level then
Polyi := 0;
Pnt (Bp.X + Left * Side_X, Bp.Y - Left * Side_Y);
Pnt ((Bp.Level - Left) * Side_X, (Left - Bp.Level) * Side_Y);
Pnt (0, Tile_Height + 1);
Pnt ((Left - Bp.Level) * Side_X, (Bp.Level - Left) * Side_Y);
Pnt (0, -(Tile_Height + 1));
if (Tile_Control and Grayside) /= 0 then
X_Fill_Polygon (Dpy, Main.Board.Drawable,
Gray_Gc, Poly (0 .. Polyi - 1),
Convex, Coord_Mode_Previous);
else
X_Fill_Polygon (Dpy, Main.Board.Drawable,
Normal_Gc, Poly (0 .. Polyi - 1),
Convex, Coord_Mode_Previous);
end if;
X_Draw_Lines (Dpy, Main.Board.Drawable, Normal_Gc,
Poly (0 .. Polyi - 1), Coord_Mode_Previous);
end if;
if Bottom < Bp.Level then
Polyi := 0;
Pnt (Bp.X + Bp.Level * Side_X,
Bp.Y - Bp.Level * Side_Y + Tile_Height + 1);
Pnt (Tile_Width + 1, 0);
Pnt ((Bottom - Bp.Level) * Side_X,
(Bp.Level - Bottom) * Side_Y);
Pnt (-(Tile_Width + 1), 0);
Pnt ((Bp.Level - Bottom) * Side_X,
(Bottom - Bp.Level) * Side_Y);
if (Tile_Control and Grayside) /= 0 then
X_Fill_Polygon (Dpy, Main.Board.Drawable,
Gray_Gc, Poly (0 .. Polyi - 1),
Convex, Coord_Mode_Previous);
else
X_Fill_Polygon (Dpy, Main.Board.Drawable,
Normal_Gc, Poly (0 .. Polyi - 1),
Convex, Coord_Mode_Previous);
end if;
X_Draw_Lines (Dpy, Main.Board.Drawable, Normal_Gc,
Poly (0 .. Polyi - 1), Coord_Mode_Previous);
end if;
----We want line'ed sides.
else
Polyi := 0;
if Left >= Bp.Level then
Pnt (Bp.X + Side_X * Bp.Level, Bp.Y - Side_Y * Bp.Level);
else
----First we draw the left side. We leave x/y at the bottom left corner of
-- the tile face when we are done.
Sidex := Side_X * (Bp.Level - Left);
Sidey := Side_Y * (Bp.Level - Left);
J := Sidex;
if Tile_Width = 28 and then Bp.Level - Left = 1 then
Pnt (Bp.X + Side_X * Left, Bp.Y - Side_Y * Left - Sidey);
Pnt (0, Tile_Height + 1 + Sidey);
K := 0;
else
Pnt (Bp.X + Side_X * Left, Bp.Y - Side_Y * Left);
Pnt (0, Tile_Height + 1);
K := Sidey;
end if;
Pnt (Sidex, -Sidey);
I := Tile_Height / (L_Segs + 1);
M := Tile_Height - I * (L_Segs + 1);
for L in reverse 1 .. L_Segs loop
Cury := -I;
if M > 0 then
Cury := Cury - 1;
M := M - 1;
end if;
Pnt (0, Cury);
Pnt (-J, K);
J := -J;
K := -K;
end loop;
Pnt (0, -I - 1);
Pnt (Sidex, K);
end if;
Pnt (0, Tile_Height + 1);
----Draw the left edge of the tile and then draw the bottom side of the tile.
-- We leave x/y at the bottom right corner of the tile face when we are done.
if Bottom < Bp.Level then
Sidex := Side_X * (Bp.Level - Bottom);
Sidey := Side_Y * (Bp.Level - Bottom);
I := Tile_Width / (R_Segs + 1);
M := Tile_Width - I * (R_Segs + 1);
if Tile_Width = 28 and then Bp.Level - Bottom = 1 then
J := 0;
else
J := Sidex;
end if;
K := Sidey;
for L in reverse 1 .. R_Segs loop
Curx := I;
if M > 0 then
Curx := Curx + 1;
M := M - 1;
end if;
Pnt (Curx, 0);
Pnt (-J, K);
J := -J;
K := -K;
end loop;
Pnt (I + 1, 0);
Pnt (-J, Sidey);
Pnt (-(Tile_Width + 1 + Sidex - J), 0);
Pnt (Sidex, -Sidey);
end if;
Pnt (Tile_Width + 1, 0);
----Draw the right side.
Pnt (0, -(Tile_Height + 1));
----Draw the top side.
Pnt (-(Tile_Width + 1), 0);
----Draw all of those edges.
if (Tile_Control and Grayside) /= 0 then
X_Draw_Lines (Dpy, Main.Board.Drawable, Gray_Gc,
Poly (0 .. Polyi - 1), Coord_Mode_Previous);
else
X_Draw_Lines (Dpy, Main.Board.Drawable, Normal_Gc,
Poly (0 .. Polyi - 1), Coord_Mode_Previous);
end if;
end if;
----Now draw the tile shadow.
if (Tile_Control and Shadow) /= 0 then
declare
Top : S_Short;
Right : S_Short;
Top_Right : Boolean;
begin
----Determine the level of the tile on the right of this tile.
if Col = Spec1_Col then
if Row = Spec2_Row then
Right := Board_Tiles (Spec1_Row, Spec1_Col).Level;
elsif Row = Spec3_Row then
Right := 0;
else
Right := 0;
end if;
else
Right := Board_Tiles (Row, Col + 1).Level;
end if;
----Determine the level of the tile at the top of this tile.
if Row > 0 then
Top := Board_Tiles (Row - 1, Col).Level;
else
Top := 0;
end if;
----Do we have an upper-right tile?
if Row > 0 and then
Board_Tiles (Row - 1, Col + 1).Level >= Bp.Level then
Top_Right := True;
elsif Row = Spec3_Row and then Col = Spec3_Col and then
Board_Tiles (3, 1).Level > 0 then
Top_Right := True;
elsif Row = 4 and then Col = 12 and then
Board_Tiles (Spec2_Row, Spec2_Col).Level > 0 then
Top_Right := True;
else
Top_Right := False;
end if;
----Draw the upper shadow if necessary.
if Top < Bp.Level then
Polyi := 0;
Pnt (Bp.X + Bp.Level * Side_X - 1,
Bp.Y - Bp.Level * Side_Y);
Pnt (Shadow_X, -Shadow_Y);
if Top_Right then
I := Shadow_X;
else
I := 0;
end if;
Pnt (Tile_Width + 3 - I, 0);
Pnt (-(Shadow_X - I), Shadow_Y);
Pnt (-(Tile_Width + 3), 0);
X_Fill_Polygon (Dpy, Main.Board.Drawable,
Over_Gc, Poly (0 .. Polyi - 1),
Convex, Coord_Mode_Previous);
end if;
----Now work on the right shadow. It may need to be drawn in pieces.
Polyi := 0;
----If SPEC3 has both neighbors then don't draw the right shadow.
if Row = Spec3_Row and then Col = Spec3_Col then
if Board_Tiles (3, 1).Level > 0 then
if Board_Tiles (4, 1).Level > 0 then
Right := Bp.Level;
----If SPEC3 has only the upper neighbor then draw just the lower shadow.
else
I := Bp.Y - Board_Tiles (3, 1).Y;
Pnt (Board_Tiles (4, 1).X + Side_X,
Board_Tiles (4, 1).Y);
Pnt (Shadow_X, 0);
Pnt (0, I - Shadow_Y);
Pnt (-Shadow_X, Shadow_Y);
Pnt (0, -I);
Right := Bp.Level;
end if;
----If SPEC3 has only the lower neighbor then draw just the upper shadow.
elsif Board_Tiles (4, 1).Level > 0 then
I := Board_Tiles (4, 1).Y - Bp.Y;
Pnt (Bp.X + Bp.Level * Side_X + Tile_Width + 1 + 1,
Bp.Y - Bp.Level * Side_Y);
Pnt (Shadow_X, -Shadow_Y);
Pnt (0, I + Shadow_Y);
Pnt (-Shadow_X, 0);
Pnt (0, -I);
Right := Bp.Level;
end if;
----If SPEC2's upper neighbor is there then draw that tile's upper shadow.
elsif Row = 3 and then Col = 12 and then
Board_Tiles (Spec2_Row, Spec2_Col).Level > 0 then
I := Board_Tiles (Spec2_Row, Spec2_Col).Y - Bp.Y;
Pnt (Bp.X + Bp.Level * Side_X + Tile_Width + 1 + 1,
Bp.Y - Bp.Level * Side_Y);
Pnt (Shadow_X, -Shadow_Y);
Pnt (0, I + Shadow_Y);
Pnt (-Shadow_X, 0);
Pnt (0, -I);
Right := Bp.Level;
----If SPEC2's lower neighbor is there then draw that tile's lower shadow.
elsif Row = 4 and then Col = 12 and then
Board_Tiles (Spec2_Row, Spec2_Col).Level > 0 then
I := Bp.Y - Board_Tiles (Spec2_Row, Spec2_Col).Y;
Pnt (Board_Tiles (Spec2_Row, Spec2_Col).X + Side_X,
Board_Tiles (Spec2_Row, Spec2_Col).Y +
Tile_Height + 1);
Pnt (Shadow_X, 0);
Pnt (0, I - Shadow_Y);
Pnt (-Shadow_X, Shadow_Y);
Pnt (0, -I);
Right := Bp.Level;
end if;
----If required, draw a normal right shadow that may be truncated by an upper
-- right neighbor.
if Right < Bp.Level then
Polyi := 0;
if Top_Right then
I := Shadow_Y;
else
I := 0;
end if;
Pnt (Bp.X + Bp.Level * Side_X + Tile_Width + 1 + 1,
Bp.Y - Bp.Level * Side_Y);
Pnt (Shadow_X, -(Shadow_Y - I));
Pnt (0, Tile_Height + 1 - I);
Pnt (-Shadow_X, Shadow_Y);
Pnt (0, -(Tile_Height + 1));
end if;
----Draw any right shadow that may have been requested.
if Polyi > 0 then
X_Fill_Polygon (Dpy, Main.Board.Drawable,
Over_Gc, Poly (0 .. Polyi - 1),
Convex, Coord_Mode_Previous);
end if;
end;
end if;
----Now check for hiliting.
if Board_State /= S_Sample then
if Click1 = Bp then
Hilite_Tile (Click1_Row, Click1_Col);
elsif Click2 = Bp then
Hilite_Tile (Click2_Row, Click2_Col);
end if;
end if;
end Tile;
--\x0c
procedure Draw_All_Tiles is
------------------------------------------------------------------------------
-- Draws all visible tiles.
------------------------------------------------------------------------------
begin
----Draw the rightmost special tiles.
if Board_Tiles (Spec1_Row, Spec1_Col).Draw and then
Board_Tiles (Spec1_Row, Spec1_Col).Level > 0 then
Tile (Spec1_Row, Spec1_Col);
end if;
if Board_Tiles (Spec2_Row, Spec2_Col).Draw and then
Board_Tiles (Spec2_Row, Spec2_Col).Level > 0 then
Tile (Spec2_Row, Spec2_Col);
end if;
----Draw the current game. Draw the normally placed tiles.
for I in S_Short range 0 .. 7 loop
for J in reverse S_Short range 1 .. 12 loop
if Board_Tiles (I, J).Draw and then
Board_Tiles (I, J).Level > 0 then
Tile (I, J);
end if;
end loop;
end loop;
----Now draw the other special tiles.
if Board_Tiles (Spec4_Row, Spec4_Col).Draw and then
Board_Tiles (Spec4_Row, Spec4_Col).Level > 0 then
Tile (Spec4_Row, Spec4_Col);
end if;
if Board_Tiles (Spec3_Row, Spec3_Col).Draw and then
Board_Tiles (Spec3_Row, Spec3_Col).Level > 0 then
Tile (Spec3_Row, Spec3_Col);
end if;
Draw_Score (Score,
Board_Tile0_X + 14 * (Tile_Width + 1),
Board_Tile0_Y + 8 * (Tile_Height + 1));
end Draw_All_Tiles;
--\x0c
procedure Sample (Face : S_Long;
X : S_Short;
Y : S_Short) is
------------------------------------------------------------------------------
-- Draw one sample tile.
------------------------------------------------------------------------------
begin
X_Draw_Rectangle (Dpy, Main.Board.Drawable, Normal_Gc, X, Y,
U_Short (Tile_Width + 1), U_Short (Tile_Height + 1));
Call (Faces (Face), X + 1, Y + 1);
end Sample;
--\x0c
procedure Tile_Samples is
------------------------------------------------------------------------------
-- Called when we want to display all tiles as a sampler.
------------------------------------------------------------------------------
X : S_Short := Board_Tile0_X + 2 * Tile_Width;
Y : S_Short := Board_Tile0_Y;
begin
----Clear the board.
----Draw sample tiles.
Draw_Text ("Flower", Board_Tile0_X, Y);
Draw_Text ("Flower", Board_Tile0_X + 1, Y);
Sample (5, X + (Tile_Width + 1) * 0, Y);-- Draw_Bamboo
Sample (6, X + (Tile_Width + 1) * 1, Y);-- Draw_Mum
Sample (7, X + (Tile_Width + 1) * 2, Y);-- Draw_Orchid
Sample (8, X + (Tile_Width + 1) * 3, Y);-- Draw_Plum
Y := Y + Tile_Height + 1;
Draw_Text ("Season", Board_Tile0_X, Y);
Draw_Text ("Season", Board_Tile0_X + 1, Y);
Sample (1, X + (Tile_Width + 1) * 0, Y);-- Draw_Spring
Sample (2, X + (Tile_Width + 1) * 1, Y);-- Draw_Summer
Sample (3, X + (Tile_Width + 1) * 2, Y);-- Draw_Fall
Sample (4, X + (Tile_Width + 1) * 3, Y);-- Draw_Winter
Y := Y + Tile_Height + 1;
Draw_Text ("Dragon", Board_Tile0_X, Y);
Draw_Text ("Dragon", Board_Tile0_X + 1, Y);
Sample (10, X + (Tile_Width + 1) * 1, Y);-- Draw_RDragon
Sample (11, X + (Tile_Width + 1) * 2, Y);-- Draw_WDragon
Sample (9, X + (Tile_Width + 1) * 0, Y); -- Draw_GDragon
Y := Y + Tile_Height + 1;
Draw_Text ("Wind", Board_Tile0_X, Y);
Draw_Text ("Wind", Board_Tile0_X + 1, Y);
Sample (12, X + (Tile_Width + 1) * 0, Y);-- Draw_East
Sample (13, X + (Tile_Width + 1) * 1, Y);-- Draw_West
Sample (14, X + (Tile_Width + 1) * 2, Y);-- Draw_North
Sample (15, X + (Tile_Width + 1) * 3, Y);-- Draw_South
Y := Y + Tile_Height + 1;
Draw_Text ("Bam", Board_Tile0_X, Y);
Draw_Text ("Bam", Board_Tile0_X + 1, Y);
Sample (16, X + (Tile_Width + 1) * 0, Y);-- Draw_Bam1
Sample (17, X + (Tile_Width + 1) * 1, Y);-- Draw_Bam2
Sample (18, X + (Tile_Width + 1) * 2, Y);-- Draw_Bam3
Sample (19, X + (Tile_Width + 1) * 3, Y);-- Draw_Bam4
Sample (20, X + (Tile_Width + 1) * 4, Y);-- Draw_Bam5
Sample (21, X + (Tile_Width + 1) * 5, Y);-- Draw_Bam6
Sample (22, X + (Tile_Width + 1) * 6, Y);-- Draw_Bam7
Sample (23, X + (Tile_Width + 1) * 7, Y);-- Draw_Bam8
Sample (24, X + (Tile_Width + 1) * 8, Y);-- Draw_Bam9
Y := Y + Tile_Height + 1;
Draw_Text ("Dot", Board_Tile0_X, Y);
Draw_Text ("Dot", Board_Tile0_X + 1, Y);
Sample (25, X + (Tile_Width + 1) * 0, Y);-- Draw_Dot1
Sample (26, X + (Tile_Width + 1) * 1, Y);-- Draw_Dot2
Sample (27, X + (Tile_Width + 1) * 2, Y);-- Draw_Dot3
Sample (28, X + (Tile_Width + 1) * 3, Y);-- Draw_Dot4
Sample (29, X + (Tile_Width + 1) * 4, Y);-- Draw_Dot5
Sample (30, X + (Tile_Width + 1) * 5, Y);-- Draw_Dot6
Sample (31, X + (Tile_Width + 1) * 6, Y);-- Draw_Dot7
Sample (32, X + (Tile_Width + 1) * 7, Y);-- Draw_Dot8
Sample (33, X + (Tile_Width + 1) * 8, Y);-- Draw_Dot9
Y := Y + Tile_Height + 1;
Draw_Text ("Crak", Board_Tile0_X, Y);
Draw_Text ("Crak", Board_Tile0_X + 1, Y);
Sample (34, X + (Tile_Width + 1) * 0, Y);-- Draw_Crak1
Sample (35, X + (Tile_Width + 1) * 1, Y);-- Draw_Crak2
Sample (36, X + (Tile_Width + 1) * 2, Y);-- Draw_Crak3
Sample (37, X + (Tile_Width + 1) * 3, Y);-- Draw_Crak4
Sample (38, X + (Tile_Width + 1) * 4, Y);-- Draw_Crak5
Sample (39, X + (Tile_Width + 1) * 5, Y);-- Draw_Crak6
Sample (40, X + (Tile_Width + 1) * 6, Y);-- Draw_Crak7
Sample (41, X + (Tile_Width + 1) * 7, Y);-- Draw_Crak8
Sample (42, X + (Tile_Width + 1) * 8, Y);-- Draw_Crak9
X_Flush (Dpy);
end Tile_Samples;
--\x0c
procedure Show_Samples (Event : X_Button_Press_Event) is
------------------------------------------------------------------------------
-- Called when the Samples button is presses. Display or un-display the sample
-- tiles.
------------------------------------------------------------------------------
begin
X_Clear_Area (Dpy, Main.Board, 0,
Board_Tile0_Y - Side_Y - Shadow_Y, 0, 0, False);
if Board_State = S_Play then
Board_State := S_Sample;
Tile_Samples;
else
Board_State := S_Play;
Board_Expose;
end if;
end Show_Samples;
--\x0c
procedure Board_Expose is
------------------------------------------------------------------------------
-- Called when the Board receives an Expose event.
------------------------------------------------------------------------------
Success : X_Status;
Event2 : X_Event;
begin
---Draw the correct stuff. We might not want the current game.
if Board_State = S_Sample then
Tile_Samples;
return;
end if;
----Draw the entire board.
for I in S_Short range 0 .. N_Rows - 1 loop
for J in S_Short range 0 .. N_Cols - 1 loop
if Board_Tiles (I, J).Level > 0 then
Board_Tiles (I, J).Draw := True;
end if;
end loop;
end loop;
Draw_All_Tiles;
----Make sure that it all goes out to the server.
X_Flush (Dpy);
----Getting multiple events; at least when we start.
loop
X_Check_Typed_Event (Dpy, Expose, Event2, Success);
if Success /= Successful then
exit;
end if;
end loop;
end Board_Expose;
--\x0c
procedure Board_Configure (Event : X_Configure_Notify_Event) is
------------------------------------------------------------------------------
-- Called when the Board receives a ConfigureNotify event.
------------------------------------------------------------------------------
Old_Height : S_Short := Tile_Height;
begin
----Calculate the new Board size.
Board_Width := S_Short (Event.Configure.Width);
Board_Height := S_Short (Event.Configure.Height);
Tile_Width := (Board_Width - 9) / 15 - 1;
Tile_Height := (Board_Height - 9) / 10 - 1;
----Pick a tile size based upon the size of the board.
if Tile_Width >= 80 and then Tile_Height >= 96 then
Tile_Width := 80;
Tile_Height := 96;
Configure_Tiles (5);
elsif Tile_Width >= 68 and then Tile_Height >= 80 then
Tile_Width := 68;
Tile_Height := 80;
Configure_Tiles (4);
elsif Tile_Width >= 56 and then Tile_Height >= 64 then
Tile_Width := 56;
Tile_Height := 64;
Configure_Tiles (3);
elsif Tile_Width >= 40 and then Tile_Height >= 48 then
Tile_Width := 40;
Tile_Height := 48;
Configure_Tiles (2);
else
Tile_Width := 28;
Tile_Height := 32;
Configure_Tiles (1);
end if;
----Figure the real 0,0 coordinate.
Board_Tile0_X := 4;
Board_Tile0_Y := 4 + 2 * Tile_Height;
----Figure the Shadow and Side sizes.
Shadow_X := Tile_Width / 10;
Shadow_Y := Tile_Height / 10;
Side_X := (Tile_Width / 10) / 2 * 2;
Side_Y := (Tile_Height / 10) / 2 * 2;
----See if we need to repaint.
if Old_Height /= Tile_Height then
Do_Button_Configuration;
Set_Tile_Controls;
X_Clear_Area (Dpy, Main.Board, 0, 0, 0, 0, True);
end if;
end Board_Configure;
--\x0c
procedure Board_Setup is
------------------------------------------------------------------------------
-- Called to set up and create the Board widget.
------------------------------------------------------------------------------
-- static s_char actions() :=
-- "<Expose>: ButtonExpose() BoardExpose()\n\
-- <Configure>: BoardConfigure()\n\
-- <Btn1Down>: ButtonPress() TilePress()\n\
-- <Btn1Up>: ButtonRelease() TileRelease()\n\
-- <Btn2Down>: TileHints()\n\
-- <Btn3Down>: TileRemove()\n";
begin
----Define the various routines that we will be calling for various events
-- on the Board.
-- ACTION( "BoardConfigure", Board_Configure );
-- ACTION( "BoardExpose", Board_Expose );
--
-- ACTION( "ButtonExpose", Button_Expose );
-- ACTION( "ButtonPress", Button_Press );
-- ACTION( "ButtonRelease", Button_Release );-
-- ACTION( "TileHints", Hints );
-- ACTION( "TileRemove", Tile_Remove );
-- ACTION( "TilePress", Tile_Press );
-- ACTION( "TileRelease", Tile_Release );
----Give the tiles a default initial size.
declare
Event : X_Configure_Notify_Event;
begin
Event.Configure.Width := U_Short (Board_Width);
Event.Configure.Height := U_Short (Board_Height);
Board_Configure (Event);
end;
----Give the buttons a default initial size based upon the Tile sizes.
Do_Button_Configuration;
----Set up the initial game.
Setup_New_Game;
end Board_Setup;
--\x0c
end Draw;
nblk1=38
nid=0
hdr6=70
[0x00] rec0=29 rec1=00 rec2=01 rec3=00a
[0x01] rec0=0f rec1=00 rec2=02 rec3=02a
[0x02] rec0=1c rec1=00 rec2=03 rec3=010
[0x03] rec0=1d rec1=00 rec2=04 rec3=02c
[0x04] rec0=1b rec1=00 rec2=05 rec3=01a
[0x05] rec0=1b rec1=00 rec2=06 rec3=016
[0x06] rec0=1a rec1=00 rec2=07 rec3=01e
[0x07] rec0=1d rec1=00 rec2=08 rec3=036
[0x08] rec0=00 rec1=00 rec2=38 rec3=00e
[0x09] rec0=17 rec1=00 rec2=09 rec3=030
[0x0a] rec0=16 rec1=00 rec2=0a rec3=02a
[0x0b] rec0=1e rec1=00 rec2=0b rec3=014
[0x0c] rec0=00 rec1=00 rec2=37 rec3=00e
[0x0d] rec0=1c rec1=00 rec2=0c rec3=052
[0x0e] rec0=14 rec1=00 rec2=0d rec3=08a
[0x0f] rec0=19 rec1=00 rec2=0e rec3=008
[0x10] rec0=1c rec1=00 rec2=0f rec3=004
[0x11] rec0=00 rec1=00 rec2=36 rec3=018
[0x12] rec0=22 rec1=00 rec2=10 rec3=014
[0x13] rec0=17 rec1=00 rec2=11 rec3=00c
[0x14] rec0=02 rec1=00 rec2=35 rec3=034
[0x15] rec0=20 rec1=00 rec2=12 rec3=04a
[0x16] rec0=00 rec1=00 rec2=34 rec3=012
[0x17] rec0=1d rec1=00 rec2=13 rec3=096
[0x18] rec0=13 rec1=00 rec2=14 rec3=004
[0x19] rec0=11 rec1=00 rec2=15 rec3=03e
[0x1a] rec0=1a rec1=00 rec2=16 rec3=032
[0x1b] rec0=01 rec1=00 rec2=33 rec3=004
[0x1c] rec0=18 rec1=00 rec2=17 rec3=054
[0x1d] rec0=00 rec1=00 rec2=32 rec3=006
[0x1e] rec0=1a rec1=00 rec2=18 rec3=000
[0x1f] rec0=01 rec1=00 rec2=31 rec3=014
[0x20] rec0=20 rec1=00 rec2=19 rec3=00e
[0x21] rec0=00 rec1=00 rec2=30 rec3=014
[0x22] rec0=1a rec1=00 rec2=1a rec3=00e
[0x23] rec0=17 rec1=00 rec2=1b rec3=05c
[0x24] rec0=17 rec1=00 rec2=1c rec3=06c
[0x25] rec0=16 rec1=00 rec2=1d rec3=054
[0x26] rec0=14 rec1=00 rec2=1e rec3=008
[0x27] rec0=1a rec1=00 rec2=1f rec3=006
[0x28] rec0=1e rec1=00 rec2=20 rec3=018
[0x29] rec0=1a rec1=00 rec2=21 rec3=008
[0x2a] rec0=1a rec1=00 rec2=22 rec3=090
[0x2b] rec0=1a rec1=00 rec2=23 rec3=030
[0x2c] rec0=13 rec1=00 rec2=24 rec3=074
[0x2d] rec0=12 rec1=00 rec2=25 rec3=048
[0x2e] rec0=16 rec1=00 rec2=26 rec3=088
[0x2f] rec0=1e rec1=00 rec2=27 rec3=008
[0x30] rec0=00 rec1=00 rec2=2f rec3=002
[0x31] rec0=21 rec1=00 rec2=28 rec3=066
[0x32] rec0=1a rec1=00 rec2=29 rec3=00e
[0x33] rec0=00 rec1=00 rec2=2d rec3=006
[0x34] rec0=22 rec1=00 rec2=2e rec3=054
[0x35] rec0=00 rec1=00 rec2=2a rec3=014
[0x36] rec0=15 rec1=00 rec2=2b rec3=002
[0x37] rec0=1d rec1=00 rec2=2c rec3=000
tail 0x215009b548197877a327b 0x42a00088462063203