home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 364b.lha / PCQ_v1.1 / Runtime / Extras / CRT.p < prev    next >
Encoding:
Text File  |  1990-04-08  |  2.7 KB  |  119 lines
  1. External;
  2.  
  3. {
  4.     CRT.p
  5.  
  6.     These routines are a simple attempt to mimic the Turbo Pascal
  7.     CRT routines.  See ConsoleTest.p for an example of using these.
  8. }
  9.  
  10. {$I "Include/ConsoleIO.i"}
  11. {$I "Include/ExecIOUtils.i"}
  12. {$I "Include/Intuition.i"}
  13.  
  14. TYPE
  15.     ConsoleSet = record
  16.              WritePort,
  17.              ReadPort    : MsgPortPtr;
  18.              WriteRequest,
  19.              ReadRequest : IOStdReqPtr;
  20.              Window    : WindowPtr; { not yet used }
  21.              Buffer    : Char;
  22.          end;
  23.     ConsoleSetPtr = ^ConsoleSet;
  24.  
  25. Procedure CleanSet(con : ConsoleSetPtr);
  26. begin
  27.     with con^ do begin
  28.     if ReadRequest <> Nil then
  29.         DeleteStdIO(ReadRequest);
  30.     if WriteRequest <> Nil then
  31.         DeleteStdIO(WriteRequest);
  32.     if ReadPort <> Nil then
  33.         DeletePort(ReadPort);
  34.     if WritePort <> Nil then
  35.         DeletePort(WritePort);
  36.     end;
  37. end;
  38.  
  39. Function AttachConsole(w : WindowPtr) : ConsoleSetPtr;
  40. var
  41.     con : ConsoleSetPtr;
  42.     Error : Boolean;
  43. begin
  44.     New(con);
  45.     if con = Nil then
  46.     AttachConsole := Nil;
  47.     with Con^ do begin
  48.     WritePort := CreatePort(Nil, 0);
  49.     Error := WritePort = Nil;
  50.     ReadPort  := CreatePort(Nil, 0);
  51.     Error := Error or (ReadPort = Nil);
  52.     if not Error then begin
  53.         WriteRequest := CreateStdIO(WritePort);
  54.         Error := Error or (WriteRequest = Nil);
  55.         ReadRequest := CreateStdIO(ReadPort);
  56.         Error := Error or (ReadRequest = Nil);
  57.     end;
  58.     if Error then begin
  59.         CleanSet(con);
  60.         Dispose(con);
  61.         AttachConsole := Nil;
  62.     end;
  63.     Window := w;
  64.     end;
  65.     with con^.WriteRequest^ do begin
  66.     ioData := Address(w);
  67.     ioLength := SizeOf(Window);
  68.     end;
  69.     Error := OpenDevice("console.device", 0,
  70.             IORequestPtr(con^.WriteRequest), 0) <> 0;
  71.     if Error then begin
  72.     CleanSet(con);
  73.     Dispose(con);
  74.     AttachConsole := Nil;
  75.     end;
  76.     with con^ do begin
  77.     ReadRequest^.ioReq.ioDevice := WriteRequest^.ioReq.ioDevice;
  78.     ReadRequest^.ioReq.ioUnit := WriteRequest^.ioReq.ioUnit;
  79.     end;
  80.     QueueRead(con^.ReadRequest, Adr(con^.Buffer));
  81.     AttachConsole := Con;
  82. end;
  83.  
  84. Function ReadKey(con : ConsoleSetPtr) : Char;
  85. begin
  86.     with con^ do
  87.     ReadKey := ConGetChar(ReadPort, ReadRequest, Adr(Buffer));
  88. end;
  89.  
  90. Function KeyPressed(con : ConsoleSetPtr) : Boolean;
  91. begin
  92.     with con^ do
  93.     KeyPressed := CheckIO(IORequestPtr(ReadRequest)) <> Nil;
  94. end;
  95.  
  96. Procedure WriteString(con : ConsoleSetPtr; Str : String);
  97. begin
  98.     ConPutStr(con^.WriteRequest, Str);
  99. end;
  100.  
  101. Procedure DetachConsole(con : ConsoleSetPtr);
  102. var
  103.     TempMsg : MessagePtr;
  104. begin
  105.     with con^ do begin
  106.     Forbid;
  107.     if CheckIO(IORequestPtr(ReadRequest)) = Nil then begin
  108.         AbortIO(IORequestPtr(ReadRequest));
  109.         Permit;
  110.         TempMsg := WaitPort(ReadPort);
  111.         TempMsg := GetMsg(ReadPort);
  112.     end else
  113.         Permit;
  114.     CloseDevice(IORequestPtr(WriteRequest));
  115.     end;
  116.     CleanSet(con);
  117.     Dispose(con);
  118. end;
  119.