// some functions for work with GP2X registers 
// Code partly taken from gp2x.com (authors paeryn, squide)

unit uGP2X;

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}

{$IFNDEF GP2X}
This unit is only for low level access to gp2x.
{$ENDIF}

interface

{TODOS:
  - Timer support
  - GetTicks (Register $0A00) like SDL_GetTicks
  - Sound output
  
  - Memory functions 
    http://wiki.gp2x.org/wiki/Using_the_upper_32MB_of_memory
}

uses Unix,
     BaseUnix,
     SysUtils,
     Math,
     
     uFB;
     
const
  // some gp2x memory addresses
  UNUSED_MEMORY         = $02000000;
  PHYSICAL_NONCACHED    = $03000000;                       // Base address of 48 MB
  PHYSICAL_VIDEODECODING= PHYSICAL_NONCACHED + $00000000;  // Video decoding firmware
  PHYSICAL_SCREEN0      = PHYSICAL_NONCACHED + $00101000;  // first frame buffer
  PHYSICAL_SCREEN1      = PHYSICAL_NONCACHED + $00381000;  // second frame buffer
  PHYSICAL_SOUNDBUFFER  = PHYSICAL_NONCACHED + $00600000;  // Sound buffer 

  // query button state
  gp2x_A           =  1;
  gp2x_B           =  2;
  gp2x_Y           =  3;
  gp2x_X           =  4;
          
  gp2x_Select      =  5;
  gp2x_Start       =  6;
             
  gp2x_VolMinus    =  7;
  gp2x_VolPlus     =  8;
                  
  gp2x_LButton     =  9;
  gp2x_RButton     = 10;
                      
  gp2x_JoyLeft     = 20;
  gp2x_JoyUp       = 21;
  gp2x_JoyRight    = 22;
  gp2x_JoyDown     = 23;
  gp2x_Center      = 24;

function  gp2x_InitMem(aBaseAddr : Cardinal = UNUSED_MEMORY) : boolean;
procedure gp2x_DeinitMem;
function  gp2x_Initialized() : Boolean;

function  mmsp2_addr(aAddr : Pointer) : Pointer;

// memory manager function for upper memory, which not used by linux
function  gp2x_MemHandle() : Integer;

function  gp2x_AllocMem(aSize : Integer) : Pointer;
function  gp2x_FreeMem(aPtr : Pointer) : Boolean;
function  gp2x_Virt2Phys(aPtr : Pointer) : Cardinal;
procedure gp2x_PrintMemoryMap();

procedure gp2x_setFreq(aFreq : Word); // set clock and divide
//function  gp2x_getClock: word;
procedure gp2x_setClock(aFreq: Word);

procedure gp2x_SleepMode;
procedure gp2x_Wakeup(NewSpeed: longint);

function  gp2x_getBattery : Word;
procedure gp2x_LedBattOn;
procedure gp2x_LedBattOff;
procedure gp2x_LedBattFlip;

function  gp2x_JoystickValue() : Word;
function  gp2x_ButtonValue() : Word;
function  gp2x_VolumeValue() : Word;

function  gp2x_JoystickPressed(const aButton : Integer; aSmallRange : Boolean) : Boolean;
function  gp2x_ButtonPressed(const aButton : Integer) : Boolean;
function  gp2x_VolumePressed(const aButton : Integer) : Boolean;

// -----------------------------------------------------------------------
// gp2x video functions
// -----------------------------------------------------------------------
type
   TLongArray      = array [0..0] of longint;
   pLongArray      = ^TLongArray;
   TWordArray      = array [0..0] of word;
   pWordArray      = ^TWordArray;

   PVideoBuffer    = ^TVideoBuffer;
   TVideoBuffer    = record
     Active          : Boolean;
     Handle          : Integer;
     Screen	         : PWordArray;
     ColorDepth      : Integer;
     LineWidth       : Integer;
     PhysAddr        : Cardinal;
     Len             : Cardinal;
   end;

function  gp2x_OpenFrameBuffer1(aColorDepth : Integer) : PVideoBuffer;
function  gp2x_OpenFrameBuffer2(aColorDepth : Integer) : PVideoBuffer;
 
function  gp2x_OpenVideo(aWidth, aHeight : Integer; aColorDepth : Integer) : Boolean;
function  gp2x_CloseVideo() : Boolean;

type
  PGP2XScreen      = ^TGP2XScreen;
  TGP2XScreen      = array[0..239, 0..319] of Word;

function  gp2x_ScreenBuffer : PGP2XScreen;
function  gp2x_PhysScreenAddr : Cardinal;

// -----------------------------------------------------------------------
// color conversion helper functions
// -----------------------------------------------------------------------

function  gp2x_RGB16(aRed, aGreen, aBlue : Integer) : Word;

function  gp2x_R16_Red(aRGB16 : Word) : Byte;
function  gp2x_R16_Green(aRGB16 : Word) : Byte;
function  gp2x_R16_Blue(aRGB16 : Word) : Byte;

function  gp2x_RGB32(aRGB16 : Word) : Cardinal;

// -----------------------------------------------------------------------
// screen functions
// -----------------------------------------------------------------------

procedure gp2x_FlipScreen(aScreen : Integer = -1);
procedure gp2x_FlipScreenWait(aWaitForSync : Boolean);
procedure gp2x_WaitVSync(aWaitForASync : Boolean = True);
procedure gp2x_WaitVASync();

// -----------------------------------------------------------------------
// function without blitter support
// -----------------------------------------------------------------------
procedure gp2x_ClearScreen16(aRed, aGreen, aBlue : Integer; aScreen : Integer = -1); overload;
procedure gp2x_Hline(aX1, aX2, aY : Integer; aRed, aGreen, aBlue : Integer); overload;

// -----------------------------------------------------------------------
// function with blitter support
// -----------------------------------------------------------------------
procedure gp2x_ClearScreen(aRed, aGreen, aBlue : Integer; aScreen : Integer = - 1);

procedure gp2x_FillRect(aX, aY, aW, aH : Integer; aColor : Word); overload;
procedure gp2x_FillRect(aX, aY, aW, aH : Integer; aRed, aGreen, aBlue : Byte); overload;

procedure gp2x_DummyBlit();

function  gp2x_Blit16(aSrcPtr     : Pointer;       // Physical source address to blit from
                      aXSrc       : Integer;       // X - Position to blit from
                      aYSrc       : Integer;       // Y - Position to blit from
                      aWidth      : Integer;
                      aHeight     : Integer;
                      aPitch      : Integer;       // width of image in bytes(!) not pixel
                      aDstPtr     : Pointer;       // Physical dest adresse where to blit, 
                                                   // coud be nil
                      aXDest      : Integer;       // X - Position where to blit 
                      aYDest      : Integer;       // Y - Poistion where to blit
                      aTransColor : Boolean;       // Has Transparent color (TRUE)
                      aRed        : Byte;          // 8Bit Value 
                      aGreen      : Byte;          // 8Bit Value 
                      aBlue       : Byte;          // 8Bit Value 
                      aAlpha      : Byte;          // not used at this time
                      aDummyBlit  : Boolean = True // GP2X issue, blit 8 bytes to clear 
                                                   // bitter cache
                      ) : Boolean;

// -----------------------------------------------------------------------
// simple debug textout (slow)
// -----------------------------------------------------------------------
procedure gp2x_TextOut(aX, aY : Integer; const aMessage : String; aColor : Word);

// -----------------------------------------------------------------------
// gp2x audio functions
// -----------------------------------------------------------------------
function  gp2x_OpenAudio() : Boolean;
procedure gp2x_CloseAudio();
procedure gp2x_SetVolume(aVolume : Word);

implementation

{$I sysfixed.inc}

const
  DSP_SPEED                  = $C0045002;   // ioctl codes
  DSP_SETFMT                 = $C0045005;
  DSP_STEREO                 = $C0045003;
  DSP_SETFRAGMENT            = $C004500A;

  SOUND_MIXER_WRITE_VOLUME   = $C0044D00;
  SOUND_MIXER_WRITE_PCM      = $c0044d04;
  SOUND_MIXER_WRITE_LINE     = $c0044d06;
  SOUND_MIXER_WRITE_MIC      = $c0044d07;
  SOUND_MIXER_WRITE_RECSRC   = $c0044dff;
  SOUND_MIXER_LINE           = 7;
  SOUND_MASK_LINE            = 64;
                            
const
  // http://wiki.gp2x.org/wiki/GPIO_Programming_Example
  GP2X_940_CTRL              = $0904;

  GPIOAOUT                   = $1060;
  GPIOBOUT                   = $1062;
  GPIOCOUT                   = $1064;
  GPIODOUT                   = $1066;
  GPIOEOUT                   = $1068;
  GPIOFOUT                   = $106A;
  GPIOGOUT                   = $106C;
  GPIOHOUT                   = $106E;
  GPIOIOUT                   = $1070;
  GPIOJOUT                   = $1072;
  GPIOKOUT                   = $1074;
  GPIOLOUT                   = $1076;
  GPIOMOUT                   = $1078;
  GPIONOUT                   = $107A;
  GPIOOOUT                   = $107C;

  GPIOAPINLVL                = $1180;
  GPIOBPINLVL                = $1182; // GP2x_REG_SCREEN_SYNC
  GPIOCPINLVL                = $1184; // GP2x_REG_BUTTONS_1
  GPIODPINLVL                = $1186; // GP2x_REG_BUTTONS_2
  GPIOEPINLVL                = $1188;
  GPIOFPINLVL                = $118A;
  GPIOGPINLVL                = $118C;
  GPIOHPINLVL                = $118E;
  GPIOIPINLVL                = $1190;
  GPIOJPINLVL                = $1192;
  GPIOKPINLVL                = $1194;
  GPIOLPINLVL                = $1196;
  GPIOMPINLVL                = $1198; // GP2x_REG_JOYSTICK
  GPIONPINLVL                = $119A;
  GPIOOPINLVL                = $119C;

  GP2X_BIT_DEPTH             = $28DA;
  GP2X_LINE_WIDTH            = $290C;
  GP2X_IMAGE_ADDRESS_ODD     = $290E; // MLC_STL_OADR
  GP2X_IMAGE_ADDRESS_EVEN    = $2912; // MLC_STL_EADR
  GP2X_940_INTERRUPT_1       = $3B40;
  GP2X_940_INTERRUPT_2       = $3B42;
  GP2X_940_MEMORY_BASE       = $3B48;
  
  // Blitter Register/Values
  MESGDSTCTRL                = $0000;
  MESGDSTADDR                = $0004;
  MESGSRCCTRL                = $000C;
  MESGPATCTRL                = $0020;
  MESGSIZE                   = $002C;
  MESGCTRL                   = $0030;
  MESGSTATUS                 = $0034;
  
  MESG_BSTBPP                = $60;
  MESG_DSTBPP_16             = (1 << 5);
  MESG_DSTENB                = (1 << 6);
  MESG_INVIDEO               = (1 << 8);
  MESG_HEIGHT                = 16;
  MESG_XDIR_POS              = (1 << 8);
  MESG_YDIR_POS              = (1 << 9);
  MESG_FFCLR                 = (1 << 10);
  MESG_BUSY                  = (1 << 0);


  cPhysBaseAddr              = $02000000;
  cMinMemBlock               = $0400;
  cFixedMemSize              = 16 * 1024 * 1024 - 1; // 16MB upper memory

// -----------------------------------------------------------------------
// Memory manager for upper memory of GP2X
// -----------------------------------------------------------------------
type
  TGP2XMemManager  = class(TObject)
  protected
    fVirtBaseAddr    : Pointer;
    fAllocBlocks     : array[0..(cFixedMemSize div cMinMemBlock) - 1] of Pointer;
  public
    constructor Create();
    destructor Destroy; override;

    procedure Init(aMemHandle : Integer);
    procedure PrintMemoryMap();

    function  AllocMem(const aSize : Integer) : Pointer;
    function  FreeMem(aPtr : Pointer) : Boolean;

    function  Virt2Phys(aPtr : Pointer) : Cardinal;
  end;

constructor TGP2XMemManager.Create();
var
  iLoop            : Integer;
begin
  inherited Create;

  fVirtBaseAddr := nil;
  for iLoop := 0 to Pred(Length(fAllocBlocks)) do begin
    fAllocBlocks[iLoop] := 0;
  end;
end;

destructor TGP2XMemManager.Destroy;
var
 pTmp              : Pointer;
begin
  if Assigned(fVirtBaseAddr) then begin
    pTmp          := fVirtBaseAddr;
    fVirtBaseAddr := nil;
    fpmunmap(pTmp, cFixedMemSize);
  end;

  inherited Destroy;
end;

procedure TGP2XMemManager.Init(aMemHandle : Integer);
begin
  // Create mapped memory to physical memory
  fVirtBaseAddr := fpmmap(0, cFixedMemSize, PROT_READ or PROT_WRITE, MAP_SHARED, aMemHandle, $02000000);
  if (CARDINAL(fVirtBaseAddr) = CARDINAL(-1)) then begin
    raise Exception.CreateFmt('Memory manager coudn''t initialized, error no: %d', [fpGetErrNo()]);
  end;
end;

procedure TGP2XMemManager.PrintMemoryMap();

  procedure WriteInfo(aStart, aSize : Integer; aUsed : Boolean);
  begin
    if aUsed then begin
      WriteLn('  (u)', IntToHex(CARDINAL(fVirtBaseAddr) + (aStart * cMinMemBlock), 8), ' - ' + IntToHex(aSize, 8));
    end else begin
      WriteLn('  (f)', IntToHex(CARDINAL(fVirtBaseAddr) + (aStart * cMinMemBlock), 8), ' - ' + IntToHex(aSize, 8));
    end;
  end;

var
  iLoop            : Integer;
  iSize            : Integer;
  iStart           : Integer;
begin
  WriteLn('');
  WriteLn('Memory map');
  iSize  := cMinMemBlock;
  iStart := 0;
  for iLoop := 1 to Pred(Length(fAllocBlocks)) do begin
    if (fAllocBlocks[iLoop - 1] <> fAllocBlocks[iLoop]) then begin
      WriteInfo(iStart, iSize, Assigned(fAllocBlocks[iStart]));

      iSize  := 0;
      iStart := iLoop;
    end;
    iSize := iSize + cMinMemBlock;
  end;
  WriteInfo(iStart, iSize, Assigned(fAllocBlocks[iStart]));
  WriteLn();
end;

function TGP2XMemManager.AllocMem(const aSize : Integer) : Pointer;
var
  iLoop            : Integer;
  iMark            : Integer;
  iStart           : Integer;
  iSize            : Integer;
begin
  Result := nil;
  if not Assigned(fVirtBaseAddr) then begin
    raise Exception.Create('The gp2x memory manager is not initialzed');
  end;

  iStart := -1;
  iSize  := 0;
  for iLoop := 0 to Pred(Length(fAllocBlocks)) do begin
    if not Assigned(fAllocBlocks[iLoop]) then begin
      // found empty memory block

      if (iStart < 0) then begin
        // this is the first empty block
        iStart := iLoop;
      end;

      iSize := iSize + cMinMemBlock;
      if (iSize >= aSize) then begin
        // we enough continues memory
        Result := POINTER((iStart * cMinMemBlock) + CARDINAL(fVirtBaseAddr));
        for iMark := iStart to iLoop do begin
          fAllocBlocks[iMark] := Result;
        end;
        FillByte(Result^, aSize, 0);
        Exit;
      end;
    end else begin
      // not enough continues memory found, reset start index
      iStart := -1;
      iSize  := 0;
    end;
  end;

  raise Exception.Create('Out of upper memory');
end;

function TGP2XMemManager.FreeMem(aPtr : Pointer) : Boolean;
var
  iLoop            : Integer;
  bFound           : Boolean;
begin
  if not Assigned(fVirtBaseAddr) then begin
    raise Exception.Create('The gp2x memory manager is not initialzed');
  end;

  bFound := False;
  for iLoop := 0 to Pred(Length(fAllocBlocks)) do begin
    if (fAllocBlocks[iLoop] = aPtr) then begin
      fAllocBlocks[iLoop] := nil;
      bFound              := True;
    end;
  end;

  Result := bFound;
  if not bFound then begin
    raise Exception.Create('pointer not managed by gp2x memory manager');
  end;
end;

function TGP2XMemManager.Virt2Phys(aPtr : Pointer) : Cardinal;
begin
  if not Assigned(fVirtBaseAddr) then begin
    raise Exception.Create('The gp2x memory manager is not initialzed');
  end;

  Result := CARDINAL((CARDINAL(aPtr) - CARDINAL(fVirtBaseAddr)) + cPhysBaseAddr);
end;

// -----------------------------------------------------------------------
// local variables
// -----------------------------------------------------------------------
var
  gp2xMemManager   : TGP2XMemManager;
  InitCounter      : Integer;
  mem32            : pLongArray;
  mem16            : pWordArray;
  blit32           : pLongArray;
  memdev           : Integer;
  VirtMappedOffset : Cardinal;

  // global video data
  VideoDone        : Boolean;
  VB1              : TVideoBuffer;
  VB2              : TVideoBuffer;

  // global audio data
  AudioDone        : Boolean;
  DSPHandle        : Integer;

// -----------------------------------------------------------------------
// GP2X Blitter helper functions
// -----------------------------------------------------------------------

function mmsp2_addr(aAddr : Pointer) : Pointer;
var
  BaseAddr         : Cardinal;
begin
  if VB1.Active then begin
    BaseAddr := VB2.PhysAddr;
  end else begin
    BaseAddr := VB1.PhysAddr;
  end;
  
  Result := POINTER(aAddr - BaseAddr);
end;

function gp2x_BlitterWait() : Cardinal;
begin
  Result := 0;
  
  // wait until, if blitter flag is zero
  while ((blit32[MESGSTATUS >> 2] and 1) > 0) do begin
    Inc(Result);
  end;
end;

// Code partly taken from gp2x.com (author paeryn)
// dummy blit to force MMSP2's blitter to flush it's cache
procedure gp2x_DummyBlit();
var
  Screen           : Cardinal;
begin
  Screen := gp2x_PhysScreenAddr;
  
  gp2x_BlitterWait();
  
  // Blitter seems to have a 16 byte buffer, so force flushing by
  // drawing 8 16bit pixels onto themselves.
  blit32[$0000 >> 2] := (1 << 5) or (1 << 6);                      // MESGDSTCTRL
  blit32[$0004 >> 2] := Screen;                                    // MESGDSTCTRL  - front screen buffer
  blit32[$000C >> 2] := 1 << 8;                                    // MESGSRCCTRL
  blit32[$0020 >> 2] := 0;                                         // MESGPATCTRL
  blit32[$002C >> 2] := (1 << 16) or 8;                            // MESGSIZE     - number of bytes to copy
  blit32[$0030 >> 2] := (1 << 8) or (1 << 9) or $AA or MESG_FFCLR; // MESGCTRL

  blit32[$0034 >> 2] := $0001;                                     // MESGCTRL     - start blitter

  gp2x_BlitterWait();
end;

// -----------------------------------------------------------------------
//
// -----------------------------------------------------------------------
function gp2x_InitMem(aBaseAddr : Cardinal = UNUSED_MEMORY) : Boolean;
var
  Mem32MB          : Pointer;
begin
  if (InitCounter > 0) then begin
    Inc(InitCounter);
    Result := True;
    Exit;
  end;

  memdev := fpopen('/dev/mem', O_RDWR);
  if (memdev < 0) then begin
    writeLn('dev/mem not open');
    Result := False;
    exit;
  end;

  // try access lower 32MB of GP2X
  Mem32MB := fpmmap(0, UNUSED_MEMORY, PROT_READ or PROT_WRITE, MAP_SHARED, memdev, 0);
  if (Mem32MB = MAP_FAILED) then begin
    writeLn('32MB memory not maped');
    Result := False;
    exit;
  end;
  VirtMappedOffset := CARDINAL(Mem32MB);
  WriteLn('Virtual memory offset: ', IntToHex(VirtMappedOffset, 8));
  fpmunmap(Mem32MB, UNUSED_MEMORY);

  mem32 := fpmmap(0, $10000, PROT_READ or PROT_WRITE, MAP_SHARED, memdev, $C0000000);
  mem16 := pWordArray(mem32);
  if (mem32 = MAP_FAILED) then begin
    writeLn('memory not maped');
    Result := False;
    exit;
  end;

  blit32 := fpmmap(0, $100, PROT_READ or PROT_WRITE, MAP_SHARED, memdev, $E0020000);
  if (blit32 = MAP_FAILED) then begin
    writeLn('blitter memory not maped');
    Result := False;
    exit;
  end;

  Result := True;
  Inc(InitCounter);

  // Init memory manager
  gp2xMemManager.Init(gp2x_MemHandle());
end;

function  gp2x_Initialized() : Boolean;
begin
  Result := (InitCounter > 0);
end;

procedure gp2x_DeinitMem;
begin
  if (InitCounter > 0) then begin
    Dec(InitCounter);

    if (InitCounter = 0) then begin
    
      fpmunmap(Blit32, $100);
      fpmunmap(Mem32, $10000);
    
      mem16[$28DA shr 1] := $4AB;
      mem16[$290C shr 1] := 640;
      if (fpclose(memdev) <0) then begin
        writeLn('dev/map not close');
      end;
    end;
  end;
end;

// -----------------------------------------------------------------------
// memory manager for upper memory which is not used by linux
// -----------------------------------------------------------------------
function gp2x_MemHandle() : Integer;
begin
  Result := -1;
  if gp2x_InitMem() then begin
    Result := memdev;
  end;
end;

function gp2x_AllocMem(aSize : Integer) : Pointer;
begin
  if Assigned(gp2xMemManager) then begin
    Result := gp2xMemManager.AllocMem(aSize);
  end else begin
    raise Exception.Create('GP2X memory manager not initialized');
  end;
end;

function gp2x_FreeMem(aPtr : Pointer) : Boolean;
begin
  if Assigned(gp2xMemManager) then begin
    Result := gp2xMemManager.FreeMem(aPtr);
  end else begin
    raise Exception.Create('GP2X memory manager not initialized');
  end;
end;

function gp2x_Virt2Phys(aPtr : Pointer) : Cardinal;
begin
  if Assigned(gp2xMemManager) then begin
    Result := gp2xMemManager.Virt2Phys(aPtr);
  end else begin
    raise Exception.Create('GP2X memory manager not initialized');
  end;
end;

procedure gp2x_PrintMemoryMap();
begin
  if Assigned(gp2xMemManager) then begin
    gp2xMemManager.PrintMemoryMap();
  end else begin
    raise Exception.Create('GP2X memory manager not initialized');
  end;
end;

// -----------------------------------------------------------------------
// -----------------------------------------------------------------------
procedure set_display_clock_div(divi: word);
begin
  if not gp2x_InitMem then begin
    exit;
  end;

  divi := (divi and $ff) shl 8;
  mem16[$924 shr 1] := (mem16[$924 shr 1] and $ff) or divi;

  gp2x_DeinitMem;
end;

{function get_freq_920_CLK: word;
const
    GP2X_CLK_FREQ=7372800;

var i    : word;
    reg  : word;
    mdiv,
    pdiv,
    scale: integer;
begin
  reg:= mem16[$912>>1];
  mdiv:= ((reg and $ff00) shr 8) + 8;
  pdiv:= ((reg and $fc) shr 2) + 2;
  scale:= reg and 3;
  
  i:= (mem16[$91c shr 1] and 7)+1;
  result:= ((GP2X_CLK_FREQ * mdiv) div (pdiv shl scale)) div i;
end;

function get_920_Div: word;
begin
  result:=mem16[$91c shr 1] and 7;
end;

function getClock: word;
const lfreq: array [0..24] of word =
    (60,66,80,100,120,133,150,166,
     200,210,220,240,250,266,270,275,
     280,285,290,295,300,305,310,315,320); 
var n,m: integer;
    sysfreq: word;
begin
  sysfreq:=0;

  sysfreq:=get_freq_920_CLK;
  sysfreq:=sysfreq * get_920_Div+1;
  m:=(sysfreq div 1000000)+4;
  n:=0;
  
  for n:=24 downto 0 do
     if lfreq[n]<m
     then break;

  result:=lfreq[n];
end;}

procedure gp2x_setClock(aFreq : Word);
const
  maxClock         = 300;
  GP2X_CLK_FREQ    = $708000;

var
  v                : word;
  mhz              : longint;
  mdiv,pdiv,scale  : integer;
begin
  mhz := EnsureRange(aFreq, 50, maxClock);
  if not gp2x_InitMem then begin
    Exit;
  end;

  pdiv  := 3;
  scale := 0;
  mhz   := aFreq * 1000000;
  mdiv  := (mhz * pdiv) div GP2X_CLK_FREQ;
  mdiv  := ((mdiv - 8) and $ff) shl 8;
  pdiv  := ((pdiv - 2) shl 2) and $fc;
  scale := scale and 3;
  v     := mdiv or pdiv or scale;
  //mem16[$910 shr 1]:=v;
  mem16[$910 shr 1] := mem16[$910 shr 1] and 0 or v;

  gp2x_DeinitMem;
end;

procedure set_DCLK_Div(divi: word);
var 
  v                : Word;
begin
  v := mem16[$91c shr 1] and not(7 shl 6);
  
  mem16[$91c shr 1] := ((divi and 7) shl 6) or v;
end;

procedure set_920_Div(divi: word);
var v: word;
begin
  v := mem16[$91c shr 1] and (not 3);
  mem16[$91c shr 1] := (divi and 7) or v;
end;

procedure gp2x_setFreq(aFreq: word);
var 
  divi             : Word;
begin
  divi:=(aFreq * 14) div 200;
  if (divi >63) then begin
    divi:=63;
  end;

  set_display_clock_div(64 or divi);
  gp2x_setClock(aFreq);

  if not gp2x_InitMem then begin
    exit;
  end;
  
  set_DCLK_Div(0);
  set_920_Div(0);
  
  gp2x_DeinitMem;
end;

procedure gp2x_SleepMode;
begin
   gp2x_SetClock(25);

   if not gp2x_InitMem then exit;

   //Turn off backlight
   mem16[GPIOHOUT shr 1]:=mem16[GPIOHOUT shr 1] and not $0004;
   //Turn off LCD controller
   mem16[$2800 shr 1]:=mem16[$2800 shr 1] and not $0001;
   //Set LCD to sleep mode
   mem16[GPIOBOUT shr 1]:=mem16[GPIOBOUT shr 1] or $0004;

   gp2x_DeinitMem;
end;

procedure gp2x_Wakeup(NewSpeed : Longint);
begin
   gp2x_SetClock(NewSpeed);

   if not gp2x_InitMem then exit;

   //Set LCD from sleep mode
   mem16[GPIOBOUT shr 1]:=mem16[GPIOBOUT shr 1] and not $0004;
   
   //Turn on LCD controller
   mem16[$2800 shr 1]:=mem16[$2800 shr 1] or $0001;
   
   //Turn on backlight
   mem16[GPIOHOUT shr 1]:=mem16[GPIOHOUT shr 1] or $0004;
  
   gp2x_DeinitMem;
end;

function gp2x_getBattery: word;
const
  BATTERY_READS    = 10;

var 
  devbatt          : Integer;
  battval          : Integer;
  cbv,
  min,
  max              : Word;
  i                : Integer;
begin
  devbatt:= fpopen ('/dev/batt', O_RDONLY);
  try
    if (devbatt < 0) then begin
      Result := 0;
      exit;
    end;

    battval := 0;
    min     := 900;
    max     := 0;
    for i:=1 to BATTERY_READS do begin
      if (fpread(devbatt, cbv, 2) = 2) then begin
        inc(battval,cbv);
        if (cbv>max) then max := cbv;
        if (cbv<min) then min := cbv;
      end;
    end;
  finally
    if (devbatt >= 0) then begin
      fpclose(devbatt);
    end;
  end;

   battval:=(battval-min-max) div (BATTERY_READS-2); // middle value without max and min values

   if (battval>=900) then result:=7      // AC
   else if (battval>850) then result:=6  // battery full
   else if (battval>780) then result:=5
   else if (battval>740) then result:=4
   else if (battval>700) then result:=3
   else if (battval>690) then result:=2
   else if (battval>680) then result:=1
   else result:=0;                       // battery empty
end;

procedure gp2x_LedBattOff;
begin
  if not gp2x_InitMem then begin
    exit;
  end;
  
  mem16[GPIOHOUT >> 1] := mem16[GPIOHOUT >> 1] or $10;
  
  gp2x_DeinitMem;
end;

procedure gp2x_LedBattOn;
begin
  if not gp2x_InitMem then begin
    exit;
  end;

  mem16[GPIOHOUT >> 1] := mem16[GPIOHOUT >> 1] and $ef;

  gp2x_DeinitMem;
end;

procedure gp2x_LedBattFlip;
begin
  if not gp2x_InitMem then exit;
  mem16[GPIOHOUT >> 1] := mem16[GPIOHOUT >> 1] xor $10;
  gp2x_DeinitMem;
end;

function gp2x_JoystickValue() : Word;
begin
  Result := 0;
  if gp2x_InitMem() then begin
    Result := NOT mem16[GPIOMPINLVL >> 1];
    gp2x_DeinitMem();
  end;
end;

function gp2x_ButtonValue() : Word;
begin
  Result := 0;
  if gp2x_InitMem() then begin
    Result := NOT mem16[GPIOCPINLVL >> 1];
    gp2x_DeinitMem();
  end;
end;

function gp2x_VolumeValue() : Word;
begin
  Result := 0;
  if gp2x_InitMem() then begin
    Result := NOT mem16[GPIODPINLVL >> 1];
    gp2x_DeinitMem();
  end;
end;

function gp2x_JoystickPressed(const aButton : Integer; aSmallRange : Boolean) : Boolean;
var
  wJoy             : Word;
begin
  Result := False;
  wJoy   := (gp2x_JoystickValue() and $00FF);
  if (wJoy <> 0) then begin
    if (aButton = gp2x_JoyLeft) then begin
      if (wJoy = $0004) then Result := True;
      if (wJoy = $0006) then Result := True;
      if (wJoy = $000C) then Result := True;
      if not aSmallRange then begin
        if (wJoy = $0002) then Result := True;
        if (wJoy = $0008) then Result := True;
      end;
    end;
                                                                        
    if (aButton = gp2x_JoyUp) then begin
      if (wJoy = $0001) then Result := True;
      if (wJoy = $0003) then Result := True;
      if (wJoy = $0081) then Result := True;
      if not aSmallRange then begin
        if (wJoy = $0002) then Result := True;
        if (wJoy = $0080) then Result := True;
      end;
    end;

    if (aButton = gp2x_JoyRight) then begin
      if (wJoy = $0040) then Result := True;
      if (wJoy = $0060) then Result := True;
      if (wJoy = $00C0) then Result := True;
      if not aSmallRange then begin
        if (wJoy = $0020) then Result := True;
        if (wJoy = $0080) then Result := True;
      end;
    end;

    if (aButton = gp2x_JoyDown) then begin
      if (wJoy = $0010) then Result := True;
      if (wJoy = $0030) then Result := True;
      if (wJoy = $0018) then Result := True;
      if not aSmallRange then begin
        if (wJoy = $0008) then Result := True;
        if (wJoy = $0020) then Result := True;
      end;
    end;
  end;                                                                                                                                                  
end;

function gp2x_ButtonPressed(const aButton : Integer) : Boolean;
var
  wButton          : Word;
begin
  Result  := False;
  wButton := gp2x_ButtonValue();
  if (wButton <> 0) then begin
    case aButton of
      gp2x_Start   : Result := ((wButton and $0100) = $0100);
      gp2x_Select  : Result := ((wButton and $0200) = $0200);
      gp2x_LButton : Result := ((wButton and $0400) = $0400);
      gp2x_RButton : Result := ((wButton and $0800) = $0800);
      gp2x_A       : Result := ((wButton and $1000) = $1000);
      gp2x_B       : Result := ((wButton and $2000) = $2000);
      gp2x_X       : Result := ((wButton and $4000) = $4000);
      gp2x_Y       : Result := ((wButton and $8000) = $8000);
    else
      Result := False;
    end;
  end;
end;

function gp2x_VolumePressed(const aButton : Integer) : Boolean;
var
  wButton          : Word;
begin
  Result  := False;
  wButton := (gp2x_VolumeValue() and $00F0);  
  if (wButton <> 0) then begin
    case aButton of
      gp2x_VolMinus : Result := ((wButton and $0040) = $0040);
      gp2x_VolPlus  : Result := ((wButton and $0080) = $0080);
    else
      Result := False;
    end;
  end;
end;

// -----------------------------------------------------------------------
// gp2x video functions
// -----------------------------------------------------------------------
function  gp2x_OpenFrameBuffer1(aColorDepth : Integer) : PVideoBuffer;
var
  fixed_info       : TFB_Fix_ScreenInfo;
begin
  Result := nil;
  if (VB1.Handle < 0) then begin
    VB1.Handle := fpopen('/dev/fb/0', O_RDWR);
    if (VB1.Handle >= 0) then begin
      // Lese die physikalischen Daten zu dem Framebuffer aus
      fpioctl(VB1.Handle, FBIOGET_FSCREENINFO, @fixed_info);

      // Speichere einige Daten zwischen
      VB1.Active     := False;
      VB1.ColorDepth := aColorDepth;
      VB1.LineWidth  := (aColorDepth + 1) div 8;
      VB1.PhysAddr   := fixed_info.SMem_Start;
      VB1.Len        := fixed_info.SMem_Len;
        
      // Mappe die physikalische Adresse auf eine logische Adresse
      VB1.Screen     := fpmmap(0, 320 * 240 * 2, PROT_WRITE, MAP_SHARED, VB1.Handle, 0);      

      WriteLn('ID:         ', fixed_info.ID);
      WriteLn('SMem_Start: ', IntToHex(fixed_info.SMem_Start, 8));
      WriteLn('SMem_Len:   ', IntToHex(fixed_info.SMem_Len, 8));
      WriteLn('Screen:     ', IntToHex(CARDINAL(VB1.Screen), 8));
      
      // Gebe den Pointer auf die Datenstruktur zurueck
      Result := @VB1;
    end else begin
      WriteLn('No access to FB0: ', fpGetErrNo);    
    end;
  end else begin
    Result := @VB1;    
  end;
end;

function  gp2x_OpenFrameBuffer2(aColorDepth : Integer) : PVideoBuffer;
var
  fixed_info       : TFB_Fix_ScreenInfo;
begin
  Result := nil;
  if (VB2.Handle < 0) then begin
    VB2.Handle := fpopen('/dev/fb/1', O_RDWR);    
    if (VB2.Handle >= 0) then begin
      fpioctl(VB2.Handle, FBIOGET_FSCREENINFO, @fixed_info);
      VB2.Active     := False;
      VB2.ColorDepth := aColorDepth;          
      VB2.LineWidth  := (aColorDepth + 1) div 8;
      VB2.PhysAddr   := fixed_info.SMem_Start;
      VB2.Len        := fixed_info.SMem_Len;
      VB2.Screen     := fpmmap(0, 320 * 240 * 2, PROT_WRITE, MAP_SHARED, VB2.Handle, 0);

      WriteLn('ID:         ', fixed_info.ID);
      WriteLn('SMem_Start: ', IntToHex(fixed_info.SMem_Start, 8));
      WriteLn('SMem_Len:   ', IntToHex(fixed_info.SMem_Len, 8));
      WriteLn('Screen:     ', IntToHex(CARDINAL(VB2.Screen), 8));

      Result := @VB2;
    end else begin
      WriteLn('No access to FB1: ', fpGetErrNo);    
    end;
  end else begin
    Result := @VB2;    
  end;
end;

function gp2x_OpenVideo(aWidth, aHeight : Integer; aColorDepth : Integer) : Boolean;
begin
  Result := False;
  if not VideoDone then begin
    WriteLn('Initialize Video');
    if gp2x_InitMem() then begin
      if Assigned(gp2x_OpenFrameBuffer1(aColorDepth)) then begin
        WriteLn('Open FB2 device');
        if Assigned(gp2x_OpenFrameBuffer2(aColorDepth)) then begin                  
          // set up color depth
          mem16[$28DA >> 1] := ((aColorDepth div 8) << 9) or $AB; // 8/15/16/24bpp
          mem16[$290C >> 1] := 320 * ((aColorDepth + 1) div 8);   // line width in bytes
          
          // enable all video and graphic devices
          mem16[$090a >> 1] := $FFFF;
          
          // enable fastio
          mem16[$0904 >> 1] := mem16[$0904 >> 1] or (1 << 10);
          
          gp2x_DummyBlit();
    
          VideoDone := True;
          Result    := True;
          Exit;           
        end;
      end;
      gp2x_DeinitMem();      
    end;
  end;  
end;

function gp2x_CloseVideo() : Boolean;
begin
  Result := False;
  if (VB2.Handle >= 0) then begin
    fpclose(VB2.Handle);
    VB2.Handle := -2;
  end;

  if (VB1.Handle >= 0) then begin
    fpclose(VB1.Handle);
    VB1.Handle := -1;
  end;
  
  if VideoDone then begin
    gp2x_DeinitMem();
    VideoDone := False;
    Result    := True;
  end;
end;

function gp2x_ScreenBuffer : PGP2XScreen;
begin
  if VideoDone then begin
    if VB1.Active then begin
      Result := PGP2XSCREEN(VB2.Screen);
    end else begin
      Result := PGP2XSCREEN(VB1.Screen);
    end;
  end else begin
    WriteLn('Video buffer not initialized');
  end;
end;

function  gp2x_PhysScreenAddr : Cardinal;
begin
  if VB1.Active then begin
    Result := VB2.PhysAddr;
  end else begin
    Result := VB1.PhysAddr;
  end;

end;

// -----------------------------------------------------------------------
// color conversion helper functions
// -----------------------------------------------------------------------

function gp2x_RGB16(aRed, aGreen, aBlue : Integer) : Word;
begin
  Result := ((aRed and $F8) << 8) or ((aGreen and $FC) << 3) or ((aBlue and $F8) >> 3);
end;

function  gp2x_R16_Red(aRGB16 : Word) : Byte;
begin
  Result := ((((aRGB16 and $F800) << 10) and $00FF0000) >> 16);
end;

function  gp2x_R16_Green(aRGB16 : Word) : Byte;
begin
  Result := ((((aRGB16 and $07E0) >> 5) and $0000FF00) >> 8);
end;

function  gp2x_R16_Blue(aRGB16 : Word) : Byte;
begin
  Result := ((aRGB16 and $001F) and $000000FF);
end;

function  gp2x_RGB32(aRGB16 : Word) : Cardinal;
begin
  Result := ((aRGB16 and $F800) << 8);
  Result := Result or ((aRGB16 and $07E0) << 5);
  Result := Result or ((aRGB16 and $001F) << 3);
end;

// -----------------------------------------------------------------------
// screen functions
// -----------------------------------------------------------------------

procedure gp2x_FlipScreen(aScreen : Integer = -1);
var
  Address          : Cardinal;
begin
  if (VB1.Handle >= 0) and (VB2.Handle >= 0) then begin
    if (aScreen = -1) then begin
      if VB1.Active then begin
        VB1.Active := False;
        VB2.Active := True;
        Address    := CARDINAL(VB2.PhysAddr);
      end else begin
        VB2.Active := False;
        VB1.Active := True;
        Address    := CARDINAL(VB1.PhysAddr);
      end;
    end else begin
      if (aScreen = 1) then begin
        VB1.Active := False;
        VB2.Active := True;
        Address    := CARDINAL(VB2.PhysAddr);
      end else begin
        VB2.Active := False;
        VB1.Active := True;
        Address    := CARDINAL(VB1.PhysAddr);
      end; 
    end;
    
    mem16[$290E >> 1] := WORD(Address AND $FFFF);
    mem16[$2910 >> 1] := WORD(Address >> 16);
  
    Inc(Address, VB1.LineWidth);
  
    mem16[$2912 >> 1] := WORD(Address AND $FFFF);
    mem16[$2914 >> 1] := WORD(Address >> 16);    
  end;
end;                                                              

procedure gp2x_FlipScreenWait(aWaitForSync : Boolean);
begin
  gp2x_FlipScreen();
  if aWaitForSync then begin
    while (((not mem16[GPIOBPINLVL >> 1]) and (1 << 4)) > 0) do ;  
  end;
end;

procedure gp2x_WaitVSync(aWaitForASync : Boolean = True);
begin
  if (InitCounter > 0) then begin
    while ((mem16[GPIOBPINLVL >> 1] and (1<<4)) > 0) do ;
    if aWaitForASync then begin
      while ((mem16[GPIOBPINLVL >> 1] and (1<<4)) = 0) do ;
    end;
  end;
end;

procedure gp2x_WaitVASync();
begin
  if (InitCounter > 0) then begin
    while ((mem16[GPIOBPINLVL >> 1] and (1<<4)) = 0) do ;
  end;
end;

// -----------------------------------------------------------------------
// functions without blitter support
// -----------------------------------------------------------------------

procedure gp2x_ClearScreen16(aRed, aGreen, aBlue : Integer; aScreen : Integer = -1);
var
  Screen           : PGP2XScreen;
  wColor           : Word;
begin
  case aScreen of
    -1 : Screen := gp2x_ScreenBuffer();
     0 : Screen := PGP2XSCREEN(VB1.Screen);
     1 : Screen := PGP2XSCREEN(VB2.Screen);
  else
    Exit;
  end;

  wColor := gp2x_RGB16(aRed, aGreen, aBlue);
  FillWord(Screen^, 320 * 240, wColor);                                                          
end;

procedure gp2x_Hline(aX1, aX2, aY : Integer; aRed, aGreen, aBlue : Integer);
var
  Screen           : PGP2XScreen;
  iX, iY           : Integer;
  wColor           : Word;
begin
  Screen := gp2x_ScreenBuffer;
  wColor := gp2x_RGB16(aRed, aGreen, aBlue);

  if (aY < 0) then Exit;
  if (aY > 239) then Exit;
  
  if (aX1 < 0) then aX1 := 0;
  if (aX1 > 319) then aX1 := 319;
  if (aX2 < 0) then aX2 := 0;
  if (aX2 > 319) then aX2 := 319;
  
  if (aX1 > aX2) then begin
    iX  := aX2;
    aX2 := aX1;
    aX1 := iX;
  end;

  if ((aX2 - aX1) >= 10) then begin
    gp2x_FillRect(aX1, aY, (aX2 - aX1) + 1, 1, aRed, aGreen, aBlue); 
  end else begin
    FillWord(Screen^[aY, aX1], (aX2 - aX1) + 1, wColor);
  end;
end;

// -----------------------------------------------------------------------
// functions with blitter support
// -----------------------------------------------------------------------

procedure gp2x_ClearScreen(aRed, aGreen, aBlue : Integer; aScreen : Integer = - 1);
var
  Screen           : Cardinal;
  wColor           : Word;
begin
  wColor := gp2x_RGB16(aRed, aGreen, aBlue);
   case aScreen of
    -1 : Screen := gp2x_PhysScreenAddr();
     0 : Screen := VB1.PhysAddr;
     1 : Screen := VB2.PhysAddr;
  else
    Exit;
  end;

  blit32[$0004 >> 2] := Screen;
  blit32[$0000 >> 2] := (1 << 5);                         // Destination is 16 bpp
  blit32[$0008 >> 2] := 640;                              // Destination stride size in bytes

  blit32[$0020 >> 2] := (1 << 5) or (2 << 3);             // Perform ROP with a 1bpp pattern
  blit32[$0024 >> 2] := wColor;                           // Setup the foreground and background colors for the pattern to be the same
  blit32[$0028 >> 2] := wColor;                           // so we don't actually have to upload a pattern image.
  blit32[$002C >> 2] := (240 << 16) or (320 << 0);        // Height and width to blit
  blit32[$0030 >> 2] := (1 << 8) or (1 << 9) or $F0;      // Fill from top left to bottom right

  // start blitter
  blit32[$0034 >> 2] := $0001;

  gp2x_BlitterWait();
  gp2x_DummyBlit(); 
end;

procedure gp2x_FillRect(aX, aY, aW, aH : Integer; aColor : Word);
var
  Screen           : Cardinal;
begin
  Screen := gp2x_PhysScreenAddr;

  gp2x_BlitterWait();

  // perform bounding checks
  if (aW < 0) then Exit;
  if (aH < 0) then Exit;
  if (aX > 319) then Exit;
  if (aY > 239) then Exit;
  
  if (aX < 0) then aX := 0;
  if (aY < 0) then aY := 0;
  
  if ((aX + aW) >= 320) then aW := 320 - aX;
  if ((aY + aH) >= 240) then aH := 240 - aY;  

  if (aW < 0) then exit;
  if (aH < 0) then exit;

  // set destination
  blit32[$0004 >> 2] := (Screen + (aY * 640) + (aX << 1)) and $FFFFFFFC;
  blit32[$0000 >> 2] := (1 << 5) or ((aX and $000000001) << 4); // Destination is 16 bpp
  blit32[$0008 >> 2] := 640;                                    // Destination stride size in bytes
  // blit32[$000C >> 2] := (1 << 8) or (1 << 7) or (1 << 5);  
  blit32[$000C >> 2] := 0;

  // set source  
  blit32[$0020 >> 2] := (1 << 5) or (2 << 3);             // Perform ROP with a 1bpp pattern
  blit32[$0024 >> 2] := aColor;                           // Setup the foreground and background colors for the pattern to be the same
  blit32[$0028 >> 2] := aColor;                           // so we don't actually have to upload a pattern image.
  blit32[$002C >> 2] := (aH << 16) or (aW << 0);          // Height and width to blit
  blit32[$0030 >> 2] := (1 << 8) or (1 << 9) or $F0;      // Fill from top left to bottom right

  // start blitter
  blit32[$0034 >> 2] := $0001;

  // Wait until blitter is ready  
  gp2x_BlitterWait();
  gp2x_DummyBlit();
end;

procedure gp2x_FillRect(aX, aY, aW, aH : Integer; aRed, aGreen, aBlue : Byte);
var
  wColor           : Word;
begin
  wColor := gp2x_RGB16(aRed, aGreen, aBlue);
  
  gp2x_FillRect(aX, aY, aW, aH, wColor);
end;

function gp2x_Blit16(aSrcPtr     : Pointer;       // Physical source address to blit from
                     aXSrc       : Integer;       // X - Position to blit from
                     aYSrc       : Integer;       // Y - Position to blit from
                     aWidth      : Integer;
                     aHeight     : Integer;
                     aPitch      : Integer;       // width of image in bytes(!) not pixel
                     aDstPtr     : Pointer;       // Physical dest adresse where to blit, 
                                                  // coud be nil
                     aXDest      : Integer;       // X - Position where to blit 
                     aYDest      : Integer;       // Y - Poistion where to blit
                     aTransColor : Boolean;       // Has Transparent color (TRUE)
                     aRed        : Byte;          // 8Bit Value 
                     aGreen      : Byte;          // 8Bit Value 
                     aBlue       : Byte;          // 8Bit Value 
                     aAlpha      : Byte;          // not used at this time
                     aDummyBlit  : Boolean = True // GP2X issue, blit 8 bytes to clear 
                                                  // bitter cache
                     ) : Boolean;

var
  Screen           : Cardinal;
  CTRLFlag         : Cardinal;
begin
  Result := False;
  Screen := CARDINAL(aDstPtr);
  if not Assigned(aDstPtr) then begin
    Screen := gp2x_PhysScreenAddr;
  end;

  gp2x_BlitterWait();  
  
  // Set the destination address
  blit32[$0004 >> 2] := (Screen + (aYDest * 640) + (aXDest << 1)) and $FFFFFFFC; // dest ptr
  blit32[$0000 >> 2] := (1 << 5) or ((aXDest and $00000001) << 4);               // Destination is 16 bpp
  //Set the pitch of destination in bytes
  blit32[$0008 >> 2] := 640;
  
  // Set the source address
  blit32[$0010 >> 2] := (CARDINAL(aSrcPtr) + (aYSrc * aPitch) + (aXSrc << 1)) and $FFFFFFFC;   // source pointer
  // Set the pitch of source in bytes
  blit32[$0014 >> 2] := aPitch;
  // Do nothing with pattern
  blit32[$0020 >> 2] := 0;
  
  // Set a 16bit source, enable source and say the source is not controlled by CPU(?)
  // ((aXSrc and $00000001) << 4) set fraction bit, if aXSrc not alligned to 4
  if ((aXSrc mod 4) > 0) then begin
    blit32[$000C >> 2] := (1 << 8) or (1 << 7) or (1 << 5) or ((aXSrc and $00000001) << 4);
  end else begin
    blit32[$000C >> 2] := (1 << 8) or (1 << 7) or (1 << 5);
  end;

  // Clear the source input FIFO, positive X,Y and do a copy ROP.
  blit32[$002C >> 2] := (aHeight << 16) or (aWidth << 0);                // Height and width to blit
  
  // transparent color 
  CTRLFlag := (1 << 10) or (1 << 9) or (1 << 8) or $CC;
  if aTransColor then begin
    // Enable transparent color
    CTRLFlag := CTRLFlag or (1 << 11);
    // Set transparent color
    CTRLFlag := CTRLFlag or (gp2x_RGB16(aRed, aGreen, aBlue) << 16);
  end;
  blit32[$0030 >> 2] := CTRLFlag;

  // start blitter
  blit32[$0034 >> 2] := $0001;

  // Wait until blitter is ready  
  gp2x_BlitterWait();
  
  if aDummyBlit then begin
    gp2x_DummyBlit();
  end;
end;

// -----------------------------------------------------------------------
// simple debug textout (slow)
// -----------------------------------------------------------------------
procedure gp2x_TextOut(aX, aY : Integer; const aMessage : String; aColor : Word);
var
  iLoop            : Integer;
  iLoopX, iLoopY   : Integer;
  iFontHeight      : Integer;
  iFontWidth       : Integer;
  iCharPos         : Integer;
  uColor           : Word;
  cMessage         : array[0..255] of Char;
  Screen           : PGP2XScreen;
begin
  StrPLCopy(cMessage, aMessage, SizeOf(cMessage) - 1);

  Screen      := gp2x_ScreenBuffer();
  iFontWidth  := Length(cFixedFont[0][0]);
  iFontHeight := Length(cFixedFont[0]);

  for iLoop := 0 to Pred(StrLen(cMessage)) do begin
    iCharPos := Ord(cMessage[iLoop]);
    if (iCharPos > 0) then begin
      for iLoopY := 0 to Pred(iFontHeight) do begin
        for iLoopX := 0 to Pred(iFontWidth) do begin
          uColor := cFixedFont[iCharPos][iLoopY][iLoopX];
          if (uColor <> $F81F) then begin
            if ((aX + (iFontWidth * iLoop) + iLoopX) < 320) and ((aY + iLoopY) < 239) and
               ((aX + (iFontWidth * iLoop) + iLoopX) >= 0) and ((aY + iLoopY) >= 0)
            then begin
              Screen^[aY + iLoopY, aX + (iFontWidth * iLoop) + iLoopX] := aColor;
            end;
          end;
        end;
      end;
    end; 
  end;  
end;

// -----------------------------------------------------------------------
// gp2x audio functions
// -----------------------------------------------------------------------

function gp2x_OpenAudio() : Boolean;
var
  uRate            : Cardinal;
  uBits            : Cardinal;
  uStereo          : Cardinal;
  uFrag            : Cardinal;
  uNB              : Cardinal;
begin
  Result := AudioDone;
  if not AudioDone then begin
    DSPHandle := fpopen('/dev/dsp', 1); // O_WRONLY
    if (DSPHandle >= 0) then begin
      uRate   := 44100;
      uBits   := 16;
      uStereo := 1;
      uFrag   := $0002000D;
      uNB     := $00000001;
      
      fpioctl(DSPHandle, DSP_SPEED, @uRate);
      fpioctl(DSPHandle, DSP_SETFMT, @uBits);
      fpioctl(DSPHandle, DSP_STEREO, @uStereo);
      fpioctl(DSPHandle, DSP_SETFRAGMENT, @uFrag);
      fpioctl(DSPHandle, $5421, @uNB);
      
      AudioDone := True;
      Result    := True;
    end;
  end;
end;

procedure gp2x_CloseAudio();
begin
  if AudioDone then begin
    fpclose(DSPHandle);
    AudioDone := False;  
  end;
end;

procedure gp2x_SetVolume(aVolume : Word);
var
  iMixer           : Integer;
  wVolume          : Word;
begin
  iMixer := fpopen('/dev/mixer', O_RDWR);
  if (iMixer >= 0) then begin
    wVolume := (aVolume << 8) or aVolume;
    fpioctl(iMixer, SOUND_MIXER_WRITE_PCM, @wVolume);
    fpclose(iMixer);
  end;                  
end;

initialization

  gp2xMemManager := TGP2XMemManager.Create();
  memdev         := 0;
  InitCounter    := 0;
  VideoDone      := False;
  VB1.Handle     := -1;
  VB2.Handle     := -2; 
  AudioDone      := False;

finalization

  FreeAndNil(gp2xMemManager);

end.
