home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 2.ddi / XPOLLING.PRO < prev    next >
Encoding:
Text File  |  1987-03-23  |  2.7 KB  |  92 lines
  1. /****************************************************************
  2.  
  3.      Turbo Prolog Toolbox
  4.      (C) Copyright 1987 Borland International.
  5.  
  6.     Demo of polled transmission with 'time out'
  7. ****************************************************************/
  8.  
  9. Project "xpolling"
  10.  
  11. DOMAINS
  12.   FILE = df
  13.  
  14. include "tdoms.pro"
  15. include "comglobs.pro"
  16. include "tpreds.pro"
  17. include "menu.pro"
  18.  
  19. PREDICATES
  20.   send_str(STRING)
  21.   send_ch_CRLF(CHAR,INTEGER)
  22.   send_ch(CHAR,INTEGER)
  23.   receive_str()
  24.   receive_ch(CHAR,INTEGER)
  25.   wait_ok(INTEGER,INTEGER,INTEGER)
  26.   tx_status(INTEGER)
  27.   check_status(INTEGER,INTEGER,STRING)
  28.  
  29. GOAL
  30.     openRS232(1,256,256,7,0,3,0,2),
  31.     makewindow(3,7,7,"Output Window",0,0,10,80),
  32.     send_str("Hello to all our readers.\n"),
  33.     write("Press any key"),
  34.     readchar(_),
  35.     closeRS232(1).
  36.  
  37. CLAUSES
  38.   /* Transmit a string  */
  39.   send_str(""):-!.
  40.   send_str(S):-frontchar(S,CH,S2),
  41.          write(CH), send_ch_CRLF(CH,50),
  42.              send_str(S2).
  43.  
  44.   send_ch_CRLF('\10',I):-!,send_ch('\13',I), send_ch('\10',I).
  45.   send_ch_CRLF(CH,I):-send_ch(CH,I).
  46.  
  47.   send_ch(CH,_):-txch_RS232(1,CH),!.
  48.   send_ch(CH,I):-
  49.     status_RS232(1,Status),!,
  50.     wait_ok(Status,I,I2), send_ch(CH,I2).
  51.  
  52.   /* Receive a string and copy it to a file */
  53.   receive_str():-
  54.     receive_ch(CH,50),!,
  55.     write(CH),
  56.     writedevice(FP), writedevice(df), write(CH), writedevice(FP),
  57.       receive_str().
  58.   receive_str().
  59.  
  60.   receive_ch(CH,_):-rxch_RS232(1,CH), CH<>'\013', !.
  61.   receive_ch(CH,_):-rxch_RS232(1,CH), !.
  62.   receive_ch(CH,I):-
  63.     status_RS232(1,Status), !,
  64.     wait_ok(Status,I,I2), receive_ch(CH,I2).
  65.  
  66.   /* Time out */
  67.   wait_ok(_,I,I2):-I > 0, I2=I-1,ticks(10),!.
  68.   wait_ok(Status,_,50):-tx_status(Status).
  69.  
  70.   /* De-mask status value */
  71.   tx_status(0):-!.
  72.   tx_status(Status):-
  73.       shiftwindow(WD), shiftwindow(1),
  74.       check_status(Status,1, "Input Characters have been lost"),
  75.       check_status(Status,2,  "Parity Error"),
  76.       check_status(Status,4,  "Overrun detected"),
  77.       check_status(Status,8,  "Framing error detected"),
  78.       check_status(Status,16, "Break signal detected"),
  79.       check_status(Status,32, "An Xoff has been received"),
  80.       check_status(Status,64, "An Xon has been received"),
  81.       check_status(Status,128,"An Xoff has been transmitted"),
  82.       check_status(Status,256,"An Xon has been transmitted"),
  83.       check_status(Status,512,"Input buffer empty when attempt to read"),
  84.       check_status(Status,1024,"Output buffer full when attempt to write"),
  85.       write("\nPress Space to continue or Esc to abort"), readchar(Ch),
  86.       shiftwindow(2), shiftwindow(3),
  87.       shiftwindow(WD),CH<>'\27'.
  88.  
  89.   check_status(Status,BitMask,Mess):-
  90.       bitand(Status,BitMask,V), V<>0, !, nl, write(Mess).
  91.   check_status(_,_,_).
  92.