Skip to content

Commit

Permalink
Open Watcom C Support
Browse files Browse the repository at this point in the history
  • Loading branch information
@RetroNick2020
RetroNick2020 committed Feb 4, 2023
1 parent afa2d85 commit d266848
Show file tree
Hide file tree
Showing 6 changed files with 187 additions and 7 deletions.
4 changes: 2 additions & 2 deletions rmabout.lfm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 = {
Expand Down
2 changes: 1 addition & 1 deletion rmabout.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
11 changes: 11 additions & 0 deletions rmmain.lfm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
30 changes: 30 additions & 0 deletions rmmain.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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;
Expand Down
24 changes: 21 additions & 3 deletions rwpng.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;


Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -441,6 +458,7 @@ function TEasyPNG.GetHeight : integer;

Procedure TEasyPNG.LoadFromFile(filename : string);
begin
// Picture1.Bitmap.PixelFormat:=pf4bit;
Picture1.LoadFromFile(filename);
end;

Expand Down
123 changes: 122 additions & 1 deletion rwxgf.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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);
Expand All @@ -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;
Expand All @@ -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;
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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);
Expand Down

0 comments on commit d266848

Please sign in to comment.