{****************************************************************************}
{** Unit für die Programmiersprachen PASCAL, Delphi für die Einbindung der **}
{** pmbslib2.dll. Geschrieben von Oliver "CYBRiX" Hauth/IQ Computing       **}
{** EMail: cybrix@fodder.prometheus.de                                     **}
{****************************************************************************}

{$F+}
unit PMBSLIB;

interface

USES
  WinTypes, Strings;

CONST
  LibName = 'PMBSLIB2';

CONST
  cur_Up    = 200;
  cur_Down  = 201;
  cur_Left  = 202;
  cur_Right = 203;



FUNCTION pmbspcSend(Port : Word; Str : String) : Word;
FUNCTION pmbspcQuit(Port : Word) : Word;
FUNCTION pmbspcMemory : Pointer;
FUNCTION pmbspcRead(Port : Word; Vorgabe : String; Anzahl : Word) : String;
FUNCTION pmbspcBRead(Port : Word; Vorgabe : String; Anzahl : Word) : String;
FUNCTION pmbspcGetDir : String;
FUNCTION pmbspcGetNetDir : String;
FUNCTION pmbspcGetUser(Port : Word) : String;
FUNCTION pmbspcGetUserDos(Port : Word) : String;
FUNCTION pmbspcGetBox(Port : Word) : String;
FUNCTION pmbspcCheckCarrier(Port : Word) : Boolean;
FUNCTION pmbspcGetChar(Port : Word) : Char;
FUNCTION pmbspcSendFile(Port : Word; Datei : String) : Boolean;
FUNCTION pmbspcReceiveFile(Port : Word) : Boolean;
FUNCTION pmbspcGetPoint(Port : Word) : String;
FUNCTION pmbspcGetFree(Port : Word) : LongInt;
FUNCTION pmbspcSetFree(Port : Word; Freiraum : LongInt) : LongInt;
FUNCTION pmbspcGetLevel(Port : Word) : LongInt;
FUNCTION pmbspcChoose(Port : Word; Auswahl : String; Vorgabe : Word) : BYTE;
FUNCTION pmbspcGetNum(Port : Word; min, max, Def : LongInt) : LongInt;
FUNCTION pmbspcWaitForKey(Port : Word) : LongInt; 


implementation

FUNCTION IntToStr(l : Longint) : STRING;
VAR
  s : STRING;
BEGIN
  Str(l, s);
  IntToStr := s;
END;

FUNCTION StrToInt(s : STRING) : Longint;
VAR
  e : Integer;
  l : Longint;
BEGIN
  Val(s, l, e);
  StrToInt := l;
END;


FUNCTION pmbsSend(Port : Word; Str : PChar) : Word;
  external LibName;

FUNCTION pmbsQuit(Port : Word) : Word;
  external LibName;

FUNCTION pmbsMemory(Adr : Pointer) : LongInt;
  external LibName;

FUNCTION pmbsRead(Port : Word; Vorgabe : PChar; Anzahl : Word; Puffer : PChar) : Word;
  external LibName;

FUNCTION pmbsBRead(Port : Word; Vorgabe : PChar; Anzahl : Word; Puffer : PChar) : Word;
  external LibName;

FUNCTION pmbsGetDir(Puffer : PChar) : Word;
  external LibName;

FUNCTION pmbsGetNetDir(Puffer : PChar) : Word;
  external LibName;

FUNCTION pmbsGetUser(Port : Word; Puffer : PChar) : Word;
  external LibName;

FUNCTION pmbsGetUserDos(Port : Word; Puffer : PChar) : Word;
  external LibName;

FUNCTION pmbsGetBox(Port : Word; Puffer : PChar) : Word;
  external LibName;

FUNCTION pmbsCheckCarrier(Port : Word; P : Pointer) : LongInt;
  external LibName;

FUNCTION pmbsGetChar(Port : Word; P : Pointer) : LongInt;
  external LibName;

FUNCTION pmbsSendFile(Port : Word; Datei : PChar; P : Pointer) : LongInt;
  external LibName;

FUNCTION pmbsReceiveFile(Port : Word; P : Pointer) : LongInt;
  external LibName;

FUNCTION pmbsGetPoint(Port : Word; Puffer : PChar) : LongInt;
  external LibName;

FUNCTION pmbsGetFree(Port : Word; P : Pointer) : LongInt;
  external LibName;

FUNCTION pmbsSetFree(Port : Word; Freiraum : LongInt) : LongInt;
  external LibName;

FUNCTION pmbsGetLevel(Port : Word; P : Pointer) : LongInt;
  external LibName;

FUNCTION pmbspcSend;
VAR
  Puffer : PChar;
BEGIN
  GetMem(Puffer, Length(Str)+1);
  StrPCopy(Puffer, Str);
  pmbsSend(Port, Puffer);
  FreeMem(Puffer, Length(Str)+1);
END;

FUNCTION pmbspcQuit;
BEGIN
  pmbsQuit(Port);
END; 

FUNCTION pmbspcMemory;
BEGIN
  pmbsMemory(pmbspcMemory);
END;

FUNCTION pmbspcRead;
VAR
  Puffer  : PChar;
  Puffer2 : PChar;
BEGIN
  GetMem(Puffer, Anzahl+1);
  GetMem(Puffer2, Length(Vorgabe)+1);
  StrPCopy(Puffer2, Vorgabe); 
  pmbsRead(Port, Puffer2, Anzahl, Puffer);
  pmbspcRead := StrPas(Puffer);
  FreeMem(Puffer, Anzahl+1);
  FreeMem(Puffer2, Length(Vorgabe)+1);
END;

FUNCTION pmbspcBRead;
VAR
  Puffer  : PChar;
  Puffer2 : PChar;
BEGIN
  GetMem(Puffer, Anzahl+1);
  GetMem(Puffer2, Length(Vorgabe)+1);
  StrPCopy(Puffer2, Vorgabe); 
  pmbsBRead(Port, Puffer2, Anzahl, Puffer);
  pmbspcBRead := StrPas(Puffer);
  FreeMem(Puffer, Anzahl+1);
  FreeMem(Puffer2, Length(Vorgabe)+1);
END;

FUNCTION pmbspcGetDir;
VAR
  Puffer : PChar;
BEGIN
  GetMem(Puffer, 100);
  pmbsGetDir(Puffer);
  pmbspcGetDir := StrPas(Puffer);
  FreeMem(Puffer, 100);
END;

FUNCTION pmbspcGetNetDir;
VAR
  Puffer : PChar;
BEGIN
  GetMem(Puffer, 100);
  pmbsGetNetDir(Puffer);
  pmbspcGetNetDir := StrPas(Puffer);
  FreeMem(Puffer, 100);
END;

FUNCTION pmbspcGetUser;
VAR
  Puffer : PChar;
BEGIN
  GetMem(Puffer, 25);
  pmbsGetUser(Port, Puffer);
  pmbspcGetUser := StrPas(Puffer);
  FreeMem(Puffer, 25);
END;

FUNCTION pmbspcGetUserDos;
VAR
  Puffer : PChar;
BEGIN
  GetMem(Puffer, 10);
  pmbsGetUserDos(Port, Puffer);
  pmbspcGetUserDos := StrPas(Puffer);
  FreeMem(Puffer, 10);
END;

FUNCTION pmbspcGetBox;
VAR
  Puffer : PChar;
BEGIN
  GetMem(Puffer, 25);
  pmbsGetBox(Port, Puffer);
  pmbspcGetBox := StrPas(Puffer);
  FreeMem(Puffer, 25);
END;

FUNCTION pmbspcCheckCarrier;
VAR
  p : Pointer;
  b : Byte;
BEGIN
  GetMem(p, 5);
  pmbsCheckCarrier(Port, p);
  Move(p^, b, 1);
  FreeMem(p, 5);
  pmbspcCheckCarrier := b = 1;
END;

FUNCTION pmbspcGetChar;
VAR
  p : Pointer;
  b : Char;
BEGIN
  GetMem(p, 5);
  pmbsGetChar(Port, p);
  Move(p^, b, 1);
  FreeMem(p, 5);
  pmbspcGetChar := b;
END;

FUNCTION pmbspcSendFile;
VAR
  p      : Pointer;
  Puffer : PChar;
  b      : Byte;
BEGIN
  GetMem(p, 5);
  GetMem(Puffer, Length(Datei)+1);
  StrPCopy(Puffer, Datei);
  pmbsSendFile(Port, Puffer, p);
  Move(p^, b, 1);
  FreeMem(p, 5);
  FreeMem(Puffer, Length(Datei)+1);
  pmbspcSendFile := b = 0;
END;

FUNCTION pmbspcReceiveFile;
VAR
  p : Pointer;
  b : Byte;
BEGIN
  GetMem(p, 5);
  pmbsReceiveFile(Port, p);
  Move(p^, b, 1);
  FreeMem(p, 5);
  pmbspcReceiveFile := b = 0;
END;

FUNCTION pmbspcGetPoint;
VAR
  Puffer : PChar;
BEGIN
  GetMem(Puffer, 25);
  pmbsGetPoint(Port, Puffer);
  pmbspcGetPoint := StrPas(Puffer);
  FreeMem(Puffer, 25);
END;

FUNCTION pmbspcGetFree;
VAR
  p : Pointer;
  b : Byte;
BEGIN
  GetMem(p, 5);
  pmbsGetFree(Port, p);
  Move(p^, b, 1);
  FreeMem(p, 5);
  pmbspcGetFree := b;
END;

FUNCTION pmbspcSetFree;
BEGIN
  pmbsSetFree(Port, Freiraum);
END;

FUNCTION pmbspcGetLevel;
VAR
  p : Pointer;
  b : Byte;
BEGIN
  GetMem(p, 5);
  pmbsGetLevel(Port, p);
  Move(p^, b, 1);
  FreeMem(p, 5);
  pmbspcGetLevel := b;
END;

FUNCTION pmbspcChoose;
VAR
  Os          : PChar;
  Taste       : LongInt;
  akt_ShowBtn : Byte;
  akt_Btn     : Byte;
  max_Btn     : Byte;
  x           : Byte;
  Cnt         : Byte;
BEGIN
  GetMem(Os, 6);
  Taste   := 1;
  max_Btn := 1;
  akt_Btn := Vorgabe;
  FOR x := 1 TO Length(Auswahl) DO
    IF Auswahl[x] = '|' THEN
      Inc(max_Btn);
  pmbsSend(Port, #27+'[s');
  pmbsSend(Port, #27+'[1;37;40m');
  REPEAT
    IF Taste IN [1, 48..57, 65..90, 97..122, cur_Left, cur_Right] THEN
    BEGIN
      IF Taste <> 1 THEN
      BEGIN
        pmbspcSend(Port, #27+'[u');
        pmbsSend(Port, Os);
      END;
      akt_ShowBtn := 1;
      IF akt_Btn = akt_ShowBtn THEN
        pmbsSend(Port, #27+'[44m')
      ELSE
        pmbsSend(Port, #27+'[40m');
      IF NOT pmbspcCheckCarrier(Port) THEN
      BEGIN
        pmbspcChoose := 1;
        Exit;
      END;
      FOR x := 1 TO Length(Auswahl) DO
      BEGIN
        CASE Auswahl[x] OF
          '<' : BEGIN
                  IF akt_Btn = akt_ShowBtn THEN
                    pmbsSend(Port, #27+'[1;37;44m');
                  StrPCopy(Os, Auswahl[x]);
                  pmbsSend(Port, Os);
                  IF akt_Btn = akt_ShowBtn THEN
                    pmbsSend(Port, #27+'[0;31;44m')
                  ELSE
                    pmbsSend(Port, #27+'[0;31;40m');
                END;
          ')' : BEGIN
                  IF akt_Btn = akt_ShowBtn THEN
                    pmbsSend(Port, #27+'[1;37;44m')
                  ELSE
                    pmbsSend(Port, #27+'[1;37;40m');
                  StrPCopy(Os, Auswahl[x]);
                  pmbsSend(Port, Os);
                END;
          '>' : BEGIN
                  StrPCopy(Os, Auswahl[x]);
                  pmbsSend(Port, Os);
                  IF akt_Btn = akt_ShowBtn THEN
                    pmbsSend(Port, #27+'[40m');
                END;
          '|' : BEGIN
                  pmbsSend(Port, #32);
                  Inc(akt_ShowBtn);
                END;
        ELSE
          BEGIN
            StrPCopy(Os, Auswahl[x]);
            pmbsSend(Port, Os);
          END;
        END;
      END;
      pmbsSend(Port, #27+'[1;37;40m');
    END;
    IF NOT pmbspcCheckCarrier(Port) THEN
    BEGIN
      pmbspcChoose := 1;
      Exit;
    END;
    Taste := Ord(pmbspcGetChar(Port));
    IF NOT pmbspcCheckCarrier(Port) THEN
    BEGIN
      pmbspcChoose := 1;
      Exit;
    END;
    CASE Taste OF
      cur_Left  : IF akt_Btn > 1 THEN
                    Dec(akt_Btn)
                  ELSE
                    akt_Btn := max_Btn;   
      Cur_Right : IF akt_Btn < max_Btn THEN
                    Inc(akt_Btn)
                  ELSE
                    akt_Btn := 1;
    ELSE
      BEGIN
        IF Taste IN [48..57, 65..90, 97..122] THEN
        BEGIN
          Cnt := 1;
          x := 0;
          REPEAT
            Inc(x);
            CASE Auswahl[x] OF
              '<' : BEGIN
                      Inc(x);
                      IF UpCase(Auswahl[x]) = UpCase(Chr(Taste)) THEN
                      BEGIN
                        akt_Btn := Cnt;
                        x       := Length(Auswahl);
                        taste   := 13;
                      END;
                    END;
              '|' : Inc(Cnt);
            END;
          UNTIL x = Length(Auswahl);
        END;
      END;
    END;
  UNTIL taste = 13;
  FreeMem(Os, 6);
  pmbspcChoose := akt_Btn;
END;

FUNCTION pmbspcGetNum;
VAR
  Taste  : LongInt;
  Os     : PChar;

  FUNCTION Convert_Length(s : STRING) : STRING;
  VAR
    x : Byte;
  BEGIN
    FOR x := Length(IntToStr(Def))+1 TO Length(IntToStr(max)) Do
      s := '0' + s;
    Convert_Length := s;
  END;

BEGIN
  GetMem(Os, 200);
  Taste := 1;
  pmbsSend(Port, #27+'[s');
  REPEAT
    IF Taste IN [1, 43, 45, cur_Up, cur_Down]  THEN
    BEGIN
      IF Taste <> 1 THEN
      BEGIN
        pmbsSend(Port, #27+'[u');
        pmbsSend(Port, Os);
      END;
      StrPCopy(Os, #27+'[37;44m'+Convert_Length(IntToStr(Def))+#27+'[37;40m');
      pmbsSend(Port, Os);
      IF NOT pmbspcCheckCarrier(Port) THEN
      BEGIN
        pmbspcGetNum := min;
        Exit;
      END;
    END;
    Taste := Ord(pmbspcGetChar(Port));
    IF NOT pmbspcCheckCarrier(Port) THEN
    BEGIN
      pmbspcGetNum := min;
      Exit;
    END;
    Case Taste OF
      cur_Up, 43   : IF Def < max THEN
                       Inc(Def)
                     ELSE
                       Def := min;
      cur_Down, 45 : IF Def > min THEN
                       Dec(Def)
                     ELSE
                       Def := max;
    END;
  UNTIL Taste = 13;
  FreeMem(Os, 200);
  pmbspcGetNum := Def;
END;

FUNCTION pmbspcWaitForKey;
VAR
  Puffer : PChar;
BEGIN
  pmbsSend(Port, #27+'[0;36;40m<'+#27+'[1;37;40mTaste'+#27+'[0;36;40m>'+#27+'[0;37;40m');
  GetMem(Puffer, 2);
  pmbsRead(Port, #0, 0, Puffer);
  FreeMem(Puffer, 2);
END;

END.