Uses synedit in rhodusIDE

Author: penavon

RhodusIDE/ufMain.dfm

@@ -5,8 +5,9 @@ interface
 uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, ulibTypes,
-  Vcl.ExtCtrls, Vcl.FileCtrl, Vcl.ComCtrls,
-  uExamples, Vcl.Menus, SyncObjs;
+  Vcl.ExtCtrls, Vcl.FileCtrl, Vcl.ComCtrls, Vcl.Themes,
+  uExamples, Vcl.Menus, SyncObjs, SynEdit, SynEditHighlighter, SynEditCodeFolding, SynHighlighterPython, SynHighlighterGeneral,
+  SynEditMiscClasses, SynEditSearch, StrUtils;
 
 const RHODUS_VERSION = 0.5;
 
@@ -26,7 +27,6 @@   TfrmMain = class(TForm)
     Panel3: TPanel;
     moutput: TMemo;
     Splitter1: TSplitter;
-    editor: TMemo;
     btnLoad: TButton;
     OpenDialog: TOpenDialog;
     lblVersion: TLabel;
@@ -51,6 +51,9 @@   TfrmMain = class(TForm)
     mnuNew: TMenuItem;
     pnlImage: TPanel;
     pnlDrawing: TImage;
+    editor: TSynEdit;
+    SynGeneralSyn1: TSynGeneralSyn;
+    SynEditSearch1: TSynEditSearch;
     procedure btnRunClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure btnLoadClick(Sender: TObject);
@@ -344,8 +347,7 @@ procedure TfrmMain.btnRunClick(Sender: TObject);
 
 procedure TfrmMain.cboExamplesChange(Sender: TObject);
 begin
-  editor.Lines.Text :=
-     (cboExamples.items.Objects[cboExamples.ItemIndex] as TExample).src;
+  editor.Lines.Text := (cboExamples.items.Objects[cboExamples.ItemIndex] as TExample).src;
 end;
 
 procedure TfrmMain.DirectoryListBox1Change(Sender: TObject);
@@ -420,6 +422,11 @@ procedure TfrmMain.FormCreate(Sender: TObject);
   for i := 0 to Bmp.Height - 1 do
       line[i] :=  Bmp.ScanLine [i];
   gClear;
+  editor.Color := $614326;
+  editor.Font.Color := $F0FBFF;
+  editor.Gutter.Color :=  $614326;
+  editor.Gutter.Font.Color := $838383;
+  SynGeneralSyn1.KeyAttri.Foreground := $0099FF;
   except
     on e: exception do
       showmessage ('Error in FormCreate: ' + e.message);
@@ -457,4 +464,6 @@ procedure TfrmMain.Quit1Click(Sender: TObject);
   loadScript;
 end;
 
+initialization
+  TStyleManager.Engine.RegisterStyleHook(TSynEdit, TScrollBoxStyleHook);
 end.

RhodusIDE/ufMain.pas

@@ -94,7 +94,8 @@ uses
   uBuiltInMatrix in 'uBuiltInMatrix.pas',
   uMath in 'uMath.pas',
   uBuiltInGraphics in 'uBuiltInGraphics.pas',
-  ulibTypes in '..\librhodus\ulibTypes.pas';
+  ulibTypes in '..\librhodus\ulibTypes.pas',
+  uIntStack in '..\VirtualMachine\uIntStack.pas';
 
 begin
   ReportMemoryLeaksOnShutdown := True;

Rhodus_Version_3/RhodusVersionThreeProject.dpr

@@ -225,6 +225,7 @@
         <DCCReference Include="uMath.pas"/>
         <DCCReference Include="uBuiltInGraphics.pas"/>
         <DCCReference Include="..\librhodus\ulibTypes.pas"/>
+        <DCCReference Include="..\VirtualMachine\uIntStack.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>

Rhodus_Version_3/RhodusVersionThreeProject.dproj

@@ -1,5 +1,13 @@
 unit uRepl;
 
+// This source is distributed under Apache 2.0
+
+// Copyright (C) 2019-2021 Herbert M Sauro
+
+// Author Contact Information:
+// email: hsauro@gmail.com
+
+
 interface
 
 Uses SysUtils, uTerminal, uRhodusEngine;

Rhodus_Version_3/uRepl.pas

@@ -1,6 +1,5 @@
 unit uTerminal;
 
-
 // This source is distributed under Apache 2.0
 
 // Copyright (C) 2019-2021 Herbert M Sauro

Rhodus_Version_3/uTerminal.pas

@@ -0,0 +1,63 @@
+unit uIntStack;
+
+// This source is distributed under Apache 2.0
+
+// Copyright (C) 2019-2021 Herbert M Sauro
+
+// Author Contact Information:
+// email: hsauro@gmail.com
+
+// This is a lighweight integer stack. Implemented to ensure that
+// the code can be used with Delphi versions that dodn't have
+// generics
+
+interface
+
+Uses Classes, SysUtils;
+
+const
+   MAX_ENTRIES = 100;
+
+type
+  TStack = record
+      data : array of integer;
+      stackPtr : integer;
+      maxSize : integer;
+  end;
+
+procedure create (stack : TStack; n : integer);
+procedure push (stack : TStack; value : integer);
+function  pop (stack : TStack) : integer;
+function  peek (stack : TStack) : integer;
+
+implementation
+
+procedure create (stack : TStack; n : integer);
+begin
+  stack.maxSize := n;
+  setLength (stack.data, n);
+end;
+
+procedure push (stack : TStack; value : integer);
+begin
+  if stack.stackPtr = stack.maxSize then
+     raise Exception.Create('Integer stack overflow error.');
+  inc (stack.stackPtr);
+  stack.data[stack.stackPtr] := value;
+end;
+
+function pop (stack : TStack) : integer;
+begin
+  if stack.stackPtr = -1 then
+     raise Exception.Create('Integer stack underflow error.');
+  result := stack.data[stack.stackPtr];
+  dec (stack.stackPtr);
+end;
+
+function peek (stack : TStack) : integer;
+begin
+  result := stack.data[stack.stackPtr];
+end;
+
+
+end.

VirtualMachine/uIntStack.pas

@@ -16,7 +16,7 @@ interface
 Uses System.SysUtils, System.Diagnostics, System.TimeSpan, uUtils,
   uMachineStack, System.generics.Collections, uListObject, uStringObject,
   uArrayObject, uSymbolTable, uConstantTable, uProgramCode, uMemoryManager,
-  uObjectSupport;
+  uObjectSupport, uIntStack;
 
 const
   MAX_STACK_SIZE = 40000; // Maximum depth of operand stack
@@ -65,7 +65,7 @@   TVM = class(TObject)
 
     symbolTable : TSymbolTable;
     VMStateStack : TStack<TVMState>;
-    subscriptStack : TStack<integer>;
+    subscriptStack : uIntStack.TStack;     // lightweight integer stack
 
     frameStackTop: integer;
     frameStack: TFrameStack;
@@ -247,7 +247,8 @@ constructor TVM.Create;
   createStack(MAX_STACK_SIZE);
   createFrameStack(recursionLimit);
   VMStateStack := TStack<TVMState>.Create;
-  subscriptStack := TStack<integer>.Create;
+  //subscriptStack := TStack<integer>.Create;
+  uIntStack.create (subscriptStack, uIntStack.MAX_ENTRIES);
 
   callbackPtr := nil;
   printCallbackPtr := nil;
@@ -262,7 +263,7 @@ destructor TVM.Destroy;
   freeStack;
   freeFrameStack;
   VMStateStack.Free;
-  subscriptStack.Free;
+  //subscriptStack.Free;
   inherited;
 end;
 
@@ -2054,22 +2055,23 @@ procedure TVM.storeIndexableArray(variable: PMachineStackRecord; index: integer;
   if variable.stackType <> stArray then
     raise ERuntimeException.Create('left-hand side must be a array');
 
-  if subscriptStack.Count + 1 < nSubscripts then
+  //if subscriptStack.Count + 1 < nSubscripts then
+  if subscriptStack.stackPtr + 1 < nSubscripts then
      begin
-     subscriptStack.Push(index);
+     uIntStack.Push(subscriptStack, index);
      push (variable);
      end
   else
      begin
-     subscriptStack.Push(index);
-     setLength (idx, subscriptStack.Count);
+     uIntStack.Push(subscriptStack, index);
+     setLength (idx, subscriptStack.stackPtr);
      // Index backwards since the stack entries are backwards
-     for i := subscriptStack.Count - 1 downto 0 do
-         idx[i] := subscriptStack.Pop();
+     for i := subscriptStack.stackPtr - 1 downto 0 do
+         idx[i] := uIntStack.Pop(subscriptStack);
 
      variable.aValue.setValue (idx, value);
 
-     subscriptStack.Clear;
+     subscriptStack.stackPtr := -1; // Clear
      end;
 end;
 
@@ -2270,9 +2272,9 @@ procedure TVM.loadIndexableArray(st: PMachineStackRecord; index: integer; nSubsc
     i : integer;
 begin
   // For an n dimensional array we will collect the subscripts.
-  if subscriptStack.Count + 1 < nSubscripts then
+  if subscriptStack.StackPtr + 1 < nSubscripts then
      begin
-     subscriptStack.Push(index);
+     uIntStack.Push(subscriptStack, index);
      push (st);
      end
   else
@@ -2286,14 +2288,14 @@ procedure TVM.loadIndexableArray(st: PMachineStackRecord; index: integer; nSubsc
         exit;
         end;
 
-     subscriptStack.Push(index);
-     setLength (idx, subscriptStack.Count);
+     uIntStack.Push(subscriptStack, index);
+     setLength (idx, subscriptStack.stackPtr);
      // Index backwards since the stack entries are backwards
-     for i := subscriptStack.Count - 1 downto 0 do
-         idx[i] := subscriptStack.Pop();
+     for i := subscriptStack.stackPtr - 1 downto 0 do
+         idx[i] := uIntStack.Pop(subscriptStack);
 
      push (st.aValue.getValue (idx));
-     subscriptStack.Clear;
+     subscriptStack.stackPtr := -1; //Clear;
      end;
 end;