view release on metacpan or  search on metacpan

include/in.h  view on Meta::CPAN

/*
 * in.h - Perl-XS bridge helpers for Colouring::In::XS
 *
 * Provides the glue between Perl SVs/HVs/AVs and the pure-C
 * colouring_rgba_t from colouring.h.  Header-only; requires
 * PERL_NO_GET_CONTEXT, perl.h and XSUB.h already included.
 *
 * Re-usable by Eshu (CSS preprocessor) or any other XS module
 * that works with Colouring::In colour objects.
 */

#ifndef COLOURING_IN_H
#define COLOURING_IN_H

#include "colouring.h"

/* ── Class name constant ──────────────────────────────────────── */

#define COLOURING_CLASS      "Colouring::In::XS"
#define COLOURING_CLASS_LEN  17

/* ── Message store (set from Perl side) ───────────────────────── */
/* Holds a refcount-managed reference to the user's message hash so
 * the underlying HV stays alive after set_messages() returns. */

static SV * MESSAGES_REF = NULL;

#define MESSAGES \
	((MESSAGES_REF && SvROK(MESSAGES_REF)) ? (HV*)SvRV(MESSAGES_REF) : NULL)

/* ── Bless a hash into the caller's class ─────────────────────── */

static SV * xs_new(SV * class, HV * hash) {
	dTHX;
	if (SvROK(class)) {
		char * name = HvNAME(SvSTASH(SvRV(class)));
		class = newSVpv(name, strlen(name));
	}
	return sv_bless(newRV_noinc((SV*)hash), gv_stashsv(class, 0));
}

/* ── Quick "does this SV look numeric?" check ─────────────────── */

static int numIs(SV * num) {
	dTHX;
	if (!num || !SvOK(num)) return 0;
	/* looks_like_number is Perl's portable, bounds-safe numeric test
	 * (handles ints, floats, scientific notation, Unicode digits). The
	 * previous hand-rolled scanner had an unbounded write into a
	 * fixed-size stack buffer — a stack-smash on long all-digit input. */
	return looks_like_number(num) ? 1 : 0;
}

/* ── Scale a value that may be a percentage ───────────────────── */

static double xs_scaled(SV * num, int size) {
	dTHX;
	STRLEN len;
	char * number = SvPV(num, len);
	double n = atof(number);
	/* Percent suffix: check the last *character*, not the trailing
	 * NUL (`number[strlen(number)]` always reads '\0'). */
	if (len > 0 && number[len - 1] == '%') {
		return (n * size) / 100;
	}
	return n;
}

/* ── Extract RGBA from a blessed Colouring::In::XS object ─────── */

static colouring_rgba_t xs_extract_rgba(SV * self) {
	dTHX;
	colouring_rgba_t c;
	AV * colour = (AV*)SvRV(*hv_fetch((HV*)SvRV(self), "colour", 6, 0));
	int len = av_len(colour);
	SV *r, *g, *b;

	r = len >= 0 ? *av_fetch(colour, 0, 0) : NULL;
	g = len >= 1 ? *av_fetch(colour, 1, 0) : NULL;
	b = len >= 2 ? *av_fetch(colour, 2, 0) : NULL;

	c.r = (r && SvOK(r)) ? SvNV(r) : 255;
	c.g = (g && SvOK(g)) ? SvNV(g) : 255;
	c.b = (b && SvOK(b)) ? SvNV(b) : 255;