{
EmulationWindow используется для создания окна, в котором пользователь
смотрит экран выполняемой Малик Эмулятором программы и взаимодействует с
этой программой.
Этот исходный текст является частью Малик Эмулятора.
Следующие файлы используются этим исходным текстом:
emulationwindow.lfm
На них так же распространяются те же права, как и на этот исходный текст.
Copyright © 2016–2017, 2019–2023 Малик Разработчик
Малик Эмулятор – свободная программа: вы можете перераспространять её и/или
изменять её на условиях Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Малик Эмулятор распространяется в надежде, что он может быть полезен,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
общественной лицензии GNU.
Вы должны были получить копию Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit EmulationWindow;
{$MODE DELPHI}
{$ASMMODE INTEL}
interface
uses
Windows,
Classes,
SysUtils,
Controls,
Forms,
Graphics,
ComCtrls,
ExtCtrls,
LMessages,
LCLType,
Buttons,
Lang,
IOStreams,
FileIO,
Zlib,
Images,
UFonts,
Manifests,
Timers,
Players,
EmulMalik,
EmulConstants,
EmulProgrammes,
PixelGraphicScaling,
PixelGraphicNearNeighbour,
PixelGraphicSimpleScaling,
PixelGraphicHighQualityScaling,
PixelGraphicPhotographicScaling,
EmulThemes,
EmulatorInterfaces,
DisassemblerWindow;
{%region public }
const
SYSTEM_OBJECT_GUID = '{74C86B60-AC5B-4E8D-8ACD-29A50B5C151C}';
type
SystemObject = interface;
FontsNotFoundException = class;
RecordingThread = class;
EmulationObject = class;
EmulationRefCountObject = class;
TEmulationForm = class;
EmulationOfFileStream = class;
EmulationOfFileEnumeration = class;
EmulationOfUnicodeFont = class;
EmulationOfPlayer = class;
EmulationOfPlayerPCM = class;
EmulationOfPlayerMIDI = class;
PMalikDataDescriptor = ^MalikDataDescriptor;
PMalikFileAttributes = ^MalikFileAttributes;
PMalikFileInfo = ^MalikFileInfo;
PMalikGraphicBuffer = ^MalikGraphicBuffer;
PMalikGraphicBufferWithAlpha = ^MalikGraphicBufferWithAlpha;
PMalikGUIElementDraw = ^MalikGUIElementDraw;
PMalikStretchDraw = ^MalikStretchDraw;
PMalikTextDraw = ^MalikTextDraw;
MalikDataDescriptor = packed record
count: int;
address: int;
end;
MalikFileAttributes = packed record
creationTime: long;
lastAccessTime: long;
lastWriteTime: long;
attributes: int;
reserved: int;
end;
MalikFileInfo = packed record
attributes: MalikFileAttributes;
size: long;
nameLength: int;
nameAddress: int;
end;
MalikGraphicBuffer = packed record
base: int;
scanline: int;
width: short;
height: short;
end;
MalikGraphicBufferWithAlpha = packed record
case int of
0: (base: int;
scanline: int;
width: short;
height: short;
supportsAlpha: boolean);
1: (buffer: MalikGraphicBuffer;
reserved: int);
end;
MalikGUIElementDraw = packed record
dst: MalikGraphicBufferWithAlpha;
left: short;
top: short;
width: short;
height: short;
element: int;
end;
MalikStretchDraw = packed record
dst: MalikGraphicBufferWithAlpha;
left: short;
top: short;
width: short;
height: short;
src: MalikGraphicBufferWithAlpha;
transform: int;
end;
MalikTextDraw = packed record
dst: MalikGraphicBufferWithAlpha;
handle: int;
style: int;
x: short;
y: short;
color: int;
charsCount: int;
charsAddress: int;
end;
SystemObject_Array1d = packed array of SystemObject;
SystemObject = interface(_Interface) [SYSTEM_OBJECT_GUID]
function syscall(func, param: int): long;
end;
FontsNotFoundException = class(Exception)
public
constructor create(); overload;
constructor create(const message: AnsiString); overload;
end;
RecordingThread = class(Thread)
private
isBusy: boolean;
isStop: boolean;
isPause: boolean;
isClosed: boolean;
pauseTime: long;
canvasWidth: int;
canvasHeight: int;
currFrameTime: long;
nextFrameTime: long;
prevFramePixels: int_Array1d;
currFramePixels: int_Array1d;
nextFramePixels: int_Array1d;
pngData: byte_Array1d;
frameEvent: THandle;
apngFileName: AnsiString;
function isRowsEquals(rowIndex: int): boolean;
function isColsEquals(colIndex, rowOffset, rowLength: int): boolean;
function isNextFrameEquals(nextFramePixels: PIntArray; nextFrameScanline, nextFrameWidth, nextFrameHeight: int): boolean;
function toPNGData(left, top, width, height: int; opaque: boolean): int;
public
constructor create(const apngFileName: AnsiString; mainFramePixels: PIntArray; mainFrameScanline, mainFrameWidth, mainFrameHeight: int);
destructor destroy; override;
procedure run(); override;
procedure addFrame(nextFramePixels: PIntArray; nextFrameScanline, nextFrameWidth, nextFrameHeight: int);
procedure pause();
procedure stop();
function isPaused(): boolean;
private
class procedure writePNGChunk(pngChunk: ByteArrayOutputStream; crc: Checksum32; dataStream: DataOutput); static;
end;
EmulationObject = class(_Object)
protected
TEmulationForm_self: TEmulationForm;
public
constructor create(TEmulationForm_self: TEmulationForm);
end;
EmulationRefCountObject = class(RefCountInterfacedObject)
protected
TEmulationForm_self: TEmulationForm;
public
constructor create(TEmulationForm_self: TEmulationForm);
end;
TEmulationForm = class(TForm, _Interface, Runnable, GraphicListener, TimerHandler, PlayerPCMListener, PlayerMIDIListener, ProcessorListener, SystemObject, EmulationWindowInterface)
fps: TTimer;
panelView: TPanel;
sbtnViewRotateLeft: TSpeedButton;
sbtnViewRotateRight: TSpeedButton;
sbtnViewZoomIn: TSpeedButton;
sbtnViewZoomOut: TSpeedButton;
panelMonitor: TPanel;
sbtnMonitorAdjustSize: TSpeedButton;
sbtnMonitorFullScreen: TSpeedButton;
sbtnMonitorRecordStart: TSpeedButton;
sbtnMonitorRecordStop: TSpeedButton;
status: TStatusBar;
disassembler: TDisassemblerForm;
procedure formKeyPressed(sender: TObject; var key: Word; shift: TShiftState);
procedure formKeyReleased(sender: TObject; var key: Word; shift: TShiftState);
procedure formUTF8KeyPressed(sender: TObject; var utf8Key: TUTF8Char);
procedure formPointerPressed(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: integer);
procedure formPointerDragged(sender: TObject; shift: TShiftState; x, y: integer);
procedure formPointerReleased(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: integer);
procedure formScrollingWheelDown(sender: TObject; shift: TShiftState; pointerCoordinates: TPoint; var handled: boolean);
procedure formScrollingWheelUp(sender: TObject; shift: TShiftState; pointerCoordinates: TPoint; var handled: boolean);
procedure formWindowStateChange(sender: TObject);
procedure formResize(sender: TObject);
procedure formPaint(sender: TObject);
procedure formClose(sender: TObject; var action: TCloseAction);
procedure fpsTimer(sender: TObject);
procedure buttonClick(sender: TObject);
strict private
owner: MainWindowInterface;
runningProgrammeID: AnsiString;
runningProgrammeInfo: ProgrammeInfo;
ptimer: Timer;
recording: RecordingThread;
processor: MalikProcessor;
context: MalikDebugContext;
contextID: int;
frames: int;
windowHandle: int;
closeOnTerminate: boolean;
nowDebugging: boolean;
debug: boolean;
pause: boolean;
suspend: boolean;
terminated: boolean;
modeChanging: boolean;
hostPressed: boolean;
keyPressed: int;
normalScreenZoom: int;
prevWindowState: TWindowState;
data: long_Array1d;
procedure windowActivate(active: boolean);
procedure processorBegin();
procedure processorEnd();
procedure debugBegin();
procedure debugEnd();
procedure recalculateStatusPanelsWidth();
procedure screenUpdate(fromProgramme: boolean);
function playerPCMCreate(signalParameters, blockLength: int): int;
function playerPCMLoadBlock(playerHandle, descriptorAddress: int): int;
function playerPCMPlayback(playerHandle, command: int): int;
function playerPCMGetState(playerHandle: int): int;
function playerPCMSetPosition(playerHandle, position: int): int;
function playerPCMGetPosition(playerHandle: int): long;
function playerPCMVolume(playerHandle, volume: int): int;
function playerPCMDestroy(playerHandle: int): int;
function playerMIDICreate(): int;
function playerMIDILoadBlock(playerHandle, descriptorAddress: int): int;
function playerMIDIPlayback(playerHandle, command: int): int;
function playerMIDIGetState(playerHandle: int): int;
function playerMIDISetPosition(playerHandle, position: int): int;
function playerMIDIGetPosition(playerHandle: int): long;
function playerMIDIVolume(playerHandle, volume: int): int;
function playerMIDIDestroy(playerHandle: int): int;
function getPlayerPCM(playerHandle: int): PlayerPCM;
function getPlayerMIDI(playerHandle: int): PlayerMIDI;
function readNullTerminatedUnicodeString(address: int): UnicodeString;
strict private
guiTheme: Theme;
scalingAlgorithm: PixelGraphicScalingAlgorithm;
maximumFrames: int;
renderInProgress: boolean;
resolutionChanged: boolean;
sourceImagePixels: PIntArray;
sourceImageScanline: int;
sourceImageWidth: int;
sourceImageHeight: int;
sourceImageBitmap: TBitmap;
rotatedImageBitmap: TBitmap;
rotatedImagePixels: PIntArray;
rotatedImageScanline: int;
scaledImageBitmap: TBitmap;
scaledImagePixels: PIntArray;
outputImage: TBitmap;
screenImageAddress: int;
screenImagePixels: PIntArray;
screenImageScanline: int;
screenImageWidth: int;
screenImageHeight: int;
screenRotate: int;
screenZoom: int;
screenLeft: int;
screenTop: int;
outputGraphicWidth: int;
outputGraphicHeight: int;
outputGraphicScanline: int;
outputGraphicPixels: PIntArray;
outputGraphicWithAlpha: boolean;
inputGraphicWithAlpha: boolean;
procedure createSystemMenu();
procedure startRecording();
procedure stopRecording();
procedure zoomIn();
procedure zoomOut();
procedure rotateLeft();
procedure rotateRight();
procedure adjustMonitorSize();
procedure switchFullScreenMode();
procedure switchToolBarsVisible();
procedure setScaledImageSize(width, height: int);
procedure setFullScreenMode(fullScreen: boolean);
procedure setMonitorSize(width, height: int);
procedure setOutputAreaBounds(left, top, width, height: int);
function isOutputGraphicInvalid(): boolean;
function isFullScreenMode(): boolean;
function getMonitorWidth(): int;
function getMonitorHeight(): int;
function getOutputAreaLeft(): int;
function getOutputAreaTop(): int;
function getOutputAreaWidth(): int;
function getOutputAreaHeight(): int;
function getVirtualCoordinates(x, y: int; virtualCoordinates: PPoint): boolean;
function fileOpen(fileNameAddress, mode: int): int;
function fileDelete(fileNameAddress: int): int;
function fileFind(fileNameAddress, descriptorAddress: int): int;
function fileMove(sourceFileNameAddress, destinationFileNameAddress: int): int;
function fileReadAttr(fileNameAddress, descriptorAddress: int): int;
function fileWriteAttr(fileNameAddress, descriptorAddress: int): int;
function directoryCreate(directoryNameAddress: int): int;
function directoryDelete(directoryNameAddress: int): int;
function screenUpdateQuery(): int;
function screenReadBuffer(): int;
function screenGetBuffer(descriptorAddress: int): int;
function screenSetBuffer(descriptorAddress: int): int;
function screenGetGUIElementMinSizes(element: int): int;
function screenDrawGUIElement(descriptorAddress: int): int;
function screenGetSystemColor(index: int): int;
function screenStretchDraw(descriptorAddress: int): int;
function screenCharsGetWidth(descriptorAddress: int): int;
function screenCharsOutput(descriptorAddress: int): int;
function screenFontInstall(fontNameAddress, fileNameAddress: int): int;
function screenFontUninstall(fontHandle: int): int;
function timerSetInterval(milliseconds: long): int;
function timerGetRemainingTime(): long;
function inoutGetKeyboardLightState(): int;
strict private
systemObjects: SystemObject_Array1d;
systemObjectsCount: int;
function addSystemObject(obj: SystemObject): int;
function nextSystemObject(handle: int; objClass: TClass): int;
function handleSystemObject(func: int; param: long): long;
private
function getSystemObject(handle: int): SystemObject;
function closeSystemObject(handle: int; objClass: TClass): boolean;
function malikFileNameToOS(const fileName: UnicodeString): UnicodeString;
function malikFileCheckAccess(const fileName: UnicodeString; forWrite: boolean): boolean;
procedure writeFileInfoToProcessor(descriptorAddress: int; const findData: Windows.WIN32_FIND_DATAW);
private
procedure postMessage(msg: int); overload;
procedure postMessage(msg, wparam, lparam: int); overload;
function sendMessage(msg: int): int; overload;
function sendMessage(msg, wparam, lparam: int): int; overload;
protected
procedure wndProc(var theMessage: TLMessage); override;
public
constructor create(theOwner: TComponent); override;
destructor destroy; override;
{ _Interface }
function getClass(): _Class;
function asObject(): TObject;
{ Runnable }
procedure run();
{ GraphicListener }
procedure putPixel(x, y, argb: int);
{ TimerHandler }
procedure timerHandle(timer: Timer; millisecondsElapsed: long);
{ PlayerPCMListener }
procedure loadPCMBlock(player: PlayerPCM; blockIndex: int);
{ PlayerMIDIListener }
procedure endMIDITrack(player: PlayerMIDI);
{ ProcessorListener }
procedure programmePause();
procedure programmeResume();
procedure programmeTerminated();
procedure programmeBreakpoint();
procedure instructionExecuting(contextID: int);
function getCurrentUTCOffset(): int;
function getCurrentUTCTime(): long;
function getMilliseconds(): long;
function syscall(func: int; argument: long): long; overload;
{ SystemObject }
function syscall(func, param: int): long; overload;
{ EmulationWindowInterface }
procedure showEmulationWindow();
procedure showDisassemblerWindow();
procedure setDebug(debug: boolean);
function isNowDebugging(): boolean;
function getMalikProcessor(): MalikProcessor;
function getMainWindow(): MainWindowInterface;
function getProgrammeDirectory(): AnsiString;
{ Собственные методы }
procedure setProgramme(const id: AnsiString; info: ProgrammeInfo);
procedure runProgramme();
procedure showExecutionStatus(const statusText: AnsiString);
procedure showRecordingStatus(const statusText: AnsiString);
procedure showScreenZoomStatus(screenZoom: int);
procedure showFramesPerSecondStatus(fps: int);
private class var
STR_TOOLBARS: UnicodeString;
protected const
ID_TOOLBARS = int(1);
protected const
DIRECTORY_FONTS = 'fonts';
DIRECTORY_VIDEO = 'video';
protected const
EM_PROCESSOR_BEGIN = int(LM_USER + 1);
EM_PROCESSOR_END = int(LM_USER + 2);
EM_DEBUG_BEGIN = int(LM_USER + 3);
EM_DEBUG_END = int(LM_USER + 4);
EM_SCREEN_UPDATE = int(LM_USER + 5);
EM_SYSCALL = int(LM_USER + $400);
EM_PLAYER_PCM_CREATE = int(EM_SYSCALL + $0030);
EM_PLAYER_PCM_LOAD_BLOCK = int(EM_SYSCALL + $0031);
EM_PLAYER_PCM_PLAYBACK_CONTROL = int(EM_SYSCALL + $0032);
EM_PLAYER_PCM_GET_STATE = int(EM_SYSCALL + $0033);
EM_PLAYER_PCM_BLOCK_SEEK = int(EM_SYSCALL + $0034);
EM_PLAYER_PCM_GET_BLOCK_INDEX = int(EM_SYSCALL + $0035);
EM_PLAYER_PCM_VOLUME_CONTROL = int(EM_SYSCALL + $0036);
EM_PLAYER_PCM_DESTROY = int(EM_SYSCALL + $0037);
EM_PLAYER_MIDI_CREATE = int(EM_SYSCALL + $0038);
EM_PLAYER_MIDI_LOAD_BLOCK = int(EM_SYSCALL + $0039);
EM_PLAYER_MIDI_PLAYBACK_CONTROL = int(EM_SYSCALL + $003a);
EM_PLAYER_MIDI_GET_STATE = int(EM_SYSCALL + $003b);
EM_PLAYER_MIDI_BLOCK_SEEK = int(EM_SYSCALL + $003c);
EM_PLAYER_MIDI_GET_BLOCK_INDEX = int(EM_SYSCALL + $003d);
EM_PLAYER_MIDI_VOLUME_CONTROL = int(EM_SYSCALL + $003e);
EM_PLAYER_MIDI_DESTROY = int(EM_SYSCALL + $003f);
protected const
TRANSFORM_NONE = int(0);
TRANSFORM_ROTATE_90 = int(1);
TRANSFORM_ROTATE_180 = int(2);
TRANSFORM_ROTATE_270 = int(3);
TRANSFORM_MIRROR = int(4);
TRANSFORM_MIRROR_ROTATE_90 = int(5);
TRANSFORM_MIRROR_ROTATE_180 = int(6);
TRANSFORM_MIRROR_ROTATE_270 = int(7);
end;
EmulationOfFileStream = class(EmulationRefCountObject, SystemObject)
strict private
invalidHandle: boolean;
fileInput: Input;
fileOutput: Output;
function write(param: int): int;
function read(param: int): int;
function seek(param: int): int;
function size(): long;
function truncate(): long;
public
constructor create(TEmulationForm_self: TEmulationForm; const fileName: UnicodeString; mode: int);
function syscall(func, param: int): long;
function isInvalidHandle(): boolean;
end;
EmulationOfFileEnumeration = class(EmulationRefCountObject, SystemObject)
strict private
handle: int;
directory: boolean;
fileName: UnicodeString;
function findNext(param: int): int;
public
constructor create(TEmulationForm_self: TEmulationForm; handle: int; directory: boolean; const fileName: UnicodeString);
destructor destroy; override;
function syscall(func, param: int): long;
end;
EmulationOfUnicodeFont = class(EmulationRefCountObject, SystemObject)
strict private
font: UnicodeFont;
function getNameAndLength(nameDestAddress: int): int;
function getFontInfo(): int;
function getCharSupport(code: int): int;
public
constructor create(TEmulationForm_self: TEmulationForm; const fontName, fileName: AnsiString);
destructor destroy; override;
function syscall(func, param: int): long;
function getFont(): UnicodeFont;
end;
EmulationOfPlayer = class(EmulationRefCountObject, SystemObject)
private
handle: int;
soundPlayer: Player;
public
constructor create(TEmulationForm_self: TEmulationForm; soundPlayer: Player);
destructor destroy; override;
function syscall(func, param: int): long;
end;
EmulationOfPlayerPCM = class(EmulationOfPlayer)
public
constructor create(TEmulationForm_self: TEmulationForm; soundPlayer: PlayerPCM);
end;
EmulationOfPlayerMIDI = class(EmulationOfPlayer)
public
constructor create(TEmulationForm_self: TEmulationForm; soundPlayer: PlayerMIDI);
end;
{%endregion}
implementation
{$R *.LFM}
{%region private }
var
internalCounter: int = $007fffff;
{%endregion}
{%region routine }
function getInternalCounterValue(): int; assembler; nostackframe;
asm
mov eax, $00000001
lock xadd dword[internalCounter], eax
lea eax, [eax+$01]
end;
function SystemObject_Array1d_create(length: int): SystemObject_Array1d;
begin
setLength(result, length);
end;
procedure arraycopy(const src: SystemObject_Array1d; srcOffset: int; const dst: SystemObject_Array1d; dstOffset: int; length: int); overload;
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure intArrayCopy(src: PIntArray; srcOffset: int; dst: PIntArray; dstOffset: int; length: int); overload; stdcall; assembler;
asm
mov ecx, [length]
cmp ecx, $00
jg @0
leave
ret $14
@0: push esi
push edi
mov eax, [src]
mov edx, [srcOffset]
lea esi, [eax+edx*4]
mov eax, [dst]
mov edx, [dstOffset]
lea edi, [eax+edx*4]
cld
rep movsd
pop edi
pop esi
end;
procedure opaquePixelsArrayCopy(src: PIntArray; srcOffset: int; dst: PIntArray; dstOffset: int; length: int); overload; stdcall; assembler;
asm
mov ecx, [length]
cmp ecx, $00
jg @0
leave
ret $14
@0: push esi
push edi
mov eax, [src]
mov edx, [srcOffset]
lea esi, [eax+edx*4]
mov eax, [dst]
mov edx, [dstOffset]
lea edi, [eax+edx*4]
cld
@1: lodsd
and eax, $00ffffff
stosd
loop @1
pop edi
pop esi
end;
procedure sortStrings(const strings: UnicodeString_Array1d);
var
g: int;
i: int;
j: int;
e: UnicodeString;
f: UnicodeString;
begin
g := length(strings);
for i := 0 to g - 2 do begin
e := strings[i];
for j := i + 1 to g - 1 do begin
f := strings[j];
if f < e then begin
strings[i] := f;
strings[j] := e;
e := f;
end;
end;
end;
end;
function systemTimeToMalik(const systime: Windows.SYSTEMTIME): long;
var
mtime: DateTimeRecord absolute result;
begin
result := 0;
mtime.year := systime.year;
mtime.month := byte(systime.month);
mtime.day := byte(systime.day);
mtime.hour := byte(systime.hour);
mtime.minute := byte(systime.minute);
mtime.millisecond := Word(1000 * systime.second + systime.millisecond);
end;
function fileTimeToMalik(const filetime: Windows.FILETIME): long;
var
stime: Windows.SYSTEMTIME;
begin
initialize(stime);
if Windows.fileTimeToSystemTime(@filetime, @stime) then begin
result := systemTimeToMalik(stime);
exit;
end;
result := 0;
end;
function malikTimeToFile(maliktime: long; filetime: Windows.PFILETIME): boolean;
var
mtime: DateTimeRecord absolute maliktime;
stime: Windows.SYSTEMTIME;
ms: int;
begin
ms := int(mtime.millisecond);
stime.year := mtime.year;
stime.month := Word(mtime.month);
stime.day := Word(mtime.day);
stime.hour := Word(mtime.hour);
stime.minute := Word(mtime.minute);
stime.second := Word(ms div 1000);
stime.millisecond := Word(ms mod 1000);
result := int(Windows.systemTimeToFileTime(@stime, filetime)) <> 0;
end;
{%endregion}
{%region FontsNotFoundException }
constructor FontsNotFoundException.create();
begin
inherited create();
end;
constructor FontsNotFoundException.create(const message: AnsiString);
begin
inherited create(message);
end;
{%endregion}
{%region RecordingThread }
function RecordingThread.isRowsEquals(rowIndex: int): boolean;
var
i: int;
cwid: int;
index: int;
frame0: int_Array1d;
frame1: int_Array1d;
begin
cwid := canvasWidth;
index := rowIndex * cwid;
frame0 := prevFramePixels;
frame1 := currFramePixels;
for i := 0 to cwid - 1 do begin
if (frame0[index] and $00ffffff) <> (frame1[index] and $00ffffff) then begin
result := false;
exit;
end;
inc(index);
end;
result := true;
end;
function RecordingThread.isColsEquals(colIndex, rowOffset, rowLength: int): boolean;
var
i: int;
cwid: int;
index: int;
frame0: int_Array1d;
frame1: int_Array1d;
begin
cwid := canvasWidth;
index := rowOffset * cwid + colIndex;
frame0 := prevFramePixels;
frame1 := currFramePixels;
for i := 0 to rowLength - 1 do begin
if (frame0[index] and $00ffffff) <> (frame1[index] and $00ffffff) then begin
result := false;
exit;
end;
inc(index, cwid);
end;
result := true;
end;
function RecordingThread.isNextFrameEquals(nextFramePixels: PIntArray; nextFrameScanline, nextFrameWidth, nextFrameHeight: int): boolean;
var
x: int;
y: int;
frame0Delta: int;
frame0Index: int;
frame0Pixels: PIntArray;
frame1Delta: int;
frame1Index: int;
frame1Pixels: PIntArray;
begin
frame0Delta := canvasWidth - nextFrameWidth;
frame0Index := 0;
frame0Pixels := PIntArray(self.nextFramePixels);
frame1Delta := nextFrameScanline - nextFrameWidth;
frame1Index := 0;
frame1Pixels := nextFramePixels;
for y := 0 to nextFrameHeight - 1 do begin
for x := 0 to nextFrameWidth - 1 do begin
if (frame0Pixels[frame0Index] and $00ffffff) <> (frame1Pixels[frame1Index] and $00ffffff) then begin
result := false;
exit;
end;
inc(frame0Index);
inc(frame1Index);
end;
inc(frame0Index, frame0Delta);
inc(frame1Index, frame1Delta);
end;
result := true;
end;
function RecordingThread.toPNGData(left, top, width, height: int; opaque: boolean): int;
var
x: int;
y: int;
cwid: int;
delta: int;
index: int;
pixel: int;
frame0: int_Array1d;
frame1: int_Array1d;
filterStart: int;
filterIndex: int;
lineIndex: int;
lineData: byte_Array1d;
begin
cwid := canvasWidth;
delta := cwid - width;
index := left + top * cwid;
frame0 := prevFramePixels;
frame1 := currFramePixels;
lineIndex := 0;
lineData := self.pngData;
for y := 0 to height - 1 do begin
lineData[lineIndex] := $01; { тип фильтрации - вычитание (1) }
inc(lineIndex);
filterStart := lineIndex + 4;
for x := 0 to width - 1 do begin
pixel := frame1[index] and $00ffffff;
if opaque or (pixel <> (frame0[index] and $00ffffff)) then begin
lineData[lineIndex + 0] := byte(pixel shr 16); { R - уровень красного }
lineData[lineIndex + 1] := byte(pixel shr 8); { G - уровень зелёного }
lineData[lineIndex + 2] := byte(pixel); { B - уровень синего }
lineData[lineIndex + 3] := byte($ff); { A - уровень непрозрачного }
end else begin
lineData[lineIndex + 0] := byte($00);
lineData[lineIndex + 1] := byte($00);
lineData[lineIndex + 2] := byte($00);
lineData[lineIndex + 3] := byte($00);
end;
inc(lineIndex, 4);
inc(index);
end;
{ применение типа фильтрации }
for filterIndex := lineIndex - 1 downto filterStart do begin
dec(lineData[filterIndex], lineData[filterIndex - 4]);
end;
inc(index, delta);
end;
result := lineIndex;
end;
constructor RecordingThread.create(const apngFileName: AnsiString; mainFramePixels: PIntArray; mainFrameScanline, mainFrameWidth, mainFrameHeight: int);
var
len: int;
line: int;
pixels: int_Array1d;
eventName: AnsiString;
begin
inherited create(nil, '', false);
len := mainFrameWidth * mainFrameHeight;
pixels := int_Array1d_create(len);
for line := 0 to mainFrameHeight - 1 do begin
intArrayCopy(mainFramePixels, line * mainFrameScanline, PIntArray(pixels), line * mainFrameWidth, mainFrameWidth);
end;
eventName := 'Event.' + toDecString(int(Windows.getCurrentProcessId())) + '.' + toDecString(int(Windows.getCurrentThreadId())) + '.' + toDecString(getInternalCounterValue());
self.canvasWidth := mainFrameWidth;
self.canvasHeight := mainFrameHeight;
self.nextFrameTime := Windows.getTickCount64();
self.prevFramePixels := int_Array1d_create(len);
self.currFramePixels := int_Array1d_create(len);
self.nextFramePixels := pixels;
self.pngData := byte_Array1d_create((4 * mainFrameWidth + 1) * mainFrameHeight);
self.frameEvent := Windows.createEventA(nil, false, false, PChar(eventName));
self.apngFileName := apngFileName;
end;
destructor RecordingThread.destroy;
begin
Windows.closeHandle(frameEvent);
inherited destroy;
end;
procedure RecordingThread.run();
var
frameEvent: THandle;
canvasWidth: int;
canvasHeight: int;
frameCounter: int;
blockCounter: int;
left: int;
top: int;
width: int;
height: int;
temp: int;
actlPosition: long;
crc: Checksum32;
apngStream: FileStream;
dataStream: DataOutput;
apngChunk: ByteArrayOutputStream;
dataChunk: DataOutput;
pngData: byte_Array1d;
begin
try
apngStream := FileStream.create(apngFileName);
if apngStream.isInvalidHandle() then begin
apngStream.free();
exit;
end;
frameEvent := self.frameEvent;
canvasWidth := self.canvasWidth;
canvasHeight := self.canvasHeight;
frameCounter := 0;
blockCounter := 0;
pngData := self.pngData;
{ PNG }
crc := Crc32.create();
dataStream := DataOutputStream.create(apngStream);
dataStream.writeLong($89504e470d0a1a0a); { магическое число }
{ IHDR }
apngChunk := ByteArrayOutputStream.create();
dataChunk := DataOutputStream.create(apngChunk);
dataChunk.writeInt($49484452);
dataChunk.writeInt(canvasWidth); { ширина холста }
dataChunk.writeInt(canvasHeight); { высота холста }
dataChunk.writeByte($08); { глубина цвета }
dataChunk.writeByte($06); { тип пикселей - RGBA }
dataChunk.writeByte($00); { алгоритм сжатия - только Deflate (0) }
dataChunk.writeByte($00); { алгоритм фильтрации - адаптивная фильтрация с пятью типами (0) }
dataChunk.writeByte($00); { алгоритм передачи данных - по умолчанию (0) }
writePNGChunk(apngChunk, crc, dataStream);
{ tEXt }
apngChunk := ByteArrayOutputStream.create();
dataChunk := DataOutputStream.create(apngChunk);
dataChunk.writeInt($74455874);
dataChunk.writeFully(stringToByteArray('Software'#0'Malik Emulator https://malik-elaborarer.ru/emulator/'));
writePNGChunk(apngChunk, crc, dataStream);
{ acTL }
actlPosition := apngStream.position();
apngChunk := ByteArrayOutputStream.create();
dataChunk := DataOutputStream.create(apngChunk);
dataChunk.writeInt($6163544c);
dataChunk.writeInt(0); { количество кадров анимации - будет определено по окончании записи }
dataChunk.writeInt(1); { количество повторов - 1 }
writePNGChunk(apngChunk, crc, dataStream);
repeat
{ ожидание следующего кадра }
Windows.waitForSingleObject(frameEvent, Windows.INFINITE);
try
{ определение границ кадра }
if (frameCounter and $0f) = 0 then begin
left := 0;
top := 0;
width := canvasWidth;
height := canvasHeight;
end else begin
top := 0;
while (top < canvasHeight) and isRowsEquals(top) do inc(top);
temp := canvasHeight - 1;
while (temp >= 0) and isRowsEquals(temp) do dec(temp);
height := temp - top + 1;
left := 0;
while (left < canvasWidth) and isColsEquals(left, top, height) do inc(left);
temp := canvasWidth - 1;
while (temp >= 0) and isColsEquals(temp, top, height) do dec(temp);
width := temp - left + 1;
end;
{ fcTL }
apngChunk := ByteArrayOutputStream.create();
dataChunk := DataOutputStream.create(apngChunk);
dataChunk.writeInt($6663544c);
dataChunk.writeInt(blockCounter); { порядковый номер куска анимации }
dataChunk.writeInt(width); { ширина кадра }
dataChunk.writeInt(height); { высота кадра }
dataChunk.writeInt(left); { отступ слева кадра }
dataChunk.writeInt(top); { отступ сверху кадра }
dataChunk.writeShort(int(nextFrameTime - currFrameTime)); { задержка кадра }
dataChunk.writeShort(1000); { знаменатель задержки кадра (0.001 с) }
if (frameCounter and $0f) < $0f then begin
dataChunk.writeByte($00); { APNG_DISPOSE_OP_NONE (0) }
end else begin
dataChunk.writeByte($01); { APNG_DISPOSE_OP_BACKGROUND (1) }
end;
dataChunk.writeByte($01); { APNG_BLEND_OP_OVER (1) }
writePNGChunk(apngChunk, crc, dataStream);
inc(blockCounter);
if frameCounter = 0 then begin
temp := toPNGData(left, top, width, height, true);
{ IDAT }
apngChunk := ByteArrayOutputStream.create();
dataChunk := DataOutputStream.create(apngChunk);
dataChunk.writeInt($49444154);
dataChunk.writeFully(Zlib.compress(pngData, 0, temp, 5)); { сжатые данные }
writePNGChunk(apngChunk, crc, dataStream);
end else begin
temp := toPNGData(left, top, width, height, (frameCounter and $0f) = 0);
{ faAT }
apngChunk := ByteArrayOutputStream.create();
dataChunk := DataOutputStream.create(apngChunk);
dataChunk.writeInt($66644154);
dataChunk.writeInt(blockCounter); { порядковый номер куска анимации }
dataChunk.writeFully(Zlib.compress(pngData, 0, temp, 5)); { сжатые данные }
writePNGChunk(apngChunk, crc, dataStream);
inc(blockCounter);
end;
inc(frameCounter);
finally
isBusy := false;
end;
until isStop;
{ IEND }
apngChunk := ByteArrayOutputStream.create();
dataChunk := DataOutputStream.create(apngChunk);
dataChunk.writeInt($49454e44);
writePNGChunk(apngChunk, crc, dataStream);
{ окончание записи }
apngStream.truncate();
apngStream.seek(-apngStream.position() + actlPosition);
{ acTL - запись количества кадров анимации }
apngChunk := ByteArrayOutputStream.create();
dataChunk := DataOutputStream.create(apngChunk);
dataChunk.writeInt($6163544c);
dataChunk.writeInt(frameCounter); { количество кадров анимации }
dataChunk.writeInt(1); { количество повторов - 1 }
writePNGChunk(apngChunk, crc, dataStream);
finally
dataStream := nil;
isClosed := true;
end;
end;
procedure RecordingThread.addFrame(nextFramePixels: PIntArray; nextFrameScanline, nextFrameWidth, nextFrameHeight: int);
var
i: int;
len: int;
srcIndex: int;
dstIndex: int;
canvasWidth: int;
canvasHeight: int;
pausedTime: long;
frame0: int_Array1d;
frame1: int_Array1d;
frame2: int_Array1d;
begin
if isPause then begin
while isBusy do Windows.sleep(1);
isPause := false;
pausedTime := Windows.getTickCount64() - pauseTime;
inc(currFrameTime, pausedTime);
inc(nextFrameTime, pausedTime);
end;
if isBusy then exit;
canvasWidth := self.canvasWidth;
canvasHeight := self.canvasHeight;
if nextFrameWidth > canvasWidth then nextFrameWidth := canvasWidth;
if nextFrameHeight > canvasHeight then nextFrameHeight := canvasHeight;
if isNextFrameEquals(nextFramePixels, nextFrameScanline, nextFrameWidth, nextFrameHeight) then exit;
len := canvasWidth * canvasHeight;
frame0 := self.prevFramePixels;
frame1 := self.currFramePixels;
frame2 := self.nextFramePixels;
currFrameTime := nextFrameTime;
nextFrameTime := Windows.getTickCount64();
intArrayCopy(PIntArray(frame1), 0, PIntArray(frame0), 0, len);
intArrayCopy(PIntArray(frame2), 0, PIntArray(frame1), 0, len);
srcIndex := 0;
dstIndex := 0;
for i := 0 to nextFrameHeight - 1 do begin
intArrayCopy(nextFramePixels, srcIndex, PIntArray(frame2), dstIndex, nextFrameWidth);
inc(srcIndex, nextFrameScanline);
inc(dstIndex, canvasWidth);
end;
isBusy := true;
Windows.setEvent(frameEvent);
end;
procedure RecordingThread.pause();
begin
if isPause then exit;
isPause := true;
pauseTime := Windows.getTickCount64();
end;
procedure RecordingThread.stop();
begin
isStop := true;
Windows.setEvent(frameEvent);
while not isClosed do Windows.sleep(1);
end;
function RecordingThread.isPaused(): boolean;
begin
result := isPause;
end;
class procedure RecordingThread.writePNGChunk(pngChunk: ByteArrayOutputStream; crc: Checksum32; dataStream: DataOutput);
var
bytesChunk: byte_Array1d;
lengthChunk: int;
begin
bytesChunk := pngChunk.toByteArray();
lengthChunk := length(bytesChunk);
crc.reset();
crc.update(bytesChunk, 0, lengthChunk);
dataStream.writeInt(lengthChunk - 4);
dataStream.writeFully(bytesChunk);
dataStream.writeInt(crc.getValue());
end;
{%endregion}
{%region EmulationObject }
constructor EmulationObject.create(TEmulationForm_self: TEmulationForm);
begin
inherited create();
self.TEmulationForm_self := TEmulationForm_self;
end;
{%endregion}
{%region EmulationRefCountObject }
constructor EmulationRefCountObject.create(TEmulationForm_self: TEmulationForm);
begin
inherited create();
self.TEmulationForm_self := TEmulationForm_self;
end;
{%endregion}
{%region TEmulationForm }
procedure TEmulationForm.formKeyPressed(sender: TObject; var key: Word; shift: TShiftState);
var
kstate: Windows.TKeyboardState;
begin
initialize(kstate);
Windows.getKeyboardState(kstate);
if ((key = VK_F4) or (key = VK_SPACE)) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Сочетания клавиш Alt+F4 и Alt+Пробел зарезервированы и не обрабатываются здесь. }
exit;
end;
hostPressed := (kstate[$a5] and $80) <> 0;
if hostPressed then begin
{ Нажата хост-клавиша (правый Alt). }
if (key = VK_M) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+M – показать главное окно }
owner.showMainWindow();
key := 0;
exit;
end;
if (key = VK_T) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+T – показать или скрыть панели инструментов }
switchToolBarsVisible();
key := 0;
exit;
end;
if (key = VK_D) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+D – войти в режим отладки }
showDisassemblerWindow();
key := 0;
exit;
end;
if (key = VK_R) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+R – начать или приостановить запись видео }
startRecording();
key := 0;
exit;
end;
if (key = VK_S) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+S – остановить запись видео }
stopRecording();
key := 0;
exit;
end;
if ((key = VK_OEM_PLUS) or (key = VK_ADD)) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+=, правый Alt+Num+ – увеличить изображение }
zoomIn();
key := 0;
exit;
end;
if ((key = VK_OEM_MINUS) or (key = VK_SUBTRACT)) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+-, правый Alt+Num- – уменьшить изображение }
zoomOut();
key := 0;
exit;
end;
if (key = VK_0) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+0 – повернуть изображение вправо }
rotateRight();
key := 0;
exit;
end;
if (key = VK_9) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+9 – повернуть изображение влево }
rotateLeft();
key := 0;
exit;
end;
if (key = VK_8) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+8 – подогнать размер окна под изображение }
adjustMonitorSize();
key := 0;
exit;
end;
if (key = VK_RETURN) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Правый Alt+Enter – переключение между оконным и полноэкранным режимом }
switchFullScreenMode();
key := 0;
exit;
end;
exit;
end;
if (key >= $00) and (key <= $ff) and (key in [8..9, 13, 16..20, 27, 32..40, 45..46, 48..57, 65..90, 93, 96..135, 144..145, 160..165, 186..192, 219..222]) then begin
{ Если не нажата хост-клавиша, то передаём нажатую клавишу в эмулируемую программу. }
keyPressed := int(key);
if key in [8..9, 13, 16..20, 27, 33..40, 45..46, 93, 112..135, 144..145, 160..165] then begin
processor.interrupt($10, buildLong(keyPressed, 0));
key := 0;
end;
end;
end;
procedure TEmulationForm.formKeyReleased(sender: TObject; var key: Word; shift: TShiftState);
begin
if (key = VK_ESCAPE) and (shift * [ssShift, ssCtrl, ssAlt] = []) and processor.isTerminated() then begin
close();
exit;
end;
if not hostPressed then begin
{ Если не нажата хост-клавиша, то передаём нажатую клавишу в эмулируемую программу. }
processor.interrupt($10, buildLong(int(key), MIN_INT));
end;
end;
procedure TEmulationForm.formUTF8KeyPressed(sender: TObject; var utf8Key: TUTF8Char);
var
charCode: int;
begin
if hostPressed then begin
utf8Key := '';
exit;
end;
charCode := getCharCodes(AnsiString(utf8Key))[0] and $00ffffff;
if (charCode >= 32) then begin
{ Если не нажата хост-клавиша, то передаём нажатую клавишу в эмулируемую программу. }
processor.interrupt($10, buildLong(keyPressed, charCode));
end;
utf8Key := '';
end;
procedure TEmulationForm.formPointerPressed(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: integer);
var
p: TPoint;
b: int;
begin
p.x := 0;
p.y := 0;
if getVirtualCoordinates(x, y, @p) then begin
case button of
mbLeft: begin
b := $00;
end;
mbRight: begin
b := $01;
end;
mbMiddle: begin
b := $02;
end;
else
exit;
end;
processor.interrupt($11, zeroExtend(p.x and $ffff) + zeroExtend((p.y and $ffff) shl 16) + (long(b) shl 32));
end;
end;
procedure TEmulationForm.formPointerDragged(sender: TObject; shift: TShiftState; x, y: integer);
var
p: TPoint;
begin
if shift * [ssLeft, ssRight, ssMiddle] = [] then begin
exit;
end;
p.x := 0;
p.y := 0;
if getVirtualCoordinates(x, y, @p) then begin
processor.interruptIfAllow($11, zeroExtend(p.x and $ffff) + zeroExtend((p.y and $ffff) shl 16) + (long($0f) shl 32));
end;
end;
procedure TEmulationForm.formPointerReleased(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: integer);
var
p: TPoint;
b: int;
begin
p.x := 0;
p.y := 0;
if getVirtualCoordinates(x, y, @p) then begin
case button of
mbLeft: begin
b := $08;
end;
mbRight: begin
b := $09;
end;
mbMiddle: begin
b := $0a;
end;
else
exit;
end;
processor.interrupt($11, zeroExtend(p.x and $ffff) + zeroExtend((p.y and $ffff) shl 16) + (long(b) shl 32));
end;
end;
procedure TEmulationForm.formScrollingWheelDown(sender: TObject; shift: TShiftState; pointerCoordinates: TPoint; var handled: boolean);
var
x: int absolute pointerCoordinates.x;
y: int absolute pointerCoordinates.y;
p: TPoint;
begin
p.x := 0;
p.y := 0;
if getVirtualCoordinates(x, y, @p) then begin
processor.interrupt($11, zeroExtend(p.x and $ffff) + zeroExtend((p.y and $ffff) shl 16) + (long($05) shl 32));
processor.interrupt($11, zeroExtend(p.x and $ffff) + zeroExtend((p.y and $ffff) shl 16) + (long($0d) shl 32));
end;
end;
procedure TEmulationForm.formScrollingWheelUp(sender: TObject; shift: TShiftState; pointerCoordinates: TPoint; var handled: boolean);
var
x: int absolute pointerCoordinates.x;
y: int absolute pointerCoordinates.y;
p: TPoint;
begin
p.x := 0;
p.y := 0;
if getVirtualCoordinates(x, y, @p) then begin
processor.interrupt($11, zeroExtend(p.x and $ffff) + zeroExtend((p.y and $ffff) shl 16) + (long($04) shl 32));
processor.interrupt($11, zeroExtend(p.x and $ffff) + zeroExtend((p.y and $ffff) shl 16) + (long($0c) shl 32));
end;
end;
procedure TEmulationForm.formWindowStateChange(sender: TObject);
var
currWindowState: TWindowState;
prevWindowState: TWindowState;
begin
currWindowState := self.windowState;
prevWindowState := self.prevWindowState;
if (currWindowState = wsMinimized) and (prevWindowState <> wsMinimized) then begin
processor.interrupt($12, long(1) shl 32);
end else
if (currWindowState <> wsMinimized) and (prevWindowState = wsMinimized) then begin
processor.interrupt($12, long(0) shl 32);
end;
self.prevWindowState := currWindowState;
end;
procedure TEmulationForm.formResize(sender: TObject);
var
w: int;
h: int;
begin
recalculateStatusPanelsWidth();
if (processor <> nil) and (not modeChanging) and (not isFullScreenMode()) then begin
w := getMonitorWidth();
h := getMonitorHeight();
processor.interruptIfAllow($13, buildLong(0, zeroExtend(w and $ffff) + zeroExtend((h and $ffff) shl 16)));
end;
end;
procedure TEmulationForm.formPaint(sender: TObject);
var
w: int;
h: int;
img: TBitmap;
scl: TBitmap;
begin
w := getOutputAreaWidth();
h := getOutputAreaHeight();
img := outputImage;
if img = nil then begin
exit;
end;
scl := scaledImageBitmap;
if (img.width <> w) or (img.height <> h) then begin
img.setSize(w, h);
end;
screenLeft := sar(img.width - scl.width, 1);
screenTop := sar(img.height - scl.height, 1);
with img.canvas do begin
brush.style := bsSolid;
brush.color := $000000;
fillRect(bounds(0, 0, img.width, img.height));
draw(screenLeft, screenTop, scl);
end;
self.canvas.draw(getOutputAreaLeft(), getOutputAreaTop(), img);
end;
procedure TEmulationForm.formClose(sender: TObject; var action: TCloseAction);
begin
stopRecording();
if terminated then begin
action := caFree;
exit;
end;
action := caNone;
closeOnTerminate := true;
if nowDebugging then begin
programmeResume();
end;
processor.terminate();
end;
procedure TEmulationForm.fpsTimer(sender: TObject);
begin
showFramesPerSecondStatus(frames);
frames := 0;
end;
procedure TEmulationForm.buttonClick(sender: TObject);
begin
if sender = sbtnViewRotateLeft then begin
rotateLeft();
exit;
end;
if sender = sbtnViewRotateRight then begin
rotateRight();
exit;
end;
if sender = sbtnViewZoomIn then begin
zoomIn();
exit;
end;
if sender = sbtnViewZoomOut then begin
zoomOut();
exit;
end;
if sender = sbtnMonitorAdjustSize then begin
adjustMonitorSize();
exit;
end;
if sender = sbtnMonitorFullScreen then begin
switchFullScreenMode();
exit;
end;
if sender = sbtnMonitorRecordStart then begin
startRecording();
exit;
end;
if sender = sbtnMonitorRecordStop then begin
stopRecording();
exit;
end;
end;
procedure TEmulationForm.windowActivate(active: boolean);
begin
if isFullScreenMode() then begin
if active then begin
windowState := wsMaximized;
end else begin
windowState := wsMinimized;
end;
formWindowStateChange(self);
end;
end;
procedure TEmulationForm.processorBegin();
begin
showExecutionStatus('Выполняется');
sbtnMonitorFullScreen.enabled := true;
if owner.getSetting(SECTION_EMULATOR, KEY_AUTO_FULLSCREEN, '0') = '1' then begin
setFullScreenMode(true);
end;
end;
procedure TEmulationForm.processorEnd();
var
d: TDisassemblerForm;
begin
setFullScreenMode(false);
showExecutionStatus('Завершён');
sbtnMonitorFullScreen.enabled := false;
d := disassembler;
d.caption := d.caption + ' [ПРОГРАММА ЗАВЕРШЕНА]';
terminated := true;
if closeOnTerminate or (owner.getSetting(SECTION_EMULATOR, KEY_AUTO_CLOSEWND, '0') = '1') then begin
close();
end;
end;
procedure TEmulationForm.debugBegin();
var
d: TDisassemblerForm;
begin
showExecutionStatus('Отладка');
d := disassembler;
d.showOnTop();
d.setFocus();
d.showContents(contextID);
end;
procedure TEmulationForm.debugEnd();
begin
showExecutionStatus('Выполняется');
end;
procedure TEmulationForm.recalculateStatusPanelsWidth();
begin
status.panels.items[0].width := clientWidth - 160;
end;
procedure TEmulationForm.screenUpdate(fromProgramme: boolean);
var
x: int;
y: int;
z: int;
w: int;
h: int;
srcScanline: int;
dstScanline: int;
srcPixels: PIntArray;
dstPixels: PIntArray;
recording: RecordingThread;
begin
{ проверка максимума кадров в секунду }
if fromProgramme and (frames >= maximumFrames) then begin
exit;
end;
renderInProgress := true;
try
srcPixels := sourceImagePixels;
dstPixels := rotatedImagePixels;
srcScanline := sourceImageScanline;
dstScanline := rotatedImageScanline;
{ выполняем запись видео, если нужно }
recording := self.recording;
if (recording <> nil) and not recording.isPaused() then begin
recording.addFrame(srcPixels, srcScanline, sourceImageWidth, sourceImageHeight);
end;
{ выполняем поворот изображения }
case screenRotate and 3 of
0: begin { без поворота }
w := sourceImageWidth;
h := sourceImageHeight;
for y := 0 to h - 1 do begin
intArrayCopy(srcPixels, y * srcScanline, dstPixels, y * dstScanline, w);
end;
end;
1: begin { поворот на 90° вправо }
w := sourceImageHeight;
h := sourceImageWidth;
for y := 0 to h - 1 do for x := 0 to w - 1 do begin
dstPixels[x + y * dstScanline] := srcPixels[y + (w - x - 1) * srcScanline];
end;
end;
2: begin { поворот на 180° }
w := sourceImageWidth;
h := sourceImageHeight;
for y := 0 to h - 1 do for x := 0 to w - 1 do begin
dstPixels[x + y * dstScanline] := srcPixels[(w - x - 1) + (h - y - 1) * srcScanline];
end;
end;
3: begin { поворот на 90° влево }
w := sourceImageHeight;
h := sourceImageWidth;
for y := 0 to h - 1 do for x := 0 to w - 1 do begin
dstPixels[x + y * dstScanline] := srcPixels[(h - y - 1) + x * srcScanline];
end;
end;
else
exit;
end;
finally
renderInProgress := false;
end;
{ выполняем масштабирование изображения }
z := screenZoom;
if z = 1 then begin
setScaledImageSize(w, h);
scaledImageBitmap.canvas.copyRect(bounds(0, 0, w, h), rotatedImageBitmap.canvas, bounds(0, 0, w, h));
end else begin
setScaledImageSize(z * w, z * h);
if scalingAlgorithm <> nil then begin
scalingAlgorithm.setSource(dstPixels, w, h, srcScanline);
case z of
2: begin
scalingAlgorithm.scale2x(scaledImagePixels, 2 * w, true);
end;
3: begin
scalingAlgorithm.scale3x(scaledImagePixels, 3 * w, true);
end;
4: begin
scalingAlgorithm.scale4x(scaledImagePixels, 4 * w, true);
end;
end;
end else begin
scaledImageBitmap.canvas.copyRect(bounds(0, 0, z * w, z * h), rotatedImageBitmap.canvas, bounds(0, 0, w, h));
end;
end;
{ выводим изображение на экран }
if resolutionChanged then begin
resolutionChanged := false;
setMonitorSize(screenImageWidth, screenImageHeight);
end;
if fromProgramme then begin
inc(frames);
end;
formPaint(self);
end;
function TEmulationForm.playerPCMCreate(signalParameters, blockLength: int): int;
var
samplesPerSecond: int;
bitsPerSample: int;
channelsCount: int;
soundPlayer: PlayerPCM;
emu: EmulationOfPlayer;
begin
samplesPerSecond := signalParameters and $ffff;
bitsPerSample := (signalParameters shr 16) and $ff;
channelsCount := ((signalParameters shr 24) and $ff) + 1;
soundPlayer := PlayerPCM.create(samplesPerSecond, bitsPerSample, channelsCount, blockLength, self);
if soundPlayer.isInvalidData() or soundPlayer.isNoDevices() then begin
soundPlayer.free();
result := 0;
exit;
end;
emu := EmulationOfPlayerPCM.create(self, soundPlayer);
emu.handle := addSystemObject(emu);
result := emu.handle;
end;
function TEmulationForm.playerPCMLoadBlock(playerHandle, descriptorAddress: int): int;
var
soundPlayer: PlayerPCM;
descriptor: PMalikDataDescriptor;
p: Pointer;
length: int;
data: long_Array1d;
begin
soundPlayer := getPlayerPCM(playerHandle);
if soundPlayer = nil then begin
result := 0;
exit;
end;
descriptor := PMalikDataDescriptor(processor.getMemory(descriptorAddress, sizeof(MalikDataDescriptor)));
if descriptor = nil then begin
result := 0;
exit;
end;
length := descriptor.count;
if (length <= 0) or (length > PlayerPCM.MAX_BLOCK_LENGTH) then begin
result := 0;
exit;
end;
p := processor.getMemory(descriptor.address, length shl 3);
if p = nil then begin
result := 0;
exit;
end;
data := self.data;
if (data = nil) or (System.length(data) < PlayerPCM.MAX_BLOCK_LENGTH) then begin
data := long_Array1d_create(PlayerPCM.MAX_BLOCK_LENGTH);
self.data := data;
end;
System.move(p^, data[0], length shl 3);
result := soundPlayer.loadBlock(data, 0, length);
end;
function TEmulationForm.playerPCMPlayback(playerHandle, command: int): int;
var
soundPlayer: PlayerPCM;
begin
soundPlayer := getPlayerPCM(playerHandle);
if soundPlayer = nil then begin
result := -1;
exit;
end;
case command of
0: begin
result := soundPlayer.reset();
end;
1: begin
result := soundPlayer.start();
end;
2: begin
result := soundPlayer.stop();
end;
else
result := -1;
end;
end;
function TEmulationForm.playerPCMGetState(playerHandle: int): int;
var
soundPlayer: PlayerPCM;
begin
soundPlayer := getPlayerPCM(playerHandle);
if soundPlayer = nil then begin
result := -1;
exit;
end;
result := soundPlayer.getState();
end;
function TEmulationForm.playerPCMSetPosition(playerHandle, position: int): int;
var
soundPlayer: PlayerPCM;
begin
soundPlayer := getPlayerPCM(playerHandle);
if soundPlayer = nil then begin
result := -1;
exit;
end;
result := soundPlayer.setCurrentBlockPosition(position);
end;
function TEmulationForm.playerPCMGetPosition(playerHandle: int): long;
var
soundPlayer: PlayerPCM;
begin
soundPlayer := getPlayerPCM(playerHandle);
if soundPlayer = nil then begin
result := -1;
exit;
end;
result := buildLong(soundPlayer.getCurrentBlockPosition(), soundPlayer.getCurrentBlockIndex());
end;
function TEmulationForm.playerPCMVolume(playerHandle, volume: int): int;
var
soundPlayer: PlayerPCM;
begin
soundPlayer := getPlayerPCM(playerHandle);
if soundPlayer = nil then begin
result := -1;
exit;
end;
if volume = -1 then begin
result := soundPlayer.getVolume();
exit;
end;
result := soundPlayer.setVolume(volume and $7f);
end;
function TEmulationForm.playerPCMDestroy(playerHandle: int): int;
begin
result := 0;
closeSystemObject(playerHandle, EmulationOfPlayerPCM);
end;
function TEmulationForm.playerMIDICreate(): int;
var
soundPlayer: PlayerMIDI;
emu: EmulationOfPlayer;
begin
soundPlayer := PlayerMIDI.create(self);
if soundPlayer.isInvalidData() or soundPlayer.isNoDevices() then begin
soundPlayer.free();
result := 0;
exit;
end;
emu := EmulationOfPlayerMIDI.create(self, soundPlayer);
emu.handle := addSystemObject(emu);
result := emu.handle;
end;
function TEmulationForm.playerMIDILoadBlock(playerHandle, descriptorAddress: int): int;
var
soundPlayer: PlayerMIDI;
descriptor: PMalikDataDescriptor;
p: Pointer;
length: int;
data: long_Array1d;
begin
soundPlayer := getPlayerMIDI(playerHandle);
if soundPlayer = nil then begin
result := 0;
exit;
end;
descriptor := PMalikDataDescriptor(processor.getMemory(descriptorAddress, sizeof(MalikDataDescriptor)));
if descriptor = nil then begin
result := 0;
exit;
end;
length := descriptor.count;
if length = 0 then begin
soundPlayer.sendMessage(descriptor.address);
result := 1;
exit;
end;
if length < 0 then begin
result := 0;
exit;
end;
p := processor.getMemory(descriptor.address, length shl 3);
if p = nil then begin
result := 0;
exit;
end;
data := self.data;
if (data = nil) or (System.length(data) < length) then begin
data := long_Array1d_create(length);
self.data := data;
end;
System.move(p^, data[0], length shl 3);
result := soundPlayer.loadBlock(data, 0, length);
end;
function TEmulationForm.playerMIDIPlayback(playerHandle, command: int): int;
var
soundPlayer: PlayerMIDI;
begin
soundPlayer := getPlayerMIDI(playerHandle);
if soundPlayer = nil then begin
result := -1;
exit;
end;
case command of
0: begin
result := soundPlayer.reset();
end;
1: begin
result := soundPlayer.start();
end;
2: begin
result := soundPlayer.stop();
end;
else
result := -1;
end;
end;
function TEmulationForm.playerMIDIGetState(playerHandle: int): int;
var
soundPlayer: PlayerMIDI;
begin
soundPlayer := getPlayerMIDI(playerHandle);
if soundPlayer = nil then begin
result := -1;
exit;
end;
result := soundPlayer.getState();
end;
function TEmulationForm.playerMIDISetPosition(playerHandle, position: int): int;
var
soundPlayer: PlayerMIDI;
begin
soundPlayer := getPlayerMIDI(playerHandle);
if soundPlayer = nil then begin
result := -1;
exit;
end;
result := soundPlayer.setCurrentBlockPosition(position);
end;
function TEmulationForm.playerMIDIGetPosition(playerHandle: int): long;
var
soundPlayer: PlayerMIDI;
begin
soundPlayer := getPlayerMIDI(playerHandle);
if soundPlayer = nil then begin
result := -1;
exit;
end;
result := buildLong(soundPlayer.getCurrentBlockPosition(), soundPlayer.getCurrentBlockIndex());
end;
function TEmulationForm.playerMIDIVolume(playerHandle, volume: int): int;
var
soundPlayer: PlayerMIDI;
begin
soundPlayer := getPlayerMIDI(playerHandle);
if soundPlayer = nil then begin
result := -1;
exit;
end;
if volume = -1 then begin
result := soundPlayer.getVolume();
exit;
end;
result := soundPlayer.setVolume(volume and $7f);
end;
function TEmulationForm.playerMIDIDestroy(playerHandle: int): int;
begin
result := 0;
closeSystemObject(playerHandle, EmulationOfPlayerMIDI);
end;
function TEmulationForm.getPlayerPCM(playerHandle: int): PlayerPCM;
var
emu: SystemObject;
obj: TObject;
begin
emu := getSystemObject(playerHandle);
if emu = nil then begin
result := nil;
exit;
end;
obj := emu.asObject();
if not (obj is EmulationOfPlayer) then begin
result := nil;
exit;
end;
obj := EmulationOfPlayer(obj).soundPlayer;
if not (obj is PlayerPCM) then begin
result := nil;
exit;
end;
result := PlayerPCM(obj);
end;
function TEmulationForm.getPlayerMIDI(playerHandle: int): PlayerMIDI;
var
emu: SystemObject;
obj: TObject;
begin
emu := getSystemObject(playerHandle);
if emu = nil then begin
result := nil;
exit;
end;
obj := emu.asObject();
if not (obj is EmulationOfPlayer) then begin
result := nil;
exit;
end;
obj := EmulationOfPlayer(obj).soundPlayer;
if not (obj is PlayerMIDI) then begin
result := nil;
exit;
end;
result := PlayerMIDI(obj);
end;
function TEmulationForm.readNullTerminatedUnicodeString(address: int): UnicodeString;
const
MAX_LENGTH = int(1024);
var
i: int;
l: int;
s: PWideChar;
begin
l := MAX_LENGTH;
repeat
s := PWideChar(processor.getMemory(address, l * sizeof(wchar)));
if s <> nil then begin
break;
end;
if l <= 1 then begin
result := '';
exit;
end;
l := sar(l, 1);
until false;
for i := 0 to l - 1 do begin
if s[i] = #$0000 then begin
l := i;
break;
end;
end;
result := UnicodeString_create(l);
move(s[0], result[1], l * sizeof(wchar));
end;
procedure TEmulationForm.createSystemMenu();
var
flags: int;
sysmenu: HMenu;
begin
flags := MF_STRING;
if panelView.visible then begin
flags := flags or MF_CHECKED;
end;
sysmenu := Windows.getSystemMenu(handle, false);
Windows.appendMenuW(sysmenu, MF_SEPARATOR, 0, '');
Windows.appendMenuW(sysmenu, flags, ID_TOOLBARS, PWideChar(STR_TOOLBARS));
end;
procedure TEmulationForm.startRecording();
var
number: int;
canvasWidth: int;
canvasHeight: int;
recording: RecordingThread;
apngFileName: AnsiString;
probeFileName: AnsiString;
begin
canvasWidth := sourceImageWidth;
canvasHeight := sourceImageHeight;
recording := self.recording;
if (recording = nil) and (canvasWidth > 0) and (canvasHeight > 0) then begin
apngFileName := getEmulatorDirectory() + DIRECTORY_VIDEO;
if not fileExists(apngFileName) then begin
createDirectory(apngFileName);
end;
apngFileName := apngFileName + DIRECTORY_SEPARATOR + caption + ' ';
for number := 1 to MAX_INT do begin
probeFileName := apngFileName + '(' + toDecString(number) + ').png';
if not fileExists(probeFileName) then begin
apngFileName := probeFileName;
break;
end;
end;
recording := RecordingThread.create(apngFileName, sourceImagePixels, sourceImageScanline, canvasWidth, canvasHeight);
recording.start();
self.recording := recording;
showRecordingStatus('ЗАП');
sbtnMonitorRecordStop.enabled := true;
end else
if recording <> nil then begin
if recording.isPaused() then begin
recording.addFrame(sourceImagePixels, sourceImageScanline, canvasWidth, canvasHeight);
showRecordingStatus('ЗАП');
end else begin
recording.pause();
showRecordingStatus('пауза');
end;
end;
end;
procedure TEmulationForm.stopRecording();
var
canvasWidth: int;
canvasHeight: int;
blackPixels: int_Array1d;
recording: RecordingThread;
begin
recording := self.recording;
if recording <> nil then begin
canvasWidth := sourceImageWidth;
canvasHeight := sourceImageHeight;
blackPixels := int_Array1d_create(canvasWidth * canvasHeight);
recording.addFrame(PIntArray(blackPixels), canvasWidth, canvasWidth, canvasHeight);
recording.stop();
recording.free();
self.recording := nil;
showRecordingStatus('');
sbtnMonitorRecordStop.enabled := false;
end;
end;
procedure TEmulationForm.zoomIn();
begin
if screenZoom < 4 then begin
inc(screenZoom);
showScreenZoomStatus(screenZoom);
sbtnViewZoomIn.enabled := screenZoom < 4;
sbtnViewZoomOut.enabled := true;
resolutionChanged := true;
screenUpdate(false);
end;
end;
procedure TEmulationForm.zoomOut();
begin
if screenZoom > 1 then begin
dec(screenZoom);
showScreenZoomStatus(screenZoom);
sbtnViewZoomIn.enabled := true;
sbtnViewZoomOut.enabled := screenZoom > 1;
resolutionChanged := true;
screenUpdate(false);
end;
end;
procedure TEmulationForm.rotateLeft();
begin
screenRotate := (screenRotate - 1) and $03;
resolutionChanged := true;
screenUpdate(false);
end;
procedure TEmulationForm.rotateRight();
begin
screenRotate := (screenRotate + 1) and $03;
resolutionChanged := true;
screenUpdate(false);
end;
procedure TEmulationForm.adjustMonitorSize();
begin
setMonitorSize(screenImageWidth, screenImageHeight);
formPaint(self);
end;
procedure TEmulationForm.switchFullScreenMode();
begin
if processor.isExecuting() then begin
setFullScreenMode(borderStyle <> bsNone);
end;
end;
procedure TEmulationForm.switchToolBarsVisible();
var
flags: int;
visible: boolean;
control: TWinControl;
begin
control := panelView;
visible := not control.visible;
flags := MF_BYCOMMAND or MF_STRING;
if visible then begin
flags := flags or MF_CHECKED;
end;
beginFormUpdate();
try
control.visible := visible;
panelMonitor.visible := visible;
Windows.modifyMenuW(Windows.getSystemMenu(handle, false), ID_TOOLBARS, flags, ID_TOOLBARS, PWideChar(STR_TOOLBARS));
finally
endFormUpdate();
end;
end;
procedure TEmulationForm.setScaledImageSize(width, height: int);
var
b: TBitmap;
begin
b := scaledImageBitmap;
if b.empty or (b.width <> width) or (b.height <> height) then begin
scaledImagePixels := createPixelImage(b, width, height);
end;
end;
procedure TEmulationForm.setFullScreenMode(fullScreen: boolean);
var
w: int;
h: int;
monitor: TMonitor;
begin
if fullScreen = isFullScreenMode() then begin
exit;
end;
modeChanging := true;
try
if fullScreen then begin
if (screenRotate and $01) = 0 then begin
w := screenImageWidth;
h := screenImageHeight;
end else begin
w := screenImageHeight;
h := screenImageWidth;
end;
normalScreenZoom := screenZoom;
if (w <> 0) and (h <> 0) then begin
monitor := self.monitor;
screenZoom := min(4, max(1, min(monitor.width div w, monitor.height div h)));
end;
borderStyle := bsNone;
windowState := wsMaximized;
status.visible := false;
sbtnMonitorAdjustSize.enabled := false;
end else begin
sbtnMonitorAdjustSize.enabled := true;
status.visible := true;
windowState := wsNormal;
borderStyle := bsSizeable;
screenZoom := normalScreenZoom;
end;
showScreenZoomStatus(screenZoom);
createSystemMenu();
screenUpdate(false);
finally
windowHandle := handle;
modeChanging := false;
end;
end;
procedure TEmulationForm.setMonitorSize(width, height: int);
var
screenZoom: int;
oldWidth: int;
oldHeight: int;
newWidth: int;
newHeight: int;
begin
if isFullScreenMode() then begin
exit;
end;
screenZoom := self.screenZoom;
oldWidth := getOutputAreaWidth();
oldHeight := getOutputAreaHeight();
if (screenRotate and 1) = 0 then begin
newWidth := width * screenZoom;
newHeight := height * screenZoom;
end else begin
newWidth := height * screenZoom;
newHeight := width * screenZoom;
end;
setOutputAreaBounds(left + sar(oldWidth - newWidth, 1), top + sar(oldHeight - newHeight, 1), newWidth, newHeight);
end;
procedure TEmulationForm.setOutputAreaBounds(left, top, width, height: int);
var
control: TWinControl;
begin
if isFullScreenMode() then begin
exit;
end;
control := panelView;
if control.visible then begin
inc(width, control.width);
end;
control := panelMonitor;
if control.visible then begin
inc(width, control.width);
end;
control := status;
if control.visible then begin
inc(height, control.height);
end;
onResize := nil;
onPaint := nil;
try
setBounds(left, top, width, height);
finally
onResize := formResize;
onPaint := formPaint;
recalculateStatusPanelsWidth();
end;
end;
function TEmulationForm.isOutputGraphicInvalid(): boolean;
begin
result := (outputGraphicPixels = nil) or (abs(outputGraphicScanline) < outputGraphicWidth) or (outputGraphicWidth <= 0) or (outputGraphicHeight <= 0);
end;
function TEmulationForm.isFullScreenMode(): boolean;
begin
result := (not modeChanging) and (borderStyle = bsNone);
end;
function TEmulationForm.getMonitorWidth(): int;
var
size: int;
begin
if (screenRotate and 1) = 0 then begin
size := getOutputAreaWidth();
end else begin
size := getOutputAreaHeight();
end;
result := max(MIN_SCREEN_WIDTH, min(MAX_SCREEN_WIDTH, size div screenZoom));
end;
function TEmulationForm.getMonitorHeight(): int;
var
size: int;
begin
if (screenRotate and 1) <> 0 then begin
size := getOutputAreaWidth();
end else begin
size := getOutputAreaHeight();
end;
result := max(MIN_SCREEN_HEIGHT, min(MAX_SCREEN_HEIGHT, size div screenZoom));
end;
function TEmulationForm.getOutputAreaLeft(): int;
var
control: TWinControl;
begin
control := panelView;
if control.visible then begin
result := control.width;
exit;
end;
result := 0;
end;
function TEmulationForm.getOutputAreaTop(): int;
begin
result := 0;
end;
function TEmulationForm.getOutputAreaWidth(): int;
var
control: TWinControl;
begin
result := clientWidth;
control := panelView;
if control.visible then begin
dec(result, control.width);
end;
control := panelMonitor;
if control.visible then begin
dec(result, control.width);
end;
end;
function TEmulationForm.getOutputAreaHeight(): int;
var
control: TWinControl;
begin
result := clientHeight;
control := status;
if control.visible then begin
dec(result, control.height);
end;
end;
function TEmulationForm.getVirtualCoordinates(x, y: int; virtualCoordinates: PPoint): boolean;
var
r: int;
z: int;
l: int;
t: int;
w: int;
h: int;
begin
dec(x, getOutputAreaLeft());
dec(y, getOutputAreaTop());
r := screenRotate;
z := screenZoom;
l := screenLeft;
t := screenTop;
if (r and $01) = 0 then begin
w := z * sourceImageWidth;
h := z * sourceImageHeight;
end else begin
w := z * sourceImageHeight;
h := z * sourceImageWidth;
end;
if (x < l) or (x >= l + w) or (y < t) or (y >= t + h) then begin
result := false;
exit;
end;
case r and $03 of
0: begin
virtualCoordinates.x := (x - l) div z;
virtualCoordinates.y := (y - t) div z;
end;
1: begin
virtualCoordinates.x := (y - t) div z;
virtualCoordinates.y := (w - x + l) div z;
end;
2: begin
virtualCoordinates.x := (w - x + l) div z;
virtualCoordinates.y := (h - y + t) div z;
end;
3: begin
virtualCoordinates.x := (h - y + t) div z;
virtualCoordinates.y := (x - l) div z;
end;
end;
result := true;
end;
function TEmulationForm.fileOpen(fileNameAddress, mode: int): int;
var
f: UnicodeString;
e: EmulationOfFileStream;
begin
f := readNullTerminatedUnicodeString(fileNameAddress);
if malikFileCheckAccess(f, (mode and $03) <> $01) then begin
result := 0;
exit;
end;
e := EmulationOfFileStream.create(self, malikFileNameToOS(f), mode);
if e.isInvalidHandle() then begin
result := 0;
e.free();
exit;
end;
result := addSystemObject(e);
end;
function TEmulationForm.fileDelete(fileNameAddress: int): int;
var
f: UnicodeString;
begin
f := readNullTerminatedUnicodeString(fileNameAddress);
if malikFileCheckAccess(f, true) then begin
result := 0;
exit;
end;
if deleteFile(malikFileNameToOS(f)) then begin
result := 1;
exit;
end;
result := 0;
end;
function TEmulationForm.fileFind(fileNameAddress, descriptorAddress: int): int;
var
d: boolean;
l: int;
h: int;
r: int;
s: Windows.WIN32_FIND_DATAW;
k: UnicodeString;
n: UnicodeString;
m: UnicodeString;
begin
n := readNullTerminatedUnicodeString(fileNameAddress);
l := length(n);
if (l <= 0) or (n[1] <> '/') then begin
n := '/' + n;
end;
if malikFileCheckAccess(n, false) then begin
result := 0;
exit;
end;
if (l > 0) and (n[l] = '/') then begin
k := n + '*.*';
d := true;
end else begin
k := n;
d := false;
end;
k := malikFileNameToOS(k);
m := n;
initialize(s);
h := int(Windows.findFirstFileW(PWideChar(k), @s));
if h = int(Windows.INVALID_HANDLE_VALUE) then begin
result := 0;
exit;
end;
r := 1;
if d then begin
m := n + UnicodeString(s.cFileName);
end;
while (r <> 0) and malikFileCheckAccess(m, false) do begin
r := int(Windows.findNextFileW(h, @s));
if d then begin
m := n + UnicodeString(s.cFileName);
end;
end;
if r = 0 then begin
Windows.findClose(h);
result := -1;
exit;
end;
writeFileInfoToProcessor(descriptorAddress, s);
result := addSystemObject(EmulationOfFileEnumeration.create(self, h, d, n));
end;
function TEmulationForm.fileMove(sourceFileNameAddress, destinationFileNameAddress: int): int;
var
s: UnicodeString;
d: UnicodeString;
begin
s := readNullTerminatedUnicodeString(sourceFileNameAddress);
d := readNullTerminatedUnicodeString(destinationFileNameAddress);
if malikFileCheckAccess(s, true) or malikFileCheckAccess(d, true) then begin
result := 0;
exit;
end;
if move(malikFileNameToOS(s), malikFileNameToOS(d)) then begin
result := 1;
exit;
end;
result := 0;
end;
function TEmulationForm.fileReadAttr(fileNameAddress, descriptorAddress: int): int;
var
l: int;
h: int;
a: PMalikFileAttributes;
p: MalikProcessor;
s: Windows.WIN32_FIND_DATAW;
f: UnicodeString;
begin
f := readNullTerminatedUnicodeString(fileNameAddress);
l := length(f);
if (l = 0) or (l > 0) and (f[l] = '/') or malikFileCheckAccess(f, false) then begin
result := 0;
exit;
end;
f := malikFileNameToOS(f);
initialize(s);
h := int(Windows.findFirstFileW(PWideChar(f), @s));
if h <> int(Windows.INVALID_HANDLE_VALUE) then begin
Windows.findClose(h);
p := processor;
a := PMalikFileAttributes(p.getMemory(descriptorAddress, sizeof(MalikFileAttributes)));
if a <> nil then begin
a.creationTime := fileTimeToMalik(s.ftCreationTime);
a.lastAccessTime := fileTimeToMalik(s.ftLastAccessTime);
a.lastWriteTime := fileTimeToMalik(s.ftLastWriteTime);
a.attributes := int(s.dwFileAttributes) and $37;
end;
result := 1;
exit;
end;
result := 0;
end;
function TEmulationForm.fileWriteAttr(fileNameAddress, descriptorAddress: int): int;
var
l: int;
r: int;
a: PMalikFileAttributes;
c: Windows.FILETIME;
t: Windows.FILETIME;
w: Windows.FILETIME;
f: UnicodeString;
begin
f := readNullTerminatedUnicodeString(fileNameAddress);
l := length(f);
if (l = 0) or (l > 0) and (f[l] = '/') or malikFileCheckAccess(f, true) then begin
result := 0;
exit;
end;
f := malikFileNameToOS(f);
a := PMalikFileAttributes(processor.getMemory(descriptorAddress, sizeof(MalikFileAttributes)));
if a = nil then begin
result := 0;
exit;
end;
initialize(c);
initialize(t);
initialize(w);
if malikTimeToFile(a.creationTime, @c) and malikTimeToFile(a.lastAccessTime, @t) and malikTimeToFile(a.lastWriteTime, @w) then begin
r := (int(Windows.getFileAttributesW(PWideChar(f))) and $10) or (a.attributes and $27);
if int(Windows.setFileAttributesW(PWideChar(f), Dword(r))) = 0 then begin
result := 0;
exit;
end;
if (r and $10) = 0 then begin
with FileOutputStream.create(f, true) do begin
try
if not isInvalidHandle() then begin
Windows.setFileTime(getHandle(), @c, @t, @w);
end;
finally
free();
end;
end;
end;
result := 1;
exit;
end;
result := 0;
end;
function TEmulationForm.directoryCreate(directoryNameAddress: int): int;
var
d: UnicodeString;
l: int;
begin
d := readNullTerminatedUnicodeString(directoryNameAddress);
l := length(d);
if (l = 0) or (l > 0) and (d[l] = '/') or malikFileCheckAccess(d, true) then begin
result := 0;
exit;
end;
if createDirectory(malikFileNameToOS(d)) then begin
result := 1;
exit;
end;
result := 0;
end;
function TEmulationForm.directoryDelete(directoryNameAddress: int): int;
var
d: UnicodeString;
l: int;
begin
d := readNullTerminatedUnicodeString(directoryNameAddress);
l := length(d);
if (l = 0) or (l > 0) and (d[l] = '/') or malikFileCheckAccess(d, true) then begin
result := 0;
exit;
end;
if deleteDirectory(malikFileNameToOS(d)) then begin
result := 1;
exit;
end;
result := 0;
end;
function TEmulationForm.screenUpdateQuery(): int;
var
i: int;
j: int;
src: PIntArray;
srcLine: int;
srcScanline: int;
dst: PIntArray;
dstLine: int;
dstScanline: int;
begin
if renderInProgress or (frames >= maximumFrames) then begin
result := 0;
exit;
end;
self.sourceImageWidth := self.screenImageWidth;
self.sourceImageHeight := self.screenImageHeight;
if (self.sourceImageWidth > 0) and (self.sourceImageHeight > 0) and not sbtnMonitorRecordStart.enabled then begin
sbtnMonitorRecordStart.enabled := true;
end;
j := self.screenImageWidth;
src := self.screenImagePixels;
srcLine := 0;
srcScanline := self.screenImageScanline;
dst := self.sourceImagePixels;
dstLine := 0;
dstScanline := self.sourceImageScanline;
for i := 0 to self.screenImageHeight - 1 do begin
opaquePixelsArrayCopy(src, srcLine, dst, dstLine, j);
inc(srcLine, srcScanline);
inc(dstLine, dstScanline);
end;
postMessage(EM_SCREEN_UPDATE);
result := 1;
end;
function TEmulationForm.screenReadBuffer(): int;
var
i: int;
j: int;
src: PIntArray;
srcLine: int;
srcScanline: int;
dst: PIntArray;
dstLine: int;
dstScanline: int;
begin
j := self.screenImageWidth;
src := self.sourceImagePixels;
srcLine := 0;
srcScanline := self.sourceImageScanline;
dst := self.screenImagePixels;
dstLine := 0;
dstScanline := self.screenImageScanline;
for i := 0 to self.screenImageHeight - 1 do begin
intArrayCopy(src, srcLine, dst, dstLine, j);
inc(srcLine, srcScanline);
inc(dstLine, dstScanline);
end;
result := 1;
end;
function TEmulationForm.screenGetBuffer(descriptorAddress: int): int;
var
descriptor: PMalikGraphicBuffer;
begin
descriptor := PMalikGraphicBuffer(processor.getMemory(descriptorAddress, sizeof(MalikGraphicBuffer)));
if descriptor = nil then begin
result := 0;
exit;
end;
descriptor.base := screenImageAddress;
descriptor.scanline := screenImageScanline;
descriptor.width := short(screenImageWidth);
descriptor.height := short(screenImageHeight);
result := 1;
end;
function TEmulationForm.screenSetBuffer(descriptorAddress: int): int;
var
descriptor: PMalikGraphicBuffer;
screenPixels: PIntArray;
screenAddress: int;
screenScanline: int;
screenWidth: int;
screenHeight: int;
begin
descriptor := PMalikGraphicBuffer(processor.getMemory(descriptorAddress, sizeof(MalikGraphicBuffer)));
if (descriptor = nil) then begin
result := 0;
exit;
end;
screenAddress := descriptor.base;
screenScanline := descriptor.scanline;
screenWidth := descriptor.width;
screenHeight := descriptor.height;
screenPixels := PIntArray(processor.getMemory(screenAddress, (screenScanline * (screenHeight - 1) + screenWidth) * sizeof(int)));
if
(screenPixels = nil) or (screenScanline < screenWidth) or
(screenWidth < MIN_SCREEN_WIDTH) or (screenWidth > MAX_SCREEN_WIDTH) or
(screenHeight < MIN_SCREEN_HEIGHT) or (screenHeight > MAX_SCREEN_HEIGHT)
then begin
result := 0;
exit;
end;
if (screenWidth <> self.screenImageWidth) or (screenHeight <> self.screenImageHeight) then begin
resolutionChanged := true;
end;
self.screenImagePixels := screenPixels;
self.screenImageAddress := screenAddress;
self.screenImageScanline := screenScanline;
self.screenImageWidth := screenWidth;
self.screenImageHeight := screenHeight;
result := 1;
end;
function TEmulationForm.screenGetGUIElementMinSizes(element: int): int;
begin
result := guiTheme.getSizes(element);
end;
function TEmulationForm.screenDrawGUIElement(descriptorAddress: int): int;
var
i: int;
descriptor: PMalikGUIElementDraw;
begin
descriptor := PMalikGUIElementDraw(processor.getMemory(descriptorAddress, sizeof(MalikGUIElementDraw)));
if (descriptor = nil) or (int(descriptor.width) <= 0) or (int(descriptor.height) <= 0) then begin
result := 0;
exit;
end;
outputGraphicWidth := int(descriptor.dst.width);
outputGraphicHeight := int(descriptor.dst.height);
outputGraphicScanline := descriptor.dst.scanline;
if outputGraphicScanline >= 0 then begin
outputGraphicPixels := PIntArray(processor.getMemory(descriptor.dst.base, (outputGraphicScanline * (outputGraphicHeight - 1) + outputGraphicWidth) * sizeof(int)));
end else begin
i := (-outputGraphicScanline) * (outputGraphicHeight - 1);
outputGraphicPixels := @(PIntArray(processor.getMemory(descriptor.dst.base - i * sizeof(int), (i + outputGraphicWidth) * sizeof(int)))[i]);
end;
outputGraphicWithAlpha := descriptor.dst.supportsAlpha;
inputGraphicWithAlpha := true;
if isOutputGraphicInvalid() then begin
result := 0;
exit;
end;
guiTheme.drawElement(self, descriptor.element, int(descriptor.left), int(descriptor.top), int(descriptor.width), int(descriptor.height));
result := 1;
end;
function TEmulationForm.screenGetSystemColor(index: int): int;
begin
result := guiTheme.getSystemColor(index);
end;
function TEmulationForm.screenStretchDraw(descriptorAddress: int): int;
const
MAX_SIZE = int($1000);
TO_TRANSFORM: array [$00..$0f] of int =
(
TRANSFORM_NONE, TRANSFORM_ROTATE_90, TRANSFORM_ROTATE_180, TRANSFORM_ROTATE_270,
TRANSFORM_MIRROR, TRANSFORM_MIRROR_ROTATE_90, TRANSFORM_MIRROR_ROTATE_180, TRANSFORM_MIRROR_ROTATE_270,
TRANSFORM_MIRROR_ROTATE_180, TRANSFORM_MIRROR_ROTATE_270, TRANSFORM_MIRROR, TRANSFORM_MIRROR_ROTATE_90,
TRANSFORM_ROTATE_180, TRANSFORM_ROTATE_270, TRANSFORM_NONE, TRANSFORM_ROTATE_90
);
var
descriptor: PMalikStretchDraw;
rotate90: boolean;
transform: int;
dstWidth: int;
dstHeight: int;
dstScanline: int;
dstWithAlpha: boolean;
dstPixels: PIntArray;
left: int;
top: int;
width: int;
height: int;
srcWidth: int;
srcHeight: int;
srcScanline: int;
srcWithAlpha: boolean;
srcPixels: PIntArray;
src: int_Array1d;
function isDestinationInvalid(): boolean; inline;
begin
result := (dstPixels = nil) or (abs(dstScanline) < dstWidth) or (dstWidth <= 0) or (dstWidth > MAX_SIZE) or (dstHeight <= 0) or (dstHeight > MAX_SIZE);
end;
function isSourceInvalid(): boolean; inline;
begin
result := (srcPixels = nil) or (srcWidth <= 0) or (srcWidth > MAX_SIZE) or (srcHeight <= 0) or (srcHeight > MAX_SIZE);
end;
function isDrawRegionInvalid(): boolean; inline;
begin
result := (width <= 0) or (width > MAX_SIZE) or (height <= 0) or (height > MAX_SIZE);
end;
function isDrawRegionOutOfBounds(): boolean; inline;
begin
result := (left + width <= 0) or (left >= dstWidth) or (top + height <= 0) or (top >= dstHeight);
end;
function getSrcPixel(x, y: int): int;
var
newX: int;
newY: int;
begin
if x < 0 then begin
x := 0;
end;
if y < 0 then begin
y := 0;
end;
if rotate90 then begin
if x >= srcHeight then begin
x := srcHeight - 1;
end;
if y >= srcWidth then begin
y := srcWidth - 1;
end;
end else begin
if x >= srcWidth then begin
x := srcWidth - 1;
end;
if y >= srcHeight then begin
y := srcHeight - 1;
end;
end;
case transform of
TRANSFORM_NONE: begin
newX := x;
newY := y;
end;
TRANSFORM_ROTATE_90: begin
newX := y;
newY := srcHeight - x - 1;
end;
TRANSFORM_ROTATE_180: begin
newX := srcWidth - x - 1;
newY := srcHeight - y - 1;
end;
TRANSFORM_ROTATE_270: begin
newX := srcWidth - y - 1;
newY := x;
end;
TRANSFORM_MIRROR: begin
newX := srcWidth - x - 1;
newY := y;
end;
TRANSFORM_MIRROR_ROTATE_90: begin
newX := srcWidth - y - 1;
newY := srcHeight - x - 1;
end;
TRANSFORM_MIRROR_ROTATE_180: begin
newX := x;
newY := srcHeight - y - 1;
end;
TRANSFORM_MIRROR_ROTATE_270: begin
newX := y;
newY := x;
end;
else
result := 0;
exit;
end;
result := srcPixels[newX + newY * srcScanline];
end;
function getSrcAveragePixel(x1, y1, x2, y2: real): int;
type
ColorArray = packed array [0..3] of byte;
var
i: int;
x: int;
y: int;
x1int: int;
y1int: int;
x2int: int;
y2int: int;
x1frac: real;
y1frac: real;
x2frac: real;
y2frac: real;
c: real;
s: real;
begin
result := 0;
x1int := toInt(x1);
y1int := toInt(y1);
x2int := toInt(x2);
y2int := toInt(y2);
x1frac := 1.0 - fracPart(x1);
y1frac := 1.0 - fracPart(y1);
x2frac := fracPart(x2);
y2frac := fracPart(y2);
s := (x2 - x1) * (y2 - y1);
for i := 0 to 3 do begin
{ угловые пикселы }
c :=
(ColorArray(getSrcPixel(x1int, y1int))[i] and $ff) * x1frac * y1frac +
(ColorArray(getSrcPixel(x2int, y1int))[i] and $ff) * x2frac * y1frac +
(ColorArray(getSrcPixel(x1int, y2int))[i] and $ff) * x1frac * y2frac +
(ColorArray(getSrcPixel(x2int, y2int))[i] and $ff) * x2frac * y2frac
;
{ верхние и нижние пикселы }
for x := x1int + 1 to x2int - 1 do begin
c := c +
(ColorArray(getSrcPixel(x, y1int))[i] and $ff) * y1frac +
(ColorArray(getSrcPixel(x, y2int))[i] and $ff) * y2frac
;
end;
{ боковые пикселы }
for y := y1int + 1 to y2int - 1 do begin
c := c +
(ColorArray(getSrcPixel(x1int, y))[i] and $ff) * x1frac +
(ColorArray(getSrcPixel(x2int, y))[i] and $ff) * x2frac
;
end;
{ внутренние пикселы }
for y := y1int + 1 to y2int - 1 do for x := x1int + 1 to x2int - 1 do begin
c := c +
(ColorArray(getSrcPixel(x, y))[i] and $ff)
;
end;
{ результат }
ColorArray(result)[i] := byte(round(c / s));
end;
end;
procedure putPixel(x, y, argb: int);
var
pixels: PIntArray;
index: int;
begin
if (x >= 0) and (y >= 0) and (x < dstWidth) and (y < dstHeight) then begin
pixels := dstPixels;
index := x + y * dstScanline;
pixels[index] := computePixel(pixels[index], argb, dstWithAlpha, srcWithAlpha);
end;
end;
procedure drawStretch();
var
x: int;
y: int;
realSrcWidth: real;
realSrcHeight: real;
pixelSizeX: real;
pixelSizeY: real;
stepX: real;
stepY: real;
realX: real;
realY: real;
r: real;
begin
if rotate90 then begin
realSrcWidth := toReal(srcHeight);
realSrcHeight := toReal(srcWidth);
end else begin
realSrcWidth := toReal(srcWidth);
realSrcHeight := toReal(srcHeight);
end;
r := toReal(width);
if r < realSrcWidth then begin
pixelSizeX := realSrcWidth / r;
stepX := pixelSizeX;
end else begin
pixelSizeX := 1.0;
if width > 1 then begin
stepX := (realSrcWidth - 1.0) / (r - 1.0);
end else begin
stepX := 0.0;
end;
end;
r := toReal(height);
if r < realSrcHeight then begin
pixelSizeY := realSrcHeight / r;
stepY := pixelSizeY;
end else begin
pixelSizeY := 1.0;
if height > 1 then begin
stepY := (realSrcHeight - 1.0) / (r - 1.0);
end else begin
stepY := 0.0;
end;
end;
for y := max(0, -top) to min(height, dstHeight - top) - 1 do begin
realY := y * stepY;
for x := max(0, -left) to min(width, dstWidth - left) - 1 do begin
realX := x * stepX;
putPixel(x + left, y + top, getSrcAveragePixel(realX, realY, realX + pixelSizeX, realY + pixelSizeY));
end;
end;
end;
procedure drawNormal();
var
x: int;
y: int;
begin
for y := max(0, -top) to min(height, dstHeight - top) - 1 do begin
for x := max(0, -left) to min(width, dstWidth - left) - 1 do begin
putPixel(x + left, y + top, getSrcPixel(x, y));
end;
end;
end;
procedure drawPixel();
var
x: int;
y: int;
pixel: int;
begin
pixel := getSrcPixel(0, 0);
for y := max(top, 0) to min(height + top, dstHeight) - 1 do begin
for x := max(left, 0) to min(width + left, dstWidth) - 1 do begin
putPixel(x, y, pixel);
end;
end;
end;
var
i: int;
begin
descriptor := PMalikStretchDraw(processor.getMemory(descriptorAddress, sizeof(MalikStretchDraw)));
if descriptor = nil then begin
result := 0;
exit;
end;
dstWidth := int(descriptor.dst.width);
dstHeight := int(descriptor.dst.height);
dstScanline := descriptor.dst.scanline;
dstWithAlpha := descriptor.dst.supportsAlpha;
if dstScanline >= 0 then begin
dstPixels := PIntArray(processor.getMemory(descriptor.dst.base, (dstScanline * (dstHeight - 1) + dstWidth) * sizeof(int)));
end else begin
i := (-dstScanline) * (dstHeight - 1);
dstPixels := @(PIntArray(processor.getMemory(descriptor.dst.base - i * sizeof(int), (i + dstWidth) * sizeof(int)))[i]);
end;
if isDestinationInvalid() then begin
result := 0;
exit;
end;
left := int(descriptor.left);
top := int(descriptor.top);
width := int(descriptor.width);
height := int(descriptor.height);
if isDrawRegionInvalid() then begin
result := 0;
exit;
end;
srcWidth := int(descriptor.src.width);
srcHeight := int(descriptor.src.height);
srcScanline := descriptor.src.scanline;
srcWithAlpha := descriptor.src.supportsAlpha;
if srcScanline >= 0 then begin
srcPixels := PIntArray(processor.getMemory(descriptor.src.base, (srcScanline * (srcHeight - 1) + srcWidth) * sizeof(int)));
end else begin
i := (-srcScanline) * (srcHeight - 1);
srcPixels := @(PIntArray(processor.getMemory(descriptor.src.base - i * sizeof(int), (i + srcWidth) * sizeof(int)))[i]);
end;
if isSourceInvalid() then begin
result := 0;
exit;
end;
if isDrawRegionOutOfBounds() then begin
result := 2;
exit;
end;
src := int_Array1d_create(srcWidth * srcHeight);
for i := 0 to srcHeight - 1 do begin
intArrayCopy(srcPixels, i * srcScanline, PIntArray(src), i * srcWidth, srcWidth);
end;
srcScanline := srcWidth;
srcPixels := PIntArray(src);
transform := TO_TRANSFORM[descriptor.transform and $0f];
if (srcWidth = 1) and (srcHeight = 1) then begin
drawPixel();
result := 1;
exit;
end;
rotate90 := (transform and 1) <> 0;
if (not rotate90) and (srcWidth = width) and (srcHeight = height) or rotate90 and (srcWidth = height) and (srcHeight = width) then begin
drawNormal();
result := 1;
exit;
end;
drawStretch();
result := 1;
end;
function TEmulationForm.screenCharsGetWidth(descriptorAddress: int): int;
var
descriptor: PMalikTextDraw;
textUTF16: PWideChar;
textUTF32: PIntArray;
font: UnicodeFont;
sys: SystemObject;
emu: TObject;
i: int;
l: int;
c: int;
d: int;
begin
result := 0;
descriptor := PMalikTextDraw(processor.getMemory(descriptorAddress, sizeof(MalikTextDraw)));
if (descriptor = nil) or (descriptor.charsCount <= 0) then begin
exit;
end;
sys := getSystemObject(descriptor.handle);
if sys = nil then begin
exit;
end;
emu := sys.asObject();
if not (emu is EmulationOfUnicodeFont) then begin
exit;
end;
font := EmulationOfUnicodeFont(emu).getFont();
l := descriptor.charsCount;
if (descriptor.style and MIN_INT) <> 0 then begin
textUTF16 := PWideChar(processor.getMemory(descriptor.charsAddress, l * sizeof(wchar)));
if textUTF16 = nil then begin
exit;
end;
i := 0;
while i < l do begin
c := int(textUTF16[i]);
inc(i);
if (i < l) and (c >= $d800) and (c < $dc00) then begin
d := int(textUTF16[i]);
if (d >= $dc00) and (d < $e000) then begin
c := ((c and $03ff) shl $0a) + (d and $03ff) + $00010000;
inc(i);
end;
end;
inc(result, font.getCharacterWidth(c));
end;
exit;
end;
textUTF32 := PIntArray(processor.getMemory(descriptor.charsAddress, l * sizeof(int)));
if textUTF32 = nil then begin
exit;
end;
for i := 0 to l - 1 do begin
inc(result, font.getCharacterWidth(textUTF32[i]));
end;
end;
function TEmulationForm.screenCharsOutput(descriptorAddress: int): int;
var
descriptor: PMalikTextDraw;
textUTF16: PWideChar;
textUTF32: PIntArray;
font: UnicodeFont;
sys: SystemObject;
emu: TObject;
i: int;
l: int;
c: int;
d: int;
s: int;
x: int;
y: int;
color: int;
underline: boolean;
strikeout: boolean;
begin
result := 0;
descriptor := PMalikTextDraw(processor.getMemory(descriptorAddress, sizeof(MalikTextDraw)));
if (descriptor = nil) or (descriptor.charsCount <= 0) then begin
exit;
end;
sys := getSystemObject(descriptor.handle);
if sys = nil then begin
exit;
end;
emu := sys.asObject();
if not (emu is EmulationOfUnicodeFont) then begin
exit;
end;
font := EmulationOfUnicodeFont(emu).getFont();
outputGraphicWidth := int(descriptor.dst.width);
outputGraphicHeight := int(descriptor.dst.height);
outputGraphicScanline := descriptor.dst.scanline;
if outputGraphicScanline >= 0 then begin
outputGraphicPixels := PIntArray(processor.getMemory(descriptor.dst.base, (outputGraphicScanline * (outputGraphicHeight - 1) + outputGraphicWidth) * sizeof(int)));
end else begin
i := (-outputGraphicScanline) * (outputGraphicHeight - 1);
outputGraphicPixels := @(PIntArray(processor.getMemory(descriptor.dst.base - i * sizeof(int), (i + outputGraphicWidth) * sizeof(int)))[i]);
end;
outputGraphicWithAlpha := descriptor.dst.supportsAlpha;
inputGraphicWithAlpha := true;
if isOutputGraphicInvalid() then begin
exit;
end;
l := descriptor.charsCount;
s := descriptor.style;
x := int(descriptor.x);
y := int(descriptor.y);
color := descriptor.color;
underline := (s and 1) <> 0;
strikeout := (s and 2) <> 0;
if (s and MIN_INT) <> 0 then begin
textUTF16 := PWideChar(processor.getMemory(descriptor.charsAddress, l * sizeof(wchar)));
if textUTF16 = nil then begin
exit;
end;
i := 0;
while i < l do begin
c := int(textUTF16[i]);
inc(i);
if (i < l) and (c >= $d800) and (c < $dc00) then begin
d := int(textUTF16[i]);
if (d >= $dc00) and (d < $e000) then begin
c := ((c and $03ff) shl $0a) + (d and $03ff) + $00010000;
inc(i);
end;
end;
inc(result, font.drawCharacter(self, c, result + x, y, color, underline, strikeout));
end;
exit;
end;
textUTF32 := PIntArray(processor.getMemory(descriptor.charsAddress, l * sizeof(int)));
if textUTF32 = nil then begin
exit;
end;
for i := 0 to l - 1 do begin
c := textUTF32[i];
inc(result, font.drawCharacter(self, c, result + x, y, color, underline, strikeout));
end;
end;
function TEmulationForm.screenFontInstall(fontNameAddress, fileNameAddress: int): int;
var
fontName: UnicodeString;
fileName: UnicodeString;
e: EmulationOfUnicodeFont;
begin
fontName := readNullTerminatedUnicodeString(fontNameAddress);
fileName := readNullTerminatedUnicodeString(fileNameAddress);
if malikFileCheckAccess(fileName, false) then begin
result := 0;
exit;
end;
e := EmulationOfUnicodeFont.create(self, toUTF8String(fontName), toUTF8String(malikFileNameToOS(fileName)));
if not e.getFont().isEmpty() then begin
result := addSystemObject(e);
exit;
end;
e.free();
result := 0;
end;
function TEmulationForm.screenFontUninstall(fontHandle: int): int;
begin
if (fontHandle <> nextSystemObject(0, EmulationOfUnicodeFont)) and closeSystemObject(fontHandle, EmulationOfUnicodeFont) then begin
result := 1;
exit;
end;
result := 0;
end;
function TEmulationForm.timerSetInterval(milliseconds: long): int;
begin
ptimer.setInterval(milliseconds);
result := 1;
end;
function TEmulationForm.timerGetRemainingTime(): long;
begin
result := ptimer.getRemainingMilliseconds();
end;
function TEmulationForm.inoutGetKeyboardLightState(): int;
var
state: TKeyBoardState;
begin
Windows.getKeyboardState(state);
result := (state[VK_NUMLOCK] and $01) or ((state[VK_CAPITAL] and $01) shl 1) or ((state[VK_SCROLL] and $01) shl 2);
end;
function TEmulationForm.addSystemObject(obj: SystemObject): int;
var
i: int;
l: int;
a: SystemObject_Array1d;
begin
l := systemObjectsCount;
a := systemObjects;
for i := 0 to l - 1 do begin
if a[i] = nil then begin
a[i] := obj;
result := i shl 2;
exit;
end;
end;
if l = length(a) then begin
a := SystemObject_Array1d_create((l shl 1) + 1);
arraycopy(systemObjects, 0, a, 0, l);
systemObjects := a;
end;
a[l] := obj;
systemObjectsCount := l + 1;
result := l shl 2;
end;
function TEmulationForm.nextSystemObject(handle: int; objClass: TClass): int;
var
i: int;
j: int;
l: int;
a: SystemObject_Array1d;
obj: SystemObject;
begin
j := sar(handle, 2);
l := systemObjectsCount;
if ((handle and $03) <> 0) or (j < 0) or (j >= l) then begin
result := 0;
exit;
end;
a := systemObjects;
obj := a[j];
if (obj <> nil) and (obj.asObject() is objClass) then begin
j := (j + 1) mod l;
end;
i := j;
repeat
obj := a[i];
if (obj <> nil) and (obj.asObject() is objClass) then begin
result := i shl 2;
exit;
end;
inc(i);
until i >= l;
result := 0;
end;
function TEmulationForm.handleSystemObject(func: int; param: long): long;
var
longParam: LongRecord absolute param;
obj: SystemObject;
begin
obj := getSystemObject(longParam.lo);
if obj <> nil then begin
result := obj.syscall(func, longParam.hi);
exit;
end;
result := -1;
end;
function TEmulationForm.getSystemObject(handle: int): SystemObject;
var
i: int;
begin
i := sar(handle, 2);
if ((handle and $03) <> 0) or (i < 0) or (i >= systemObjectsCount) then begin
result := nil;
exit;
end;
result := systemObjects[i];
end;
function TEmulationForm.closeSystemObject(handle: int; objClass: TClass): boolean;
var
i: int;
obj: SystemObject;
begin
i := sar(handle, 2);
if ((handle and $03) <> 0) or (i < 0) or (i >= systemObjectsCount) then begin
result := false;
exit;
end;
obj := systemObjects[i];
if (obj = nil) or (not (obj.asObject() is objClass)) then begin
result := false;
exit;
end;
systemObjects[i] := nil;
result := true;
end;
function TEmulationForm.malikFileNameToOS(const fileName: UnicodeString): UnicodeString;
var
d: UnicodeString;
l: int;
begin
d := toUTF16String(runningProgrammeInfo.getProgrammeDirectory());
l := length(fileName);
if (l > 0) and (fileName[1] = '/') then begin
result := d + virtualFileNameToOSFileName(copy(fileName, 2, l - 1));
exit;
end;
result := d + virtualFileNameToOSFileName(fileName);
end;
function TEmulationForm.malikFileCheckAccess(const fileName: UnicodeString; forWrite: boolean): boolean;
var
f: UnicodeString;
c: wchar;
i: int;
begin
f := toLowerCase(fileName);
if (length(f) <= 0) or (f[1] <> '/') then begin
f := '/' + f;
end;
{ Это чтоб программа по всему логическому диску не шастала… }
result := (pos('/../', f) > 0) or (pos('/./', f) > 0) or endsWith('/.', f) or endsWith('/..', f);
if result then begin
exit;
end;
for i := 1 to length(f) do begin
c := f[i];
if (c >= #0000) and (c < #0100) and (c in ['\', ':', '*', '?', '"', '<', '>', '|', '%']) then begin
{
Список запрещённых символов в имени файла в операционной системе Windows.
Косая черта (/) разрешена, поскольку она используется для разделения папок.
Процент (%) запрещён, дабы не дать программам устраивать взбучку с переменными
среды операционной системы Windows.
}
result := true;
exit;
end;
end;
{ Недоступные (даже для создания) и скрываемые из поисковой выдачи файлы и папки }
result := (endsWith('.dbg', f) or endsWith('.mal', f)) or
{ Файлы, доступные только для чтения }
forWrite and (endsWith('/meta-inf/manifest.mf', f) or endsWith('/meta-inf', f) or
endsWith('.ico', f) or endsWith('.bindbg', f))
;
end;
procedure TEmulationForm.writeFileInfoToProcessor(descriptorAddress: int; const findData: Windows.WIN32_FIND_DATAW);
var
t: Pointer;
a: PMalikFileInfo;
f: UnicodeString;
begin
a := PMalikFileInfo(processor.getMemory(descriptorAddress, sizeof(MalikFileInfo)));
if a <> nil then begin
with a.attributes do begin
creationTime := fileTimeToMalik(findData.ftCreationTime);
lastAccessTime := fileTimeToMalik(findData.ftLastAccessTime);
lastWriteTime := fileTimeToMalik(findData.ftLastWriteTime);
attributes := int(findData.dwFileAttributes) and $37;
end;
a.size := buildLong(int(findData.nFileSizeLow), int(findData.nFileSizeHigh));
f := UnicodeString(findData.cFileName) + #$0000;
t := processor.getMemory(a.nameAddress, a.nameLength * sizeof(wchar));
if t <> nil then begin
move(f[1], t^, min(a.nameLength, length(f)) * sizeof(wchar));
end;
end;
end;
procedure TEmulationForm.postMessage(msg: int);
begin
while modeChanging do begin
sleep(2);
end;
Windows.postMessage(windowHandle, msg, 0, 0);
end;
procedure TEmulationForm.postMessage(msg, wparam, lparam: int);
begin
while modeChanging do begin
sleep(2);
end;
Windows.postMessage(windowHandle, msg, wparam, lparam);
end;
function TEmulationForm.sendMessage(msg: int): int;
begin
while modeChanging do begin
sleep(2);
end;
result := Windows.sendMessage(windowHandle, msg, 0, 0);
end;
function TEmulationForm.sendMessage(msg, wparam, lparam: int): int;
begin
while modeChanging do begin
sleep(2);
end;
result := Windows.sendMessage(windowHandle, msg, wparam, lparam);
end;
procedure TEmulationForm.wndProc(var theMessage: TLMessage);
begin
case int(theMessage.msg) of
WM_SYSCOMMAND: begin
case theMessage.wParam of
ID_TOOLBARS: begin
switchToolBarsVisible();
end;
else
inherited wndProc(theMessage);
end;
end;
WM_ACTIVATE: begin
windowActivate(theMessage.wParam = WA_ACTIVE);
end;
EM_PROCESSOR_BEGIN: begin
processorBegin();
end;
EM_PROCESSOR_END: begin
processorEnd();
end;
EM_DEBUG_BEGIN: begin
debugBegin();
end;
EM_DEBUG_END: begin
debugEnd();
end;
EM_SCREEN_UPDATE: begin
screenUpdate(true);
end;
EM_PLAYER_PCM_CREATE: begin
theMessage.result := playerPCMCreate(theMessage.wParam, theMessage.lParam);
end;
EM_PLAYER_PCM_LOAD_BLOCK: begin
theMessage.result := playerPCMLoadBlock(theMessage.wParam, theMessage.lParam);
end;
EM_PLAYER_PCM_PLAYBACK_CONTROL: begin
theMessage.result := playerPCMPlayback(theMessage.wParam, theMessage.lParam);
end;
EM_PLAYER_PCM_GET_STATE: begin
theMessage.result := playerPCMGetState(theMessage.wParam);
end;
EM_PLAYER_PCM_BLOCK_SEEK: begin
theMessage.result := playerPCMSetPosition(theMessage.wParam, theMessage.lParam);
end;
EM_PLAYER_PCM_GET_BLOCK_INDEX: begin
long(intToPointer(theMessage.lParam)^) := playerPCMGetPosition(theMessage.wParam);
end;
EM_PLAYER_PCM_VOLUME_CONTROL: begin
theMessage.result := playerPCMVolume(theMessage.wParam, theMessage.lParam);
end;
EM_PLAYER_PCM_DESTROY: begin
theMessage.result := playerPCMDestroy(theMessage.wParam);
end;
EM_PLAYER_MIDI_CREATE: begin
theMessage.result := playerMIDICreate();
end;
EM_PLAYER_MIDI_LOAD_BLOCK: begin
theMessage.result := playerMIDILoadBlock(theMessage.wParam, theMessage.lParam);
end;
EM_PLAYER_MIDI_PLAYBACK_CONTROL: begin
theMessage.result := playerMIDIPlayback(theMessage.wParam, theMessage.lParam);
end;
EM_PLAYER_MIDI_GET_STATE: begin
theMessage.result := playerMIDIGetState(theMessage.wParam);
end;
EM_PLAYER_MIDI_BLOCK_SEEK: begin
theMessage.result := playerMIDISetPosition(theMessage.wParam, theMessage.lParam);
end;
EM_PLAYER_MIDI_GET_BLOCK_INDEX: begin
long(intToPointer(theMessage.lParam)^) := playerMIDIGetPosition(theMessage.wParam);
end;
EM_PLAYER_MIDI_VOLUME_CONTROL: begin
theMessage.result := playerMIDIVolume(theMessage.wParam, theMessage.lParam);
end;
EM_PLAYER_MIDI_DESTROY: begin
theMessage.result := playerMIDIDestroy(theMessage.wParam);
end
else
inherited wndProc(theMessage);
end;
end;
constructor TEmulationForm.create(theOwner: TComponent);
begin
inherited create(theOwner);
createSystemMenu();
theOwner.getInterface(stringToGUID(MAIN_WINDOW_INTERFACE_GUID), owner);
closeOnTerminate := false;
pause := true;
terminated := false;
prevWindowState := wsNormal;
end;
destructor TEmulationForm.destroy;
var
l: int;
t: int;
w: int;
h: int;
v: int;
begin
l := left;
t := top;
w := getOutputAreaWidth();
h := getOutputAreaHeight();
if panelView.Visible then begin
v := 1;
end else begin
v := 0;
end;
owner.setSetting(SECTION_WINDOWS, runningProgrammeID, makeStringOf(toStringArray1d([
toDecString(screenRotate), toDecString(screenZoom),
toDecString(l), toDecString(t), toDecString(w),
toDecString(h), toDecString(v)
])));
owner.saveSettings();
owner.notifyTerminated(self);
ptimer.free();
processor.free();
context.free();
outputImage.free();
scaledImageBitmap.free();
rotatedImageBitmap.free();
sourceImageBitmap.free();
runningProgrammeInfo.free();
inherited destroy;
end;
function TEmulationForm.getClass(): _Class;
begin
result := ClassData.create(classType());
end;
function TEmulationForm.asObject(): TObject;
begin
result := self;
end;
procedure TEmulationForm.run();
var
processor: MalikProcessor;
size: int;
begin
processor := self.processor;
if processor.load() then begin
size := (MAX_SCREEN_WIDTH * MAX_SCREEN_HEIGHT) * sizeof(int);
screenImageAddress := processor.createRegion(size);
screenImageScanline := MAX_SCREEN_WIDTH;
screenImagePixels := PIntArray(processor.getMemory(screenImageAddress, size));
disassembler.loadData();
sendMessage(EM_PROCESSOR_BEGIN);
processor.execute();
exit;
end;
programmeTerminated();
end;
procedure TEmulationForm.putPixel(x, y, argb: int);
var
pixels: PIntArray;
index: int;
begin
if (x >= 0) and (y >= 0) and (x < outputGraphicWidth) and (y < outputGraphicHeight) then begin
pixels := outputGraphicPixels;
index := x + y * outputGraphicScanline;
pixels[index] := computePixel(pixels[index], argb, outputGraphicWithAlpha, inputGraphicWithAlpha);
end;
end;
procedure TEmulationForm.timerHandle(timer: Timer; millisecondsElapsed: long);
begin
if timer = ptimer then begin
processor.interrupt($18, millisecondsElapsed);
end;
end;
procedure TEmulationForm.loadPCMBlock(player: PlayerPCM; blockIndex: int);
var
i: int;
count: int;
obj: TObject;
objects: SystemObject_Array1d;
sysobj: SystemObject;
begin
if processor.isTerminated() then begin
exit;
end;
count := systemObjectsCount;
objects := systemObjects;
for i := count - 1 downto 0 do begin
sysobj := objects[i];
if sysobj = nil then begin
continue;
end;
obj := sysobj.asObject();
if (obj is EmulationOfPlayerPCM) and (EmulationOfPlayerPCM(obj).soundPlayer = player) then begin
processor.interrupt($1e, buildLong(i shl 2, blockIndex));
exit;
end;
end;
end;
procedure TEmulationForm.endMIDITrack(player: PlayerMIDI);
var
i: int;
count: int;
obj: TObject;
objects: SystemObject_Array1d;
sysobj: SystemObject;
begin
if processor.isTerminated() then begin
exit;
end;
count := systemObjectsCount;
objects := systemObjects;
for i := count - 1 downto 0 do begin
sysobj := objects[i];
if sysobj = nil then begin
continue;
end;
obj := sysobj.asObject();
if (obj is EmulationOfPlayerMIDI) and (EmulationOfPlayerMIDI(obj).soundPlayer = player) then begin
processor.interrupt($1f, buildLong(i shl 2, -1));
exit;
end;
end;
end;
procedure TEmulationForm.programmePause();
begin
while pause do begin
sleep(2);
end;
pause := true;
end;
procedure TEmulationForm.programmeResume();
begin
pause := false;
end;
procedure TEmulationForm.programmeTerminated();
begin
sendMessage(EM_PROCESSOR_END);
end;
procedure TEmulationForm.programmeBreakpoint();
begin
suspend := true;
processor.setDebug(true);
end;
procedure TEmulationForm.instructionExecuting(contextID: int);
begin
self.contextID := contextID;
if debug or suspend then begin
processor.getContext(contextID, context);
if suspend or disassembler.mustBreak(contextID, context.regEIP) then begin
suspend := false;
nowDebugging := true;
sendMessage(EM_DEBUG_BEGIN);
programmePause();
sendMessage(EM_DEBUG_END);
nowDebugging := false;
end;
end;
end;
function TEmulationForm.getCurrentUTCOffset(): int;
var
tz: Windows.TIME_ZONE_INFORMATION;
begin
initialize(tz);
Windows.getTimeZoneInformation(@tz);
result := -60000 * int(tz.bias);
end;
function TEmulationForm.getCurrentUTCTime(): long;
var
t: Windows.SYSTEMTIME;
begin
initialize(t);
Windows.getSystemTime(@t);
result := systemTimeToMalik(t);
end;
function TEmulationForm.getMilliseconds(): long;
begin
result := Timers.getMilliseconds();
end;
function TEmulationForm.syscall(func: int; argument: long): long;
var
longParam: LongRecord absolute argument;
begin
result := 0;
case func of
$0012..$0016, $0019, $0020..$0023, $0029..$002b, $0031..$0034, $0036, $0039..$003c, $003e: begin
result := handleSystemObject(func, argument);
end;
$0010: begin
result := fileOpen(longParam.lo, longParam.hi);
end;
$0011: begin
closeSystemObject(longParam.lo, EmulationOfFileStream);
end;
$0017: begin
result := fileDelete(longParam.lo);
end;
$0018: begin
result := fileFind(longParam.lo, longParam.hi);
end;
$001a: begin
closeSystemObject(longParam.lo, EmulationOfFileEnumeration);
end;
$001b: begin
result := fileMove(longParam.lo, longParam.hi);
end;
$001c: begin
result := fileReadAttr(longParam.lo, longParam.hi);
end;
$001d: begin
result := fileWriteAttr(longParam.lo, longParam.hi);
end;
$001e: begin
result := directoryCreate(longParam.lo);
end;
$001f: begin
result := directoryDelete(longParam.lo);
end;
$0024: begin
result := screenGetGUIElementMinSizes(longParam.lo);
end;
$0025: begin
result := screenDrawGUIElement(longParam.lo);
end;
$0026: begin
result := screenGetSystemColor(longParam.lo);
end;
$0027: begin
result := screenStretchDraw(longParam.lo);
end;
$0028: begin
result := nextSystemObject(longParam.lo, EmulationOfUnicodeFont);
end;
$002c: begin
result := screenCharsGetWidth(longParam.lo);
end;
$002d: begin
result := screenCharsOutput(longParam.lo);
end;
$002e: begin
result := screenFontInstall(longParam.lo, longParam.hi);
end;
$002f: begin
result := screenFontUninstall(longParam.lo);
end;
$0030: begin
result := sendMessage(EM_PLAYER_PCM_CREATE, longParam.lo, longParam.hi);
end;
$0035: begin
sendMessage(EM_PLAYER_PCM_GET_BLOCK_INDEX, longParam.lo, pointerToInt(@result));
end;
$0037: begin
result := sendMessage(EM_PLAYER_PCM_DESTROY, longParam.lo, 0);
end;
$0038: begin
result := sendMessage(EM_PLAYER_MIDI_CREATE, 0, 0);
end;
$003d: begin
sendMessage(EM_PLAYER_MIDI_GET_BLOCK_INDEX, longParam.lo, pointerToInt(@result));
end;
$003f: begin
result := sendMessage(EM_PLAYER_MIDI_DESTROY, longParam.lo, 0);
end;
$0040: begin
result := timerSetInterval(longParam.value);
end;
$0041: begin
result := timerGetRemainingTime();
end;
$0050: begin
result := 0;
end;
$0051: begin
result := inoutGetKeyboardLightState();
end;
end;
end;
function TEmulationForm.syscall(func, param: int): long;
begin
result := 0;
case func of
$0016: begin
result := long(Windows.MAX_PATH) - long(length(toUTF16String(runningProgrammeInfo.getProgrammeDirectory())));
end;
$0020: begin
result := screenUpdateQuery();
end;
$0021: begin
result := screenReadBuffer();
end;
$0022: begin
result := screenGetBuffer(param);
end;
$0023: begin
result := screenSetBuffer(param);
end;
end;
end;
procedure TEmulationForm.showEmulationWindow();
begin
showOnTop();
setFocus();
end;
procedure TEmulationForm.showDisassemblerWindow();
var
d: TDisassemblerForm;
begin
if nowDebugging then begin
d := disassembler;
d.showOnTop();
d.setFocus();
exit;
end;
programmeBreakpoint();
end;
procedure TEmulationForm.setDebug(debug: boolean);
var
p: MalikProcessor;
begin
self.debug := debug;
p := processor;
if p <> nil then begin
p.setDebug(debug);
end;
end;
function TEmulationForm.isNowDebugging(): boolean;
begin
result := nowDebugging;
end;
function TEmulationForm.getMalikProcessor(): MalikProcessor;
begin
result := processor;
end;
function TEmulationForm.getMainWindow(): MainWindowInterface;
begin
result := owner;
end;
function TEmulationForm.getProgrammeDirectory(): AnsiString;
begin
result := runningProgrammeInfo.getProgrammeDirectory();
end;
procedure TEmulationForm.setProgramme(const id: AnsiString; info: ProgrammeInfo);
var
execFileName: AnsiString;
sizes: AnsiString_Array1d;
pman: ProgrammeManifest;
width: int;
height: int;
begin
execFileName := info.getExecutableFileName();
if not fileExists(execFileName) then begin
raise FileNotOpenException.create('важный исполняемый файл, необходимый для запуска программы, не найден: ' + execFileName);
end;
pman := ProgrammeManifest.create();
try
info.loadManifest(pman);
info.loadIcon(icon);
caption := pman.getValue(MANIFEST_PROPERTY_PROGRAMME_NAME);
sizes := getComponents(pman.getValue(MANIFEST_PROPERTY_MALIK_SCREEN_SIZE));
finally
pman.free();
end;
runningProgrammeID := id;
runningProgrammeInfo := ProgrammeInfo.create(info.getProgrammeDirectory());
if length(sizes) >= 2 then begin
screenImageWidth := max(MIN_SCREEN_WIDTH, min(MAX_SCREEN_WIDTH, parseDecInt(sizes[0], DEFAULT_SCREEN_WIDTH)));
screenImageHeight := max(MIN_SCREEN_HEIGHT, min(MAX_SCREEN_HEIGHT, parseDecInt(sizes[1], DEFAULT_SCREEN_HEIGHT)));
end else begin
screenImageWidth := DEFAULT_SCREEN_WIDTH;
screenImageHeight := DEFAULT_SCREEN_HEIGHT;
end;
sizes := getComponents(owner.getSetting(SECTION_WINDOWS, id, ''));
if length(sizes) >= 6 then begin
screenRotate := parseDecInt(sizes[0], 0);
screenZoom := max(1, min(4, parseDecInt(sizes[1], 1)));
if (screenRotate and 1) = 0 then begin
width := screenZoom * screenImageWidth;
height := screenZoom * screenImageHeight;
end else begin
width := screenZoom * screenImageHeight;
height := screenZoom * screenImageWidth;
end;
if (length(sizes) > 6) and (parseDecInt(sizes[6], 1) <> 0) then begin
switchToolBarsVisible();
end;
setOutputAreaBounds(parseDecInt(sizes[2], (screen.width - width) div 2), parseDecInt(sizes[3], (screen.height - height) div 2), parseDecInt(sizes[4], width), parseDecInt(sizes[5], height));
end else begin
screenRotate := 0;
screenZoom := 1;
width := screenImageWidth;
height := screenImageHeight;
setOutputAreaBounds((screen.width - width) div 2, (screen.height - height) div 2, width, height);
end;
showScreenZoomStatus(screenZoom);
sbtnViewZoomIn.enabled := screenZoom < 4;
sbtnViewZoomOut.enabled := screenZoom > 1;
sbtnMonitorAdjustSize.enabled := true;
sbtnMonitorFullScreen.enabled := false;
sbtnMonitorRecordStart.enabled := false;
sbtnMonitorRecordStop.enabled := false;
end;
procedure TEmulationForm.runProgramme();
var
a: AnsiString;
s: int;
i: int;
j: int;
font: AnsiString;
fonts: UnicodeString_Array1d;
fontsCount: int;
disassembler: TDisassemblerForm;
begin
{ поиск шрифтов }
a := getEmulatorDirectory() + DIRECTORY_FONTS + DIRECTORY_SEPARATOR;
j := length(a) + 1;
fonts := enumerateFiles(a, 'ufn');
fontsCount := length(fonts);
if fontsCount = 0 then begin
raise FontsNotFoundException.create('Не найдено ни одного шрифта UFN. Проверьте папку ' + DIRECTORY_FONTS + ' в папке с эмулятором на наличие шрифтов UFN.');
end;
sortStrings(fonts);
systemObjects := SystemObject_Array1d_create(1);
addSystemObject(self);
for i := 0 to fontsCount - 1 do begin
font := toUTF8String(fonts[i]);
addSystemObject(EmulationOfUnicodeFont.create(self, copy(font, j, length(font) - j - 3), font));
end;
{ определение алгоритма масштабирования пиксельной графики }
a := toLowerCase(owner.getSetting(SECTION_EMULATOR, KEY_GRAPHIC_SCALING, ''));
if a = 'near' then begin
scalingAlgorithm := PixelGraphicNearNeighbour.Algorithm.create();
end else
if a = 'scalenx' then begin
scalingAlgorithm := PixelGraphicSimpleScaling.Algorithm.create();
end else
if a = 'hqnx' then begin
scalingAlgorithm := PixelGraphicHighQualityScaling.Algorithm.create();
end else
if a = 'standard' then begin
scalingAlgorithm := PixelGraphicPhotographicScaling.Algorithm.create();
end else begin
scalingAlgorithm := nil;
end;
{ определение максимального количества кадров в секунду }
s := parseDecInt(owner.getSetting(SECTION_EMULATOR, KEY_MAXIMUM_FPS, ''), 25);
maximumFrames := min(max(1, s), 100);
{ определение темы для графического пользовательского интерфейса }
guiTheme := getTheme(owner.getSetting(SECTION_EMULATOR, KEY_THEME, ''));
if guiTheme = nil then begin
guiTheme := getTheme(0);
end;
{ создание промежуточных изображений }
sourceImageBitmap := TBitmap.create();
sourceImagePixels := createPixelImage(sourceImageBitmap, MAX_SCREEN_WIDTH, MAX_SCREEN_HEIGHT);
sourceImagePixels := @(sourceImagePixels[(MAX_SCREEN_HEIGHT - 1) * MAX_SCREEN_WIDTH]);
sourceImageScanline := -MAX_SCREEN_WIDTH;
s := max(MAX_SCREEN_WIDTH, MAX_SCREEN_HEIGHT);
rotatedImageBitmap := TBitmap.create();
rotatedImagePixels := createPixelImage(rotatedImageBitmap, s, s);
rotatedImagePixels := @(rotatedImagePixels[(s - 1) * s]);
rotatedImageScanline := -s;
scaledImageBitmap := TBitmap.create();
outputImage := TBitmap.create();
{ создание среды выполнения программы }
windowHandle := handle;
a := runningProgrammeInfo.getExecutableFileName();
context := MalikDebugContext.create();
ptimer := Timer.create(self);
processor := MalikProcessor.create(toUTF16String(a), self);
processor.setDebug(debug);
suspend := debug;
disassembler := TDisassemblerForm.create(self);
self.disassembler := disassembler;
disassembler.icon := icon;
disassembler.caption := disassembler.caption + caption;
{ запуск }
startThread(self);
end;
procedure TEmulationForm.showExecutionStatus(const statusText: AnsiString);
begin
status.panels.items[0].text := statusText;
end;
procedure TEmulationForm.showRecordingStatus(const statusText: AnsiString);
begin
status.panels.items[1].text := statusText;
end;
procedure TEmulationForm.showScreenZoomStatus(screenZoom: int);
begin
status.panels.items[2].text := 'x' + toDecString(screenZoom);
end;
procedure TEmulationForm.showFramesPerSecondStatus(fps: int);
begin
status.panels.Items[3].text := 'FPS: ' + toDecString(fps);
end;
{%endregion}
{%region EmulationOfFileStream }
constructor EmulationOfFileStream.create(TEmulationForm_self: TEmulationForm; const fileName: UnicodeString; mode: int);
var
fo: FileOutputStream;
fi: FileInputStream;
fs: FileStream;
begin
inherited create(TEmulationForm_self);
case int(mode and $03) of
$00: begin
fo := FileOutputStream.create(fileName, true);
invalidHandle := fo.isInvalidHandle();
fileOutput := fo;
end;
$01: begin
fi := FileInputStream.create(fileName);
invalidHandle := fi.isInvalidHandle();
fileInput := fi;
end;
$02: begin
fo := FileOutputStream.create(fileName, false);
invalidHandle := fo.isInvalidHandle();
fileOutput := fo;
end;
$03: begin
fs := FileStream.create(fileName);
invalidHandle := fs.isInvalidHandle();
fileInput := fs;
fileOutput := fs;
end;
end;
end;
function EmulationOfFileStream.write(param: int): int;
const
BUF_SIZE = int(1024);
var
f: Output;
p: MalikProcessor;
d: PMalikDataDescriptor;
b: byte_Array1d;
a: int;
c: int;
s: int;
t: Pointer;
begin
f := fileOutput;
if f = nil then begin
result := -1;
exit;
end;
p := TEmulationForm_self.getMalikProcessor();
d := PMalikDataDescriptor(p.getMemory(param, sizeof(MalikDataDescriptor)));
if d = nil then begin
result := -1;
exit;
end;
b := nil;
a := d.address;
c := d.count;
result := 0;
while c > 0 do begin
if b = nil then begin
b := byte_Array1d_create(BUF_SIZE);
end;
s := min(c, BUF_SIZE);
t := p.getMemory(a, s);
if t = nil then begin
exit;
end;
move(t^, b[0], s);
s := f.write(b, 0, s);
if s <= 0 then begin
exit;
end;
dec(c, s);
inc(a, s);
inc(result, s);
end;
end;
function EmulationOfFileStream.read(param: int): int;
const
BUF_SIZE = int(1024);
var
f: Input;
p: MalikProcessor;
d: PMalikDataDescriptor;
b: byte_Array1d;
a: int;
c: int;
s: int;
t: Pointer;
begin
f := fileInput;
if f = nil then begin
result := -1;
exit;
end;
p := TEmulationForm_self.getMalikProcessor();
d := PMalikDataDescriptor(p.getMemory(param, sizeof(MalikDataDescriptor)));
if d = nil then begin
result := -1;
exit;
end;
b := nil;
a := d.address;
c := d.count;
result := 0;
while c > 0 do begin
if b = nil then begin
b := byte_Array1d_create(BUF_SIZE);
end;
s := min(c, BUF_SIZE);
t := p.getMemory(a, s);
if t = nil then begin
exit;
end;
s := f.read(b, 0, s);
if s <= 0 then begin
exit;
end;
move(b[0], t^, s);
dec(c, s);
inc(a, s);
inc(result, s);
end;
end;
function EmulationOfFileStream.seek(param: int): int;
var
f: Input;
p: MalikProcessor;
t: Pointer;
d: long;
begin
f := fileInput;
if f = nil then begin
result := -1;
exit;
end;
p := TEmulationForm_self.getMalikProcessor();
t := p.getMemory(param, sizeof(long));
if t = nil then begin
result := -1;
exit;
end;
d := long(t^);
result := f.seek(d);
end;
function EmulationOfFileStream.size(): long;
var
f: Input;
begin
f := fileInput;
if f = nil then begin
result := -1;
exit;
end;
result := f.size();
end;
function EmulationOfFileStream.truncate(): long;
var
f: _Interface;
begin
f := fileInput;
if (f = nil) or (fileOutput = nil) then begin
result := -1;
exit;
end;
result := FileStream(f.asObject()).truncate();
end;
function EmulationOfFileStream.syscall(func, param: int): long;
begin
result := -1;
case func of
$0012: begin
result := read(param);
end;
$0013: begin
result := write(param);
end;
$0014: begin
result := seek(param);
end;
$0015: begin
result := size();
end;
$0016: begin
result := truncate();
end;
end;
end;
function EmulationOfFileStream.isInvalidHandle(): boolean;
begin
result := invalidHandle;
end;
{%endregion}
{%region EmulationOfFileEnumeration }
constructor EmulationOfFileEnumeration.create(TEmulationForm_self: TEmulationForm; handle: int; directory: boolean; const fileName: UnicodeString);
begin
inherited create(TEmulationForm_self);
self.handle := handle;
self.directory := directory;
self.fileName := fileName;
end;
destructor EmulationOfFileEnumeration.destroy;
begin
Windows.findClose(handle);
inherited destroy;
end;
function EmulationOfFileEnumeration.findNext(param: int): int;
var
f: TEmulationForm;
d: boolean;
h: int;
r: int;
s: Windows.WIN32_FIND_DATAW;
n: UnicodeString;
m: UnicodeString;
begin
f := TEmulationForm_self;
d := directory;
h := handle;
n := fileName;
m := n;
initialize(s);
result := int(Windows.findNextFileW(h, @s));
if result = 0 then begin
exit;
end;
r := 1;
if d then begin
m := n + UnicodeString(s.cFileName);
end;
while (r <> 0) and f.malikFileCheckAccess(m, false) do begin
r := int(Windows.findNextFileW(h, @s));
if d then begin
m := n + UnicodeString(s.cFileName);
end;
end;
if r = 0 then begin
result := 0;
exit;
end;
f.writeFileInfoToProcessor(param, s);
result := 1;
end;
function EmulationOfFileEnumeration.syscall(func, param: int): long;
begin
result := -1;
if func = $0019 then begin
result := findNext(param);
end;
end;
{%endregion}
{%region EmulationOfUnicodeFont }
constructor EmulationOfUnicodeFont.create(TEmulationForm_self: TEmulationForm; const fontName, fileName: AnsiString);
begin
inherited create(TEmulationForm_self);
self.font := UnicodeFont.create(fontName, fileName);
end;
destructor EmulationOfUnicodeFont.destroy;
begin
font.free();
inherited destroy;
end;
function EmulationOfUnicodeFont.getNameAndLength(nameDestAddress: int): int;
var
s: UnicodeString;
p: Pointer;
begin
s := font.getName();
result := length(s);
p := TEmulationForm_self.getMalikProcessor().getMemory(nameDestAddress, result * sizeof(wchar));
if p <> nil then begin
move(s[1], p^, result * sizeof(wchar));
end;
end;
function EmulationOfUnicodeFont.getFontInfo(): int;
var
font: UnicodeFont;
begin
result := 0;
font := self.font;
if font.isBold() then begin
result := result or $01;
end;
if font.isItalic() then begin
result := result or $02;
end;
result := result or ((font.getHeight() and $ff) shl 8) or ((font.getBaseLineHeight() and $ff) shl 16);
end;
function EmulationOfUnicodeFont.getCharSupport(code: int): int;
begin
if font.isCharacterExists(code) then begin
result := 1;
exit;
end;
result := 0;
end;
function EmulationOfUnicodeFont.syscall(func, param: int): long;
begin
result := -1;
case func of
$0029: begin
result := getNameAndLength(param);
end;
$002a: begin
result := getFontInfo();
end;
$002b: begin
result := getCharSupport(param);
end;
end;
end;
function EmulationOfUnicodeFont.getFont(): UnicodeFont;
begin
result := font;
end;
{%endregion}
{%region EmulationOfPlayer }
constructor EmulationOfPlayer.create(TEmulationForm_self: TEmulationForm; soundPlayer: Player);
begin
inherited create(TEmulationForm_self);
self.soundPlayer := soundPlayer;
end;
destructor EmulationOfPlayer.destroy;
begin
soundPlayer.free();
inherited destroy;
end;
function EmulationOfPlayer.syscall(func, param: int): long;
begin
result := TEmulationForm_self.sendMessage(TEmulationForm_self.EM_SYSCALL + func, handle, param);
end;
{%endregion}
{%region EmulationOfPlayerPCM }
constructor EmulationOfPlayerPCM.create(TEmulationForm_self: TEmulationForm; soundPlayer: PlayerPCM);
begin
inherited create(TEmulationForm_self, soundPlayer);
end;
{%endregion}
{%region EmulationOfPlayerMIDI }
constructor EmulationOfPlayerMIDI.create(TEmulationForm_self: TEmulationForm; soundPlayer: PlayerMIDI);
begin
inherited create(TEmulationForm_self, soundPlayer);
end;
{%endregion}
initialization {%region}
TEmulationForm.STR_TOOLBARS := UnicodeString(toUTF16String('Панели инструментов'));
{%endregion}
end.
