Lazarus

Programming => Graphics and Multimedia => Graphics => Topic started by: Roland57 on October 26, 2020, 01:43:56 pm

Title: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 26, 2020, 01:43:56 pm
Hello!

I try to update a Dos program originally based on the Graph unit. I am on Linux. Since I had problems with the VGA library missing or not correctly installed, I decided to try to use ptcGraph and I had the joy to see "my" old program compiling and running! There is just a problem with colors, and I would need your advice on the method to repair the colors of the game. Currently all is blue on the screen.  :)

If I remember correctly, ptcGraph uses 16-bit colors. Are there existing functions to convert 32-bit colors to 16-bit?

Any help or suggestion on this problem or on any another problem that you would detect is welcome. It seems that there also some memory leaks.

I attach the source, and a screenshot of the original program that I found on the web.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Thaddy on October 26, 2020, 03:53:45 pm
32 to 16 leads to extreme data loss for the color.
you can use "nearest neighbour" and the likes to smoothen any transitions.
It is better to upscale any new  colors than trying to downscale them.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: circular on October 26, 2020, 06:55:40 pm
Hello Roland,

Hope you're alright.

I cannot find the definition of ptcGraph that would contain setColor function nor the color constants. I see in the code "setcolor(yellow)" or things like that. Why would the constant not agree with the function?

Anyway to convert from 32 bit to 16 bit you could do something like:
Code: Pascal  [Select][+][-]
  1. function From32To16(AColor: longint): word;
  2. var red, green, blue, red5, green6, blue5: byte;
  3. begin
  4.   red := AColor and $ff;
  5.   green := (AColor sur 8) and $ff;
  6.   blue := (AColor sur 16) and $ff;
  7.   red5 := red shr 3;
  8.   green6 := green shr 2;
  9.   blue5 := blue shr 3;
  10.   result := red5 + (green6 shl 5) + (blue5 shl 11);
  11. end;

@Thaddy: in this case we don't care about loss of precision for the colors to distinguish blue, yellow, white etc. as you can see from the screenshot.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Thaddy on October 26, 2020, 08:29:36 pm
@Thaddy: in this case we don't care about loss of precision for the colors to distinguish blue, yellow, white etc. as you can see from the screenshot.
ptc differs in color definition compared to, say, Dos vs different Unix terminals. Has to do with the weight encodings (like 888, 565 and family) so you can get very different colors depending on definition. That is what I am trying to point out....

And ptc has most definitely the encoding values in the header files.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 26, 2020, 09:04:21 pm
@Thaddy, circular

Thank you for your answers.

Hope you're alright.

Yes, I am well, thank you.  ;)

I cannot find the definition of ptcGraph that would contain setColor function nor the color constants. I see in the code "setcolor(yellow)" or things like that. Why would the constant not agree with the function?

Good question. I don't know. Maybe it's because of the compilation mode that I used (-Mtp)?

Thank you for your function. I used it to build a source code with 256 predefined 16-bit colors. Now the colors of the program are OK (excepted when I compile to 32-bit, I dont know why).
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 26, 2020, 09:25:52 pm
Hello Roland.

Once again, VERY impressive.

I did use fpc 64bit with that command:

Code: Pascal  [Select][+][-]
  1. fpc -Mtp -FUunits -B nero5.pas  -CX -XX -Xs

I was not able to resize-close the window but many things work, sure you will find all.

Chapeau.

Fre;D

Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 26, 2020, 09:58:04 pm
Re-hello.

Compiling with fpc 32 bit gives better result vs fpc 64, see picture.

All works, even close the app (but not resizing).
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: circular on October 27, 2020, 12:28:00 am
When trying to compile, it says it cannot find the unit ptccrt and ptcgraph. Though I have those units.  %)
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 27, 2020, 12:48:22 am
When trying to compile, it says it cannot find the unit ptccrt and ptcgraph. Though I have those units.  %)

Huh, I did get those errors too using fpc 32 bit on my multi-arch Debian OS, I needed to change config of fpc.cfg. 
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 27, 2020, 12:55:46 am
Note also that I needed to install on my Debian multi-arch this package that was missing:

Code: Pascal  [Select][+][-]
  1. $ sudo apt-get install libxxf86dga1:i386

[EDIT]

All is ok too with fpc 64 bit (I dont know why I got strange result before).

Using this:

Code: Pascal  [Select][+][-]
  1. /usr/lib/fpc/3.2.1/ppcx64 -Mtp -FUunits -B -CX -XX -Xs -ghl nero5.pas

(But there is many memory leaks.)

Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 27, 2020, 08:41:29 am
Thank you for testing, Fred.

I retouched many little things. There remains ony one small memory leak: I don't find where it comes from.

The -Mtp option is no longer needed. You can use -Mobjfpc.

I played with the different graphic modes offered by ptcGraph. I see now that it was possible to use a 8-bit color mode. Maybe it would have been a more logical choice (if we keep the original colors).

If you prefer fullscreen, change this value to 0:
Code: Pascal  [Select][+][-]
  1. procedure set_to_graphics_mode;
  2. { ... }
  3. begin
  4.   opt := 2;
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 27, 2020, 08:45:06 am
I cannot find the definition of ptcGraph that would contain setColor function nor the color constants. I see in the code "setcolor(yellow)" or things like that. Why would the constant not agree with the function?

I think these constants are for the 8-bit color mode.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: PascalDragon on October 27, 2020, 09:15:52 am
I cannot find the definition of ptcGraph that would contain setColor function nor the color constants. I see in the code "setcolor(yellow)" or things like that. Why would the constant not agree with the function?

I think these constants are for the 8-bit color mode.

The color constants are for SetPalette and GetPalette and thus for paletted color modes (like the 8-bit one).

Routines that directly take color values (like SetColor) take 32-bit RGB values on most platforms (at least those where FPC_GRAPH_SUPPORTS_TRUECOLOR is defined, on others like i8086-msdos it's 16-bit).
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 27, 2020, 10:00:59 am
The color constants are for SetPalette and GetPalette and thus for paletted color modes (like the 8-bit one).

Routines that directly take color values (like SetColor) take 32-bit RGB values on most platforms (at least those where FPC_GRAPH_SUPPORTS_TRUECOLOR is defined, on others like i8086-msdos it's 16-bit).

Thank you for your answer. Something is not clear for me. If ptcGraph expects 32-bits colors, I should get an unexpected visual result, since I use 16-bit values for the SetColor procedure, shouldn't I?
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 27, 2020, 11:48:08 am
I used to believe that ptcGraph supported only 16-bit colors. It isn't true.

Here is a little program which make a list of all modes available. I did find it on a russian forum.

Code: Pascal  [Select][+][-]
  1. { http://www.freepascal.ru/article/freepascal/20120215095658/ }
  2.  
  3. program gmodeinfo;
  4.  
  5. uses
  6. {$IFDEF UNIX}
  7.   CThreads,
  8. {$ENDIF}
  9.   SysUtils, ptcGraph;
  10.  
  11. var
  12.   ModeInfo: PModeInfo; // Сюда будет заносится информация о видеорежимах
  13.   Rez: string;
  14.  
  15. begin
  16.   ModeInfo := QueryAdapterInfo;
  17.  
  18.   if ModeInfo = nil then
  19.     WriteLn('Не удалось получить информацию у видеоадаптера...')
  20.   else
  21.   begin
  22.     //WriteLn('№ драйвера ', '№ режима ', 'Разрешение ', '  Цветов');
  23.     WriteLn('Driver num ', 'Mode num ', 'Resolution ', '  Colors', '          Mode name');
  24.     WriteLn('----------------------------------------------------------');
  25.     while ModeInfo^.Next <> nil do
  26.     begin
  27.       Write(ModeInfo^.DriverNumber: 10);
  28.       Write(ModeInfo^.ModeNumber: 9);
  29.       Rez := IntToStr(ModeInfo^.MaxX + 1) + 'x' + IntToStr(ModeInfo^.MaxY + 1);
  30.       Write(Rez: 11);
  31.       Write(ModeInfo^.MaxColor: 9);
  32.       WriteLn(' ' + ModeInfo^.ModeName: 19);
  33.       ModeInfo := ModeInfo^.Next;
  34.     end;
  35.   end;
  36. end.
  37.  

And here is the result for me:
Code: Text  [Select][+][-]
  1. Driver num Mode num Resolution   Colors          Mode name
  2. ----------------------------------------------------------
  3.          1        0    320x200        4   320 x 200 CGA C0
  4.          1        1    320x200        4   320 x 200 CGA C1
  5.          1        2    320x200        4   320 x 200 CGA C2
  6.          1        3    320x200        4   320 x 200 CGA C3
  7.          1        4    640x200        2      640 x 200 CGA
  8.          2        0    320x200        4   320 x 200 CGA C0
  9.          2        1    320x200        4   320 x 200 CGA C1
  10.          2        2    320x200        4   320 x 200 CGA C2
  11.          2        3    320x200        4   320 x 200 CGA C3
  12.          2        4    640x200        2      640 x 200 CGA
  13.          2        5    640x480        2     640 x 480 MCGA
  14.          7        0    720x348        2 720 x 348 HERCULES
  15.          3        0    640x200       16      640 x 200 EGA
  16.          3        1    640x350       16      640 x 350 EGA
  17.          9        0    640x200       16      640 x 200 EGA
  18.          9        1    640x350       16      640 x 350 EGA
  19.          9        2    640x480       16      640 x 480 VGA
  20.          6        0    320x200      256      320 x 200 VGA
  21.          6        1    320x200      256    320 x 200 ModeX
  22.         10      256    640x400      256     640 x 400 VESA
  23.         10      257    640x480      256     640 x 480 VESA
  24.         10      269    320x200    32768     320 x 200 VESA
  25.         10      272    640x480    32768     640 x 480 VESA
  26.         10      270    320x200    65536     320 x 200 VESA
  27.         10      273    640x480    65536     640 x 480 VESA
  28.         10      271    320x200 16777216     320 x 200 VESA
  29.         10      274    640x480 16777216     640 x 480 VESA
  30.         10      258    800x600       16     800 x 600 VESA
  31.         10      259    800x600      256     800 x 600 VESA
  32.         10      275    800x600    32768     800 x 600 VESA
  33.         10      276    800x600    65536     800 x 600 VESA
  34.         10      277    800x600 16777216     800 x 600 VESA
  35.         10      260   1024x768       16    1024 x 768 VESA
  36.         10      261   1024x768      256    1024 x 768 VESA
  37.         10      278   1024x768    32768    1024 x 768 VESA
  38.         10      279   1024x768    65536    1024 x 768 VESA
  39.         10      280   1024x768 16777216    1024 x 768 VESA
  40.         10      512    720x480       16     720 x 480 VESA
  41.         10      513    720x480      256     720 x 480 VESA
  42.         10      514    720x480    32768     720 x 480 VESA
  43.         10      515    720x480    65536     720 x 480 VESA
  44.         10      516    720x480 16777216     720 x 480 VESA
  45.         10      517    848x480       16     848 x 480 VESA
  46.         10      518    848x480      256     848 x 480 VESA
  47.         10      519    848x480    32768     848 x 480 VESA
  48.         10      520    848x480    65536     848 x 480 VESA
  49.         10      521    848x480 16777216     848 x 480 VESA
  50.         10      522   1152x768       16    1152 x 768 VESA
  51.         10      523   1152x768      256    1152 x 768 VESA
  52.         10      524   1152x768    32768    1152 x 768 VESA
  53.         10      525   1152x768    65536    1152 x 768 VESA
  54.         10      526   1152x768 16777216    1152 x 768 VESA
  55.         10      527   1280x720       16    1280 x 720 VESA
  56.         10      528   1280x720      256    1280 x 720 VESA
  57.         10      529   1280x720    32768    1280 x 720 VESA
  58.         10      530   1280x720    65536    1280 x 720 VESA
  59.         10      531   1280x720 16777216    1280 x 720 VESA
  60.         10      532   1366x768       16    1366 x 768 VESA
  61.         10      533   1366x768      256    1366 x 768 VESA
  62.         10      534   1366x768    32768    1366 x 768 VESA
  63.         10      535   1366x768    65536    1366 x 768 VESA
  64.  
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 27, 2020, 12:49:50 pm
I changed the graphic mode to 16 colors. Now you really have the feeling of a Dos program.  :)
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 27, 2020, 02:55:15 pm
Quote
There remains ony one small memory leak: I don't find where it comes from.

Imho, it comes from engine88.pas

You may try this:

Code: Pascal  [Select][+][-]
  1. program nero5_test;
  2. uses
  3.   cthreads,
  4.   engine88;
  5.  
  6. begin
  7. end.

Compile it with this:

Code: Bash  [Select][+][-]
  1. $ fpc -ghl nero5_test.pas

I get that:

Quote
fred@fiens $ ./nero5_test

Heap dump by heaptrc unit of nero5_test
1260 memory blocks allocated : 115031/117752
1259 memory blocks freed     : 114983/117704
1 unfreed memory blocks : 48
True heap size : 229376
True free heap : 229120
Should be : 229136
Call trace for block $00007FD7F1068F00 size 48

But I did not investigate where is the guilty.

Fre;D
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 27, 2020, 03:13:39 pm
Hum, in engine88.pas, in uses section there is:

Code: Pascal  [Select][+][-]
  1. uses
  2.   sysutils, ptccrt, ptcgraph;

Now doing this:

Code: Pascal  [Select][+][-]
  1. program nero5_test;
  2.  
  3. uses
  4.  cthreads,
  5.  ptccrt;
  6.  
  7. begin
  8. end.
  9.  

Compile it with:

Code: Bash  [Select][+][-]
  1. $ fpc -ghl nero5_test.pas

Gives the same result:

Quote
fred@fiens ~/roland> /home/fred/roland/nero5_test
Heap dump by heaptrc unit of /home/fred/roland/nero5_test
1260 memory blocks allocated : 115031/117752
1259 memory blocks freed     : 114983/117704
1 unfreed memory blocks : 48
True heap size : 229376
True free heap : 229120
Should be : 229136
Call trace for block $00007F008E667F00 size 48

Conclusion:

I fear that the memory leak is in ptccrt

Fre;D
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 27, 2020, 03:44:19 pm
It is me again!

Continuing the battle:

In ptccrt.pp in uses section there is:

Code: Pascal  [Select][+][-]
  1. uses
  2.   ptcgraph, ptc, ptcwrapper, ...


And doing this:

   
Code: Pascal  [Select][+][-]
  1. program nero5_test;
  2.      
  3.     uses
  4.      cthreads,
  5.      ptcgraph;
  6.  
  7.   begin
  8.   end.
  9.  

Gives:   

Code: Pascal  [Select][+][-]
  1. fred@fiens ./nero5_test
  2. Heap dump by heaptrc unit of nero5_test
  3. 1259 memory blocks allocated : 111191/113912
  4. 1258 memory blocks freed     : 111143/113864
  5. 1 unfreed memory blocks : 48
  6. True heap size : 229376
  7. True free heap : 229120
  8. Should be : 229136
  9. Call trace for block $00007F0409FDDF00 size 48

Re-conclusion, the memory leak is in ptcgraph.pp

(and not in ptc.pp, ptcwrapper.pp that are in uses section of ptcgraph.pp)

There is something missing in Finalization section of ptcgraph.pp.

For the sport, I let you find where.

Fre;D



Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 27, 2020, 06:26:19 pm
Thank your for your search Fred. So we should add this?

Code: Pascal  [Select][+][-]
  1. // ptcgraph.pp
  2. finalization
  3.   PTCFormat8.Destroy;
  4.   PTCFormat15.Destroy;
  5.   PTCFormat16.Destroy;

I would like to test, but I don't know what is the procedure to test a modification in FPC units.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 27, 2020, 06:42:34 pm
Thank your for your search Fred. So we should add this?

Code: Pascal  [Select][+][-]
  1. // ptcgraph.pp
  2. finalization
  3.   PTCFormat8.Destroy;
  4.   PTCFormat15.Destroy;
  5.   PTCFormat16.Destroy;

Hello Roland.

I did try this already but sadly it does not compile, even using .free;

Quote
ptcgraph.pp(3467,15) Error: (5038) identifier idents no member "Destroy"

I did a fast investigation but without luck, this memory leak is well hidden.


Quote
I would like to test, but I don't know what is the procedure to test a modification in FPC units.

I do a easy way, to be sure to not touch at the original source.

So, copy in the root directory of project all files that are in:
 
Code: Pascal  [Select][+][-]
  1. /fpc/src/packages/graph/src/ptcgraph/*.*

and in:

Code: Pascal  [Select][+][-]
  1. /fpc/src/packages/graph/src/inc/*.*

And tune those files then compile.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 27, 2020, 07:00:12 pm
[EDIT] Removed previous attachment, there was some file missing.

Hello Roland.

Here your project in attachment with all the needed files.

Fre;D
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 27, 2020, 07:28:44 pm
Thank you Fred.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 27, 2020, 08:26:03 pm
Thank you Fred.

With pleasure (if we find the guilty).

Something smells not good, in ptcgraph.pp and TPTCWrapperThread:

Using this to test the unit:

Code: Pascal  [Select][+][-]
  1. program nero5_test;
  2. uses
  3.  cthreads,
  4.  ptcgraph;
  5.  
  6. begin
  7. end.


And in ptcgraph.pp, If you use that code (removing all other lines in initialization and finalization):

Code: Pascal  [Select][+][-]
  1. ...
  2. initialization
  3.   PTCWrapperObject := TPTCWrapperThread.Create;
  4.  
  5. finalization
  6.   PTCWrapperObject.Terminate;
  7.   PTCWrapperObject.WaitFor;
  8.   PTCWrapperObject.Free;
  9. end.

The memory leak is still there.

So, imho, there is something not freed in PTCWrapperObject.

Fre;D
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Fred vS on October 27, 2020, 08:46:33 pm
Hello Roland!

I get it!

The terrorist was inside fpc/src/packages/ptc/src/ptcwrapper/ptcwrapper.pp

Here the code:

Code: Pascal  [Select][+][-]
  1. constructor TPTCWrapperThread.Create;
  2. begin
  3.   FOpen := False;
  4.   FNeedsUpdate := False;
  5.  
  6.   FOpenRequest.Processed := True;
  7.   FCloseRequest.Processed := True;
  8.   FOptionRequest.Processed := True;
  9.   FGetModesRequest.Processed := True;
  10.   FMoveMouseToRequest.Processed := True;
  11.  
  12.   FSurfaceCriticalSection := TCriticalSection.Create; // HUH DONT FORGET IT
  13.  
  14.   inherited Create(False);
  15. end;
  16.  
  17. ....
  18.  
  19. destructor TPTCWrapperThread.Destroy;
  20. begin
  21.   FSurfaceCriticalSection.free; // THIS WAS MISSING
  22.   inherited;
  23. end;
  24.  

Doing this, no more memory leak.

Quote
       You have played FREEWARE program NERO 5.
                   Feel free to give it to your friends too!
                          Send your feedback to:
                             <huikari@mit.jyu.fi>
                                       OR
 Jari Huikari, Jenkkakuja 1 B 34, 40520  JKL, FINLAND, EUROPE

Heap dump by heaptrc unit of /home/fred/roland/nero5
3066 memory blocks allocated : 627850/630696
3066 memory blocks freed     : 627850/630696
0 unfreed memory blocks : 0
True heap size : 196608
True free heap : 196608

Included fixed ptcwrapper.pp, just add it in your root directory project.

Fre.D
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: circular on October 27, 2020, 08:59:27 pm
Good job Fred  :)
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Thaddy on October 27, 2020, 09:06:37 pm

at least 16777216 values are errors in the test.....
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 27, 2020, 09:14:39 pm
Congratulations inspector Fred! Excellent job.

at least 16777216 values are errors in the test.....

Sorry, I don't understand.  :-\
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: BobDog on October 27, 2020, 09:27:00 pm

Hi Roland.
For a bit of an experiment converting 32 bit colours to 16 bit (256) colours.
I set up the converting array from freebasic.
Code: Pascal  [Select][+][-]
  1.   program To256;
  2.  uses
  3.  Windows;
  4.  
  5.      type
  6. colour =packed record
  7. case integer of
  8. 0:(r,g,b:byte);
  9. 1:(c:longword);
  10. end;
  11.  
  12.   function SetDCBrushColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCBrushColor';
  13.   function SetDCPenColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCPenColor';
  14.   function closest(v:colour):longword;forward;
  15.  
  16.    type
  17.  circle=object
  18.  x:integer;
  19.  y:integer ;
  20.  r:integer;
  21.  c:colour;
  22.  procedure draw(h:hdc);
  23.  procedure draw256(h:hdc);
  24.  end;
  25.  
  26.  procedure circle.draw(h:hdc) ;
  27.  begin
  28.   SetDCBrushColor(h,c.c);
  29.   SetDCPenColor(h,c.c);
  30.  ellipse(h,trunc(x-r)+50,trunc(y-r),trunc(x+r)+50,trunc(y+r));
  31.  end;
  32.  
  33.   procedure circle.draw256(h:hdc) ;
  34.  begin
  35.   SetDCBrushColor(h,closest(c));
  36.   SetDCPenColor(h,closest(c));
  37.  ellipse(h,trunc(x-r+400),trunc(y-r),trunc(x+r+400),trunc(y+r));
  38.  end;
  39.  // constants
  40.     const
  41.     DC_BRUSH=18;
  42.     const
  43.     DC_PEN=19;
  44.  
  45.     const clr:array[0..255] of colour=(
  46. (r:0;g:0;b:0),
  47. (r:0;g:170;b:0),
  48. (r:0;g:0;b:170),
  49. (r:0;g:170;b:170),
  50. (r:170;g:0;b:0),
  51. (r:170;g:170;b:0),
  52. (r:170;g:0;b:85),
  53. (r:170;g:170;b:170),
  54. (r:85;g:85;b:85),
  55. (r:85;g:255;b:85),
  56. (r:85;g:85;b:255),
  57. (r:85;g:255;b:255),
  58. (r:255;g:85;b:85),
  59. (r:255;g:255;b:85),
  60. (r:255;g:85;b:255),
  61. (r:255;g:255;b:255),
  62. (r:0;g:0;b:0),
  63. (r:20;g:20;b:20),
  64. (r:32;g:32;b:32),
  65. (r:44;g:44;b:44),
  66. (r:56;g:56;b:56),
  67. (r:68;g:68;b:68),
  68. (r:80;g:80;b:80),
  69. (r:97;g:97;b:97),
  70. (r:113;g:113;b:113),
  71. (r:129;g:129;b:129),
  72. (r:145;g:145;b:145),
  73. (r:161;g:161;b:161),
  74. (r:182;g:182;b:182),
  75. (r:202;g:202;b:202),
  76. (r:226;g:226;b:226),
  77. (r:255;g:255;b:255),
  78. (r:0;g:255;b:0),
  79. (r:64;g:255;b:0),
  80. (r:125;g:255;b:0),
  81. (r:190;g:255;b:0),
  82. (r:255;g:255;b:0),
  83. (r:255;g:190;b:0),
  84. (r:255;g:125;b:0),
  85. (r:255;g:64;b:0),
  86. (r:255;g:0;b:0),
  87. (r:255;g:0;b:64),
  88. (r:255;g:0;b:125),
  89. (r:255;g:0;b:190),
  90. (r:255;g:0;b:255),
  91. (r:190;g:0;b:255),
  92. (r:125;g:0;b:255),
  93. (r:64;g:0;b:255),
  94. (r:0;g:0;b:255),
  95. (r:0;g:64;b:255),
  96. (r:0;g:125;b:255),
  97. (r:0;g:190;b:255),
  98. (r:0;g:255;b:255),
  99. (r:0;g:255;b:190),
  100. (r:0;g:255;b:125),
  101. (r:0;g:255;b:64),
  102. (r:125;g:255;b:125),
  103. (r:157;g:255;b:125),
  104. (r:190;g:255;b:125),
  105. (r:222;g:255;b:125),
  106. (r:255;g:255;b:125),
  107. (r:255;g:222;b:125),
  108. (r:255;g:190;b:125),
  109. (r:255;g:157;b:125),
  110. (r:255;g:125;b:125),
  111. (r:255;g:125;b:157),
  112. (r:255;g:125;b:190),
  113. (r:255;g:125;b:222),
  114. (r:255;g:125;b:255),
  115. (r:222;g:125;b:255),
  116. (r:190;g:125;b:255),
  117. (r:157;g:125;b:255),
  118. (r:125;g:125;b:255),
  119. (r:125;g:157;b:255),
  120. (r:125;g:190;b:255),
  121. (r:125;g:222;b:255),
  122. (r:125;g:255;b:255),
  123. (r:125;g:255;b:222),
  124. (r:125;g:255;b:190),
  125. (r:125;g:255;b:157),
  126. (r:182;g:255;b:182),
  127. (r:198;g:255;b:182),
  128. (r:218;g:255;b:182),
  129. (r:234;g:255;b:182),
  130. (r:255;g:255;b:182),
  131. (r:255;g:234;b:182),
  132. (r:255;g:218;b:182),
  133. (r:255;g:198;b:182),
  134. (r:255;g:182;b:182),
  135. (r:255;g:182;b:198),
  136. (r:255;g:182;b:218),
  137. (r:255;g:182;b:234),
  138. (r:255;g:182;b:255),
  139. (r:234;g:182;b:255),
  140. (r:218;g:182;b:255),
  141. (r:198;g:182;b:255),
  142. (r:182;g:182;b:255),
  143. (r:182;g:198;b:255),
  144. (r:182;g:218;b:255),
  145. (r:182;g:234;b:255),
  146. (r:182;g:255;b:255),
  147. (r:182;g:255;b:234),
  148. (r:182;g:255;b:218),
  149. (r:182;g:255;b:198),
  150. (r:0;g:113;b:0),
  151. (r:28;g:113;b:0),
  152. (r:56;g:113;b:0),
  153. (r:85;g:113;b:0),
  154. (r:113;g:113;b:0),
  155. (r:113;g:85;b:0),
  156. (r:113;g:56;b:0),
  157. (r:113;g:28;b:0),
  158. (r:113;g:0;b:0),
  159. (r:113;g:0;b:28),
  160. (r:113;g:0;b:56),
  161. (r:113;g:0;b:85),
  162. (r:113;g:0;b:113),
  163. (r:85;g:0;b:113),
  164. (r:56;g:0;b:113),
  165. (r:28;g:0;b:113),
  166. (r:0;g:0;b:113),
  167. (r:0;g:28;b:113),
  168. (r:0;g:56;b:113),
  169. (r:0;g:85;b:113),
  170. (r:0;g:113;b:113),
  171. (r:0;g:113;b:85),
  172. (r:0;g:113;b:56),
  173. (r:0;g:113;b:28),
  174. (r:56;g:113;b:56),
  175. (r:68;g:113;b:56),
  176. (r:85;g:113;b:56),
  177. (r:97;g:113;b:56),
  178. (r:113;g:113;b:56),
  179. (r:113;g:97;b:56),
  180. (r:113;g:85;b:56),
  181. (r:113;g:68;b:56),
  182. (r:113;g:56;b:56),
  183. (r:113;g:56;b:68),
  184. (r:113;g:56;b:85),
  185. (r:113;g:56;b:97),
  186. (r:113;g:56;b:113),
  187. (r:97;g:56;b:113),
  188. (r:85;g:56;b:113),
  189. (r:68;g:56;b:113),
  190. (r:56;g:56;b:113),
  191. (r:56;g:68;b:113),
  192. (r:56;g:85;b:113),
  193. (r:56;g:97;b:113),
  194. (r:56;g:113;b:113),
  195. (r:56;g:113;b:97),
  196. (r:56;g:113;b:85),
  197. (r:56;g:113;b:68),
  198. (r:80;g:113;b:80),
  199. (r:89;g:113;b:80),
  200. (r:97;g:113;b:80),
  201. (r:105;g:113;b:80),
  202. (r:113;g:113;b:80),
  203. (r:113;g:105;b:80),
  204. (r:113;g:97;b:80),
  205. (r:113;g:89;b:80),
  206. (r:113;g:80;b:80),
  207. (r:113;g:80;b:89),
  208. (r:113;g:80;b:97),
  209. (r:113;g:80;b:105),
  210. (r:113;g:80;b:113),
  211. (r:105;g:80;b:113),
  212. (r:97;g:80;b:113),
  213. (r:89;g:80;b:113),
  214. (r:80;g:80;b:113),
  215. (r:80;g:89;b:113),
  216. (r:80;g:97;b:113),
  217. (r:80;g:105;b:113),
  218. (r:80;g:113;b:113),
  219. (r:80;g:113;b:105),
  220. (r:80;g:113;b:97),
  221. (r:80;g:113;b:89),
  222. (r:0;g:64;b:0),
  223. (r:16;g:64;b:0),
  224. (r:32;g:64;b:0),
  225. (r:48;g:64;b:0),
  226. (r:64;g:64;b:0),
  227. (r:64;g:48;b:0),
  228. (r:64;g:32;b:0),
  229. (r:64;g:16;b:0),
  230. (r:64;g:0;b:0),
  231. (r:64;g:0;b:16),
  232. (r:64;g:0;b:32),
  233. (r:64;g:0;b:48),
  234. (r:64;g:0;b:64),
  235. (r:48;g:0;b:64),
  236. (r:32;g:0;b:64),
  237. (r:16;g:0;b:64),
  238. (r:0;g:0;b:64),
  239. (r:0;g:16;b:64),
  240. (r:0;g:32;b:64),
  241. (r:0;g:48;b:64),
  242. (r:0;g:64;b:64),
  243. (r:0;g:64;b:48),
  244. (r:0;g:64;b:32),
  245. (r:0;g:64;b:16),
  246. (r:32;g:64;b:32),
  247. (r:40;g:64;b:32),
  248. (r:48;g:64;b:32),
  249. (r:56;g:64;b:32),
  250. (r:64;g:64;b:32),
  251. (r:64;g:56;b:32),
  252. (r:64;g:48;b:32),
  253. (r:64;g:40;b:32),
  254. (r:64;g:32;b:32),
  255. (r:64;g:32;b:40),
  256. (r:64;g:32;b:48),
  257. (r:64;g:32;b:56),
  258. (r:64;g:32;b:64),
  259. (r:56;g:32;b:64),
  260. (r:48;g:32;b:64),
  261. (r:40;g:32;b:64),
  262. (r:32;g:32;b:64),
  263. (r:32;g:40;b:64),
  264. (r:32;g:48;b:64),
  265. (r:32;g:56;b:64),
  266. (r:32;g:64;b:64),
  267. (r:32;g:64;b:56),
  268. (r:32;g:64;b:48),
  269. (r:32;g:64;b:40),
  270. (r:44;g:64;b:44),
  271. (r:48;g:64;b:44),
  272. (r:52;g:64;b:44),
  273. (r:60;g:64;b:44),
  274. (r:64;g:64;b:44),
  275. (r:64;g:60;b:44),
  276. (r:64;g:52;b:44),
  277. (r:64;g:48;b:44),
  278. (r:64;g:44;b:44),
  279. (r:64;g:44;b:48),
  280. (r:64;g:44;b:52),
  281. (r:64;g:44;b:60),
  282. (r:64;g:44;b:64),
  283. (r:60;g:44;b:64),
  284. (r:52;g:44;b:64),
  285. (r:48;g:44;b:64),
  286. (r:44;g:44;b:64),
  287. (r:44;g:48;b:64),
  288. (r:44;g:52;b:64),
  289. (r:44;g:60;b:64),
  290. (r:44;g:64;b:64),
  291. (r:44;g:64;b:60),
  292. (r:44;g:64;b:52),
  293. (r:44;g:64;b:48),
  294. (r:0;g:0;b:0),
  295. (r:0;g:0;b:0),
  296. (r:0;g:0;b:0),
  297. (r:0;g:0;b:0),
  298. (r:0;g:0;b:0),
  299. (r:0;g:0;b:0),
  300. (r:0;g:0;b:0),
  301. (r:0;g:0;b:0));
  302.  
  303.  
  304. function closest(v:colour):longword;
  305. function dist(cc:colour;pv:colour):single ;
  306. var s:single;
  307. begin
  308. s:= (cc.r-pv.r)*(cc.r-pv.r) +(cc.g-pv.g)*(cc.g-pv.g)+(cc.b-pv.b)*(cc.b-pv.b) ;
  309. exit(s);
  310. end;
  311. var
  312. res:longword;
  313. n:longword;
  314. dt :single =1e20;
  315. distance:single=0;
  316.     begin
  317.     res:=0;
  318.     for n :=0 to 255 do
  319.     begin
  320.         distance:=dist(clr[n],v);
  321.         if (dt > distance) then // catch the smallest
  322.          begin
  323.            dt := distance;res:=clr[n].c;
  324.          end;
  325.     end;
  326.     exit(res)
  327. end;
  328.  
  329. function rgb(r:byte;g:byte;b:byte):longword;
  330. var return:colour;
  331. begin
  332. return.r:=r;return.g:=g;return.b:=b;
  333.  exit(return.c);
  334. end;
  335.  
  336. procedure hidecursor();
  337.  var
  338.     consoleHandle:handle;
  339.      info:CONSOLE_CURSOR_INFO ;
  340.      begin
  341.      consolehandle := GetStdHandle(STD_OUTPUT_HANDLE);
  342.      info.dwSize := 100;
  343.      info.bVisible := FALSE ;
  344.      SetConsoleCursorInfo(consoleHandle, @info);
  345.      End;
  346.  
  347. procedure setupcircles(var a:array of circle) ;
  348. var i:integer;
  349. begin
  350. for i:=1 to length(a) do
  351. begin
  352. a[i].x:=5+random(300);
  353. a[i].y:=50+random(500);
  354. a[i].r:=3+random(10);
  355. a[i].c.c:=rgb(random(255),random(255),random(255));
  356. end;
  357. end;
  358.  
  359. var
  360. p:hwnd;
  361. h:hdc;
  362. circles:array[1..5000] of circle;
  363. i:integer;
  364.  
  365. begin
  366.     p := GetConsoleWindow();
  367.     setwindowpos(p, HWND_TOPMOST, 100, 100, 800, 600, SWP_SHOWWINDOW);
  368.     hidecursor();
  369.     h:=GetDC(p);
  370.     setupcircles(circles);
  371.     SelectObject(h,GetStockObject(DC_BRUSH));
  372.     SelectObject(h,GetStockObject(DC_PEN));
  373.     write('         32 bit');
  374.     writeln('                                           256 colours');
  375.     for i:=1 to length(circles) do circles[i].draw(h);
  376.     for i:=1 to length(circles) do circles[i].draw256(h);
  377. readln;
  378. end.  

I don't suppose it is any good to you, just ignore it, it is a mess around for fun.
I might try it out on a bitmap.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 27, 2020, 10:35:00 pm
Hi Roland.
For a bit of an experiment converting 32 bit colours to 16 bit (256) colours.
I set up the converting array from freebasic.

Hi. Thank you for your code. I cannot try it at once (because I am on Linux) but I keep it.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Seenkao on October 28, 2020, 02:21:23 am
Небольшой вопрос. А почему бы не сделать как в OpenGL?
Вы берёте максимальную составляющую за 1
Из заданного бита (пикселя) цвета выделяете составляющую для 32-х бит и восстанавливаете для 16-ти.

1 = 255 (R, G, B or alpha)
допустим R = 130, (подсчёт примерный)
составляющая 1 / 255 = 0.004 далее 0.004  * 130 = 0,52 (погрешность появляется, но можно делать точнее)
переводим в 16: 1 / 31 = 0.032 находим составляющую 0.52 / 0.032 = 16.25 округляем к ближайшему = 16

Для остальных цветов так же. Не забываем для R и B по 31, для G 63.
Возможно займёт порядочно времени по работе с большим объёмом.

Google translate
A small question. Why not do it like in OpenGL?
You take the maximum component for 1
From a given bit (pixel) of color, select a component for 32 bits and restore for 16 bits.

1 = 255 (R, G, B or alpha)
let's say R = 130, (approximate calculation)
component 1/255 = 0.004 further 0.004 * 130 = 0.52 (the error appears, but you can do it more precisely)
translate into 16: 1/31 = 0.032 find the component 0.52 / 0.032 = 16.25 round to the nearest = 16

For other colors the same. Don't forget 31 for R and B, 63 for G.
It may take a lot of time to work with a large volume.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Roland57 on October 28, 2020, 07:28:15 am
A small question. Why not do it like in OpenGL?

Thank you for your message. If I correctly understand, you would suggest to do the conversion from 32-bit to 16-bit color like this?

Code: Pascal  [Select][+][-]
  1. function Color16(const r, g, b: byte): word;
  2. var
  3.   r1, g1, b1: byte;
  4. begin
  5.   r1 := Round((r / 255) * 31);
  6.   g1 := Round((g / 255) * 63);
  7.   b1 := Round((b / 255) * 31);
  8.   result := (r1 shl 11) or (g1 shl 5) or b1;
  9. end;
  10.  
  11. var
  12.   blue: word;
  13.  
  14. begin
  15.   blue := Color16(0, 0, 255);
  16.   WriteLn(blue);
  17. end.
Title: Re: Repair the colors of a Dos program ported to ptcGraph unit
Post by: Seenkao on October 28, 2020, 10:55:48 am
Проверьте, будет работать или нет.

Google translate:
Check if it will work or not.  :)
TinyPortal © 2005-2018