1 (* 2 * Hedgewars, a free turn based strategy game 3 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com> 4 * 5 * This program is free software; you can redistribute it and/or modify 6 * it under the terms of the GNU General Public License as published by 7 * the Free Software Foundation; version 2 of the License 8 * 9 * This program is distributed in the hope that it will be useful, 10 * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 * GNU General Public License for more details. 13 * 14 * You should have received a copy of the GNU General Public License 15 * along with this program; if not, write to the Free Software 16 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 17 *) 18 19 {$INCLUDE "options.inc"} 20 21 unit uLandPainted; 22 23 interface 24 25 procedure Draw; 26 procedure initModule; 27 procedure freeModule; 28 29 implementation 30 uses uLandGraphics, uConsts, uVariables, uUtils, SDLh, uCommands, uScript, uIO; 31 32 type PointRec = packed record 33 X, Y: SmallInt; 34 flags: byte; 35 end; 36 PPointRec = ^PointRec; 37 38 type 39 PPointEntry = ^PointEntry; 40 PointEntry = record 41 point: PointRec; 42 next: PPointEntry; 43 end; 44 45 var pointsListHead, pointsListLast: PPointEntry; 46 47 procedure chDraw(var s: shortstring); 48 var rec: PointRec; 49 prec: PPointRec; 50 pe: PPointEntry; 51 i, l: byte; 52 begin 53 i:= 1; 54 l:= length(s); 55 while i < l do 56 begin 57 prec:= PPointRec(@s[i]); 58 rec:= prec^; 59 rec.X:= SDLNet_Read16(@rec.X); 60 rec.Y:= SDLNet_Read16(@rec.Y); 61 62 if rec.X < -318 then rec.X:= -318; 63 if rec.X > 4096+318 then rec.X:= 4096+318; 64 if rec.Y < -318 then rec.Y:= -318; 65 if rec.Y > 2048+318 then rec.Y:= 2048+318; 66 67 new(pe); 68 if pointsListLast = nil then 69 pointsListHead:= pe 70 else 71 pointsListLast^.next:= pe; 72 pointsListLast:= pe; 73 74 pe^.point:= rec; 75 pe^.next:= nil; 76 77 inc(i, 5) 78 end; 79 end; 80 81 procedure Draw; 82 var pe: PPointEntry; 83 prevPoint: PointRec; 84 radius: LongInt; 85 color, Xoffset, Yoffset: Longword; 86 lineNumber, linePoints: Longword; 87 begin 88 // shutup compiler 89 prevPoint.X:= 0; 90 prevPoint.Y:= 0; 91 radius:= 0; 92 linePoints:= 0; 93 Xoffset:= (LAND_WIDTH-(playWidth)) div 2; 94 Yoffset:= LAND_HEIGHT-(playHeight); 95 96 pe:= pointsListHead; 97 while (pe <> nil) and (pe^.point.flags and $80 = 0) do 98 begin 99 ScriptCall('onSpecialPoint', pe^.point.X, pe^.point.Y, pe^.point.flags); 100 pe:= pe^.next; 101 end; 102 103 lineNumber:= 0; 104 105 while(pe <> nil) do 106 begin 107 pe^.point.X:= LongInt(pe^.point.X) * playWidth div 4096 + Xoffset; 108 pe^.point.Y:= LongInt(pe^.point.Y) * playHeight div 2048 + Yoffset; 109 if (pe^.point.flags and $80 <> 0) then 110 begin 111 if (lineNumber > 0) and (linePoints = 0) and cAdvancedMapGenMode then 112 SendIPC('|' + inttostr(lineNumber - 1)); 113 114 inc(lineNumber); 115 116 if (pe^.point.flags and $40 <> 0) then 117 color:= 0 118 else 119 color:= lfBasic; 120 radius:= (pe^.point.flags and $3F) * 5 + 3; 121 radius:= (radius * playWidth div 4096); 122 linePoints:= FillRoundInLand(pe^.point.X, pe^.point.Y, radius, color); 123 end 124 else 125 begin 126 inc(linePoints, DrawThickLine(prevPoint.X, prevPoint.Y, pe^.point.X, pe^.point.Y, radius, color)); 127 end; 128 129 prevPoint:= pe^.point; 130 pe:= pe^.next; 131 end; 132 133 if (topY > 0) then 134 EraseLandRectRaw(0, 0, LAND_WIDTH, topY); 135 if (leftX > 0) then 136 EraseLandRectRaw(0, topY, leftX, LAND_HEIGHT - topY); 137 if (rightX < (LAND_WIDTH - 1)) then 138 EraseLandRectRaw(rightX + 1, topY, LAND_WIDTH - (rightX + 1), LAND_HEIGHT - topY); 139 end; 140 141 procedure initModule; 142 begin 143 pointsListHead:= nil; 144 pointsListLast:= nil; 145 146 RegisterVariable('draw', @chDraw, false); 147 end; 148 149 procedure freeModule; 150 var pe, pp: PPointEntry; 151 begin 152 pe:= pointsListHead; 153 while(pe <> nil) do 154 begin 155 pp:= pe; 156 pe:= pe^.next; 157 dispose(pp); 158 end; 159 end; 160 161 end. 162