SHARE
TWEET

Untitled

a guest Aug 20th, 2013 54 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Remove["Gr`*"];
  2. SetAttributes[repr, HoldAllComplete]
  3. repr[exp_, code_] :=
  4.     With[{exp2 = MakeBoxes@exp, body = MakeBoxes@code},
  5.       Block[{$ContextPath = {"System`"}, $Context = "Gr`"},
  6.         SetAttributes[Gr`graphic, HoldAllComplete];
  7.         Gr`graphic[a_] := Module[{c = False, x},
  8.             x = Replace[HoldForm[a], x_[t___] :> With[{newHead = If[
  9.                           NameQ["Gr`" <> SymbolName[x]],
  10.                           Symbol["Gr`" <> SymbolName[x]], c = True; x]
  11.                       }, newHead[t] /; True],
  12.                 1];
  13.             If[c,
  14.              
  15.        x = Replace[x, HoldPattern[x_[t___]] :> Gr`display[x[t]], 1];
  16.               ];
  17.             ReleaseHold@x
  18.             ];
  19.        
  20.         SetAttributes[Gr`display, HoldAllComplete];
  21.         Gr`display[c_] := ToString[Replace[
  22.               HoldForm[c]
  23.               , {
  24.                 HoldPattern[x_[t___]] :>
  25.                   With[{new = Symbol[SymbolName[x]]},
  26.                     new[t] /; True],
  27.                
  28.         HoldPattern[x_Symbol ] :> With[{new = Symbol[SymbolName[x]]},
  29.                     new /; True]
  30.                 }, Infinity], InputForm];
  31.        
  32.         Print@Replace[
  33.             ToExpression[exp2, StandardForm, Hold],
  34.            
  35.       HoldPattern[SetDelayed[x_[y___], z___]] :> With[{newHead = If[
  36.                       Head[x] === Symbol,
  37.                       Symbol["Gr`" <> SymbolName[x]], x
  38.                       ]},
  39.                 SetDelayed[newHead[y], z] /; True], Infinity];
  40.        
  41.         Print@Replace[
  42.             ToExpression[body, StandardForm,
  43.               Hold], {x_[t___] :>
  44.                 With[{new = Symbol[SymbolName[x]]}, new[t] /; True],
  45.              
  46.        x_Symbol :> With[{new = Symbol[SymbolName[x]]}, new /; True]},
  47.             Infinity]
  48.         ]
  49.       ];
  50.  
  51. repr[
  52.   SetAttributes[y, HoldAllComplete];
  53.        y[a__] := (
  54.       Graphics[{Circle[],
  55.           Inset[
  56.             graphic[a]
  57.             , Scaled[{0.498, 0.5020000000000002}], Center,
  58.             Scaled[{0.5, 0.5}]]}, ImagePadding -> 0,
  59.     PlotRangePadding -> 0]
  60.       );
  61.   SetAttributes[x, HoldAllComplete];
  62.        x[a___] :=
  63.               Graphics[{RGBColor[1, 0, 0], Rectangle[{0, 0}]},
  64.                ImagePadding -> 0, ImageSize -> {85., Automatic},
  65.       PlotRangePadding -> 0];
  66.   SetAttributes[Times, HoldAllComplete];
  67.        (* Times[a_, b_] :=
  68.              display[Plus[a, b]]; *)
  69.   , graphic[y[y[a*b]]]
  70.   ]
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top