Browse Source

added let keyword in bgrascript

lainz 11 years ago
parent
commit
b28071b407
3 changed files with 30 additions and 8 deletions
  1. 20 5
      bgrascript.pas
  2. 9 3
      test/test_bgrascript/umain.lfm
  3. 1 0
      test/test_bgrascript/umain.pas

+ 20 - 5
bgrascript.pas

@@ -11,7 +11,7 @@ uses
 {Template}
 procedure SynCompletionList(itemlist: TStrings);
 {Scripting}
-function ScriptCommand(command: string; bitmap: TBGRABitmap): boolean;
+function ScriptCommand(command: string; bitmap: TBGRABitmap; variables: TStringList): boolean;
 function ScriptCommandList(commandlist: TStrings; bitmap: TBGRABitmap): boolean;
 
 {Tools}
@@ -78,7 +78,7 @@ begin
   end;
 end;
 
-function ScriptCommand(command: string; bitmap: TBGRABitmap): boolean;
+function ScriptCommand(command: string; bitmap: TBGRABitmap; variables: TStringList): boolean;
 
   function ParamCheck(passed, mustbe: integer): boolean;
   begin
@@ -99,9 +99,7 @@ var
   list: TStringList;
   passed: integer;
   tmpbmp1: TBGRABitmap;
-  {$ifdef debug}
   i: integer;
-  {$endif}
 begin
   { $ifdef debug}
   //writeln('---Script-Command---');
@@ -112,7 +110,19 @@ begin
   list.CommaText := command;
   passed := list.Count;
 
+  {Replace values in variable names}
+  for i:=0 to list.Count -1 do
+    if variables.Values[list[i]] <> '' then
+      list[i] := variables.Values[list[i]];
+
   case LowerCase(list[0]) of
+    {Assign values to variable names}
+    'let':
+    begin
+      Result := ParamCheck(passed, 3);
+      if Result then
+        variables.Add(list[1] + '=' + list[2]);
+    end;
 
     {TFPCustomImage override}
     'setsize':
@@ -537,6 +547,7 @@ end;
 function ScriptCommandList(commandlist: TStrings; bitmap: TBGRABitmap): boolean;
 var
   i: integer;
+  variables: TStringList;
 begin
   {$ifdef debug}
   //writeln('----SCRIPT--LIST----');
@@ -544,10 +555,14 @@ begin
   writeln('____________________');
   {$endif}
 
+  variables := TStringList.Create;
+
   Result := True;
   for i := 0 to commandlist.Count - 1 do
     if commandlist[i] <> '' then
-      ScriptCommand(commandlist[i], bitmap);
+      ScriptCommand(commandlist[i], bitmap, variables);
+
+  variables.Free;
 
   {$ifdef debug}
   //writeln('----SCRIPT--LIST----');

+ 9 - 3
test/test_bgrascript/umain.lfm

@@ -459,8 +459,11 @@ object Form1: TForm1
       '{ BGRAScript }'
       'FillTransparent'
       ''
+      '// "store some values"'
+      'let oneh 100'
+      ''
       '// "Draw rectangles, lines and bitmap"'
-      'Rectangle 0,0,100,100,"rgba(0,0,0,0.6)","rgba(250,250,250,1)","dmDrawWithTransparency"'
+      'Rectangle 0,0,oneh,oneh,"rgba(0,0,0,0.6)","rgba(250,250,250,1)","dmDrawWithTransparency"'
       'Rectangle 20,20,80,80,"rgba(0,0,0,0.4)","rgba(255,255,255,1)","dmDrawWithTransparency"'
       'SetHorizLine 0,10,98,"rgba(0,0,0,.3)"'
       'SetVertLine 90,1,98,"rgba(0,0,0,.3)"'
@@ -469,13 +472,13 @@ object Form1: TForm1
       '// "Save and weird things step 1"'
       'SaveToFile "file.png"'
       'Negative'
-      'BlendBitmap 0,100,"file.png","boTransparent"'
+      'BlendBitmap 0,oneh,"file.png","boTransparent"'
       ''
       '// "Save and weird things step 2"'
       'SaveToFile "file.png"'
       'Negative'
       'FilterFastBlur 3,"False"'
-      'BlendBitmap 100,0,"file.png","boTransparent"'
+      'BlendBitmap oneh,0,"file.png","boTransparent"'
       ''
       '// "Flip the world and save it"'
       'VerticalFlip 0,0,100,100'
@@ -843,6 +846,9 @@ object Form1: TForm1
     EntityAttri.FrameEdges = sfeAround
     VariableAttri.FrameEdges = sfeAround
     DotAttri.FrameEdges = sfeAround
+    KeyWords.Strings = (
+      'LET'
+    )
     NumberAttri.Foreground = clMaroon
     NumberAttri.FrameEdges = sfeAround
     PreprocessorAttri.FrameEdges = sfeAround

+ 1 - 0
test/test_bgrascript/umain.pas

@@ -10,6 +10,7 @@ unit umain;
   - Comments are threated as the first parameter
   - Comment with '// comment' and '{ comment }' or '//,comment' and '{,comment}'
   - Multi line comments not allowed
+  - Use 'let' to store values: "let a 100" "let key value"
 
  Error handling:
   - If one line fails and program not crash it will continue running other lines