From d266848258e05621cd9a79c70049225bb20eec2f Mon Sep 17 00:00:00 2001 From: Nick's Hardware Youtube Channel <56885781+nickshardware@users.noreply.github.com> Date: Fri, 3 Feb 2023 21:57:38 -0500 Subject: [PATCH] Open Watcom C Support --- rmabout.lfm | 4 +- rmabout.pas | 2 +- rmmain.lfm | 11 +++++ rmmain.pas | 30 +++++++++++++ rwpng.pas | 24 ++++++++-- rwxgf.pas | 123 +++++++++++++++++++++++++++++++++++++++++++++++++++- 6 files changed, 187 insertions(+), 7 deletions(-) diff --git a/rmabout.lfm b/rmabout.lfm index 0772f3b..e378af3 100644 --- a/rmabout.lfm +++ b/rmabout.lfm @@ -41,9 +41,9 @@ object AboutDialog: TAboutDialog Brush.Color = clRed end object Image1: TImage - Left = 275 + Left = 264 Height = 138 - Top = 90 + Top = 72 Width = 133 AutoSize = True Picture.Data = { diff --git a/rmabout.pas b/rmabout.pas index dbc09ed..3207d66 100644 --- a/rmabout.pas +++ b/rmabout.pas @@ -8,7 +8,7 @@ interface Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,lclintf; Const - ProgramName ='Raster Master v1.4 R71'; + ProgramName ='Raster Master v1.4 R72'; ProgramLicense = 'Released under MIT License'; type diff --git a/rmmain.lfm b/rmmain.lfm index 531cf5d..0b3b321 100644 --- a/rmmain.lfm +++ b/rmmain.lfm @@ -741,6 +741,17 @@ object RMMainForm: TRMMainForm OnClick = javaScriptArrayClick end end + object OpenWatcom: TMenuItem + Caption = 'Open Watcom C' + object OWPutImageArray: TMenuItem + Caption = '_putimage array' + OnClick = OpenWatcomCClick + end + object OWPutImagePlusMaskArray: TMenuItem + Caption = '_putimage+Mask array' + OnClick = OpenWatcomCClick + end + end object QuickBasic: TMenuItem Caption = 'QBasic\QuickBasic' object QBPutData: TMenuItem diff --git a/rmmain.pas b/rmmain.pas index 7aa5d03..db32ba2 100644 --- a/rmmain.pas +++ b/rmmain.pas @@ -74,6 +74,9 @@ TRMMainForm = class(TForm) AqbPsetBitMap: TMenuItem; GWMouseShapeFile: TMenuItem; FBMouseShapeFile: TMenuItem; + OWPutImagePlusMaskArray: TMenuItem; + OWPutImageArray: TMenuItem; + OpenWatcom: TMenuItem; QBMouseShapeFile: TMenuItem; TCMouseShapeFile: TMenuItem; TBMouseShapeFile: TMenuItem; @@ -311,6 +314,7 @@ TRMMainForm = class(TForm) procedure ListView1Click(Sender: TObject); procedure DeleteAllClick(Sender: TObject); procedure MapEditMenuClick(Sender: TObject); + procedure OpenWatcomCClick(Sender: TObject); procedure RayLibExportClick(Sender: TObject); procedure RightPanelClick(Sender: TObject); procedure RMPanelClick(Sender: TObject); @@ -2610,6 +2614,32 @@ procedure TRMMainForm.PaletteExportTurboCClick(Sender: TObject); end; end; +procedure TRMMainForm.OpenWatcomCClick(Sender: TObject); +var + x,y,x2,y2 : integer; + error : word; +begin + GetOpenSaveRegion(x,y,x2,y2); + Case (Sender As TMenuItem).Name of 'OWPutImageArray' :ExportDialog.Filter := 'Open Watcom C _putimage Array|*.c'; + 'OWPutImagePlusMaskArray' :ExportDialog.Filter := 'Open Watcom C _putimage+Mask Array|*.c'; + 'OWPutImageFile' :ExportDialog.Filter := 'Open Watcom C _putimage File|*.xgf'; + End; + + if ExportDialog.Execute then + begin + Case (Sender As TMenuItem).Name of 'OWPutImageArray' : error:=WriteXGFToCode(x,y,x2,y2,OWLan,ExportDialog.FileName); + 'OWPutImagePlusMaskArray' : error:=WriteXgfWithMaskToCode(x,y,x2,y2,OWLan,ExportDialog.FileName); + 'OWPutImageFile' : error:=WriteXGFToFile(x,y,x2,y2,OWLan,ExportDialog.FileName); + End; + + if error<>0 then + begin + ShowMessage('Error Saving file!'); + exit; + end; + end; +end; + procedure TRMMainForm.QuickCClick(Sender: TObject); var x,y,x2,y2 : integer; diff --git a/rwpng.pas b/rwpng.pas index 1688468..8796b77 100644 --- a/rwpng.pas +++ b/rwpng.pas @@ -55,10 +55,25 @@ function FindPaletteIndex(r,g,b : integer;var BasePalette : TRMPaletteBuf;pm,nCo implementation function TColorToStr(Color : TColor) : string; +(* +var + r,g,b : integer;*) begin + (* + r:=SixToEightBit(EightToSixBit(Red(Color))); + g:=SixToEightBit(EightToSixBit(Green(Color))); + b:=SixToEightBit(EightToSixBit(Blue(Color))); + + TColorToStr := AddChar('0',IntToStr(r),3)+ + AddChar('0',IntToStr(g),3)+ + AddChar('0',IntToStr(b), 3); + *) + + TColorToStr := AddChar('0',IntToStr(Red(Color)),3)+ AddChar('0',IntToStr(Green(Color)),3)+ AddChar('0',IntToStr(Blue(Color)), 3); + end; @@ -231,15 +246,17 @@ function FindPaletteIndex(r,g,b : integer;var BasePalette : TRMPaletteBuf;pm,nCo end else if (pm=PaletteModeVGA) or (pm=paletteModeVGA256) then begin - (* r:=SixToEightBit(EightToSixBit(r)); + + r:=SixToEightBit(EightToSixBit(r)); g:=SixToEightBit(EightToSixBit(g)); b:=SixToEightBit(EightToSixBit(b)); - *) + + (* r:=TwoToEightBit(EightToTwoBit(r)); g:=TwoToEightBit(EightToTwoBit(g)); b:=TwoToEightBit(EightToTwoBit(b)); - + *) ColorIndex:=FindNearColorMatch(BasePalette,nColors,r,g,b); //near performas findexact also if (pm=PaletteModeVGA) and (ColorIndex > 15) then ColorIndex:=ColorIndex Mod 15; @@ -441,6 +458,7 @@ function TEasyPNG.GetHeight : integer; Procedure TEasyPNG.LoadFromFile(filename : string); begin +// Picture1.Bitmap.PixelFormat:=pf4bit; Picture1.LoadFromFile(filename); end; diff --git a/rwxgf.pas b/rwxgf.pas index e3ac16b..eaeb17a 100644 --- a/rwxgf.pas +++ b/rwxgf.pas @@ -27,6 +27,7 @@ AQBLan = 14; //Amiga APQBasic support - once we figure out how to access t_BitMap memory and stuff it with bitplane data QPLan = 15; //Quick Pascal gccLan = 16; + OWLan = 17; //Open Watcom C/C++ compiler NoExportFormat = 0; @@ -100,6 +101,7 @@ 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; procedure BitplaneWriterFile(inByte : Byte; var Buffer : BufferRec;action : integer); procedure BitplaneWriterPascalCode(inByte : Byte; var Buffer : BufferRec;action : integer); @@ -117,6 +119,13 @@ procedure BitplaneWriterGWBasicCode(inByte : Byte; var Buffer : BufferRec;action Height : Word; End; + //Open Watcom XGF header - slightly different than borland/MS + XgfHeadOW = Packed Record + Width : Word; + Height : Word; + Colors : Word; // 1 = Monochrome, 2 = 4 color/GGA modes, 4 = 16 color modes, 8 = 256 color modes + End; + //free pascal graph - each pixel takes a Word XGFHeadFP = Packed Record Width,Height : LongInt; @@ -130,10 +139,22 @@ procedure BitplaneWriterGWBasicCode(inByte : Byte; var Buffer : BufferRec;action const - BorlandColorMap : ColorMap = (0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15); + BorlandColorMap : ColorMap = (0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15); //Borland and Open Watcom 16 color remap // MSColorMap: ColorMap = (0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15); +function nColorsToColorBits(nColors : integer) : integer; +var + CB : integer; +begin + CB:=0; + Case nColors of 2:CB:=1; + 4:CB:=2; + 16:CB:=4; + 256:CB:=8; + end; + nColorsToColorBits:=CB; +end; Procedure spTOmp(var singlePlane : LineBufType ; var multiplane : LineBufType; @@ -314,6 +335,11 @@ function GetXImageSize(width,height,ncolors : integer) : longint; end; end; +function GetXImageSizeOW(width,height,ncolors : integer) : longint; +begin + GetXImageSizeOW:=GetXImageSize(width,height,ncolors)+2; //OW header contains 2 more bytes to specy Color Bits +end; + function GetXImageSizeFP(width,height : integer) : longint; begin //all FP simulated Graph modes up 256 colors take word per pixel @@ -415,6 +441,63 @@ function GetXImageSizeFB(width,height : integer) : longint; BitplaneWriter(0,data,2); //flush it end; +Procedure WriteXGFBufferOW(BitPlaneWriter : BitPlaneWriterProc;var data :BufferRec; x,y,x2,y2,LanType : word); +Var + sourcelinebuf : Linebuftype; + destlinebuf : Linebuftype; + Head : XgfHeadOW; + width : word; + height : word; + BPL : Word; //bytes per line for one bitplane + BTW : word; //bytes to write to buffer + i,j,n : Word; + nColors : Word; + tempBuf : array[1..6] of byte; +begin + width:=x2-x+1; + Height:=y2-y+1; + nColors:=GetMaxColor+1; + BPL:=GetBPLSize(Width,nColors); + BTW:=BPL; + + if nColors = 16 then BTW:=BPL*4; + + Head.Width:=width; + Head.Height:=height; + Head.Colors:=nColorsToColorBits(nColors); + Move(Head,tempBuf,sizeof(tempBuf)); + + for n:=1 to 6 do + begin + BitplaneWriter(tempBuf[n],data,1); + end; + + for j:=0 to height-1 do + begin + for i:=0 to Width-1 do + begin + sourceLineBuf[i]:=GetPixel(x+i,y+j); + end; + case nColors of 2:spTOmp(sourcelinebuf,destlinebuf,BPL,1); + 4:spToPacked(sourcelinebuf,destlinebuf,BPL); + 16:begin + RemapToBorland(sourcelinebuf,Width); //OW uses the same bit plane format as Borland for 16 colors + spTOmp(sourcelinebuf,destlinebuf,BPL,4); + end; + 256:destlinebuf:=sourcelinebuf; + end; + for n:=0 to BTW-1 do + begin + BitplaneWriter(destlinebuf[n],data,1); + end; + end; + + BitplaneWriter(0,data,2); //flush it +end; + + + + Procedure WriteXGFBuffer(BitPlaneWriter : BitPlaneWriterProc;var data :BufferRec; x,y,x2,y2,LanType : word); Var sourcelinebuf : Linebuftype; @@ -724,6 +807,40 @@ procedure BitplaneWriterBasicCode(inByte : Byte; var Buffer : BufferRec;action : end; +Function WriteOWCodeToBuffer(var data :BufferRec;x,y,x2,y2,imageId : word; imagename:string):word; +var + Width,Height : Word; + Size : longint; + nColors : integer; + BWriter : BitPlaneWriterProc; +begin + BWriter:=@BitplaneWriterCCode; + + width:=x2-x+1; + height:=y2-y+1; + nColors:=GetMaxColor+1; + Size:=GetXImageSizeOW(width,height,nColors); +{$I-} + BWriter(0,data,0); //init the data record + data.ArraySize:=size; + + writeln(data.ftext,'/* Open Watcom C _putimage Bitmap Code Created By Raster Master */'); + writeln(data.ftext,'/* Size= ', Size,' Width= ',width,' Height= ',height, ' Colors= ',nColors,' */'); + writeln(data.ftext,' #define ',Imagename,'_Size ',size); + writeln(data.ftext,' #define ',Imagename,'_Width ',width); + writeln(data.ftext,' #define ',Imagename,'_Height ',height); + writeln(data.ftext,' #define ',Imagename,'_Colors ',nColors); + Writeln(data.ftext,' #define ',ImageName,'_Id ',imageId); + + writeln(data.ftext,' ','char ',Imagename, '[',size,'] = {'); + WriteXGFBufferOW(BWriter,data,x,y,x2,y2,OWLan); + writeln(data.ftext); + +{$I+} + WriteOWCodeToBuffer:=IORESULT; +end; + + Function WriteTCCodeToBuffer(var data :BufferRec;x,y,x2,y2,imageId : word; imagename:string):word; var Width,Height : Word; @@ -1030,6 +1147,8 @@ procedure WriteXgfToBufferFP(x,y,x2,y2,Mask : word;var data : BufferRec); 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); @@ -1098,6 +1217,8 @@ function WriteXGFCodeToBuffer(var data : BufferRec;x,y,x2,y2,LanType,Mask : word 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); FPLan: WriteFPCodeToBuffer(data,x,y,x2,y2,imageid,imagename);