atlas (empty) → 0
raw patch · 8 files changed
+1326/−0 lines, 8 filesdep +atlasdep +basedep +containers
Dependencies added: atlas, base, containers, data-default, hspec, inline-c, lens, primitive, template-haskell, transformers
Files
- CHANGELOG.md +3/−0
- LICENSE.md +279/−0
- README.md +16/−0
- atlas.cabal +60/−0
- cbits/stb_rect_pack.h +628/−0
- src/Data/Atlas.hs +130/−0
- src/Data/Atlas/Internal.hsc +184/−0
- test/Spec.hs +26/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0++* Split off from `codex`
+ LICENSE.md view
@@ -0,0 +1,279 @@+# License++The Haskell code here is licensed under either+ * Apache License, Version 2.0 (http://www.apache.org/licenses/LICENSE-2.0)+ * BSD 2-Clause license (https://opensource.org/licenses/BSD-2-Clause)+at your option.++The contained library `stb_rect_pack.h` is licensed under either+ * MIT License+ * Public Domain+at your option.++## ALTERNATIVE A: BSD 2-Clause License++- Copyright 2019 Edward Kmett and Sean Chalmers++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.++## ALTERNATIVE B: Apache License++_Version 2.0, January 2004_+_<<http://www.apache.org/licenses/>>_++### Terms and Conditions for use, reproduction, and distribution++#### 1. Definitions++“License” shall mean the terms and conditions for use, reproduction, and+distribution as defined by Sections 1 through 9 of this document.++“Licensor” shall mean the copyright owner or entity authorized by the copyright+owner that is granting the License.++“Legal Entity” shall mean the union of the acting entity and all other entities+that control, are controlled by, or are under common control with that entity.+For the purposes of this definition, “control” means **(i)** the power, direct or+indirect, to cause the direction or management of such entity, whether by+contract or otherwise, or **(ii)** ownership of fifty percent (50%) or more of the+outstanding shares, or **(iii)** beneficial ownership of such entity.++“You” (or “Your”) shall mean an individual or Legal Entity exercising+permissions granted by this License.++“Source” form shall mean the preferred form for making modifications, including+but not limited to software source code, documentation source, and configuration+files.++“Object” form shall mean any form resulting from mechanical transformation or+translation of a Source form, including but not limited to compiled object code,+generated documentation, and conversions to other media types.++“Work” shall mean the work of authorship, whether in Source or Object form, made+available under the License, as indicated by a copyright notice that is included+in or attached to the work (an example is provided in the Appendix below).++“Derivative Works” shall mean any work, whether in Source or Object form, that+is based on (or derived from) the Work and for which the editorial revisions,+annotations, elaborations, or other modifications represent, as a whole, an+original work of authorship. For the purposes of this License, Derivative Works+shall not include works that remain separable from, or merely link (or bind by+name) to the interfaces of, the Work and Derivative Works thereof.++“Contribution” shall mean any work of authorship, including the original version+of the Work and any modifications or additions to that Work or Derivative Works+thereof, that is intentionally submitted to Licensor for inclusion in the Work+by the copyright owner or by an individual or Legal Entity authorized to submit+on behalf of the copyright owner. For the purposes of this definition,+“submitted” means any form of electronic, verbal, or written communication sent+to the Licensor or its representatives, including but not limited to+communication on electronic mailing lists, source code control systems, and+issue tracking systems that are managed by, or on behalf of, the Licensor for+the purpose of discussing and improving the Work, but excluding communication+that is conspicuously marked or otherwise designated in writing by the copyright+owner as “Not a Contribution.”++“Contributor” shall mean Licensor and any individual or Legal Entity on behalf+of whom a Contribution has been received by Licensor and subsequently+incorporated within the Work.++#### 2. Grant of Copyright License++Subject to the terms and conditions of this License, each Contributor hereby+grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free,+irrevocable copyright license to reproduce, prepare Derivative Works of,+publicly display, publicly perform, sublicense, and distribute the Work and such+Derivative Works in Source or Object form.++#### 3. Grant of Patent License++Subject to the terms and conditions of this License, each Contributor hereby+grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free,+irrevocable (except as stated in this section) patent license to make, have+made, use, offer to sell, sell, import, and otherwise transfer the Work, where+such license applies only to those patent claims licensable by such Contributor+that are necessarily infringed by their Contribution(s) alone or by combination+of their Contribution(s) with the Work to which such Contribution(s) was+submitted. If You institute patent litigation against any entity (including a+cross-claim or counterclaim in a lawsuit) alleging that the Work or a+Contribution incorporated within the Work constitutes direct or contributory+patent infringement, then any patent licenses granted to You under this License+for that Work shall terminate as of the date such litigation is filed.++#### 4. Redistribution++You may reproduce and distribute copies of the Work or Derivative Works thereof+in any medium, with or without modifications, and in Source or Object form,+provided that You meet the following conditions:++* **(a)** You must give any other recipients of the Work or Derivative Works a copy of+this License; and+* **(b)** You must cause any modified files to carry prominent notices stating that You+changed the files; and+* **(c)** You must retain, in the Source form of any Derivative Works that You distribute,+all copyright, patent, trademark, and attribution notices from the Source form+of the Work, excluding those notices that do not pertain to any part of the+Derivative Works; and+* **(d)** If the Work includes a “NOTICE” text file as part of its distribution, then any+Derivative Works that You distribute must include a readable copy of the+attribution notices contained within such NOTICE file, excluding those notices+that do not pertain to any part of the Derivative Works, in at least one of the+following places: within a NOTICE text file distributed as part of the+Derivative Works; within the Source form or documentation, if provided along+with the Derivative Works; or, within a display generated by the Derivative+Works, if and wherever such third-party notices normally appear. The contents of+the NOTICE file are for informational purposes only and do not modify the+License. You may add Your own attribution notices within Derivative Works that+You distribute, alongside or as an addendum to the NOTICE text from the Work,+provided that such additional attribution notices cannot be construed as+modifying the License.++You may add Your own copyright statement to Your modifications and may provide+additional or different license terms and conditions for use, reproduction, or+distribution of Your modifications, or for any such Derivative Works as a whole,+provided Your use, reproduction, and distribution of the Work otherwise complies+with the conditions stated in this License.++#### 5. Submission of Contributions++Unless You explicitly state otherwise, any Contribution intentionally submitted+for inclusion in the Work by You to the Licensor shall be under the terms and+conditions of this License, without any additional terms or conditions.+Notwithstanding the above, nothing herein shall supersede or modify the terms of+any separate license agreement you may have executed with Licensor regarding+such Contributions.++#### 6. Trademarks++This License does not grant permission to use the trade names, trademarks,+service marks, or product names of the Licensor, except as required for+reasonable and customary use in describing the origin of the Work and+reproducing the content of the NOTICE file.++#### 7. Disclaimer of Warranty++Unless required by applicable law or agreed to in writing, Licensor provides the+Work (and each Contributor provides its Contributions) on an “AS IS” BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied,+including, without limitation, any warranties or conditions of TITLE,+NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are+solely responsible for determining the appropriateness of using or+redistributing the Work and assume any risks associated with Your exercise of+permissions under this License.++#### 8. Limitation of Liability++In no event and under no legal theory, whether in tort (including negligence),+contract, or otherwise, unless required by applicable law (such as deliberate+and grossly negligent acts) or agreed to in writing, shall any Contributor be+liable to You for damages, including any direct, indirect, special, incidental,+or consequential damages of any character arising as a result of this License or+out of the use or inability to use the Work (including but not limited to+damages for loss of goodwill, work stoppage, computer failure or malfunction, or+any and all other commercial damages or losses), even if such Contributor has+been advised of the possibility of such damages.++#### 9. Accepting Warranty or Additional Liability++While redistributing the Work or Derivative Works thereof, You may choose to+offer, and charge a fee for, acceptance of support, warranty, indemnity, or+other liability obligations and/or rights consistent with this License. However,+in accepting such obligations, You may act only on Your own behalf and on Your+sole responsibility, not on behalf of any other Contributor, and only if You+agree to indemnify, defend, and hold each Contributor harmless for any liability+incurred by, or claims asserted against, such Contributor by reason of your+accepting any such warranty or additional liability.++_END OF TERMS AND CONDITIONS_++### APPENDIX: How to apply the Apache License to your work++To apply the Apache License to your work, attach the following boilerplate+notice, with the fields enclosed by brackets `[]` replaced with your own+identifying information. (Don't include the brackets!) The text should be+enclosed in the appropriate comment syntax for the file format. We also+recommend that a file or class name and description of purpose be included on+the same “printed page” as the copyright notice for easier identification within+third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.++# Licensing for `stb_rect_pack.h`++This software is available under 2 licenses -- choose whichever you prefer.++## ALTERNATIVE A - MIT License++Copyright (c) 2017 Sean Barrett++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:+The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.++## ALTERNATIVE B - Public Domain (www.unlicense.org)++This is free and unencumbered software released into the public domain.+Anyone is free to copy, modify, publish, use, compile, sell, or distribute this+software, either in source code form or as a compiled binary, for any purpose,+commercial or non-commercial, and by any means.+In jurisdictions that recognize copyright laws, the author or authors of this+software dedicate any and all copyright interest in the software to the public+domain. We make this dedication for the benefit of the public at large and to+the detriment of our heirs and successors. We intend this dedication to be an+overt act of relinquishment in perpetuity of all present and future rights to+this software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,16 @@+atlas+=====++[](https://hackage.haskell.org/package/atlas) [](http://travis-ci.org/ekmett/atlas)++This package provides 2D skyline rectangle packing, which can be useful for building texture atlases and the like.++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett+
+ atlas.cabal view
@@ -0,0 +1,60 @@+cabal-version: 2.2+name: atlas+version: 0+synopsis: Skyline rectangle packing+homepage: https://github.com/ekmett/codex/tree/master/atlas#readme+license: BSD-2-Clause OR Apache-2.0+license-file: LICENSE.md+author: Edward Kmett+maintainer: Edward Kmett <ekmett@gmail.com>+copyright: Copyright (c) 2019 Edward Kmett+stability: experimental+category: Graphics+build-type: Simple+description:+ Skyline rectangle packing for font atlases and the like using @stb_rect_pack.h@+extra-doc-files:+ README.md,+ CHANGELOG.md+extra-source-files: cbits/stb_rect_pack.h++source-repository head+ type: git+ location: https://github.com/ekmett/codex+ subdir: atlas++common base+ default-language: Haskell2010+ ghc-options:+ -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates+ -Wredundant-constraints -Widentities -Wmissing-export-lists+ build-depends:+ base >= 4.11 && < 5,+ primitive,+ transformers++library+ import: base+ hs-source-dirs: src+ include-dirs: cbits+ build-tool-depends: hsc2hs:hsc2hs+ cc-options: -g -Wall+ build-depends:+ containers,+ data-default,+ inline-c,+ lens,+ template-haskell+ exposed-modules:+ Data.Atlas+ Data.Atlas.Internal++test-suite atlas-test+ import: base+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends:+ atlas,+ hspec+
+ cbits/stb_rect_pack.h view
@@ -0,0 +1,628 @@+// stb_rect_pack.h - v1.00 - public domain - rectangle packing+// Sean Barrett 2014+//+// Useful for e.g. packing rectangular textures into an atlas.+// Does not do rotation.+//+// Not necessarily the awesomest packing method, but better than+// the totally naive one in stb_truetype (which is primarily what+// this is meant to replace).+//+// Has only had a few tests run, may have issues.+//+// More docs to come.+//+// No memory allocations; uses qsort() and assert() from stdlib.+// Can override those by defining STBRP_SORT and STBRP_ASSERT.+//+// This library currently uses the Skyline Bottom-Left algorithm.+//+// Please note: better rectangle packers are welcome! Please+// implement them to the same API, but with a different init+// function.+//+// Credits+//+// Library+// Sean Barrett+// Minor features+// Martins Mozeiko+// github:IntellectualKitty+// +// Bugfixes / warning fixes+// Jeremy Jaussaud+// Fabian Giesen+//+// Version history:+//+// 1.00 (2019-02-25) avoid small space waste; gracefully fail too-wide rectangles+// 0.99 (2019-02-07) warning fixes+// 0.11 (2017-03-03) return packing success/fail result+// 0.10 (2016-10-25) remove cast-away-const to avoid warnings+// 0.09 (2016-08-27) fix compiler warnings+// 0.08 (2015-09-13) really fix bug with empty rects (w=0 or h=0)+// 0.07 (2015-09-13) fix bug with empty rects (w=0 or h=0)+// 0.06 (2015-04-15) added STBRP_SORT to allow replacing qsort+// 0.05: added STBRP_ASSERT to allow replacing assert+// 0.04: fixed minor bug in STBRP_LARGE_RECTS support+// 0.01: initial release+//+// LICENSE+//+// See end of file for license information.++//////////////////////////////////////////////////////////////////////////////+//+// INCLUDE SECTION+//++#ifndef STB_INCLUDE_STB_RECT_PACK_H+#define STB_INCLUDE_STB_RECT_PACK_H++#define STB_RECT_PACK_VERSION 1++#ifdef STBRP_STATIC+#define STBRP_DEF static+#else+#define STBRP_DEF extern+#endif++#ifdef __cplusplus+extern "C" {+#endif++typedef struct stbrp_context stbrp_context;+typedef struct stbrp_node stbrp_node;+typedef struct stbrp_rect stbrp_rect;++#ifdef STBRP_LARGE_RECTS+typedef int stbrp_coord;+#else+typedef unsigned short stbrp_coord;+#endif++STBRP_DEF int stbrp_pack_rects (stbrp_context *context, stbrp_rect *rects, int num_rects);+// Assign packed locations to rectangles. The rectangles are of type+// 'stbrp_rect' defined below, stored in the array 'rects', and there+// are 'num_rects' many of them.+//+// Rectangles which are successfully packed have the 'was_packed' flag+// set to a non-zero value and 'x' and 'y' store the minimum location+// on each axis (i.e. bottom-left in cartesian coordinates, top-left+// if you imagine y increasing downwards). Rectangles which do not fit+// have the 'was_packed' flag set to 0.+//+// You should not try to access the 'rects' array from another thread+// while this function is running, as the function temporarily reorders+// the array while it executes.+//+// To pack into another rectangle, you need to call stbrp_init_target+// again. To continue packing into the same rectangle, you can call+// this function again. Calling this multiple times with multiple rect+// arrays will probably produce worse packing results than calling it+// a single time with the full rectangle array, but the option is+// available.+//+// The function returns 1 if all of the rectangles were successfully+// packed and 0 otherwise.++struct stbrp_rect+{+ // reserved for your use:+ int id;++ // input:+ stbrp_coord w, h;++ // output:+ stbrp_coord x, y;+ int was_packed; // non-zero if valid packing++}; // 16 bytes, nominally+++STBRP_DEF void stbrp_init_target (stbrp_context *context, int width, int height, stbrp_node *nodes, int num_nodes);+// Initialize a rectangle packer to:+// pack a rectangle that is 'width' by 'height' in dimensions+// using temporary storage provided by the array 'nodes', which is 'num_nodes' long+//+// You must call this function every time you start packing into a new target.+//+// There is no "shutdown" function. The 'nodes' memory must stay valid for+// the following stbrp_pack_rects() call (or calls), but can be freed after+// the call (or calls) finish.+//+// Note: to guarantee best results, either:+// 1. make sure 'num_nodes' >= 'width'+// or 2. call stbrp_allow_out_of_mem() defined below with 'allow_out_of_mem = 1'+//+// If you don't do either of the above things, widths will be quantized to multiples+// of small integers to guarantee the algorithm doesn't run out of temporary storage.+//+// If you do #2, then the non-quantized algorithm will be used, but the algorithm+// may run out of temporary storage and be unable to pack some rectangles.++STBRP_DEF void stbrp_setup_allow_out_of_mem (stbrp_context *context, int allow_out_of_mem);+// Optionally call this function after init but before doing any packing to+// change the handling of the out-of-temp-memory scenario, described above.+// If you call init again, this will be reset to the default (false).+++STBRP_DEF void stbrp_setup_heuristic (stbrp_context *context, int heuristic);+// Optionally select which packing heuristic the library should use. Different+// heuristics will produce better/worse results for different data sets.+// If you call init again, this will be reset to the default.++enum+{+ STBRP_HEURISTIC_Skyline_default=0,+ STBRP_HEURISTIC_Skyline_BL_sortHeight = STBRP_HEURISTIC_Skyline_default,+ STBRP_HEURISTIC_Skyline_BF_sortHeight+};+++//////////////////////////////////////////////////////////////////////////////+//+// the details of the following structures don't matter to you, but they must+// be visible so you can handle the memory allocations for them++struct stbrp_node+{+ stbrp_coord x,y;+ stbrp_node *next;+};++struct stbrp_context+{+ int width;+ int height;+ int align;+ int init_mode;+ int heuristic;+ int num_nodes;+ stbrp_node *active_head;+ stbrp_node *free_head;+ stbrp_node extra[2]; // we allocate two extra nodes so optimal user-node-count is 'width' not 'width+2'+};++#ifdef __cplusplus+}+#endif++#endif++//////////////////////////////////////////////////////////////////////////////+//+// IMPLEMENTATION SECTION+//++#ifdef STB_RECT_PACK_IMPLEMENTATION+#ifndef STBRP_SORT+#include <stdlib.h>+#define STBRP_SORT qsort+#endif++#ifndef STBRP_ASSERT+#include <assert.h>+#define STBRP_ASSERT assert+#endif++#ifdef _MSC_VER+#define STBRP__NOTUSED(v) (void)(v)+#else+#define STBRP__NOTUSED(v) (void)sizeof(v)+#endif++enum+{+ STBRP__INIT_skyline = 1+};++STBRP_DEF void stbrp_setup_heuristic(stbrp_context *context, int heuristic)+{+ switch (context->init_mode) {+ case STBRP__INIT_skyline:+ STBRP_ASSERT(heuristic == STBRP_HEURISTIC_Skyline_BL_sortHeight || heuristic == STBRP_HEURISTIC_Skyline_BF_sortHeight);+ context->heuristic = heuristic;+ break;+ default:+ STBRP_ASSERT(0);+ }+}++STBRP_DEF void stbrp_setup_allow_out_of_mem(stbrp_context *context, int allow_out_of_mem)+{+ if (allow_out_of_mem)+ // if it's ok to run out of memory, then don't bother aligning them;+ // this gives better packing, but may fail due to OOM (even though+ // the rectangles easily fit). @TODO a smarter approach would be to only+ // quantize once we've hit OOM, then we could get rid of this parameter.+ context->align = 1;+ else {+ // if it's not ok to run out of memory, then quantize the widths+ // so that num_nodes is always enough nodes.+ //+ // I.e. num_nodes * align >= width+ // align >= width / num_nodes+ // align = ceil(width/num_nodes)++ context->align = (context->width + context->num_nodes-1) / context->num_nodes;+ }+}++STBRP_DEF void stbrp_init_target(stbrp_context *context, int width, int height, stbrp_node *nodes, int num_nodes)+{+ int i;+#ifndef STBRP_LARGE_RECTS+ STBRP_ASSERT(width <= 0xffff && height <= 0xffff);+#endif++ for (i=0; i < num_nodes-1; ++i)+ nodes[i].next = &nodes[i+1];+ nodes[i].next = NULL;+ context->init_mode = STBRP__INIT_skyline;+ context->heuristic = STBRP_HEURISTIC_Skyline_default;+ context->free_head = &nodes[0];+ context->active_head = &context->extra[0];+ context->width = width;+ context->height = height;+ context->num_nodes = num_nodes;+ stbrp_setup_allow_out_of_mem(context, 0);++ // node 0 is the full width, node 1 is the sentinel (lets us not store width explicitly)+ context->extra[0].x = 0;+ context->extra[0].y = 0;+ context->extra[0].next = &context->extra[1];+ context->extra[1].x = (stbrp_coord) width;+#ifdef STBRP_LARGE_RECTS+ context->extra[1].y = (1<<30);+#else+ context->extra[1].y = 65535;+#endif+ context->extra[1].next = NULL;+}++// find minimum y position if it starts at x1+static int stbrp__skyline_find_min_y(stbrp_context *c, stbrp_node *first, int x0, int width, int *pwaste)+{+ stbrp_node *node = first;+ int x1 = x0 + width;+ int min_y, visited_width, waste_area;++ STBRP__NOTUSED(c);++ STBRP_ASSERT(first->x <= x0);++ #if 0+ // skip in case we're past the node+ while (node->next->x <= x0)+ ++node;+ #else+ STBRP_ASSERT(node->next->x > x0); // we ended up handling this in the caller for efficiency+ #endif++ STBRP_ASSERT(node->x <= x0);++ min_y = 0;+ waste_area = 0;+ visited_width = 0;+ while (node->x < x1) {+ if (node->y > min_y) {+ // raise min_y higher.+ // we've accounted for all waste up to min_y,+ // but we'll now add more waste for everything we've visted+ waste_area += visited_width * (node->y - min_y);+ min_y = node->y;+ // the first time through, visited_width might be reduced+ if (node->x < x0)+ visited_width += node->next->x - x0;+ else+ visited_width += node->next->x - node->x;+ } else {+ // add waste area+ int under_width = node->next->x - node->x;+ if (under_width + visited_width > width)+ under_width = width - visited_width;+ waste_area += under_width * (min_y - node->y);+ visited_width += under_width;+ }+ node = node->next;+ }++ *pwaste = waste_area;+ return min_y;+}++typedef struct+{+ int x,y;+ stbrp_node **prev_link;+} stbrp__findresult;++static stbrp__findresult stbrp__skyline_find_best_pos(stbrp_context *c, int width, int height)+{+ int best_waste = (1<<30), best_x, best_y = (1 << 30);+ stbrp__findresult fr;+ stbrp_node **prev, *node, *tail, **best = NULL;++ // align to multiple of c->align+ width = (width + c->align - 1);+ width -= width % c->align;+ STBRP_ASSERT(width % c->align == 0);++ // if it can't possibly fit, bail immediately+ if (width > c->width || height > c->height) {+ fr.prev_link = NULL;+ fr.x = fr.y = 0;+ return fr;+ }++ node = c->active_head;+ prev = &c->active_head;+ while (node->x + width <= c->width) {+ int y,waste;+ y = stbrp__skyline_find_min_y(c, node, node->x, width, &waste);+ if (c->heuristic == STBRP_HEURISTIC_Skyline_BL_sortHeight) { // actually just want to test BL+ // bottom left+ if (y < best_y) {+ best_y = y;+ best = prev;+ }+ } else {+ // best-fit+ if (y + height <= c->height) {+ // can only use it if it first vertically+ if (y < best_y || (y == best_y && waste < best_waste)) {+ best_y = y;+ best_waste = waste;+ best = prev;+ }+ }+ }+ prev = &node->next;+ node = node->next;+ }++ best_x = (best == NULL) ? 0 : (*best)->x;++ // if doing best-fit (BF), we also have to try aligning right edge to each node position+ //+ // e.g, if fitting+ //+ // ____________________+ // |____________________|+ //+ // into+ //+ // | |+ // | ____________|+ // |____________|+ //+ // then right-aligned reduces waste, but bottom-left BL is always chooses left-aligned+ //+ // This makes BF take about 2x the time++ if (c->heuristic == STBRP_HEURISTIC_Skyline_BF_sortHeight) {+ tail = c->active_head;+ node = c->active_head;+ prev = &c->active_head;+ // find first node that's admissible+ while (tail->x < width)+ tail = tail->next;+ while (tail) {+ int xpos = tail->x - width;+ int y,waste;+ STBRP_ASSERT(xpos >= 0);+ // find the left position that matches this+ while (node->next->x <= xpos) {+ prev = &node->next;+ node = node->next;+ }+ STBRP_ASSERT(node->next->x > xpos && node->x <= xpos);+ y = stbrp__skyline_find_min_y(c, node, xpos, width, &waste);+ if (y + height <= c->height) {+ if (y <= best_y) {+ if (y < best_y || waste < best_waste || (waste==best_waste && xpos < best_x)) {+ best_x = xpos;+ STBRP_ASSERT(y <= best_y);+ best_y = y;+ best_waste = waste;+ best = prev;+ }+ }+ }+ tail = tail->next;+ } + }++ fr.prev_link = best;+ fr.x = best_x;+ fr.y = best_y;+ return fr;+}++static stbrp__findresult stbrp__skyline_pack_rectangle(stbrp_context *context, int width, int height)+{+ // find best position according to heuristic+ stbrp__findresult res = stbrp__skyline_find_best_pos(context, width, height);+ stbrp_node *node, *cur;++ // bail if:+ // 1. it failed+ // 2. the best node doesn't fit (we don't always check this)+ // 3. we're out of memory+ if (res.prev_link == NULL || res.y + height > context->height || context->free_head == NULL) {+ res.prev_link = NULL;+ return res;+ }++ // on success, create new node+ node = context->free_head;+ node->x = (stbrp_coord) res.x;+ node->y = (stbrp_coord) (res.y + height);++ context->free_head = node->next;++ // insert the new node into the right starting point, and+ // let 'cur' point to the remaining nodes needing to be+ // stiched back in++ cur = *res.prev_link;+ if (cur->x < res.x) {+ // preserve the existing one, so start testing with the next one+ stbrp_node *next = cur->next;+ cur->next = node;+ cur = next;+ } else {+ *res.prev_link = node;+ }++ // from here, traverse cur and free the nodes, until we get to one+ // that shouldn't be freed+ while (cur->next && cur->next->x <= res.x + width) {+ stbrp_node *next = cur->next;+ // move the current node to the free list+ cur->next = context->free_head;+ context->free_head = cur;+ cur = next;+ }++ // stitch the list back in+ node->next = cur;++ if (cur->x < res.x + width)+ cur->x = (stbrp_coord) (res.x + width);++#ifdef _DEBUG+ cur = context->active_head;+ while (cur->x < context->width) {+ STBRP_ASSERT(cur->x < cur->next->x);+ cur = cur->next;+ }+ STBRP_ASSERT(cur->next == NULL);++ {+ int count=0;+ cur = context->active_head;+ while (cur) {+ cur = cur->next;+ ++count;+ }+ cur = context->free_head;+ while (cur) {+ cur = cur->next;+ ++count;+ }+ STBRP_ASSERT(count == context->num_nodes+2);+ }+#endif++ return res;+}++static int rect_height_compare(const void *a, const void *b)+{+ const stbrp_rect *p = (const stbrp_rect *) a;+ const stbrp_rect *q = (const stbrp_rect *) b;+ if (p->h > q->h)+ return -1;+ if (p->h < q->h)+ return 1;+ return (p->w > q->w) ? -1 : (p->w < q->w);+}++static int rect_original_order(const void *a, const void *b)+{+ const stbrp_rect *p = (const stbrp_rect *) a;+ const stbrp_rect *q = (const stbrp_rect *) b;+ return (p->was_packed < q->was_packed) ? -1 : (p->was_packed > q->was_packed);+}++#ifdef STBRP_LARGE_RECTS+#define STBRP__MAXVAL 0xffffffff+#else+#define STBRP__MAXVAL 0xffff+#endif++STBRP_DEF int stbrp_pack_rects(stbrp_context *context, stbrp_rect *rects, int num_rects)+{+ int i, all_rects_packed = 1;++ // we use the 'was_packed' field internally to allow sorting/unsorting+ for (i=0; i < num_rects; ++i) {+ rects[i].was_packed = i;+ }++ // sort according to heuristic+ STBRP_SORT(rects, num_rects, sizeof(rects[0]), rect_height_compare);++ for (i=0; i < num_rects; ++i) {+ if (rects[i].w == 0 || rects[i].h == 0) {+ rects[i].x = rects[i].y = 0; // empty rect needs no space+ } else {+ stbrp__findresult fr = stbrp__skyline_pack_rectangle(context, rects[i].w, rects[i].h);+ if (fr.prev_link) {+ rects[i].x = (stbrp_coord) fr.x;+ rects[i].y = (stbrp_coord) fr.y;+ } else {+ rects[i].x = rects[i].y = STBRP__MAXVAL;+ }+ }+ }++ // unsort+ STBRP_SORT(rects, num_rects, sizeof(rects[0]), rect_original_order);++ // set was_packed flags and all_rects_packed status+ for (i=0; i < num_rects; ++i) {+ rects[i].was_packed = !(rects[i].x == STBRP__MAXVAL && rects[i].y == STBRP__MAXVAL);+ if (!rects[i].was_packed)+ all_rects_packed = 0;+ }++ // return the all_rects_packed status+ return all_rects_packed;+}+#endif++/*+------------------------------------------------------------------------------+This software is available under 2 licenses -- choose whichever you prefer.+------------------------------------------------------------------------------+ALTERNATIVE A - MIT License+Copyright (c) 2017 Sean Barrett+Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions:+The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software.+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE.+------------------------------------------------------------------------------+ALTERNATIVE B - Public Domain (www.unlicense.org)+This is free and unencumbered software released into the public domain.+Anyone is free to copy, modify, publish, use, compile, sell, or distribute this +software, either in source code form or as a compiled binary, for any purpose, +commercial or non-commercial, and by any means.+In jurisdictions that recognize copyright laws, the author or authors of this +software dedicate any and all copyright interest in the software to the public +domain. We make this dedication for the benefit of the public at large and to +the detriment of our heirs and successors. We intend this dedication to be an +overt act of relinquishment in perpetuity of all present and future rights to +this software under copyright law.+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN +ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+------------------------------------------------------------------------------+*/
+ src/Data/Atlas.hs view
@@ -0,0 +1,130 @@+{-# language TypeOperators #-}+{-# language ScopedTypeVariables #-}+{-# language UndecidableInstances #-}+{-# language MultiParamTypeClasses #-}+{-# language FlexibleInstances #-}+{-# language TemplateHaskell #-}+{-# language QuasiQuotes #-}+{-# language ViewPatterns #-}+{-# language BlockArguments #-}+-- |+-- Copyright : (c) 2019-2021 Edward Kmett+-- License : BSD-2-Clause OR Apache-2.0+-- Maintainer: Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability: non-portable+--+-- skyline packing using @stb_rect_pack.h@+module Data.Atlas+( Atlas+, create+, createExplicit+, reset+-- * Setup+, Heuristic(..)+, setHeuristic+, setAllowOutOfMem+-- * Using a context+, Pt(..)+, pack+, pack1+, packM+) where++import Control.Lens+import Control.Monad+import Control.Monad.Primitive+import Control.Monad.Trans.State.Strict+import Data.Atlas.Internal+import Data.Maybe (fromMaybe)+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import Foreign.Ptr+import GHC.Stack+import qualified Language.C.Inline as C+import qualified Language.C.Inline.Unsafe as CU++C.context $ C.baseCtx <> C.fptrCtx <> atlasCtx+C.verbatim "#define STB_RECT_PACK_IMPLEMENTATION"+C.include "stb_rect_pack.h"++-- | Create a packing context.++create :: (HasCallStack, PrimMonad m) => Int -> Int -> m (Atlas (PrimState m))+create w h = createExplicit w h Nothing++-- | Initialization with an optional node count, when @node count < width@ is used this results in quantization unless+-- 'setAllowOutOfMem' is enabled. When no value is supplied, it defaults to the width of the 'Atlas'.+createExplicit :: HasCallStack => PrimMonad m => Int -> Int -> Maybe Int -> m (Atlas (PrimState m))+createExplicit width@(fromIntegral -> w) height@(fromIntegral -> h) mn = withFrozenCallStack $ unsafeIOToPrim do+ let nodes@(fromIntegral -> n) = fromMaybe width mn+ unless (width < 0xffff && height < 0xffff) $ die $ "Atlas.new " ++ show width ++ " " ++ show height ++ ": atlas too large"+ fp <- mallocForeignPtrBytes (sizeOfAtlas + sizeOfNode * nodes)+ Atlas fp <$ [CU.block|void {+ stbrp_context * p = $atlas:fp;+ stbrp_init_target(p,$(int w),$(int h),(stbrp_node *)(p+1),$(int n));+ }|]++-- | Reinitialize an atlas with the same parameters+reset :: PrimMonad m => Atlas (PrimState m) -> m ()+reset atlas = unsafeIOToPrim+ [CU.block| void {+ stbrp_context * p = $atlas:atlas;+ int heuristic = p->heuristic;+ int align = p->align;+ stbrp_init_target(p,p->width,p->height,(stbrp_node*)(p+1),p->num_nodes);+ p->heuristic = heuristic;+ p->align = align;+ }|]++setHeuristic :: PrimMonad m => Atlas (PrimState m) -> Heuristic -> m ()+setHeuristic fp (heuristicId -> h) = unsafeIOToPrim [CU.block|void { stbrp_setup_heuristic($atlas:fp,$(int h)); }|]++setAllowOutOfMem :: PrimMonad m => Atlas (PrimState m) -> Bool -> m ()+setAllowOutOfMem fp (fromIntegral . fromEnum -> b) = unsafeIOToPrim [CU.block|void { stbrp_setup_allow_out_of_mem($atlas:fp,$(int b)); }|]++pack+ :: (PrimMonad m, Traversable f)+ => Atlas (PrimState m) -- ^ The atlas you want to pack these rectangles into.+ -> (a -> Pt) -- ^ for each item you want to pack, extract the size.+ -> (Maybe Pt -> a -> b) -- ^ when some fail to pack this will be called, with+ -- 'Just' a position for each that succeeded, and+ -- 'Nothing' for any that it failed on. The successes+ -- and failures may well be out of order.+ -> (Pt -> a -> c) -- ^ when all succeed this will be called with each position.+ -> f a -- ^ A container full of things that you'd like to pack into the atlas.+ -> m (Either (f b) (f c)) -- ^ Either a mixture of successes and failures, or a successful pack.+pack atlas f g h as = stToPrim $ packM atlas (pure . f) g h as++packM+ :: (PrimBase m, Traversable f)+ => Atlas (PrimState m) -- ^ The 'Atlas' you want to pack these rectangles into.+ -> (a -> m Pt) -- ^ for each item you want to pack, extract the size, + -- with effects in @m@+ -> (Maybe Pt -> a -> b) -- ^ when some fail to pack this will be called, with+ -- 'Just' a position for each that succeeded, and + -- 'Nothing' for any that it failed on. The successes+ -- and failures may well be out of order.+ -> (Pt -> a -> c) -- ^ when all succeed, this will be called with each position.+ -> f a -- ^ A container full of things that you'd like to pack into the atlas.+ -> m (Either (f b) (f c)) -- ^ 'Either' a mixture of successes and failures, or a successful pack.+packM fc f g h as = unsafeIOToPrim do+ let n = length as+ let cn = fromIntegral n+ allocaBytes (n*sizeOfRect) \ rs -> do+ iforOf_ folded as \i a -> do+ p <- unsafePrimToIO $ f a+ pokeWH (plusPtr rs (i*sizeOfRect)) p+ res <- [CU.exp|int { stbrp_pack_rects($atlas:fc,$(stbrp_rect *rs),$(int cn)) }|]+ if res == 0+ then Left <$> evalStateT (traverse (go peekMaybeXY g) as) rs -- partial+ else Right <$> evalStateT (traverse (go peekXY h) as) rs -- all allocated+ where+ go :: (Ptr Rect -> IO u) -> (u -> a -> d) -> a -> StateT (Ptr Rect) IO d+ go k gh a = StateT \p -> (\b -> (,) (gh b a) $! plusPtr p sizeOfRect) <$> k p+ {-# inline go #-}++-- | Add one rectangle to the 'Atlas'. Using 'pack' can yield significantly better+-- packing than calling this one rectangle at a time.+pack1 :: PrimMonad m => Atlas (PrimState m) -> Pt -> m (Maybe Pt)+pack1 atlas p = stToPrim $ either runIdentity runIdentity <$> pack atlas id const (const . Just) (Identity p)
+ src/Data/Atlas/Internal.hsc view
@@ -0,0 +1,184 @@+{-# language BangPatterns #-}+{-# language LambdaCase #-}+{-# language DeriveLift #-}+{-# language ViewPatterns #-}+{-# language ImplicitParams #-}+{-# language RecordWildCards #-}+{-# language OverloadedStrings #-}+{-# language ScopedTypeVariables #-}+{-# language StandaloneDeriving #-}+{-# language UndecidableInstances #-}+{-# language MultiParamTypeClasses #-}+{-# language StrictData #-}+{-# language FunctionalDependencies #-}+{-# language TemplateHaskell #-}+{-# language MultiWayIf #-}+{-# language FlexibleInstances #-}++-- |+-- Copyright : (c) 2019 Edward Kmett+-- License : BSD-2-Clause OR Apache-2.0+-- Maintainer: Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability: non-portable+--+-- Details of the implementation.+--+-- The contents of this module do not fall under the PVP. Use at your own risk.++#ifndef HLINT+#include "stb_rect_pack.h"+#endif++module Data.Atlas.Internal+( Atlas(..)+, AtlasContext+, Coord+, Rect+, Node+, heuristicId, Heuristic(..)+, sizeOfAtlas+, sizeOfNode+, sizeOfRect+, Pt(..)+, peekWH, peekXY+, pokeWH, peekMaybeXY+, atlasCtx+, die+) where++import Control.Exception+import Control.Monad.IO.Class+import Data.Coerce+import Data.Default+import Data.Functor ((<&>))+import qualified Data.Map as Map+import Data.Word+import Data.Int+import Foreign.C.Types+import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Storable+import GHC.Arr+import GHC.Exception+import GHC.Stack+import qualified Language.C.Inline as C+import qualified Language.C.Inline.Context as C+import qualified Language.C.Inline.HaskellIdentifier as C+import qualified Language.C.Types as C+import qualified Language.Haskell.TH as TH+import qualified Language.Haskell.TH.Syntax as TH++type Coord = Word16+data Node+data Rect+data AtlasContext++newtype Atlas s = Atlas (ForeignPtr AtlasContext) deriving (Eq,Ord,Show)++die :: (MonadIO m, HasCallStack) => String -> m a+die msg = liftIO $ throwIO (errorCallWithCallStackException msg ?callStack)++getHsVariable :: HasCallStack => C.HaskellIdentifier -> TH.ExpQ+getHsVariable s = TH.lookupValueName (C.unHaskellIdentifier s) >>= \ case+ Nothing -> die $ "Cannot capture Haskell variable " ++ C.unHaskellIdentifier s ++ ", because it's not in scope."+ Just hsName -> TH.varE hsName++anti :: HasCallStack => C.Type C.CIdentifier -> TH.TypeQ -> TH.ExpQ -> C.SomeAntiQuoter+anti cTy hsTyQ w = C.SomeAntiQuoter C.AntiQuoter+ { C.aqParser = C.parseIdentifier <&> \hId -> (C.mangleHaskellIdentifier False hId, cTy, hId)+ , C.aqMarshaller = \_ _ _ cId -> (,) <$> hsTyQ <*> [|$w (coerce $(getHsVariable cId))|]+ }++atlasCtx :: C.Context+atlasCtx = mempty + { C.ctxTypesTable = Map.fromList+ [ (C.TypeName "stbrp_context", [t|AtlasContext|])+ , (C.TypeName "stbrp_rect", [t|Rect|])+ ]+ , C.ctxAntiQuoters = Map.fromList+ [ ("atlas"+ , anti + (C.Ptr [] $ C.TypeSpecifier mempty $ C.TypeName "stbrp_context") + [t|Ptr AtlasContext|]+ [|withForeignPtr|]+ )+ ]+ }++data Heuristic+ = BottomLeft -- ^ bottom-left sort-height+ | BestFirst -- ^ best first sort-height+ deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,TH.Lift)++instance Default Heuristic where+ def = BottomLeft+ {-# inline def #-}++-- | Use and cast back and forth to ints instead for more natural API?+data Pt = Pt Int Int deriving (Eq,Ord,Show,Read,TH.Lift)++instance Num Pt where+ Pt a b + Pt c d = Pt (a + c) (b + d)+ Pt a b - Pt c d = Pt (a - c) (b - d)+ Pt a b * Pt c d = Pt (a * c) (b * d)+ abs (Pt a b) = Pt (abs a) (abs b)+ signum (Pt a b) = Pt (signum a) (signum b)+ negate (Pt a b) = Pt (negate a) (negate b)+ fromInteger n = Pt (fromInteger n) (fromInteger n)+ {-# inline (+) #-}+ {-# inline (-) #-}+ {-# inline (*) #-}+ {-# inline abs #-}+ {-# inline signum #-}+ {-# inline negate #-}+ {-# inline fromInteger #-}++#ifndef HLINT++heuristicId :: Heuristic -> CInt+heuristicId BottomLeft = #const STBRP_HEURISTIC_Skyline_BL_sortHeight+heuristicId BestFirst = #const STBRP_HEURISTIC_Skyline_BF_sortHeight+{-# inline heuristicId #-}++sizeOfAtlas :: Int+sizeOfAtlas = #size stbrp_context+{-# inline sizeOfAtlas #-}++sizeOfNode :: Int+sizeOfNode = #size stbrp_node+{-# inline sizeOfNode #-}++sizeOfRect :: Int+sizeOfRect = #size stbrp_rect+{-# inline sizeOfRect #-}++peekWH :: Ptr Rect -> IO Pt+peekWH p = (\(w :: Coord) (h :: Coord) -> Pt (fromIntegral w) (fromIntegral h))+ <$> (#peek stbrp_rect, w) p+ <*> (#peek stbrp_rect, h) p+{-# inline peekWH #-}++pokeWH :: Ptr Rect -> Pt -> IO ()+pokeWH p (Pt w h) = do+ (#poke stbrp_rect, id) p (0 :: Int32)+ (#poke stbrp_rect, x) p (0 :: Coord)+ (#poke stbrp_rect, y) p (0 :: Coord)+ (#poke stbrp_rect, w) p (fromIntegral w :: Coord)+ (#poke stbrp_rect, h) p (fromIntegral h :: Coord)+ (#poke stbrp_rect, was_packed) p (0 :: Int32)+{-# inline pokeWH #-}++peekXY :: Ptr Rect -> IO Pt+peekXY p = (\(w :: Coord) (h :: Coord) -> Pt (fromIntegral w) (fromIntegral h))+ <$> (#peek stbrp_rect, x) p+ <*> (#peek stbrp_rect, y) p+{-# inline peekXY #-}++peekMaybeXY :: Ptr Rect -> IO (Maybe Pt)+peekMaybeXY p = (#peek stbrp_rect, was_packed) p >>= \case+ (0 :: Int32) -> pure Nothing+ _ -> Just <$> peekXY p+{-# inline peekMaybeXY #-}++#endif
+ test/Spec.hs view
@@ -0,0 +1,26 @@+module Main+( main+) where++import Control.Monad.Primitive+import Control.Monad.ST+import Data.Atlas+import Test.Hspec++harnessM :: PrimBase m => Int -> Int -> [Pt] -> m (Either [Maybe Pt] [Pt])+harnessM w h xs = do+ ctx <- create w h+ pack ctx id const const xs++harness :: Int -> Int -> [Pt] -> Either [Maybe Pt] [Pt]+harness w h xs = runST $ harnessM w h xs++main :: IO ()+main = hspec $+ describe "Data.Atlas" $ do+ it "can fill the packing region" $+ harness 100 100 [Pt 50 50, Pt 50 50, Pt 50 50, Pt 50 50] `shouldBe` Right [Pt 0 0,Pt 50 0,Pt 0 50,Pt 50 50]+ it "can run in IO" $+ harnessM 100 100 [Pt 50 50, Pt 50 50, Pt 50 50, Pt 50 50] `shouldReturn` Right [Pt 0 0,Pt 50 0,Pt 0 50,Pt 50 50]+ it "can be setup" $ + (do ctx <- create 10 10; setHeuristic ctx BestFirst) `shouldReturn` ()