From 4da3ad1f569832845b58c3ce35149633a2bb665c Mon Sep 17 00:00:00 2001
From: Uko Kokņevičs
Date: Thu, 9 Oct 2025 21:58:43 +0300
Subject: Initial commit

---
 src/tg-types/message-entity.lisp | 61 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 src/tg-types/message-entity.lisp

(limited to 'src/tg-types/message-entity.lisp')

diff --git a/src/tg-types/message-entity.lisp b/src/tg-types/message-entity.lisp
new file mode 100644
index 0000000..fcabcce
--- /dev/null
+++ b/src/tg-types/message-entity.lisp
@@ -0,0 +1,61 @@
+;; SPDX-License-Identifier: EUPL-1.2
+;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
+(defpackage :ukkoclot/tg-types/message-entity
+  (:use :c2cl :iterate :ukkoclot/tg-types/macros :ukkoclot/tg-types/parsers :ukkoclot/tg-types/user)
+  (:export
+   message-entity
+   make-message-entity
+   message-entity-p
+   copy-message-entity
+   message-entity-type
+   message-entity-offset
+   message-entity-length
+   message-entity-url
+   message-entity-user
+   message-entity-language
+   message-entity-custom-emoji-id
+
+   hash->message-entity
+   message-entity-extract
+   parse-message-entity-array))
+(in-package :ukkoclot/tg-types/message-entity)
+
+(define-tg-type message-entity
+  (type keyword nil :parser tg-string->keyword)
+  (offset integer)
+  (length integer)
+  (url (or string null) nil)
+  (user (or user null) nil)
+  (language (or string null) nil)
+  (custom-emoji-id (or string null) nil))
+
+(unless (= char-code-limit #x110000)
+  (error "Some UTF-16 fuckery assumes that system chars are UTF-32"))
+
+(defun utf16-width (ch)
+  (if (< (char-code ch) #x10000)
+      1
+      2))
+
+(defun message-entity-extract (entity text)
+  (with-slots (length offset) entity
+    (if (= length 0)
+        ""
+        (let* ((start (iterate
+                        (with curr-idx16 = 0)
+                        (for ch in-string text with-index curr-idx32)
+                        (for curr-width = (utf16-width ch))
+                        (when (or (= curr-idx16 offset)
+                                  (> (+ curr-idx16 curr-width) offset))
+                          (return curr-idx32))
+                        (setq curr-idx16 (+ curr-idx16 curr-width))
+                        (finally (return (length text)))))
+               (end (iterate
+                      (with curr-len16 = 0)
+                      (for ch in-string text from start with-index curr-idx32)
+                      (for curr-width = (utf16-width ch))
+                      (when (>= curr-len16 length)
+                        (return curr-idx32))
+                      (setq curr-len16 (+ curr-len16 curr-width))
+                      (finally (return (length text))))))
+          (subseq text start end)))))
-- 
cgit v1.2.3