toolbuttons

This commit is contained in:
April Ayres-Griffiths 2019-04-06 10:28:47 +11:00
parent 407c37545a
commit 2482c7c0a1
11 changed files with 4172 additions and 5955 deletions

File diff suppressed because it is too large Load Diff

View File

@ -18,8 +18,15 @@ type
{ TGUIForm }
TGUIForm = class(TForm)
BackdropImage: TImage;
ImageList1: TImageList;
backdrop: TImage;
N2: TMenuItem;
miTintOff: TMenuItem;
miTintGrey: TMenuItem;
miTintGreen: TMenuItem;
miTintAmber: TMenuItem;
ToolTimer: TTimer;
TintMode: TPopupMenu;
ToolbarIcons: TImageList;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
@ -100,7 +107,14 @@ type
CheckTimer: TTimer;
MouseTimer: TTimer;
ToolBar1: TToolBar;
procedure BackdropImageClick(Sender: TObject);
tbTintMode: TToolButton;
tbRMVoxels: TToolButton;
tbRMDots: TToolButton;
tbRMRaster: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
tbRMColor: TToolButton;
procedure backdropClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure CheckTimerTimer(Sender: TObject);
procedure FormActivate(Sender: TObject);
@ -164,6 +178,11 @@ type
procedure miSPEjectClick(Sender: TObject);
procedure miSPFileClick(Sender: TObject);
procedure MouseTimerTimer(Sender: TObject);
procedure tbRMClick(Sender: TObject);
procedure tbRMColorClick(Sender: TObject);
procedure tbTintModeClick(Sender: TObject);
procedure ToolTimerTimer(Sender: TObject);
procedure UpdateRenderMode;
procedure UnFreeze;
procedure HideM8;
procedure menuRebootVMClick(Sender: TObject);
@ -171,6 +190,7 @@ type
procedure RebootVM;
procedure ReposWindow;
procedure RepaintWindow;
procedure UpdateColorMode;
function GetTitleOfActiveWindow: string;
procedure SendKey(key: Integer; ScanCode: Integer; KeyAction: Integer; Mods: Integer);
procedure tbDisk1MouseDown(Sender: TObject; Button: TMouseButton;
@ -200,6 +220,9 @@ var
implementation
const
baseUrl: string = 'http://localhost:38911';
{$R *.lfm}
{ TGUIForm }
@ -236,12 +259,12 @@ end;
procedure TGUIForm.RebootVM;
begin
self.hc.Get('http://localhost:38911/api/control/system/reboot');
self.hc.Get(baseUrl + '/api/control/system/reboot');
end;
procedure TGUIForm.Freeze;
begin
self.hc.Get('http://localhost:38911/api/control/window/freeze');
self.hc.Get(baseUrl + '/api/control/window/freeze');
end;
procedure TGUIForm.miColorDotsClick(Sender: TObject);
@ -261,7 +284,7 @@ end;
procedure TGUIForm.miD1BlankClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/hardware/disk/eject/0');
self.hc.Get(baseUrl + '/api/control/hardware/disk/eject/0');
end;
procedure TGUIForm.miD1FileClick(Sender: TObject);
@ -277,7 +300,7 @@ end;
procedure TGUIForm.miD2BlankClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/hardware/disk/eject/1');
self.hc.Get(baseUrl + '/api/control/hardware/disk/eject/1');
end;
procedure TGUIForm.miD2FileClick(Sender: TObject);
@ -361,7 +384,7 @@ end;
procedure TGUIForm.miFileCatClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/system/catalog');
self.hc.Get(baseUrl + '/api/control/system/catalog');
end;
procedure TGUIForm.miGRRasterClick(Sender: TObject);
@ -449,17 +472,17 @@ end;
procedure TGUIForm.miIntFPClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/interpreter/fp');
self.hc.Get(baseUrl + '/api/control/interpreter/fp');
end;
procedure TGUIForm.miIntINTClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/interpreter/int');
self.hc.Get(baseUrl + '/api/control/interpreter/int');
end;
procedure TGUIForm.miIntLOGOClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/interpreter/logo');
self.hc.Get(baseUrl + '/api/control/interpreter/logo');
end;
procedure TGUIForm.miMonoDotsClick(Sender: TObject);
@ -538,13 +561,13 @@ procedure TGUIForm.miSLIClick(Sender: TObject);
const
values: Array[0..9] of string = ('1', '0.88', '0.77', '0.66', '0.55', '0.44', '0.33', '0.22', '0.11', '0');
begin
// self.hc.Get('http://localhost:38911/api/control/input/meta/key/i/value/'+TMenuItem(Sender).Caption);
// self.hc.Get(baseUrl + '/api/control/input/meta/key/i/value/'+TMenuItem(Sender).Caption);
UpdateConfig( 'video/init.video.scanline', values[StrToInt(TMenuItem(Sender).Caption)], true );
end;
procedure TGUIForm.miSPEjectClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/hardware/disk/eject/2');
self.hc.Get(baseUrl + '/api/control/hardware/disk/eject/2');
end;
procedure TGUIForm.miSPFileClick(Sender: TObject);
@ -581,9 +604,101 @@ begin
end;
end;
procedure TGUIForm.UpdateRenderMode;
var
t: integer;
begin
t := StrToInt( GetConfig( 'video/current.rendermode' ) );
case t of
0: tbRMDots.Down := true;
3: tbRMDots.Down := true;
1: tbRMVoxels.Down := true;
4: tbRMVoxels.Down := true;
2: tbRMRaster.Down := true;
5: tbRMVoxels.Down := true;
end;
end;
procedure TGUIForm.tbRMClick(Sender: TObject);
var
t: integer;
begin
t := StrToInt( GetConfig( 'video/current.rendermode' ) );
case TToolButton(sender).Tag of
0:
if t >= 3 then
t := 3
else
t := 0;
1:
if t >= 3 then
t := 4
else
t := 1;
2:
if t >= 3 then
t := 5
else
t := 2;
end;
UpdateConfig( 'video/current.rendermode', IntToStr(t), false );
UpdateRenderMode;
end;
procedure TGUIForm.UpdateColorMode;
var
t: integer;
begin
t := StrToInt( GetConfig( 'video/current.rendermode' ) );
tbRMColor.ImageIndex := 7 + (t div 3);
end;
procedure TGUIForm.tbRMColorClick(Sender: TObject);
var
t: integer;
begin
{ increment video tint }
t := StrToInt( GetConfig( 'video/current.rendermode' ) );
if t >= 3 then
t := t - 3
else
t := t + 3;
UpdateConfig( 'video/current.rendermode', IntToStr(t), false );
UpdateColorMode;
end;
procedure TGUIForm.tbTintModeClick(Sender: TObject);
var
t: integer;
begin
{ increment video tint }
t := StrToInt( GetConfig( 'video/init.video.tintmode' ) );
inc(t);
if t > 3 then
t := 0;
UpdateConfig( 'video/init.video.tintmode', IntToStr(t), false );
t := StrToInt( GetConfig( 'video/init.video.tintmode' ) );
tbTintMode.ImageIndex := t;
end;
procedure TGUIForm.ToolTimerTimer(Sender: TObject);
begin
UpdateRenderMode;
UpdateColorMode;
UpdateTintMode;
end;
procedure TGUIForm.UnFreeze;
begin
self.hc.Get('http://localhost:38911/api/control/window/unfreeze');
self.hc.Get(baseUrl + '/api/control/window/unfreeze');
end;
procedure TGUIForm.HideM8;
@ -591,7 +706,7 @@ begin
if hidden then
exit;
//Memo1.Lines.Add('hiding m8 window');
self.hc.Get('http://localhost:38911/api/control/window/hide');
self.hc.Get(baseUrl + '/api/control/window/hide');
lastHideTime := Now();
hidden := true;
end;
@ -606,7 +721,7 @@ begin
if not hidden then
exit;
//Memo1.Lines.Add('showing m8 window');
self.hc.Get('http://localhost:38911/api/control/window/show');
self.hc.Get(baseUrl + '/api/control/window/show');
lastShowTime := Now();
hidden := false;
end;
@ -617,13 +732,13 @@ var
filename: string;
begin
S := TMemoryStream.Create();
self.hc.Get('http://localhost:38911/api/control/window/screen', S);
self.hc.Get(baseUrl + '/api/control/window/screen', S);
if S.Size > 0 then
begin
filename := GetUserDir + PathSeparator + 'microm8scrn.png';
StatusBar1.SimpleText:='Got '+IntToStr(S.Size)+' bytes of PNG data';
S.SaveToFile(filename);
BackdropImage.Picture.LoadFromFile(filename);
backdrop.Picture.LoadFromFile(filename);
S.Free;
end;
end;
@ -657,7 +772,7 @@ begin
',"h":'+IntToStr(h) +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/window/position',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/window/position',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=S;
Respo.Destroy;
@ -668,14 +783,11 @@ var
json, S: string;
Respo: TStringStream;
begin
if key = 8 then
key := 127;
json := '{"x":' + IntToStr(x) +
',"y":'+IntToStr(y) +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/input/mouseevent',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/input/mouseevent',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=S;
Respo.Destroy;
@ -695,7 +807,7 @@ begin
',"modifiers":'+IntToStr(Mods) +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/input/keyevent',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/input/keyevent',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=S;
Respo.Destroy;
@ -714,7 +826,7 @@ begin
'","drive":'+IntToStr(Drive) +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/hardware/disk/insert',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/hardware/disk/insert',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=json;
Respo.Destroy;
@ -734,7 +846,7 @@ begin
'","persist":'+ pval +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/settings/update',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/settings/update',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=json;
Respo.Destroy;
@ -749,7 +861,7 @@ begin
json := '{"path":"' + path +
'"}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/settings/get',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/settings/get',json,Respo);
Result := Respo.DataString;
self.StatusBar1.SimpleText:=json;
Respo.Destroy;
@ -793,7 +905,7 @@ begin
self.ReposWindow;
end;
procedure TGUIForm.BackdropImageClick(Sender: TObject);
procedure TGUIForm.backdropClick(Sender: TObject);
begin
end;
@ -821,7 +933,7 @@ function TGUIForm.GetTitleOfActiveWindow: string;
var s: string;
begin
Result := '';
s := self.hc.Get('http://localhost:38911/api/control/window/focused');
s := self.hc.Get(baseUrl + '/api/control/window/focused');
if s = '1' then
Result := 'microM8';
end;

View File

@ -12,7 +12,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="176"/>
<UsageCount Value="323"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
@ -21,141 +21,140 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<TopLine Value="387"/>
<CursorPos X="34" Y="412"/>
<UsageCount Value="176"/>
<TopLine Value="782"/>
<CursorPos X="21" Y="799"/>
<UsageCount Value="323"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="C:\lazarus\lcl\include\picture.inc"/>
<EditorIndex Value="1"/>
<EditorIndex Value="-1"/>
<TopLine Value="576"/>
<CursorPos X="49" Y="591"/>
<UsageCount Value="65"/>
<Loaded Value="True"/>
<UsageCount Value="136"/>
</Unit2>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="main.pas"/>
<Caret Line="292" Column="78" TopLine="255"/>
<Caret Line="620" Column="46" TopLine="602"/>
</Position1>
<Position2>
<Filename Value="main.pas"/>
<Caret Line="293" Column="78" TopLine="256"/>
<Caret Line="621" Column="46" TopLine="603"/>
</Position2>
<Position3>
<Filename Value="main.pas"/>
<Caret Line="294" Column="78" TopLine="257"/>
<Caret Line="622" Column="46" TopLine="604"/>
</Position3>
<Position4>
<Filename Value="main.pas"/>
<Caret Line="295" Column="78" TopLine="258"/>
<Caret Line="623" Column="46" TopLine="605"/>
</Position4>
<Position5>
<Filename Value="main.pas"/>
<Caret Line="296" Column="78" TopLine="259"/>
<Caret Line="624" Column="46" TopLine="606"/>
</Position5>
<Position6>
<Filename Value="main.pas"/>
<Caret Line="297" Column="78" TopLine="260"/>
<Caret Line="213" Column="30" TopLine="190"/>
</Position6>
<Position7>
<Filename Value="main.pas"/>
<Caret Line="300" Column="78" TopLine="263"/>
<Caret Line="467" Column="98" TopLine="448"/>
</Position7>
<Position8>
<Filename Value="main.pas"/>
<Caret Line="305" Column="16" TopLine="300"/>
<Caret Line="232" Column="76" TopLine="237"/>
</Position8>
<Position9>
<Filename Value="main.pas"/>
<Caret Line="583" Column="44" TopLine="562"/>
<Caret Line="233" Column="76" TopLine="233"/>
</Position9>
<Position10>
<Filename Value="main.pas"/>
<Caret Line="564" Column="43" TopLine="545"/>
<Caret Line="234" Column="76" TopLine="234"/>
</Position10>
<Position11>
<Filename Value="main.pas"/>
<Caret Line="569" Column="44" TopLine="545"/>
<Caret Line="235" Column="76" TopLine="235"/>
</Position11>
<Position12>
<Filename Value="main.pas"/>
<Caret Line="356" Column="5" TopLine="347"/>
<Caret Line="236" Column="76" TopLine="236"/>
</Position12>
<Position13>
<Filename Value="main.pas"/>
<Caret Line="283" Column="34" TopLine="270"/>
<Caret Line="238" Column="76" TopLine="238"/>
</Position13>
<Position14>
<Filename Value="main.pas"/>
<Caret Line="281" TopLine="267"/>
<Caret Line="612" Column="33" TopLine="583"/>
</Position14>
<Position15>
<Filename Value="main.pas"/>
<Caret Line="873" TopLine="850"/>
<Caret Line="610" Column="66" TopLine="591"/>
</Position15>
<Position16>
<Filename Value="main.pas"/>
<Caret Line="882" Column="18" TopLine="850"/>
<Caret Line="692" TopLine="674"/>
</Position16>
<Position17>
<Filename Value="main.pas"/>
<Caret Line="874" TopLine="864"/>
<Caret Line="614" Column="24" TopLine="599"/>
</Position17>
<Position18>
<Filename Value="main.pas"/>
<Caret Line="371" Column="17" TopLine="360"/>
<Caret Line="192" Column="30" TopLine="174"/>
</Position18>
<Position19>
<Filename Value="main.pas"/>
<Caret Line="374" Column="30" TopLine="361"/>
<Caret Line="618" Column="40" TopLine="600"/>
</Position19>
<Position20>
<Filename Value="main.pas"/>
<Caret Line="426" TopLine="411"/>
<Caret Line="183" Column="36" TopLine="158"/>
</Position20>
<Position21>
<Filename Value="main.pas"/>
<Caret Line="422" Column="51" TopLine="411"/>
<Caret Line="822" TopLine="804"/>
</Position21>
<Position22>
<Filename Value="main.pas"/>
<Caret Line="475" Column="21" TopLine="445"/>
<Caret Line="820" Column="5" TopLine="804"/>
</Position22>
<Position23>
<Filename Value="main.pas"/>
<Caret Line="439" Column="13" TopLine="420"/>
<Caret Line="794" Column="29" TopLine="787"/>
</Position23>
<Position24>
<Filename Value="main.pas"/>
<Caret Line="427" TopLine="419"/>
<Caret Line="820" Column="5" TopLine="804"/>
</Position24>
<Position25>
<Filename Value="main.pas"/>
<Caret Line="401" Column="12" TopLine="383"/>
<Caret Line="179" Column="42" TopLine="157"/>
</Position25>
<Position26>
<Filename Value="main.pas"/>
<Caret Line="405" Column="30" TopLine="383"/>
<Caret Line="793" Column="48" TopLine="820"/>
</Position26>
<Position27>
<Filename Value="main.pas"/>
<Caret Line="388" Column="3" TopLine="384"/>
<Caret Line="821" TopLine="802"/>
</Position27>
<Position28>
<Filename Value="main.pas"/>
<Caret Line="394" Column="3" TopLine="385"/>
<Caret Line="811" Column="20" TopLine="785"/>
</Position28>
<Position29>
<Filename Value="main.pas"/>
<Caret Line="400" Column="3" TopLine="386"/>
<Caret Line="810" Column="6" TopLine="780"/>
</Position29>
<Position30>
<Filename Value="main.pas"/>
<Caret Line="406" Column="3" TopLine="387"/>
<Caret Line="799" Column="28" TopLine="780"/>
</Position30>
</JumpHistory>
<RunParams>

File diff suppressed because it is too large Load Diff

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

3212
main.lfm

File diff suppressed because it is too large Load Diff

175
main.pas
View File

@ -18,8 +18,15 @@ type
{ TGUIForm }
TGUIForm = class(TForm)
BackdropImage: TImage;
ImageList1: TImageList;
backdrop: TImage;
N2: TMenuItem;
miTintOff: TMenuItem;
miTintGrey: TMenuItem;
miTintGreen: TMenuItem;
miTintAmber: TMenuItem;
ToolTimer: TTimer;
TintMode: TPopupMenu;
ToolbarIcons: TImageList;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
@ -100,7 +107,14 @@ type
CheckTimer: TTimer;
MouseTimer: TTimer;
ToolBar1: TToolBar;
procedure BackdropImageClick(Sender: TObject);
tbTintMode: TToolButton;
tbRMVoxels: TToolButton;
tbRMDots: TToolButton;
tbRMRaster: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
tbRMColor: TToolButton;
procedure backdropClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure CheckTimerTimer(Sender: TObject);
procedure FormActivate(Sender: TObject);
@ -164,6 +178,11 @@ type
procedure miSPEjectClick(Sender: TObject);
procedure miSPFileClick(Sender: TObject);
procedure MouseTimerTimer(Sender: TObject);
procedure tbRMClick(Sender: TObject);
procedure tbRMColorClick(Sender: TObject);
procedure tbTintModeClick(Sender: TObject);
procedure ToolTimerTimer(Sender: TObject);
procedure UpdateRenderMode;
procedure UnFreeze;
procedure HideM8;
procedure menuRebootVMClick(Sender: TObject);
@ -171,6 +190,8 @@ type
procedure RebootVM;
procedure ReposWindow;
procedure RepaintWindow;
procedure UpdateColorMode;
procedure UpdateTintMode;
function GetTitleOfActiveWindow: string;
procedure SendKey(key: Integer; ScanCode: Integer; KeyAction: Integer; Mods: Integer);
procedure tbDisk1MouseDown(Sender: TObject; Button: TMouseButton;
@ -200,6 +221,9 @@ var
implementation
const
baseUrl: string = 'http://localhost:38911';
{$R *.lfm}
{ TGUIForm }
@ -236,12 +260,12 @@ end;
procedure TGUIForm.RebootVM;
begin
self.hc.Get('http://localhost:38911/api/control/system/reboot');
self.hc.Get(baseUrl + '/api/control/system/reboot');
end;
procedure TGUIForm.Freeze;
begin
self.hc.Get('http://localhost:38911/api/control/window/freeze');
self.hc.Get(baseUrl + '/api/control/window/freeze');
end;
procedure TGUIForm.miColorDotsClick(Sender: TObject);
@ -261,7 +285,7 @@ end;
procedure TGUIForm.miD1BlankClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/hardware/disk/eject/0');
self.hc.Get(baseUrl + '/api/control/hardware/disk/eject/0');
end;
procedure TGUIForm.miD1FileClick(Sender: TObject);
@ -277,7 +301,7 @@ end;
procedure TGUIForm.miD2BlankClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/hardware/disk/eject/1');
self.hc.Get(baseUrl + '/api/control/hardware/disk/eject/1');
end;
procedure TGUIForm.miD2FileClick(Sender: TObject);
@ -361,7 +385,7 @@ end;
procedure TGUIForm.miFileCatClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/system/catalog');
self.hc.Get(baseUrl + '/api/control/system/catalog');
end;
procedure TGUIForm.miGRRasterClick(Sender: TObject);
@ -449,17 +473,17 @@ end;
procedure TGUIForm.miIntFPClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/interpreter/fp');
self.hc.Get(baseUrl + '/api/control/interpreter/fp');
end;
procedure TGUIForm.miIntINTClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/interpreter/int');
self.hc.Get(baseUrl + '/api/control/interpreter/int');
end;
procedure TGUIForm.miIntLOGOClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/interpreter/logo');
self.hc.Get(baseUrl + '/api/control/interpreter/logo');
end;
procedure TGUIForm.miMonoDotsClick(Sender: TObject);
@ -538,13 +562,13 @@ procedure TGUIForm.miSLIClick(Sender: TObject);
const
values: Array[0..9] of string = ('1', '0.88', '0.77', '0.66', '0.55', '0.44', '0.33', '0.22', '0.11', '0');
begin
// self.hc.Get('http://localhost:38911/api/control/input/meta/key/i/value/'+TMenuItem(Sender).Caption);
// self.hc.Get(baseUrl + '/api/control/input/meta/key/i/value/'+TMenuItem(Sender).Caption);
UpdateConfig( 'video/init.video.scanline', values[StrToInt(TMenuItem(Sender).Caption)], true );
end;
procedure TGUIForm.miSPEjectClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/hardware/disk/eject/2');
self.hc.Get(baseUrl + '/api/control/hardware/disk/eject/2');
end;
procedure TGUIForm.miSPFileClick(Sender: TObject);
@ -581,9 +605,108 @@ begin
end;
end;
procedure TGUIForm.UpdateRenderMode;
var
t: integer;
begin
t := StrToInt( GetConfig( 'video/current.rendermode' ) );
case t of
0: tbRMDots.Down := true;
3: tbRMDots.Down := true;
1: tbRMVoxels.Down := true;
4: tbRMVoxels.Down := true;
2: tbRMRaster.Down := true;
5: tbRMVoxels.Down := true;
end;
end;
procedure TGUIForm.tbRMClick(Sender: TObject);
var
t: integer;
begin
t := StrToInt( GetConfig( 'video/current.rendermode' ) );
case TToolButton(sender).Tag of
0:
if t >= 3 then
t := 3
else
t := 0;
1:
if t >= 3 then
t := 4
else
t := 1;
2:
if t >= 3 then
t := 5
else
t := 2;
end;
UpdateConfig( 'video/current.rendermode', IntToStr(t), false );
UpdateRenderMode;
end;
procedure TGUIForm.UpdateColorMode;
var
t: integer;
begin
t := StrToInt( GetConfig( 'video/current.rendermode' ) );
tbRMColor.ImageIndex := 7 + (t div 3);
end;
procedure TGUIForm.tbRMColorClick(Sender: TObject);
var
t: integer;
begin
{ increment video tint }
t := StrToInt( GetConfig( 'video/current.rendermode' ) );
if t >= 3 then
t := t - 3
else
t := t + 3;
UpdateConfig( 'video/current.rendermode', IntToStr(t), false );
UpdateColorMode;
end;
procedure TGUIForm.UpdateTintMode;
var
t: integer;
begin
t := StrToInt( GetConfig( 'video/init.video.tintmode' ) );
tbTintMode.ImageIndex := t;
end;
procedure TGUIForm.tbTintModeClick(Sender: TObject);
var
t: integer;
begin
{ increment video tint }
t := StrToInt( GetConfig( 'video/init.video.tintmode' ) );
inc(t);
if t > 3 then
t := 0;
UpdateConfig( 'video/init.video.tintmode', IntToStr(t), false );
UpdateTintMode;
end;
procedure TGUIForm.ToolTimerTimer(Sender: TObject);
begin
UpdateRenderMode;
UpdateColorMode;
UpdateTintMode;
end;
procedure TGUIForm.UnFreeze;
begin
self.hc.Get('http://localhost:38911/api/control/window/unfreeze');
self.hc.Get(baseUrl + '/api/control/window/unfreeze');
end;
procedure TGUIForm.HideM8;
@ -591,7 +714,7 @@ begin
if hidden then
exit;
//Memo1.Lines.Add('hiding m8 window');
self.hc.Get('http://localhost:38911/api/control/window/hide');
self.hc.Get(baseUrl + '/api/control/window/hide');
lastHideTime := Now();
hidden := true;
end;
@ -606,7 +729,7 @@ begin
if not hidden then
exit;
//Memo1.Lines.Add('showing m8 window');
self.hc.Get('http://localhost:38911/api/control/window/show');
self.hc.Get(baseUrl + '/api/control/window/show');
lastShowTime := Now();
hidden := false;
end;
@ -617,13 +740,13 @@ var
filename: string;
begin
S := TMemoryStream.Create();
self.hc.Get('http://localhost:38911/api/control/window/screen', S);
self.hc.Get(baseUrl + '/api/control/window/screen', S);
if S.Size > 0 then
begin
filename := GetUserDir + PathSeparator + 'microm8scrn.png';
StatusBar1.SimpleText:='Got '+IntToStr(S.Size)+' bytes of PNG data';
S.SaveToFile(filename);
BackdropImage.Picture.LoadFromFile(filename);
backdrop.Picture.LoadFromFile(filename);
S.Free;
end;
end;
@ -657,7 +780,7 @@ begin
',"h":'+IntToStr(h) +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/window/position',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/window/position',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=S;
Respo.Destroy;
@ -672,7 +795,7 @@ begin
',"y":'+IntToStr(y) +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/input/mouseevent',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/input/mouseevent',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=S;
Respo.Destroy;
@ -692,7 +815,7 @@ begin
',"modifiers":'+IntToStr(Mods) +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/input/keyevent',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/input/keyevent',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=S;
Respo.Destroy;
@ -711,7 +834,7 @@ begin
'","drive":'+IntToStr(Drive) +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/hardware/disk/insert',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/hardware/disk/insert',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=json;
Respo.Destroy;
@ -731,7 +854,7 @@ begin
'","persist":'+ pval +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/settings/update',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/settings/update',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=json;
Respo.Destroy;
@ -746,7 +869,7 @@ begin
json := '{"path":"' + path +
'"}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/settings/get',json,Respo);
self.hc.SimpleFormPost(baseUrl + '/api/control/settings/get',json,Respo);
Result := Respo.DataString;
self.StatusBar1.SimpleText:=json;
Respo.Destroy;
@ -790,7 +913,7 @@ begin
self.ReposWindow;
end;
procedure TGUIForm.BackdropImageClick(Sender: TObject);
procedure TGUIForm.backdropClick(Sender: TObject);
begin
end;
@ -818,7 +941,7 @@ function TGUIForm.GetTitleOfActiveWindow: string;
var s: string;
begin
Result := '';
s := self.hc.Get('http://localhost:38911/api/control/window/focused');
s := self.hc.Get(baseUrl + '/api/control/window/focused');
if s = '1' then
Result := 'microM8';
end;

73
poc.lps
View File

@ -12,7 +12,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="178"/>
<UsageCount Value="323"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
@ -21,141 +21,140 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<TopLine Value="553"/>
<CursorPos X="22" Y="572"/>
<UsageCount Value="178"/>
<TopLine Value="239"/>
<CursorPos X="5" Y="260"/>
<UsageCount Value="323"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="C:\lazarus\lcl\include\picture.inc"/>
<EditorIndex Value="1"/>
<EditorIndex Value="-1"/>
<TopLine Value="576"/>
<CursorPos X="49" Y="591"/>
<UsageCount Value="66"/>
<Loaded Value="True"/>
<UsageCount Value="136"/>
</Unit2>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="main.pas"/>
<Caret Line="297" Column="78" TopLine="260"/>
<Caret Line="820" Column="5" TopLine="804"/>
</Position1>
<Position2>
<Filename Value="main.pas"/>
<Caret Line="300" Column="78" TopLine="263"/>
<Caret Line="179" Column="42" TopLine="157"/>
</Position2>
<Position3>
<Filename Value="main.pas"/>
<Caret Line="305" Column="16" TopLine="300"/>
<Caret Line="793" Column="48" TopLine="820"/>
</Position3>
<Position4>
<Filename Value="main.pas"/>
<Caret Line="583" Column="44" TopLine="562"/>
<Caret Line="821" TopLine="802"/>
</Position4>
<Position5>
<Filename Value="main.pas"/>
<Caret Line="564" Column="43" TopLine="545"/>
<Caret Line="811" Column="20" TopLine="785"/>
</Position5>
<Position6>
<Filename Value="main.pas"/>
<Caret Line="569" Column="44" TopLine="545"/>
<Caret Line="810" Column="6" TopLine="780"/>
</Position6>
<Position7>
<Filename Value="main.pas"/>
<Caret Line="356" Column="5" TopLine="347"/>
<Caret Line="799" Column="21" TopLine="782"/>
</Position7>
<Position8>
<Filename Value="main.pas"/>
<Caret Line="283" Column="34" TopLine="270"/>
<Caret Line="837" Column="20" TopLine="818"/>
</Position8>
<Position9>
<Filename Value="main.pas"/>
<Caret Line="281" TopLine="267"/>
<Caret Line="772" Column="20" TopLine="753"/>
</Position9>
<Position10>
<Filename Value="main.pas"/>
<Caret Line="873" TopLine="850"/>
<Caret Line="777" Column="20" TopLine="758"/>
</Position10>
<Position11>
<Filename Value="main.pas"/>
<Caret Line="882" Column="18" TopLine="850"/>
<Caret Line="182" Column="23" TopLine="167"/>
</Position11>
<Position12>
<Filename Value="main.pas"/>
<Caret Line="874" TopLine="864"/>
<Caret Line="772" Column="20" TopLine="754"/>
</Position12>
<Position13>
<Filename Value="main.pas"/>
<Caret Line="371" Column="17" TopLine="360"/>
<Caret Line="837" Column="28" TopLine="812"/>
</Position13>
<Position14>
<Filename Value="main.pas"/>
<Caret Line="374" Column="30" TopLine="361"/>
<Caret Line="839" Column="59" TopLine="812"/>
</Position14>
<Position15>
<Filename Value="main.pas"/>
<Caret Line="426" TopLine="411"/>
<Caret Line="182" Column="23" TopLine="164"/>
</Position15>
<Position16>
<Filename Value="main.pas"/>
<Caret Line="422" Column="51" TopLine="411"/>
<Caret Line="770" Column="5" TopLine="741"/>
</Position16>
<Position17>
<Filename Value="main.pas"/>
<Caret Line="475" Column="21" TopLine="445"/>
<Caret Line="837" Column="26" TopLine="818"/>
</Position17>
<Position18>
<Filename Value="main.pas"/>
<Caret Line="439" Column="13" TopLine="420"/>
<Caret Line="1108" Column="9" TopLine="1077"/>
</Position18>
<Position19>
<Filename Value="main.pas"/>
<Caret Line="427" TopLine="419"/>
<Caret Line="1268" Column="12" TopLine="1237"/>
</Position19>
<Position20>
<Filename Value="main.pas"/>
<Caret Line="401" Column="12" TopLine="383"/>
<Caret Line="183" Column="21" TopLine="165"/>
</Position20>
<Position21>
<Filename Value="main.pas"/>
<Caret Line="405" Column="30" TopLine="383"/>
<Caret Line="250" Column="15" TopLine="219"/>
</Position21>
<Position22>
<Filename Value="main.pas"/>
<Caret Line="388" Column="3" TopLine="384"/>
<Caret Line="443" Column="12" TopLine="412"/>
</Position22>
<Position23>
<Filename Value="main.pas"/>
<Caret Line="394" Column="3" TopLine="385"/>
<Caret Line="459" Column="9" TopLine="428"/>
</Position23>
<Position24>
<Filename Value="main.pas"/>
<Caret Line="400" Column="3" TopLine="386"/>
<Caret Line="726" Column="9" TopLine="695"/>
</Position24>
<Position25>
<Filename Value="main.pas"/>
<Caret Line="406" Column="3" TopLine="387"/>
<Caret Line="770" Column="5" TopLine="741"/>
</Position25>
<Position26>
<Filename Value="main.pas"/>
<Caret Line="412" Column="34" TopLine="387"/>
<Caret Line="842" Column="37" TopLine="834"/>
</Position26>
<Position27>
<Filename Value="main.pas"/>
<Caret Line="14" Column="19"/>
<Caret Line="770" Column="5" TopLine="753"/>
</Position27>
<Position28>
<Filename Value="main.pas"/>
<Caret Line="189" Column="36" TopLine="167"/>
<Caret Line="847" Column="33" TopLine="822"/>
</Position28>
<Position29>
<Filename Value="main.pas"/>
<Caret Line="577" Column="80" TopLine="559"/>
<Caret Line="258" Column="5" TopLine="237"/>
</Position29>
<Position30>
<Filename Value="main.pas"/>
<Caret Line="572" Column="23" TopLine="553"/>
<Caret Line="259" Column="5" TopLine="238"/>
</Position30>
</JumpHistory>
<RunParams>