/*
@B@LLabel Generator.pprx@b Copyright Gold Disk Inc., February, 1992
This Genie will read one of several Avery Label databases contained in the current directory and allow the user to create a variety of labels.
*/
parse arg sourcedir
cr  = '0a'x
address command
call SafeEndEdit.rexx()
call ppm_AutoUpdate(0)
units = getclip(ppgenie_units)
call ppm_SetUnits(1)

labels = ''
counter = 0

address command
list	= getdirlist.rexx(sourcedir, ".db")
if list = '' then exit_msg("Unable to find label data:ase. Please reinstall!")

selection = ppm_SelectFromList("Select Type of label..", 35, 5, 0, list)
if selection = '' then exit_msg()

filename = sourcedir"/"selection".db"

if ~open(file, filename, "r") then exit_msg("An error has occured reading database")

call ppm_ShowStatus("Reading label database..")

line	= readln(file)

if pos('LASER', line) ~= 0 then
	labeltype = laser
else if pos('MATRIX', line) ~= 0 then
	labeltype = matrix
else
	exit_msg("Invalid database file")

spos = Pos('PAGESIZE', line)

if spos ~= 0 then
do
	line = substr(line, spos + 8)
	opageh	= word(line, 2)
	opagev	= word(line, 1)
end
else
do
	opageh	= 0
	opagev	= 0
end


lcounter = 0

do while ~eof(file)

    line = strip(readln(file))

	if line = '' | left(line, 2) = '\*' | left(line, 2) = '*/' then
		iterate
    
	lcounter = lcounter + 1

	parse var line code ';' name ';' .

	code = strip(code)
	name = strip(name)
	text = code || copies(" ", max(1,12 - length(code))) || name

    lines.lcounter.0	= line
	lines.lcounter.1	= text

    labels = labels||cr||text

end

labels = delstr(labels,1,1)
label = ppm_SelectFromList("Select Label..", 40, 10, 0, labels)
if label = '' then exit_msg()

do i = 0 to lcounter - 1

	cline = lines.i.1
	if cline = label then leave

end

line = lines.i.0

group = 0

if ppm_GroupFirstBox() ~= 0 then
do
	if ppm_Inform(2,"Would like like to tile the current group to create labels?", "No","Yes") then group = 1
end
else if ppm_BoxNum() ~= 0 then
do
	if ppm_BoxPage() ~= 0 then
		if ppm_Inform(2,"Would like like to tile the current box to create labels?", "No","Yes") then group = 2
end

if labeltype = laser then
do
	sline = compress(line)
	parse var sline pnum ';' type ';' lheight ';' lwid ';' cols ';' rows ';' topmarg ';' sidemarg ';' hpitch ';' vpitch ';' .

	if ~exists("rexx:GroupTile.pprx") then
		exit_msg("Unable to locate Genie named: rexx:GroupTile.pprx")

	npages = ppm_GetForm("How many pages will you need?", 8, "Pages:1")
	if npages = '' then exit_msg()

	if ~datatype(npages, n) then exit_msg("Invalid entry")

	newpage = ppm_CreatePage(ppm_CurrentPage() + 1,1,0,0,0)

	if opagev ~= 0 then
		call ppm_SetPageSize(newpage, opagev, opageh)

	call ppm_GotoPage(newpage)

	if group = 2 then
	do
		call ppm_NewGroup()
		call ppm_AddToGroup(ppm_BoxNum())
		call TileGroup(sidemarg,topmarg,lwid, lheight, cols, rows, hpitch, vpitch)
	end
	else if group = 1 then
	do
		call TileGroup(sidemarg,topmarg,lwid, lheight, cols, rows, hpitch, vpitch)
	end
	else
	do
		call ppm_NewGroup()
		box = ppm_CreateBox(sidemarg, topmarg, lwid, lheight, 0)
		call ppm_AddToGroup(box) 
		call TileGroup(sidemarg,topmarg,lwid,lheight,cols,rows, hpitch, vpitch)
	end

	message = "Done"

end
else
do
	sline = compress(line)
	parse var sline pnum ';' type ';' lheight ';' lwid  ';' cols ';' cwidth ';' hpitch ';' vpitch ';' .

	npages = ppm_GetForm("How many Pages of Dot Matrix Labels?", 18, "Number of labels:"1)
	if npages = '' then exit_msg()

	if ~datatype(npages, n) then exit_msg("Invalid input")

	if vpitch < 1 then vpitch = 1

	hspace = hpitch - lwid
	lmarg = (cwidth - (cols * hpitch - hpitch + lwid)) / 2
	tmarg = (vpitch - lheight) / 2

	newpage = ppm_CreatePage(ppm_CurrentPage() + 1, 1, 0, 0, 0)
	call ppm_SetPageSize(newpage, cwidth, vpitch)
	call ppm_GotoPage(newpage)

	if group = 2 then
	do
		call ppm_NewGroup()
		call ppm_AddToGroup(ppm_BoxNum())
		call TileGroup(lmarg,tmarg,lwid, lheight, cols, 1, hpitch, vpitch)
	end
	else if group = 1 then
	do
		call TileGroup(lmarg,tmarg,lwid, lheight, cols, 1, hpitch, vpitch)
	end
	else
	do
		call ppm_NewGroup()
		box = ppm_CreateBox(lmarg, tmarg, lwid, lheight, 0)
		call ppm_AddToGroup(box) 
		call TileGroup(lmarg,tmarg,lwid, lheight, cols, 1, hpitch, vpitch)
		call ppm_DeleteBox(box)
	end

	call ppm_SetDMEject(0)
	call ppm_SetDMPageSize(cwidth, vpitch)

	cwidth = ppm_ConvertUnits(1, units, cwidth)
	vpitch = ppm_ConvertUnits(1, units, vpitch)

	if units = 1 then unit = "inches"
	else if units = 2 then unit = "CM"
	else if units = 3 then unit = "Picas"

	message = "Done. The Dot Matrix Page Eject has been turned off and the output page size has been set to "cwidth" "unit" x "vpitch" "unit

end
	
npages = npages - 1
cpage = ppm_CurrentPage()

do npages

	call ppm_CopyPage(cpage, cpage + 1, 1)
	cpage = cpage + 1

end

exit_msg(message)

exit_msg: procedure expose units
do
    parse arg message

    if message ~= '' then call ppm_Inform(1,message,)
	call ppm_ClearStatus()
	call ppm_SetUnits(units)
    call ppm_AutoUpdate(1)
	exit
end

TileGroup: procedure expose newpage
do
	parse arg sidemarg, topmarg, lwid, lheight, cols, rows, hpitch, vpitch

	i = 0

	box = ppm_GroupFirstBox()

	do while box ~= 0

		i = i + 1
		newbox.i = ppm_CloneBox(box, 0, 0)

		if ppm_TextOverFlow(box) then
		do
			call ppm_DeleteContents(newbox.i)
			call ppm_TextIntoBox(newbox.i, ppm_GetArticleText(box, 1))
		end

		call ppm_BoxChangePage(newbox.i, newpage)
		box = ppm_GroupNextBox(box)

	end

	call ppm_NewGroup()

	do x = 1 to i
		call ppm_AddToGroup(newbox.x)
	end

	grouprect = ppm_GetGroupRect()
	xscale = lwid / word(grouprect, 3) * 100
	yscale = lheight / word(grouprect, 4) * 100
	address command
	call GroupScale.pprx(xscale, yscale)

	xsp = hpitch - lwid
	ysp	= vpitch - lheight

	call GroupTile.pprx(sidemarg, topmarg, rows, cols, xsp, ysp)
	return
end