%%
%% This functor offers a Prototyper for Strasheela examples, the code
%% is a slightly modified version of the QTk Prototyper by Donatien Grolaux
%% (see copyright notice).
%%
%% The compiler created by this functor is independent from any OZRC,
%% and thus these examples can be tried out even if OZRC has not been
%% set up properly -- only a full Strasheela installation is sufficient. 
%% Problem: this way I have no software to playback the music output...
%% For now, just make output dir explicit in examples code and let user open output with their own app..
%% Still, paths to external apps like lily and csound are still problematic. So, I should first do my output GUI before I release this..
%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%                                                                      %%
%% QTk                                                                  %%
%%                                                                      %%
%%  (c) 2000 Université catholique de Louvain. All Rights Reserved.     %%
%%  The development of QTk is supported by the PIRATES project at       %%
%%  the Université catholique de Louvain.  This file is subject to the  %%
%%  general Mozart license.                                             %%
%%                                                                      %%
%%  Author: Donatien Grolaux                                            %%
%%                                                                      %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%
%% Changes to original QTk Prototyper:
%%
%% Replaced directory PrototyperData and the contained examples with directory of Strasheela examples
%%
%% Added further functor variables in the environment of the call Compiler.evalExpression and also imported these functors.
%%
%% Added initialisation code for each Strasheela example (i.e. '{Init.addExplorerOuts_Standard}')
%%
%% !! Hack: exported text handlers to make font changes possible -- this should be done internally.
%%


functor

import
   QTk at 'x-oz://system/wp/QTk.ozf'

   %% General Oz stuff
   Compiler Open OS System Application Error
   Browser Combinator CompilerPanel Connection DistributionPanel DPControl DPInit DPStatistics DefaultURL Discovery  Emacs ErrorListener ErrorRegistry EvalDialog Explorer FD FS Fault Finalize Gump GumpParser GumpScanner Inspector Listener Macro Module Narrator OPI OPIEnv OPIServer ObjectSupport OsTime Ozcar OzcarClient Panel Pickle Profiler Property RecordC Remote Resolve Schedule Search Service Space Tix Tk TkTools Type URL VirtualSite 
   
   %% Strasheela stuff
   Init at 'x-ozlib://anders/strasheela/Init.ozf'
   GUtils at 'x-ozlib://anders/strasheela/GeneralUtils.ozf'
   LUtils at 'x-ozlib://anders/strasheela/ListUtils.ozf'
   MUtils at 'x-ozlib://anders/strasheela/MusicUtils.ozf'
   Score at 'x-ozlib://anders/strasheela/ScoreCore.ozf'
   Pattern at 'x-ozlib://anders/strasheela/Pattern.ozf'
   SDistro at 'x-ozlib://anders/strasheela/ScoreDistribution.ozf'
   Out at 'x-ozlib://anders/strasheela/Output.ozf'
   
export
   Run
   %% tmp export
   NfoText
   CodeText
   
require OS
prepare
   DIR = {OS.getCWD}
   ExamplesDir = DIR#"/TheExamples"
   
define
   %% !! tmp Hack: take two variables out of Run and export
   NfoText			
   CodeText

      
   %% InitCode is placed before every Strasheela example before evaluation
   InitCode = "{Init.addExplorerOuts_Standard}\n"

   %% CompilerEnvironment copied from OzCompiler..   
   Browse = Browser.browse
   Inspect = Inspector.inspect
   %%
   ExploreAll = Explorer.all
   ExploreBest = Explorer.best
   ExploreOne = Explorer.one
   SearchAll = Search.base.all
   SearchBest = Search.base.best
   SearchOne = Search.base.one
   Print = System.print
   Show = System.show
   Load = Pickle.load
   Save = Pickle.save
   Apply = Module.apply
   Link = Module.link
   %% class/object 
   BaseObject = Object.base 
   CompilerEnvironment = env('Abs': Abs
			     'Access': Access
			     'Acos': Acos
			     'Adjoin': Adjoin
			     'AdjoinAt': AdjoinAt
			     'AdjoinList': AdjoinList
			     'Alarm': Alarm
			     'All': All
			     'AllTail': AllTail
			     'And': And
			     'Append': Append
			     'Application': Application
			     'Apply': Apply
			     'Arity': Arity
			     'Array': Array
			     'Asin': Asin
			     'Assign': Assign
			     'Atan': Atan
			     'Atan2': Atan2
			     'Atom': Atom
			     'AtomToString': AtomToString
			     'BaseObject': BaseObject
			     'BitArray': BitArray
			     'BitString': BitString
			     'Bool': Bool
			     'Browse': Browse
			     'Browser': Browser
			     'ByNeed': ByNeed
			     'ByNeedFuture': ByNeedFuture
			     'ByteString': ByteString
			     'Ceil': Ceil
			     'Cell': Cell
			     'Char': Char
			     'Chunk': Chunk
			     'Class': Class
			     'Combinator': Combinator
			     'Compiler': Compiler
			     'CompilerPanel': CompilerPanel
			     'CondSelect': CondSelect
			     'Connection': Connection
			     'Cos': Cos
			     'DPControl': DPControl
			     'DPInit': DPInit
			     'DPStatistics': DPStatistics
			     'DefaultURL': DefaultURL
			     'Delay': Delay
			     'Dictionary': Dictionary
			     'Discovery': Discovery
			     'DistributionPanel': DistributionPanel
			     'Emacs': Emacs
			     'Error': Error
			     'ErrorListener': ErrorListener
			     'ErrorRegistry': ErrorRegistry
			     'EvalDialog': EvalDialog
			     'Exception': Exception
			     'Exchange': Exchange
			     'Exp': Exp
			     'ExploreAll': ExploreAll
			     'ExploreBest': ExploreBest
			     'ExploreOne': ExploreOne
			     'Explorer': Explorer
			     'FD': FD
			     'FS': FS
			     'Fault': Fault
			     'Filter': Filter
			     'Finalize': Finalize
			     'Flatten': Flatten
			     'Float': Float
			     'FloatToInt': FloatToInt
			     'FloatToString': FloatToString
			     'Floor': Floor
			     'FoldL': FoldL
			     'FoldLTail': FoldLTail
			     'FoldR': FoldR
			     'FoldRTail': FoldRTail
			     'For': For
			     'ForAll': ForAll
			     'ForAllTail': ForAllTail
			     'ForThread': ForThread
			     'ForeignPointer': ForeignPointer
			     'Functor': Functor
			     'Get': Get
			     'Gump': Gump
			     'GumpParser': GumpParser
			     'GumpScanner': GumpScanner
			     'HasFeature': HasFeature
			     'Inspect': Inspect
			     'Inspector': Inspector
			     'Int': Int
			     'IntToFloat': IntToFloat
			     'IntToString': IntToString
			     'IsArray': IsArray
			     'IsAtom': IsAtom
			     'IsBitArray': IsBitArray
			     'IsBitString': IsBitString
			     'IsBool': IsBool
			     'IsByteString': IsByteString
			     'IsCell': IsCell
			     'IsChar': IsChar
			     'IsChunk': IsChunk
			     'IsClass': IsClass
			     'IsDet': IsDet
			     'IsDictionary': IsDictionary
			     'IsEven': IsEven
			     'IsFailed': IsFailed
			     'IsFloat': IsFloat
			     'IsForeignPointer': IsForeignPointer
			     'IsFree': IsFree
			     'IsFuture': IsFuture
			     'IsInt': IsInt
			     'IsKinded': IsKinded
			     'IsList': IsList
			     'IsLiteral': IsLiteral
			     'IsLock': IsLock
			     'IsName': IsName
			     'IsNat': IsNat
			     'IsNeeded': IsNeeded
			     'IsNumber': IsNumber
			     'IsObject': IsObject
			     'IsOdd': IsOdd
			     'IsPort': IsPort
			     'IsProcedure': IsProcedure
			     'IsRecord': IsRecord
			     'IsString': IsString
			     'IsThread': IsThread
			     'IsTuple': IsTuple
			     'IsUnit': IsUnit
			     'IsVirtualString': IsVirtualString
			     'IsWeakDictionary': IsWeakDictionary
			     'Label': Label
			     'Length': Length
			     'Link': Link
			     'List': List
			     'Listener': Listener
			     'Literal': Literal
			     'Load': Load
			     'Lock': Lock
			     'Log': Log
			     'Loop': Loop
			     'Macro': Macro
			     'MakeList': MakeList
			     'MakeRecord': MakeRecord
			     'MakeTuple': MakeTuple
			     'Map': Map
			     'Max': Max
			     'Member': Member
			     'Merge': Merge
			     'Min': Min
			     'Module': Module
			     'Name': Name
			     'Narrator': Narrator
			     'New': New
			     'NewArray': NewArray
			     'NewCell': NewCell
			     'NewChunk': NewChunk
			     'NewDictionary': NewDictionary
			     'NewLock': NewLock
			     'NewName': NewName
			     'NewPort': NewPort
			     'NewWeakDictionary': NewWeakDictionary
			     'Not': Not
			     'Nth': Nth
			     'Number': Number
			     'OPI': OPI
			     'OPIEnv': OPIEnv
			     'OPIServer': OPIServer
			     'OS': OS
			     'Object': Object
			     'ObjectSupport': ObjectSupport
			     'Open': Open
			     'Or': Or
			     'OsTime': OsTime
			     'Ozcar': Ozcar
			     'OzcarClient': OzcarClient
			     'Panel': Panel
			     'Pickle': Pickle
			     'Port': Port
			     'Pow': Pow
			     'Print': Print
			     'Procedure': Procedure
			     'ProcedureArity': ProcedureArity
			     'Profiler': Profiler
			     'Property': Property
			     'Put': Put
			     'Raise': Raise
			     'Record': Record
			     'RecordC': RecordC
			     'Remote': Remote
			     'Resolve': Resolve
			     'Reverse': Reverse
			     'Round': Round
			     'Save': Save
			     'Schedule': Schedule
			     'Search': Search
			     'SearchAll': SearchAll
			     'SearchBest': SearchBest
			     'SearchOne': SearchOne
			     'Send': Send
			     'Service': Service
			     'Show': Show
			     'Sin': Sin
			     'SiteProperty': SiteProperty
			     'Some': Some
			     'Sort': Sort
			     'Space': Space
			     'Sqrt': Sqrt
			     'String': String
			     'StringToAtom': StringToAtom
			     'StringToFloat': StringToFloat
			     'StringToInt': StringToInt
			     'System': System
			     'Tan': Tan
			     'Thread': Thread
			     'Time': Time
			     'Tix': Tix
			     'Tk': Tk
			     'TkTools': TkTools
			     'Tuple': Tuple
			     'Type': Type
			     'URL': URL
			     'Unit': Unit
			     'Value': Value
			     'VirtualSite': VirtualSite
			     'VirtualString': VirtualString
			     'Wait': Wait
			     'WaitNeeded': WaitNeeded
			     'WaitOr': WaitOr
			     'WeakDictionary': WeakDictionary
			     'Width': Width
			     %%	   
			     %% Strasheela stuff
			     %% !! some Strasheela extensions are still missing here 
			     'Init':Init 'GUtils':GUtils 'LUtils':LUtils 'MUtils':MUtils
			     'Score':Score 'Pattern':Pattern 'SDistro':SDistro 'Out':Out
			    )

 
   /** %% 
   %% */  
   fun{Purge L}
      case L
      of &\r|Ls then {Purge Ls}
      [] Le|Ls then Le|{Purge Ls}
      else nil end
   end

   /** %% 
   %% */
   fun {ReadExamples}
      {List.map
       {List.sort
	{List.map
	 {List.filter {OS.getDir ExamplesDir}
	  fun{$ N}
	     {List.take {Reverse N} 3}=="zo." % file ending by a .oz extension
	  end}	       
	 fun{$ N} {List.take N {Length N}-3} end}
	fun{$ A B}
	   {String.toAtom A}<{String.toAtom B}
	end}
       fun{$ Name}
	  Name#{fun{$}
		   Ret
		in
		   try
		      HOZ={New Open.file init(url:DIR#"/TheExamples/"#Name#".oz" flags:[read])}
		      COZ={HOZ read(list:$ size:all)}
		      {HOZ close}
		   in
		      Ret=COZ
		   catch _ then Ret="" end
		   {Purge Ret}
		end}#{fun{$}
			 Ret
		      in
			 try
			    HOZ={New Open.file init(url:DIR#"/TheExamples/"#Name#".nfo" flags:[read])}
			    COZ={HOZ read(list:$ size:all)}
			    {HOZ close}
			 in
			    Ret=COZ
			 catch _ then Ret="No information available." end
			 {Purge Ret}
		      end}
       end}
   end

   /** %% Start Prototyper (the only thing exported).
   %% */
   proc{Run}
      TheExamples = {ReadExamples}
      FileList
      HomeDir
      FromDirectory
      local
	 P={Application.getCmdArgs plain}
      in
	 FromDirectory=P\=nil
	 HD=if P==nil then "./TheExamples" else P.1 end
	 HomeDir=if {List.last HD}==47 then HD else HD#"/" end
      end
      if FromDirectory then
	 L={List.filter {OS.getDir HomeDir}
	    fun{$ N}
	       {List.take {Reverse N} 3}=="zo." % file ending by a .oz extension
	    end}
      in
	 FileList={List.sort
		   {List.map L fun{$ N} {List.take N {Length N}-3} end}
		   fun{$ A B}
		      {String.toAtom A}<{String.toAtom B}
		   end}
      else
	 FileList={List.map TheExamples fun{$ F} A in F=A#_#_ A end}
      end
      ListObj
      FileNameVar
      CurName={NewCell nil}

      class MyApp
   
	 meth init skip end

	 meth run 
	    Code={LUtils.accum 
		  ["try\n"
		   InitCode
		   {CodeText get($)}
		   "\ncatch E then {Error.printException E} end\nunit\n"]
		  List.append}
	    
	 in
	    thread
	       try
		  %% !!?? for efficiency, I should access OPI compiler instead of creating a new compiler every time with Compiler.evalExpression
		  {Compiler.evalExpression Code
		   CompilerEnvironment
% 		   env('QTk':QTk 'OS':OS 'Compiler':Compiler 'System':System
% 		       'Application':Application
% 		       %'PrototyperData':PrototyperData
% 		       'Open':Open 'Show':System.show
% 		       'Error':Error
% 		       %% Strasheela stuff
% 		       'FD':FD 'FS':FS 'Explorer':Explorer 'Module':Module
% 		       %'TheExamples':TheExamples
% 		       'Init':Init 'GUtils':GUtils 'LUtils':LUtils 'MUtils':MUtils
% 		       'Score':Score 'Pattern':Pattern 'SDistro':SDistro 'Out':Out
% 		      )
		   _ _}
	       catch E then
		  {Error.printException E}
	       end
	    end
	 end
   
	 meth loadCurFile
	    Name={Access CurName}
	    {FileNameVar set(Name)}
	 in
	    if FromDirectory then
	       try
		  HOZ={New Open.file init(url:HomeDir#Name#".oz" flags:[read])}
		  COZ={HOZ read(list:$ size:all)}
		  {HOZ close}
	       in
		  {CodeText set({Purge COZ})}
	       catch _ then {CodeText set("")}
	       end
	    else
	       R
	    in
	       {ForAll TheExamples
		proc{$ F}
		   A B
		in
		   F=A#B#_
		   if A==Name then R=B end
		end}
	       if {IsFree R} then R="" end
	       {CodeText set(R)}
	    end
	 end
   
	 meth chgFile
	    Ind={ListObj get(firstselection:$)}
	 in
	    if Ind\=0 then
	       Name={List.nth FileList Ind}
	    in
	       {Assign CurName Name}
	       if FromDirectory then
		  try
		     HOZ={New Open.file init(url:HomeDir#Name#".nfo" flags:[read])}
		     COZ={HOZ read(list:$ size:all)}
		     {HOZ close}
		  in
		     {NfoText set({Purge COZ})}
		  catch _ then
		     {NfoText set("No information available.")}
		  end
	       else
		  {NfoText set({fun{$}
				   F={List.nth TheExamples Ind}
				   C
				in
				   F=_#_#C
				   C
				end})}
	       end
	       {self loadCurFile}
	    else
	       {Assign CurName ""}
	       {NfoText set("")}
	       {CodeText set("")}
	    end	    
	 end
      end

      App={New MyApp init}

      Desc=td(title:"Strashela Examples"
	      lr(glue:nwe
		 menubutton(glue:w
			    text:"File"
			    menu:menu(command(text:"About"
					      action:proc{$}
							{{QTk.build td(label(text:"Authors : Donatien Grolaux (QTk Prototyper),\nTorsten Anders (Prototyper customisation, Strasheela Examples)")
								       button(glue:s padx:5 pady:5
									      text:"Close"
									      action:toplevel#close))} show(wait:true modal:true)}
						     end)
				      separator
				      command(text:"Exit"
					      action:toplevel#close)))
		 label(glue:e
		       handle:FileNameVar)
		)
	      tdrubberframe(glue:nswe padx:2 pady:2
			    td(glue:nswe
			       lrrubberframe(glue:nswe
					     td(glue:nswe
						listbox(glue:nswe bg:white
							handle:ListObj
							tdscrollbar:true
							init:FileList
							width:20
							action:App#chgFile))
					     td(glue:nswe
						text(glue:nswe bg:white
						     tdscrollbar:true
						     wrap:word
						     handle:NfoText))))
			    td(glue:nswe
			       text(glue:nswe bg:white
				    tdscrollbar:true
				    handle:CodeText)))
	      lr(glue:swe
		 button(glue:w padx:5 pady:5
			text:"Run"
			action:App#run)
		 button(glue:w padx:5 pady:5
			text:"Revert"
			action:App#loadCurFile)
		))
      Window={QTk.build Desc}
      {Window show}
      {NfoText bind(event:"<FocusIn>"
		    action:proc{$} {ListObj getFocus} end)}
   in
      {ListObj set(selection:{List.map FileList fun{$ F} F=="Click_here_to_begin" end})}
      {App chgFile}
      {Window show(wait:true)}
   end
end