Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Initial commit of the Ada FCP2 library, named AdaFN.

git-svn-id: file:///home/toad/git-migration/temprepository/trunk/apps/AdaFN@18796 67a373e5-eb02-0410-a15c-ee090a768436
  • Loading branch information...
commit 417bb2a673da682ee2a4207444fd986332c04911 0 parents
mosteo authored
Showing with 26,269 additions and 0 deletions.
  1. 0  CHANGES
  2. +7 −0 LICENSE
  3. +30 −0 Makefile
  4. +16 −0 README
  5. +106 −0 adafn.gpr
  6. +74 −0 agpl/3rdparty/asl/asl-semaphore-counting.adb
  7. +65 −0 agpl/3rdparty/asl/asl-semaphore-counting.ads
  8. +51 −0 agpl/3rdparty/asl/asl-semaphore.ads
  9. +29 −0 agpl/3rdparty/asl/asl.ads
  10. +14 −0 agpl/3rdparty/mw/exchange.adb
  11. +18 −0 agpl/3rdparty/mw/exchange.ads
  12. +240 −0 agpl/3rdparty/mw/permutations.adb
  13. +82 −0 agpl/3rdparty/mw/permutations.ads
  14. +281 −0 agpl/3rdparty/png_io/gpl.txt
  15. +168 −0 agpl/3rdparty/png_io/png_compare.adb
  16. +178 −0 agpl/3rdparty/png_io/png_io-adam7.adb
  17. +71 −0 agpl/3rdparty/png_io/png_io-adam7.ads
  18. +98 −0 agpl/3rdparty/png_io/png_io-adaptive_filter.adb
  19. +77 −0 agpl/3rdparty/png_io/png_io-chromaticity_data.ads
  20. +114 −0 agpl/3rdparty/png_io/png_io-chunk_ordering.adb
  21. +84 −0 agpl/3rdparty/png_io/png_io-gamma_encoding.adb
  22. +59 −0 agpl/3rdparty/png_io/png_io-gamma_encoding.ads
  23. +841 −0 agpl/3rdparty/png_io/png_io-open.adb
  24. +89 −0 agpl/3rdparty/png_io/png_io-standard_rgb_encodings.adb
  25. +59 −0 agpl/3rdparty/png_io/png_io-standard_rgb_encodings.ads
  26. +206 −0 agpl/3rdparty/png_io/png_io-write_png_type_0.adb
  27. +151 −0 agpl/3rdparty/png_io/png_io-write_png_type_2.adb
  28. +224 −0 agpl/3rdparty/png_io/png_io-write_png_type_3.adb
  29. +150 −0 agpl/3rdparty/png_io/png_io-write_png_type_4.adb
  30. +156 −0 agpl/3rdparty/png_io/png_io-write_png_type_6.adb
  31. +1,377 −0 agpl/3rdparty/png_io/png_io.adb
  32. +574 −0 agpl/3rdparty/png_io/png_io.ads
  33. BIN  agpl/3rdparty/png_io/png_io_manual.pdf
  34. +216 −0 agpl/3rdparty/png_io/png_test.adb
  35. +51 −0 agpl/3rdparty/xmlada/dom-core-attrs.adb
  36. +52 −0 agpl/3rdparty/xmlada/dom-core-attrs.ads
  37. +31 −0 agpl/3rdparty/xmlada/dom-core-cdata_sections.ads
  38. +142 −0 agpl/3rdparty/xmlada/dom-core-character_datas.adb
  39. +76 −0 agpl/3rdparty/xmlada/dom-core-character_datas.ads
  40. +3 −0  agpl/3rdparty/xmlada/dom-core-comments.ads
  41. +35 −0 agpl/3rdparty/xmlada/dom-core-document_fragments.ads
  42. +47 −0 agpl/3rdparty/xmlada/dom-core-document_types.adb
  43. +41 −0 agpl/3rdparty/xmlada/dom-core-document_types.ads
  44. +367 −0 agpl/3rdparty/xmlada/dom-core-documents.adb
  45. +134 −0 agpl/3rdparty/xmlada/dom-core-documents.ads
  46. +260 −0 agpl/3rdparty/xmlada/dom-core-elements.adb
  47. +127 −0 agpl/3rdparty/xmlada/dom-core-elements.ads
  48. +31 −0 agpl/3rdparty/xmlada/dom-core-entity_references.ads
  49. +1,203 −0 agpl/3rdparty/xmlada/dom-core-nodes.adb
  50. +264 −0 agpl/3rdparty/xmlada/dom-core-nodes.ads
  51. +59 −0 agpl/3rdparty/xmlada/dom-core-notations.adb
  52. +43 −0 agpl/3rdparty/xmlada/dom-core-notations.ads
  53. +32 −0 agpl/3rdparty/xmlada/dom-core-processing_instructions.ads
  54. +59 −0 agpl/3rdparty/xmlada/dom-core-texts.adb
  55. +39 −0 agpl/3rdparty/xmlada/dom-core-texts.ads
  56. +117 −0 agpl/3rdparty/xmlada/dom-core.adb
  57. +271 −0 agpl/3rdparty/xmlada/dom-core.ads
  58. +224 −0 agpl/3rdparty/xmlada/dom-readers.adb
  59. +100 −0 agpl/3rdparty/xmlada/dom-readers.ads
  60. +45 −0 agpl/3rdparty/xmlada/dom.ads
  61. +138 −0 agpl/3rdparty/xmlada/input_sources-file.adb
  62. +65 −0 agpl/3rdparty/xmlada/input_sources-file.ads
  63. +99 −0 agpl/3rdparty/xmlada/input_sources-strings.adb
  64. +66 −0 agpl/3rdparty/xmlada/input_sources-strings.ads
  65. +196 −0 agpl/3rdparty/xmlada/input_sources.adb
  66. +137 −0 agpl/3rdparty/xmlada/input_sources.ads
  67. +538 −0 agpl/3rdparty/xmlada/sax-attributes.adb
  68. +235 −0 agpl/3rdparty/xmlada/sax-attributes.ads
  69. +82 −0 agpl/3rdparty/xmlada/sax-encodings.ads
  70. +135 −0 agpl/3rdparty/xmlada/sax-exceptions.adb
  71. +97 −0 agpl/3rdparty/xmlada/sax-exceptions.ads
  72. +146 −0 agpl/3rdparty/xmlada/sax-htable.adb
  73. +77 −0 agpl/3rdparty/xmlada/sax-htable.ads
  74. +180 −0 agpl/3rdparty/xmlada/sax-locators.adb
  75. +121 −0 agpl/3rdparty/xmlada/sax-locators.ads
  76. +115 −0 agpl/3rdparty/xmlada/sax-models.adb
  77. +88 −0 agpl/3rdparty/xmlada/sax-models.ads
  78. +5,033 −0 agpl/3rdparty/xmlada/sax-readers.adb
  79. +669 −0 agpl/3rdparty/xmlada/sax-readers.ads
  80. +41 −0 agpl/3rdparty/xmlada/sax.ads
  81. +57 −0 agpl/3rdparty/xmlada/unicode-ccs-iso_8859_1.adb
  82. +48 −0 agpl/3rdparty/xmlada/unicode-ccs-iso_8859_1.ads
  83. +233 −0 agpl/3rdparty/xmlada/unicode-ccs-iso_8859_2.adb
  84. +48 −0 agpl/3rdparty/xmlada/unicode-ccs-iso_8859_2.ads
  85. +204 −0 agpl/3rdparty/xmlada/unicode-ccs-iso_8859_3.adb
  86. +43 −0 agpl/3rdparty/xmlada/unicode-ccs-iso_8859_3.ads
  87. +228 −0 agpl/3rdparty/xmlada/unicode-ccs-iso_8859_4.adb
  88. +45 −0 agpl/3rdparty/xmlada/unicode-ccs-iso_8859_4.ads
  89. +65 −0 agpl/3rdparty/xmlada/unicode-ccs.adb
  90. +78 −0 agpl/3rdparty/xmlada/unicode-ccs.ads
  91. +185 −0 agpl/3rdparty/xmlada/unicode-ces-basic_8bit.adb
  92. +128 −0 agpl/3rdparty/xmlada/unicode-ces-basic_8bit.ads
  93. +338 −0 agpl/3rdparty/xmlada/unicode-ces-utf16.adb
  94. +168 −0 agpl/3rdparty/xmlada/unicode-ces-utf16.ads
  95. +235 −0 agpl/3rdparty/xmlada/unicode-ces-utf32.adb
  96. +157 −0 agpl/3rdparty/xmlada/unicode-ces-utf32.ads
  97. +274 −0 agpl/3rdparty/xmlada/unicode-ces-utf8.adb
  98. +147 −0 agpl/3rdparty/xmlada/unicode-ces-utf8.ads
  99. +181 −0 agpl/3rdparty/xmlada/unicode-ces.adb
  100. +159 −0 agpl/3rdparty/xmlada/unicode-ces.ads
  101. +64 −0 agpl/3rdparty/xmlada/unicode-names-alpha_presentation_forms.ads
  102. +230 −0 agpl/3rdparty/xmlada/unicode-names-arabic.ads
  103. +1,049 −0 agpl/3rdparty/xmlada/unicode-names-arabic_present_formsa.ads
  104. +165 −0 agpl/3rdparty/xmlada/unicode-names-arabic_present_formsb.ads
  105. +100 −0 agpl/3rdparty/xmlada/unicode-names-armenian.ads
  106. +140 −0 agpl/3rdparty/xmlada/unicode-names-arrows.ads
  107. +163 −0 agpl/3rdparty/xmlada/unicode-names-basic_latin.ads
  108. +99 −0 agpl/3rdparty/xmlada/unicode-names-bengali.ads
  109. +29 −0 agpl/3rdparty/xmlada/unicode-names-block_elements.ads
  110. +45 −0 agpl/3rdparty/xmlada/unicode-names-bopomofo.ads
  111. +30 −0 agpl/3rdparty/xmlada/unicode-names-bopomofo_extended.ads
  112. +213 −0 agpl/3rdparty/xmlada/unicode-names-box_drawing.ads
  113. +260 −0 agpl/3rdparty/xmlada/unicode-names-braille_patterns.ads
  114. +639 −0 agpl/3rdparty/xmlada/unicode-names-canadian_aboriginal.ads
  115. +90 −0 agpl/3rdparty/xmlada/unicode-names-cherokee.ads
  116. +307 −0 agpl/3rdparty/xmlada/unicode-names-cjk_compat_ideographs.ads
  117. +311 −0 agpl/3rdparty/xmlada/unicode-names-cjk_compatibility.ads
  118. +50 −0 agpl/3rdparty/xmlada/unicode-names-cjk_compatibility_forms.ads
  119. +215 −0 agpl/3rdparty/xmlada/unicode-names-cjk_letters_months.ads
  120. +121 −0 agpl/3rdparty/xmlada/unicode-names-cjk_radicals_supplement.ads
  121. +74 −0 agpl/3rdparty/xmlada/unicode-names-cjk_symbols_and_punct.ads
  122. +5 −0 agpl/3rdparty/xmlada/unicode-names-cjk_unified_ideographs.ads
  123. +120 −0 agpl/3rdparty/xmlada/unicode-names-combining_diacritical.ads
  124. +9 −0 agpl/3rdparty/xmlada/unicode-names-combining_half_marks.ads
  125. +28 −0 agpl/3rdparty/xmlada/unicode-names-combining_marks_symbols.ads
  126. +44 −0 agpl/3rdparty/xmlada/unicode-names-control_pictures.ads
  127. +21 −0 agpl/3rdparty/xmlada/unicode-names-currency_symbols.ads
  128. +296 −0 agpl/3rdparty/xmlada/unicode-names-cyrillic.ads
  129. +114 −0 agpl/3rdparty/xmlada/unicode-names-devanagari.ads
  130. +201 −0 agpl/3rdparty/xmlada/unicode-names-dingbats.ads
Sorry, we could not display the entire diff because too many files (529) changed.
0  CHANGES
No changes.
7 LICENSE
@@ -0,0 +1,7 @@
+The AdaFN library is licensed under GPLv3 license:
+
+http://www.gnu.org/licenses/gpl-3.0.html
+
+The "or later" option is explicitly rejected for AdaFN. Any remainding license notices in source files are to be discarded in favor of this manifest.
+
+Other licensing options (e.g. GPLv2/CC compatible licensing or commercial licensing) will be considered on request.
30 Makefile
@@ -0,0 +1,30 @@
+.PHONY: all lib clean
+
+PARAMS=-XHungarian_Include_Base=No -XAgpl_Include_PngIO=No -XAgpl_Include_Boost=No -XAgpl_Include_Concorde=No
+
+PARAMSBIN=${PARAMS} -Padafn -XAdaFN_Link=Dependencies
+
+PARAMSLIB=${PARAMS} -Padafn -XAdaFN_Link=Static_Library
+
+all:
+ gprmake ${PARAMSBIN} adafn_getkey
+ gprmake ${PARAMSBIN} adafn_putfile
+ gprmake ${PARAMSBIN} adafn_putdir
+ gprmake ${PARAMSBIN} adafn_test
+
+lib:
+ # NOTE: you don't need to build the library. Just "with" the project file in your project and choose the appropriate linking type.
+ # This makefile is provided only as a way to check the build and build the utils
+ #
+ # gprmake builds the C and C++ files
+ #
+ gprmake ${PARAMSLIB}
+ #
+ # gnatmake builds all the Ada files and does the linking
+ # I think gprmake should do this too, since it does when a main procedure is specified. Bug?
+ #
+ gnatmake ${PARAMSLIB}
+
+clean:
+ gnatclean -r -q ${PARAMSBIN}
+ gnatclean -r -q ${PARAMSLIB}
16 README
@@ -0,0 +1,16 @@
+This is an Ada library implementing the FCP2 protocol for communication with a freenet node.
+
+This library is developed with GNAT and this instructions are specific for that compiler.
+
+Usage: with the adafn.gpr project file in your own project file.
+
+Alternatively: issue
+
+ make
+to build the example executables (tests folder).
+
+ make lib
+to build a statically linkable library.
+
+Tested works with gnat-gpl-2007
+Tested does not work with gnat-4.1/4.2 (Preelaborable_Initialization pragma still unimplemented in gnat).
106 adafn.gpr
@@ -0,0 +1,106 @@
+with "agpl/agpl";
+
+project AdaFN is
+
+ type Boolean is ("True", "False");
+ type Enabled_Disabled is ("Enabled", "Disabled");
+ type Yes_No is ("Yes", "No");
+
+ Lib_Name := "adafn";
+ Lib_Version := "20080324";
+
+ for Object_Dir use "obj";
+ for Source_Dirs use ();
+
+ for Languages use ("Ada");
+
+ type Build_Type is ("Debug", "Release", "No_Options", "Profile");
+ type Linking_Type is ("Dependencies", "Static_Library", "Dynamic_Library");
+
+ Build : Build_Type := external ("AdaFN_Build", "Debug");
+ Link : Linking_Type := External ("AdaFN_Link", "Dependencies");
+
+ case Link is
+ when "Dependencies" =>
+ null;
+ when "Static_Library" =>
+ for Library_Dir use "libstatic";
+ for Library_Name use Lib_Name;
+ for Library_Kind use "Static";
+ for Library_Version use Lib_Name & ".a." & Lib_Version;
+ when "Dynamic_Library" =>
+ for Library_Dir use "libdynamic";
+ for Library_Name use Lib_Name;
+ for Library_Kind use "Dynamic";
+ for Library_Version use Lib_Name & ".so." & Lib_Version;
+ end case;
+
+ Include_Core : Yes_No := external ("AdaFN_Include_Core", "Yes");
+ Include_Main : Yes_No := external ("AdaFN_Include_Main", "Yes");
+
+ case Include_Core is
+ when "Yes" => for Source_Dirs use ("src");
+ when "No" => null;
+ end case;
+
+ case Include_Main is
+ when "Yes" => for Source_Dirs use project'Source_Dirs & "src/main";
+ when "No" => null;
+ end case;
+
+ package Ide is
+ for Vcs_Kind use "Subversion";
+ end Ide;
+
+ package Compiler is
+ for Default_Switches ("C") use ("-g", "-Wall", "-O2");
+ for Default_Switches ("C++") use ("-g", "-Wall", "-O2");
+ for Default_Switches ("Ada") use ("-g", "-gnatf", "-gnat05", "-gnatwcfjklmopruvz", "-gnatyacehikn", "-gnatqQ");
+
+ case Build is
+ when "Profile" =>
+ for Default_Switches ("Ada") use Compiler'Default_Switches ("Ada") &
+ ("-O2", "-gnato", "-fstack-check", "-gnata", "-gnatpg");
+ when "Debug" =>
+ for Default_Switches ("Ada") use Compiler'Default_Switches ("Ada") &
+ ("-O2", "-gnato", "-fstack-check", "-gnata");
+ when "Release" =>
+ for Default_Switches ("Ada") use Compiler'Default_Switches ("Ada") & ("-O3", "-gnatn", "-gnatN");
+ for Default_Switches ("C") use Compiler'Default_Switches ("C") & ("-O3");
+ for Default_Switches ("C++") use Compiler'Default_Switches ("C") & ("-O3");
+ when "No_Options" =>
+ for Default_Switches ("Ada") use ("-gnat05");
+ -- Deliberately override default switches not to have any!
+ end case;
+ end Compiler;
+
+ package Binder is
+ for Default_Switches ("Ada") use ("-E", "-g");
+ end Binder;
+
+ package Linker is
+ for Default_Switches ("Ada") use ("-g", "-Wl,--gc-sections");
+ for Default_Switches ("C") use ("-g");
+ for Default_Switches ("C++") use ("-g");
+ end Linker;
+
+ package Builder is
+ for Default_Switches ("Ada") use ("-g");
+ end Builder;
+
+ package Pretty_Printer is
+ for Default_Switches ("Ada") use ("-A1", "-A2", "-A3", "-A4");
+ end Pretty_Printer;
+
+ package Naming is
+ for Specification_Suffix ("C") use ".h";
+ for Implementation_Suffix ("C") use ".c";
+ for Specification_Suffix ("C++") use ".hh";
+ for Implementation_Suffix ("C++") use ".cpp";
+ for Implementation_Suffix ("C++") use ".cc";
+ for Specification_Suffix ("Changelog") use "changelog";
+ for Specification_Suffix ("Project file") use ".gpr";
+ for Specification_Suffix ("Python") use ".py";
+ end Naming;
+
+end AdaFN;
74 agpl/3rdparty/asl/asl-semaphore-counting.adb
@@ -0,0 +1,74 @@
+-- The Ada Structured Library - A set of container classes and general
+-- tools for use with Ada95.
+-- Copyright (C) 1998-1999 Corey Minyard (minyard@acm.org)
+--
+-- This library is free software; you can redistribute it and/or modify it
+-- under the terms of the GNU General Public License as published by the
+-- Free Software Foundation; either version 2 of the License, or (at your
+-- option) any later version.
+--
+-- This library is distributed in the hope that it will be useful, but
+-- WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License along
+-- with this library; if not, write to the Free Software Foundation, Inc.,
+-- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+--
+-- As a special exception, if other files instantiate generics from this
+-- unit, or you link this unit with other files to produce an executable,
+-- this unit does not by itself cause the resulting executable to be
+-- covered by the GNU General Public License. This exception does not
+-- however invalidate any other reasons why the executable file might be
+-- covered by the GNU Public License.
+--
+
+package body Asl.Semaphore.Counting is
+
+ ------------------------------------------------------------------------
+ procedure Take (O : in out Object) is
+ begin
+ O.The_Mutex.Wait;
+ end Take;
+
+ ------------------------------------------------------------------------
+ procedure Give (O : in out Object) is
+ begin
+ O.The_Mutex.Release;
+ end Give;
+
+ ------------------------------------------------------------------------
+ procedure Try_To_Take (O : in out Object;
+ Success : out Boolean;
+ Timeout : in Duration := 0.0) is
+ begin
+ select
+ O.The_Mutex.Wait;
+ Success := True;
+ or
+ delay Timeout;
+ Success := False;
+ end select;
+ end Try_To_Take;
+
+
+ ------------------------------------------------------------------------
+ ------------------------------------------------------------------------
+ protected body Mutex is
+
+ ---------------------------------------------------------------------
+ entry Wait when (Count > 0) is
+ begin
+ Count := Count - 1;
+ end Wait;
+
+ ---------------------------------------------------------------------
+ procedure Release is
+ begin
+ Count := Count + 1;
+ end Release;
+
+ end Mutex;
+
+end Asl.Semaphore.Counting;
65 agpl/3rdparty/asl/asl-semaphore-counting.ads
@@ -0,0 +1,65 @@
+-- The Ada Structured Library - A set of container classes and general
+-- tools for use with Ada95.
+-- Copyright (C) 1998-1999 Corey Minyard (minyard@acm.org)
+--
+-- This library is free software; you can redistribute it and/or modify it
+-- under the terms of the GNU General Public License as published by the
+-- Free Software Foundation; either version 2 of the License, or (at your
+-- option) any later version.
+--
+-- This library is distributed in the hope that it will be useful, but
+-- WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License along
+-- with this library; if not, write to the Free Software Foundation, Inc.,
+-- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+--
+-- As a special exception, if other files instantiate generics from this
+-- unit, or you link this unit with other files to produce an executable,
+-- this unit does not by itself cause the resulting executable to be
+-- covered by the GNU General Public License. This exception does not
+-- however invalidate any other reasons why the executable file might be
+-- covered by the GNU Public License.
+--
+
+-- A standard counting semaphore. The initial count is specified when the
+-- semaphore is declared. The Take operation will block is the count is
+-- zero, otherwise Take will decremenet the count. Give will always
+-- increment the count.
+
+package Asl.Semaphore.Counting is
+
+ type Object (Initial_Count : Natural) is
+ new Asl.Semaphore.Object with private;
+ type Object_Ptr is access all Object;
+
+ -- Claim the semaphore. Will block until the semaphore is available.
+ procedure Take (O : in out Object);
+
+ -- Release the semaphore.
+ procedure Give (O : in out Object);
+
+ -- Try to take the semaphore, but return an error if not successful.
+ -- Returns True if the semaphore was claimed and False if not. This
+ -- will wait up to Timeout time for the semaphore to become available.
+ procedure Try_To_Take (O : in out Object;
+ Success : out Boolean;
+ Timeout : in Duration := 0.0);
+
+private
+
+ protected type Mutex (Initial_Count : Natural) is
+ entry Wait;
+ procedure Release;
+ private
+ Count : Natural := Initial_Count;
+ end Mutex;
+
+ type Object (Initial_Count : Natural) is
+ new Asl.Semaphore.Object with record
+ The_Mutex : Mutex(Initial_Count);
+ end record;
+
+end Asl.Semaphore.Counting;
51 agpl/3rdparty/asl/asl-semaphore.ads
@@ -0,0 +1,51 @@
+-- The Ada Structured Library - A set of container classes and general
+-- tools for use with Ada95.
+-- Copyright (C) 1998-1999 Corey Minyard (minyard@acm.org)
+--
+-- This library is free software; you can redistribute it and/or modify it
+-- under the terms of the GNU General Public License as published by the
+-- Free Software Foundation; either version 2 of the License, or (at your
+-- option) any later version.
+--
+-- This library is distributed in the hope that it will be useful, but
+-- WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License along
+-- with this library; if not, write to the Free Software Foundation, Inc.,
+-- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+--
+-- As a special exception, if other files instantiate generics from this
+-- unit, or you link this unit with other files to produce an executable,
+-- this unit does not by itself cause the resulting executable to be
+-- covered by the GNU General Public License. This exception does not
+-- however invalidate any other reasons why the executable file might be
+-- covered by the GNU Public License.
+--
+
+package Asl.Semaphore is
+
+ type Object is abstract tagged limited private;
+ type Object_Class is access all Object'Class;
+
+ -- Claim the semaphore. Will block until the semaphore is available.
+ procedure Take (O : in out Object)
+ is abstract;
+
+ -- Release the semaphore.
+ procedure Give (O : in out Object)
+ is abstract;
+
+ -- Try to take the semaphore, but return an error if not successful.
+ -- Returns True if the semaphore was claimed and False if not.
+ procedure Try_To_Take (O : in out Object;
+ Success : out Boolean;
+ Timeout : in Duration := 0.0)
+ is abstract;
+
+private
+
+ type Object is abstract tagged limited null record;
+
+end Asl.Semaphore;
29 agpl/3rdparty/asl/asl.ads
@@ -0,0 +1,29 @@
+-- The Ada Structured Library - A set of container classes and general
+-- tools for use with Ada95.
+-- Copyright (C) 1998-1999 Corey Minyard (minyard@acm.org)
+--
+-- This library is free software; you can redistribute it and/or modify it
+-- under the terms of the GNU General Public License as published by the
+-- Free Software Foundation; either version 2 of the License, or (at your
+-- option) any later version.
+--
+-- This library is distributed in the hope that it will be useful, but
+-- WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License along
+-- with this library; if not, write to the Free Software Foundation, Inc.,
+-- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+--
+-- As a special exception, if other files instantiate generics from this
+-- unit, or you link this unit with other files to produce an executable,
+-- this unit does not by itself cause the resulting executable to be
+-- covered by the GNU General Public License. This exception does not
+-- however invalidate any other reasons why the executable file might be
+-- covered by the GNU Public License.
+--
+
+package Asl is
+ pragma Pure;
+end Asl;
14 agpl/3rdparty/mw/exchange.adb
@@ -0,0 +1,14 @@
+-- GENERIC EXCHANGE PROCEDURE
+ --------------------------
+
+-- Creation : 17-NOV-1989 by Mats Weber.
+
+
+procedure Exchange (X, Y : in out Item) is
+
+ Temp : constant Item := X;
+
+begin
+ X := Y;
+ Y := Temp;
+end Exchange;
18 agpl/3rdparty/mw/exchange.ads
@@ -0,0 +1,18 @@
+-- GENERIC EXCHANGE PROCEDURE
+ --------------------------
+
+-- Last Modified By: Mats Weber
+-- Last Modified On: Mon Sep 8 12:04:16 1997
+-- Update Count : 2
+
+-- Creation : 17-NOV-1989 by Mats Weber, taken from package Utilities.
+
+
+generic
+ type Item (<>) is private;
+procedure Exchange (X, Y : in out Item);
+------------------
+-- Exchanges X and Y.
+
+pragma Preelaborate (Exchange);
+pragma Inline(Exchange);
240 agpl/3rdparty/mw/permutations.adb
@@ -0,0 +1,240 @@
+-- GENERIC PACKAGE FOR HANDLING PERMUTATIONS OF DISCRETE ITEMS
+ -----------------------------------------------------------
+
+-- Creation : 17-JAN-1989 by Mats Weber.
+
+
+with Exchange;
+
+package body Permutations is
+-------------------------
+
+ function Identity return Permutation is
+
+ Result : Permutation;
+
+ begin
+ for A in Discrete loop
+ Result(A) := A;
+ end loop;
+ return Result;
+ end Identity;
+
+
+ function To_Permutation (The_Cycle : Cycle) return Permutation is
+
+ Result : Permutation := Identity;
+
+ begin
+ for I in The_Cycle.Contents'First..The_Cycle.Contents'Last - 1 loop
+ Result(The_Cycle.Contents(I)) := The_Cycle.Contents(I + 1);
+ end loop;
+ Result(The_Cycle.Contents(The_Cycle.Contents'Last)) := The_Cycle.Contents(The_Cycle.Contents'First);
+ return Result;
+ end To_Permutation;
+
+
+ function Equal (Left, Right : Cycle) return Boolean is
+ begin
+ return To_Permutation(Left) = To_Permutation(Right);
+ end Equal;
+
+
+ function "*" (Left : Permutation; Right : Permutation) return Permutation is
+
+ Result : Permutation;
+
+ begin
+ for A in Discrete loop
+ Result(A) := Left(Right(A));
+ end loop;
+ return Result;
+ end "*";
+
+ function "*" (Left : Permutation; Right : Cycle) return Permutation is
+ begin
+ return Left * To_Permutation(Right);
+ end "*";
+
+ function "*" (Left : Cycle; Right : Permutation) return Permutation is
+ begin
+ return To_Permutation(Left) * Right;
+ end "*";
+
+ function "*" (Left : Cycle; Right : Cycle) return Permutation is
+ begin
+ return To_Permutation(Left) * To_Permutation(Right);
+ end "*";
+
+
+ function Inverse (Of_Permutation : Permutation) return Permutation is
+
+ Result : Permutation;
+
+ begin
+ for A in Discrete loop
+ Result(Of_Permutation(A)) := A;
+ end loop;
+ return Result;
+ end Inverse;
+
+ function Inverse (Of_Cycle : Cycle) return Cycle is
+
+ Result : Cycle(Of_Cycle.Length);
+
+ begin
+ for I in Of_Cycle.Contents'Range loop
+ Result.Contents(Result.Contents'Last - I + Result.Contents'First) := Of_Cycle.Contents(I);
+ end loop;
+ return Result;
+ end Inverse;
+
+
+ function Decomposition (Of_Permutation : Permutation) return Cycle_List is
+
+ Start_Of_Cycle : Discrete := Discrete'First;
+ A : Discrete;
+ Visited : array (Discrete) of Boolean := (others => False);
+ Cycle_Contents : Discrete_List(1..Cycle_Length'Last);
+ Length_Of_Cycle : Count range 1..Cycle_Length'Last;
+ Result : Cycle_List(1..Permutation'Length / 2);
+ Result_Length : Count range 0..Result'Last := 0;
+
+ begin
+ Decomposition_Loop :
+ loop
+ A := Start_Of_Cycle;
+ Length_Of_Cycle := 1;
+ loop
+ Visited(A) := True;
+ Cycle_Contents(Length_Of_Cycle) := A;
+ A := Of_Permutation(A);
+ exit when A = Start_Of_Cycle;
+ Length_Of_Cycle := Length_Of_Cycle + 1;
+ end loop;
+ if Length_Of_Cycle > 1 then
+ Result_Length := Result_Length + 1;
+ Result(Result_Length) := (Length => Length_Of_Cycle,
+ Contents => Cycle_Contents(1..Length_Of_Cycle));
+ end if;
+ loop
+ exit Decomposition_Loop when Start_Of_Cycle = Discrete'Last;
+ Start_Of_Cycle := Discrete'Succ(Start_Of_Cycle);
+ exit when not Visited(Start_Of_Cycle);
+ end loop;
+ end loop Decomposition_Loop;
+ return Result(1..Result_Length);
+ end Decomposition;
+
+ function Decomposition (Of_Permutation : Permutation) return Transposition_List is
+
+ Decomposition_In_Cycles : constant Cycle_List := Decomposition(Of_Permutation);
+
+ subtype Index is Count range 0..Decomposition_In_Cycles'Last;
+
+ function Concatenate (Last : Index) return Transposition_List is
+ begin
+ if Last = 0 then
+ declare
+
+ Null_List : Transposition_List(1..0);
+
+ begin
+ return Null_List;
+ end;
+ else
+ return Concatenate(Last => Last - 1) & Decomposition(Of_Cycle => Decomposition_In_Cycles(Last));
+ end if;
+ end Concatenate;
+
+ begin
+ return Concatenate(Last => Decomposition_In_Cycles'Last);
+ end Decomposition;
+
+ function Decomposition (Of_Cycle : Cycle) return Transposition_List is
+
+ Result : Transposition_List(1..Of_Cycle.Length - 1);
+
+ begin
+ for I in Result'Range loop
+ Result(I).Contents(1) := Of_Cycle.Contents(1);
+ Result(I).Contents(2) := Of_Cycle.Contents(I + 1);
+ end loop;
+ return Result;
+ end Decomposition;
+
+
+ function Signature (Of_Permutation : Permutation) return Parity is
+
+ Decomposition_In_Cycles : constant Cycle_List := Decomposition(Of_Permutation);
+ Result : Parity := Even;
+
+ begin
+ for I in Decomposition_In_Cycles'Range loop
+ Result := Result * Signature(Of_Cycle => Decomposition_In_Cycles(I));
+ end loop;
+ return Result;
+ end Signature;
+
+ function Signature (Of_Cycle : Cycle) return Parity is
+ begin
+ if Of_Cycle.Length mod 2 = 0 then
+ return Odd;
+ else
+ return Even;
+ end if;
+ end Signature;
+
+
+ function "*" (Left, Right : Parity) return Parity is
+ begin
+ if Left = Right then
+ return Even;
+ else
+ return Odd;
+ end if;
+ end "*";
+
+
+ procedure Enumeration is
+
+ Current_Permutation : Permutation;
+ Already_Taken : array (Discrete) of Boolean := (others => False);
+
+ procedure Set_Image_Of (A : in Discrete) is
+ begin
+ for B in Discrete loop
+ if not Already_Taken(B) then
+ Current_Permutation(A) := B;
+ Already_Taken(B) := True;
+ if A = Discrete'Last then
+ Action(Current_Permutation);
+ else
+ Set_Image_Of(Discrete'Succ(A));
+ end if;
+ Already_Taken(B) := False;
+ end if;
+ end loop;
+ end Set_Image_Of;
+
+ begin
+ Set_Image_Of(Discrete'First);
+ end Enumeration;
+
+
+ function Random_Permutation return Permutation is
+
+ Result : Permutation := Identity;
+
+ procedure Swap is new Exchange(Discrete);
+
+ begin
+ for J in reverse Discrete'Succ(Discrete'First)..Discrete'Last loop
+ Swap(Result(J),
+ Result(Discrete'Val(Uniform(Discrete'Pos(Discrete'First),
+ Discrete'Pos(J)))));
+ end loop;
+ return Result;
+ end Random_Permutation;
+
+end Permutations;
82 agpl/3rdparty/mw/permutations.ads
@@ -0,0 +1,82 @@
+-- GENERIC PACKAGE FOR HANDLING PERMUTATIONS OF DISCRETE ITEMS
+ -----------------------------------------------------------
+
+-- Revision : 15-OCT-1990 by Mats Weber, changed generic parameter of Random_Permutation
+-- in order to avoid trial-and-error in its
+-- implementation.
+-- Revision : 31-JAN-1989 by Mats Weber, added generic function RANDOM_PERMUTATION.
+
+-- Creation : 13-JAN-1989 by Mats Weber.
+
+
+generic
+ type Discrete is (<>); -- Must have at least two values
+ type Count is range <>;
+package Permutations is
+
+ pragma Preelaborate;
+
+ subtype Positive_Count is Count range 1..Count'Last;
+
+ type Permutation is array (Discrete) of Discrete;
+ ----------------
+
+ subtype Cycle_Length is Count range 2..Permutation'Length;
+
+ type Discrete_List is array (Positive_Count range <>) of Discrete;
+
+ type Cycle (Length : Cycle_Length := 2) is
+ ----------
+ record
+ Contents : Discrete_List(1..Length);
+ end record;
+
+ type Cycle_List is array (Positive_Count range <>) of Cycle;
+
+ subtype Transposition is Cycle(Length => 2);
+ ---------------------
+
+ type Transposition_List is array (Positive_Count range <>) of Transposition;
+
+ type Parity is (Even, Odd);
+ -----------
+
+
+ function Identity return Permutation;
+
+ function To_Permutation (The_Cycle : Cycle) return Permutation;
+
+ function Equal (Left, Right : Cycle) return Boolean;
+ -- Returns TRUE if and only if LEFT and RIGHT represent the same permutation.
+
+ function "*" (Left : Permutation; Right : Permutation) return Permutation;
+ function "*" (Left : Permutation; Right : Cycle) return Permutation;
+ function "*" (Left : Cycle; Right : Permutation) return Permutation;
+ function "*" (Left : Cycle; Right : Cycle) return Permutation;
+ -- Returns the permutation A -> LEFT(RIGHT(A)) for all A of type DISCRETE.
+
+ function Inverse (Of_Permutation : Permutation) return Permutation;
+ function Inverse (Of_Cycle : Cycle) return Cycle;
+
+ function Decomposition (Of_Permutation : Permutation) return Cycle_List;
+ function Decomposition (Of_Permutation : Permutation) return Transposition_List;
+ function Decomposition (Of_Cycle : Cycle) return Transposition_List;
+
+ function Signature (Of_Permutation : Permutation) return Parity;
+ function Signature (Of_Cycle : Cycle) return Parity;
+
+ function "*" (Left, Right : Parity) return Parity;
+
+ generic
+ with procedure Action (A_Permutation : in Permutation);
+ procedure Enumeration;
+ -- Enumerates all possible permutations of discrete.
+
+ generic
+ with function Uniform (First, Last : Count) return Count;
+ -- must return a uniformly distributed Count in the
+ -- range First..Last.
+ function Random_Permutation return Permutation;
+ -- Returns a uniformly distributed random permutation.
+
+end Permutations;
281 agpl/3rdparty/png_io/gpl.txt
@@ -0,0 +1,281 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
168 agpl/3rdparty/png_io/png_compare.adb
@@ -0,0 +1,168 @@
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO -- Ada95 Portable Network Graphics Input/Output Package --
+-- --
+-- Copyright (©) 2000 Dr Stephen J. Sangwine (S.Sangwine@IEEE.org) --
+-- --
+-- This software was created by Stephen J. Sangwine. He hereby --
+-- asserts his Moral Right to be identified as author of this --
+-- software. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as --
+-- published by the Free Software Foundation; either version 2 of --
+-- the License, or (at your option) any later version. --
+-- --
+-- PNG_IO is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
+-- GNU General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public --
+-- License along with this software (in the file gpl.txt); if not, --
+-- contact the Free Software Foundation, or access www.fsf.org. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- Created: 18 July 2000 --
+-- Modified: 6 February 2001 to fix stupid error! The first file --
+-- was read twice and the second file --
+-- was ignored. How did I miss that? --
+-- 7 June 2002 to output the actual pixel values --
+-- which do not match. --
+-- 3 January 2002 to output the largest difference in --
+-- sample values if non-zero. --
+-- 22 March 2004 to output the Zlib version as well --
+-- as the PNG_IO version. --
+-- 20 July 2004 to remove the exception handler. --
+-- 10 September 2006 to set exit status. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG image comparison program. Reads two PNG image files and --
+-- verifies that they contain the same pixel data. If the two PNGs --
+-- were written by different coders, the comparison validates one --
+-- coder against the other for correctness of the pixel data. This --
+-- can be used to check PNG_IO against other PNG coders. It checks --
+-- colour palettes for Type 3 PNGs only indirectly, since it gets --
+-- the pixel values after looking up the palette. If any pixels --
+-- differ, the values are output. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+
+with Ada.Command_Line, Ada.Text_IO;
+use Ada.Command_Line, Ada.Text_IO;
+
+with PNG_IO;
+use PNG_IO;
+
+procedure PNG_Compare is
+
+ Filename1 : constant String := Argument(1); -- Two PNGs of the
+ Filename2 : constant String := Argument(2); -- same image.
+
+ F1, F2 : PNG_File;
+
+begin
+
+ Put_Line("Opening file: " & Filename1);
+ Open(F1, Filename1);
+
+ Put_Line("Opening file: " & Filename2);
+ Open(F2, Filename2);
+
+ declare
+ W1 : constant Dimension := Width(F1);
+ W2 : constant Dimension := Width(F2);
+ H1 : constant Dimension := Height(F1);
+ H2 : constant Dimension := Height(F2);
+ D1 : constant Depth := Bit_Depth(F1);
+ D2 : constant Depth := Bit_Depth(F2);
+ T1 : constant Colour_Type_Code := Colour_Type(F1);
+ T2 : constant Colour_Type_Code := Colour_Type(F2);
+ begin
+ Put_Line("PNG_IO version " & Version);
+ Put_Line("Zlib version " & Zlib_Version);
+ if W1 /= W2 or H1 /= H2 or D1 /= D2 or T1 /= T2 then
+ Put_Line("The two files are not of the same size, bit depth or PNG type.");
+ Set_Exit_Status(Failure);
+ return;
+ end if;
+
+ -- The two files seem to be compatible. Read all the pixel information and
+ -- compare, and output a message if any pixel or alpha values do not match.
+
+ declare
+ subtype Row_Coordinate is Coordinate range 0 .. H1 - 1;
+ subtype Col_Coordinate is Coordinate range 0 .. W1 - 1;
+
+ function Coordinate_Image(R : Row_Coordinate;
+ C : Col_Coordinate) return String is
+ begin
+ return '(' & Row_Coordinate'Image(R) & ','
+ & Col_Coordinate'Image(C) & ')';
+ end Coordinate_Image;
+
+ All_Pixels_Match : Boolean := True;
+
+ subtype String_5 is String(1 .. 5);
+
+ Maximum_Difference : Natural := 0;
+
+ generic
+ Label : in String_5;
+ with function Value(F : PNG_File; R, C : Coordinate) return Natural;
+ procedure Check(R, C : Coordinate);
+
+ procedure Check(R, C : Coordinate) is
+ V1 : constant Natural := Value(F1, R, C);
+ V2 : constant Natural := Value(F2, R, C);
+ begin
+ if V1 /= V2 then
+ Put_Line(Label & " values do not match at: " & Coordinate_Image(R, C) &
+ ": " & Natural'Image(V1) & ' ' & Natural'Image(V2));
+ All_Pixels_Match := False;
+ declare
+ Difference : constant Integer := Integer(V1) - Integer(V2);
+ begin
+ Maximum_Difference := Natural'Max(Maximum_Difference, Natural(abs Difference));
+ end;
+ end if;
+ end Check;
+
+ procedure Check_Red is new Check("Red ", Red_Value);
+ procedure Check_Green is new Check("Green", Green_Value);
+ procedure Check_Blue is new Check("Blue ", Blue_Value);
+ procedure Check_Alpha is new Check("Alpha", Alpha_Value);
+ procedure Check_Grey is new Check("Grey ", Pixel_Value);
+
+ begin
+ for R in Row_Coordinate loop
+ for C in Col_Coordinate loop
+ if Colour(T1) then
+ Check_Red (R, C);
+ Check_Green(R, C);
+ Check_Blue (R, C);
+ else
+ Check_Grey (R, C);
+ end if;
+ if Alpha(T1) then
+ Check_Alpha(R, C);
+ end if;
+ end loop;
+ end loop;
+ if All_Pixels_Match then
+ Put_Line("No pixel value differences encountered.");
+ Set_Exit_Status(Success);
+ else
+ Put_Line("Maximum difference in samples was: " & Natural'Image(Maximum_Difference));
+ Set_Exit_Status(Failure);
+ end if;
+ New_Line;
+ end;
+
+ Close(F1);
+ Close(F2);
+
+ end;
+
+end PNG_Compare;
178 agpl/3rdparty/png_io/png_io-adam7.adb
@@ -0,0 +1,178 @@
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO -- Ada95 Portable Network Graphics Input/Output Package --
+-- --
+-- Copyright (©) 1999 Dr Stephen J. Sangwine (S.Sangwine@IEEE.org) --
+-- --
+-- This software was created by Stephen J. Sangwine. He hereby --
+-- asserts his Moral Right to be identified as author of this --
+-- software. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as --
+-- published by the Free Software Foundation; either version 2 of --
+-- the License, or (at your option) any later version. --
+-- --
+-- PNG_IO is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
+-- GNU General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public --
+-- License along with this software (in the file gpl.txt); if not, --
+-- contact the Free Software Foundation, or access www.fsf.org. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- Date: 26 August 1999 --
+-- Edited: 24 May - 4 June 2002 to add code for interlaced output. --
+-- 20 June 2003 converted from a separate to a child body. --
+-- 9 January 2004 to delete Inline pragmas (the functions --
+-- are not likely to be called enough to --
+-- justify them). --
+-- 13 August 2006 to replace reference to the PNG spec --
+-- with reference to the ISO standard. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+
+with Ada.Exceptions;
+use Ada.Exceptions;
+
+package body PNG_IO.Adam7 is
+
+ -- This package is implemented using table-driven code, because the Adam7
+ -- scheme is quite complex, but at the same time systematic and capable of
+ -- coding using tables.
+
+ -- The next table is the fundamental definition of the Adam7 scheme.
+ -- It represents an 8 by 8 block of pixels within the image and it indicates
+ -- for each pixel in the block which of the seven passes the pixel falls within.
+ -- This is documented in Section 8.2 of the ISO standard.
+
+ subtype Index is Natural range 0 .. 7;
+
+ Pass_Table : constant array(Index, Index) of Pass_Number :=
+
+ -- 0 1 2 3 4 5 6 7
+
+ (0 => ( 1, 6, 4, 6, 2, 6, 4, 6 ),
+ 1 => ( 7, 7, 7, 7, 7, 7, 7, 7 ),
+ 2 => ( 5, 6, 5, 6, 5, 6, 5, 6 ),
+ 3 => ( 7, 7, 7, 7, 7, 7, 7, 7 ),
+ 4 => ( 3, 6, 4, 6, 3, 6, 4, 6 ),
+ 5 => ( 7, 7, 7, 7, 7, 7, 7, 7 ),
+ 6 => ( 5, 6, 5, 6, 5, 6, 5, 6 ),
+ 7 => ( 7, 7, 7, 7, 7, 7, 7, 7 ));
+
+ -- The next two tables give the number of scan lines and columns within an 8 by 8 block
+ -- which are accessed on each pass. Pass 7 for example accesses all 8 columns of the
+ -- block, but only 4 rows.
+
+ N_Lines : constant array(Pass_Number) of Positive range 1 .. 4 := (1, 1, 1, 2, 2, 4, 4);
+ N_Columns : constant array(Pass_Number) of Positive range 1 .. 8 := (1, 1, 2, 2, 4, 4, 8);
+
+ function Pass(R, C : Coordinate) return Pass_Number is
+ begin
+ return Pass_Table(R mod 8, C mod 8);
+ end Pass;
+
+ function Sub_Image_Width(W : Dimension; P : Pass_Number) return Natural is
+
+ -- The width of a sub-image in a given pass is determined by the number
+ -- of columns in each 8 by 8 block which contain pixels in that pass,
+ -- times the number of 8 by 8 blocks across the image, plus an addition
+ -- for the odd few columns (if any) past the last complete 8. The latter
+ -- is what is tabulated below.
+
+ Extra_Columns : constant array(Index, Pass_Number) of Index :=
+ (0 => (0, 0, 0, 0, 0, 0, 0),
+ 1 => (1, 0, 1, 0, 1, 0, 1),
+ 2 => (1, 0, 1, 0, 1, 1, 2),
+ 3 => (1, 0, 1, 1, 2, 1, 3),
+ 4 => (1, 0, 1, 1, 2, 2, 4),
+ 5 => (1, 1, 2, 1, 3, 2, 5),
+ 6 => (1, 1, 2, 1, 3, 3, 6),
+ 7 => (1, 1, 2, 2, 4, 3, 7));
+ begin
+ return (W/8) * N_Columns(P) + Extra_Columns(W mod 8, P);
+ end Sub_Image_Width;
+
+ function Sub_Image_Height(H : Dimension; P : Pass_Number) return Natural is
+ -- See comment in previous function.
+ Extra_Lines : constant array(Index, Pass_Number) of Index :=
+ (0 => (0, 0, 0, 0, 0, 0, 0),
+ 1 => (1, 1, 0, 1, 0, 1, 0),
+ 2 => (1, 1, 0, 1, 0, 1, 1),
+ 3 => (1, 1, 0, 1, 1, 2, 1),
+ 4 => (1, 1, 0, 1, 1, 2, 2),
+ 5 => (1, 1, 1, 2, 1, 3, 2),
+ 6 => (1, 1, 1, 2, 1, 3, 3),
+ 7 => (1, 1, 1, 2, 2, 4, 3));
+ begin
+ return (H/8) * N_Lines(P) + Extra_Lines(H mod 8, P);
+ end Sub_Image_Height;
+
+ X : constant := -1; -- Indicates a don't care value.
+
+ subtype Offset is Integer range X .. Index'Last;
+
+ function Sub_Image_Row(R, C : Coordinate) return Coordinate is
+ P : constant Pass_Number := Pass(R, C);
+ T : constant array(Index, Pass_Number) of Offset :=
+ -- 1 2 3 4 5 6 7
+ (0 => (0, 0, X, 0, X, 0, X),
+ 1 => (X, X, X, X, X, X, 0),
+ 2 => (X, X, X, X, 0, 1, X),
+ 3 => (X, X, X, X, X, X, 1),
+ 4 => (X, X, 0, 1, X, 2, X),
+ 5 => (X, X, X, X, X, X, 2),
+ 6 => (X, X, X, X, 1, 3, X),
+ 7 => (X, X, X, X, X, X, 3));
+ O : constant Offset := T(R mod 8, P);
+ begin
+ if O = X then
+ Raise_Exception(Program_Error'Identity,
+ "Internal error in Adam7.Sub_Image_Row.");
+ end if;
+ return (R/8) * N_Lines(P) + O;
+ end Sub_Image_Row;
+
+ function Sub_Image_Col(R, C : Coordinate) return Coordinate is
+ P : constant Pass_Number := Pass(R, C);
+ T : constant array(Pass_Number, Index) of Offset :=
+ -- 0 1 2 3 4 5 6 7
+ (1 => (0, X, X, X, X, X, X, X),
+ 2 => (X, X, X, X, 0, X, X, X),
+ 3 => (0, X, X, X, 1, X, X, X),
+ 4 => (X, X, 0, X, X, X, 1, X),
+ 5 => (0, X, 1, X, 2, X, 3, X),
+ 6 => (X, 0, X, 1, X, 2, X, 3),
+ 7 => (0, 1, 2, 3, 4, 5, 6, 7));
+ O : constant Offset := T(P, C mod 8);
+ begin
+ if O = X then
+ Raise_Exception(Program_Error'Identity,
+ "Internal error in Adam7.Sub_Image_Col.");
+ end if;
+ return (C/8) * N_Columns(P) + O;
+ end Sub_Image_Col;
+
+ -- The two following functions map from a coordinate within a sub-image to the
+ -- corresponding coordinate in the whole image. There is no error checking here
+ -- because the algorithm is valid for arbitrary sized images.
+
+ function Image_Row(R : Coordinate; P : Pass_Number) return Coordinate is
+ Scale : constant array(Pass_Number) of Positive range 2 .. 8 := (8, 8, 8, 4, 4, 2, 2);
+ Offset : constant array(Pass_Number) of Natural range 0 .. 4 := (0, 0, 4, 0, 2, 0, 1);
+ begin
+ return R * Scale(P) + Offset(P);
+ end Image_Row;
+
+ function Image_Col(C : Coordinate; P : Pass_Number) return Coordinate is
+ Scale : constant array(Pass_Number) of Positive range 1 .. 8 := (8, 8, 4, 4, 2, 2, 1);
+ Offset : constant array(Pass_Number) of Natural range 0 .. 4 := (0, 4, 0, 2, 0, 1, 0);
+ begin
+ return C * Scale(P) + Offset(P);
+ end Image_Col;
+
+end PNG_IO.Adam7;
71 agpl/3rdparty/png_io/png_io-adam7.ads
@@ -0,0 +1,71 @@
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO -- Ada95 Portable Network Graphics Input/Output Package --
+-- --
+-- Copyright (©) 1999 Dr Stephen J. Sangwine (S.Sangwine@IEEE.org) --
+-- --
+-- This software was created by Stephen J. Sangwine. He hereby --
+-- asserts his Moral Right to be identified as author of this --
+-- software. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as --
+-- published by the Free Software Foundation; either version 2 of --
+-- the License, or (at your option) any later version. --
+-- --
+-- PNG_IO is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
+-- GNU General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public --
+-- License along with this software (in the file gpl.txt); if not, --
+-- contact the Free Software Foundation, or access www.fsf.org. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- Date: 20 June 2003 converted from a package nested in the --
+-- body of PNG_IO to a private child package. --
+-- 13 August 2006 to replace reference to the PNG spec with --
+-- reference to the ISO standard. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+
+private package PNG_IO.Adam7 is
+
+ -- A package of functions for handling interlaced images using the Adam7
+ -- interlacing scheme which requires 7 passes over the image.
+
+ type Pass_Number is range 1 .. 7;
+
+ -- Pass returns the pass number for a given pixel in the whole image,
+ -- assuming that the image is Adam7 interlaced.
+
+ function Pass(R, C : Coordinate) return Pass_Number;
+
+ -- The width or height of a sub-image may be zero for images with fewer
+ -- than 5 rows or columns. See the ISO standard, Section 8.2. This is
+ -- why the next two functions return Natural, not Dimension.
+
+ function Sub_Image_Width (W : Dimension; P : Pass_Number) return Natural;
+ function Sub_Image_Height(H : Dimension; P : Pass_Number) return Natural;
+
+ -- On input, pixels from an interlaced image must be fetched from the decompressed
+ -- data buffer by computing the coordinates within the sub-image for the appropriate
+ -- pass. The function Pass (above) determines which pass the pixel occurs in, and
+ -- the two following functions determine the coordinates within the sub-image.
+
+ function Sub_Image_Row(R, C : Coordinate) return Coordinate;
+ function Sub_Image_Col(R, C : Coordinate) return Coordinate;
+
+ -- On output, the Write procedures need to fetch pixels within a pass in
+ -- raster sequence within the sub-image. This will not be raster sequence in the
+ -- whole image, and the following two functions map from coordinates within
+ -- a sub-image of a given pass to the coordinate position in the whole image
+ -- which is needed to fetch the pixel value from the user's code.
+
+ function Image_Row(R : Coordinate; P : Pass_Number) return Coordinate;
+ function Image_Col(C : Coordinate; P : Pass_Number) return Coordinate;
+
+end PNG_IO.Adam7;
+
98 agpl/3rdparty/png_io/png_io-adaptive_filter.adb
@@ -0,0 +1,98 @@
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO -- Ada95 Portable Network Graphics Input/Output Package --
+-- --
+-- Copyright (©) 1999 Dr Stephen J. Sangwine (S.Sangwine@IEEE.org) --
+-- --
+-- This software was created by Stephen J. Sangwine. He hereby --
+-- asserts his Moral Right to be identified as author of this --
+-- software. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as --
+-- published by the Free Software Foundation; either version 2 of --
+-- the License, or (at your option) any later version. --
+-- --
+-- PNG_IO is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
+-- GNU General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public --
+-- License along with this software (in the file gpl.txt); if not, --
+-- contact the Free Software Foundation, or access www.fsf.org. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- Date: 26 August 1999 --
+-- Edited: 7 July 2004 to use Stream_Element_Array. --
+-- 13 August 2006 to replace reference to the PNG spec with --
+-- reference to the ISO standard. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- A function to perform adaptive filtering of the scanlines in an --
+-- image. The two scanlines supplied must be the same length and --
+-- contain the raw byte sequence of an image scanline and the --
+-- previous scanline. (For the first scanline in an image or pass --
+-- of an interlaced image, Previous MUST be supplied as an array --
+-- of zero bytes.) The returned result is one byte longer and --
+-- consists of the filter type byte followed by the filtered --
+-- scanline ready for input to Zlib compression. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+
+separate(PNG_IO)
+function Adaptive_Filter(Raw, Prior : Stream_Element_Array)
+ return Stream_Element_Array is
+ S, U, A, P : Stream_Element_Array(1 .. Raw'Last); -- Sub, Up, Average, Paeth.
+begin
+ pragma Assert(Raw'Length = Prior'Length);
+ for I in Raw'Range loop -- Compute the four non-trivial filters.
+ if I <= Bpp then
+ S(I) := Raw(I);
+ A(I) := Raw(I) - Mean(0, Prior(I));
+ P(I) := Raw(I) - PaethPredictor(0, Prior(I), 0);
+ else
+ S(I) := Raw(I) - Raw(I - Bpp);
+ A(I) := Raw(I) - Mean(Raw(I - Bpp), Prior(I));
+ P(I) := Raw(I) - PaethPredictor(Raw(I - Bpp), Prior(I), Prior(I - Bpp));
+ end if;
+ U(I) := Raw(I) - Prior(I);
+ end loop;
+ -- Now decide which filter is best for the scanline Raw. The method
+ -- employed here is the heuristic suggested in Section 12.8 of the
+ -- ISO standard: compute the sum of absolute values taking the
+ -- values as signed differences.
+ declare
+ function Sigma(X : Stream_Element_Array) return Natural is
+ R : Natural := 0;
+ begin
+ for I in X'First .. X'Last - 1 loop
+ if (X(I) and 2#1000_0000#) /= 0 then
+ -- Value is 'negative'
+ R := R + (256 - Natural(X(I)));
+ else
+ R := R + Natural(X(I));
+ end if;
+ end loop;
+ return R;
+ end Sigma;
+ SN : constant Natural := Sigma(Raw);
+ SS : constant Natural := Sigma(S);
+ SU : constant Natural := Sigma(U);
+ SA : constant Natural := Sigma(A);
+ SP : constant Natural := Sigma(P);
+ begin
+ if SN <= SS and then SN <= SU and then SN <= SA and then SN <= SP then
+ return None & Raw;
+ elsif SS <= SU and then SS <= SA and then SS <= SP then
+ return Sub & S;
+ elsif SU <= SA and then SU <= SP then
+ return Up & U;
+ elsif SA <= SP then
+ return Average & A;
+ else
+ return Paeth & P;
+ end if;
+ end;
+end Adaptive_Filter;
77 agpl/3rdparty/png_io/png_io-chromaticity_data.ads
@@ -0,0 +1,77 @@
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO -- Ada95 Portable Network Graphics Input/Output Package --
+-- --
+-- Copyright (©) 2001 Dr Stephen J. Sangwine (S.Sangwine@IEEE.org) --
+-- --
+-- This software was created by Stephen J. Sangwine. He hereby --
+-- asserts his Moral Right to be identified as author of this --
+-- software. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as --
+-- published by the Free Software Foundation; either version 2 of --
+-- the License, or (at your option) any later version. --
+-- --
+-- PNG_IO is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
+-- GNU General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public --
+-- License along with this software (in the file gpl.txt); if not, --
+-- contact the Free Software Foundation, or access www.fsf.org. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- Date: 8 March 2001 --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- This package defines some standard chromaticity data for use in --
+-- constructing chromaticity chunks. The values given here are --
+-- (x, y) chromaticity coordinates scaled by 100_000, so that they --
+-- are in the form required for the parameters of the function --
+-- PNG_IO.Chromaticity_Chunk. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+
+package PNG_IO.Chromaticity_Data is
+
+ -- CIE standardized whitepoints, taken from:
+ --
+ -- Sproson, W. N., Colour Science in Television and Display Systems,
+ -- Adam Hilger, Bristol, 1983, p29,32.
+
+ C : constant Pair := (31_010, 31_620);
+ D65 : constant Pair := (31_270, 32_900);
+
+ -- RGB television system primaries.
+
+ EBU_R : constant Pair := (64_000, 33_000); -- Given by Sproson (ibid)
+ EBU_G : constant Pair := (29_000, 60_000); -- p32.
+ EBU_B : constant Pair := (15_000, 6_000);
+
+ FCC_R : constant Pair := (67_000, 33_000); -- Given by Sproson (ibid)
+ FCC_G : constant Pair := (21_000, 71_000); -- p31.
+ FCC_B : constant Pair := (14_000, 8_000);
+
+ -- The CIE chromaticity primaries and whitepoint are taken from:
+ --
+ -- Palus, H., Colour Spaces, in Sangwine and Horne (eds), The Colour
+ -- Image Processing Handbook, Chapman and Hall, 1998.
+
+ CIE_W : constant Pair := (33_300, 33_300);
+
+ CIE_R : constant Pair := (73_500, 26_500);
+ CIE_G : constant Pair := (27_400, 71_700);
+ CIE_B : constant Pair := (16_700, 900);
+
+ -- The following primary chromaticities are for ITU-R BT.709 and sRGB.
+ -- The values are taken from the PNG Specification V1.2 and agree with
+ -- those in the draft sRGB standard.
+
+ BT709_R : constant Pair := (64_000,33_000);
+ BT709_G : constant Pair := (30_000,60_000);
+ BT709_B : constant Pair := (15_000, 6_000);
+
+end PNG_IO.Chromaticity_Data;
114 agpl/3rdparty/png_io/png_io-chunk_ordering.adb
@@ -0,0 +1,114 @@
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO -- Ada95 Portable Network Graphics Input/Output Package --
+-- --
+-- Copyright (©) 2000 Dr Stephen J. Sangwine (S.Sangwine@IEEE.org) --
+-- --
+-- This software was created by Stephen J. Sangwine. He hereby --
+-- asserts his Moral Right to be identified as author of this --
+-- software. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as --
+-- published by the Free Software Foundation; either version 2 of --
+-- the License, or (at your option) any later version. --
+-- --
+-- PNG_IO is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
+-- GNU General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public --
+-- License along with this software (in the file gpl.txt); if not, --
+-- contact the Free Software Foundation, or access www.fsf.org. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- Date: 1 November 2000 --
+-- Edit: 9 January 2004 to comment out the unused body of the --
+-- function After_PLTE. --
+-- 13 August 2006 to refer to the ISO standard and not the --
+-- draft. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- This package body contains the rules for placement of ancillary --
+-- chunks relative to PLTE and IDAT chunks. This is needed when --
+-- writing these chunks to PNG files. A concise description of the --
+-- rules is given in the ISO standard Section 5.6, Table 5.3. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+
+separate(PNG_IO)
+package body Chunk_Ordering is
+
+ type Chunk_Position is (Before, After, Anywhere);
+
+ type Chunk_Info is
+ record
+ Chunk_Name : Unsigned_32;
+ PLTE, IDAT : Chunk_Position;
+ end record;
+
+ Table : constant array(Positive range <>) of Chunk_Info :=
+ -----------------------------
+ -- Name PLTE IDAT --
+ -----------------------------
+ ((cHRM, Before, Before ),
+ (gAMA, Before, Before ),
+ (iCCP, Before, Before ),
+ (sBIT, Before, Before ),
+ (sRGB, Before, Before ),
+ (bKGD, After, Before ),
+ (hIST, After, Before ),
+ (tRNS, After, Before ),
+ (pHYS, Anywhere, Before ),
+ (sPLT, Anywhere, Before ),
+ (tIME, Anywhere, Anywhere),
+ (iTXt, Anywhere, Anywhere),
+ (tEXt, Anywhere, Anywhere),
+ (zTXt, Anywhere, Anywhere));
+
+ function Known_Chunk(C : Unsigned_32) return Boolean is
+ Result : Boolean := False;
+ begin
+ for I in Table'Range loop
+ Result := Result or (Table(I).Chunk_Name = C);
+ end loop;
+ return Result;
+ end Known_Chunk;
+
+ function Before_PLTE(C : Unsigned_32) return Boolean is
+ begin
+ for I in Table'Range loop
+ if Table(I).Chunk_Name = C then
+ return Table(I).PLTE = Before;
+ end if;
+ end loop;
+ return False; -- If not found we assume the ordering doesn't matter.
+ end Before_PLTE;
+
+ -- The next function is not currently used, and is commented out to
+ -- prevent compiler warnings about unused code.
+
+ --function After_PLTE(C : Unsigned_32) return Boolean is
+ --begin
+ -- for I in Table'Range loop
+ -- if Table(I).Chunk_Name = C then
+ -- return Table(I).PLTE = After;
+ -- end if;
+ -- end loop;
+ -- return False; -- If not found we assume the ordering doesn't matter.
+ --end After_PLTE;
+
+ function Before_IDAT(C : Unsigned_32) return Boolean is
+ begin
+ for I in Table'Range loop
+ if Table(I).Chunk_Name = C then
+ return Table(I).IDAT = Before;
+ end if;
+ end loop;
+ return False; -- If not found we assume the ordering doesn't matter.
+ end Before_IDAT;
+
+end Chunk_Ordering;
+
84 agpl/3rdparty/png_io/png_io-gamma_encoding.adb
@@ -0,0 +1,84 @@
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO -- Ada95 Portable Network Graphics Input/Output Package --
+-- --
+-- Copyright (©) 2003 Dr Stephen J. Sangwine (S.Sangwine@IEEE.org) --
+-- --
+-- This software was created by Stephen J. Sangwine. He hereby --
+-- asserts his Moral Right to be identified as author of this --
+-- software. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as --
+-- published by the Free Software Foundation; either version 2 of --
+-- the License, or (at your option) any later version. --
+-- --
+-- PNG_IO is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
+-- GNU General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public --
+-- License along with this software (in the file gpl.txt); if not, --
+-- contact the Free Software Foundation, or access www.fsf.org. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- Released: 1 July 2004 --
+-- Edited: 13 August 2006 to refer to the ISO standard. --
+-- 13 August 2006 to implement the changed from modular --
+-- to discrete input and output samples: --
+-- requiring use of 'Pos and 'Val to --
+-- handle non-integer types. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+
+with Ada.Numerics.Elementary_Functions;
+
+package body PNG_IO.Gamma_Encoding is
+
+ pragma Assert( Input_Sample'Pos( Input_Sample'First) = 0);
+ pragma Assert(Output_Sample'Pos(Output_Sample'First) = 0);
+
+ -- The gamma lookup table (below) handles a double conversion, from the
+ -- input gamma to linearized pixels, and then to the output gamma. Either
+ -- (or indeed both!) of the gamma values may be unity (i.e. 100_000). The
+ -- two stage calculation is merged here into one stage. The ISO standard
+ -- Sections 12.2 and 13.13 explains how the conversion is done. Simply
+ -- put, the pixel values from the input file are converted to floats in the
+ -- range 0.0 .. 1.0, the two gamma exponents are applied, and the result is
+ -- then scaled into the output range.
+
+ type Lookup_Table is array(Input_Sample) of Output_Sample;
+
+ LUT : Lookup_Table; -- This is initialised below during elaboration.
+
+ function To_Output_Gamma(I : Input_Sample) return Output_Sample is
+ begin
+ return LUT(I);
+ end To_Output_Gamma;
+
+begin
+
+ Initialise_LUT : declare
+
+ IG : constant Float := 1.0e5/Float( Input_Gamma);
+ OG : constant Float := 1.0e5/Float(Output_Gamma);
+
+ Exponent : constant Float := Float(IG)/Float(OG);
+
+ use Ada.Numerics.Elementary_Functions; -- For the ** operator.
+
+ IL : constant Float := Float( Input_Sample'Pos( Input_Sample'Last));
+ OL : constant Float := Float(Output_Sample'Pos(Output_Sample'Last));
+
+ begin
+
+ for P in LUT'Range loop
+ LUT(P) := Output_Sample'Val(Integer(((Float(Input_Sample'Pos(P))/IL) ** Exponent) * OL));
+ end loop;
+
+ end Initialise_LUT;
+
+end PNG_IO.Gamma_Encoding;
+
59 agpl/3rdparty/png_io/png_io-gamma_encoding.ads
@@ -0,0 +1,59 @@
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO -- Ada95 Portable Network Graphics Input/Output Package --
+-- --
+-- Copyright (©) 2004 Dr Stephen J. Sangwine (S.Sangwine@IEEE.org) --
+-- --
+-- This software was created by Stephen J. Sangwine. He hereby --
+-- asserts his Moral Right to be identified as author of this --
+-- software. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as --
+-- published by the Free Software Foundation; either version 2 of --
+-- the License, or (at your option) any later version. --
+-- --
+-- PNG_IO is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
+-- GNU General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public --
+-- License along with this software (in the file gpl.txt); if not, --
+-- contact the Free Software Foundation, or access www.fsf.org. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- Released: 1 July 2004 --
+-- Edited: 13 August 2006 to permit the input and output sample --
+-- parameters to be discrete rather than --
+-- modular. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- This package implements gamma encoding between arbitrary gamma --
+-- values. The gamma values are encoded in the same way as in PNG --
+-- files so that values read from a file may be used directly to --
+-- instantiate this package. The package uses lookup tables which --
+-- are initialised at elaboration time. --
+-- --
+-- The input and output samples are represented by discrete types: --
+-- the package uses the full range of the actual subtypes to --
+-- construct its lookup tables. The first value of the actual --
+-- subtype must be zero. This is checked by an assertion. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+
+generic
+
+ type Input_Sample is (<>); -- These two types may be the same,
+ type Output_Sample is (<>); -- but they are not required to be.
+
+ Input_Gamma : in Natural; -- These values represent the gamma
+ Output_Gamma : in Natural; -- multiplied by 100_000.
+
+package PNG_IO.Gamma_Encoding is
+
+ function To_Output_Gamma(I : Input_Sample) return Output_Sample;
+
+end PNG_IO.Gamma_Encoding;
+
841 agpl/3rdparty/png_io/png_io-open.adb
@@ -0,0 +1,841 @@
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO -- Ada95 Portable Network Graphics Input/Output Package --
+-- --
+-- Copyright (©) 1999 Dr Stephen J. Sangwine (S.Sangwine@IEEE.org) --
+-- --
+-- This software was created by Stephen J. Sangwine. He hereby --
+-- asserts his Moral Right to be identified as author of this --
+-- software. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- PNG_IO is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as --
+-- published by the Free Software Foundation; either version 2 of --
+-- the License, or (at your option) any later version. --
+-- --
+-- PNG_IO is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
+-- GNU General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public --
+-- License along with this software (in the file gpl.txt); if not, --
+-- contact the Free Software Foundation, or access www.fsf.org. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+-- Date: 26 August 1999 --
+-- Edit: 9 September 1999 to insert check on size of uncompressed --
+-- data after calling Zlib. --
+-- 14 December 1999 to increase the size of the compressed --
+-- data buffer by an arbitrary 4kB. --
+-- 29 February 2000 to use Generic_Zlib. --
+-- 13 July 2000 to add a check on the first two bytes --
+-- of any Zlib compressed data, and to fix --
+-- the lack of a CRC check on IEND chunk. --
+-- 17 July 2000 to fix once and for all the sizing of --
+-- buffers for IDAT chunk data: by --
+-- changing from Sequential_IO to --
+-- Direct_IO, it is possible to read ahead --
+-- all the chunk sizes and total those of --
+-- the IDAT chunks. Also fixed incorrect --
+-- exception messages regarding ordering --
+-- of cHRM, gAMA, and pHYs chunks. Added --
+-- check for duplicates of these chunks. --
+-- 20 November 2000 moved with clause to parent unit. --
+-- 15 May 2002 changed Positive to Natural at line 482 --
+-- to fix a bug with text chunks with zero --
+-- length text. --
+-- 5-21 July 2004 to use Stream_IO and Zlib_Ada. --
+-- 10 September 2004 changed buffer size passed to Zlib_Ada: --
+-- release 1.3 now handles correctly the --
+-- case of a zero length buffer. --
+-- 22 October 2004 fixed error near end where Format_Error --
+-- was incorrectly raised. --
+-- 13 August 2006 changed references to the PNG spec to --
+-- refer to the ISO standard. --
+---------------------------------------------------------------------
+---------------------------------------------------------------------
+
+separate(PNG_IO)
+procedure Open(F : in out PNG_File; Filename : in String) is
+ -- This procedure has the following major stages:
+ -- 1. Read the file signature and IHDR chunk.
+ -- 2. Read the IDAT, PLTE and other chunks up to the IEND chunk,
+ -- placing the raw image data into a buffer and any information
+ -- extracted from other chunks into the descriptor. In the case
+ -- of IDAT and zTXt chunks, the data is decompressed on the fly
+ -- as it is read in. Known chunks are interpreted and their data
+ -- loaded into the descriptor. Unknown chunks are linked into the
+ -- ancillary chunks list.
+ -- 3. Defilter the uncompressed image data, leaving the result in
+ -- a buffer for later use by the pixel access functions. Note
+ -- that, for an interlaced image, no de-interlacing is done:
+ -- the pixel access functions have to compute the location of
+ -- the pixel data taking interlacing into account.
+begin
+
+ if F /= null then
+ Raise_Exception(Call_Error'Identity, "PNG File " & Filename & " is already open.");
+ end if;
+
+ -- Open the file for reading.
+
+ F := new PNG_File_Descriptor;
+ Open(F.Handle, In_File, Filename);
+ F.Stream := Stream(F.Handle);
+
+ -- Read in the file signature and verify it.
+
+ declare
+ B : Stream_Element;
+ begin
+ for I in PNG_Signature'Range loop
+ Stream_Element'Read(F.Stream, B);
+ if B /= PNG_Signature(I) then
+ raise Signature_Error;
+ end if;
+ end loop;
+ end;
+
+ -- Read in the rest of the file, which is structured into chunks, starting
+ -- with a 4-byte chunk length field (most significant byte first), then the
+ -- chunk name (4 bytes), the chunk data (variable length, from zero bytes
+ -- upward), and finally the 4-byte CRC.
+
+ Read_Chunks : declare
+
+ -- The need to read 4 bytes and interpret them as an unsigned 32-bit
+ -- integer arises often. Therefore, we define functions to do it, in
+ -- two steps: first, to read the 4 bytes from the file into a buffer;
+ -- second, to convert a 4-byte buffer into an Unsigned_32. Doing it
+ -- in two steps allows us to read 32-bit values direct from the file,
+ -- or from a buffer that has already been read in.
+
+ function To_Unsigned_32(B : Buffer_4) return Unsigned_32 is
+ L : Unsigned_32 := Unsigned_32(B(1));
+ begin
+ for I in Stream_Element_Offset'(2) .. 4 loop
+ L := Shift_Left(L, 8) or Unsigned_32(B(I));
+ end loop;
+ return L;
+ end To_Unsigned_32;
+
+ function Read_Unsigned_32 return Unsigned_32 is
+ B : Buffer_4;
+ L : Stream_Element_Count;
+ begin
+ Read(F.Handle, B, L);
+ if L /= B'Last then raise End_Error; end if;
+ return To_Unsigned_32(B);
+ end Read_Unsigned_32;
+
+ function Read_Chunk return Buffer_Pointer is
+
+ -- A function to read the next chunk from the file into a
+ -- dynamically allocated buffer, and verify its CRC.
+
+ -- The chunk length field in the chunk represents the size of the
+ -- data in the chunk. We are about to read the chunk type (4 bytes)
+ -- as well as the data, so we must add 4 to the length read from the file.
+
+ Chunk_Length : constant Unsigned_32 := Read_Unsigned_32;
+
+ BP : Buffer_Pointer := new Buffer(1 .. Stream_Element_Count(Chunk_Length + 4));
+ B : Buffer renames BP.all;
+ begin
+
+ -- Read the chunk into the buffer. Note that if the chunk length was zero,
+ -- we will read in 4 bytes (the chunk type).
+
+ declare
+ L : Stream_Element_Count;
+ begin
+ Read(F.Handle, B, L);
+ if L /= B'Last then raise End_Error; end if;
+ end;
+
+ -- Check the CRC. This covers the chunk type and the chunk data, i.e.
+ -- the whole content of the buffer B. The CRC at the end of the chunk is
+ -- the 1's complement of the CRC computed over the chunk type and data.
+
+ declare
+ NChunk_CRC : constant Zlib.Unsigned_32 := Zlib.Unsigned_32(Read_Unsigned_32);
+ Buffer_CRC : Zlib.Unsigned_32 := 0;
+ use type Zlib.Unsigned_32;
+ begin
+ Zlib.CRC32(Buffer_CRC, B);
+ if Buffer_CRC /= NChunk_CRC then raise CRC_Error; end if;
+ end;
+
+ return BP;
+ exception
+ when others => Deallocate(BP); raise;
+ end Read_Chunk;
+
+ begin
+
+ -- Read the IHDR chunk (which must come next, immediately after the signature).
+
+ declare
+ BP : Buffer_Pointer := Read_Chunk;
+ B : Buffer renames BP.all;
+ begin
+
+ if B'Length /= 17 or else To_Unsigned_32(B(1 .. 4)) /= IHDR then
+ Deallocate(BP);
+ raise Format_Error;
+ end if;
+
+ -- The chunk seems OK so far, so copy the data into
+ -- the file descriptor, and deallocate the chunk.
+
+ begin
+ F.Width := Dimension(To_Unsigned_32(B(5 .. 8)));
+ F.Height := Dimension(To_Unsigned_32(B(9 .. 12)));
+ exception
+ when Constraint_Error =>
+ Raise_Exception(Format_Error'Identity,
+ "Invalid image dimension in IHDR chunk.");
+ end;
+
+ F.Bit_Depth := Unsigned_8(B(13));
+ F.Colour_Type := Unsigned_8(B(14));
+ F.Compression := Unsigned_8(B(15));
+ F.Filter := Unsigned_8(B(16));
+ F.Interlace := Unsigned_8(B(17));
+
+ Deallocate(BP);
+
+ end;
+
+ -- Now check that the values just read in are valid. This is a check
+ -- on the validity of the encoder that wrote the PNG file rather than
+ -- the integrity of the file, since we have just checked the CRC and
+ -- found it to be correct.
+
+ -- Check the colour type and the bit depth together since these are inter-related.
+
+ declare
+
+ procedure Verify(V : in Boolean) is
+ begin
+ if not V then
+ Raise_Exception(Format_Error'Identity,
+ "Invalid combination of colour type and bit depth in IHDR chunk.");
+ end if;
+ end Verify;
+ pragma Inline(Verify);
+
+ T : Unsigned_8 renames F.Colour_Type;
+ D : Unsigned_8 renames F.Bit_Depth;
+
+ begin
+ if T = 0 then Verify(D = 1 or D = 2 or D = 4 or D = 8 or D = 16);
+ elsif T = 2 then Verify( D = 8 or D = 16);
+ elsif T = 3 then Verify(D = 1 or D = 2 or D = 4 or D = 8 );
+ elsif T = 4 then Verify( D = 8 or D = 16);
+ elsif T = 6 then Verify( D = 8 or D = 16);
+ else
+ Raise_Exception(Format_Error'Identity, "Invalid colour type in IHDR chunk.");
+ end if;
+ end;
+
+ if F.Compression /= 0 or F.Filter /= 0 or F.Interlace > 1 then
+ Raise_Exception(Format_Error'Identity,
+ "Illegal compression, filter or interlace value in IHDR chunk.");
+ end if;
+
+ -- We are now ready to read the chunks. If the image is of colour
+ -- type 3 we are looking for the PLTE chunk before the first IDAT
+ -- chunk, otherwise we are looking for an IDAT chunk first.
+ -- There may be other chunks present after the IDAT chunks, which must
+ -- be ancillary chunks (ignored here, although their CRCs are checked).
+
+ -- From version 4.0 of PNG_IO, the compressed data in IDAT chunks and
+ -- zTXt chunks is decompressed on-the-fly. That is, it is read from the
+ -- buffer containing the chunk data, and directly decompressed from there
+ -- to the uncompressed data buffer in the descriptor.
+
+ declare
+ PLTE_Flag,
+ IDAT_Flag : Boolean := False;
+ Previous_Chunk_Type : Unsigned_32 := 0;
+
+ -- We verify the first two bytes of the IDAT stream (and of any zTXt streams too).
+ -- Since IDAT chunks of length 1 (and even 0!) are legal, we can't guarantee that
+ -- the first two bytes will be found in the first IDAT chunk (or even in consecutive
+ -- IDAT chunks, since zero length IDAT chunks could occur). Therefore we may have to
+ -- save the value of the first byte and check the two bytes only when we have read
+ -- the second.
+
+ IDAT_1 : Stream_Element; -- To store the first byte of the IDAT stream.
+ IDAT_V : Boolean := False; -- Set True when we have seen the second byte and tested.
+
+ procedure Validate_Zlib_Stream(CMG, FLG : in Stream_Element; Message : in String) is
+ begin
+ if not Valid_Zlib_Header(CMG, FLG) then
+ Raise_Exception(Format_Error'Identity, Message);
+ end if;
+ end Validate_Zlib_Stream;
+
+ Z : Zlib.Filter_Type; -- This is used for the IDAT decompression.
+
+ begin
+
+ -- Allocate a buffer for the uncompressed image data in the IDAT chunks.
+ -- The size of this buffer is exactly that needed for the uncompressed pixel
+ -- data.
+
+ F.Uncompressed_Data := new Buffer(1 .. Image_Size(Colour_Type(F),
+ Bit_Depth(F),
+ Width(F), Height(F),
+ Interlaced(F)));
+
+ For_each_chunk : while Previous_Chunk_Type /= IEND loop -- Read all the chunks,
+ declare -- including IEND.
+ BP : Buffer_Pointer := Read_Chunk;
+ B : Buffer renames BP.all;
+
+ Chunk_Type : constant Unsigned_32 := To_Unsigned_32(B(1 .. 4));
+ Chunk_Length : constant Stream_Element_Count := B'Length - 4;
+
+ procedure Confirm_Chunk_Length(L : in Stream_Element_Count) is
+ begin
+ if Chunk_Length /= L then
+ Raise_Exception(Format_Error'Identity,
+ "Incorrect chunk length in " & To_Chunk_Name(Chunk_Type) & " chunk.");
+ end if;
+ end;
+
+ begin
+ case Chunk_Type is
+ when PLTE =>
+
+ -- We have to check here that:
+ -- 1. The length of the chunk is divisible by 3,
+ -- and that there are between 1 and 256 entries.
+ -- 2. The image is a colour image.
+ -- 3. There have been no previous PLTE chunks
+ -- (because only one is allowed).
+ -- 4. There have been no IDAT chunks (because PLTE
+ -- must precede IDAT if it occurs).
+
+ if Chunk_Length rem 3 /= 0
+ or Chunk_Length > 768
+ or Chunk_Length < 3 then
+ Raise_Exception(Format_Error'Identity,
+ "Illegal length in PLTE chunk.");
+ end if;
+ if (F.Colour_Type and 16#02#) = 0 then
+ Raise_Exception(Format_Error'Identity,
+ "Illegal PLTE chunk in greyscale PNG.");
+ end if;
+ if PLTE_Flag then
+ Raise_Exception(Format_Error'Identity,
+ "Illegal multiple PLTE chunks.");
+ end if;
+ if IDAT_Flag then
+ Raise_Exception(Format_Error'Identity,
+ "Illegal PLTE chunk after IDAT chunk(s).");
+ end if;
+ PLTE_Flag := True;
+
+ -- Allocate a palette and copy the colour palette data to it
+ -- from the chunk buffer.