How would you do a clickable calendar in Mathematica? - wolfram-mathematica

Has anyone already thought about how to do a clickable calendar in Mathematica? There seems to be something here http://library.wolfram.com/infocenter/Demos/108/, but I quickly tested it and it doesn't seem to work.

The link you provided seems to work, at least partially.
After loading the notebook from the WR site, scanning, applying all the automatically generated suggestions and evaluating it, the following code:
CellPrint[
Cell[BoxData[
GridBox[{{ButtonBox["January 2003",
Background -> RGBColor[0.4, 0, 0.4],
ButtonFunction -> Null]}, {GridBox[
Prepend[monthlayout[1, 2003] /.
i : (_Integer | _String) :>
ButtonBox[i, Background -> RGBColor[1, 0.6, 0.8],
ButtonFunction -> (FrontEndToken["New"] &)],
alldays /.
s_String :>
ButtonBox[s, Background -> RGBColor[0.8, 0.2, 0.6],
ButtonFunction -> Null]]]}}]], "Output"]]
displays a clickable calendar that opens a new notebook when you click on any day button

Here's a slightly more elaborate example:
http://dev.ragfield.com/2009/03/flickcalendar.html

Related

Eventhandler won't let me select graphic when MouseClicked is assigned

I'm trying to digitize points in an image and I would like to use KeyDown events to clear selected points.
For the KeyDown to work the image must be selected by clicking it (orange border shows around the image).
When the MouseClicked is assigned it will register the point in my image, but the image won't be selected, and so the KeyDown won't work.
I've figured out that I can select the image using the right mouse button instead.
I was hoping to find a way to have the code automatically select the image for me as soon as the document is created.
Does anybody know how to do this?
This is for my research so that I can digitize the location of features within an ultrasound image.
I've tried using the SelectionMove[] function in a couple of different ways, but it doesn't work.
CreateDocument[
DynamicModule[
{pnts = {}},
EventHandler[
Show[
img,
Epilog -> {Red, Point[Dynamic[pnts]]}
],
{
{"MouseClicked",
1} :> {AppendTo[pnts, MousePosition["Graphics"]]},
"EscapeKeyDown" :> {pnts = {}}
}
]
]
];
It opens the image, and I can place points. However, I can't clear them with the EscapeKeyDown.
my image -> https://imgur.com/a/qgksuBP
It looks like the problem is vaguely answered in the docs: "For mouse events, EventHandler[expr, ...] handles events for which the mouse is within the rectangular region defined by the display of expr." Implying that keyboard events work differently.
You could use something like this.
pnts = {};
SetOptions[CreateDocument[
EventHandler[Show[img, Epilog -> {Red, Point[Dynamic[pnts]]}],
{"MouseClicked", 1} :> AppendTo[pnts, MousePosition["Graphics"]]]],
NotebookEventActions :> {"EscapeKeyDown" :> (pnts = {})}]

Mathematica : Add text to imported image / graphic as a label

Ive searched for hours ... but Im at a loss !
I have imported an image int Mathematica -> dimensions 2x2cm at 72DPI.
I am trying to "label" the image with a text string that:
- has font color "fontColor"
- has a black outline, so it contrasts to any underlying color
- sits in the bottom right corner of the imported image
- has size h/w in cm
- optionally sits in a text box with a white background
This is how far ive come:
MathCode:
image = Import["myimg.jpg"];
inchFactor = 2.54;(* 1 inch = 2.54cm *)
docRes = 72;
pixelConverter = docRes/inchFactor/2;
myText = First[
First[ImportString[
ExportString[
Style["glorious label string here", Bold, FontSize -> 15,
FontFamily -> "Verdana"], "PDF"], "PDF",
"TextMode" -> "Outlines"]]];
myTextGraphic =
Graphics[{EdgeForm[Directive[Black, Thickness[0.01]]], White,
myText}, Background -> White,
ImageSize -> {10*pixelConverter, 2*pixelConverter}];
myTextGraphic = Rasterize[myTextGraphic];
combined = SetAlphaChannel[myTextGraphic, myTextGraphicAlphaVersion];
I found the above method (PDF wrapper) for the black outline of the text string.
I am adding an AlphaChannel to the graphic of the text string using a version of it that only uses black/white.
I then try to combine the images with Overlay.
As none of this seems to work concerning the outputted image size and positioning, Im kindly asking for help.
There´s no need to "fix" that messy code.
Maybe you could point me to a script or tutorial - all I really want is to add and position a text string or text box to an underlying image.
Thanks a lot !
Have a look at this. There are other ways too.
img = Import["http://todayinsci.com/H/Hilbert_David/HilbertDavidThm.jpg"];
Column[{
img,
Text[Style["Professor Hilbert", Red]]
}]
imgCtr = Round[ImageDimensions[img]/2];
overlay = Framed[Graphics[{Text[Style["Professor Hilbert", Red, 9], imgCtr]},ImageSize-> {66, 14}], FrameStyle -> Green]
Overlay[{img, overlay}, Alignment -> Center]
It's late here so this is only the beginning of a solution for you but here's a simple way to add a text label to an image:
lbl = Graphics[Text[Style["Bottom", Red, Large]]]
which creates an image with the text 'Bottom' in red in a large font. Next, given an image called img1
ImageCompose[img1,lbl]
puts the text in the centre of the image. ImageCompose has options to allow you to position the second image (ie the label) wrt the first image. You can put the label on a coloured background like this:
lbl = Graphics[Text[Style["Bottom", Red, Large, Background -> Blue]]]
I haven't figured out, yet, how to write the text with a coloured outline.

Why does the locator look semi-transparent in this Dynamic graphic?

I want a position a locator on a graphic, and update its position based on the mouse position. Here is some sample code:
Show[{
Graphics[{Yellow, Rectangle[]}],
Graphics[Dynamic[
With[{pt = MousePosition[{"Graphics", Graphics}]},
{ If[pt===None, ,Locator[pt^2]], Text[pt, {0,0}, {-1,-1}] }
]
]]
}, PlotRange -> {{-.2, 1.2},{-.2, 1.2}}]
The weird thing is that sometimes the locator displays normally, sometimes it displays at what looks like half opacity. It flips from normal to half-opacity as I move the mouse around.
Why is this, and what can I do to fix it?
I'm using Mathematica 8 on OSX.

How to fill in CellFrameLabels in Mathematica Notebook Styles?

I have been working on getting numbered cell-frame labels following the great advice in these other answers
Extending cell definition to CellFrameLabels definition
How to Autonumber Cell Tags in Mathematica Notebooks?
and I'm almost there. I wanted to add section numbers to section styles in the Creative / Pastel colors stylesheet. I created a new notebook (here's a copy on my public dropbox)
http://dl.dropbox.com/u/1997638/CellFrameMargins.nb
went to "Format" menu, chose "Stylesheet \ Creative \ PastelColor," then
"Format" "Edit Stylesheet", "Choose a style: Section", then click on Creative\Pastelcolor.nb at the top of the stylesheet-editing dialog.
That opens another stylesheet editor, and I go to the fourth item down "Styles for Title and Section Cells," then the second item in there "Section." Put mouse crosshairs in there and click, then choose "Cell" menu, "Show Expression" item, which reveals the following expression:
Cell[StyleData["Section"],
CellFrame->{{0, 0}, {1, 3}},
CellFrameColor->RGBColor[1., 0.819608, 0.658824],
FontFamily->"Helvetica",
FontSize->18,
FontWeight->"Bold",
FontColor->RGBColor[0.882353, 0.419608, 0.0784314],
Background->RGBColor[1., 0.886275, 0.741176]]
GREAT! Reveals all the details, or so I thought. In particular, the CellFrame item gives me the {{0, 0}, {1, 3}} info I need to line up my cell frame labels with the Section style. Ok, so back to the steylsheet editor dialog for my notebook, and following the aforementioned answers, I type
Cell[
StyleData["Section"],
CellFrameLabelMargins -> 0,
CellFrameLabels-> { {
Cell[
TextData[{ "§", CounterBox["Section"], ": " }],
"SectionLabel",
CellFrame -> {{0, 0}, {1, 3}},
CellFrameMargins -> 4
] (* left label *),
Inherited (* right label *) },
{Inherited (* bottom label *),
Inherited (* top label *) } } ]
The CellFrameMargins -> 4 rule I found by trial-and-error is needed to line up the top and bottom of the cell frame with the rest of the Section style to the right. I'm sad to report that it only almost works. There are gaps between the text of the CellFrameLabels and the frames, and I want to fill in those gaps. It's as though the fonts in the CellFrameLabels don't stretch up and down far enough, even though they're exactly the same as the fonts in the Section cells. I can't find a way to fill in the background behind the labels. I tried Background -> RGBColor[...], I tried putting in explict fonts, I tried setting the CellFrameMargins, and the CellFrameLabelMargins, in many many combinations, but to no avail.
I'm stumped and would appreciate any advice.
This seems to work for the pastel style. What this does is putting the label inside a frame. I had to fiddle a bit with the ImageMargins and FrameMargins of the FrameBox to make everything align.
Cell[StyleData["Section"],
CellFrameLabels->{{
Cell[
BoxData[
FrameBox[
TemplateBox[{"§", CounterBox["Section"], ": "},
"Row",
DisplayFunction->(RowBox[{#, " ", #2}]& )
],
ImageMargins->-1,
Background->RGBColor[1., 0.886275, 0.741176],
FrameStyle->RGBColor[1., 0.886275, 0.741176],
FrameMargins->2
]
],
"SectionLabel", CellFrame -> {{0, 0}, {1, 3}},
CellFrameMargins->0
], Inherited},
{Inherited, Inherited}},
CellFrameLabelMargins->0
]
Screenshot:

Can relative size changes be made to PointSize[], Thickness[] in mathematica?

Arising from this question regarding line thickness and point size setting [e.g. PointSize[Large}, PointSize[0.5]), I was wondering if it is feasible to change PointSize[], Thickness[] etc in a relative manner?
I.e. why is it that PointSize[Larger] doesn't work? Or is possible to somehow query the existing pointsize and perhaps do something likePointSize[1.25*GetPointSize[]] (I haven't been able to figure this out if something like "GetPointSize[]" exists, neither with a quick look at the documentation, nor from a quick reverse-engineering look at PointSize[x])
You can do this using the Style option form of PointSize with Inherited in the value:
Graphics[{Style[{Point[{0, 0}],
Style[{Point[{.2, 0}],
Style[{Point[{.4, 0}],
Style[{Point[{.6, 0}],
Style[{Point[{.8, 0}]}, PointSize -> .9 Inherited]},
PointSize -> .9 Inherited]}, PointSize -> .9 Inherited]},
PointSize -> .9 Inherited]}, PointSize -> .1]}, PlotRange -> 1]
Those options that Mathematica keeps track of are revealed by AbsoluteOptions[]
Try AbsoluteOptions[Graphics[{Point[{0, 0}]}]], for example.
Unfortunately, PointSize is not among the options tracked.
So, why not simply use a variable to store the value to use?
ps = 0.01; Graphics[{PointSize[ps],
Table[Point[{RandomReal[], RandomReal[]}], {i, 100}]}]
Then...
Graphics[{PointSize[ps*2],
Table[Point[{RandomReal[], RandomReal[]}], {i, 100}]}]
I can't comment to Belisarius' "Directive" comments due to lack of points, so I chime in here:
Ragfield's code works, but all PointSize instructions are indeed marked red. Formatted as directives it still works and isn't marked as erroneous too:
Graphics[
{
Style[
{
Point[{0, 0}],
Style[
{
Point[{.2, 0}],
Style[
{
Point[{.4, 0}],
Style[
{
Point[{.6, 0}],
Style[
{
Point[{.8, 0}]
},
PointSize[.9 Inherited]
]
},
PointSize[.9 Inherited]
]
},
PointSize[.9 Inherited]
]
},
PointSize[.9 Inherited]
]
},
PointSize[.1]
]
},
PlotRange -> 1
]
I like a bit of formatting for deeply nested structures like this. Anyone know how you can paste formatted Mma code in Stackoverflow without having to do manual formatting afterwards?
Nice to hear about Inherited BTW. Apparently new since v6, but it flew under my radar.

Resources