HTML Code:
(*
Written by T.K.Egan
12 Feb 2007
inspired by need and http://forums.omnigroup.com/
updated by T.K.Egan
14 Feb 2007
added headers and "editing cells"
updated by M.R.Rayner
May 2012
various tweaks and fixes - works on Lion now
changed week to start on Monday
fixed issue where some months didn't display their last few days
added section to allow you to choose template (or use property)
added property to allow change of font (.dfont type only)
added (random!!) property & dialog picker for colouring etc
requires bsd subsystem and Omnigraffle to be installed
*)
-- preferences (you might edit these...)
property kHorizontalPadding : 10 -- the horizontal page margin
property kVerticalPadding : 10 -- the vertical page margin
property kTitleTextSize : 24
property kHeaderTextSize : 12
property kNormalTextSize : 10
property kUseShortDayNames : true
property ordinalOffset : 7
property myFont : "Monaco" -- for some reason this doesn't work with fonts ending .ttf; only .dfont
property myTemplate : "Blank Landscape"
property myMonthHeaderFill : "linear fill"
property myDayHeaderFill : "linear fill"
property myMonthFillAngle : "90"
property myDayFillAngle : "270"
-- constant data... With so much built in to Applescript these seem like odd omissions - changed from original to start on Monday
set kMonths to {"January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"}
set kFullDayNames to {"Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"}
set kShortDayNames to {"Mon", "Tues", "Wed", "Thur", "Fri", "Sat", "Sun"}
-- program body begins... Editing the below will almost certainly change the program's behavior
if kUseShortDayNames then
set myDays to kShortDayNames
else
set myDays to kFullDayNames
end if
display dialog "First, enter the year this calendar for:" default answer (year of (current date))
set myYear to text returned of result
set myMonth to (choose from list kMonths with prompt "Next, choose the month:" default items {month of (current date) as text} without empty selection allowed and multiple selections allowed)
if myMonth is false then return -- handle what happens if user selects cancel
set myDocumentName to myMonth & " " & myYear as string
set myArgs to (listIndex(myMonth, kMonths) as string) & " " & myYear
set myCalendar to (do shell script "cal " & myArgs)
set AppleScript's text item delimiters to ASCII character 13
set myLines to every text item of myCalendar
set AppleScript's text item delimiters to "" -- always restore delimiters
--first two lines are trash the third line has the day numbers
set myInterestingLine to item 3 of myLines
set myLeadingDayBoxWidthMultiplier to countLeadingSpaces(myInterestingLine) div 3
-- create leading space before month start - and converts week from starting on Sunday to starting on Monday
if myLeadingDayBoxWidthMultiplier is equal to 0 then
set myLeadingDayBoxWidthMultiplier to 6
else
set myLeadingDayBoxWidthMultiplier to myLeadingDayBoxWidthMultiplier - 1
end if
-- for many months the last line is USUALLY blank, the next to last line has the last date. But this assumes all months can
-- be represented in a calendar with 4 or 5 rows, when some need 6 (like July 2012) - and this is what the last, often blank
-- output line from cal is for so it can't just be discarded.
if length of (item -1 of myLines) is greater than 0 then
set myInterestingLine to item -1 of myLines
else
set myInterestingLine to item -2 of myLines
end if
set myLastDay to ((characters (length of myInterestingLine) through -2 of myInterestingLine) as string) as number
if myLastDay is 28 and myLeadingDayBoxWidthMultiplier is 0 then
set rowsInMonth to 4
else if (myLastDay is 30 and myLeadingDayBoxWidthMultiplier is 6) or (myLastDay is 31 and myLeadingDayBoxWidthMultiplier is greater than 4) then
set rowsInMonth to 6
else
set rowsInMonth to 5 -- mostly, months need 5 rows!!
end if
try
set myThemeCol to choose color default color {59110, 59110, 59110}
set themeRed to text item 1 of myThemeCol
set themeGreen to text item 2 of myThemeCol
set themeBlue to text item 3 of myThemeCol
if ((themeRed + themeGreen + themeBlue) as number) is less than 40000 then
-- dark colour selected
set myFillStartCol to {((65535 - themeRed) * 0.2) + themeRed, ((65535 - themeGreen) * 0.2) + themeGreen, ((65535 - themeBlue) * 0.2) + themeBlue}
set myFillEndCol to {((65535 - themeRed) * 0.8) + themeRed, ((65535 - themeGreen) * 0.8) + themeGreen, ((65535 - themeBlue) * 0.8) + themeBlue}
set myFillBlankCol to {((65535 - themeRed) * 0.4) + themeRed, ((65535 - themeGreen) * 0.4) + themeGreen, ((65535 - themeBlue) * 0.4) + themeBlue}
set myFillCol to {((65535 - themeRed) * 0.9) + themeRed, ((65535 - themeGreen) * 0.9) + themeGreen, ((65535 - themeBlue) * 0.9) + themeBlue}
else
-- light colour selected
set myFillStartCol to {themeRed - (themeRed * 0.3), themeGreen - (themeGreen * 0.3), themeBlue - (themeBlue * 0.3)}
set myFillEndCol to {themeRed - (themeRed * 0.1), themeGreen - (themeGreen * 0.1), themeBlue - (themeBlue * 0.1)}
set myFillBlankCol to {((65535 - themeRed) * 0.4) + themeRed, ((65535 - themeGreen) * 0.4) + themeGreen, ((65535 - themeBlue) * 0.4) + themeBlue}
set myFillCol to {((65535 - themeRed) * 0.9) + themeRed, ((65535 - themeGreen) * 0.9) + themeGreen, ((65535 - themeBlue) * 0.9) + themeBlue}
end if
set myFillWeekendCol to myThemeCol
on error
-- if you use properties for these, you'll always get the same "random" numbers!
set myFillStartCol to {random number from 0 to 65535, random number from 0 to 65535, random number from 0 to 65535}
set myFillEndCol to {random number from 0 to 65535, random number from 0 to 65535, random number from 0 to 65535}
set myFillBlankCol to {random number from 0 to 65535, random number from 0 to 65535, random number from 0 to 65535}
set myFillWeekendCol to {random number from 0 to 65535, random number from 0 to 65535, random number from 0 to 65535}
set myFillCol to {random number from 0 to 65535, random number from 0 to 65535, random number from 0 to 65535}
end try
set myTrailingDayBoxWidthMultiplier to 7 - ((myLeadingDayBoxWidthMultiplier + myLastDay) mod 7)
tell application "OmniGraffle Professional 5"
-- Uncomment this section if you want to choose your template each time. Note that many fancy templates don't work!
-- set myTemplates to available templates
-- set AppleScript's text item delimiters to ASCII character 13
-- set myTemplateList to every text item of myTemplates
-- set AppleScript's text item delimiters to "" -- always restore delimiters
-- set myTemplate to (choose from list (every text item of myTemplateList) with prompt "Now choose the template:" without empty selection allowed and multiple selections allowed)
activate
try
make new document with properties {name:myDocumentName, template:myTemplate}
on error
make new document with properties {name:myDocumentName}
end try
end tell
set myDayCounter to 0
set myVerticalCursor to kVerticalPadding
set myHeaderCellHeight to kNormalTextSize * 1.5
tell document myDocumentName of application "OmniGraffle Professional 5"
set myCanvasSize to canvasSize of first canvas
end tell
set myFullWidth to (first item of myCanvasSize as number) - 2 * kHorizontalPadding
set myCalendarDayBoxWidth to myFullWidth div 7
set myCalendarDayBoxHeight to ((second item of myCanvasSize as number) - (2 * kVerticalPadding + myHeaderCellHeight + kTitleTextSize * 1.5)) div (rowsInMonth) -- first two and final lines are bogus
tell document myDocumentName of application "OmniGraffle Professional 5"
--make header
make new shape at end of graphics of first canvas with properties {origin:{kHorizontalPadding, myVerticalCursor}, size:{myFullWidth, kTitleTextSize * 1.5}, draws shadow:false, draws stroke:true, name:"Rectangle", fill:myMonthHeaderFill, gradient angle:myMonthFillAngle, fill color:myFillStartCol, gradient color:myFillEndCol, text:{font:myFont, size:kTitleTextSize, alignment:center, text:myDocumentName}}
set myVerticalCursor to myVerticalCursor + kTitleTextSize * 1.5
repeat with theDay in myDays
make new shape at end of graphics of first canvas with properties {origin:{myDayCounter * myCalendarDayBoxWidth + kHorizontalPadding, myVerticalCursor}, size:{myCalendarDayBoxWidth, myHeaderCellHeight}, draws shadow:false, name:"Rectangle", fill:myDayHeaderFill, gradient angle:myDayFillAngle, fill color:myFillStartCol, gradient color:myFillEndCol, text:{font:myFont, size:kHeaderTextSize, alignment:center, text:theDay}}
set myDayCounter to myDayCounter + 1
end repeat
set myVerticalCursor to myVerticalCursor + myHeaderCellHeight
-- make leader
if myLeadingDayBoxWidthMultiplier is greater than 0 then
make new shape at end of graphics of first canvas with properties {origin:{kHorizontalPadding, myVerticalCursor}, size:{myCalendarDayBoxWidth * myLeadingDayBoxWidthMultiplier, myCalendarDayBoxHeight}, draws shadow:false, name:"Rectangle", fill color:myFillBlankCol}
end if
set myDayCounter to 0
set myDayOfWeekCounter to myLeadingDayBoxWidthMultiplier
-- make normal calendar day boxes
repeat while myDayCounter is less than myLastDay
repeat while myDayOfWeekCounter is less than 7 and myDayCounter is less than myLastDay
if myDayOfWeekCounter is greater than 4 then
-- added a bit of height to the ordinal boxes, and then shifted down the blank boxes - added this as a property so if font size changes it can be easily tweaked
-- draws big empty box
make new shape at end of graphics of first canvas with properties {origin:{myDayOfWeekCounter * myCalendarDayBoxWidth + kHorizontalPadding, myVerticalCursor + kHeaderTextSize + ordinalOffset}, size:{myCalendarDayBoxWidth, myCalendarDayBoxHeight - (kHeaderTextSize + ordinalOffset)}, draws shadow:false, name:"Rectangle", text placement:top, fill color:myFillWeekendCol}
-- draws bigger box around the first one with effect of creating the little date ordinal box
make new shape at end of graphics of first canvas with properties {origin:{myDayOfWeekCounter * myCalendarDayBoxWidth + kHorizontalPadding, myVerticalCursor}, size:{myCalendarDayBoxWidth, myCalendarDayBoxHeight}, draws shadow:false, name:"Rectangle", text placement:top, fill color:myFillWeekendCol, text:{font:myFont, size:kNormalTextSize, alignment:right, text:myDayCounter + 1 as string}}
else
-- added a bit of height to the ordinal boxes, and then shifted down the blank boxes - added this as a property so if font size changes it can be easily tweaked
-- draws big empty box
make new shape at end of graphics of first canvas with properties {origin:{myDayOfWeekCounter * myCalendarDayBoxWidth + kHorizontalPadding, myVerticalCursor + kHeaderTextSize + ordinalOffset}, size:{myCalendarDayBoxWidth, myCalendarDayBoxHeight - (kHeaderTextSize + ordinalOffset)}, draws shadow:false, name:"Rectangle", text placement:top, fill color:myFillCol}
-- draws bigger box around the first one with effect of creating the little date ordinal box
make new shape at end of graphics of first canvas with properties {origin:{myDayOfWeekCounter * myCalendarDayBoxWidth + kHorizontalPadding, myVerticalCursor}, size:{myCalendarDayBoxWidth, myCalendarDayBoxHeight}, draws shadow:false, name:"Rectangle", text placement:top, fill color:myFillCol, text:{font:myFont, size:kNormalTextSize, alignment:right, text:myDayCounter + 1 as string}}
end if
set myDayCounter to myDayCounter + 1
set myDayOfWeekCounter to myDayOfWeekCounter + 1
end repeat
set myDayOfWeekCounter to 0
set myVerticalCursor to myVerticalCursor + myCalendarDayBoxHeight
end repeat
-- make trailing box
if myTrailingDayBoxWidthMultiplier is greater than 0 then
make new shape at end of graphics of first canvas with properties {origin:{kHorizontalPadding + (7 - myTrailingDayBoxWidthMultiplier) * myCalendarDayBoxWidth, myVerticalCursor - myCalendarDayBoxHeight}, size:{myCalendarDayBoxWidth * myTrailingDayBoxWidthMultiplier, myCalendarDayBoxHeight}, draws shadow:false, name:"Rectangle", fill color:myFillBlankCol} --, text:{size:kNormalTextSize}}
end if
end tell
on listIndex(theItem, theList)
repeat with i from 1 to the count of theList
if item i of theList as string = theItem as string then return i
end repeat
return -1
end listIndex
on countLeadingSpaces(theLine)
set myCounter to 1
set myOldDelimiters to AppleScript's text item delimiters
set AppleScript's text item delimiters to ""
set myLineAsCharList to every text item of theLine
set AppleScript's text item delimiters to myOldDelimiters
repeat while item myCounter of myLineAsCharList is " "
set myCounter to myCounter + 1
end repeat
return myCounter - 1
end countLeadingSpaces