Skip to content

Commit

Permalink
QBJS support
Browse files Browse the repository at this point in the history
  • Loading branch information
@RetroNick2020
RetroNick2020 committed Jan 19, 2024
1 parent 4b98d4a commit badb7fd
Show file tree
Hide file tree
Showing 10 changed files with 179 additions and 12 deletions.
4 changes: 4 additions & 0 deletions mapeditor.lfm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -659,6 +659,10 @@ object MapEdit: TMapEdit
OnClick = ReSizeTiles
end
end
object Properties: TMenuItem
Caption = 'Properties'
OnClick = MenuMapPropsClick
end
end
object MenuItem17: TMenuItem
Caption = 'View'
Expand Down
1 change: 1 addition & 0 deletions mapeditor.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ TMapEdit = class(TForm)
GroupBox1: TGroupBox;
MenuItem15: TMenuItem;
CloneMap: TMenuItem;
Properties: TMenuItem;
Panel1: TPanel;
RadioDraw: TRadioButton;
RadioErase: TRadioButton;
Expand Down
4 changes: 2 additions & 2 deletions rmabout.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,8 @@ interface
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,lclintf;

Const
ProgramName ='Raster Master v3.2 R99';
ProgramLicense = 'Released January 13 - 2024 under MIT License';
ProgramName ='Raster Master v3.3 R100';
ProgramLicense = 'Released January 19 - 2024 under MIT License';

type

Expand Down
9 changes: 6 additions & 3 deletions rmcodegen.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,8 @@ interface
QB64BasicLan = 6; //fix this in the future - just a hack right now to make things work with Qb64
AQBBasicLan = 7; //fix this in the future - just a hack right now to make things work with Amiga QuickBasic AQB
BAMBasicLan = 8;
QBJSBasicLan = 9;

ValueFormatDecimal = 0;
ValueFormatHex = 1;

Expand Down Expand Up @@ -112,15 +114,15 @@ procedure MWWriteLineFeed(var mc : CodeGenRec);

procedure MWWriteData(var mc : CodeGenRec);
begin
if (mc.LanId=BasicLan) or (mc.LanId=BasicLNLan) then
if (mc.LanId=BasicLan) or (mc.LanId=BasicLNLan) or (mc.LanId=QBJSBasicLan) then
begin
if mc.VCL = 0 then Write(mc.FTextPtr^,'DATA ');
end;
end;

procedure MWWriteIndent(var mc : CodeGenRec);
begin
if (mc.LanId=BasicLan) or (mc.LanId=BasicLNLan) then exit;
if (mc.LanId=BasicLan) or (mc.LanId=BasicLNLan) or (mc.LanId=QBJSBasicLan) then exit;
if (mc.VCL = 0) then
begin
if (mc.IndentOnFirst = false) and (mc.LineCount=0) then exit;
Expand All @@ -144,7 +146,7 @@ procedure MWWriteComma(var mc : CodeGenRec);
end
else if (mc.VCL=mc.ValuesPerLine) then //end of line but not last value
begin
if (mc.LanId<>BasicLan) and (mc.LanId<>BasicLNLan) then Write(mc.FTextPtr^,','); //if not basic write a comma
if (mc.LanId<>BasicLan) and (mc.LanId<>BasicLNLan) and (mc.LanId<>QBJSBasicLan) then Write(mc.FTextPtr^,','); //if not basic write a comma
end;
end;
end;
Expand All @@ -157,6 +159,7 @@ function ByteToHex(num : byte;LanId : integer) : string;
if LanId=BasicLan then HStr:='&H'+HStr;
if LanId=PascalLan then HStr:='$'+HStr;
if LanId=CLan then HStr:='0x'+HStr;
if LanId=QBJSBasicLan then HStr:='0x'+HStr;
ByteToHex:=HStr;
end;

Expand Down
15 changes: 15 additions & 0 deletions rmexportprops.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -311,6 +311,20 @@ procedure TImageExportForm.UpdateComboBoxes(compiler : integer);
ComboMask.ItemIndex:=EO.Mask;
ComboPalette.ItemIndex:=EO.Palette;
end;
QBJSLan:begin
ComboImage.Items.Clear;
ComboMask.Items.Clear;
ComboImage.Items.Add('None');
ComboImage.Items.Add('RGBA Fuchsia');
ComboImage.Items.Add('RGBA Index 0');
ComboImage.Items.Add('RGBA Custom');
ComboImage.Items.Add('RGB');
ComboMask.Items.Add('None');
ComboImage.ItemIndex:=EO.Image;
ComboMask.ItemIndex:=EO.Mask;
ComboPalette.ItemIndex:=EO.Palette;
end;


end;
end;
Expand Down Expand Up @@ -375,6 +389,7 @@ procedure TImageExportForm.InitComboBoxes;
ComboCompiler.Items.Add('Open Watcom C');
ComboCompiler.Items.Add('BAM Basic');
ComboCompiler.Items.Add('TMT Pascal');
ComboCompiler.Items.Add('QBJS');

ComboCompiler.ItemIndex:=0;
ComboImage.Items.Clear;
Expand Down
19 changes: 19 additions & 0 deletions rmmain.lfm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -859,6 +859,25 @@ object RMMainForm: TRMMainForm
OnClick = RayLibExportClick
end
end
object QBJS: TMenuItem
Caption = 'QBJS'
object qbjsRGBAFuchsia: TMenuItem
Caption = 'RGBA - Fuchsia Data Statements'
OnClick = RayLibExportClick
end
object qbjsRGBAIndex0: TMenuItem
Caption = 'RGBA - Index 0 Data Statements'
OnClick = RayLibExportClick
end
object qbjsRGBACustom: TMenuItem
Caption = 'RGBA - Custom Data Statements'
OnClick = RayLibExportClick
end
object qbjsRGB: TMenuItem
Caption = 'RGB Data Statements'
OnClick = RayLibExportClick
end
end
object QuickC: TMenuItem
Caption = 'Quick C'
object QCPutImageArray: TMenuItem
Expand Down
53 changes: 52 additions & 1 deletion rmmain.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -74,6 +74,11 @@ TRMMainForm = class(TForm)
fpRayLibCustom: TMenuItem;
gccRayLibCustom: TMenuItem;
EditProperties: TMenuItem;
QBJS: TMenuItem;
qbjsRGBAFuchsia: TMenuItem;
qbjsRGBAIndex0: TMenuItem;
qbjsRGBACustom: TMenuItem;
qbjsRGB: TMenuItem;
qb64RGBACustom: TMenuItem;
PaletteExportTMTPascal: TMenuItem;
TMTPaletteArray: TMenuItem;
Expand Down Expand Up @@ -2501,6 +2506,32 @@ function TRMMainForm.ExportTextFileToClipboard(Sender: TObject) : boolean;
error:=IORESULT;
{$I-}
end;
'qbjsRGBAFuchsia':begin
WriteRayLibCodeToFile(FileName,x,y,x2,y2,QBJSLan,1);
{$I+}
error:=IORESULT;
{$I-}
end;
'qbjsRGBAIndex0':begin
WriteRayLibCodeToFile(FileName,x,y,x2,y2,QBJSLan,2);
{$I+}
error:=IORESULT;
{$I-}
end;
'qbjsRGBACustom':begin
WriteRayLibCodeToFile(FileName,x,y,x2,y2,QBJSLan,4);
{$I+}
error:=IORESULT;
{$I-}
end;

'qbjsRGB' : begin
WriteRayLibCodeToFile(FileName,x,y,x2,y2,QBJSLan,3);
{$I+}
error:=IORESULT;
{$I-}
end;

'fbRayLibFuchsia':begin
WriteRayLibCodeToFile(FileName,x,y,x2,y2,FBLan,1);
{$I+}
Expand Down Expand Up @@ -3710,7 +3741,27 @@ procedure TRMMainForm.RayLibExportClick(Sender: TObject);
Lan:=QB64Lan;
format:=3;
end;

'qbjsRGBAFuchsia':begin
ExportDialog.Filter := 'Basic Array|*.bas';
Lan:=QBJSLan;
format:=1;
end;
'qbjsRGBAIndex0':begin
ExportDialog.Filter := 'Basic Array|*.bas';
Lan:=QBJSLan;
format:=2;
end;

'qbjsRGBACustom':begin
ExportDialog.Filter := 'Basic Array|*.bas';
Lan:=QBJSLan;
format:=4;
end;
'qbjsRGB' : begin
ExportDialog.Filter := 'Basic Array|*.bas';
Lan:=QBJSLan;
format:=3;
end;
'fbRayLibFuchsia':begin
ExportDialog.Filter := 'Basic Array|*.bas';
Lan:=FBLan;
Expand Down
70 changes: 64 additions & 6 deletions rres.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -191,6 +191,13 @@ function ImageIndexToFormat(Compiler,ImageIndex : integer) : integer;
8:format:=RayLibRGBExportFormat;
end;
end;
QBJSLan:begin
case ImageIndex of 1:format:=RGBAFuchsiaExportFormat;
2:format:=RGBAIndex0ExportFormat;
3:format:=RGBACustomExportFormat;
4:format:=RGBExportFormat;
end;
end;
PBLan:begin
case ImageIndex of 1:format:=PutImageExportFormat;
2:format:=MouseImageExportFormat;
Expand Down Expand Up @@ -333,6 +340,14 @@ function GetRESImageSize(width,height,nColors,Lan,ImageType : integer) : longint
RayLibRGBExportFormat:size:=ResRayLibImageSize(width,height,RGBSize);
end;
end;
QBJSLan:begin
Case ImageFormat of RGBAFuchsiaExportFormat:size:=ResRayLibImageSize(width,height,RGBASize);
RGBAIndex0ExportFormat:size:=ResRayLibImageSize(width,height,RGBASize);
RGBACustomExportFormat:size:=ResRayLibImageSize(width,height,RGBASize);
RGBExportFormat:size:=ResRayLibImageSize(width,height,RGBSize);
end;
end;

FPLan:begin
Case ImageFormat of PutImageExportFormat:size:=GetXImageSizeFP(width,height);
RGBAFuchsiaExportFormat:size:=ResRayLibImageSize(width,height,RGBASize);
Expand Down Expand Up @@ -416,7 +431,7 @@ function GetRESMapSize(mwidth,mheight : integer) : longint;
Procedure WriteBasicLabel(var data : BufferRec;Lan : integer;LabelName : string);
begin
//we don't want GWLan - it has line number already
case Lan of BAMLan,ABLan,AQBLan,FBinQBModeLan,FBLan,QBLan,QB64Lan,PBLan:Writeln(data.fText,LabelName,'Label:');
case Lan of BAMLan,ABLan,AQBLan,FBinQBModeLan,FBLan,QBLan,QB64Lan,PBLan,QBJSLan:Writeln(data.fText,LabelName,'Label:');
end;
end;

Expand All @@ -426,10 +441,11 @@ procedure WriteBasicVariable(var data : BufferRec;Lan : integer;vname,vsubname :
begin
DotOrUnderScore:='.';

if (Lan=BAMLan) or (Lan=AQBLan) or (Lan = FBinQBModeLan) or (Lan = FBLan) then
if (Lan=BAMLan) or (Lan=AQBLan) or (Lan = FBinQBModeLan) or (Lan = FBLan) or (Lan = QBJSLan) then
begin
DotOrUnderScore:='_';
end;

if (Lan=AQBLan) or (Lan = FBLan) then
begin
writeln(data.fText,LineCountToStr(Lan),'Dim ',vname,DotOrUnderScore,vsubname,' As Integer = ',value);
Expand All @@ -438,6 +454,10 @@ procedure WriteBasicVariable(var data : BufferRec;Lan : integer;vname,vsubname :
begin
writeln(data.fText,LineCountToStr(Lan),'Const ',vname,DotOrUnderScore,vsubname,' = ',value);
end
else if (Lan=QBJSLan) then
begin
writeln(data.fText,LineCountToStr(Lan),'Const ',vname,DotOrUnderScore,vsubname,' = ',value);
end
else
begin
writeln(data.fText,LineCountToStr(Lan),vname,DotOrUnderScore,vsubname,' = ',value);
Expand Down Expand Up @@ -484,6 +504,28 @@ procedure WriteFBBasicReadStub(var data : BufferRec;Lan : integer; name : string
writeln(data.fText,LineCountToStr(Lan),'Next _rmy');
end;

procedure WriteQBJSReadStub(var data : BufferRec;Lan : integer; name : string;size : longint);
begin
writeln(data.fText,LineCountToStr(Lan),'Restore ',name,'Label');
writeln(data.fText,LineCountToStr(Lan),'Dim ',name);
writeln(data.fText,LineCountToStr(Lan),name,' = _NewImage(',name,'_Width,',name,'_Height,32)');
writeln(data.fText,LineCountToStr(Lan),'rmprevdest = _Dest');
writeln(data.fText,LineCountToStr(Lan),'_Dest ',name);
writeln(data.fText,LineCountToStr(Lan),'For rmy=0 to ',name,'_Height-1');
writeln(data.fText,LineCountToStr(Lan),' For rmx=0 to ',name,'_Width-1');
writeln(data.fText,LineCountToStr(Lan),' Read rmr,rmg,rmb');
writeln(data.fText,LineCountToStr(Lan),' if ',name,'_Format = 7 Then');
writeln(data.fText,LineCountToStr(Lan),' Read rma');
writeln(data.fText,LineCountToStr(Lan),' PSet(rmx,rmy),_RGBA(rmr,rmg,rmb,rma)');
writeln(data.fText,LineCountToStr(Lan),' else');
writeln(data.fText,LineCountToStr(Lan),' PSet(rmx,rmy),_RGB(rmr,rmg,rmb)');
writeln(data.fText,LineCountToStr(Lan),' end if');
writeln(data.fText,LineCountToStr(Lan),' Next rmx');
writeln(data.fText,LineCountToStr(Lan),'Next rmy');
writeln(data.fText,LineCountToStr(Lan),'_Dest rmprevdest');
end;


procedure WriteQB64ReadStub(var data : BufferRec;Lan : integer; name : string;size : longint);
begin
writeln(data.fText,LineCountToStr(Lan),'Restore ',name,'Label');
Expand Down Expand Up @@ -645,7 +687,7 @@ procedure WriteBasicRMInit(var data : BufferRec);
end;


if (EO.LAN in [BAMLan,ABLan,AQBLan,GWLan,QBLan,QB64Lan,FBinQBModeLan,FBLan,PBLan]) then
if (EO.LAN in [BAMLan,ABLan,AQBLan,GWLan,QBLan,QB64Lan,QBJSLan,FBinQBModeLan,FBLan,PBLan]) then
begin
if DefIntFlag then
begin
Expand All @@ -666,6 +708,15 @@ procedure WriteBasicRMInit(var data : BufferRec);
writeln(data.fText,LineCountToStr(EO.Lan),'Dim rmr, rmg, rmb, rma As _Unsigned _Byte');
end;
end
else if (EO.Lan = QBJSLan) then
begin
if ImageExportFormat in [RGBAFuchsiaExportFormat,RGBAIndex0ExportFormat,RGBACustomExportFormat,RGBExportFormat] then
begin
writeln(data.fText,LineCountToStr(EO.Lan),'Dim rmx,rmy,rmi,rmj,rmc AS Integer');
writeln(data.fText,LineCountToStr(EO.Lan),'Dim rmr, rmg, rmb, rma As _Unsigned _Byte');
writeln(data.fText,LineCountToStr(EO.Lan),'Dim rmprevdest');
end;
end
else
begin
Writeln(data.fText,LineCountToStr(EO.Lan),'DEFINT A-Z');
Expand Down Expand Up @@ -701,7 +752,7 @@ procedure WriteBasicRMInit(var data : BufferRec);

WriteBasicVariable(data,EO.Lan,EO.Name,'Size',size);
// if ((EO.Lan = QB64Lan) or (EO.Lan = FBLan)) and ((EO.Image > 0) and (EO.Image < 4)) then
if ((EO.Lan = QB64Lan) or (EO.Lan = FBLan)) then
if ((EO.Lan = QB64Lan) or (EO.Lan = QBJSLan) or (EO.Lan = FBLan)) then
begin
if ImageExportFormat in [RGBAFuchsiaExportFormat,RGBAIndex0ExportFormat,RGBACustomExportFormat,RGBExportFormat,RayLibRGBAFuchsiaExportFormat,RayLibRGBAIndex0ExportFormat,RayLibRGBExportFormat] then
begin
Expand Down Expand Up @@ -746,6 +797,13 @@ procedure WriteBasicRMInit(var data : BufferRec);
WriteQB64RayLibReadStub(data,EO.Lan,EO.Name,size); //QB64 - Use RayLib Graphics
end;
end
else if (EO.Lan=QBJSLan) then
begin
if (ImageExportFormat in [RGBAFuchsiaExportFormat,RGBAIndex0ExportFormat,RGBACustomExportFormat,RGBExportFormat]) then
begin
WriteQBJSReadStub(data,EO.Lan,EO.Name,size); //QBJS
end;
end
else
begin
if (ImageExportFormat in[PutImageExportFormat,MouseImageExportFormat]) then WriteBasicDimReadStub(data,EO.Lan,EO.Name,size); //loading stub for putimage code.
Expand Down Expand Up @@ -942,7 +1000,7 @@ procedure WriteBasicRMInit(var data : BufferRec);
end;

//RGBA/RayLib formats
if (EO.Lan in [FPLan,QB64Lan,FBLan,gccLan]) and (ImageExportFormat in [RGBAFuchsiaExportFormat,
if (EO.Lan in [FPLan,QB64Lan,QBJSLan,FBLan,gccLan]) and (ImageExportFormat in [RGBAFuchsiaExportFormat,
RGBAIndex0ExportFormat,
RGBACustomExportFormat,
RGBExportFormat,
Expand All @@ -951,7 +1009,7 @@ procedure WriteBasicRMInit(var data : BufferRec);
RayLibRGBACustomExportFormat,
RayLibRGBExportFormat]) then
begin
if (EO.Lan in [QB64Lan,FBLan]) then WriteBasicLabel(data,EO.Lan,EO.Name);
if (EO.Lan in [QB64Lan,QBJSLan,FBLan]) then WriteBasicLabel(data,EO.Lan,EO.Name);
Case ImageExportFormat of RGBAFuchsiaExportFormat:WriteRayLibCodeToBuffer(data.fText,0,0,width-1,height-1, EO.Lan,1,EO.Name);
RGBAIndex0ExportFormat:WriteRayLibCodeToBuffer(data.fText,0,0,width-1,height-1, EO.Lan,2,EO.Name);
RGBACustomExportFormat:WriteRayLibCodeToBuffer(data.fText,0,0,width-1,height-1, EO.Lan,4,EO.Name);
Expand Down
1 change: 1 addition & 0 deletions rwxgf.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@
OWLan = 17; //Open Watcom C/C++ compiler
BAMLan = 18; //Basic Anywhere Machine
TMTLan = 19; // TMT Pascal Compiler - 32bit DOS
QBJSLan = 20; // QB to JS transpiler

NoExportFormat = 0;
PutImageExportFormat = 1; //for all compilers the use put/putimage
Expand Down
Loading

0 comments on commit badb7fd

Please sign in to comment.