1{
2    Free Pascal port of the Hermes C library.
3    Copyright (C) 2001-2003  Nikolay Nikolov (nickysn@users.sourceforge.net)
4    Original C version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
5
6    This library is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public
8    License as published by the Free Software Foundation; either
9    version 2.1 of the License, or (at your option) any later version
10    with the following modification:
11
12    As a special exception, the copyright holders of this library give you
13    permission to link this library with independent modules to produce an
14    executable, regardless of the license terms of these independent modules,and
15    to copy and distribute the resulting executable under terms of your choice,
16    provided that you also meet, for each linked independent module, the terms
17    and conditions of the license of that module. An independent module is a
18    module which is not derived from or based on this library. If you modify
19    this library, you may extend this exception to your version of the library,
20    but you are not obligated to do so. If you do not wish to do so, delete this
21    exception statement from your version.
22
23    This library is distributed in the hope that it will be useful,
24    but WITHOUT ANY WARRANTY; without even the implied warranty of
25    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
26    Lesser General Public License for more details.
27
28    You should have received a copy of the GNU Lesser General Public
29    License along with this library; if not, write to the Free Software
30    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
31}
32
33{
34   C surface clearing routines for the HERMES library
35   Copyright (c) 1998 Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
36   This source code is licensed under the GNU LGPL
37
38   Please refer to the file COPYING.LIB contained in the distribution for
39   licensing conditions
40}
41
42procedure ClearP_32(iface: PHermesClearInterface); cdecl;
43var
44  count: DWord;
45  value: Uint32;
46  dest: PUint8;
47begin
48  value := iface^.value;
49  dest := iface^.dest;
50  repeat
51    count := iface^.width;
52    repeat
53      PUint32(dest)^ := value;
54      Inc(dest, 4);
55      Dec(count);
56    until count = 0;
57    Inc(dest, iface^.add);
58    Dec(iface^.height);
59  until iface^.height = 0;
60end;
61
62procedure ClearP_24(iface: PHermesClearInterface); cdecl;
63var
64  p_value: PUint8;
65  count: DWord;
66  dest: PUint8;
67begin
68  p_value := PUint8(@iface^.value) + (R_32 - R_24);
69  dest := iface^.dest;
70  repeat
71    count := iface^.width;
72    repeat
73      (dest + 0)^ := (p_value + 0)^;
74      (dest + 1)^ := (p_value + 1)^;
75      (dest + 2)^ := (p_value + 2)^;
76
77      Inc(dest, 3);
78      Dec(count);
79    until count = 0;
80
81    Inc(dest, iface^.add);
82    Dec(iface^.height);
83  until iface^.height = 0;
84end;
85
86procedure ClearP_16(iface: PHermesClearInterface); cdecl;
87var
88  value32: DWord;
89  countshifted, count: DWord;
90  dest: PUint8;
91begin
92  value32 := (iface^.value shl 16) or (iface^.value and $ffff);
93  dest := iface^.dest;
94  repeat
95    count := iface^.width;
96
97    { Align destination }
98    if (PtrUInt(dest) and $3) <> 0 then
99    begin
100      PUint16(dest)^ := iface^.value;
101      Inc(dest, 2);
102      Dec(count);
103    end;
104
105    countshifted := count shr 1;
106
107    while countshifted <> 0 do
108    begin
109      Dec(countshifted);
110      PUint32(dest)^ := value32;
111      Inc(dest, 4);
112    end;
113
114    if (count and 1) <> 0 then
115    begin
116      PUint16(dest)^ := iface^.value;
117      Inc(dest, 2);
118    end;
119
120    Inc(dest, iface^.add);
121    Dec(iface^.height);
122  until iface^.height = 0;
123end;
124
125{$GOTO ON}
126
127procedure ClearP_8(iface: PHermesClearInterface); cdecl;
128label
129  yloop;
130var
131  count, shiftcount: DWord;
132  value32: Uint32;
133  value: Uint8;
134  dest: PUint8;
135begin
136  dest := iface^.dest;
137
138  value := iface^.value and $ff;
139  value32 := (value shl 24) or (value shl 16) or (value shl 8) or value;
140
141  repeat
142    count := iface^.width;
143
144    while (PtrUInt(dest) and $3) <> 0 do    { Align to dword boundary }
145    begin
146      dest^ := value;
147      Inc(dest);
148      Dec(count);
149      if count = 0 then
150        goto yloop;                { GOTO's are nice ;) }
151    end;
152
153    shiftcount := count shr 2;
154
155    while shiftcount <> 0 do
156    begin
157      Dec(shiftcount);
158      PUint32(dest)^ := value32;
159      Inc(dest, 4);
160    end;
161
162    count := count and $3;
163    while count <> 0 do
164    begin
165      Dec(count);
166      dest^ := value;
167      Inc(dest);
168    end;
169
170yloop:
171    Inc(dest, iface^.add);
172    Dec(iface^.height);
173  until iface^.height = 0;
174end;
175