Recent

Recent Posts

Pages: [1] 2 3 ... 10
1
General / Re: Parameter passing oddities
« Last post by ASerge on Today at 06:59:05 pm »
Quote from: Nitorami on Today at 03:31:11 pm
break the "const" contract; C1 will be changed although declared as const. It works, the compiler does not care, but it gives me doubts. This is not clean.
The "const" contract is valid only within the procedure.
Quote
Well, then let's pass by value instead...
WTF, this is FACTOR 50 slower! Impressive, REP MOVSL hitting hard. Forget it!
...
we could check for identical addresses in the argument...Nice, and less than 10% overhead for checking the assertion...the assertion fails...But I need such calls.
...
What shall I do ? I went back to the original version, ignoring that the const parameters may in fact change, and hoping that the compiler will not stumble across it one day.
Check without assertion:
Code: Pascal  [Select][+][-]
  1. {$APPTYPE CONSOLE}
  2. {$MODE OBJFPC}
  3.  
  4. type
  5.   TComplex = record
  6.     Im, Re: ValReal;
  7.   end;
  8.  
  9. procedure AddNotSafe(constref A, B: TComplex; out C: TComplex);
  10. begin
  11.   begin // Just for an example, in this case, the extra code
  12.     C.Im := 0; // Sloppy code that does not consider the possibility of parameter identity
  13.     C.Re := 0;
  14.   end;
  15.   C.Im := A.Im + B.Im;
  16.   C.Re := A.Re + B.Re;
  17. end;
  18.  
  19. procedure AddSlow(A, B: TComplex; out C: TComplex);
  20. begin
  21.   begin // Just for an example, in this case, the extra code
  22.     C.Im := 0; // In this case safe, becase full copy, but slow
  23.     C.Re := 0;
  24.   end;
  25.   C.Im := A.Im + B.Im;
  26.   C.Re := A.Re + B.Re;
  27. end;
  28.  
  29. procedure AddSafe(constref A, B: TComplex; out C: TComplex);
  30. begin
  31.   begin // Just for an example, in this case, the extra code
  32.     if (@A <> @C) and (@B <> @C) then // Smart code
  33.     begin
  34.       C.Im := 0;
  35.       C.Re := 0;
  36.     end;
  37.   end;
  38.   C.Im := A.Im + B.Im;
  39.   C.Re := A.Re + B.Re;
  40. end;
  41.  
  42. procedure Print(const C: TComplex);
  43. begin
  44.   Writeln('Im: ', C.Im:0:2, ', Re: ', C.Re:0:2);
  45. end;
  46.  
  47. procedure Test;
  48. var
  49.   A: TComplex = (Im:2; Re:2);
  50.   B: TComplex = (Im:1; Re:1);
  51.   C: TComplex;
  52. begin
  53.   Writeln('AddNotSafe:');
  54.   C := A;
  55.   AddNotSafe(C, B, C);
  56.   Print(C);
  57.   Writeln('AddSlow:');
  58.   C := A;
  59.   AddSlow(C, B, C);
  60.   Print(C);
  61.   Writeln('AddSafe:');
  62.   C := A;
  63.   AddSafe(C, B, C);
  64.   Print(C);
  65. end;
  66.  
  67. begin
  68.   Test;
  69.   Readln;
  70. end.
2
Unix / Re: A fairly simple sound solution? [SOLVED]
« Last post by Thaddy on Today at 06:52:55 pm »
@Videolab
your statements are simply not true. Most professional video editing is done under unix OS's.

More in general, we lack a simple sound interface like python has and that is perfectly capable for educational purposes, including synthesizers. It is just that nobody bothers to write that in FPC. But that can be done. Just like the Raspberry Pi community has proven for python, we can do that in FPC. It has simply not been done yet.
But if playng a simple wav is enough? There are better examples on this forum.
3
Suggestions / Re: add new targets to make
« Last post by Key-Real on Today at 06:44:32 pm »
UPS! I had a typo.

now it works, the next step is to create a Makefle.fpc in the ps1 dir
4
Other / [Request] Demo Scene Sub category
« Last post by Gigatron on Today at 06:29:39 pm »
Hi,
Can you add a [Demo Scene] subcategory in Multimedia area , please?
Thanks in advance.

Gigatron
5
General / Re: Parameter passing oddities
« Last post by alpine on Today at 06:16:58 pm »
Quote
But all that would not be necessary if there was a method of passing parameters which works like const but avoids the "constant" assumption. I don't know how other languages handle this. Just feel something is missing in Pascal.
I know only two methods: by-value and by-reference (without involving pointers, of course). AFAIK const parameters is to retain by-value semantics with an additional twist:
Quote
Declaring a parameter as const allows the compiler the possibility to do optimizations it couldn't do otherwise, such as passing by reference while retaining the semantics of passing by value.
   
Passing by-ref are var and constref.
What do you mean by "if there was a method of passing parameters which works like const..."?
6
Suggestions / Re: add new targets to make
« Last post by Key-Real on Today at 06:04:22 pm »
still the same

Code: Pascal  [Select][+][-]
  1. $ make rtl CPU_TARGET=mipsel OS_TARGET=ps1 FPC=/run/media/key-real/E3AF-F107/code/source/compiler/ppcrossmipsel
  2. make -C rtl all
  3. make[1]: Entering directory '/run/media/key-real/E3AF-F107/code/source/rtl'
  4. make[1]: Nothing to be done for 'all'.
  5. make[1]: Leaving directory '/run/media/key-real/E3AF-F107/code/source/rtl'
  6.  


see attachment
7
Operating Systems / Re: Unlocking Files
« Last post by KodeZwerg on Today at 06:03:08 pm »
To be honest, on a windows machine I would use the windows api.
I have not checked what RenameFile() does do but this is how I would do:
Code: Pascal  [Select][+][-]
  1. function MyRenameFile(const OldName, NewName: WideString): Boolean;
  2. var
  3.   OldNameW, NewNameW: PWideChar;
  4. begin
  5.   OldNameW := PWideChar(OldName);
  6.   NewNameW := PWideChar(NewName);
  7.   Result := MoveFileW(OldNameW, NewNameW);
  8. end;
  9.  
  10. begin
  11.   if MyRenameFile('OldFileName.txt', 'NewFileName.txt') then
  12.     WriteLn('File renamed successfully.')
  13.   else
  14.     WriteLn('Failed to rename file.');
  15. end.
Extend that snipped with error handling like the link is suggesting.
My example assume that OldFileName.txt does exists and NewFileName.txt not.
That the destination folder exists and your process got write permission.
8
FPC development / Re: trunk compiler bug for mipsel raised exception internally - Access violation
« Last post by Key-Real on Today at 05:56:32 pm »
Yes, Finally!

the system and the fpintres units have to be precompiled!

I would wish me a reasonable error message from the compiler to avoid all this discussion
9
Graphics / Demo Scene Bitmap Font Scroller
« Last post by Gigatron on Today at 05:56:27 pm »
Hi L&G,

I will try to share a bitmap font scroller using BGRABitmap, you will learn how to scroll text.
Bitmap font from the champs cracktro Amiga;

https://www.youtube.com/watch?v=05C-iyxoqLs

The Result in LP :
https://www.youtube.com/watch?v=puFsvBfmIoA

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   BGRABitmap, BGRABitmapTypes, BGRAVirtualScreen; uplaysound;
  10.  
  11. const
  12.   ascii : Array [0..58] of integer = (26,37,99,99,99,99,99,41,42,43,99,99,44,99,38,99,27,28,29,30,31,32,33,34,35,36,40,99,99,99,99,39,99,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25);
  13.   cop_col:Array[0..245] of String =('#000066','#000055','#000044','#000033','#000022','#000011','#000011','#000022','#000033',
  14.                                             '#000044','#000055','#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc',
  15.                                             '#0000dd','#0000ee','#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff',
  16.                                             '#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff',
  17.                                             '#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff',
  18.                                             '#8888ff','#7777ff','#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff',
  19.                                             '#0000ee','#0000dd','#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066',
  20.                                             '#000055','#000044','#000033','#000022','#000011','#000022','#000033','#000044','#000055',
  21.                                             '#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee',
  22.                                             '#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff',
  23.                                             '#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff',
  24.                                             '#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff',
  25.                                             '#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd',
  26.                                             '#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044',
  27.                                             '#000033','#000022','#000011','#000011','#000022','#000033','#000044','#000055','#000066',
  28.                                             '#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff',
  29.                                             '#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff',
  30.                                             '#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff',
  31.                                             '#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff',
  32.                                             '#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc',
  33.                                             '#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044','#000033',
  34.                                             '#000022','#000011','#000022','#000033','#000044','#000055','#000066','#000077','#000088',
  35.                                             '#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff','#1111ff','#2222ff',
  36.                                             '#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff',
  37.                                             '#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff',
  38.                                             '#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff','#5555ff','#4444ff',
  39.                                             '#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc','#0000bb','#0000aa',
  40.                                             '#000099','#000088','#000077');
  41.  
  42. var
  43.   CharImage: TBGRABitmap;
  44.   ScrollSpeed: integer = 2;
  45.   ScrollCounter: integer = 1;
  46.   CharWidth : integer = 30;
  47.   CharW     : integer = 30;
  48.   CharHeight :  integer = 48;
  49.   CharsPerLine : integer = 240;
  50.   ScrollText : String = '                  ....       GIGATRON THE LEADER PRESENTS BITMAP FONT SCROLLER DEMO CODED WITH LAZARUS PASCAL GREETINGS TO PUMA, JAGUAR, SERVAL, LYNX, CARACAL, PANTHER, OCELOT, CHEETAH, WILD CAT,  ...  FONT FROM THE CHAMPS CRACKTRO AMIGA IN 1988  RELEASE DATE LATE ON (( 22.04.2024 ))     SEE YOU    .....';
  51.   hexColor: string;
  52.   red, green, blue: Byte;
  53.   j,pause,snd_timer  : integer;
  54.  
  55. type
  56.  
  57.   { TForm1 }
  58.  
  59.   TForm1 = class(TForm)
  60.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  61.     playsound1: Tplaysound;
  62.     Timer1: TTimer;
  63.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  64.     procedure FormCreate(Sender: TObject);
  65.     procedure FormDestroy(Sender: TObject);
  66.     procedure Timer1Timer(Sender: TObject);
  67.   private
  68.  
  69.   public
  70.  
  71.   end;
  72.  
  73.  
  74. var
  75.   Form1: TForm1;
  76.  
  77. implementation
  78.  
  79. {$R *.lfm}
  80.  
  81.  
  82. procedure TForm1.FormCreate(Sender: TObject);
  83. begin
  84.  // playsound1.Execute;        // play once when form created !
  85.   CharImage := TBGRABitmap.Create('font2x.png');
  86.   CharImage.SetSize(30,2226);
  87.   j:=0;
  88.   pause := 0;
  89. end;
  90.  
  91. procedure HexToRGB(hex: string; var r, g, b: Byte);
  92. begin
  93.   r := StrToInt('$' + Copy(hex, 2, 2));
  94.   g := StrToInt('$' + Copy(hex, 4, 2));
  95.   b := StrToInt('$' + Copy(hex, 6, 2));
  96. end;
  97.  
  98. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  99. var
  100.    I,   Chr: Integer;
  101.    CharX, CharY: Integer;
  102.    ScrollOffset: Integer;
  103.  
  104. begin
  105.   Bitmap.Fill(BGRAPixelTransparent);
  106.  
  107.   // raster bars cycle colors
  108.   for i := 0 to 20 do
  109.   begin
  110.        hexColor := cop_col[i+j];
  111.        HexToRGB(hexColor, red, green, blue);
  112.        Bitmap.FillRect(0,242+i*2,640,242+i*2-2,RGBToColor(red,green,blue));
  113.  
  114.   end;
  115.  
  116.      inc(pause);
  117.    if (pause>=1) then
  118.    begin
  119.        inc(j);
  120.        pause := 0;
  121.        if(j>=184) then j:=0;
  122.  
  123.     end;
  124.  
  125.   // Bitmap Scrolling  copy bitmap char with correct ascii code ,  x,y,x1,y1 like Amiga blitter
  126.   ScrollOffset :=  ScrollCounter ;
  127.   for I := 0 to 24 do
  128.     begin
  129.        Chr   := Ord(ScrollText[I]);
  130.        CharX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset  ;
  131.        CharY := ((I - 1) div CharsPerLine) * CharHeight  ;
  132.        Bitmap.PutImagePart(CharX , 240+CharY , CharImage, Rect(0, ascii[Chr-32]*CharHeight , CharW, ascii[Chr-32]*CharHeight+CharHeight), dmDrawWithTransparency);
  133.  
  134.   end;
  135.  
  136.   ScrollCounter := ScrollCounter + ScrollSpeed;
  137.  
  138.   if ScrollCounter >= CharWidth then
  139.      begin
  140.             ScrollCounter := ScrollCounter - CharWidth;
  141.             ScrollText := Copy(ScrollText,2, Length(ScrollText) - 1) + ScrollText[1];
  142.      end;
  143.  
  144.  // play sound every xxx sec
  145.  // inc(snd_timer);
  146.  //  if(snd_timer>500) then
  147.  // begin
  148.  //     snd_timer :=0;
  149.  //     playsound1.Execute;
  150.  
  151.  //  end
  152.  
  153. end;
  154.  
  155. procedure TForm1.Timer1Timer(Sender: TObject);
  156. begin
  157.       BGRAVirtualScreen1.RedrawBitmap;
  158.  
  159. end;
  160.  
  161. procedure TForm1.FormDestroy(Sender: TObject);
  162. // libere tout !!
  163. begin
  164.    //playsound1.Free;
  165.    CharImage.Free;
  166.  
  167. end;
  168.  
  169. end.
  170.  
10
Operating Systems / Re: Unlocking Files
« Last post by 440bx on Today at 05:51:27 pm »
@Redenegue,

It would be nice of you to put your code between code tags so it looks like this:
Code: Pascal  [Select][+][-]
  1. program ProgramName;

To see how I did that, click the "quote" (to quote the message) and you'll see the necessary tags between [ and ].

HTH.
Pages: [1] 2 3 ... 10

TinyPortal © 2005-2018