MACD 4/MACD4.iso/Patch/Programs/PGS3ITU3.LHA/FontSpec.rexx

OS/2 REXX Batch file | 1996-05-03 | 10.3 KB | 359 lines

/* $VER: FontSpec.rexx 3.0 (03.05.96)
   Copyright 1996 SoftLogik Publishing Corporation
   May not be distributed without SoftLogik 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
        if specsize=small then 'open "pagestream3:macros/fontspec6.doc"'
        else 'open "pagestream3:macros/fontspec1.doc"'
        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 script will print font specimen sheets to help select fonts'"
    addarexxgadget hInstructReq TEXT 8 20 536 border none string "'to use. You can choose to print detailed specimens with one font'"
    addarexxgadget hInstructReq TEXT 8 30 536 border none string "'per page or small specimens with 6 fonts per page. You can also'"
    addarexxgadget hInstructReq TEXT 8 40 536 border none string "'choose 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

PRINTFONTS:
/* PRINT LOOP */
    openbusyrequester message "'Creating Font Specimens...'" thermometer enabled abort enabled total 100 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 */

                if lastpage>0 & i=pagecount & ii>lastpage then do
                    /* Change the title(s) to blank */
                    'setvariablevalue "' '" variable FontName'ii
                    /* Set the text color to white */
                    'beginstyletag styletag FontSample'ii
                    'setcolor text white styletag FontSample'ii
                    'endstyletag styletag FontSample'ii
                    end
                else do
                    /* Change the title(s) */
                    'setvariablevalue "'mfonts.j'-'mstyles.j'" variable FontName'ii
                    /* Change the font and style */
                    'beginstyletag styletag FontSample'ii
                    'setfont 'mfonts.j' styletag FontSample'ii
                    'settypestyle 'mstyles.j' styletag FontSample'ii
                    'endstyletag styletag FontSample'ii
                end
                j=j+1
            end ii
            j=j-1
            end
        else do
            /* Change the title */
            'setvariablevalue "'mfonts.j'-'mstyles.j'" variable FontName'

            /* Change the font and style */
            'beginstyletag styletag FontSample'
            'setfont 'mfonts.j' styletag FontSample'
            'settypestyle 'mstyles.j' styletag FontSample'
            'endstyletag styletag FontSample'
        end

        /* Print the font sample page */
        '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 '"Script 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