From 87f1d045a60da6bc75d312ae5008e1823ae519f3 Mon Sep 17 00:00:00 2001
From: visionmercer <62051836+visionmercer@users.noreply.github.com>
Date: Sat, 21 May 2022 00:18:24 +0200
Subject: [PATCH] Create savebinarypbm.bm

---
 savebinarypbm.bm | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)
 create mode 100644 savebinarypbm.bm

diff --git a/savebinarypbm.bm b/savebinarypbm.bm
new file mode 100644
index 0000000..4bc431f
--- /dev/null
+++ b/savebinarypbm.bm
@@ -0,0 +1,37 @@
+Sub saveBinaryPBM (handle As Long, filename As String)
+    Dim imgwidth As Long
+    Dim imgheight As Long
+    Dim oldsource As Long
+    Dim fid As String
+    Dim imgdim As String
+    Dim y As _Unsigned Long
+    Dim x As _Unsigned Long
+    Dim c As _Byte
+
+    oldsource = _Source
+    _Source handle
+    imgwidth = _Width(handle)
+    imgheight = _Height(handle)
+    Open filename For Binary As #1
+    fid = "P4" + Chr$(10)
+    Put #1, , fid
+    fid = "# Created with QB64" + Chr$(10)
+    Put #1, , fid
+    imgdim = LTrim$(Str$(imgwidth) + Str$(imgheight)) + Chr$(10)
+    Put #1, , imgdim
+    Dim o As _Unsigned _Byte
+    For y = 0 To imgheight - 1
+        For x = 0 To imgwidth - 1
+            c = (Point(x, y) = _RGB(0, 0, 0))
+            If c <> 0 Then
+                o = _SetBit(o, 7 - (x Mod 8))
+            Else
+                o = _ResetBit(o, 7 - (x Mod 8))
+            End If
+            If x Mod 8 = 7 Then
+                Put #1, , o
+            End If
+        Next
+    Next
+    Close #1
+End Sub