Recent

Recent Posts

Pages: [1] 2 3 ... 10
1
Audio and Video / Adlib Player
« Last post by Gigatron on Today at 01:57:12 am »
Hi,
Back to C++, C and then to FPC for making something nice to listening old OPL fm modules .. used on PCs,
will give some extra info later ;
What is Adlib/Adplug   ? : https://adplug.github.io/
Supported file format not tested yet ;

AdLib / OPL2 sound chip Format file support .HSC, .SNG, .IMF/.WLF/.ADLIB, .A2M, .AMD, .BAM, .CMF, .D00, .DFM, .HSP, .KSM, .MAD, .LAA, .MKJ, .CFF, .DMO, .S3M, .DTM, .MTK, .RAD, .RAW, .SAT, .XAD, .LDS, .M, .ROL, .XSM, .DRO, .MSC, and .RIX.

Tested 2 extension .HSC and XSM ;

I used Visual studio 2019 , Hippoplayer Adplug and replay sources to extract some functions in adlib.dll. on X64 platforms ;
Just simple functions to play FM OPL modules are exported to .dll the replay routine is a bit faster than original will be fixed asap;

The library and 2 modules are attached in .zip file;
The modules must be in project drawer .dll too ;



** I am working with UADE ... a really nightmare ... done 40 % !!! hope it's will ready before 2025 !

Have Fun

Gigatron


The main Unit :

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,adlib,
  9.   mmsystem, windows,DynLibs;
  10.  
  11. const
  12.   Channels = 2;
  13.   BitsPerSample = 16;
  14.   SampleRate = 44100; // Nombre d'échantillons par seconde
  15.   BufSize = 8192;    // Taille du tampon audio x 2
  16.   BufferCount = 2;
  17.  
  18. type
  19.   { TForm1 }
  20.  
  21.   TForm1 = class(TForm)
  22.     Timer1: TTimer;
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure FormShow(Sender: TObject);
  25.     procedure Timer1Timer(Sender: TObject);
  26.     procedure Process_OPL(BufferIndex: Integer);
  27.   private
  28.     buffers: array[0..BufferCount-1] of array[0..BufSize-1] of SmallInt;
  29.     waveHeaders: array[0..BufferCount-1] of TWaveHdr;
  30.     currentBuffer: Integer;
  31.   public
  32.   end;
  33.  
  34. var
  35.   Form1: TForm1;
  36.   waveOut: HWAVEOUT;
  37.   ok_flag: Boolean = false;
  38.   libHandle: TLibHandle;
  39.   error: DWORD;
  40.   core: boolean = false;
  41.   p_tick : integer = 0;
  42.   n_sample  : SmallInt;
  43.   opl : Pointer; // file pointer !!
  44.  
  45. implementation
  46.  
  47. {$R *.lfm}
  48.  
  49. procedure HandleError(const Str: PAnsiChar);
  50. begin
  51.   if Str <> nil then
  52.   begin
  53.     ShowMessage('Error: ' + Str);
  54.     Halt(1);
  55.   end;
  56. end;
  57.  
  58. function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;
  59. begin
  60.   if uMsg = WOM_DONE then
  61.   begin
  62.     Form1.Process_OPL(Form1.currentBuffer);
  63.     waveOutWrite(waveOut, @Form1.waveHeaders[Form1.currentBuffer], SizeOf(TWaveHdr));
  64.     Form1.currentBuffer := (Form1.currentBuffer + 1) mod BufferCount;
  65.   end;
  66.   Result := 0;
  67. end;
  68.  
  69. procedure InitAudio;
  70. var
  71.   wFormat: TWaveFormatEx;
  72.   i: Integer;
  73. begin
  74.   SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_LOWEST);
  75.  
  76.   with wFormat do
  77.   begin
  78.     wFormatTag := WAVE_FORMAT_PCM;
  79.     nChannels := Channels;
  80.     nSamplesPerSec := SampleRate;
  81.     wBitsPerSample := BitsPerSample;
  82.     nBlockAlign := (wBitsPerSample * nChannels) div 8;
  83.     nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
  84.     cbSize := 0;
  85.   end;
  86.  
  87.   if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
  88.     raise Exception.Create('Erreur lors de l''ouverture du périphérique audio');
  89.  
  90.   // Préparation des tampons
  91.   for i := 0 to BufferCount - 1 do
  92.   begin
  93.     ZeroMemory(@Form1.waveHeaders[i], SizeOf(TWaveHdr));
  94.     with Form1.waveHeaders[i] do
  95.     begin
  96.       lpData := @Form1.buffers[i][0];
  97.       dwBufferLength := BufSize  ;
  98.       dwFlags := 0;
  99.  
  100.     end;
  101.     waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
  102.   end;
  103.     Form1.currentBuffer := 0;
  104.     for i := 0 to BufferCount - 1 do
  105.      begin
  106.       waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
  107.     end;
  108. end;
  109.  
  110. procedure TForm1.FormCreate(Sender: TObject);
  111. var
  112.   FileName: string;
  113.  begin
  114.  
  115.   libHandle := LoadLibrary('adlib.dll');
  116.   if libHandle = 0 then
  117.   begin
  118.     error := GetLastError;
  119.     ShowMessage('Erreur chargement de la DLL: ' + IntToStr(error));
  120.   end;
  121.  
  122.   core := CreateCore(true,2); // create OPL   20 channels max !! Type_Opl2
  123.  
  124.  // FileName := 'neo_intro.xms'; // the famous Neo-Intro when PC had FM OPL soundchip and AMIGA PAULA !!! :)
  125.  // Or this module file
  126.  FileName := 'ezerious.hsc';  // Hannes Seifert / Input
  127.  
  128.  
  129.   ShowMessage('init OK ' );
  130.   Set_OPLchip(0);
  131.   Init_Opl;
  132.   opl :=  Load_Mod(Pchar(filename) );
  133.   ShowMessage('file Ok ' );
  134.   ShowMessage('All Ok ' );
  135.  
  136.   end;
  137.  
  138. procedure TForm1.FormShow(Sender: TObject);
  139. begin
  140.      InitAudio;
  141.      ok_flag := true;
  142.  
  143. end;
  144.  
  145. procedure TForm1.Process_OPL(BufferIndex: Integer);
  146. var
  147.  n: SmallInt;
  148. begin
  149.  
  150.        n := 2048;
  151.        Write_pcm(@buffers[BufferIndex][0], n   );
  152.  
  153.          if  Player_Update then
  154.          begin
  155.            inc(p_tick,2); // future
  156.          end;
  157. end;
  158.  
  159. procedure TForm1.Timer1Timer(Sender: TObject);
  160. begin
  161.  
  162. end;
  163.  
  164. end.
  165.  

Adlib Unit;

Code: Pascal  [Select][+][-]
  1. unit adlib;
  2.  
  3.  
  4. {$mode objfpc}{$H+}
  5.  
  6. interface
  7.  
  8. uses
  9.     windows;
  10.  
  11. const
  12.  
  13.    ADLIBDLL = 'adlib.dll';
  14.  
  15.  
  16. function CreateCore(isStereo: Boolean;core : integer): Boolean; cdecl; external ADLIBDLL;
  17. procedure Init_Opl; cdecl; external ADLIBDLL;
  18. procedure Write_Pcm(buf: Pointer; samples: SmallInt); cdecl; external ADLIBDLL;
  19. function Load_Mod(filename : Pchar  ): Pointer;  cdecl; external ADLIBDLL;
  20.  
  21. procedure Set_OPLchip(chip: integer); cdecl; external ADLIBDLL;
  22. function Player_Update: Boolean; cdecl; external ADLIBDLL;
  23.  
  24.  
  25. implementation
  26.  
  27. end.
2
General / Re: Bug in string concatenation?
« Last post by Avinash on Today at 01:51:00 am »
Ok, thanks to tetrastes I understood how it all works, now I'm ready to reformulate why it's a bug.

Let's again look at this expression from the point of view of all these codepages:
Code: Pascal  [Select][+][-]
  1. S := UTF8Encode(#255) + #0#0#0#0;
The documentation states that UTF8Encode returns RawByteString, in other words AnsiString(CP_NONE). And, if I understand it correctly, when concatenated with #0#0#0#0 it should not be converted to anything like a system CP, and the result should be the same as with ShortString() typecast:
Code: Pascal  [Select][+][-]
  1. S := ShortString(UTF8Encode(#255)) + #0#0#0#0;

But here, instead of AnsiString(CP_NONE), we get AnsiString(CP_UTF8). It seems that the RawByteString type simply doesn't work properly.

Quote from: tetrastes on December 11, 2024, 10:34:58 pm
Use {$codepage cp1251}

Looks like a workaround. It's beyond my understanding why String <=> WideString conversion happens in some situations, but not in others:

Code: Pascal  [Select][+][-]
  1. var
  2.   S: ShortString;
  3.   U: UnicodeString;
  4. begin
  5.  
  6.   S := #$FF;
  7.  
  8.   U := S;                               // there is exist type conversion
  9.   WriteLn(  HexStr(Ord(U[1]), 4)  );    // 044F
  10.  
  11.   S := U;                               // there is exist type conversion
  12.   WriteLn(  HexStr(Ord(S[1]), 4)  );    // FF
  13.  
  14.  
  15.   S := UnicodeString(#$044F);           // there is exist type conversion
  16.   WriteLn(  HexStr(Ord(S[1]), 4)  );    // FF
  17.  
  18.   U := ShortString(#$FF);               // there is NO type conversion
  19.   WriteLn(  HexStr(Ord(U[1]), 4)  );    // FF
  20.  
  21. end.

In summary, these things should work much more intuitively than they actually do.
3
Linux / Re: Is it possible to do git pull?
« Last post by Warfley on Today at 12:38:51 am »
You can easily update any lazarus installation using git. Even lazarus installations you installed, e.g. through an installer (also on windows)

If your lazarus directory is not yet a git directory, first initialize git (skip if it's already a git repository):
Code: Bash  [Select][+][-]
  1. git init
  2. git remote add origin https://gitlab.com/freepascal.org/lazarus/lazarus.git
Now you can fetch the all the new branches and versions:
Code: Bash  [Select][+][-]
  1. git fetch --all
If you want to change from a stable version to another stable version, you can switch the branch. E.g. if you want to update form the current version (e.g. 3.6) to 4.0rc1:
Code: Bash  [Select][+][-]
  1. git reset --hard tags/lazarus_4_0_RC_1
  2. git checkout tags/lazarus_4_0_RC_1
If instead you are already on main/trunk but just want to update to the newest commit just do:
Code: Bash  [Select][+][-]
  1. git reset --hard origin/main

Now your directory is on the desired version you can rebuild:
Code: Bash  [Select][+][-]
  1. make clean
  2. make lazbuild PP=$(realpath ../fpc/bin/fpc) # change to fpc.sh for fpcup installation
  3. ./lazbuild --build-ide=
Note that you must choose the correct path for the make lazbuild. If you use the system fpc you don't need to add any PP=..., if you have a custom fpc installation choose that one. FPCUp usually installs fpc as fpc.sh into the parent folders fpc/bin

This is actually how I update pretty much all of my lazarus installations, including on windows where I installed them with the windows installer.
4
General / MQTT devices for Home Assistant
« Last post by nicolap on Today at 12:37:19 am »
Hi,
I just published a small library that I use with Raspberry PI (but works also in Windows) for building devices that interact with Home Assistant using MQTT protocol.
One of the interesting thing is the support for auto configuration: no need to "play" with YAML!
For now it supports binary sensor, button, cover, device trigger, fan, light, lock, sensor, switch, text, update and valve.

https://github.com/NicolaP8/mqtt-devices-for-home-assistant

Best regards
     Nicola


Credits to the very good MQTT Client Component https://github.com/prof7bit/fpc-mqtt-client
5
Other / Re: Interesting article about AI
« Last post by Joanna from IRC on Today at 12:37:08 am »
Quote
In order for you to have some idea of why I am so staunchly against OOP you need to compare the results obtained with both paradigms.  Since you advocate for OOP then you should be the one to have the opportunity to produce the best that can be done with OOP.

Lainz has a good point about this stuff suspiciously looking (and possibly being) off topic but the point that is not off topic is that when you criticize something then you must provide some reasonably good supporting evidence and you definitely could improve that area of your argument.
440bx Do you think I care if people use oop? Seriously? I am not going to spend my spare time reworking your code into oop unless I was going to be using and improving your code.

The fact that you couldn’t demonstrate the superiority of non oop code for the simple example of oop code I presented to does not impress me. I was hoping you would be willing to show me how non oop code is better.

Bogen85 you know next to nothing about what I do or if I have rewritten other people’s code.{I have!} Just because I don’t share code publicly doesn’t mean that I do nothing.

You claim to be an expert in everything related to programming yet refused to give me an explanation in layman’s terms about something I asked you about. Instead you told me to “go read some books”  sorry but unquestioning rote memorization isn’t my thing. If someone is unable to answer questions about the ideas that they are advocating I rightfully start to question the validity of those ideas.

AI is much like bogen85’s dogmatic unwavering faith in books. We are just supposed to believe that it magically provides correct answers to everything.
Personally I’ve never used it but I doubt that it discloses it’s sources when giving answers does it? If it did nobody would want it. It just gathers up a lot of data including the intellectual property of people who never consented for their creations to be used by third parties to profit from. I also doubt that AI provides you with the names of the authors of the code responsible for the answers being provided. There is no attribution whatsoever is there?

You are not allowed to know who the developers of AI are nor their sources. Questioning the Anonymous developers is not allowed. You’re just supposed to trust and believe like a religious faith.

As far as I’m concerned, the information provided by AI is about as reliable as anonymous information scribbled  upon a bathroom wall.
6
General / Re: Draw Transparent Fill Rect Over UI
« Last post by lainz on Today at 12:16:54 am »
Great idea.

You need to use client to screen to convert from local pixels to screen pixels.
7
General / Re: I have created dll in golang want to use inside lazarus freepascal
« Last post by Packs on December 11, 2024, 11:14:14 pm »
Application is written in golang.

And we are creating report in Lazarus.

So in this part of the application there is formula.

So we have used same golang formula
8
General / Re: Draw Transparent Fill Rect Over UI
« Last post by LBox on December 11, 2024, 10:41:23 pm »
In general, I found one non-trivial solution for this trivial task  :D
Considering that I need this transparent rectangle as a temporary marker to indicate the docking area of ​​the panel over which the mouse will be located,
we can simply create another transparent form without a frame and dynamically place it above the panel under the mouse.  ::)
I have not tried it in practice yet, but the rough test says that this is quite possible.  :)

Code: Pascal  [Select][+][-]
  1. TranspForm.Left:= ; // Depends Under Mouse Panel Local Left Value To Screen And The Docking Zone
  2. TranspForm.Top:= ; // Depends Under Mouse Panel Local Top Value To Screen And The Docking Zone
  3. TranspForm.Height:= ; // Depends Under Mouse Panel Height And The Docking Zone
  4. TranspForm.Width:= ; // Depends Under Mouse Panel Width And The Docking Zone
  5. TranspForm.AlphaBlendValue:= 160;
  6. TranspForm.BorderStyle:= bsNone;  
9
TAChart / Re: Crosshair error when changing series
« Last post by wp on December 11, 2024, 10:39:23 pm »
Quote from: Marq01 on December 11, 2024, 07:47:59 pm
I had to add one more change in my original program to the TATools unit:

Code: Pascal  [Select][+][-]
  1. procedure TDataPointDrawTool.DoHide;
  2. begin
  3.   if Assigned(FChart) then
  4.   begin
  5.     case EffectiveDrawingMode of
  6.       tdmXor: begin
  7.         FChart.Drawer.SetXor(true);
  8.         DoDraw;
  9.         FChart.Drawer.SetXor(false);
  10.       end;
  11.       tdmNormal:
  12.         FChart.StyleChanged(Self);
  13.     end;
  14.   end;
  15. end;
What is the scenario why you want to change this? The original code in TAChart looks quite reasonable (except maybe for the unchecked call to FChart.StyleChanged).
10
General / Re: Draw Transparent Fill Rect Over UI
« Last post by lainz on December 11, 2024, 10:37:52 pm »
Basically a panel is a window object with his own canvas and with keyboard support. For that is opaque.

A graphic control has no canvas and draws in the parent canvas. It doesn't have keyboard support.
Pages: [1] 2 3 ... 10

TinyPortal © 2005-2018