improved code documentation for RLC routine

/*  Copyright 2014 Aaron Boxer

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>. */

#include "ocl_platform.cl"

/*

Bit Plane Coder
===============

A. Scan Pattern

Xx4 stripes

The stripes are scanned from top to bottom, and the columns within a
stripe are scanned from left to right.

B. Serial State Variables

Pixels are stored in Sign + Magnitude format

sigma[y][x]			equal to 1 if at least one non-zero bit has been coded, otherwise zero

sigma_prime[y][x]   equal to 1 if magnitude refinement coding (MRC) has been applied to this pixel, otherwise zero

eta[y][x]		    equal to 1 if zero coding (ZC) has been applied in SPP for this bit plane, otherwise zero

Note: eta gets reset to zero at the start of each bit plane, while sigma and sigma_prime do not.

C. Concepts

Preferred Neighbourhood: at least one of the eight neighbours has sigma[y][x] == 1

Sign Coding (SC)
Zero Coding (ZC)
Magnitude Refinement Coding (MRC)
Run Length Encoding (RLC) (applied only to first pixel in stripe column)
	- if we are at the first pixel in the column, and all four pixels in column have sigma == 0 and eta == 0,
      then apply RLC to current pixel
	- occurrence of first 1 bit in column determines how RLC is coded

C. Serial Algorithm

Three passes per bit plane : Significance Propagation Pass (SPP)
                             Magnitude Refinement Pass	 (MRP)
						     Clean Up Pass				 (CUP)

Only the CUP is performed on the most significant bit plane (MSB)

Algorithm:

i. most significant bit plane is calculated

ii.  SPP
     // not significant, and in preferred nbhd
     if in preferred nbhd and sigma[y][x] == 0 then
	     ZC
		 eta[y][x] = 1
		 if (encoded bit == 1) then
			SC
			sigma[y][x] = 1
		 end if
	end if

iii. MRP
     // significant, but ZC has not been performed in SPP
	`if (sigma[y][x] == 1 and eta[y][x] == 0 then
		MRC
		sigma_prime = 1
	end if

iv. CUP
    // not significant, and not in preferred nbhd
	if sigma[y][x] == 0 and eta[y][x] == 0 then
		if pixel meets RLC conditions then
		   RLC
		else
		   ZC
		endif
*/

#define CODEBLOCKY_QUARTER 8

#define BOUNDARY 1
#define BOUNDARY_X2 2

#define CODEBLOCKY_X4 128

//////////////////////////////////////////////////////
// State Buffer

#define STATE_BUFFER_SIZE 1156
#define STATE_BOTTOM_BOUNDARY_OFFSET 1124

#define STATE_BUFFER_STRIDE 34
#define STATE_BUFFER_STRIDE_X2 68
#define STATE_BUFFER_STRIDE_X3 102
#define STATE_BUFFER_STRIDE_X4 136

#define LEFT_TOP -35
#define TOP  -34
#define RIGHT_TOP -33

#define LEFT   -1
#define RIGHT   1

#define LEFT_BOTTOM  33
#define BOTTOM  34
#define RIGHT_BOTTOM  35

////////////////////////////////////////////////////
// State Variables

// bit positions (0 based indices)
#define INPUT_SIGN_BITPOS  15  // assumes 16 bit signed input

#define SIGMA_NEW_BITPOS   0x0
#define SIGMA_OLD_BITPOS   0x1
#define NBH_BITPOS         0x2
#define PIXEL_START_BITPOS 0xA
#define PIXEL_END_BITPOS   0x18
#define SIGN_BITPOS        0x19

// bit flags
#define SIGMA_NEW_F			 0x1		  //position 0
#define SIGMA_OLD_F			 0x10		  //position  1
#define NBH_F				 0x20		  //position  2
#define PIXEL_F				 0x7FFF0000   //positions 10-24
#define SIGN_F				 0x2000000    //position  25

#define NOT_SIGMA_NEW_F      0xFFFFFFFE   // ~SIGMA_NEW
#define SIGMA_OLD_AND_NEW_F  0x11

#define INPUT_TO_SIGN_SHIFT 10
#define SIGMA_OLD_TO_NBH_SHIFT 0x1

#define BIT(pix) (((pix)>>(bp))&1)
#define NBH(pix) ((pix) & NBH_F)
#define SIGMA_OLD(pix) ((pix) & SIGMA_OLD_F)
#define SIGMA_NEW(pix) ((pix) & SIGMA_NEW_F)
#define SIGMA_OLD_AND_NEW(pix) ((pix) & SIGMA_OLD_AND_NEW_F)
#define SIGN(pix) ((pix) & SIGN_F)

#define SET_SIGMA_NEW(pix) ( (pix) |= SIGMA_NEW_F )
#define CLEAR_SIGMA_NEW(pix) ( (pix) &= NOT_SIGMA_NEW_F )

/////////////////////////////////////
// Context Variables

/*
0-2		(CX,D) pairs counter
3		SPP flag
4		MRP flag
5		SPP flag
8		D4
9-13	CX4
14		D3
15-19	CX3
20		D2
21-25	CX2
26		D1
27-31	CX1

*/

/////////////////////////////////////////////////////

// TABLES
/*

// ZERO CODING /////////////////////////////////////

// LL and LH sub-bands
values					Context
sumH	sumV	sumD	CX
2		x		x		8
1 		1		x		7
1		0 		1		6
1		0		0		5
0		2		x		4
0		1		x		3
0		0 		2		2
0		0		1		1
0		0		0		0

//HH sub-band

values					Context
sum(H + V )		sumD	CX
2 				3		8
1				2		7
1				2		6
1				1		5
0				1		4
0				1		3
0				0		2
0				0		1
0				0		0

// HL sub-band

 values Context
sumH	sumV	sumD	CX
x		2		x		8
1		1		x		7
0		1 		1		6
0		1		0		5
2		0		x		4
1		0		x		3
0		0 		2		2
0		0		1		1
0		0		0		0

// SIGN CODING ///////////////////////

H	V	X^	 CX
1	1	0	 13
1	0	0	 12
1	-1	0	 11
0	1	0	 10
0	0	0	 9
0	-1	1	 10
-1	1	1	 11
-1	0	1	 12
-1 -1	1	 13

// Magnitude Refinement //////////////////

sigm_prime [y; x]	(H + V + D)	CX
1					x			16
0 					1			15
0					0			14

*/

CONSTANT sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE  | CLK_FILTER_NEAREST;

void KERNEL run(read_only image2d_t channel) {

	// state buffer
	LOCAL uint state[STATE_BUFFER_SIZE];
	LOCAL uint cxd[STATE_BUFFER_SIZE];

	///////////////////////////////////////////////////////////////////////////////////
	//1. Calculate MSB

	LOCAL int msbScratch[CODEBLOCKX]; // between -1 and 31 - negative one value indicates that this code block is identically zero

	int maxSigBit;
	if (getLocalId(1) == 0) {

		uint maxVal = 0;
		state[getLocalId(0)] = 0;   //top boundary
		LOCAL uint* statePtr = state + (BOUNDARY + getLocalId(0));
		int2 posIn = (int2)(getGlobalId(0),  (getGlobalId(1) >> 3)*CODEBLOCKY);

		for (uint i = 0; i < CODEBLOCKY; ++i) {
			int pixel = read_imagei(channel, sampler, posIn).x;
			uint absPixel = abs(pixel);
			maxVal = max(maxVal, absPixel);
			pixel = (absPixel << PIXEL_START_BITPOS) | SIGN((pixel << INPUT_TO_SIGN_SHIFT));
			statePtr[0] = pixel;

			posIn.y++;
			statePtr += STATE_BUFFER_STRIDE;
		}
		state[ getLocalId(0) + STATE_BOTTOM_BOUNDARY_OFFSET] = 0;		//bottom boundary

		//initialize full left and right boundary columns
		if (getLocalId(0) == 0 || getLocalId(0) == CODEBLOCKX-1) {
			int delta = -1 + ((getLocalId(0)/(CODEBLOCKX-1)) << 1); // -1 or +1
			statePtr = state + BOUNDARY + getLocalId(0) + delta;
			for (uint i = 0; i < CODEBLOCKY+ BOUNDARY_X2; ++i) {
				 *statePtr = 0;
				 statePtr += STATE_BUFFER_STRIDE;
			}
		}

		// calculate column-msb
		maxSigBit = 31 - clz(maxVal);
		msbScratch[getLocalId(0)] =maxSigBit;
	}
	localMemoryFence();

	//calculate global msb
	if (!getLocalId(0) && !getLocalId(1) ) {
		int4 mx = (int4)(maxSigBit);

		LOCAL int* scratchPtr = msbScratch;
		for(uint i=0; i < CODEBLOCKX; i+=4) {
			mx = max(mx,(int4)(msbScratch[i],msbScratch[i+1],msbScratch[i+2],msbScratch[i+3]));
		}
		maxSigBit = mx.x;
		maxSigBit = max(maxSigBit, mx.y);
		maxSigBit = max(maxSigBit, mx.z);
		maxSigBit = max(maxSigBit, mx.w);
		msbScratch[0] = maxSigBit;
	}
	localMemoryFence();

	if (msbScratch[0] == -1)
		return;

	int startIndex = (BOUNDARY + getLocalId(0)) + (BOUNDARY + getLocalId(1))*STATE_BUFFER_STRIDE_X4;

	////////////////////////////////////////////////////////////////////////////////////////////////
	// 2. CUP on MSB

	uint bp = msbScratch[0] + PIXEL_START_BITPOS;

	// i) set sigma_new for stripe column (sigma_old is zero)
	LOCAL uint* statePtr = state + startIndex;
	for (uint i = 0; i < 4; ++i) {
		uint current = statePtr[0];
		current |= BIT(current);	// set sigma_new
		*statePtr = current;
		statePtr += STATE_BUFFER_STRIDE;

	}
	localMemoryFence();

	// ii) set nbh for stripe column, and do CUP

	// Note: since this is the very first pass on this code block, the only possible significant pixels
	// following the scan pattern are the those in top, left top, left and left bottom positions.

	// RLC (which runs through all consecutive non-significant pixels in column)
	// ZC/SC on rest of pixels in column

	statePtr				= state + startIndex;
	uint current			= statePtr[0];
	uint top				= statePtr[TOP];
	uint leftTop			= statePtr[LEFT_TOP];
	uint left				= statePtr[LEFT];
	uint leftBottom			= statePtr[LEFT_BOTTOM];

	// first pixel in stripe column
	uint nbh =  SIGMA_NEW(top) | SIGMA_NEW(leftTop) | SIGMA_NEW(left) | SIGMA_NEW(leftBottom);
	bool doRLC = !nbh && !SIGMA_NEW(current);
	if (!doRLC) {
		if (nbh) {
			//ZC
		}
		if (SIGMA_NEW(current) ){
			//SC
		}
	}

	for (int i = 0; i < 2; ++i) {
		statePtr += STATE_BUFFER_STRIDE;
		top			= current;
		current		= statePtr[0];
		leftTop		= left;
		left		= leftBottom;
		leftBottom	= statePtr[LEFT_BOTTOM];

		nbh =  SIGMA_NEW(top) | SIGMA_NEW(leftTop) | SIGMA_NEW(left) | SIGMA_NEW(leftBottom);
		bool wasDoingRLC = doRLC;
		doRLC = doRLC && !nbh && !SIGMA_NEW(current);
		if (!doRLC) {
		    if (wasDoingRLC) {
				//RLC for first (i+1) pixels
			}
			if (nbh) {
				//ZC
			}
			if (SIGMA_NEW(current)) {
				//SC
			}
		}
	}

	// last pixel in stripe column -
	// ignore leftBottom pixel, because it is in the next
	// stripe and it hasn't been processed yet
	statePtr += STATE_BUFFER_STRIDE;
	top			= current;
	current		= statePtr[0];
	leftTop		= left;
	left		= leftBottom;

	nbh =  SIGMA_NEW(top) | SIGMA_NEW(leftTop) | SIGMA_NEW(left);
	bool wasDoingRLC = doRLC;
	doRLC = doRLC && !nbh && !SIGMA_NEW(current);
	if (doRLC) {
		//RLC for first all four pixels in stripe column
	}
	else {
	   if (wasDoingRLC) {
		  //RLC for first three pixels in stripe column
	   }

		if (nbh) {
			//ZC
		}
		if (SIGMA_NEW(current)) {
			//SC
		}
	}
	localMemoryFence();

	/////////////////////////////////////////////////////////////////////////////////////////////////
	// 3. Processs rest of bit planes
	bp--;
	LOCAL char blockVote;

	while (bp >= PIXEL_START_BITPOS) {
		blockVote = 0;

		/////////////////////////////
		// 4. pre-process bit plane

		// i) migrate sigma_new to sigma_old, and clear sigma new bit
		statePtr = state + startIndex;
		for (uint i = 0; i < 4; ++i) {
		    uint current = *statePtr;
			current |=  SIGMA_NEW(current) << SIGMA_OLD_BITPOS;
			CLEAR_SIGMA_NEW(current);

			*statePtr = current;
			statePtr += STATE_BUFFER_STRIDE;

		}
		localMemoryFence();

		// ii) update nbh
		statePtr = state + startIndex;

		uint top			= statePtr[TOP];
		uint leftTop		= statePtr[LEFT_TOP];
		uint rightTop	= statePtr[RIGHT_TOP];
		uint left		= statePtr[LEFT];
		uint current		= statePtr[0];
		uint right		= statePtr[RIGHT];
		uint leftBottom  = statePtr[LEFT_BOTTOM];
		uint bottom		= statePtr[BOTTOM];
		uint rightBottom = statePtr[RIGHT_BOTTOM];

		current |=  (   SIGMA_OLD(leftTop) |
						SIGMA_OLD( top) |
						SIGMA_OLD( rightTop) |
						SIGMA_OLD( left) |
						SIGMA_OLD( right) |
						SIGMA_OLD( leftBottom) |
						SIGMA_OLD( bottom) |
						SIGMA_OLD( rightBottom)  ) << SIGMA_OLD_TO_NBH_SHIFT;

		if ( BIT(current) && NBH(current) && !SIGMA_OLD(current) ) {
			SET_SIGMA_NEW(current);
			blockVote = 1;

		}
		*statePtr = current;

		for (uint i = 0; i < 3; ++i) {
			statePtr += STATE_BUFFER_STRIDE;

			top			 = current;
			leftTop		 = left;
			rightTop	 = right;
			left		 = leftBottom;
			current		 = statePtr[0];
			right		 = rightBottom;
			leftBottom   = statePtr[LEFT_BOTTOM];
			bottom		 = statePtr[BOTTOM];
			rightBottom  = statePtr[RIGHT_BOTTOM];

			current |=	   ( SIGMA_OLD(leftTop) |
							 SIGMA_OLD( top) |
							 SIGMA_OLD( rightTop) |
							 SIGMA_OLD( left) |
							 SIGMA_OLD( right) |
							 SIGMA_OLD( leftBottom) |
							 SIGMA_OLD( bottom) |
							 SIGMA_OLD( rightBottom)  ) << SIGMA_OLD_TO_NBH_SHIFT;

			if ( BIT(current) && NBH(current) && !SIGMA_OLD(current) ) {
			    SET_SIGMA_NEW(current);
				blockVote = 1;
			}
			*statePtr = current;

		}
		localMemoryFence();

		// iii) block vote on sigma new
		while (blockVote)
		{
		    blockVote = 0;
			localMemoryFence();

			statePtr = state + startIndex;

			//first pixel in stripe column
			uint top			= statePtr[TOP];
			uint leftTop		= statePtr[LEFT_TOP];
			uint left			= statePtr[LEFT];
			uint current		= statePtr[0];
			uint leftBottom		= statePtr[LEFT_BOTTOM];

			current  |= (   SIGMA_NEW(leftTop) |
							SIGMA_NEW( top) |
							SIGMA_NEW( left) |
							SIGMA_NEW( leftBottom) ) << NBH_BITPOS;

			if (  BIT(current) && !SIGMA_OLD(current) &&  NBH(current)  &&  !SIGMA_NEW(current)) {
				SET_SIGMA_NEW(current);
				blockVote = 1;

			}
			statePtr[0] = current;

			// next two pixels in stripe column
			for (uint i = 0; i < 2; ++i) {
				statePtr += STATE_BUFFER_STRIDE;

				top			= current;
				current		= statePtr[0];
				leftTop		= left;
				left		= leftBottom;
				leftBottom  = statePtr[LEFT_BOTTOM];

				current  |= (   SIGMA_NEW(leftTop) |
								SIGMA_NEW( top) |
								SIGMA_NEW( left) |
								SIGMA_NEW( leftBottom) ) << NBH_BITPOS;

				if (  BIT(current) && !SIGMA_OLD(current) && NBH(current)  && !SIGMA_NEW(current)) {
					SET_SIGMA_NEW(current);
					blockVote = 1;

				}
				statePtr[0] = current;
			}

			// last pixel in stripe column -
			// ignore leftBottom pixel, because it is in the next
			// stripe and it hasn't been processed yet
			statePtr += STATE_BUFFER_STRIDE;

			top			= current;
			current		= statePtr[0];
			leftTop		= left;
			left		= leftBottom;

			current |= ( SIGMA_NEW(leftTop) |
						 SIGMA_NEW( top) |
						 SIGMA_NEW( left) ) << NBH_BITPOS;
			if (  BIT(current) && !SIGMA_OLD(current) && NBH(current)  && !SIGMA_NEW(current)) {
				SET_SIGMA_NEW(current);
				blockVote = 1;
			}
			statePtr[0] = current;

			localMemoryFence();

		}

		/////////////////////////
		// 5. bit plane processing
		statePtr = state + startIndex;

		// first pixel in stripe column
		top				= statePtr[TOP];
		leftTop			= statePtr[LEFT_TOP];
		rightTop		= statePtr[RIGHT_TOP];
		left			= statePtr[LEFT];
		current			= statePtr[0];
		right			= statePtr[RIGHT];
		leftBottom		= statePtr[LEFT_BOTTOM];
		bottom			= statePtr[BOTTOM];
		rightBottom		= statePtr[RIGHT_BOTTOM];

		bool doRLC = false;
		if (SIGMA_OLD(current)) {
			// MRC
		} else {
			int nbh = ( SIGMA_OLD_AND_NEW(leftTop) |
						SIGMA_OLD_AND_NEW( top) |
						SIGMA_OLD_AND_NEW( rightTop) |
						SIGMA_OLD_AND_NEW( left) |
						SIGMA_OLD_AND_NEW( right) |
						SIGMA_OLD_AND_NEW( leftBottom) |
						SIGMA_OLD_AND_NEW( bottom) |
						SIGMA_OLD_AND_NEW( rightBottom)  ) ;

			doRLC = !nbh && !SIGMA_NEW(current);
			if (!doRLC) {
				 if (nbh) {
					//ZC
				 }

                // could be from SPP or CUP
				if (BIT(current)) {
					//SC
				}
			}
		}

		// next two pixels in stripe column
		for (uint i = 0; i < 2; ++i) {
			statePtr += STATE_BUFFER_STRIDE;

			top			= current;
			leftTop		= left;
			rightTop	= right;
			left		= leftBottom;
			current		= statePtr[0];
			right		= rightBottom;
			leftBottom  = statePtr[LEFT_BOTTOM];
			bottom		= statePtr[BOTTOM];
			rightBottom = statePtr[RIGHT_BOTTOM];

			if (SIGMA_OLD(current)) {
			    if (doRLC) {
					//RLC for first (i+1) pixels
					doRLC = false;
				}
				// MRC
			} else {
				int nbh = ( SIGMA_OLD_AND_NEW(leftTop) |
							SIGMA_OLD_AND_NEW( top) |
							SIGMA_OLD_AND_NEW( rightTop) |
							SIGMA_OLD_AND_NEW( left) |
							SIGMA_OLD_AND_NEW( right) |
							SIGMA_OLD_AND_NEW( leftBottom) |
							SIGMA_OLD_AND_NEW( bottom) |
							SIGMA_OLD_AND_NEW( rightBottom)  ) ;

				bool wasDoingRLC = doRLC;
				doRLC = doRLC && !nbh && !SIGMA_NEW(current);
				if (!doRLC) {
					if (wasDoingRLC) {
						//RLC for first (i+1) pixels
					}
					if (nbh) {
						//ZC
					}

					// could be from SPP or CUP
					if (BIT(current) ) {
						//SC
					}

				}
			}
		}

		// last pixel in stripe column
		statePtr += STATE_BUFFER_STRIDE;

		top			= current;
		leftTop		= left;
		rightTop	= right;
		left		= leftBottom;
		current		= statePtr[0];
		right		= rightBottom;

		if (SIGMA_OLD(current)) {
			if (doRLC) {
				//RLC for first three pixels
			}
			// MRC
		} else {
			int nbh = ( SIGMA_OLD_AND_NEW(leftTop) |
						SIGMA_OLD_AND_NEW( top) |
						SIGMA_OLD_AND_NEW( rightTop) |
						SIGMA_OLD_AND_NEW( left) |
						SIGMA_OLD_AND_NEW( right)  ) ;

			bool wasDoingRLC = doRLC;
			doRLC = doRLC && !nbh && !SIGMA_NEW(current);
			if (doRLC) {
				// RLC for all four pixels in stripe column
			} else {
				if (wasDoingRLC) {
					//RLC for first three pixels in column
				}
				if (nbh) {
					//ZC
				}

				// could be from SPP or CUP
				if (BIT(current) ) {
					//SC
				}
			}
		}
		localMemoryFence();
		bp--;
	}
}

/*  Copyright 2014 Aaron Boxer

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>. */

#include "ocl_platform.cl"

/*

Bit Plane Coder
===============

A. Scan Pattern

Xx4 stripes

The stripes are scanned from top to bottom, and the columns within a
stripe are scanned from left to right.

B. Serial State Variables

Pixels are stored in Sign + Magnitude format

sigma[y][x]			equal to 1 if at least one non-zero bit has been coded, otherwise zero

sigma_prime[y][x]   equal to 1 if magnitude refinement coding (MRC) has been applied to this pixel, otherwise zero

eta[y][x]		    equal to 1 if zero coding (ZC) has been applied in SPP for this bit plane, otherwise zero

Note: eta gets reset to zero at the start of each bit plane, while sigma and sigma_prime do not.

C. Concepts

Preferred Neighbourhood: at least one of the eight neighbours has sigma[y][x] == 1

Sign Coding (SC)
Zero Coding (ZC)
Magnitude Refinement Coding (MRC)
Run Length Encoding (RLC) (applied only to first pixel in stripe column)
	- if we are at the first pixel in the column, and all four pixels in column have sigma == 0 and eta == 0,
      then apply RLC to current pixel
	- occurrence of first 1 bit in column determines how RLC is coded

C. Serial Algorithm

Three passes per bit plane : Significance Propagation Pass (SPP)
                             Magnitude Refinement Pass	 (MRP)
						     Clean Up Pass				 (CUP)

Only the CUP is performed on the most significant bit plane (MSB)

Algorithm:

i. most significant bit plane is calculated

ii.  SPP
     // not significant, and in preferred nbhd
     if in preferred nbhd and sigma[y][x] == 0 then
	     ZC
		 eta[y][x] = 1
		 if (encoded bit == 1) then
			SC
			sigma[y][x] = 1
		 end if
	end if

iii. MRP
     // significant, but ZC has not been performed in SPP
	`if (sigma[y][x] == 1 and eta[y][x] == 0 then
		MRC
		sigma_prime = 1
	end if

iv. CUP
    // not significant, and not in preferred nbhd
	if sigma[y][x] == 0 and eta[y][x] == 0 then
		if pixel meets RLC conditions then
		   RLC
		else
		   ZC
		endif
*/

#define CODEBLOCKY_QUARTER 8

#define BOUNDARY 1
#define BOUNDARY_X2 2

#define CODEBLOCKY_X4 128

//////////////////////////////////////////////////////
// State Buffer

#define STATE_BUFFER_SIZE 1156
#define STATE_BOTTOM_BOUNDARY_OFFSET 1124

#define STATE_BUFFER_STRIDE 34
#define STATE_BUFFER_STRIDE_X2 68
#define STATE_BUFFER_STRIDE_X3 102
#define STATE_BUFFER_STRIDE_X4 136

#define LEFT_TOP -35
#define TOP  -34
#define RIGHT_TOP -33

#define LEFT   -1
#define RIGHT   1

#define LEFT_BOTTOM  33
#define BOTTOM  34
#define RIGHT_BOTTOM  35

////////////////////////////////////////////////////
// State Variables

// bit positions (0 based indices)
#define INPUT_SIGN_BITPOS  15  // assumes 16 bit signed input

#define SIGMA_NEW_BITPOS   0x0
#define SIGMA_OLD_BITPOS   0x1
#define NBH_BITPOS         0x2
#define PIXEL_START_BITPOS 0xA
#define PIXEL_END_BITPOS   0x18
#define SIGN_BITPOS        0x19

// bit flags
#define SIGMA_NEW_F			 0x1		  //position 0
#define SIGMA_OLD_F			 0x10		  //position  1
#define NBH_F				 0x20		  //position  2
#define PIXEL_F				 0x7FFF0000   //positions 10-24
#define SIGN_F				 0x2000000    //position  25

#define NOT_SIGMA_NEW_F      0xFFFFFFFE   // ~SIGMA_NEW
#define SIGMA_OLD_AND_NEW_F  0x11

#define INPUT_TO_SIGN_SHIFT 10
#define SIGMA_OLD_TO_NBH_SHIFT 0x1

#define BIT(pix) (((pix)>>(bp))&1)
#define NBH(pix) ((pix) & NBH_F)
#define SIGMA_OLD(pix) ((pix) & SIGMA_OLD_F)
#define SIGMA_NEW(pix) ((pix) & SIGMA_NEW_F)
#define SIGMA_OLD_AND_NEW(pix) ((pix) & SIGMA_OLD_AND_NEW_F)
#define SIGN(pix) ((pix) & SIGN_F)

#define SET_SIGMA_NEW(pix) ( (pix) |= SIGMA_NEW_F )
#define CLEAR_SIGMA_NEW(pix) ( (pix) &= NOT_SIGMA_NEW_F )

/////////////////////////////////////
// Context Variables

/*
0-2		(CX,D) pairs counter
3		SPP flag
4		MRP flag
5		SPP flag
8		D4
9-13	CX4
14		D3
15-19	CX3
20		D2
21-25	CX2
26		D1
27-31	CX1

*/

/////////////////////////////////////////////////////

// TABLES
/*

// ZERO CODING /////////////////////////////////////

// LL and LH sub-bands
values					Context
sumH	sumV	sumD	CX
2		x		x		8
1 		1		x		7
1		0 		1		6
1		0		0		5
0		2		x		4
0		1		x		3
0		0 		2		2
0		0		1		1
0		0		0		0

//HH sub-band

values					Context
sum(H + V )		sumD	CX
2 				3		8
1				2		7
1				2		6
1				1		5
0				1		4
0				1		3
0				0		2
0				0		1
0				0		0

// HL sub-band

 values Context
sumH	sumV	sumD	CX
x		2		x		8
1		1		x		7
0		1 		1		6
0		1		0		5
2		0		x		4
1		0		x		3
0		0 		2		2
0		0		1		1
0		0		0		0

// SIGN CODING ///////////////////////

H	V	X^	 CX
1	1	0	 13
1	0	0	 12
1	-1	0	 11
0	1	0	 10
0	0	0	 9
0	-1	1	 10
-1	1	1	 11
-1	0	1	 12
-1 -1	1	 13

// Magnitude Refinement //////////////////

sigm_prime [y; x]	(H + V + D)	CX
1					x			16
0 					1			15
0					0			14

*/

CONSTANT sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE  | CLK_FILTER_NEAREST;

void KERNEL run(read_only image2d_t channel) {

	// state buffer
	LOCAL uint state[STATE_BUFFER_SIZE];
	LOCAL uint cxd[STATE_BUFFER_SIZE];

	///////////////////////////////////////////////////////////////////////////////////
	//1. Calculate MSB

	LOCAL int msbScratch[CODEBLOCKX]; // between -1 and 31 - negative one value indicates that this code block is identically zero

	int maxSigBit;
	if (getLocalId(1) == 0) {

		uint maxVal = 0;
		state[getLocalId(0)] = 0;   //top boundary
		LOCAL uint* statePtr = state + (BOUNDARY + getLocalId(0));
		int2 posIn = (int2)(getGlobalId(0),  (getGlobalId(1) >> 3)*CODEBLOCKY);

		for (uint i = 0; i < CODEBLOCKY; ++i) {
			int pixel = read_imagei(channel, sampler, posIn).x;
			uint absPixel = abs(pixel);
			maxVal = max(maxVal, absPixel);
			pixel = (absPixel << PIXEL_START_BITPOS) | SIGN((pixel << INPUT_TO_SIGN_SHIFT));
			statePtr[0] = pixel;

			posIn.y++;
			statePtr += STATE_BUFFER_STRIDE;
		}
		state[ getLocalId(0) + STATE_BOTTOM_BOUNDARY_OFFSET] = 0;		//bottom boundary

		//initialize full left and right boundary columns
		if (getLocalId(0) == 0 || getLocalId(0) == CODEBLOCKX-1) {
			int delta = -1 + ((getLocalId(0)/(CODEBLOCKX-1)) << 1); // -1 or +1
			statePtr = state + BOUNDARY + getLocalId(0) + delta;
			for (uint i = 0; i < CODEBLOCKY+ BOUNDARY_X2; ++i) {
				 *statePtr = 0;
				 statePtr += STATE_BUFFER_STRIDE;
			}
		}

		// calculate column-msb
		maxSigBit = 31 - clz(maxVal);
		msbScratch[getLocalId(0)] =maxSigBit;
	}
	localMemoryFence();

	//calculate global msb
	if (!getLocalId(0) && !getLocalId(1) ) {
		int4 mx = (int4)(maxSigBit);

		LOCAL int* scratchPtr = msbScratch;
		for(uint i=0; i < CODEBLOCKX; i+=4) {
			mx = max(mx,(int4)(msbScratch[i],msbScratch[i+1],msbScratch[i+2],msbScratch[i+3]));
		}
		maxSigBit = mx.x;
		maxSigBit = max(maxSigBit, mx.y);
		maxSigBit = max(maxSigBit, mx.z);
		maxSigBit = max(maxSigBit, mx.w);
		msbScratch[0] = maxSigBit;
	}
	localMemoryFence();

	if (msbScratch[0] == -1)
		return;

	int startIndex = (BOUNDARY + getLocalId(0)) + (BOUNDARY + getLocalId(1))*STATE_BUFFER_STRIDE_X4;

	////////////////////////////////////////////////////////////////////////////////////////////////
	// 2. CUP on MSB

	uint bp = msbScratch[0] + PIXEL_START_BITPOS;

	// i) set sigma_new for stripe column (sigma_old is zero)
	LOCAL uint* statePtr = state + startIndex;
	for (uint i = 0; i < 4; ++i) {
		uint current = statePtr[0];
		current |= BIT(current);	// set sigma_new
		*statePtr = current;
		statePtr += STATE_BUFFER_STRIDE;

	}
	localMemoryFence();

	// ii) set nbh for stripe column, and do CUP

	// Note: since this is the very first pass on this code block, the only possible significant pixels
	// following the scan pattern are the those in top, left top, left and left bottom positions.

	// RLC (which runs through all consecutive non-significant pixels in column)
	// ZC/SC on rest of pixels in column

	statePtr				= state + startIndex;
	uint current			= statePtr[0];
	uint top				= statePtr[TOP];
	uint leftTop			= statePtr[LEFT_TOP];
	uint left				= statePtr[LEFT];
	uint leftBottom			= statePtr[LEFT_BOTTOM];

	// first pixel in stripe column
	uint nbh =  SIGMA_NEW(top) | SIGMA_NEW(leftTop) | SIGMA_NEW(left) | SIGMA_NEW(leftBottom);
	bool doRLC = !nbh && !SIGMA_NEW(current);
	if (!doRLC) {
		if (nbh) {
			//ZC
		}
		if (SIGMA_NEW(current) ){
			//SC
		}
	}

	for (int i = 0; i < 2; ++i) {
		statePtr += STATE_BUFFER_STRIDE;
		top			= current;
		current		= statePtr[0];
		leftTop		= left;
		left		= leftBottom;
		leftBottom	= statePtr[LEFT_BOTTOM];

		nbh =  SIGMA_NEW(top) | SIGMA_NEW(leftTop) | SIGMA_NEW(left) | SIGMA_NEW(leftBottom);
		bool wasDoingRLC = doRLC;
		doRLC = doRLC && !nbh && !SIGMA_NEW(current);
		if (!doRLC) {
		    if (wasDoingRLC) {
				//RLC
			}
			if (nbh) {
				//ZC
			}
			if (SIGMA_NEW(current)) {
				//SC
			}
		}
	}

	// last pixel in stripe column -
	// ignore leftBottom pixel, because it is in the next
	// stripe and it hasn't been processed yet
	statePtr += STATE_BUFFER_STRIDE;
	top			= current;
	current		= statePtr[0];
	leftTop		= left;
	left		= leftBottom;

	nbh =  SIGMA_NEW(top) | SIGMA_NEW(leftTop) | SIGMA_NEW(left);
	bool wasDoingRLC = doRLC;
	doRLC = doRLC && !nbh && !SIGMA_NEW(current);
	if (!doRLC) {
	   if (wasDoingRLC) {
		  //RLC
	   }

		if (nbh) {
			//ZC
		}
		if (SIGMA_NEW(current)) {
			//SC
		}
	}
	localMemoryFence();

	/////////////////////////////////////////////////////////////////////////////////////////////////
	// 3. Processs rest of bit planes
	bp--;
	LOCAL char blockVote;

	while (bp >= PIXEL_START_BITPOS) {
		blockVote = 0;

		/////////////////////////////
		// 4. pre-process bit plane

		// i) migrate sigma_new to sigma_old, and clear sigma new bit
		statePtr = state + startIndex;
		for (uint i = 0; i < 4; ++i) {
		    uint current = *statePtr;
			current |=  SIGMA_NEW(current) << SIGMA_OLD_BITPOS;
			CLEAR_SIGMA_NEW(current);

			*statePtr = current;
			statePtr += STATE_BUFFER_STRIDE;

		}
		localMemoryFence();

		// ii) update nbh
		statePtr = state + startIndex;

		uint top			= statePtr[TOP];
		uint leftTop		= statePtr[LEFT_TOP];
		uint rightTop	= statePtr[RIGHT_TOP];
		uint left		= statePtr[LEFT];
		uint current		= statePtr[0];
		uint right		= statePtr[RIGHT];
		uint leftBottom  = statePtr[LEFT_BOTTOM];
		uint bottom		= statePtr[BOTTOM];
		uint rightBottom = statePtr[RIGHT_BOTTOM];

		current |=  (   SIGMA_OLD(leftTop) |
						SIGMA_OLD( top) |
						SIGMA_OLD( rightTop) |
						SIGMA_OLD( left) |
						SIGMA_OLD( right) |
						SIGMA_OLD( leftBottom) |
						SIGMA_OLD( bottom) |
						SIGMA_OLD( rightBottom)  ) << SIGMA_OLD_TO_NBH_SHIFT;

		if ( BIT(current) && NBH(current) && !SIGMA_OLD(current) ) {
			SET_SIGMA_NEW(current);
			blockVote = 1;

		}
		*statePtr = current;

		for (uint i = 0; i < 3; ++i) {
			statePtr += STATE_BUFFER_STRIDE;

			top			 = current;
			leftTop		 = left;
			rightTop	 = right;
			left		 = leftBottom;
			current		 = statePtr[0];
			right		 = rightBottom;
			leftBottom   = statePtr[LEFT_BOTTOM];
			bottom		 = statePtr[BOTTOM];
			rightBottom  = statePtr[RIGHT_BOTTOM];

			current |=	   ( SIGMA_OLD(leftTop) |
							 SIGMA_OLD( top) |
							 SIGMA_OLD( rightTop) |
							 SIGMA_OLD( left) |
							 SIGMA_OLD( right) |
							 SIGMA_OLD( leftBottom) |
							 SIGMA_OLD( bottom) |
							 SIGMA_OLD( rightBottom)  ) << SIGMA_OLD_TO_NBH_SHIFT;

			if ( BIT(current) && NBH(current) && !SIGMA_OLD(current) ) {
			    SET_SIGMA_NEW(current);
				blockVote = 1;
			}
			*statePtr = current;

		}
		localMemoryFence();

		// iii) block vote on sigma new
		while (blockVote)
		{
		    blockVote = 0;
			localMemoryFence();

			statePtr = state + startIndex;

			//first pixel in stripe column
			uint top			= statePtr[TOP];
			uint leftTop		= statePtr[LEFT_TOP];
			uint left			= statePtr[LEFT];
			uint current		= statePtr[0];
			uint leftBottom		= statePtr[LEFT_BOTTOM];

			current  |= (   SIGMA_NEW(leftTop) |
							SIGMA_NEW( top) |
							SIGMA_NEW( left) |
							SIGMA_NEW( leftBottom) ) << NBH_BITPOS;

			if (  BIT(current) && !SIGMA_OLD(current) &&  NBH(current)  &&  !SIGMA_NEW(current)) {
				SET_SIGMA_NEW(current);
				blockVote = 1;

			}
			statePtr[0] = current;

			// next two pixels in stripe column
			for (uint i = 0; i < 2; ++i) {
				statePtr += STATE_BUFFER_STRIDE;

				top			= current;
				current		= statePtr[0];
				leftTop		= left;
				left		= leftBottom;
				leftBottom  = statePtr[LEFT_BOTTOM];

				current  |= (   SIGMA_NEW(leftTop) |
								SIGMA_NEW( top) |
								SIGMA_NEW( left) |
								SIGMA_NEW( leftBottom) ) << NBH_BITPOS;

				if (  BIT(current) && !SIGMA_OLD(current) && NBH(current)  && !SIGMA_NEW(current)) {
					SET_SIGMA_NEW(current);
					blockVote = 1;

				}
				statePtr[0] = current;
			}

			// last pixel in stripe column -
			// ignore leftBottom pixel, because it is in the next
			// stripe and it hasn't been processed yet
			statePtr += STATE_BUFFER_STRIDE;

			top			= current;
			current		= statePtr[0];
			leftTop		= left;
			left		= leftBottom;

			current |= ( SIGMA_NEW(leftTop) |
						 SIGMA_NEW( top) |
						 SIGMA_NEW( left) ) << NBH_BITPOS;
			if (  BIT(current) && !SIGMA_OLD(current) && NBH(current)  && !SIGMA_NEW(current)) {
				SET_SIGMA_NEW(current);
				blockVote = 1;
			}
			statePtr[0] = current;

			localMemoryFence();

		}

		/////////////////////////
		// 5. bit plane processing
		statePtr = state + startIndex;

		// first pixel in stripe column
		top				= statePtr[TOP];
		leftTop			= statePtr[LEFT_TOP];
		rightTop		= statePtr[RIGHT_TOP];
		left			= statePtr[LEFT];
		current			= statePtr[0];
		right			= statePtr[RIGHT];
		leftBottom		= statePtr[LEFT_BOTTOM];
		bottom			= statePtr[BOTTOM];
		rightBottom		= statePtr[RIGHT_BOTTOM];

		bool doRLC = false;
		if (SIGMA_OLD(current)) {
			// MRC
		} else {
			int nbh = ( SIGMA_OLD_AND_NEW(leftTop) |
						SIGMA_OLD_AND_NEW( top) |
						SIGMA_OLD_AND_NEW( rightTop) |
						SIGMA_OLD_AND_NEW( left) |
						SIGMA_OLD_AND_NEW( right) |
						SIGMA_OLD_AND_NEW( leftBottom) |
						SIGMA_OLD_AND_NEW( bottom) |
						SIGMA_OLD_AND_NEW( rightBottom)  ) ;

			doRLC = !nbh && !SIGMA_NEW(current);
			if (!doRLC) {
				 if (nbh) {
					//ZC
				 }

                // could be from SPP or CUP
				if (BIT(current)) {
					//SC
				}
			}
		}

		// next two pixels in stripe column
		for (uint i = 0; i < 2; ++i) {
			statePtr += STATE_BUFFER_STRIDE;

			top			= current;
			leftTop		= left;
			rightTop	= right;
			left		= leftBottom;
			current		= statePtr[0];
			right		= rightBottom;
			leftBottom  = statePtr[LEFT_BOTTOM];
			bottom		= statePtr[BOTTOM];
			rightBottom = statePtr[RIGHT_BOTTOM];

			if (SIGMA_OLD(current)) {
			    if (doRLC) {
					//RLC
					doRLC = false;
				}
				// MRC
			} else {
				int nbh = ( SIGMA_OLD_AND_NEW(leftTop) |
							SIGMA_OLD_AND_NEW( top) |
							SIGMA_OLD_AND_NEW( rightTop) |
							SIGMA_OLD_AND_NEW( left) |
							SIGMA_OLD_AND_NEW( right) |
							SIGMA_OLD_AND_NEW( leftBottom) |
							SIGMA_OLD_AND_NEW( bottom) |
							SIGMA_OLD_AND_NEW( rightBottom)  ) ;

				bool wasDoingRLC = doRLC;
				doRLC = doRLC && !nbh && !SIGMA_NEW(current);
				if (!doRLC) {
					if (wasDoingRLC) {
						//RLC
					}
					if (nbh) {
						//ZC
					}

					// could be from SPP or CUP
					if (BIT(current) ) {
						//SC
					}

				}
			}
		}

		// last pixel in stripe column
		statePtr += STATE_BUFFER_STRIDE;

		top			= current;
		leftTop		= left;
		rightTop	= right;
		left		= leftBottom;
		current		= statePtr[0];
		right		= rightBottom;

		if (SIGMA_OLD(current)) {
			if (doRLC) {
				//RLC
			}
			// MRC
		} else {
			int nbh = ( SIGMA_OLD_AND_NEW(leftTop) |
						SIGMA_OLD_AND_NEW( top) |
						SIGMA_OLD_AND_NEW( rightTop) |
						SIGMA_OLD_AND_NEW( left) |
						SIGMA_OLD_AND_NEW( right)  ) ;

			bool wasDoingRLC = doRLC;
			doRLC = doRLC && !nbh && !SIGMA_NEW(current);
			if (!doRLC) {
				if (wasDoingRLC) {
					//RLC
				}
				if (nbh) {
					//ZC
				}

				// could be from SPP or CUP
				if (BIT(current) ) {
					//SC
				}
			}
		}
		localMemoryFence();
		bp--;
	}
}


Implement sign() for half

Implement sign() for half

/* OpenCL built-in library: sign()

   Copyright (c) 2011 Erik Schnetter <eschnetter@perimeterinstitute.ca>
                      Perimeter Institute for Theoretical Physics

   Permission is hereby granted, free of charge, to any person obtaining a copy
   of this software and associated documentation files (the "Software"), to deal
   in the Software without restriction, including without limitation the rights
   to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
   copies of the Software, and to permit persons to whom the Software is
   furnished to do so, subject to the following conditions:

   The above copyright notice and this permission notice shall be included in
   all copies or substantial portions of the Software.

   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
   AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
   LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
   OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
   THE SOFTWARE.
*/

#include "templates.h"

DEFINE_EXPR_V_V(sign,
                ({
                  isnan(a) ? (stype)0 :
                    copysign(a == (stype)0 ? (stype)0 : (stype)1, a);
                }))

/* OpenCL built-in library: sign()

   Copyright (c) 2011 Erik Schnetter <eschnetter@perimeterinstitute.ca>
                      Perimeter Institute for Theoretical Physics

   Permission is hereby granted, free of charge, to any person obtaining a copy
   of this software and associated documentation files (the "Software"), to deal
   in the Software without restriction, including without limitation the rights
   to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
   copies of the Software, and to permit persons to whom the Software is
   furnished to do so, subject to the following conditions:

   The above copyright notice and this permission notice shall be included in
   all copies or substantial portions of the Software.

   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
   AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
   LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
   OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
   THE SOFTWARE.
*/

#include "templates.h"

#define __builtin_signf(a)                                              \
  (__builtin_isnan(a) ? 0.0f : copysign(a == 0.0f ? 0.0f : 1.0f, a))
#define __builtin_sign(a)                                               \
  (__builtin_isnan(a) ? 0.0  : copysign(a == 0.0  ? 0.0  : 1.0 , a))

DEFINE_BUILTIN_V_V(sign)


plexfix: fix bug in new name generation

plexfix: fix bug in new name generation

;; plexfix :: fix filenames for Plex Media Server
;;
;; TODO:
;;  - handle rar files

(eval-when (compile eval load)
  ;;(require :anydate)
  (require :list2)
  (require :acldns)
  (require :smtp)
  (require :osi)
  (require :shell)
  (require :autozoom)
  (require :tget-utils "utils.fasl"))

(defpackage :cl-user
  (:use #:common-lisp
	#:excl
	#:excl.osi
	#:excl.shell
	#:net.post-office))

(in-package :cl-user)

(defvar *debug* nil)
(defvar *no-execute* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun plexfix (stream filename)
  (if* (not (probe-file filename))
     then (.error "~a does not exist." filename)
   elseif (file-directory-p filename)
     then (let ((files (directory (pathname-as-directory filename))))
	    (if* (member "rar" files :key #'pathname-type :test #'string=)
	       then (.error "Can't handle rar files yet: ~a." filename)
	       else (dolist (file files)
		      ;; handle mp4 and mkv files, for now, warn of the
		      ;; rest, ignoring some known files
		      (if* (member (pathname-type file) '("mp4" "mkv")
				   :test #'string=)
			 then (plexfix-1 stream file)
		       elseif (member (pathname-type file)
				      '("nfo" "txt" "srt")
				      :test #'string=)
			 thenret
			 else (format stream "Unknown file:~a.~%" file)))))
     else (plexfix-1 stream filename)))

(defun plexfix-1 (stream filename &aux new-name type)
  (multiple-value-bind (series-name season episode pms-fail year month day)
      (parse-name-season-and-episode (file-namestring filename)
				     :episode-required t
				     :junk-allowed t)
    (when (not pms-fail) (return-from plexfix-1 nil))

    ;; PMS will not see this file, so make a symlink for it that it will
    ;; see.
    (setq type (pathname-type filename))
    (setq new-name
      (if* year
	 then ;; date-based name
	      (format nil "~a.~d.~2,'0d.~2,'0d.~a"
		      series-name year month day type)
	 else (format nil "~a.S~2,'0dE~2,'0d.~a"
		      series-name season episode type)))
    (setq new-name (merge-pathnames new-name filename))
    (with-verbosity 1
      (format stream "OLD name: ~a~%" filename)
      (format stream "NEW name: ~a~%" new-name))

    (if* *no-execute*
       then (format stream "Would symlink ~a ~a~%" filename new-name)
       else (symlink filename new-name))

    ;; Look for .srt file with the same name, and make a symlink for that,
    ;; too.  The Roku can't use subtitles unless the file has the same
    ;; name!
    (let ((srt (merge-pathnames (make-pathname :type "srt")
				filename))
	  new-srt)
      (when (probe-file srt)
	(with-verbosity 1
	  (format stream "Making link for srt file, too.~%"))
	(setq new-srt (merge-pathnames (make-pathname :type "srt") new-name))
	(if* *no-execute*
	   then (format stream "Would symlink ~a ~a~%" srt new-srt)
	   else (symlink srt new-srt))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-condition plexfix (error) ())

(defun .error (format-string &rest format-arguments)
  ;; This separates known tget errors from unexpected program errors.  All
  ;; calls to error in this code should be to this function.  Any calls to
  ;; error or cerror cause a stack trace.
  (error 'plexfix :format-control format-string
	 :format-arguments format-arguments))

(defun user::main (&aux (stream t))
  (flet
      ((send-output ()
	 (let ((body (get-output-stream-string stream)))
	   (when (string/= "" body)
	     (ignore-errors
	      (when (not (eq 't stream))
		(send-letter "192.168.0.1"
			     (sys:getenv "USER")
			     (sys:getenv "USER")
			     body
			     :subject "plexfix"))))))
       (doit (&aux torrent-dir torrent-name)
	 (system:with-command-line-arguments
	     (("d" :short debug)
	      ("m" :short no-email)
	      ("n" :short no-execute)
	      ("q" :short quiet)
	      ("v" :short verbose :allow-multiple-options))
	     (rest)
	   (if* (and (null rest)
		     (setq torrent-dir (sys:getenv "TR_TORRENT_DIR"))
		     (setq torrent-name (sys:getenv "TR_TORRENT_NAME")))
	      then ;; called from Transmission
		   (setq rest
		     (list
		      (namestring
		       (merge-pathnames torrent-name
					(pathname-as-directory torrent-dir)))))
	    elseif (or (null rest) (/= 1 (length rest)))
	      then (.error "usage: plexfix file."))
	   (when debug (setq *debug* t))
	   (when no-execute (setq *no-execute* t))
	   (setq *verbose* (or verbose
			       (when quiet 0)
			       1))
	   (when (and (not debug) (not no-email))
	     (setq stream (make-string-output-stream)))
	   (plexfix stream (car rest)))))

    (if* *debug* ;; -d on command line doesn't effect this test!
       then (format t ";;;NOTE: debugging mode is on~%")
	    (doit)
       else (top-level.debug:with-auto-zoom-and-exit (*standard-output*)
	      (handler-case (doit)
		(plexfix (c)
		  ;; 'plexfix errors don't get a backtrace, since those are
		  ;; expected or, at least, planned for.  The unexpected
		  ;; ones get the zoom.
		  (format stream "~&~a~&" c)
		  (send-output)
		  (exit 1 :quiet t)))))
    (send-output)
    (exit 0 :quiet t)))

;; plexfix :: fix filenames for Plex Media Server
;;
;; TODO:
;;  - handle rar files

(eval-when (compile eval load)
  ;;(require :anydate)
  (require :list2)
  (require :acldns)
  (require :smtp)
  (require :osi)
  (require :shell)
  (require :autozoom)
  (require :tget-utils "utils.fasl"))

(defpackage :cl-user
  (:use #:common-lisp
	#:excl
	#:excl.osi
	#:excl.shell
	#:net.post-office))

(in-package :cl-user)

(defvar *debug* nil)
(defvar *no-execute* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun plexfix (stream filename)
  (if* (not (probe-file filename))
     then (.error "~a does not exist." filename)
   elseif (file-directory-p filename)
     then (let ((files (directory (pathname-as-directory filename))))
	    (if* (member "rar" files :key #'pathname-type :test #'string=)
	       then (.error "Can't handle rar files yet: ~a." filename)
	       else (dolist (file files)
		      ;; handle mp4 and mkv files, for now, warn of the
		      ;; rest, ignoring some known files
		      (if* (member (pathname-type file) '("mp4" "mkv")
				   :test #'string=)
			 then (plexfix-1 stream file)
		       elseif (member (pathname-type file)
				      '("nfo" "txt" "srt")
				      :test #'string=)
			 thenret
			 else (format stream "Unknown file:~a.~%" file)))))
     else (plexfix-1 stream filename)))

(defun plexfix-1 (stream filename &aux new-name type)
  (multiple-value-bind (series-name season episode pms-fail year month day)
      (parse-name-season-and-episode (file-namestring filename)
				     :episode-required t
				     :junk-allowed t)
    (when (not pms-fail) (return-from plexfix-1 nil))

    ;; PMS will not see this file, so make a symlink for it that it will
    ;; see.
    (setq type (pathname-type filename))
    (setq new-name
      (if* year
	 then ;; date-based name
	      (format nil "~a.~d.~2,'0d.~2,'0d.~a"
		      series-name year month day type)
	 else (format nil "~a.S~2,'0dE~2,'0d.~a"
		      series-name season episode type)))
    (with-verbosity 1
      (format stream "OLD name: ~a~%" filename)
      (format stream "NEW name: ~a~%" new-name))

    (if* *no-execute*
       then (format stream "Would symlink ~a ~a~%" filename new-name)
       else (symlink filename new-name))

    ;; Look for .srt file with the same name, and make a symlink for that,
    ;; too.  The Roku can't use subtitles unless the file has the same
    ;; name!
    (let ((srt (merge-pathnames (make-pathname :type "srt")
				filename))
	  new-srt)
      (when (probe-file srt)
	(with-verbosity 1
	  (format stream "Making link for srt file, too.~%"))
	(setq new-srt (merge-pathnames (make-pathname :type "srt") new-name))
	(if* *no-execute*
	   then (format stream "Would symlink ~a ~a~%" srt new-srt)
	   else (symlink srt new-srt))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-condition plexfix (error) ())

(defun .error (format-string &rest format-arguments)
  ;; This separates known tget errors from unexpected program errors.  All
  ;; calls to error in this code should be to this function.  Any calls to
  ;; error or cerror cause a stack trace.
  (error 'plexfix :format-control format-string
	 :format-arguments format-arguments))

(defun user::main (&aux (stream t))
  (flet
      ((send-output ()
	 (let ((body (get-output-stream-string stream)))
	   (when (string/= "" body)
	     (ignore-errors
	      (when (not (eq 't stream))
		(send-letter "192.168.0.1"
			     (sys:getenv "USER")
			     (sys:getenv "USER")
			     body
			     :subject "plexfix"))))))
       (doit (&aux torrent-dir torrent-name)
	 (system:with-command-line-arguments
	     (("d" :short debug)
	      ("m" :short no-email)
	      ("n" :short no-execute)
	      ("q" :short quiet)
	      ("v" :short verbose :allow-multiple-options))
	     (rest)
	   (if* (and (null rest)
		     (setq torrent-dir (sys:getenv "TR_TORRENT_DIR"))
		     (setq torrent-name (sys:getenv "TR_TORRENT_NAME")))
	      then ;; called from Transmission
		   (setq rest
		     (list
		      (namestring
		       (merge-pathnames torrent-name
					(pathname-as-directory torrent-dir)))))
	    elseif (or (null rest) (/= 1 (length rest)))
	      then (.error "usage: plexfix file."))
	   (when debug (setq *debug* t))
	   (when no-execute (setq *no-execute* t))
	   (setq *verbose* (or verbose
			       (when quiet 0)
			       1))
	   (when (and (not debug) (not no-email))
	     (setq stream (make-string-output-stream)))
	   (plexfix stream (car rest)))))

    (if* *debug* ;; -d on command line doesn't effect this test!
       then (format t ";;;NOTE: debugging mode is on~%")
	    (doit)
       else (top-level.debug:with-auto-zoom-and-exit (*standard-output*)
	      (handler-case (doit)
		(plexfix (c)
		  ;; 'plexfix errors don't get a backtrace, since those are
		  ;; expected or, at least, planned for.  The unexpected
		  ;; ones get the zoom.
		  (format stream "~&~a~&" c)
		  (send-output)
		  (exit 1 :quiet t)))))
    (send-output)
    (exit 0 :quiet t)))


Re-enable auto-execution in lpp.cl

Re-enable auto-execution in lpp.cl

(defstruct param type name deref funcset)
(defstruct funcdef funcset funcname params returntype)

(setq preprocessor-file-extension "lpp")
(setq begin-marker-left "^^^BEGINREPLACE:")
(setq begin-marker-right "^^^")
(setq end-marker "^^^ENDREPLACE^^^")
(setq auto-header-marker "^^^AUTOGENHEADER^^^")
(setq token-marker #\^)
(setq token-arg-marker #\:)
(setq token-arg-delimiter #\,)

(defstruct lppmacro macro filter)

(setq macro-hash (make-hash-table :test 'equal))
(defun add-macro (&rest args)
    (let ((m (apply #'make-lppmacro args)))
        (setf (gethash (lppmacro-macro m) macro-hash) m)
    )
)
(defun get-macro (key) (gethash key macro-hash))

(setq void-param-hash (make-hash-table :test 'equal))
(defun add-void-param (&rest args)
    (let* ((p (apply #'make-param args))
           (funcset-name (param-funcset p))
          )
        (cond ((not (null funcset-name))
               (setf (gethash funcset-name void-param-hash) p)
              )
              (t (error "Must provide :funcset for add-void-param"))
        )
    )
)
(defun get-void-param (funcset-name) (gethash funcset-name void-param-hash))

(add-macro :macro "RETURN"	:filter (lambda (fd len args vp) (funcdef-returntype fd)))
(add-macro :macro "FUNC"	:filter (lambda (fd len args vp) (funcdef-funcname fd)))
(add-macro :macro "PARAMS"	:filter (lambda (fd len args vp) (format-params (funcdef-params fd) len args vp)))
; PARAMS arguments: types, names, deref, ref, void, voidonly, nowrap
;;;;;;;;;

(defun partial (func &rest args1)
   (lambda (&rest args2) (apply func (append args1 args2)))
)

(defun newline ()
	(write-string (format nil "~%"))
)

(defun concat-string-list (s)
	(format nil "~{~A~^~%~}" s)
)

(defun replace-all (string part replacement &key (test #'char=))
"Returns a new string in which all the occurences of the part
is replaced with replacement."
    (with-output-to-string (out)
      (loop with part-length = (length part)
            for old-pos = 0 then (+ pos part-length)
            for pos = (search part string
                              :start2 old-pos
                              :test test)
            do (write-string string out
                             :start old-pos
                             :end (or pos (length string)))
            when pos do (write-string replacement out)
            while pos))
)

(defun is-arg-set (target-arg args)
    (not (null (find target-arg args :test 'equal)))
)

(defun format-paramitem-type (args p)
	(format nil "~A" (param-type p))
)

(defun format-paramitem-name (args p)
    ;in name only format, we can dereference the argument (pointer)
    ;but only if the macro argument requested it
    ;and this parameter can be dereferenced
	(if (and (is-arg-set "deref" args) (param-deref p))
		;then
		(format nil "*~A" (param-name p))
		;else
		(format nil "~A" (param-name p))
	)
)

(defun format-paramitem-full (args p)
	(let* ((type-decl (param-type p))
           (last-index (1- (length type-decl)))
          )
        (format nil "~A ~A"
                ;if macro requested reference mode,
                ; this parameter is dereferencable,
                ; and the last char is a *
                (if (and (is-arg-set "ref" args) (param-deref p) (equal "*" (subseq type-decl last-index)))
                    ;then, replace the last * with a &
                    (concatenate 'string (subseq type-decl 0 last-index) "&")
                    ;else
                    type-decl
                )
                (param-name p))
	)
)

(defun error-if-null (var errmsg) (when (null var) (error errmsg)))

(defun format-params (params token-start-length args void-param)
    ;full, types, names, deref, ref, void, voidonly, nowrap
    (let*  ((arg-types      (is-arg-set "types" args))
            (arg-names      (is-arg-set "names" args))
            (arg-deref      (is-arg-set "deref" args))
            (arg-ref        (is-arg-set "ref" args))
            (arg-void       (is-arg-set "void" args))
            (arg-voidonly   (is-arg-set "voidonly" args))
            (arg-wrap       (is-arg-set "wrap" args))
            (arg-nowrap     (is-arg-set "nowrap" args))
            (filtered-params (cond  (arg-voidonly
                                        (error-if-null void-param "Void param must be set to use void argument")
                                        (cons void-param nil)) ;only the void-param
                                    (arg-void
                                        (error-if-null void-param "Void param must be set to use void argument")
                                        (cons void-param params)) ;prepend the void-param
                                    (t params) ;default, just use params
                              )
                          )
            (types-only (and arg-types (not arg-names)))
            (names-only (and arg-names (not arg-types)))
            (full-decl  (not (xor arg-names arg-types)))
            (format-param-func (cond  (full-decl  #'format-paramitem-full)
                                (types-only #'format-paramitem-type)
                                (names-only #'format-paramitem-name)
                          ))
            (do-wrap    (or arg-wrap (not (or names-only arg-nowrap))))
            (format-line (if do-wrap "~{~A~^,~%~}" "~{~A~^, ~}"))
           )
       (when filtered-params
            (format nil format-line
                (cons
                    ;first parameter => no indentation
                    (apply format-param-func (list args (car filtered-params)))
                    (mapcar
                        (lambda (p)
                            (concatenate 'string
                                ;second parameter, indent according to wrap policy
                                (when do-wrap (make-string token-start-length :initial-element #\ ))
                                (apply format-param-func (list args p))
                            )
                        )
                        (cdr filtered-params)
                    )
                )
            )
        )
    )
)

(defun split-by-delimiter (string delimiter)
	(loop 	for start = 0 then (1+ finish)
			for finish = (position delimiter string :start start)
			if (and (not (eq (length string) start)) (not (eq start finish))) collect (subseq string start finish)
			until (null finish)
	)
)

(defun process-tokens (line funcdata void-param &optional (line-length 0))
    (let ((token-marker-left (position token-marker line))
         )
        (if (null token-marker-left)
            ;then, no left token marker. return line
            line
            ;else, process more
            (let* ((token-start (1+ token-marker-left))
                  (token-stop (position token-marker line :start token-start))
                 )
                (if (null token-stop)
                    ;then, no right token marker. return line
                    line
                    ;else, process more

        (let* ((token-full (subseq line token-start token-stop))
               (seperator-index (position token-arg-marker token-full))
               (token (subseq token-full 0 seperator-index))
               (token-args (if (not (null seperator-index))
                              (split-by-delimiter (subseq token-full (1+ seperator-index) nil) token-arg-delimiter)
                              '(nil)
                          ))
               (line-begin (subseq line 0 token-marker-left))
               (line-end (subseq line (1+ token-stop) nil))
               (m (get-macro token))
              )
              ;m (the macro struct) is nil if no macro found for the token
              (if (null m)
                    ;then
                    line
                    ;else
                    (let* ((token-start-length (+ line-length token-marker-left))
                           (expanded-token (funcall (lppmacro-filter m) funcdata token-start-length token-args void-param))
                          )
                        (concatenate 'string
                            line-begin
                            expanded-token
                            (process-tokens line-end funcdata void-param (+ token-start-length (length expanded-token)))
                        )
                    )
               )
        )
    ))))
)

(defun expand-template (template-list func-data void-param)
    (concat-string-list
        (mapcar
            (lambda (template-line) (process-tokens template-line func-data void-param))
            template-list
        )
    )
)

(defun expand-methods-with-template (template-list funcset-name)
    (remove nil ;filter out the nil values (from wrong funcsets)
        (mapcar
            (lambda (func-data)
                    (cond ;only expand this function if it belongs to the target funcset
                          ((equal funcset-name (funcdef-funcset func-data))
                           (expand-template template-list func-data (get-void-param funcset-name))
                          )
                          ;otherwise return nil
                          (t nil)
                    )
            )
            funcs
        )
    )
)

(defun clear-funcs ()
	(setq funcs nil)
	(setq funcs-tail funcs)
)
(clear-funcs)

(defun add-func (&rest args)
	(let ((func-data (apply #'make-funcdef args)))
		(if (endp funcs)
			;then
			(progn
				(setq funcs (cons func-data nil))
				(setq funcs-tail funcs)
			)
			;else
			(progn
				(setf (cdr funcs-tail) (cons func-data nil))
				(setq funcs-tail (cdr funcs-tail))
			)
		)
	)
)

(defun outputfuncs (f)
	(write-line (concat-string-list f))
)

(defun filter-line (line filename)
	(replace-all line auto-header-marker (format nil "THIS FILE AUTO-GENERATED FROM ~A. DO NOT EDIT." filename))
)

(defmacro prepend-into (var value)
	`(setq ,var (cons ,value ,var))
)

(defun strip-end-characters (str numChars)
	(let ((index (- (length str) numChars)))
		(if (>= index 1)
			(subseq str 0 index)
			nil
		)
	)
)

(defun get-funcset-from-begin-marker (line)
    (let ((start-index (search begin-marker-left line)))
        (cond ;no begin marker, return nil
              ((null start-index) nil)

              ;begin marker must be at start of line
              ((not (= start-index 0)) nil)

              ;left side is good
              (t (let*  ((start-param-index (+ start-index (length begin-marker-left)))
                         (end-index (search begin-marker-right line :start2 start-param-index)))
                        (cond ;no right side marker, return nil
                              ((null end-index) nil)

                              ;right marker must be at end of line
                              ((not (= (length line) (+ end-index (length begin-marker-right)))) nil)

                              ;markers but no funcset parameter, can't process
                              ((= start-param-index end-index) nil)
                              ;we have a begin-marker and funcset parameter!
                              (t (values (subseq line start-param-index end-index) start-param-index end-index))
                        )
                 )
               )
        )
    )
)

(defun is-end-marker (line)
    (equal line end-marker)
)

(defun in-to-out-filename (fn)
    (strip-end-characters fn 4)
)

(defun process-file (infilename)
	(let ((infile (open infilename :if-does-not-exist nil))
		  (outfile (open (in-to-out-filename infilename) :direction :output :if-exists :supersede))
		  (filelines nil)
		  (templatelines nil)
		  (funcset-name nil)
		  )
	  (when infile
		(loop
			for line = (read-line infile nil)
			while line
			do
				(cond   ;outside of a replace block
                        ((null funcset-name)
                         ;look for a begin-replace marker (funcset name becomes not nil)
                         (setq funcset-name (get-funcset-from-begin-marker line))
                         ;if still no funcset-name
                         (when (null funcset-name)
                                ;accumulate filtered lines to filelines
                               (prepend-into filelines (filter-line line (file-namestring infilename)))
                         )
                        )

                        ;all below: funcset-name is not nil -- inside of a replace block
                        ;check for end marker
                        ((is-end-marker line)
						 ;since we have a full template, expand template it
						 (mapcar
						 	(lambda (v) (prepend-into filelines v))
						 	(expand-methods-with-template (reverse templatelines) funcset-name)
						 )
                         (setq funcset-name nil) ;clear funcset-name -- return to normal operation above
						)
						;inside replace block, accumulate template
						(t (prepend-into templatelines line))
				)
		)
		(loop for line in (reverse filelines)
			  do (write-line line outfile)
		)
		(close infile)
		(close outfile))
	)
)

(load "apidef.cl" :verbose nil)
(load "cl-fad/load.lisp" :verbose nil)

(defun mapc-directory-tree (fn directory)
    (dolist (entry (cl-fad:list-directory directory))
        (when (cl-fad:directory-pathname-p entry)
            (mapc-directory-tree fn entry))
        (funcall fn entry)
    )
)

(defun _ () (load "lpp.cl" :verbose nil))

(defun process (dir)
    (let ((target-directory (if (null dir)
                                (ext:cd)
                                dir
                                )))
    (write-line (format nil "Base directory: ~A~%" target-directory))
    (mapc-directory-tree (lambda (x)
                            (when (equal (pathname-type x) preprocessor-file-extension)
                                  (write-line (format nil "~A => ~A"
                                                    (enough-namestring x target-directory)
                                                    (in-to-out-filename (file-namestring x))))
                                  (process-file (namestring x))
                             )
                         )
                          target-directory
    )
    )
)
(process (car *args*))

(defstruct param type name deref funcset)
(defstruct funcdef funcset funcname params returntype)

(setq preprocessor-file-extension "lpp")
(setq begin-marker-left "^^^BEGINREPLACE:")
(setq begin-marker-right "^^^")
(setq end-marker "^^^ENDREPLACE^^^")
(setq auto-header-marker "^^^AUTOGENHEADER^^^")
(setq token-marker #\^)
(setq token-arg-marker #\:)
(setq token-arg-delimiter #\,)

(defstruct lppmacro macro filter)

(setq macro-hash (make-hash-table :test 'equal))
(defun add-macro (&rest args)
    (let ((m (apply #'make-lppmacro args)))
        (setf (gethash (lppmacro-macro m) macro-hash) m)
    )
)
(defun get-macro (key) (gethash key macro-hash))

(setq void-param-hash (make-hash-table :test 'equal))
(defun add-void-param (&rest args)
    (let* ((p (apply #'make-param args))
           (funcset-name (param-funcset p))
          )
        (cond ((not (null funcset-name))
               (setf (gethash funcset-name void-param-hash) p)
              )
              (t (error "Must provide :funcset for add-void-param"))
        )
    )
)
(defun get-void-param (funcset-name) (gethash funcset-name void-param-hash))

(add-macro :macro "RETURN"	:filter (lambda (fd len args vp) (funcdef-returntype fd)))
(add-macro :macro "FUNC"	:filter (lambda (fd len args vp) (funcdef-funcname fd)))
(add-macro :macro "PARAMS"	:filter (lambda (fd len args vp) (format-params (funcdef-params fd) len args vp)))
; PARAMS arguments: types, names, deref, ref, void, voidonly, nowrap
;;;;;;;;;

(defun partial (func &rest args1)
   (lambda (&rest args2) (apply func (append args1 args2)))
)

(defun newline ()
	(write-string (format nil "~%"))
)

(defun concat-string-list (s)
	(format nil "~{~A~^~%~}" s)
)

(defun replace-all (string part replacement &key (test #'char=))
"Returns a new string in which all the occurences of the part
is replaced with replacement."
    (with-output-to-string (out)
      (loop with part-length = (length part)
            for old-pos = 0 then (+ pos part-length)
            for pos = (search part string
                              :start2 old-pos
                              :test test)
            do (write-string string out
                             :start old-pos
                             :end (or pos (length string)))
            when pos do (write-string replacement out)
            while pos))
)

(defun is-arg-set (target-arg args)
    (not (null (find target-arg args :test 'equal)))
)

(defun format-paramitem-type (args p)
	(format nil "~A" (param-type p))
)

(defun format-paramitem-name (args p)
    ;in name only format, we can dereference the argument (pointer)
    ;but only if the macro argument requested it
    ;and this parameter can be dereferenced
	(if (and (is-arg-set "deref" args) (param-deref p))
		;then
		(format nil "*~A" (param-name p))
		;else
		(format nil "~A" (param-name p))
	)
)

(defun format-paramitem-full (args p)
	(let* ((type-decl (param-type p))
           (last-index (1- (length type-decl)))
          )
        (format nil "~A ~A"
                ;if macro requested reference mode,
                ; this parameter is dereferencable,
                ; and the last char is a *
                (if (and (is-arg-set "ref" args) (param-deref p) (equal "*" (subseq type-decl last-index)))
                    ;then, replace the last * with a &
                    (concatenate 'string (subseq type-decl 0 last-index) "&")
                    ;else
                    type-decl
                )
                (param-name p))
	)
)

(defun error-if-null (var errmsg) (when (null var) (error errmsg)))

(defun format-params (params token-start-length args void-param)
    ;full, types, names, deref, ref, void, voidonly, nowrap
    (let*  ((arg-types      (is-arg-set "types" args))
            (arg-names      (is-arg-set "names" args))
            (arg-deref      (is-arg-set "deref" args))
            (arg-ref        (is-arg-set "ref" args))
            (arg-void       (is-arg-set "void" args))
            (arg-voidonly   (is-arg-set "voidonly" args))
            (arg-wrap       (is-arg-set "wrap" args))
            (arg-nowrap     (is-arg-set "nowrap" args))
            (filtered-params (cond  (arg-voidonly
                                        (error-if-null void-param "Void param must be set to use void argument")
                                        (cons void-param nil)) ;only the void-param
                                    (arg-void
                                        (error-if-null void-param "Void param must be set to use void argument")
                                        (cons void-param params)) ;prepend the void-param
                                    (t params) ;default, just use params
                              )
                          )
            (types-only (and arg-types (not arg-names)))
            (names-only (and arg-names (not arg-types)))
            (full-decl  (not (xor arg-names arg-types)))
            (format-param-func (cond  (full-decl  #'format-paramitem-full)
                                (types-only #'format-paramitem-type)
                                (names-only #'format-paramitem-name)
                          ))
            (do-wrap    (or arg-wrap (not (or names-only arg-nowrap))))
            (format-line (if do-wrap "~{~A~^,~%~}" "~{~A~^, ~}"))
           )
       (when filtered-params
            (format nil format-line
                (cons
                    ;first parameter => no indentation
                    (apply format-param-func (list args (car filtered-params)))
                    (mapcar
                        (lambda (p)
                            (concatenate 'string
                                ;second parameter, indent according to wrap policy
                                (when do-wrap (make-string token-start-length :initial-element #\ ))
                                (apply format-param-func (list args p))
                            )
                        )
                        (cdr filtered-params)
                    )
                )
            )
        )
    )
)

(defun split-by-delimiter (string delimiter)
	(loop 	for start = 0 then (1+ finish)
			for finish = (position delimiter string :start start)
			if (and (not (eq (length string) start)) (not (eq start finish))) collect (subseq string start finish)
			until (null finish)
	)
)

(defun process-tokens (line funcdata void-param &optional (line-length 0))
    (let ((token-marker-left (position token-marker line))
         )
        (if (null token-marker-left)
            ;then, no left token marker. return line
            line
            ;else, process more
            (let* ((token-start (1+ token-marker-left))
                  (token-stop (position token-marker line :start token-start))
                 )
                (if (null token-stop)
                    ;then, no right token marker. return line
                    line
                    ;else, process more

        (let* ((token-full (subseq line token-start token-stop))
               (seperator-index (position token-arg-marker token-full))
               (token (subseq token-full 0 seperator-index))
               (token-args (if (not (null seperator-index))
                              (split-by-delimiter (subseq token-full (1+ seperator-index) nil) token-arg-delimiter)
                              '(nil)
                          ))
               (line-begin (subseq line 0 token-marker-left))
               (line-end (subseq line (1+ token-stop) nil))
               (m (get-macro token))
              )
              ;m (the macro struct) is nil if no macro found for the token
              (if (null m)
                    ;then
                    line
                    ;else
                    (let* ((token-start-length (+ line-length token-marker-left))
                           (expanded-token (funcall (lppmacro-filter m) funcdata token-start-length token-args void-param))
                          )
                        (concatenate 'string
                            line-begin
                            expanded-token
                            (process-tokens line-end funcdata void-param (+ token-start-length (length expanded-token)))
                        )
                    )
               )
        )
    ))))
)

(defun expand-template (template-list func-data void-param)
    (concat-string-list
        (mapcar
            (lambda (template-line) (process-tokens template-line func-data void-param))
            template-list
        )
    )
)

(defun expand-methods-with-template (template-list funcset-name)
    (remove nil ;filter out the nil values (from wrong funcsets)
        (mapcar
            (lambda (func-data)
                    (cond ;only expand this function if it belongs to the target funcset
                          ((equal funcset-name (funcdef-funcset func-data))
                           (expand-template template-list func-data (get-void-param funcset-name))
                          )
                          ;otherwise return nil
                          (t nil)
                    )
            )
            funcs
        )
    )
)

(defun clear-funcs ()
	(setq funcs nil)
	(setq funcs-tail funcs)
)
(clear-funcs)

(defun add-func (&rest args)
	(let ((func-data (apply #'make-funcdef args)))
		(if (endp funcs)
			;then
			(progn
				(setq funcs (cons func-data nil))
				(setq funcs-tail funcs)
			)
			;else
			(progn
				(setf (cdr funcs-tail) (cons func-data nil))
				(setq funcs-tail (cdr funcs-tail))
			)
		)
	)
)

(defun outputfuncs (f)
	(write-line (concat-string-list f))
)

(defun filter-line (line filename)
	(replace-all line auto-header-marker (format nil "THIS FILE AUTO-GENERATED FROM ~A. DO NOT EDIT." filename))
)

(defmacro prepend-into (var value)
	`(setq ,var (cons ,value ,var))
)

(defun strip-end-characters (str numChars)
	(let ((index (- (length str) numChars)))
		(if (>= index 1)
			(subseq str 0 index)
			nil
		)
	)
)

(defun get-funcset-from-begin-marker (line)
    (let ((start-index (search begin-marker-left line)))
        (cond ;no begin marker, return nil
              ((null start-index) nil)

              ;begin marker must be at start of line
              ((not (= start-index 0)) nil)

              ;left side is good
              (t (let*  ((start-param-index (+ start-index (length begin-marker-left)))
                         (end-index (search begin-marker-right line :start2 start-param-index)))
                        (cond ;no right side marker, return nil
                              ((null end-index) nil)

                              ;right marker must be at end of line
                              ((not (= (length line) (+ end-index (length begin-marker-right)))) nil)

                              ;markers but no funcset parameter, can't process
                              ((= start-param-index end-index) nil)
                              ;we have a begin-marker and funcset parameter!
                              (t (values (subseq line start-param-index end-index) start-param-index end-index))
                        )
                 )
               )
        )
    )
)

(defun is-end-marker (line)
    (equal line end-marker)
)

(defun in-to-out-filename (fn)
    (strip-end-characters fn 4)
)

(defun process-file (infilename)
	(let ((infile (open infilename :if-does-not-exist nil))
		  (outfile (open (in-to-out-filename infilename) :direction :output :if-exists :supersede))
		  (filelines nil)
		  (templatelines nil)
		  (funcset-name nil)
		  )
	  (when infile
		(loop
			for line = (read-line infile nil)
			while line
			do
				(cond   ;outside of a replace block
                        ((null funcset-name)
                         ;look for a begin-replace marker (funcset name becomes not nil)
                         (setq funcset-name (get-funcset-from-begin-marker line))
                         ;if still no funcset-name
                         (when (null funcset-name)
                                ;accumulate filtered lines to filelines
                               (prepend-into filelines (filter-line line (file-namestring infilename)))
                         )
                        )

                        ;all below: funcset-name is not nil -- inside of a replace block
                        ;check for end marker
                        ((is-end-marker line)
						 ;since we have a full template, expand template it
						 (mapcar
						 	(lambda (v) (prepend-into filelines v))
						 	(expand-methods-with-template (reverse templatelines) funcset-name)
						 )
                         (setq funcset-name nil) ;clear funcset-name -- return to normal operation above
						)
						;inside replace block, accumulate template
						(t (prepend-into templatelines line))
				)
		)
		(loop for line in (reverse filelines)
			  do (write-line line outfile)
		)
		(close infile)
		(close outfile))
	)
)

(load "apidef.cl" :verbose nil)
(load "cl-fad/load.lisp" :verbose nil)

(defun mapc-directory-tree (fn directory)
    (dolist (entry (cl-fad:list-directory directory))
        (when (cl-fad:directory-pathname-p entry)
            (mapc-directory-tree fn entry))
        (funcall fn entry)
    )
)

(defun _ () (load "lpp.cl" :verbose nil))

(defun process (dir)
    (let ((target-directory (if (null dir)
                                (ext:cd)
                                dir
                                )))
    (write-line (format nil "Base directory: ~A~%" target-directory))
    (mapc-directory-tree (lambda (x)
                            (when (equal (pathname-type x) preprocessor-file-extension)
                                  (write-line (format nil "~A => ~A"
                                                    (enough-namestring x target-directory)
                                                    (in-to-out-filename (file-namestring x))))
                                  (process-file (namestring x))
                             )
                         )
                          target-directory
    )
    )
)
;(process (car *args*))