Amiga ISO Collection/AmigaUtilCD2.iso/WordProcessors/PGS3I.LZX/3.0iUpdate/Macros.LHA/FontSpec.rexx

OS/2 REXX Batch file | 1995-11-27 | 15.0 KB | 555 lines

/* $VER: FontSpec.rexx 2.1b (27.11.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:'"
        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
        hBusyReq=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 'hBusyReq
RETURN

BIGSPEC:
/* CREATE A FULL PAGE FONT SPECIMEN SHEET */
    openbusyrequester message "'Preparing FontSpec document...'" thermometer enabled abort enabled total 100 current 0
        hBusyReq=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 'hBusyReq
RETURN


PRINTFONTS:
/* PRINT LOOP */
    openbusyrequester message "'Creating Font Specimens...'" thermometer enabled abort enabled total fontcount current 0
        hBusyReq=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 'hBusyReq
    '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 hBusyReq current value
    getbusyrequester hBusyReq
    if result=1 then call CLEANUP(1)
    ADDRESS COMMAND
RETURN

CLEANUP:
    'closebusyrequester 'hBusyReq
    'closedocument force'
EXIT