draak.dpr

来自「Draak is a multi-language, macro compile」· DPR 代码 · 共 135 行

(* Draak.pas: Please consult the end of this file for copyright information   *)
program cmddraak;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  StrUtils,
  Windows,
  Draak in 'TDraak\Draak.pas';

var draak1: TDraak;
  outFile: TFileStream;
  delay: array of string;
type
  errors = class
    procedure Draak1Error(sender: TObject; s: String);
    procedure Draak1Assemble(sender: TObject; s: String);
    procedure Draak1Compile(sender: TObject; s: String);
  end;

procedure errors.Draak1Error(sender: TObject; s: String);
begin
  writeln(s);
end;

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

procedure errors.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 go;
var loadedFile: string;
    ext: string;
    name: string;
    noext: string;
    cdir: string;
    lPath: PChar;
    e: errors;
    i: word;
begin
  writeln('Draak Compiler');

  cdir := ParamStr(0);
  writeln(ParamStr(1));
  while cdir[length(cdir)] <> '\' do
    delete(cdir, length(cdir), 1);
  delete(cdir, length(cdir), 1);
  if paramcount > 0 then 
    loadedFile := paramstr(1);
  if loadedFile = '' then
  begin
    draak1 := TDraak.create(nil);
    e := Errors.Create;
    draak1.onStatus := e.Draak1Error;
    draak1.produceCopyright;
    writeln('Usage: '+ParamStr(0)+' file.ext');
    exit;
  end;
  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);
  draak1 := TDraak.create(nil);
  draak1.Flags := [timeStat];
  outFile := TFileStream.Create(noext+'.asm', fmCreate);
  try
    e := Errors.Create;
    draak1.SearchPath := '.;'+cdir+';'+cdir+PathDelim+ext;
    draak1.onError := e.Draak1Error;
    draak1.onStatus := e.Draak1Error;
    draak1.onAssemble := e.Draak1Assemble;
    draak1.onLink := e.Draak1Assemble;
    draak1.onCompile := e.Draak1Compile;
//    draak1.parse(Paramstr(1));
    draak1.compile(outFile, Paramstr(1));
  finally
    outFile.Destroy;
  end;
    if draak1.success = true then
    begin
      writeln('Compiled!');
      if length(delay) <> 0 then
        for i := 0 to length(delay)-1 do
          WinExec(PChar(delay[i]), Windows.SW_NORMAL);
    end;
end;

begin
  go;
//  readln;
(* ************************************************************ *)
(* Copyright (c) 1999-2003 Jon Gentle, All right reserved.      *)
(* ************************************************************ *)
(* This software is given As-Is.  No warranties of any kind,    *)
(* implied or expressed, are given to anyone.  The author(s)    *)
(* shall not be held for any liability under any circumstances. *)
(* Permission is granted to anyone who wishes to alter, use or  *)
(* distribute this software, as long as the following           *)
(* restrictions are met:                                        *)
(*                                                              *)
(* 1) The above copyright and this notice must appear in the    *)
(* software in source code form.  Under no circumstance are     *)
(* these to be removed.                        	                *)
(* 2) The above copyright notice must appear in the software in *)
(* binary form	                                                *)
(* 3) Anyone other then the copyright owner that alters source  *)
(* code must mark the source code and resulting binary form as  *)
(* altered.                                                     *)
(* 4) Original authorship of part or whole must not be          *)
(* misrepresented.                                              *)
(* 5) Any original or modified source code under this licence   *)
(* must be made available upon request.                         *)
(* ************************************************************ *)

end .