(* :Title: NCOutput *)

(* :Author: September 1991, by David Hurst (dhurst). *)

(* :Context: NCOutput` *)

(* :History: 
   :9/20/91	Packaged. (dhurst)
   :5/02/92	Debugging, Context problems, etc. (dhurst)
   :5/29/30     Debugging. (dhurst)
*)

(* :Comments:
	Reading the usage statement should be enough to get the program 
	going.  There is a demo used when testing this program 
	commented out at the end of this file.  (dhurst) 
*)

(* :Warnings
	When SetOutput[dot->True, ...] and then looking at
	NCOutputlist, you will see Dot->Dot.  That is because NCM is
	being changed into Dot.
*)

(* :Comments:
	This establishes these new terms in the Global`context,         
	before the NCOutput` package.
*)
dot;
all;
NCOutputlist={ 
     "dummy" -> "dummy", "dummy" -> "dummy", 
     "dummy" -> "dummy", "dummy" -> "dummy", 
     "dummy" -> "dummy" };
Protect[NCOutputlist, NCOutputfunction];

BeginPackage[ "NCOutput`", 
     "Global`", "NCSubstitute`", "NonCommutativeMultiply`" ]

SetOutput::usage =
    "SetOutput[ optionlist, ... ] displays NC-expressions in a \n
    special format without affecting the internal representation of \n
    the expression.  Options are set by typing\n
    \n
    opt -> True, to use the new format.\n
    opt -> False, to return to the default format.
    \n
    \n
    options are:  all, dot, rt, tp, inv, aj
    ";

Begin[ "`Private`" ]

SetOutput[ input__ ]:=
Block[ { e,f1,f2,f3,f4,f5,f6 },
Unprotect[NCOutputlist, NCOutputfunction];

(* :Comments:
	Functions
*)
 e:="dummy"->"dummy";
 f1:=Literal[NonCommutativeMultiply`inv[b_ ]]:> HoldForm[Power[b,"-1"]];
 f2:=Literal[NonCommutativeMultiply`tp[b_]]:>HoldForm[Power[b,"T"]];
 f3:=Literal[NonCommutativeMultiply`aj[b_] ]:>HoldForm[Power[b,"*"]];
 f4:=Literal[NonCommutativeMultiply`rt[b_] ]:>HoldForm[Power[b,"1/2"]];
 f5:=NonCommutativeMultiply->Dot ;
 f6:=Dot->NonCommutativeMultiply;

list=Flatten[{input}];

If[ MemberQ[ list, all->True ], NCOutputlist={f1,f2,f3,f4,f5} ];
If[ MemberQ[ list, all->False ], NCOutputlist={ e,e,e,e,e } ];

If[MemberQ[list, inv->True  ], NCOutputlist[[1]]=f1 ];
If[ MemberQ[ list, inv->False ], NCOutputlist[[1]]=e ];

If[MemberQ[ list, tp->True  ], NCOutputlist[[2]]=f2 ];
If[ MemberQ[ list, tp->False ], NCOutputlist[[2]]=e ];

If[MemberQ[ list, aj->True  ],  NCOutputlist[[3]]=f3 ];
If[ MemberQ[ list, aj->False ], NCOutputlist[[3]]=e ];

If[MemberQ[list,rt->True  ],  NCOutputlist[[4]]=f4 ];
If[ MemberQ[ list, rt->False ], NCOutputlist[[4]]=e ];

If[MemberQ[list,dot->True], NCOutputlist[[5]]=f5 ];
If[ MemberQ[ list,dot->False ], NCOutputlist[[5]]=e ];

(* :Comments:
	$PrePrint Function
	The Union[NCOutputlist] minimizes the length of the list, 
	especially when it can contain many copies of the 'dummy' rule.
*)	
NCOutputfunction[X_]:=
     Block[{ tmp },
	  tmp:=Transform[X,Union[NCOutputlist]];
	  Return[tmp]
     ];

Protect[NCOutputlist, NCOutputfunction];

$PrePrint:=NCOutputfunction;

]

End[ ]

EndPackage[ ]


(* :Demo

SetNonCommutative[ B1,B2,C2,XX,C1,YY];

ff = -a**rt[C2] ** aj[XX] ** tp[C1] ** C1 ** tp[YY] - 
b**rt[C2] ** aj[XX] ** XX ** B2 ** inv[d12] ** C1 ** tp[YY] - c**rt[C2] ** aj[XX] ** tp[C1] ** inv[tp[d12]] ** tp[B2] ** XX ** tp[YY] - d**rt[C2] ** aj[XX] ** XX ** inv[1 - YY ** XX] ** B1 ** inv[d21] ** C2 ** tp[YY] - e**rt[C2] ** aj[XX] ** XX ** inv[1 - YY ** XX] ** B1 ** tp[B1] ** XX ** tp[YY];

 (* a0 *)
Clear[a0]
a0/: a0 := Message[SetOutput::usage]


 (* a1 *)
Clear[a1]
a1/: a1 := (Print["Here is an exp ="]; ff)
 

 (* a2 *)
Clear[a2]
a2/: a2 := (Print["all->True"]; SetOutput[Global`all -> True]; ff)
 

 (* a3 *)
Clear[a3]
a3/: a3 := (Print["all->False"]; SetOutput[Global`all -> False]; ff)
 
 (* a4 *)
Clear[a4]
a4/: a4 := (Print["dot->True"]; SetOutput[Global`dot -> True]; ff)
 

 (* a5 *)
Clear[a5]
a5/: a5 := (Print["dot->True, aj->True"]; SetOutput[Global`dot -> True, aj -> True]; ff)
 

 (* a6 *)
Clear[a6]
a6/: a6 := (Print["all->False, inv->True, tp->True"]; 
     SetOutput[Global`all -> False, inv -> True, tp -> True]; ff)
 
 (* a7 *)
Clear[a7]
a7/: a7 := (Print["here is a complicated nested expression =", 
      gg := inv[tp[rt[aj[k]]]]; gg]; SetOutput[Global`all -> True]; 
     Print["all->True"]; gg)
 
 (* a8 *)
Clear[a8]
a8/: a8 := (Print["Let's turn off some options and turn some on."]; 
     SetOutput[Global`all -> False, tp -> True, aj -> True]; 
     Print["all->False, tp->True, aj->True"]; inv[tp[rt[aj[k]]]])
 
*)
