Here is my code. I do not think someone wants to reuse it.
My logic was:
example
if input is 3
starting position = -3 -2 -1 0 1 2 3
Then some code to get to the
ending position = 1 2 3 0 -3 -2 -1
Then swap numbers
0 = ' '
<0 = 'W'
>0 = 'B'
Code:

Function s($)
	Dim $j, $k, $b, $v
	Dim $a[$+$]
	For $j = 0 to $+$
		$a[$j] = ~$+1+$j
	Next

	$s = d($s,$a)
	
	For $k = 1 to $
		For $j = 1 to $k
			$a = c($j,$a)
			$s = d($s,$a)
		Next
		If $ > $k
			$k=$k+1
		EndIf
		For $j = -1 to ~$k+1 step -1
			$a = c($j,$a)
			$s = d($s,$a)
		Next
	Next
	If NOT $ MOD 2
		For $j = 1 to $
			$a = c($j,$a)
			$s = d($s,$a)
		Next
	EndIf
	If $ MOD 2
		For $k = -1 to ~$+1 step -1		
			For $j = ~$k+1 to $
				$a = c($j,$a)
				$s = d($s,$a)
			Next
			If ~$+1 < $k
				$k=$k-1
			EndIf
			If NOT $k = ~$+1
				For $j = $k to ~$+1 step -1
					$a = c($j,$a)
					$s = d($s,$a)
				Next
			EndIf
		Next
	Else
		For $k = -1 to ~$+1 step -1
			For $j = $k to ~$+1 step -1
				$a = c($j,$a)
				$s = d($s,$a)
			Next
			If ~$+1 < $k
				$k=$k-1
			EndIf
			For $j = ~$k+1 to $
				$a = c($j,$a)
				$s = d($s,$a)
			Next
		Next
	EndIf
	$s=Split($s,"-")
EndFunction

Function c($j,$a)
	Dim $b,$v
	$b = AScan($a,0)
	$v = AScan($a,$j)
	$a[$b]=$j
	$a[$v]=0
	$c = $a
EndFunction

Function d($s,$a)
	Dim $j
	If $s
		$s = $s + "-"
	EndIf
	
	For Each $j In $a
		Select
			Case $j < 0
				$s = $s + "W"
			Case $j = 0
				$s = $s + " "
			Case $j > 0
				$s = $s + "B"
		EndSelect
	Next
	$d = $s	
EndFunction

If you would change
<0 = 'B'
>0 = 'A'
all of the tests will fail...
For one or another reason, I was also looking at the Demlo Number...
But at the end found nothing that could help me.