Browse Source

Added goto, print and input in bgrascript.pas

lainz 11 years ago
parent
commit
5739041a0e

+ 69 - 5
bgrascript.pas

@@ -6,13 +6,13 @@ unit BGRAScript;
 interface
 
 uses
-  Classes, SysUtils, BGRABitmap, BGRABitmapTypes;
+  Classes, SysUtils, BGRABitmap, BGRABitmapTypes, Dialogs;
 
 {Template}
 procedure SynCompletionList(itemlist: TStrings);
 {Scripting}
 function ScriptCommand(command: string; var bitmap: TBGRABitmap;
-  var variables: TStringList): boolean;
+  var variables: TStringList; var line: integer): boolean;
 function ScriptCommandList(commandlist: TStrings; var bitmap: TBGRABitmap): boolean;
 
 {Tools}
@@ -26,6 +26,11 @@ begin
   begin
     {Assign key values}
     Add('let key "value"');
+    {Goto line}
+    Add('goto 10');
+    {Messages}
+    Add('print "Message"');
+    Add('input "Title","Message","Default value",result');
     {Read Values}
     Add('GetWidth width');
     Add('GetHeight height');
@@ -85,7 +90,7 @@ begin
 end;
 
 function ScriptCommand(command: string; var bitmap: TBGRABitmap;
-  var variables: TStringList): boolean;
+  var variables: TStringList; var line: integer): boolean;
 
   function ParamCheck(passed, mustbe: integer): boolean;
   begin
@@ -102,11 +107,27 @@ function ScriptCommand(command: string; var bitmap: TBGRABitmap;
   {$endif}
   end;
 
+  function ParamCheckAtLeast(passed, mustbe: integer): boolean;
+  begin
+    Result := True;
+    if passed < mustbe then
+      Result := False;
+
+  {$ifdef debug}
+    if not Result then
+    begin
+      writeln('>> Wrong number of parameters: ' + IntToStr(passed));
+      writeln('>> At least must be: ' + IntToStr(mustbe));
+    end;
+  {$endif}
+  end;
+
 var
   list: TStringList;
   passed: integer;
   tmpbmp1: TBGRABitmap;
   i: integer;
+  a: string;
 begin
   { $ifdef debug}
   //writeln('---Script-Command---');
@@ -131,6 +152,41 @@ begin
         variables.Add(list[1] + '=' + list[2]);
     end;
 
+    {Messages}
+    'input':
+    begin
+      Result := ParamCheck(passed, 5);
+      if Result then
+      begin
+        a := InputBox(list[1],list[2],list[3]);
+        variables.Add(list[4] + '=' + a);
+      end;
+    end;
+
+    'print':
+    begin
+      Result := ParamCheckAtLeast(passed, 2);
+      if Result then
+      begin
+        a := '';
+        for i:=1 to passed -1 do
+         a := a + list[i];
+        ShowMessage(a);
+      end;
+    end;
+
+    {GoTo}
+    'goto':
+    begin
+      Result := ParamCheck(passed,2);
+      if Result then
+      begin
+        line := StrToInt(list[1]) - 2;
+        if line < 0 then
+          line := -1;
+      end;
+    end;
+
     {Read values}
     'getwidth':
     begin
@@ -571,7 +627,7 @@ end;
 
 function ScriptCommandList(commandlist: TStrings; var bitmap: TBGRABitmap): boolean;
 var
-  i: integer;
+  line: integer;
   variables: TStringList;
 begin
   {$ifdef debug}
@@ -582,10 +638,18 @@ begin
 
   variables := TStringList.Create;
 
-  Result := True;
+  {Result := True;
   for i := 0 to commandlist.Count - 1 do
     if commandlist[i] <> '' then
       ScriptCommand(commandlist[i], bitmap, variables);
+  }
+  Result := True;
+  line := 0;
+  repeat
+    if commandlist[line] <> '' then
+      ScriptCommand(commandlist[line], bitmap, variables, line);
+    Inc(line);
+  until line > commandList.Count;
 
   variables.Free;
 

BIN
test/test_bgrascript/file.png


+ 4 - 1
test/test_bgrascript/test_bgrascript.lpi

@@ -6,9 +6,12 @@
     <General>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <Title Value="test_bgrascript"/>
+      <Title Value="BGRAScript"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>

+ 1 - 0
test/test_bgrascript/test_bgrascript.lpr

@@ -13,6 +13,7 @@ uses
 {$R *.res}
 
 begin
+  Application.Title:='BGRAScript';
   RequireDerivedFormResource := True;
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);

BIN
test/test_bgrascript/test_bgrascript.res


+ 7 - 1
test/test_bgrascript/umain.lfm

@@ -493,6 +493,8 @@ object Form1: TForm1
       'VerticalFlip 100,0,200,100'
       'HorizontalFlip 100,0,200,100'
       'SaveToFile filename'
+      '// "goto line (skip all the intermediate lines)"'
+      'goto 47'
       ''
       '// "Weird things level 3"'
       'DrawCheckers 200,0,300,300,"rgba(100,100,100,255)","rgba(0,0,0,0)"'
@@ -504,7 +506,8 @@ object Form1: TForm1
       'DrawVertLine 0,0,height,"rgba(0,0,0,1)"'
       ''
       '// "Save this in your hard disk (again)"'
-      'SaveToFile filename      '
+      'SaveToFile filename'
+      'print "End: ''",filename,"'' saved!"'
     )
     VisibleSpecialChars = [vscSpace, vscTabAtLast]
     SelectedColor.FrameEdges = sfeAround
@@ -857,7 +860,10 @@ object Form1: TForm1
     VariableAttri.FrameEdges = sfeAround
     DotAttri.FrameEdges = sfeAround
     KeyWords.Strings = (
+      'GOTO'
+      'INPUT'
       'LET'
+      'PRINT'
     )
     NumberAttri.Foreground = clMaroon
     NumberAttri.FrameEdges = sfeAround