PageRenderTime 48ms CodeModel.GetById 19ms app.highlight 26ms RepoModel.GetById 1ms app.codeStats 0ms

/packages/hermes/src/hermes_dither.inc

https://github.com/slibre/freepascal
Pascal | 92 lines | 53 code | 6 blank | 33 comment | 6 complexity | 7cd38b733cf76a7470f0384cc73e7ce0 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
31}
32
33{ Everything in here (C)1998 The Rasterman }
34
35{ Rasterman's dither matrix }
36
37const
38  DitherMatrix_44: array [0..3, 0..3] of Uint8 = (
39    (0, 4, 1, 5),
40    (6, 2, 7, 3),
41    (1, 5, 0, 4),
42    (7, 3, 6, 2));
43
44var
45  DitherTab_r565_44: array [0..3, 0..3, 0..255] of Uint16;
46  DitherTab_g565_44: array [0..3, 0..3, 0..255] of Uint16;
47  DitherTab_b565_44: array [0..3, 0..3, 0..255] of Uint16;
48
49  DitherTab_r332_44: array [0..3, 0..3, 0..255] of Uint8;
50  DitherTab_g332_44: array [0..3, 0..3, 0..255] of Uint8;
51  DitherTab_b332_44: array [0..3, 0..3, 0..255] of Uint8;
52
53procedure Dither_SetupMatrices;
54var
55  i, x, y: LongInt;
56begin
57  for y := 0 to 3 do
58    for x := 0 to 3 do
59      for i := 0 to 255 do
60      begin
61        if (DitherMatrix_44[x, y] < (i and $7)) and (i < (256 - 8)) then
62        begin
63          DitherTab_r565_44[x, y, i] := ((i + 8) and $f8) shl 8;
64          DitherTab_r332_44[x, y, i] := ((i + 8) and $e0);
65        end
66        else
67        begin
68          DitherTab_r565_44[x, y, i] := (i and $f8) shl 8;
69          DitherTab_r332_44[x, y, i] := i and $e0;
70        end;
71        if (DitherMatrix_44[x, y] < ((i and $3) shl 1)) and (i < (256 - 4)) then
72        begin
73          DitherTab_g565_44[x, y, i] := (((i + 4) and $fc) shl 8) shr 5;
74          DitherTab_g332_44[x, y, i] := ((i + 4) and $e0) shr 3;
75        end
76        else
77        begin
78          DitherTab_g565_44[x, y, i] := ((i and $fc) shl 8) shr 5;
79          DitherTab_g332_44[x, y, i] := (i and $e0) shr 3;
80        end;
81        if (DitherMatrix_44[x, y] < (i and $7)) and (i < (256 - 8)) then
82        begin
83          DitherTab_b565_44[x, y, i] := (((i + 8) and $f8) shl 16) shr 19;
84          DitherTab_b332_44[x, y, i] := ((i + 8) shr 6) and $3;
85        end
86        else
87        begin
88          DitherTab_b565_44[x, y, i] := ((i and $f8) shl 16) shr 19;
89          DitherTab_b332_44[x, y, i] := (i shr 6) and $3;
90        end;
91      end;
92end;