/** %% This provides an interactive tutorial for the Oz programming language and for Strasheela. Just start InteractiveTutorial.exe (e.g. at the command line).
%%
%% Please note: whenever you move around your Strasheela folder in your file system (or copy it to another machine), this functor must be recompiled in order to find the example files (e.g. using the Strasheela script upgrade-all.sh). You better first delete the file StrasheelaPrototyper.ozf file by hand.
%%
%% The examples (documentation and code) is all stored in the directory "./TheExamples/" (possibly in subdirectories). They are stored in *.xml files of the following format just (giving some example). Lessons are shown in the alphabetical order of the subdirectories they their *.xml files are contained in and in the order they are stored in the *.xml file. ]

<lesson title="My Test 1">
  <info>this is a test</info>
  <oz>{Browse hi}</oz>
</lesson>
<lesson title="My Test 2">
  <info>
    the
    next
    test is
    this
  </info>
  <oz>{Browse there}</oz>
</lesson>

%% */




%%
%% 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.
%%
%% meanwhile other much other stuff..
%% 

functor

import
   
   %% !! tmp functor until next release with debugged Path of stdlib
   Path at 'x-ozlib://anders/tmp/Path/Path.ozf'

   Parser at 'x-oz://system/xml/Parser.ozf'
   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 core
   Strasheela at 'x-ozlib://anders/strasheela/Strasheela.ozf'
   %% Strasheela extensions
   CTT at 'x-ozlib://anders/strasheela/ConstrainTimingTree/ConstrainTimingTree.ozf'
   Pattern at 'x-ozlib://anders/strasheela/Pattern/Pattern.ozf'
   Motif at 'x-ozlib://anders/strasheela/Motif/Motif.ozf'
   HS at 'x-ozlib://anders/strasheela/HarmonisedScore/HarmonisedScore.ozf'
   Measure at 'x-ozlib://anders/strasheela/Measure/Measure.ozf'
   
export
   Run
      
require
   OS
   
prepare
   %% NB: functor must be re-compiled whenever it is moved in the file system or to another machine (copying the *.ozf file does NOT work)
   CWD = {OS.getCWD}
%   ExamplesDir = DIR#'/TheExamples'
   
define

   ExamplesDir = {Path.make CWD#"/TheExamples/"}

   
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %%
   %% Compiler stuff 
   %%
      
   %% InitCode is placed before every Strasheela example before evaluation
   %%
   %% additional explorer outputs are only suitable if Strasheela init settings (OZRC..) are set properly.
%   InitCode = "{Init.addExplorerOuts_Standard}\n"
   InitCode = ""

   %% 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

   %% Strasheela variables
   Init = Strasheela.init
   GUtils = Strasheela.gUtils
   LUtils = Strasheela.lUtils
   MUtils = Strasheela.mUtils
   Score = Strasheela.score
%   SMapping = Strasheela.sMapping
   SDistro = Strasheela.sDistro
   Out = Strasheela.out
   
   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
			     'QTk': QTk
			     '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 core
			     'Init':Init 'GUtils':GUtils 'LUtils':LUtils 'MUtils':MUtils
			     'Score':Score 'SDistro':SDistro 'Out':Out
			     %% Strasheela extensions 
			     'Pattern':Pattern 'CTT':CTT 'Motif':Motif
			     'HS':HS 'Measure':Measure
			    )

   
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %%
   %% Main Code 
   %%

   
   
   /** %% Defines XML parser (cf. example in http://www.mozart-oz.org/documentation/mozart-stdlib/xml/parser/index.html).
   %% */
   class MyParserClass from Parser.parser 
      meth init
	 M = {New Parser.spaceManager init}
      in
	 {M stripSpace('*' '*')}
%      {M stripSpace('*' 'lesson')}
%      {M preserveSpace('*' 'nfo')}
%      {M preserveSpace('*' 'oz')}
	 Parser.parser,init
	 {self setSpaceManager(M)}
      end
      meth onAttribute(Tag Value)
	 {self attributeAppend(Tag.name#Value)}
      end
      meth onStartElement(Tag Alist Children)
	 Name = Tag.name
      in
	 {self append(
		  Name(
		     alist    : {List.toRecord alist Alist}
		     children : Children))}
      end
   end
   MyParser = {New MyParserClass init}

   /** %% Recursively collect all *.xml pathes contained recursively in MyPath. 
   %% */ 
   fun {CollectXMLFiles MyPath}      
      /** %% Returns true if string S1 is more early in alphabetical order than S2. A shorter but otherwise equal string is more early.. 
      %% */
      fun {StringLessThan S1 S2}
	 if S1 == nil
	 then true
	 elseif S2 == nil
	 then false
	 elseif S1.1 == S2.1
	 then {StringLessThan S1.2 S2.2}
	 else S1.1 < S2.1
	 end
      end
   in
      if {MyPath isDir($)}
      then {LUtils.mappend
	    %% sort alphabetically 
	    {Sort {MyPath readdir($)}
	     fun {$ P1 P2}
		{StringLessThan {P1 toString($)} {P2 toString($)}}
	     end}
	    CollectXMLFiles}
      else
	 if {MyPath extension($)} == "xml" 
	 then [MyPath]
	 else nil
	 end
      end
   end
   fun {GetName Lesson} Lesson.alist.title end
   %% returns content of lesson record of Type (either oz or info), and uses Default in case there is no content or the type does not exist
   fun {GetContent Lesson Type Default}
      X = {LUtils.find Lesson.children
	   fun {$ X} {Label X} == Type end}
   in
      if X == nil then Default
      else
	 if X.children == nil then Default
	 else {ByteString.toString X.children.1.data}
	 end
      end
   end
   fun {GetInfo Lesson} {GetContent Lesson info "No information available."} end
   fun {GetOz Lesson} {GetContent Lesson oz nil} end
   
   /** %% Returns list of example specs in the form Name#OzContent#InfoContent. Name (a string) is the filename without extension, OzContent and InfoContent are strings with the content of the respective fields in the XML file. 
   %% */ 
   fun {ReadExamples}
      {Flatten
       {Map
	{CollectXMLFiles ExamplesDir}
	fun {$ XMLPath}
	   {Map {MyParser parseFile({XMLPath toString($)} $)}
	    fun {$ Lesson}
	       {GetName Lesson}#{GetOz Lesson}#{GetInfo Lesson}
	    end}	  
	end}}
   end   

 %   /** %% Recursively collect all *.oz pathes contained recursively in MyPath. 
%    %% */ 
%    fun {CollectOzFiles MyPath}      
%       /** %% Returns true if string S1 is more early in alphabetical order than S2. A shorter but otherwise equal string is more early.. 
%       %% */
%       fun {StringLessThan S1 S2}
% 	 if S1 == nil
% 	 then true
% 	 elseif S2 == nil
% 	 then false
% 	 elseif S1.1 == S2.1
% 	 then {StringLessThan S1.2 S2.2}
% 	 else S1.1 < S2.1
% 	 end
%       end
%    in
%       if {MyPath isDir($)}
%       then {LUtils.mappend
% 	    %% sort alphabetically 
% 	    {Sort {MyPath readdir($)}
% 	     fun {$ P1 P2} {StringLessThan {P1 toString($)} {P2 toString($)}} end}
% 	    CollectOzFiles}
%       else
% 	 if {MyPath extension($)} == "oz" 
% 	 then [MyPath]
% 	 else nil
% 	 end
%       end
%    end
%    /** %% Get *.nfo path matching OzPath (path of an *.oz file). 
%    %% */
%    fun {GetNfoPath OzPath}
%       {{OzPath dropExtension($)} addExtension("nfo" $)}
%    end
%    /** %% Returns file basename without extension as atom.
%    %% */
%    fun {GetFileName MyPath}
%       {{{MyPath dropExtension($)} basename($)} toAtom($)}
%    end
%    /** %% Read content of file at Path as string. In case an *.nfo file is not found, then "No information available." is return, and "" for all other not found files (i.e. *.oz files).
%    %% */ 
%    fun {GetFileContent MyPath}
%       MyString
%       /** %% Filters out carriage return.
%       %% */
%       fun{Purge MyString}
% 	 {Filter MyString fun {$ Char} {Not Char== &\r} end}
%       end
%    in
%       try
% 	 MyFile={New Open.file init(url:{MyPath toString($)} flags:[read])}
% 	 MyContent={MyFile read(list:$ size:all)}
% 	 {MyFile close}
%       in
% 	 MyString=MyContent
%       catch _ then if {MyPath extension($)} == "nfo"
% 		   then MyString="No information available."
% 		   else MyString=""
% 		   end
%       end
%       {Purge MyString}
%    end
%    /** %% Returns list of example specs in the form Name#OzFileContent#NfoFileContent. Name (a string) is the filename without extension, OzFileContent and NfoFileContent are strings with the content of the respective files. 
%    %% */ 
%    fun {ReadExamples}	
%       {Map
%        {CollectOzFiles ExamplesDir}
% 	fun {$ OzPath}
% 	   {GetFileName OzPath}
% 	   #{GetFileContent OzPath}
% 	   #{GetFileContent {GetNfoPath OzPath}}
% 	end}
%    end
   

   /** %% Start Prototyper (the only thing exported).
   %% */
   proc{Run}
      %% efficiency: use record instead of list with file names as feats (e.g. see loadCurFile)
      TheExamples = {ReadExamples} % list of specs Name#Code#Nfo
      NameList = {List.map TheExamples fun{$ Name#_#_} Name end}
      ListObj		     % the listbox widget to select an example
      NfoText			% the nfo text widget
      CodeText			% the code text widget
      FileNameVar		% the label widget shown at top right
      CurName={NewCell nil}	% the present file name from NameList

      class App
   
	 meth init skip end

	 /** %% Execute example code in CodeText with compiler
	 %% */
	 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
		   _ _}
	       catch E then
		  {Error.printException E}
	       end
	    end
	 end
   
	 meth loadCurFile
	    Name={Access CurName}
	    {FileNameVar set(Name)}
	    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
   
	 meth chgFile
	    Ind={ListObj get(firstselection:$)}
	 in
	    if Ind\=0 then
	       Name={List.nth NameList Ind}
	    in
	       {Assign CurName Name}
	       {NfoText set({fun{$}
				F={List.nth TheExamples Ind}
				C
			     in
				F=_#_#C
				C
			     end})}
	       {self loadCurFile}
	    else
	       {Assign CurName ""}
	       {NfoText set("")}
	       {CodeText set("")}
	    end	    
	 end
      end

      MyApp={New App 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, examples code)")
							     button(glue:s padx:5 pady:5
								    text:"Close"
								    action:toplevel#close
								   ))}
							 show(wait:true modal:true)}
						     end)
				      separator
				      command(text:"Quit"
					      action:proc {$} {Application.exit 0} end
						 % 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:NameList
							width:20
							action:MyApp#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:MyApp#run)
		 button(glue:w padx:5 pady:5
			text:"Revert"
			action:MyApp#loadCurFile)
		))
      Window={QTk.build Desc}
      {Window show}
      {NfoText bind(event:"<FocusIn>"
		    action:proc{$} {ListObj getFocus} end)}
   in
      %% !! T: is this needed
%      {ListObj set(selection:{List.map NameList fun{$ F} F=="Click_here_to_begin" end})}
      {MyApp chgFile}
      {Window show(wait:true)}
   end
end