1738 h "{ Class: SmallInteger }" |
1740 h "{ Class: SmallInteger }" |
1739 sz "{ Class: SmallInteger }" | |
1741 sz "{ Class: SmallInteger }" | |
1740 |
1742 |
1741 w := wIn. |
1743 w := wIn. |
1742 h := hIn. |
1744 h := hIn. |
|
1745 ((w == 0) or:[h == 0]) ifTrue:[ |
|
1746 self error:'invalid form extent' mayProceed:true. |
|
1747 ^ nil |
|
1748 ]. |
1743 bytes := anArray. |
1749 bytes := anArray. |
1744 sz := anArray size. |
1750 sz := anArray size. |
1745 |
1751 |
1746 sz ~~ (((w + 7) // 8) * h) ifTrue:[ |
1752 sz ~~ (((w + 7) // 8) * h) ifTrue:[ |
1747 "/ not bytes ... |
1753 "/ not bytes ... |
1748 sz == (((w + 15) // 16) * h) ifTrue:[ |
1754 sz == (((w + 15) // 16) * h) ifTrue:[ |
1749 "I want the bytes but got shorts (ST-80)" |
1755 "I want the bytes but got shorts (ST-80)" |
1750 bytes := ByteArray uninitializedNew:(((w + 7) // 8) * h). |
1756 bytes := ByteArray uninitializedNew:(((w + 7) // 8) * h). |
1751 srcPerRow := (w + 15) // 16. |
1757 srcPerRow := (w + 15) // 16. |
1752 dstPerRow := (w + 7) // 8. |
1758 dstPerRow := (w + 7) // 8. |
1753 srcStart := 1. |
1759 srcStart := 1. |
1754 dstIndex := 1. |
1760 dstIndex := 1. |
1755 |
1761 |
1756 1 to:h do:[:hi | |
1762 1 to:h do:[:hi | |
1757 srcIndex := srcStart. |
1763 srcIndex := srcStart. |
1758 bits := anArray at:srcIndex. |
1764 bits := anArray at:srcIndex. |
1759 1 to:dstPerRow do:[:di | |
1765 1 to:dstPerRow do:[:di | |
1760 di odd ifTrue:[ |
1766 di odd ifTrue:[ |
1761 bits := anArray at:srcIndex. |
1767 bits := anArray at:srcIndex. |
1762 bytes at:dstIndex put:(bits bitShift:-8) |
1768 bytes at:dstIndex put:(bits bitShift:-8) |
1763 ] ifFalse:[ |
1769 ] ifFalse:[ |
1764 bytes at:dstIndex put:(bits bitAnd:16rFF). |
1770 bytes at:dstIndex put:(bits bitAnd:16rFF). |
1765 srcIndex := srcIndex + 1 |
1771 srcIndex := srcIndex + 1 |
1766 ]. |
1772 ]. |
1767 dstIndex := dstIndex + 1 |
1773 dstIndex := dstIndex + 1 |
1768 ]. |
1774 ]. |
1769 srcStart := srcStart + srcPerRow |
1775 srcStart := srcStart + srcPerRow |
1770 ] |
1776 ] |
1771 ] ifFalse:[ |
1777 ] ifFalse:[ |
1772 sz == (((w + 31) // 32) * h) ifTrue:[ |
1778 sz == (((w + 31) // 32) * h) ifTrue:[ |
1773 "I want the bytes but got longs (Squeak)" |
1779 "I want the bytes but got longs (Squeak)" |
1774 |
1780 |
1775 bytes := ByteArray uninitializedNew:(((w + 7) // 8) * h). |
1781 bytes := ByteArray uninitializedNew:(((w + 7) // 8) * h). |
1776 srcPerRow := (w + 31) // 32. |
1782 srcPerRow := (w + 31) // 32. |
1777 dstPerRow := (w + 7) // 8. |
1783 dstPerRow := (w + 7) // 8. |
1778 srcStart := 1. |
1784 srcStart := 1. |
1779 dstIndex := 1. |
1785 dstIndex := 1. |
1780 |
1786 |
1781 1 to:h do:[:hi | |
1787 1 to:h do:[:hi | |
1782 |ss| |
1788 |ss| |
1783 |
1789 |
1784 srcIndex := srcStart. |
1790 srcIndex := srcStart. |
1785 bits := anArray at:srcIndex. |
1791 bits := anArray at:srcIndex. |
1786 ss := 0. |
1792 ss := 0. |
1787 1 to:dstPerRow do:[:di | |
1793 1 to:dstPerRow do:[:di | |
1788 ss == 0 ifTrue:[ |
1794 ss == 0 ifTrue:[ |
1789 bits := anArray at:srcIndex. |
1795 bits := anArray at:srcIndex. |
1790 ]. |
1796 ]. |
1791 bytes at:dstIndex put:((bits bitShift:-24) bitAnd:16rFF). |
1797 bytes at:dstIndex put:((bits bitShift:-24) bitAnd:16rFF). |
1792 bits := bits bitShift:8. |
1798 bits := bits bitShift:8. |
1793 ss := ss + 1. |
1799 ss := ss + 1. |
1794 ss == 4 ifTrue:[ |
1800 ss == 4 ifTrue:[ |
1795 srcIndex := srcIndex + 1. |
1801 srcIndex := srcIndex + 1. |
1796 ss := 0. |
1802 ss := 0. |
1797 ]. |
1803 ]. |
1798 dstIndex := dstIndex + 1 |
1804 dstIndex := dstIndex + 1 |
1799 ]. |
1805 ]. |
1800 srcStart := srcStart + srcPerRow |
1806 srcStart := srcStart + srcPerRow |
1801 ] |
1807 ] |
1802 ] |
1808 ] |
1803 ] |
1809 ] |
1804 ]. |
1810 ]. |
1805 data := bytes. |
1811 data := bytes. |
1806 width := w. |
1812 width := w. |
1807 height := h. |
1813 height := h. |
1808 depth := 1. |
1814 depth := 1. |
1809 offset := 0@0. |
1815 offset := 0@0. |
1810 |
1816 |
1811 localColorMap isNil ifTrue:[ |
1817 localColorMap isNil ifTrue:[ |
1812 BlackAndWhiteColorMap isNil ifTrue:[ |
1818 BlackAndWhiteColorMap isNil ifTrue:[ |
1813 BlackAndWhiteColorMap := Array with:(Color white) with:(Color black) |
1819 BlackAndWhiteColorMap := Array with:(Color white) with:(Color black) |
1814 ]. |
1820 ]. |
1815 localColorMap := BlackAndWhiteColorMap. |
1821 localColorMap := BlackAndWhiteColorMap. |
1816 ]. |
1822 ]. |
1817 |
1823 |
1818 device notNil ifTrue:[ |
1824 device notNil ifTrue:[ |
1819 gc createBitmapFromArray:bytes width:w height:h. |
1825 gc createBitmapFromArray:bytes width:w height:h. |
1820 realized := true. |
1826 realized := true. |
1821 ]. |
1827 ]. |
|
1828 |
|
1829 "Modified: / 06-09-2017 / 12:33:17 / Maren" |
1822 ! |
1830 ! |
1823 |
1831 |
1824 width:w height:h offset:offs fromArray:anArray |
1832 width:w height:h offset:offs fromArray:anArray |
1825 "actual create of a monochrome form from array" |
1833 "actual create of a monochrome form from array" |
1826 |
1834 |