diff --git a/rmabout.pas b/rmabout.pas index cc5e830..9f819f0 100644 --- a/rmabout.pas +++ b/rmabout.pas @@ -8,8 +8,8 @@ interface Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,lclintf; Const - ProgramName ='Raster Master v3.3 R100'; - ProgramLicense = 'Released January 19 - 2024 under MIT License'; + ProgramName ='Raster Master v3.4 R101'; + ProgramLicense = 'Released January 22 - 2024 under MIT License'; type diff --git a/rmexportprops.pas b/rmexportprops.pas index 68f8a1e..894f8ae 100644 --- a/rmexportprops.pas +++ b/rmexportprops.pas @@ -178,6 +178,7 @@ procedure TImageExportForm.UpdateComboBoxes(compiler : integer); ComboMask.Items.Clear; ComboImage.Items.Add('None'); ComboImage.Items.Add('Put Image'); + ComboImage.Items.Add('Put RGB Image'); ComboMask.Items.Add('None'); ComboMask.Items.Add('Inverted'); ComboImage.ItemIndex:=EO.Image; diff --git a/rmmain.lfm b/rmmain.lfm index 20d4893..324ee9d 100644 --- a/rmmain.lfm +++ b/rmmain.lfm @@ -663,6 +663,10 @@ object RMMainForm: TRMMainForm Caption = 'Put+Mask Data Statements' OnClick = BAMPutDataClick end + object BAMRGBPutData: TMenuItem + Caption = 'Put RGB Data Statements' + OnClick = BAMPutDataClick + end end object FreeBASIC: TMenuItem Caption = 'FreeBASIC - QB Mode' diff --git a/rmmain.pas b/rmmain.pas index 0fc4674..06bb72c 100644 --- a/rmmain.pas +++ b/rmmain.pas @@ -74,6 +74,7 @@ TRMMainForm = class(TForm) fpRayLibCustom: TMenuItem; gccRayLibCustom: TMenuItem; EditProperties: TMenuItem; + BAMRGBPutData: TMenuItem; QBJS: TMenuItem; qbjsRGBAFuchsia: TMenuItem; qbjsRGBAIndex0: TMenuItem; @@ -2004,6 +2005,7 @@ procedure TRMMainForm.BAMPutDataClick(Sender: TObject); ExportDialog.FileName:=''; Case (Sender As TMenuItem).Name of 'BAMPutData' :ExportDialog.Filter := 'BAM Put Data Statements|*.bas'; 'BAMPutPlusMaskData' :ExportDialog.Filter := 'BAM Put+Mask Data Statements|*.bas'; + 'BAMRGBPutData' :ExportDialog.Filter := 'BAM Put RGB Data Statements|*.bas'; End; @@ -2013,7 +2015,7 @@ procedure TRMMainForm.BAMPutDataClick(Sender: TObject); begin Case (Sender As TMenuItem).Name of 'BAMPutData' : error:=WriteXGFToCode(x,y,x2,y2,BAMLan,ExportDialog.FileName); 'BAMPutPlusMaskData' : error:=WriteXgfWithMaskToCode(x,y,x2,y2,BAMLan,ExportDialog.FileName); - + 'BAMRGBPutData' : error:=WriteXGFToCodeEx(x,y,x2,y2,BAMLan,RGBExportFormat,ExportDialog.FileName); End; if (error<>0) then @@ -2422,6 +2424,7 @@ function TRMMainForm.ExportTextFileToClipboard(Sender: TObject) : boolean; 'BAMPutData' : error:=WriteXGFToCode(x,y,x2,y2,BAMLan,FileName); 'BAMPutPlusMaskData' : error:=WriteXgfWithMaskToCode(x,y,x2,y2,BAMLan,FileName); + 'BAMRGBPutData' : error:=WriteXGFToCodeEx(x,y,x2,y2,BAMLan,RGBExportFormat,FileName); 'FBPutData' : error:=WriteXGFToCode(x,y,x2,y2,FBinQBModeLan,FileName); 'FBPutPlusMaskData' : error:=WriteXgfWithMaskToCode(x,y,x2,y2,FBinQBModeLan,FileName); diff --git a/rres.pas b/rres.pas index 11d74f3..6d51b4f 100644 --- a/rres.pas +++ b/rres.pas @@ -178,6 +178,7 @@ function ImageIndexToFormat(Compiler,ImageIndex : integer) : integer; end; BAMLan:begin case ImageIndex of 1:format:=PutImageExportFormat; + 2:format:=RGBExportFormat; end; end; QB64Lan:begin @@ -326,9 +327,9 @@ function GetRESImageSize(width,height,nColors,Lan,ImageType : integer) : longint end; BAMLan:begin Case ImageFormat of PutImageExportFormat:size:=GetXImageSizeBAM(width,height,ncolors); + RGBExportFormat:size:=GetRGBXImageSizeBAM(width,height); end; end; - QB64Lan:begin Case ImageFormat of RGBAFuchsiaExportFormat:size:=ResRayLibImageSize(width,height,RGBASize); RGBAIndex0ExportFormat:size:=ResRayLibImageSize(width,height,RGBASize); @@ -680,10 +681,6 @@ procedure WriteBasicRMInit(var data : BufferRec); RayLibRGBACustomExportFormat:size:=RayLibImageSize(width,height,RGBASize); RayLibRGBExportFormat:size:=RayLibImageSize(width,height,RGBSize); end; - // if (EO.Image > 0) and (EO.Image < 4) then - // begin - // size:=RayLibImageSize(width,height,EO.Image); - // end; end; @@ -741,17 +738,13 @@ procedure WriteBasicRMInit(var data : BufferRec); end; end; -// if (EO.Image > 0) then //we have an image - if ImageExportFormat > 0 then - begin -// if (EO.Image = 1) and ((EO.Lan = FBinQBModeLan) or (EO.Lan = ABLan) or (EO.Lan = QBLan) or (EO.Lan = GWLan) or (EO.Lan = PBLan)) then size := size div 2; //we writing basic integers for Image format 1 + if ImageExportFormat > 0 then + begin if (ImageExportFormat = PutImageExportFormat) and (EO.Lan in [BAMLan,FBinQBModeLan,ABLan,QBLan,GWLan,PBLan]) then size := size div 2; //we writing basic integers for Image format 1 - + if (ImageExportFormat = RGBExportFormat) and (EO.Lan =BAMLan) then size := size div 2; //we writing basic integers for BAM RGB format if (ImageExportFormat = MouseImageExportFormat) and (EO.Lan in [FBinQBModeLan,QBLan,GWLan,PBLan]) then size := size div 2; //we writing basic integers for Image format 1 - 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 = QBJSLan) or (EO.Lan = FBLan)) then begin if ImageExportFormat in [RGBAFuchsiaExportFormat,RGBAIndex0ExportFormat,RGBACustomExportFormat,RGBExportFormat,RayLibRGBAFuchsiaExportFormat,RayLibRGBAIndex0ExportFormat,RayLibRGBExportFormat] then @@ -761,13 +754,17 @@ procedure WriteBasicRMInit(var data : BufferRec); WriteBasicVariable(data,EO.Lan,EO.Name,'Format',Format); // for QB64/Freebasic RayLib formats end; end; + if (ImageExportFormat = RGBExportFormat) and (EO.Lan = BAMLan) then + begin + Format:=4; + WriteBasicVariable(data,EO.Lan,EO.Name,'Format',Format); + end; + WriteBasicVariable(data,EO.Lan,EO.Name,'Width',width); WriteBasicVariable(data,EO.Lan,EO.Name,'Height',height); WriteBasicVariable(data,EO.Lan,EO.Name,'Colors',nColors); WriteBasicVariable(data,EO.Lan,EO.Name,'Id',i); - //write loader code -// if (EO.Lan=ABLan) and ((EO.Image=2) or (EO.Image=3)) then //these are stored in strings so we need a diffent way if (EO.Lan=ABLan) and (ImageExportFormat in [AmigaBOBExportFormat,AmigaVSpriteExportFormat]) then //these are stored in strings so we need a diffent way begin WriteAmigaBasicBobVSprite(data,EO.Lan,EO.Name,size); @@ -777,7 +774,6 @@ procedure WriteBasicRMInit(var data : BufferRec); WriteBasicVariable(data,EO.Lan,EO.Name,'Depth',nColorsToBitPlanes(nColors)); WriteAQBImageStub(data,EO.Lan,EO.Image,EO.Mask,EO.Name,size); end -// else if (EO.Lan=FBLan) and ((EO.Image>0) and (EO.Image<4)) then else if (EO.Lan=FBLan) then begin if (ImageExportFormat in [RGBAFuchsiaExportFormat,RGBAIndex0ExportFormat,RGBExportFormat]) then @@ -785,7 +781,6 @@ procedure WriteBasicRMInit(var data : BufferRec); WriteFBBasicReadStub(data,EO.Lan,EO.Name,size); //FreeBASIC - not QB mode - RGB/RGBA Load code end; end -// else if (EO.Lan=QB64Lan) and ((EO.Image>0) and (EO.Image<4)) then else if (EO.Lan=QB64Lan) then begin if (ImageExportFormat in [RGBAFuchsiaExportFormat,RGBAIndex0ExportFormat,RGBACustomExportFormat,RGBExportFormat]) then @@ -797,6 +792,10 @@ procedure WriteBasicRMInit(var data : BufferRec); WriteQB64RayLibReadStub(data,EO.Lan,EO.Name,size); //QB64 - Use RayLib Graphics end; end + else if (EO.Lan=BAMLan) then + begin + WriteBasicDimReadStub(data,EO.Lan,EO.Name,size); //loading stub for putimage code. + end else if (EO.Lan=QBJSLan) then begin if (ImageExportFormat in [RGBAFuchsiaExportFormat,RGBAIndex0ExportFormat,RGBACustomExportFormat,RGBExportFormat]) then @@ -810,7 +809,6 @@ procedure WriteBasicRMInit(var data : BufferRec); end; end; -// if (EO.Image = 1) and (EO.Mask > 0) then //we have putimage mask - except for if (ImageExportFormat = PutImageExportFormat) and (EO.Mask > 0) then //we have putimage mask - except for begin WriteBasicVariable(data,EO.Lan,EO.Name+'Mask','Size',size); @@ -999,6 +997,12 @@ procedure WriteBasicRMInit(var data : BufferRec); WriteAQBBitMapCodeToBuffer(data.fText,0,0,height-1,width-1,EO.Name); end; + if (EO.LAN=BAMLan) and (ImageExportFormat = RGBExportFormat) then + begin + WriteBasicLabel(data,EO.Lan,EO.Name); + WriteRGBXGFCodeToBuffer(data,0,0,height-1,width-1,EO.Lan,EO.Mask,EO.Name); + end; + //RGBA/RayLib formats if (EO.Lan in [FPLan,QB64Lan,QBJSLan,FBLan,gccLan]) and (ImageExportFormat in [RGBAFuchsiaExportFormat, RGBAIndex0ExportFormat, diff --git a/rwxgf.pas b/rwxgf.pas index 08673ee..338cda3 100644 --- a/rwxgf.pas +++ b/rwxgf.pas @@ -95,6 +95,7 @@ BitPlaneWriterProc = Procedure(inByte : Byte; var Buffer : BufferRec; action : integer); Function WriteXgfToCode(x,y,x2,y2,LanType : word;filename:string):word; + Function WriteXgfToCodeEx(x,y,x2,y2,LanType, ExportFormat : word;filename:string):word; Function WriteXgfWithMaskToCode(x,y,x2,y2,LanType : word;filename:string):word; Function WriteXgfToFile(x,y,x2,y2,LanType : word;filename:string):word; @@ -105,12 +106,15 @@ procedure WriteXgfToBufferOW(x,y,x2,y2,Mask : word;var data : BufferRec); function WriteXGFCodeToBuffer(var data : BufferRec;x,y,x2,y2,LanType,Mask : word; imagename:string):word; + function WriteRGBXGFCodeToBuffer(var data : BufferRec;x,y,x2,y2,LanType,Mask : word; imagename:string):word; function GetXImageSize(width,height,ncolors : integer) : longint; function GetXImageSizeFB(width,height : integer) : longint; function GetXImageSizeFP(width,height : integer) : longint; function GetXImageSizeOW(width,height,ncolors : integer) : longint; function GetXImageSizeBAM(width,height,ncolors : integer) : longint; + function GetRGBXImageSizeBAM(width,height : integer) : longint; + function GetXImageSizeTMT(width,height,ncolors : integer) : longint; procedure BitplaneWriterFile(inByte : Byte; var Buffer : BufferRec;action : integer); @@ -372,6 +376,11 @@ function GetXImageSizeBAM(width,height,ncolors : integer) : longint; GetXImageSizeBAM:=GetBPLSizeBAM(width,ncolors)*height+4; end; +function GetRGBXImageSizeBAM(width,height : integer) : longint; +begin + GetRGBXImageSizeBAM:=width*3*height+4; +end; + function GetXImageSizeTMT(width,height,ncolors : integer) : longint; begin GetXImageSizeTMT:=GetBPLSizeTMT(width,ncolors)*height+4; @@ -554,6 +563,49 @@ function GetXImageSizeFB(width,height : integer) : longint; BitplaneWriter(0,data,2); //flush it end; +Procedure WriteRGBXGFBufferBAM(BitPlaneWriter : BitPlaneWriterProc;var data :BufferRec; x,y,x2,y2,LanType : word); +Var + destlinebuf: Linebuftype; + Head : XgfHead; + Width : word; + Height : word; + BTW : word; //bytes to write to buffer + i,j,n : Word; + tempBuf : array[1..4] of byte; + PixelIndex : integer; + cr : TRMColorRec; + begin + Width:=x2-x+1; + Height:=y2-y+1; + BTW:=Width*3; + + FixHead(Head,Width,Height,LanType); + Move(Head,tempBuf,sizeof(tempBuf)); + + for n:=1 to 4 do + begin + BitplaneWriter(tempBuf[n],data,1); + end; + + for j:=0 to Height-1 do + begin + for i:=0 to Width-1 do + begin + PixelIndex:=GetPixel(x+i,y+j); + GetColor(PixelIndex,cr); + destLineBuf[i*3]:=cr.r; + destLineBuf[i*3+1]:=cr.g; + destLineBuf[i*3+2]:=cr.b; + end; + + for n:=0 to BTW-1 do + begin + BitplaneWriter(destlinebuf[n],data,1); + end; + end; + + BitplaneWriter(0,data,2); //flush it +end; Procedure WriteXGFBufferBAM(BitPlaneWriter : BitPlaneWriterProc;var data :BufferRec; x,y,x2,y2,LanType : word); Var @@ -1215,7 +1267,8 @@ procedure BitplaneWriterBAMBasicCode(inByte : Byte; var Buffer : BufferRec;actio end; -Function WriteBAMCodeToBuffer(var data :BufferRec;x,y,x2,y2 : word; imagename:string):word; + +Function WriteBAMRGBCodeToBuffer(var data :BufferRec;x,y,x2,y2 : word; imagename:string):word; var Width,Height : Word; Size : longword; @@ -1225,6 +1278,34 @@ procedure BitplaneWriterBAMBasicCode(inByte : Byte; var Buffer : BufferRec;actio begin BWriter:=@BitplaneWriterBAMBasicCode; + width:=x2-x+1; + height:=y2-y+1; + nColors:=GetMaxColor+1; + Size:=GetRGBXImageSizeBAM(width,height); +{$I-} + BWriter(0,data,0); //init the data record + data.ArraySize:=size; + + writeln(data.ftext,#39,' BAM Put Bitmap Code Created By Raster Master'); + writeln(data.ftext,#39,' Size= ', Size div 2,' Width= ',width,' Height= ',height, ' Colors= ',nColors,' Format = RGB'); + writeln(data.ftext,#39,' ',Imagename); + WriteRGBXGFBufferBAM(BWriter,data,x,y,x2,y2,BAMLan); + writeln(data.ftext); + +{$I+} + WriteBAMRGBCodeToBuffer:=IORESULT; +end; + + +Function WriteBAMCodeToBuffer(var data :BufferRec;x,y,x2,y2 : word; imagename:string):word; +var + Width,Height : Word; + Size : longword; + nColors : integer; + BWriter : BitPlaneWriterProc; +begin + BWriter:=@BitplaneWriterBAMBasicCode; + width:=x2-x+1; height:=y2-y+1; nColors:=GetMaxColor+1; @@ -1456,6 +1537,48 @@ procedure WriteXgfToBufferTMT(x,y,x2,y2,Mask : word;var data : BufferRec); WriteXgfToCode:=IOResult; end; +//This function will replace WriteXgfToCode eventually - just adding this to one language at time +Function WriteXgfToCodeEx(x,y,x2,y2,LanType, ExportFormat : word;filename:string):word; +var + data : BufferRec; + imagename : String; + imageid : word; +begin + SetCoreActive; // we are getting data from core object RMCoreBase + SetGWStartLineNumber(1000); + assign(data.fText,filename); +{$I-} + rewrite(data.fText); + imageid:=GetThumbIndex; + Imagename:=ExtractFileName(ExtractFileNameWithoutExt(filename)); + case LanType of TPLan: WriteTPCodeToBuffer(data,x,y,x2,y2,imageid,imagename); + TCLan: WriteTCCodeToBuffer(data,x,y,x2,y2,imageid,imagename); + + TMTLan: WriteTMTCodeToBuffer(data,x,y,x2,y2,imageid,imagename); + + QBLan: WriteQBCodeToBuffer(data,x,y,x2,y2,imagename); + GWLan: WriteGWCodeToBuffer(data,x,y,x2,y2,imagename); + BAMLan:begin + Case ExportFormat of PutImageExportFormat:WriteBAMCodeToBuffer(data,x,y,x2,y2,imagename); + RGBExportFormat:WriteBAMRGBCodeToBuffer(data,x,y,x2,y2,imagename); + end; + end; + QPLan: WriteQPCodeToBuffer(data,x,y,x2,y2,imageid,imagename); + QCLan: WriteQCCodeToBuffer(data,x,y,x2,y2,imageid,imagename); + + OWLan: WriteOWCodeToBuffer(data,x,y,x2,y2,imageid,imagename); + + PBLan: WritePBCodeToBuffer(data,x,y,x2,y2,imagename); + + FBinQBModeLan: WriteFBCodeToBuffer(data,x,y,x2,y2,imagename); + FPLan: WriteFPCodeToBuffer(data,x,y,x2,y2,imageid,imagename); + + end; + close(data.fText); + {$I+} + WriteXgfToCodeEx:=IOResult; +end; + Function WriteXgfWithMaskToCode(x,y,x2,y2,LanType : word;filename:string):word; var data : BufferRec; @@ -1505,7 +1628,7 @@ procedure WriteXgfToBufferTMT(x,y,x2,y2,Mask : word;var data : BufferRec); function WriteXGFCodeToBuffer(var data : BufferRec;x,y,x2,y2,LanType,Mask : word; imagename:string):word; var - omask : integer; + omask : integer; imageid : word; begin imageId:=GetThumbIndex; @@ -1534,6 +1657,21 @@ function WriteXGFCodeToBuffer(var data : BufferRec;x,y,x2,y2,LanType,Mask : word WriteXGFCodeToBuffer:=data.Error; end; +function WriteRGBXGFCodeToBuffer(var data : BufferRec;x,y,x2,y2,LanType,Mask : word; imagename:string):word; +var + omask : integer; + imageid : word; +begin + imageId:=GetThumbIndex; + omask:=GetMaskMode; + SetMaskMode(Mask); + case LanType of BAMLan: WriteBAMRGBCodeToBuffer(data,x,y,x2,y2,imagename); + end; + SetMaskMode(omask); + WriteRGBXGFCodeToBuffer:=data.Error; +end; + + begin