/* $VER: FontSpec.rexx 2.1 (28.06.95)
   Copyright 1995 Soft-Logik Publishing Corporation
   May not be distributed without Soft-Logik Publishing Corporation's express written permission */

OPTIONS RESULTS
TRACE OFF

/* Make sure rexx support is opened */
IF ~SHOW('L','rexxsupport.library') THEN
   CALL ADDLIB('rexxsupport.library',0,-30)

ADDRESS 'PAGESTREAM'

/* DEFINES	  */
	pfontcount=0
	totalfonts=0
	cancel=9
/* specsize   */
	big=0
	small=1
/* whichfonts */
	all=0
	select=1

/* MAIN LOOP  */
choice=INSTRUCT()                                /* find out what to print */
if choice~=cancel then do
		call FINDFONTS()
		call SORTIFONTS()
		if whichfonts=select then call CHOOSEFONTS() /* choose which fonts to print */
		else do
			do i=1 to ifontcount
				pfonts.i=ifonts.i
			end
			pfontcount=ifontcount
		end
		call CREATEDOC()						 /* create the document 	 */
		if specsize=small then call SMALLSPEC()  /* layout 6 fonts per page  */
		else call BIGSPEC() 					 /* layout 1 font per page	 */
		call PRINTFONTS()
end
EXIT

INSTRUCT:
/* GIVE INSTRUCTIONS */
	allocarexxlist
		hSpecSizeList=result
	addarexxlist hSpecSizeList '"One font per page"'
	addarexxlist hSpecSizeList '"Six fonts per page"'
	allocarexxlist
		hWhichFontsList=result
	addarexxlist hWhichFontsList '"All fonts"'
	addarexxlist hWhichFontsList '"Selected fonts"'

	allocarexxrequester '"Create Font Specimen Sheets"' 552 109
		hInstructReq=result
	addarexxgadget hInstructReq EXIT 12 92 70 label "_Print"
		hPrintGadget=result
	addarexxgadget hInstructReq EXIT 470 92 70 label "_Cancel"
		hCancelGadget=result
	addarexxgadget hInstructReq TEXT 8 10 536 border none string "'This macro will print font specimen sheets to help select fonts to'"
	addarexxgadget hInstructReq TEXT 8 20 536 border none string "'use. You can choose to print detailed specimens with one font per'"
	addarexxgadget hInstructReq TEXT 8 30 536 border none string "'page or small specimens with 6 fonts per page. You can also choose'"
	addarexxgadget hInstructReq TEXT 8 40 536 border none string "'to print All installed fonts or Selected fonts only.'"
	addarexxgadget hInstructReq CYCLE 12 64 240 label '"_Number"' labelpos left
		hSpecSizeGadget=result
	addarexxgadget hInstructReq CYCLE 292 64 248 label '"_Which fonts"' labelpos left
		hWhichFontsGadget=result
	setarexxgadget hInstructReq hSpecSizeGadget list hSpecSizeList current 0
	setarexxgadget hInstructReq hWhichFontsGadget list hWhichFontsList current 0

	doarexxrequester hInstructReq
		action=result
	if action=hCancelGadget then RETURN cancel

	getarexxgadget hInstructReq hSpecSizeGadget current
		specsize=result
	getarexxgadget hInstructReq hWhichFontsGadget current
		whichfonts=result

	freearexxrequester hInstructReq
	freearexxlist hInstalledFontsList
	freearexxlist hPrintFontsList
RETURN 0

FINDFONTS:
/* GET THE NAMES AND NUMBER OF FACES */
	getfontfamilies ifonts
	ifontcount=result

	/* Count Fonts */
	fontcount=0
	do i=0 to ifontcount-1
		getfontstyles ifonts.i styles
		stylecount=result
		/* Repeat for each style */
		do ii=0 to stylecount-1
			fontcount=fontcount+1
		end ii
	end i
	/* Shuffle 0 to end to work with sort routine */
	ifonts.ifontcount=ifonts.0
RETURN

SORTIFONTS:
/* SORT THE LIST ALPHABETICALLY */
	DO tick = 1 to ifontcount-1
		nexttick=tick+1
		IF ifonts.tick > ifonts.nexttick THEN DO
			store=ifonts.nexttick
			ifonts.nexttick=ifonts.tick
			DO bubpos = tick-1 to 1 by -1 WHILE (store < ifonts.bubpos)
				nexttick=bubpos+1
				ifonts.nexttick = ifonts.bubpos
			END bubpos
			bubpos=bubpos+1
			ifonts.bubpos=store
		END
	END tick
RETURN

SORTPFONTS:
/* SORT THE LIST ALPHABETICALLY */
		DO tick = 1 to pfontcount-1
		nexttick=tick+1
		IF pfonts.tick > pfonts.nexttick THEN DO
			store=pfonts.nexttick
			pfonts.nexttick=pfonts.tick
			DO bubpos = tick-1 to 1 by -1 WHILE (store < pfonts.bubpos)
				nexttick=bubpos+1
				pfonts.nexttick = pfonts.bubpos
			END bubpos
			bubpos=bubpos+1
			pfonts.bubpos=store
		END
	END tick
RETURN

CHOOSEFONTS:
/* FIND OUT WHICH FONTS TO PRINT */

	call alloclists()

	/* Initialize the installed font list */
	do i=1 to ifontcount
	'getfontstyles "'ifonts.i'" 'styles
		stylecount=result
		'addarexxlist 'hInstalledFontsList' "'ifonts.i'"'
	end i

		/* Allocate and build the requester */
		allocarexxrequester '"Create Font Specimen Sheets"' 528 201
			hChooseReq=result
		addarexxgadget hChooseReq TEXT 8 10 250 border none string "'Select the typefaces to print:'" highdata true
		addarexxgadget hChooseReq EXIT 12 184 70 label "_Print"
			hPrintGadget=result
		addarexxgadget hChooseReq EXIT 224 42 80 label '"_Add    ->"'
			hAddGadget=result
		addarexxgadget hChooseReq EXIT 224 62 80 label '"_Remove <-"'
			hRemoveGadget=result
		addarexxgadget hChooseReq EXIT 446 184 70 label "_Cancel"
			hCancelGadget=result
		addarexxgadget hChooseReq SCROLLIST 12 32 200 139 label '"Installed Typefaces"' labelpos aboveleft
			hInstalledFontsGadget=result
		addarexxgadget hChooseReq SCROLLIST 316 32 200 139 label '"Typefaces to Print"' labelpos aboveleft
			hPrintFontsGadget=result

	/* FONT SELECTION LOOP */
	exitflag=0
	do until exitflag=1

		/* Do the font selection requester */
		setarexxgadget hChooseReq hInstalledFontsGadget list hInstalledFontsList current 0
		setarexxgadget hChooseReq hPrintFontsGadget list hPrintFontsList current 0
		doarexxrequester hChooseReq
			action=result

		select
			when action=hCancelGadget then do	  /* THE USER CANCELLED   */
				call freelists()
				retvalue=9
				exitflag=1
				end
			when action=hPrintGadget then do	  /* PRINT THE FONTS!     */
				call freelists()
				retvalue=1
				exitflag=1
				end
			when action=hAddGadget then do		  /* ADD A FONT TO PRINT  */
				getarexxgadget hChooseReq hInstalledFontsGadget current
				cfont=result+1
				pfontcount=pfontcount+1
				pfonts.pfontcount=ifonts.cfont
				call sortpfonts()				  /* sort the to print list  */
				call freelists()				  /* free the arexx lists    */
				call alloclists()				  /* alloc the lists again   */
				do i=1 to pfontcount			  /* fill the to print list  */
					'addarexxlist 'hPrintFontsList' "'pfonts.i'"'
				end i
				do i=cfont to ifontcount		  /* remove from ifonts      */
					nexti=i+1
					ifonts.i=ifonts.nexti
				end
				ifontcount=ifontcount-1
				do i=1 to ifontcount			  /* fill the installed list */
					'addarexxlist 'hInstalledFontsList' "'ifonts.i'"'
				end i
				end
			when action=hRemoveGadget then do	   /* REMOVE A FONT TO PRINT */
				getarexxgadget hChooseReq hPrintFontsGadget current
				cfont=result+1
				ifontcount=ifontcount+1
				ifonts.ifontcount=pfonts.cfont
				call sortifonts()				  /* sort the installed list */
				call freelists()				  /* free the arexx lists    */
				call alloclists()				  /* alloc the lists again   */
				do i=1 to ifontcount			  /* fill the installed list */
					'addarexxlist 'hInstalledFontsList' "'ifonts.i'"'
				end i
				do i=cfont to pfontcount		  /* remove from pfonts      */
					nexti=i+1
					pfonts.i=pfonts.nexti
				end
				pfontcount=pfontcount-1
				do i=1 to pfontcount			  /* fill the to print list  */
					'addarexxlist 'hPrintFontsList' "'pfonts.i'"'
				end i
				end
		end
	end
	freearexxrequester hChooseReq

	if retvalue=9 then EXIT
	if retvalue=1 & pfontcount=0 then do
		call doalert("No fonts selected to print!")
		EXIT
	end

RETURN

ALLOCLISTS:
/* Allocate lists for the installed fonts and the fonts to print */
	allocarexxlist
		hInstalledFontsList=result     /* list of installed fonts */
	allocarexxlist
		hPrintFontsList=result         /* list of fonts to print */
RETURN

FREELISTS:
/* Free lists for the installed fonts and the fonts to print */
	freearexxlist hInstalledFontsList
	freearexxlist hPrintFontsList
RETURN


CREATEDOC:
/* Make the FontSpec document */
	'newdocument FontSpec '
	'setdocumentdesc "" '
	'newmasterpage "Default Master Page" 8.5i 11i portrait single'
	'setmasterpagedesc ""'
	'setdimensions 8.5i 11i portrait single'
	'setbleed 0i 0i '
	'setmarginguides 0.5i 0.5i 1i 1i '
	'setcolumnguides 1 0.25i '
	'setdocumentstatus unchanged '
	'openwindow View.1 page 1 '
RETURN

SMALLSPEC:
/* CREATE A MULTIPLE FONT SPECIMEN SHEET */

	'settoolmode text'	   /* this ensures that no stray size handles get left around */

	openbusyrequester message "'Preparing FontSpec document...'" thermometer enabled abort enabled total 100 current 0
		brhandle=result

	/* Make the style tags */
	'newstyletag "FontSample1" character'
	'newstyletag "FontSample2" character'
	'newstyletag "FontSample3" character'
	'newstyletag "FontSample4" character'
	'newstyletag "FontSample5" character'
	'newstyletag "FontSample6" character'

	/* Document Layout Loop */
	do i=1 to 6
		k=i+(i-1)*0.5	   /* this gives us the correct offset */

		/* Draw the surrounding boxes */
		'drawbox 0.5i 'k'i 8i 'k+1.25'i'

		/* Make the titles */
		'drawtextobj 0.625i 'k+0.0625'i'
			tohandle.i=result
		'selecttext at 0.625i 'k+0.0625'i'
		'settypesize 18pt'
		'setfont Triumvirate'
		'settypestyle Bold'
		'insert "Font Name"'

		/* Make the text frames */
		'drawcolumn 0.625i 'k+0.375'i 7.875i 'k+1.125'i columns 1 gutter 0'
			sfhandle.i=result
		'selecttext at 0.625i 'k+0.375'i'
		if i=1 then do
			'insert '||xrange('a','z')
			'insertcontrol newparagraph'
			'insert '||xrange('A','Z')
			'insertcontrol newparagraph'
			'insert 1234567890!@#$%^&*<?>«»'
			'insertchar unicode 39'
			'insertchar unicode 34'
			'insertchar opendblquote'
			'insertchar closedblquote'
			'insertchar opensnglquote'
			'insertchar closesnglquote'
			'insertchar r c tm'
			'selecttext all'
			'setcharacterstyle "FontSample1"'
			'settypesize 15pt'
			'settracking 15%'
			'copytext nostatus'
			'selecttext none'
			end
		else do
			'pastetext nostatus'
			'setcharacterstyle FontSample'i
			'selecttext none'
		end

	call setbusy(16.7*i)
	end i

	'closebusyrequester 'brhandle
RETURN

BIGSPEC:
/* CREATE A FULL PAGE FONT SPECIMEN SHEET */
	openbusyrequester message "'Preparing FontSpec document...'" thermometer enabled abort enabled total 100 current 0
		brhandle=result

	/* Draw the surrounding box */
	'drawbox 0.5i 1i 8i 10i'

	/* Make the style tag */
	'newstyletag "FontSample" character'

	/* Make the title */
	'settoolmode text'
	'drawtextobj 0.75i 1.25i'
		tohandle=result
	'selecttext at 0.75i 1.25i'
	'settypesize 36pt'
	'setfont Triumvirate'
	'settypestyle Bold'
	'insert "Font Name"'

	call setbusy(5)

	sizes.1=10
	sizes.2=12
	sizes.3=15
	sizes.4=18
	sizes.5=24
	sizes.6=36
	sizes.7=48

	/* Make the text frames */
	'drawcolumn 0.75i 2i 1.25i 4.75i columns 1 gutter 0'
		sfhandle=result
	'selecttext at 0.75i 2i'
	'settypesize 10pt'
	do i=1 to 7
		'setleading fixed 'sizes.i+2'pt'
		'insert 'sizes.i'pt'
		'insertcontrol newparagraph'
		call setbusy(5+4*i)
	end i

	'drawcolumn 1.25i 2i 7.75i 4.75i columns 1 gutter 0'
		tfhandle=result
	'selecttext at 1.25i 2i'
	'setcharacterstyle "FontSample"'
	do i=1 to 7
		'setleading fixed 'sizes.i+2'pt'
		'settypesize 'sizes.i'pt'
		'insert "The Quick Brown Fox"'
		'insertcontrol newparagraph'
		call setbusy(33+4*i)
	end i

	'drawtextobj 0.75i 5i'
	'selecttext at 0.75i 5i'
	'settypesize 18pt'
	'setfont Triumvirate'
	'settypestyle Bold'
	'insert "Character Set Sample"'

	call setbusy(66)

	'drawcolumn 0.75i 5.5i 7.75i 7.25i columns 1 gutter 0'
		mfhandle=result
	'selecttext at 0.75i 5.5i'
	'setcharacterstyle "FontSample"'
	'settypesize 24pt'
	'insert '||xrange('a','z')
	call setbusy(69)
	'insertcontrol newparagraph'
	'insert '||xrange('A','Z')
	call setbusy(72)
	'insertcontrol newparagraph'
	'insert 1234567890!@#$%^&*<?>«»'
	'insertchar opendblquote'
	'insertchar closedblquote'
	'insertchar opensnglquote'
	'insertchar closesnglquote'
	'insertchar r c tm'

	call setbusy(75)

	'drawtextobj 0.75i 7.5i'
	'selecttext at 0.75i 7.5i'
	'settypesize 18pt'
	'setfont Triumvirate'
	'settypestyle Bold'
	'insert "Body Text Sample"'

	call setbusy(80)

	'drawcolumn 0.75i 8i 7.75i 9.75i columns 1 gutter 0'
		bfhandle=result
	'selecttext at 0.75i 8i'
	'setcharacterstyle "FontSample"'
	'settypesize 12pt'
	'setleading fixed 14pt'
	'insert "It was the best of times, it was the worst of times, it was the age of wisdom, it was the age of foolishness, it was the epoch of belief, it was the epoch of"'
	call setbusy(87)
	'insert " incredulity, it was the season of Light, it was the season of Darkness, it was the spring of hope, it was the winter of despair, we had everything before us,"'
	call setbusy(94)
	'insert " we had nothing before us, we were all going direct to Heaven, we were all going direct the other way."'
	call setbusy(100)
	'closebusyrequester 'brhandle
RETURN


PRINTFONTS:
/* PRINT LOOP */
	openbusyrequester message "'Creating Font Specimens...'" thermometer enabled abort enabled total fontcount current 0
		brhandle=result

	/* Build one master stem variable from the fonts */
	do i=1 to pfontcount

		/* Get the type styles for the font */
		getfontstyles pfonts.i styles
		stylecount=result

		/* Repeat for each type style */
		do ii=0 to stylecount-1

			/* Fill the master stem variable */
			totalfonts=totalfonts+1
			mfonts.totalfonts=pfonts.i
			mstyles.totalfonts=styles.ii

		end ii
	end i

	/* Count the pages to print */
	if specsize=small then do
		pagecount=trunc(totalfonts/6)
		lastpage=(totalfonts/6-pagecount)*6			/* how many fonts on the last page?  */
		if lastpage>0 then pagecount=pagecount+1	/* add a page if there's a remainder */
		end
	else pagecount=totalfonts

	/* Repeat for each page to print */
	j=0
	do i=1 to pagecount
		j=j+1

		if specsize=small then do			/* Layout for 6 to a page */
			do ii=1 to 6
				k=ii+(ii-1)*0.5 			/* this gives us the correct offset */
				/* Change the title(s) */
				'selecttext at 0.625i 'k+0.0625'i'
				'selecttext all'
				if lastpage>0 & i=pagecount & ii>lastpage then do
					'deletetext'
					'selectobject at 0.65i 'k+0.4'i'
					'deleteobject'
					end
				else do
					'insert "'mfonts.j'-'mstyles.j'"'
					/* Change the font and style */
					'refresh wait'
					'clearstyletag FontSample'.ii
					'setfont 'mfonts.j' styletag FontSample'ii
					'settypestyle 'mstyles.j' styletag FontSample'ii
					'refresh continue'
				end
				j=j+1
			end ii
			j=j-1
			end
		else do
			/* Change the title(s) */
			'selecttext at 0.75i 1.25i'
			'selecttext all'
			'insert "'mfonts.j'-'mstyles.j'"'

			/* Change the font and style */
			'refresh wait'
			'clearstyletag FontSample'
			'setfont 'pfonts.i' styletag FontSample'
			'settypestyle 'styles.ii' styletag FontSample'
			'refresh continue'
		end

		/* Print the font sample page */
		call setbusy((i-.7)/pagecount*100)
		'printdocument copies 1 page 1 sides both scale actual output grayscale printermarks off mirror off negative off'
		call setbusy(i/pagecount*100)
	end i

	'closebusyrequester 'brhandle
	'closedocument force'
RETURN

DOALERT:
parse arg astring
/* Display an alert requester */
		allocarexxrequester '"Macro Alert"' 334 55
			hAlertReq=result
		addarexxgadget hAlertReq TEXT 8 12 268 border none string '"'astring'"'
		addarexxgadget hAlertReq EXIT 252 38 70 label "_Exit"
		doarexxrequester hAlertReq
		freearexxrequester hAlertReq
RETURN

SETBUSY:
	parse arg value
	ADDRESS PAGESTREAM
	setbusyrequester brhandle current value
	getbusyrequester brhandle
	if result=1 then call CLEANUP(1)
	ADDRESS COMMAND
RETURN

CLEANUP:
	'closebusyrequester 'brhandle
/*	  'closedocument force'*/
EXIT