{---------
URQ-interpreter.  ver0.0.7
programming by arT (c).
e-mail: IronWoodcutter@bk.ru
    GNU General Public License.


  :

1.           -
         ,
        .
2.     ,    
   .
---------}

{TURBO PASCAL 7.1 - DELPHI 7.0}
{$A-,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T+,V+,X+}
{ $M 16384,0,655360}
{$APPTYPE CONSOLE}
uses windows, mmsystem; //crt;

{var flog : text; debug : boolean;
procedure outlog(s:string);
begin
  system.write(flog,s+#13#10);
  flush(flog);
end;{}

function inttostr(i : integer) : string;
var
  s : string;
begin
  str(i,s);
  inttostr:=s;
end;


{=========================== MUSIC LIB ===========================}
var
  wDeviceID      : Word;

procedure playwav(name : string);
begin
  playSound(pchar(name),0, SND_ASYNC {SND_SYNC or SND_LOOP{});
end;


procedure playmidi(name : string;  onoff : boolean);
var
  dwReturn       : DWord;
  mciOpenParms   : MCI_OPEN_PARMS;
  mciPlayParms   : MCI_PLAY_PARMS;
  mciStatusParms : MCI_STATUS_PARMS;
  mciSeqSetParms : MCI_SEQ_SET_PARMS;
begin
  if onoff=true then
  begin
    {Open the device by specifying the device and filename. MCI will attempt to choose the MIDI mapper as the output port.}
    mciOpenParms.lpstrDeviceType := 'sequencer';
    mciOpenParms.lpstrElementName := pchar(name);   //'music.mid';
    dwReturn := mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE OR MCI_OPEN_ELEMENT, Longint(@mciOpenParms));
    if dwReturn = 0 then
    begin
      onoff:=false;
      wDeviceID := mciOpenParms.wDeviceID;           {The device opened successfully; get the device ID.}
      mciStatusParms.dwItem := MCI_SEQ_STATUS_PORT;  {Check if the output port is the MIDI mapper.}
      dwReturn := mciSendCommand(wDeviceID, MCI_STATUS, MCI_STATUS_ITEM, Longint(@mciStatusParms));
      if dwReturn = 0 then
      begin
        {The output port is not the MIDI mapper. Ask if the user wants to continue.}
        if LOWORD(mciStatusParms.dwReturn) = Word(MIDI_MAPPER) then
        begin
          {Begin playback. The window procedure function for the parent window will be notified
          with an MM_MCINOTIFY message when playback is complete. At this time, the window procedure closes the device.}
          dwReturn := mciSendCommand(wDeviceID, MCI_PLAY, MCI_NOTIFY, Longint(@mciPlayParms));
          if dwReturn = 0 then onoff:=true;
        end
      end
    end;
  end;
  if onoff=false then mciSendCommand(wDeviceID, MCI_CLOSE, 0, 0);
End;

{========================= DOS CRT LIB =========================}
var
  inpHnd, outHnd : THandle;  // /
  textAttr : byte;   //    
//consoleScreenRect: TSmallRect;


procedure consoleproc(SysEv : Cardinal);
//  
begin
  case SysEv of
    CTRL_C_EVENT       : begin end;  //   Ctrl+C
    CTRL_BREAK_EVENT   : begin end;  //   Ctrl+Break
    CTRL_CLOSE_EVENT   : begin end;  //    
    CTRL_LOGOFF_EVENT  : begin end;  //    
    CTRL_SHUTDOWN_EVENT: begin end;  //   
  end;
end;


procedure init;
//   
begin
  {  /}
  inpHnd := getStdHandle(STD_INPUT_HANDLE);
  outHnd := getStdHandle(STD_OUTPUT_HANDLE);
  setConsoleCtrlHandler(@consoleproc, true);  {    }
  setConsoleTitle('AURQ');    { }
  flushConsoleInputBuffer(inpHnd);  {  }
  //setConsoleMode(inpHnd, 0); {  ,  Ctrl+C    }
  //setConsoleMode(inpHnd, ENABLE_PROCESSED_INPUT+ENABLE_MOUSE_INPUT); { ,    Ctrl+C}
end;

{---------------------------------------------------}
procedure cursor(b : Boolean);
/// 
var
  CCI : _CONSOLE_CURSOR_INFO;
begin
  getConsoleCursorInfo(outHnd, CCI);
  CCI.bVisible := b;
  setConsoleCursorInfo(outHnd, CCI);
end;


function wherey : integer;
var {wAttributes -  ; dwCursorPosition.x  dwCursorPosition.y -  }
  scrBufInfo : TConsoleScreenBufferInfo;  {  }
  n : integer;
begin
  getConsoleScreenBufferInfo(outHnd, scrBufInfo);
  n:=integer(scrBufInfo.dwCursorPosition.Y)+1;
  whereY := n;
end;


procedure gotoxy(x,y : integer);
var
  poscursor : _COORD;  //   
begin
  poscursor.X := x-1;
  poscursor.Y := y-1;
  setConsoleCursorPosition(outHnd, poscursor);
end;

{procedure window(X1, Y1, X2, Y2: Byte);
begin
consoleScreenRect.Left := X1 - 1;
consoleScreenRect.Top := Y1 - 1;
consoleScreenRect.Right := X2 - 1;
consoleScreenRect.Bottom := Y2 - 1;
//windMin := (ConsoleScreenRect.Top shl 8) or ConsoleScreenRect.Left;
//windMax := (ConsoleScreenRect.Bottom shl 8) or ConsoleScreenRect.Right;
setConsoleWindowInfo(outHnd, true, ConsoleScreenRect);
gotoxy(1,1);
end;{}

procedure clrScr;
const  {    }
  UpperLeft : _COORD = (X:0; Y:0);
var
  scrBufInfo : TConsoleScreenBufferInfo;  {  }
  {ScrBufInfo.dwCursorPosition.x  ScrBufInfo.dwCursorPosition.y -  }
  {ScrBufInfo.wAttributes -  }
  fillSize   : DWord;         { }
begin
  gotoxy(1,1);
  setConsoleTextAttribute(outHnd, textAttr); {  }
  getConsoleScreenBufferInfo(outHnd, scrBufInfo);
  fillSize := scrBufInfo.dwSize.x*scrBufInfo.dwSize.y;
  fillConsoleOutputCharacter(outHnd, #32, FillSize, UpperLeft, FillSize);
  fillConsoleOutputAttribute(outHnd, scrBufInfo.wAttributes, FillSize, UpperLeft, FillSize);
end;


function getkey : char;
var    {   ;   ,   }
  IR      : INPUT_RECORD;
  countWr : DWORD;
  a       : char;
begin
  getkey := #0;
  getNumberOfConsoleInputEvents(InpHnd, CountWr);//   
  if countWr > 0 then                            //  :  
  begin
    readConsoleInput(InpHnd, IR, 1, countWr);    //     IR
    case IR.EventType of                         //   
     KEY_EVENT : begin                           //  :
                   if IR.Event.KeyEvent.bKeyDown then  //   
                   begin
                     a := IR.Event.KeyEvent.AsciiChar; //     ""
                     if a > #0 then  getkey := a       //   
                      else                                        //  :
                       case IR.Event.KeyEvent.wVirtualKeyCode of  //    
                         VK_UP   : getkey := #72;   {dos up key}
                         VK_DOWN : getkey := #80;   {dos down key}
                         else      getkey := char(IR.Event.KeyEvent.wVirtualKeyCode);
                       end;
                   end;
                 end;
    _MOUSE_EVENT : begin end;    //  
    end;
  end;
end;


function rus(s : string) : string;
var    {   Windows  DOS-}
  i : integer;
  b : byte;
begin
  for i := 1 to length(s) do
  begin
    b := byte(s[i]);
    case b of
     192..239 : s[i]:=char(b-64);
     240..255 : s[i]:=char(b-16);
    end;
  end;
  rus := s;
end;


procedure write(s : string);
Var CountWr : DWORD;
begin
  //s:=Rus(s);
  SetConsoleTextAttribute(outHnd, textAttr);
  if s<>'' then WriteConsole(outHnd, @s[1], Length(s), CountWr, nil);
  //system.Write(s);
end;


procedure writeln(s : string);
begin
  write(s+#13#10);
end;
{====================== DOS CRT LIB - END ======================}


const {     URQ}
  _numb    = 1;    { }
