DTP Toolbox/DTPToolbox.iso/propage4.0/arexx/booklet.pprx

Text File | 1995-09-09 | 19.8 KB | 604 lines

/*
This genie will rearrange a document designed as double-page spreads to fit on the sheets of a simple stapled booklet. In this document, the first page has the first page on the right and the last on the left; the rest have pairs in normal order (2 & 3, 4 & 5, etc). It only works for Postscript output (which may be to a non-Postscript printer via Post). The pages are arranged so you can print the first half of the document on one side of the paper and then turn the paper over for the other half.
The script does not do the actual printing.
Written by Don Cox ©1993 Revised March 93, July/Aug 95. Not public domain.
*/
/* $VER: Booklet Sept 95 */

call open("STDERR","ram:traceBk","W")
trace r

cr = '0a'x
call SafeEndEdit.rexx()
call ppm_AutoUpdate(0)
oldunits = ppm_GetUnits()
call ppm_SetUnits(2)
call ppm_SetBatchMode(1)

mainchoice = ppm_Inform(3,"What do you want to do?","Basic Layout","Page Numbering","Convert for Printing") /* 0 for layout, 1 for numbering, 2 for conversion */
do forever /* each section returns another option */
    if mainchoice = 0 then mainchoice = basiclayout()
    if mainchoice = 1 then mainchoice = pagenumbering()
    if mainchoice = 2 then mainchoice = conversion()
    end

/* +++++++++++++++++++++++++++++  ++++++++++++++++++++++++++++++++++ */

pagecheck:
totalpages = ppm_NumPages()
if totalpages = 0 then exit_msg("No pages") /* needs an Inform */
if totalpages//2=1 then do /* odd number of pages */
lastpageblank = 0
    if ppm_Inform(2, "You must have an even number of pages. Add a blank page?", "Cancel", "Ok") then do
        /* Create a new page at end of document */
        thispage = ppm_DocLastPage()
        call ppm_MakeTemplate(thispage,0)
        newpage = ppm_CreatePage(thispage,1,2,0,0)
        newpage = ppm_MovePage(newpage+1,newpage)
        totalpages = totalpages+1
        thispage = ppm_GoToPage(newpage+1)
        box = ppm_PageFirstBox(thispage)
        do until box = 0
            call ppm_DeleteBox(box)
            box = ppm_PageNextBox(box)
            end
        end
    else exit_msg("Aborted by User")
    end

/* Set all pages to size of largest */
call ppm_ShowStatus("Checking page sizes")
if totalpages>1 then do
    oldpageX = word(ppm_GetPageSize(1),1)
    oldpageY = word(ppm_GetPageSize(1),2)
    diff = 0   /* flag for different page sizes */
    do i = 2 to totalpages
        pageX = word(ppm_GetPageSize(i),1)
        pageY = word(ppm_GetPageSize(i),2)
        if pageX ~= oldpageX | pageY ~= oldpageY then do
            diff = diff+1
            oldpageX = max(pageX,oldpageX)
            oldpageY = max(pageY,oldpageY)
            end
        end
if diff ~=0 then do
    do i =1 to totalpages
        call ppm_SetPageSize(i,oldpageX,oldpageY)
        end
    exit_msg("Pages Resized. Check boxes, then run Booklet genie again")
    end
end

return /* end of page checking */

/* +++++++++++++++++++++++++++++++++  ++++++++++++++++++++++++++++++ */

pagenumbering:

call pagecheck()
choice = ppm_Inform(3,"Number the pages?","No numbers","Copy Existing Box","New boxes") /* 0 for no numbers, 1 for existing, 2 for new */
currentpage = ppm_CurrentPage()
dfirstpage = ppm_DocFirstPage()
pageoffset = currentpage-dfirstpage

if choice = 1 then do
    call ppm_UpdateScreen()
    numberbox = ppm_ClickOnBox("Click on box for page numbers")
    if numberbox = 0 then choice = 0
    end
if choice = 1 then do
    /* GetBoxText doesn't work if first page is blank, so check */
    boxcount = ppm_Numboxes(dfirstpage)
    if boxcount = 0 then do
        call ppm_GoToPage(dfirstpage)
        littlebox = ppm_CreateBox(1,1,1,1,0)
        call ppm_GoToPage(currentpage)
        end
    text1 = ppm_GetBoxText(numberbox,0) /* Uncoded */
    text2 = ppm_GetBoxText(numberbox,1) /* With text codes */
    code = left(text2,pos(word(text1,1),text2))/* This compares coded and codeless text to find where the initial chunk of code ends */
    text3 = substr(text2,pos(word(text1,1),text2)) /* The rest of the coded text */
    legend = text1
    end

number. = ""
typecode1. = ""
typecode2. = ""
firstnumber = ""
thisword. = ""

if choice = 2 then do
    form = "First Page:Page 1"
    legend = ppm_GetForm("Legend for page number box",50,form)
    if legend = "" then choice = 0
    text3 = legend /* No codes */
    code = "\dp\n\ff<(CG)Times>\fs<12.000>\lr<120>" || "\ps<100>\ls<0.000>\t<0>\c<Black>\FP<1>\pn\ds" /* default setup */
    typecode1.1 = code
    call ppm_UpdateScreen()
    topcorner = ppm_GetClickPosition("Click on position for Page number")
    boxwidth = 4 /*temp */
    boxheight = 2
    posX = word(topcorner,1)
    posY = word(topcorner,2)
    end

if choice~=0 then do i = 1 to words(legend) /* extract number from string */
    thisword.i = word(legend,i) /* without typographic codes */
    thisword2 = word(text3,i) /* with codes */
    split = pos(thisword.i,thisword2)
    thisword3 = thisword2
    if split~=0 then do
        typecode1.i = left(thisword2,split-1)
        thisword3 = substr(thisword2,split)
        end
    spos = pos("\",thisword3)
    if spos~=0 then typecode2.i = substr(thisword3,spos) /* code after word */
    if datatype(thisword.i,n) then do
        number.i = thisword.i
        thisword.i = ""
        number.i.format = "arabic"
        if firstnumber = "" then do
            firstnumber = number.i-1 /* We are going to add 1 later */
            pagenumberpos = i
            end
        end
    else if verify(upper(thisword.i), "IVXLCMD")=0 then do
        number.i = unroman(thisword.i)
        thisword.i = ""
        number.i.format = "roman"
        if firstnumber = "" then do
            firstnumber = number.i-1
            pagenumberpos = i
            end
        end

    end


if choice = 1 then do
    box = numberbox
    if box = 0 then break
    boxsize = ppm_GetBoxSize(box)
    boxwidth = word(boxsize,1)
    boxheight = word(boxsize,2)
    position = ppm_GetBoxPosition(box)
    posX = word(position,1)
    posY = word(position,2)
    call ppm_DeleteBox(box)
    end

if choice~=0 then do
    LR = "right"
    if posX < (OldPageX/2) then LR = "left"
    if (LR = "left" & (posX+boxwidth)>(OldPageX/2)) then LR = "middle"
    select
        when (LR = "left"|LR = "middle") then do
            boxLL = posX
            boxRL = oldpageX-(posX+boxwidth)
            boxoffset = (pageoffset*2)-1
            if pageoffset = 0 then do
                LRchoice = ppm_Inform(2,"Which number is this?","Last page","First page")
                if LRchoice = 1 then boxoffset = 0
                if LRchoice = 0 then boxoffset = (totalpages*2)-1
                end
            end
        when LR = "right" then do
            boxLL = oldpageX-(posX+boxwidth)
            boxRL = posX
            boxoffset = (pageoffset*2)
            end
        end


    if firstnumber = "" then firstnumber = 0
    firstnumber = firstnumber-boxoffset /* In case you pick a box not on first page */

    lastnumber = (totalpages*2)+firstnumber
    do i = 1 to totalpages
        thispage = ppm_GoToPage(i)
        oldbox = ppm_BoxAtPosn(boxLL,posY,thispage)
        if oldbox~=0 then call ppm_DeleteBox(oldbox)
        Lbox = ppm_CreateBox(boxLL,posY,boxwidth,boxheight,0)
        Lnumber = ((i-1)*2)+firstnumber
        Lmessage = ""
        do w = 1 to words(legend)
            outnumber = number.w /* usually null */
            if w = pagenumberpos then do
                outnumber = Lnumber
                if (i=1 & number.w~="") then outnumber = lastnumber
                end
            if number.w.format = "roman" then outnumber = roman(outnumber)
            Lmessage = Lmessage||typecode1.w|| outnumber|| thisword.w|| typecode2.w||" "
            end
        overflow = ppm_TextIntoBox(Lbox,Lmessage)
        if overflow = 1 then call ppm_SetBoxSize(Lbox, boxwidth*2, boxheight*2)

        oldbox = ppm_BoxAtPosn(boxRL,posY,thispage)
        if oldbox~=0 then call ppm_DeleteBox(oldbox)
        Rbox = ppm_CreateBox(boxRL,posY,boxwidth,boxheight,0)
        Rnumber = ((i*2)-1)+firstnumber
        Rmessage = ""
        do w = 1 to words(legend)
            outnumber = number.w
            if w = pagenumberpos then outnumber = Rnumber
            if number.w.format = "roman" then outnumber = roman(outnumber)
            Rmessage = Rmessage||typecode1.w|| outnumber|| thisword.w|| typecode2.w||" "
            end
        overflow = ppm_TextIntoBox(Rbox,Rmessage)
        if overflow = 1 then call ppm_SetBoxSize(Rbox, boxwidth*2, boxheight*2)
        end /* i=1 to toalpages */

    end

call ppm_GoToPage(dfirstpage)
call ppm_DeleteBox(littlebox)
mainchoice = ppm_Inform(3,"What do you want to do?","Basic Layout","Exit from Genie","Convert for Printing") /* 0 for layout, 1 for numbering, 2 for conversion */
if mainchoice = 1 then call exit_msg("Done")
else return mainchoice

/* ++++++++++++++++++++++++++++++  +++++++++++++++++++++++++++++++++ */

/* This converts the document into a set of .eps files for printing */
conversion:
call pagecheck()
call docsaver()
/* Save all pages as .eps files */

oldpsout = ppm_GetPSOutput()
oldOrient = ppm_GetPSOutputOrient()
oldPageSize = ppm_GetPSPageSize()
oldDownLoad = ppm_GetPSFontDownload()
call ppm_SetPSFontDownload(0)
oldEPSF = ppm_GetPSEPSF()
call ppm_SetPSEPSF(1)

length2 = length(newname)
epsname = substr(newname,1,length2-5) /* strip off ".bklt" */
do i = 1 to totalpages
     /* .eps is only as big as the boxes, not the page, so make a page-size box. */
    statusmessage = "  Saving page "i" as EPS file"
    call ppm_ShowStatus(statusmessage)
    newpage = ppm_GotoPage(i)
    pagebox = ppm_CreateBox(0,0,oldpageX,oldpageY,0)
    call ppm_SetPSOutputOrient(i,1)
    call ppm_SetPSPageSize(oldpageX,oldpageY)
    call ppm_SetPSOutput(epsname||i||".eps")
    success = ppm_PrintPagePS(i,1,1)
    if success = 0 then exit_msg("Failed saving .eps of page "i)
    end

call ppm_DeletePage(1,totalpages)
freshpage = ppm_CreatePage(1,1,0,0)
call ppm_SetPageSize(1,oldpageX,oldpageY)
/* The next 2 lines assume you are printing to a normal A4 or A3 printer */
if oldpageX>oldpageY then call ppm_SetPSPageSize(oldpageY,oldpageX)
if oldpageX>oldpageY then call ppm_SetPSOutputOrient(1,2)
done = ppm_CopyPage(1,1,totalpages-1)


offset = oldpageX/2
offset = -offset
pages = 2*totalpages /* 2 pages on each side of the paper */
do i = 1 to totalpages
    statusmessage = "  Creating new page "i
    call ppm_ShowStatus(statusmessage)
    newpage = ppm_GotoPage(i)
    Lbox = ppm_CreateBox(0,0,oldpageX/2,oldpageY,0)
    Rbox = ppm_CreateBox(oldpageX/2,0,oldpageX/2,oldpageY,0)

    if i//2=1 then   /* check for odd number pages */
        do
        j = (i-1)/2
        if j=0 then j=totalpages
        k = (totalpages+1)-j  /* Formula for left page, odd sides */
        m = (i+1)/2  /* Right page, odd sides */
        done = ppm_ImportEPSF(Lbox,epsname||k||".eps")
/*        if done = 0 then exit_msg("Trouble importing "epsname||k||".eps")
n.b. Had to remove error check because of bug in ProPage 4.1  */
        done = ppm_ImportEPSF(Rbox,epsname||m||".eps")
 /*       if done = 0 then exit_msg("Trouble importing "epsname||m||".eps")*/
        end
    else do
        n = (i/2)+1  /* Left page, even sides */
        p = (totalpages+1)-(i/2)  /* Right box, even sides */
        done = ppm_ImportEPSF(Rbox,epsname||p||".eps")
/*        if done = 0 then exit_msg("Trouble importing "epsname||p||".eps")*/
        done = ppm_ImportEPSF(Lbox,epsname||n||".eps")
/*        if done = 0 then exit_msg("Trouble importing "epsname||n||".eps")*/
        end


    /* Must set scale before offset as it scales the offset */
    call ppm_SetBoxScale(Lbox,1,1)
    call ppm_SetBoxScale(Rbox,1,1)
    call ppm_SetBoxOffset(Rbox,offset,0)
    end


/* Separate the odd and even sides for double-sided printing */
do i = totalpages-1 to totalpages/2 by -1
        done = ppm_MovePage(i,1)
    end
newpage = ppm_GotoPage(1)


call ppm_SetPSOutput(oldpsout)
call ppm_SetPSoutputOrient(oldOrient)
call ppm_SetPSPageSize(oldPageSize)
call ppm_SetPSFontDownLoad(oldDownLoad)
call ppm_SetPSEPSF(oldEPSF)

call exit_msg("Booklet now converted ready for Postscript printing")
exit

/* +++++++++++++++++++++++++++++++++  ++++++++++++++++++++++++++++ */

/*exit_msg: procedure expose oldpsout*/
do
parse arg message
    if message ~= '' then call ppm_Inform(1, message,"Resume" )
    call ppm_AutoUpdate(1)
    call ppm_ClearStatus()
    call ppm_SetBatchMode(1)
    exit
end


/* ++++++++++++++++++++++++++++++++=  +++++++++++++++++++++++++++++ */

/* Procedure to read in Roman Numerals  */
unroman: procedure
parse arg nums

answer = 0
nums = upper(nums)
nums = space(nums,0)
if verify(nums,"IVXLCDM") ~= 0 then do
    answer = "Bad characters"
    return 0
    end

/* padded so that each occupies 5 spaces */
digits =   " I    II   III  IV   V    VI   VII  VIII IX  "
tens =     " X    XX   XXX  XL   L    LX   LXX  LXXX XC  "
hundreds = " C    CC   CCC  CD   D    DC   DCC  DCCC CM  "
/*          111112222233333444445555566666777778888899999  (check padding)  */

pos1 = pos("I",nums)
pos2 = pos("V",nums)
select
    when pos1=0 & pos2 = 0 then position = 0
    when pos2 = 0 & pos1 ~=0 then position = pos1
    when pos1 = 0 & pos2 ~=0 then position = pos2
    otherwise position = min(pos1,pos2)
    end

if position ~=0 then do
    digs = substr(nums,position)
    nums = left(nums,position-1)
    if digs = "IIII" then decimal = 4
    else decimal =  ((index(digits," "digs))+4)/5
    answer = decimal
    end


pos1 = pos("X",nums)
pos2 = pos("L",nums)
select
    when pos1=0 & pos2 = 0 then position = 0
    when pos2 = 0 & pos1 ~=0 then position = pos1
    when pos1 = 0 & pos2 ~=0 then position = pos2
    otherwise position = min(pos1,pos2)
    end

if position ~=0 then do
    digs = substr(nums,position)
    nums = left(nums,position-1)
    if digs = "XXXX" then decimal = 4
    else decimal =  ((index(tens," "digs))+4)*2
    answer = answer+decimal
    end


pos1 = pos("C",nums)
pos2 = pos("D",nums)
select
    when pos1=0 & pos2 = 0 then position = 0
    when pos2 = 0 & pos1 ~=0 then position = pos1
    when pos1 = 0 & pos2 ~=0 then position = pos2
    otherwise position = min(pos1,pos2)
    end

if position ~=0 then do
    digs = substr(nums,position)
    nums = left(nums,position-1)
    if digs = "CCCC" then decimal = 4
    else decimal =  ((index(hundreds," "digs))+4)*20
    answer = answer+decimal
    end

answer = answer+(length(nums))*1000  /* just count the Ms */

return answer

/* +++++++++++++++++++++++++++++++  ++++++++++++++++++++++++++++++++++++++ */

/* Procedure to convert arabic numbers to Roman numbers  */

roman: procedure
parse arg nums

nums = space(nums,0)
if verify(nums,"1234567890") ~= 0 then do
    answer = "Bad characters"
    return 0
    end

answer = ""

digits = "i ii iii iv v vi vii viii ix"
tens = "x xx xxx xl l lx lxx lxxx xc"
hundreds = "c cc ccc cd d dc dcc dccc cm"

quotient = nums%10
remainder = nums//10
roman = word(digits,remainder)
answer = roman||answer
nums = quotient

quotient = nums%10
remainder = nums//10
roman = word(tens,remainder)
answer = roman||answer
nums = quotient

quotient = nums%10
remainder = nums//10
roman = word(hundreds,remainder)
answer = roman||answer
nums = quotient

do i = 1 to nums
    answer = "m"||answer
    end

return answer




/* +++++++++++++++++++++++++++++  ++++++++++++++++++++++++++++++++ */


docsaver:
prevdoc  = ppm_GetDocName()
if ppm_DocChanged() then do
    if ppm_SavedDate() = "Not Saved" then prevdoc = ""
    samessage = "You must save the current document first. Save and continue?"
    if ppm_Inform(2,samessage , "Cancel", "Ok") then call ppm_SaveDocument(prevdoc)
    else exit_msg("Aborted by User")
    prevdoc = ppm_GetDocName()
    end

lpos = lastpos("/",prevdoc)  /* Find end of pathname */
if lpos = 0 then lpos = lastpos(":",prevdoc)
docname = substr(prevdoc,lpos+1)  /* Strip off pathname */
pathname = substr(prevdoc,1,length(prevdoc)-length(docname))
call ppm_SetDocName(docname||".bklt")
if length(docname)>30 then do
    docname = delstr(docname,1,length(docname)-30)
    call ppm_SetDocName(docname)  /* File name only */
    end
newname = ppm_GetDocName()   /* Full name including path */


return


/* +++++++++++++++++++++++++++++  ++++++++++++++++++++++++++++++++++ */

basiclayout:
/* You can change these defaults */
ppnumber = getclip("bookletppnumber")
if ppnumber = "" then ppnumber = 16
pwidth = getclip("bookletpwidth")
if pwidth = "" then pwidth = 148.5
pheight = getclip("bookletpheight")
if pheight = "" then pheight = 210
pcolumns = getclip("bookletpcolumns")
if pcolumns = "" then pcolumns = 1
pgutter = getclip("bookletpgutter")
if pgutter = "" then pgutter = 4
ptmargin = getclip("bookletptmargin")
if ptmargin = "" then ptmargin = 17
pbmargin = getclip("bookletpbmargin")
if pbmargin = "" then pbmargin = 23
pimargin = getclip("bookletpimargin")
if pimargin = "" then pimargin = 20
pomargin = getclip("bookletpomargin")
if pomargin = "" then pomargin = 17
pcreep = getclip("bookletpcreep")
if pcreep = "" then pcreep = 0

layoutform = "How many pages?:"ppnumber||cr||"Page width (mm):"pwidth || cr||"Page height (mm):"pheight || cr || "Columns:"pcolumns ||cr|| "Gutter (mm):"pgutter ||cr ||"Top margin (mm):"ptmargin || cr||"Bottom margin (mm):"pbmargin||cr||"Inner margin (mm):"pimargin ||cr||"Outer margin (mm):"pomargin ||cr||"Creep (mm):"pcreep

layoutspecs = ppm_GetForm("Enter layout details",8, layoutform)
if layoutspecs = '' then exit_msg("Aborted by User")

parse var layoutspecs ppnumber'0a'x pwidth '0a'x pheight '0a'x pcolumns '0a'x ppgutter '0a'x ptmargin '0a'x pbmargin '0a'x pimargin '0a'x pomargin '0a'x pcreep

if ~datatype(ppnumber,n) then exit_msg("Invalid entry "ppnumber)
if ~datatype(pwidth,n) then exit_msg("Invalid entry "pwidth)
if ~datatype(pheight,n) then exit_msg("Invalid entry "pheight)
if ~datatype(pcolumns,n) then exit_msg("Invalid entry "pcolumns)
if ~datatype(pgutter,n) then exit_msg("Invalid entry "pgutter)
if ~datatype(ptmargin,n) then exit_msg("Invalid entry "ptmargin)
if ~datatype(pbmargin,n) then exit_msg("Invalid entry "pbmargin)
if ~datatype(pimargin,n) then exit_msg("Invalid entry "pimargin)
if ~datatype(pomargin,n) then exit_msg("Invalid entry "pomargin)
if ~datatype(pcreep,n) then exit_msg("Invalid entry "pcreep)
call setclip("bookletppnumber",ppnumber)
call setclip("bookletpwidth",pwidth)
call setclip("bookletpheight",pheight)
call setclip("bookletpcolumns",pcolumns)
call setclip("bookletpgutter",pgutter)
call setclip("bookletptmargin",ptmargin)
call setclip("bookletpbmargin",pbmargin)
call setclip("bookletpimargin",pimargin)
call setclip("bookletpomargin",pomargin)
call setclip("bookletpcreep",pcreep)

/* convert to cm */
pwidth = pwidth/10
pheight = pheight/10
pgutter = pgutter/10
ptmargin = ptmargin/10
pbmargin = pbmargin/10
pimargin = pimargin/10
pomargin = pomargin/10
pcreep = pcreep/10

docpages = ppnumber/2
call docsaver()
call ppm_New()
page = ppm_CreatePage(1,1,1,0,0)
call ppm_SetPageSize(page,pwidth*2,pheight)
call ppm_CopyPage(1,1,docpages-1)


pboxwidth = pwidth-(pimargin+pomargin)
pboxheight = pheight-(ptmargin+pbmargin)
prmargin = pwidth+pimargin
pcwidth = (pboxwidth-((pcolumns-1)*pgutter))/pcolumns /* width of 1 column */

oldbox = 0
do i=1 to docpages
    page = ppm_GoToPage(i)
    if i~=1 then do c=1 to pcolumns
        plcleft = pomargin+((pcwidth+pgutter)*(c-1))
        box = ppm_CreateBox(plcleft,ptmargin,pcwidth,pboxheight,0)
        call ppm_LinkBox(oldbox,box)
        oldbox = box
        end
    do c= 1 to pcolumns /* right page */
        prcleft = prmargin+((pcwidth+pgutter)*(c-1))
        box = ppm_CreateBox(prcleft,ptmargin,pcwidth,pboxheight,0)
        call ppm_LinkBox(oldbox,box)
        oldbox = box
        end
    end
i=1 /* do last page of booklet */
page = ppm_GoToPage(i)
do c=1 to pcolumns
    plcleft = pomargin+((pcwidth+pgutter)*(c-1))
    box = ppm_CreateBox(plcleft,ptmargin,pcwidth,pboxheight,0)
    call ppm_LinkBox(oldbox,box)
    oldbox = box
    end


mainchoice = ppm_Inform(3,"What do you want to do now?","Exit","Page Numbering","Convert for Printing") /* 0 for exit, 1 for numbering, 2 for conversion */
if mainchoice = 0 then call exit_msg("Done")
else return mainchoice