hedgewars/uLandPainted.pas
changeset 4497 08df377b4fbc
parent 4494 9585435e20f7
child 4648 d8e1b43482d2
equal deleted inserted replaced
4488:e83216eba1db 4497:08df377b4fbc
    21 unit uLandPainted;
    21 unit uLandPainted;
    22 
    22 
    23 interface
    23 interface
    24 
    24 
    25 procedure LoadFromFile(fileName: shortstring);
    25 procedure LoadFromFile(fileName: shortstring);
       
    26 procedure Draw;
       
    27 procedure initModule;
    26 
    28 
    27 implementation
    29 implementation
    28 uses uLandGraphics, uConsts, uUtils, SDLh;
    30 uses uLandGraphics, uConsts, uUtils, SDLh, uCommands;
    29 
    31 
    30 type PointRec = packed record
    32 type PointRec = packed record
    31     X, Y: SmallInt;
    33     X, Y: SmallInt;
    32     flags: byte;
    34     flags: byte;
    33     end;
    35     end;
       
    36 
       
    37 type
       
    38     PPointEntry = ^PointEntry;
       
    39     PointEntry = record
       
    40         point: PointRec;
       
    41         next: PPointEntry;
       
    42         end;
       
    43 
       
    44 var pointsListHead, pointsListLast: PPointEntry;
    34 
    45 
    35 procedure DrawLineOnLand(X1, Y1, X2, Y2: LongInt);
    46 procedure DrawLineOnLand(X1, Y1, X2, Y2: LongInt);
    36 var  eX, eY, dX, dY: LongInt;
    47 var  eX, eY, dX, dY: LongInt;
    37     i, sX, sY, x, y, d: LongInt;
    48     i, sX, sY, x, y, d: LongInt;
    38     b: boolean;
    49     b: boolean;
   121         end;
   132         end;
   122 
   133 
   123     closeFile(f);
   134     closeFile(f);
   124 end;
   135 end;
   125 
   136 
       
   137 procedure chDraw(var s: shortstring);
       
   138 var rec: PointRec;
       
   139     prec: ^PointRec;
       
   140     pe: PPointEntry;
       
   141     i, l: byte;
       
   142 begin
       
   143     i:= 1;
       
   144     l:= length(s);
       
   145     while i < l do
       
   146         begin
       
   147         prec:= @s[i];
       
   148         rec:= prec^;
       
   149         rec.X:= SDLNet_Read16(@rec.X);
       
   150         rec.Y:= SDLNet_Read16(@rec.Y);
       
   151 
       
   152         pe:= new(PPointEntry);
       
   153         if pointsListLast = nil then
       
   154             pointsListHead:= pe
       
   155         else
       
   156             pointsListLast^.next:= pe;
       
   157         pointsListLast:= pe;
       
   158 
       
   159         pe^.point:= rec;
       
   160         pe^.next:= nil;
       
   161 
       
   162         inc(i, 5)
       
   163         end;
       
   164 end;
       
   165 
       
   166 procedure Draw;
       
   167 var pe: PPointEntry;
       
   168     prevPoint: PointRec;
       
   169 begin
       
   170     pe:= pointsListHead;
       
   171 
       
   172     while(pe <> nil) do
       
   173         begin
       
   174         if (pe^.point.flags and $80 <> 0) then
       
   175             FillRoundInLand(pe^.point.X, pe^.point.Y, 34, lfBasic)
       
   176             else
       
   177             DrawLineOnLand(prevPoint.X, prevPoint.Y, pe^.point.X, pe^.point.Y);
       
   178 
       
   179         prevPoint:= pe^.point;
       
   180         pe:= pe^.next;
       
   181         end;
       
   182 end;
       
   183 
       
   184 procedure initModule;
       
   185 begin
       
   186     pointsListHead:= nil;
       
   187     pointsListLast:= nil;
       
   188 
       
   189     RegisterVariable('draw', vtCommand, @chDraw, false);
       
   190 end;
       
   191 
   126 end.
   192 end.