From a8ae08e362716047f7c57031237313411fb7e13a Mon Sep 17 00:00:00 2001
From: retropikzel <retropikzel@iki.fi>
Date: Thu, 25 Dec 2025 16:22:53 +0200
Subject: [PATCH] Added polygon library, backup

---
 retropikzel/polygon.scm | 55 +++++++++++++++++++++++++++++++++++++++++
 retropikzel/polygon.sld |  8 ++++++
 2 files changed, 63 insertions(+)
 create mode 100644 retropikzel/polygon.scm
 create mode 100644 retropikzel/polygon.sld

diff --git a/retropikzel/polygon.scm b/retropikzel/polygon.scm
new file mode 100644
index 0000000..50f44d7
--- /dev/null
+++ b/retropikzel/polygon.scm
@@ -0,0 +1,55 @@
+(define (make-rectangle-polygon x y width height)
+  (list (cons x y)
+        (cons (+ x width) y)
+        (cons (+ x width) (+ y height))
+        (cons x (+ y height))))
+
+(define (make-triangle-polygon x y width height)
+  (list (cons x y)
+        (cons (+ x (exact (round (/ width 2))))
+              (+ y height))
+        (cons (- x (exact (round (/ width 2))))
+              (+ y height))))
+
+(define (draw-polygon polygon)
+  (let* ((first-point #f)
+         (previous-point #f))
+    (for-each
+      (lambda (point)
+        (when (not first-point)
+          (set! first-point point)
+          (set! previous-point first-point))
+        (draw-line previous-point point)
+        (set! previous-point point))
+      polygon)
+    (when first-point
+      (draw-line previous-point first-point))))
+
+(define (draw-relative-polygon x y polygon)
+  (let* ((first-point #f)
+         (previous-point #f))
+    (for-each
+      (lambda (point)
+        (when (not first-point)
+          (set! first-point point)
+          (set! previous-point first-point))
+        (draw-line (cons (+ (car previous-point) x)
+                         (+ (cdr previous-point) y))
+                   (cons (+ (car point) x)
+                         (+ (cdr point) y)))
+        (set! previous-point point))
+      polygon)
+    (when first-point
+      (draw-line (cons (+ (car previous-point) x)
+                       (+ (cdr previous-point) y))
+                 (cons (+ (car first-point) x)
+                       (+ (cdr first-point) y))))))
+
+(define (move-polygon polygon x y)
+  (map (lambda (point)
+         (cons (+ (car point) x)
+               (+ (cdr point) y)))
+       polygon))
+
+(define (rotate-polygon polygon degrees)
+  (error "WIP"))
diff --git a/retropikzel/polygon.sld b/retropikzel/polygon.sld
new file mode 100644
index 0000000..0ad0d98
--- /dev/null
+++ b/retropikzel/polygon.sld
@@ -0,0 +1,8 @@
+(define-library
+  (retropikzel polygon)
+  (import (scheme base))
+  (export make-rectangle-polygon
+          make-triangle-polygon
+          move-polygon
+          rotate-polygon)
+  (include "polygon.scm"))