RosettaCodeData/Task/Nonoblock/Action-/nonoblock.action
2023-07-01 13:44:08 -04:00

115 lines
2.1 KiB
Text

DEFINE MAX_BLOCKS="10"
DEFINE NOT_FOUND="255"
BYTE FUNC GetBlockAtPos(BYTE p BYTE ARRAY blocks,pos INT count)
INT i
FOR i=0 TO count-1
DO
IF p>=pos(i) AND p<pos(i)+blocks(i) THEN
RETURN (i)
FI
OD
RETURN (NOT_FOUND)
PROC PrintResult(BYTE cells BYTE ARRAY blocks,pos INT count)
BYTE i,b
Print("[")
FOR i=0 TO cells-1
DO
b=GetBlockAtPos(i,blocks,pos,count)
IF b=NOT_FOUND THEN
Put('.)
ELSE
Put(b+'A)
FI
OD
PrintE("]")
RETURN
BYTE FUNC LeftMostPos(BYTE cells BYTE ARRAY blocks,pos INT count,startFrom)
INT i
FOR i=startFrom TO count-1
DO
pos(i)=pos(i-1)+blocks(i-1)+1
IF pos(i)+blocks(i)>cells THEN
RETURN (0)
FI
OD
RETURN (1)
BYTE FUNC MoveToRight(BYTE cells BYTE ARRAY blocks,pos INT count,startFrom)
pos(startFrom)==+1
IF pos(startFrom)+blocks(startFrom)>cells THEN
RETURN (0)
FI
RETURN (LeftMostPos(cells,blocks,pos,count,startFrom+1))
PROC Process(BYTE cells BYTE ARRAY blocks INT count)
BYTE ARRAY pos(MAX_BLOCKS)
BYTE success
INT current
IF count=0 THEN
PrintResult(cells,blocks,pos,count)
RETURN
FI
pos(0)=0
success=LeftMostPos(cells,blocks,pos,count,1)
IF success=0 THEN
PrintE("No solutions")
RETURN
FI
current=count-1
WHILE success
DO
PrintResult(cells,blocks,pos,count)
DO
success=MoveToRight(cells,blocks,pos,count,current)
IF success THEN
current=count-1
ELSE
current==-1
IF current<0 THEN
EXIT
FI
FI
UNTIL success
OD
OD
RETURN
PROC Test(BYTE cells BYTE ARRAY blocks INT count)
BYTE CH=$02FC ;Internal hardware value for last key pressed
INT i
PrintB(cells) Print(" cells [")
FOR i=0 TO count-1
DO
PrintB(blocks(i))
IF i<count-1 THEN
Put(32)
FI
OD
PrintE("]")
Process(cells,blocks,count)
PutE()
PrintE("Press any key to continue...")
DO UNTIL CH#$FF OD
CH=$FF
PutE()
RETURN
PROC Main()
BYTE ARRAY t1=[2 1],t2=[],t3=[8],t4=[2 3 2 3],t5=[2 3]
Test(5,t1,2)
Test(5,t2,0)
Test(10,t3,1)
Test(15,t4,4)
Test(5,t5,2)
RETURN