tree.pas

Draak is a multi-language, macro compiler, meaning all syntax and code generation is defined in a si

(* tree.pas: Please see the end of treedraak.dpr for copyright information    *)
(* This file may NOT be distributed without treedraak.dpr and is under the    *)
(* same licence agreement as treedraak.dpr.                                   *)
unit tree;

interface

uses
  SysUtils, Classes, Controls, Forms, Dialogs, ExtCtrls, StdCtrls,
  ComCtrls, parser, filedrv, contnrs, Draak;
type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    CompileButton: TButton;
    Panel1: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TreeView2: TTreeView;
    Memo1: TMemo;
    TabSheet4: TTabSheet;
    Memo2: TMemo;
    LoadButton: TButton;
    OpenDialog1: TOpenDialog;
    Draak1: TDraak;
    DebugButton: TButton;
    Compile: TCheckBox;
    Stats: TCheckBox;
    TabSheet5: TTabSheet;
    Memo3: TMemo;
    AsmLink: TCheckBox;
    RatioBox: TEdit;
    Total: TLabel;
    TotalBox: TEdit;
    Filled: TLabel;
    FilledBox: TEdit;
    Ratio: TLabel;
    Panel2: TPanel;
    MemBox: TEdit;
    Mem: TLabel;
    procedure CompileButtonClick(Sender: TObject);
    procedure LoadButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Draak1Error(sender: TObject; s: String);
    procedure Draak1NodeCreate(sender: TObject; s: String);
    procedure Draak1NodeChild(sender: TObject; s: String);
    procedure Draak1NodePop(sender: TObject; s: String);
    procedure Draak1Compile(sender: TObject; s: String);
    procedure Draak1Assemble(sender: TObject; s: String);
    procedure DebugButtonClick(Sender: TObject);
    procedure Draak1Status(sender: TObject; s: String);
    procedure Draak1Stream(sender: TObject; s: String);
  private
    loadedFile: string;
    ext: string;
    name: string;
    noext: string;
    cdir: string;
    delay: array of string;
    nodes: TStack;
    debug: boolean;
    procedure recurse(node: PParseNode);
  end;

  b = object
    public
      a: word;
    protected
      b: byte;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses strUtils, windows;
var a: TStack;

procedure TForm1.recurse(node: PParseNode);
var i: word;
begin
  if node = nil then exit;
  a.push(TreeView1.Items.AddChild(a.peek, node.point.name));
  for i := 1 to length(node.children) do
  begin
    if node.children[i-1] <> nil then recurse(node.children[i-1])
    else TreeView1.Items.AddChild(a.peek, 'Unused');
  end;
  a.pop;
end;


procedure TForm1.CompileButtonClick(Sender: TObject);
var  f: TFile; current: TTreeNode; s: string;
  outStream: TFileStream; i: word;
  totalNum, filledNum: cardinal; counted: boolean;
begin
  draak1.onError := Draak1Error;
  system.ChDir(cdir+PathDelim+'..');
  PageControl1.ActivePageIndex := 2;
  if TreeView1.Items.GetFirstNode.getFirstChild <> nil then
    TreeView1.Items.GetFirstNode.DeleteChildren;
  Memo1.Lines.Clear;
  TreeView2.Items.Clear;
  a := TStack.Create;
  nodes := TStack.Create; nodes.push(Form1.TreeView1.Items.GetFirstNode);
  outStream := TFileStream.Create(noext+'.asm', fmCreate);
  try
    draak1.clearGrammer;
    if Stats.Checked = true then
      Draak1.onStatus := Draak1Status
    else
    	Draak1.onStatus := nil;
    if Compile.Checked = true then
      draak1.compile(outStream, loadedFile)
    else
    	draak1.parse(loadedFile);
    if draak1.rootNode <> nil then
    begin
      a.Push(TreeView1.TopItem);
      recurse(draak1.rootNode);
      a.pop;
    end;
    outStream.Position := 0;
    Memo1.Lines.LoadFromStream(outStream);
  finally
    outStream.Destroy;
  end;
    f := TFile.init(ext+PathDelim+ext+'.gmr');
    current := TreeView2.Items.GetFirstNode;
    filledNum := 0; totalNum := 0; counted := false;
    while f.eof <> true do
    begin
      s := f.getLine;
      if s = '' then continue;
      if s[1] = '#' then continue;
      if s[1] <> '<' then
      begin
        TreeView2.Items.AddChild(current, s);
        if counted = false then begin inc(filledNum); counted := true; end;
      end
      else
      begin
        inc(totalNum); counted := false;
        current := TreeView2.Items.Add(current, s)
      end;
    end;
    TotalBox.Text := IntToStr(totalNum);
    FilledBox.Text := IntToStr(filledNum);
    RatioBox.Text := FloatToStrF((filledNum/totalNum)*100, ffFixed, 3, 3);
    MemBox.Text := intToStr(AllocMemSize);
  nodes.Destroy;
  if (length(delay) <> 0) AND AsmLink.Checked = true then
     for i := 0 to length(delay)-1 do
      if WinExec(PChar(delay[i]), SW_HIDE) <> 0 then ;
end;

procedure TForm1.LoadButtonClick(Sender: TObject);
var lPath: PChar;
begin
  if OpenDialog1.Execute = false then
    exit;
  loadedFile := OpenDialog1.Files[0];
  ext := AnsiStrRScan(PChar(loadedFile), '.')+1;
  lPath := AnsiStrRScan(PChar(loadedFile), PathDelim);
  if lPath <> nil then
    name := lPath+1
  else
    name := loadedFile;
  noext := Leftstr(name, AnsiPos('.', name)-1);
  Memo2.Lines.LoadFromFile(loadedfile);
  CompileButton.SetFocus;
end;

procedure TForm1.FormCreate(Sender: TObject);
var lPath: PChar;
begin
  cdir := ParamStr(0);
  while cdir[length(cdir)] <> PathDelim do
    delete(cdir, length(cdir), 1);
  delete(cdir, length(cdir), 1);
  loadedFile := 'c:\devel\delphi6\projects\draak\a1.pas';
  ext := AnsiStrRScan(PChar(loadedFile), '.')+1;
  lPath := AnsiStrRScan(PChar(loadedFile), PathDelim);
  if lPath <> nil then
    name := lPath+1
  else
    name := loadedFile;
  noext := Leftstr(name, AnsiPos('.', name)-1);
  Memo2.Lines.LoadFromFile(loadedfile);
  MemBox.Text := intToStr(AllocMemSize);
//  CompileButton.SetFocus;  
end;

procedure TForm1.Draak1Error(sender: TObject; s: String);
begin
  application.MessageBox(PChar(s), 'Draak Error');
end;

procedure TForm1.Draak1NodeCreate(sender: TObject; s: String);
begin
  nodes.push(Form1.TreeView1.Items.AddChild(TTreeNode(nodes.peek), s));
end;

procedure TForm1.Draak1NodeChild(sender: TObject; s: String);
begin
  TreeView1.Items.AddChild(TTreeNode(nodes.peek), s);
end;

procedure TForm1.Draak1NodePop(sender: TObject; s: String);
begin
  TTreeNode(nodes.Peek).Text := TTreeNode(nodes.Peek).Text+s; nodes.Pop;
end;

procedure TForm1.Draak1Compile(sender: TObject; s: String);
var outStream: TFileStream;
  noext: string;
begin
  noext := Leftstr(s, AnsiPos('.', s)-1);
  outStream := TFileStream.Create(noext+'.asm', fmCreate);
  try
    Draak1.compile(outStream, trim(s));
  finally
    outStream.Destroy;
  end;
end;

procedure TForm1.Draak1Assemble(sender: TObject; s: String);
begin
  setLength(delay, length(delay)+1);
  delay[length(delay)-1] := s;
end;

procedure TForm1.DebugButtonClick(Sender: TObject);
begin
  if debug = false then
  begin
    DebugButton.Caption := 'Normal Tree';
    Draak1.onNodeCreate := Draak1NodeCreate;
    Draak1.onNodeChild := Draak1NodeChild;
    Draak1.onNodePop := Draak1NodePop;
    debug := true;
  end else
  begin
    DebugButton.Caption := 'Debug Tree';
    Draak1.onNodeCreate := nil;
    Draak1.onNodeChild := nil;
    Draak1.onNodePop := nil;
    debug := false;
  end;
end;

procedure TForm1.Draak1Status(sender: TObject; s: String);
begin
  Application.MessageBox(PChar(s), 'Status')
end;

procedure TForm1.Draak1Stream(sender: TObject; s: String);
begin
  memo3.Lines.Append(s);
end;

end.