1 unit umain;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, FileUtil, SynHighlighterPas, SynEdit, Forms, Controls,
9   Graphics, Dialogs, StdCtrls, BGRAVirtualScreen, BGRABitmap;
10 
11 type
12 
13   { TForm1 }
14 
15   TForm1 = class(TForm)
16     BGRAVirtualScreen1: TBGRAVirtualScreen;
17     Button1: TButton;
18     SynEdit1: TSynEdit;
19     SynFreePascalSyn1: TSynFreePascalSyn;
20     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
21     procedure Button1Click(Sender: TObject);
22     procedure FormCreate(Sender: TObject);
23     procedure FormDestroy(Sender: TObject);
24   private
25     { private declarations }
26   public
27     { public declarations }
28     bmp: TBGRABitmap;
29     idxBmp: integer;
30     procedure UpdateBitmap;
31   end;
32 
33 var
34   Form1: TForm1;
35 
36 implementation
37 
38 uses lpparser, lpcompiler, lputils, lpvartypes, lptypes, lpeval, lpinterpreter,
39   BGRABitmapTypes, ubgralape;
40 
41 {$R *.lfm}
42 
43 procedure MyShowMessage{$I lape.proc}
44 begin
45   Form1.UpdateBitmap;
46   ShowMessage(PlpString(Params^[0])^);
47 end;
48 
49 { TForm1 }
50 
51 procedure TForm1.Button1Click(Sender: TObject);
52 var
53   Parser: TLapeTokenizerBase;
54   Compiler: TLapeCompiler;
55 begin
56   Parser := nil;
57   Compiler := nil;
58   try
59     Parser := TLapeTokenizerString.Create(SynEdit1.Lines.Text);
60     Compiler := TLapeCompiler.Create(Parser);
61 
62     InitializePascalScriptBasics(Compiler, [psiTypeAlias]);
63     ExposeGlobals(Compiler);
64 
65     Compiler.addGlobalFunc('procedure ShowMessage(s: string);', @MyShowMessage);
66 
67     ubgralape.AddScriptSystemTypes(Compiler);
68     ubgralape.AddScriptSystemFunctions(Compiler);
69 
70 //    Compiler.addGlobalMethod('procedure _writeln; override;', @MyWriteLn, Form1);
71 
72 //    c := LapeImportWrapper(@StupidProc, Compiler, 'function(abc: array of integer): array of integer', FFI_SYSV);
73 //    Compiler.addGlobalFunc('function StupidProc(abc: array of integer): array of integer', c.Func);
74 
75     if not Compiler.Compile() then
76       raise Exception.Create('Error');
77 
78     try
79       FreeAndNil(bmp);
80       bmp := TBGRABitmap.Create(BGRAVirtualScreen1.Width,BGRAVirtualScreen1.Height);
81       idxBmp:= ubgralape.RegisterBitmap(bmp);
82       ubgralape.SetTargetBitmap(idxBmp);
83       RunCode(Compiler.Emitter.Code);
84     finally
85       ubgralape.UnregisterBitmap(idxBmp);
86       idxBmp := -1;
87     end;
88   except
89     on E: Exception do
90     begin
91       ShowMessage(E.Message);
92     end;
93   end;
94   If Assigned(Compiler) then
95     FreeAndNil(Compiler)
96   else
97     FreeAndNil(Parser);
98   BGRAVirtualScreen1.DiscardBitmap;
99 end;
100 
101 procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
102 begin
103   Bitmap.DrawCheckers(rect(0,0,Bitmap.Width,Bitmap.Height),BGRAWhite,CSSSilver);
104   if Assigned(bmp) then Bitmap.PutImage(0,0,bmp,dmDrawWithTransparency);
105 end;
106 
107 procedure TForm1.FormCreate(Sender: TObject);
108 begin
109   SynEdit1.Lines.LoadFromFile('tests.pas');
110   bmp := nil;
111   idxBmp := -1;
112 end;
113 
114 procedure TForm1.FormDestroy(Sender: TObject);
115 begin
116   FreeAndNil(bmp);
117 end;
118 
119 procedure TForm1.UpdateBitmap;
120 begin
121   if (idxBmp = -1) or (bmp = nil) then exit;
122   ubgralape.EnsureInvalidate(idxBmp);
123   Form1.BGRAVirtualScreen1.RedrawBitmap;
124 end;
125 
126 end.
127 
128