home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / UTILS / MCMF10 / MCMF.OPL < prev    next >
Encoding:
Text File  |  1995-03-09  |  7.7 KB  |  434 lines
  1. PROC Main:
  2.  
  3. global tone%,delay%,pause%,mode%,vol%
  4. global tone$(2),delay$(2),pause$(2),mode$(2),vol$(1)
  5.  
  6. local  ret%,sndHand%
  7. local  ref%,digit$(32),p%
  8.  
  9. screen 60,20
  10.  
  11. tone$="6" :delay$="2" :pause$="24" :mode$="-1" :vol$="2"
  12. tone%=6 :delay%=2 :pause%=24 :mode%=-1 :vol%=2
  13.  
  14. if not exist ("mcmf.def")
  15.     create "mcmf.def",a,mode%,tone%,delay%,pause%,vol%
  16.     a.mode%=mode%
  17.     a.tone%=tone%
  18.     a.delay%=delay%
  19.     a.pause%=pause%
  20.     a.vol%=vol%
  21.     append
  22.     close
  23.     updte:
  24. else
  25.     trap openr "mcmf.def",a,mode%,tone%,delay%,pause%,vol%
  26.     if err
  27.         showerr:(err)
  28.     else
  29.         mode%=a.mode%
  30.         tone%=a.tone%
  31.         delay%=a.delay%
  32.         pause%=a.pause%
  33.         vol%=a.vol%
  34.     endif
  35.     trap close
  36. endif
  37.  
  38. drwscrn:
  39.  
  40. do
  41.     at 1,9
  42.     print " ->",
  43.     if mode%
  44.         edit digit$
  45.     else
  46.         digit$=get$
  47.     endif
  48.     digit$=upper$(digit$)
  49.     if digit$="U"
  50.         updte:
  51.         drwscrn:
  52.         digit$=""
  53.     elseif digit$="L"
  54.         if mode%
  55.             digit$=strip$:(bring$:)
  56.         else
  57.             digit$=""
  58.         endif
  59.     elseif digit$="M"
  60.         mode%=not mode%
  61.         trap open "mcmf.def",a,mode%,tone%,delay%,pause%
  62.         if err
  63.             showerr:(err)
  64.         else
  65.             a.mode%=mode%
  66.             update
  67.         endif
  68.         trap close
  69.         drwscrn:
  70.         digit$=""
  71.     elseif digit$<>"X" and digit$<>""
  72.         ret%=IOOPEN(sndHand%,"SND:",-1)
  73.         if ret%<0
  74.             print "Failed to open SND: device"
  75.             print err$(err)
  76.             get
  77.         else
  78.             p%=1
  79.             do
  80.                 ref%=loc("123A456B789C*0#D,",mid$(digit$,p%,1))
  81.                 if ref%
  82.                     if not mode%
  83.                         print digit$;
  84.                     endif
  85.                     dtmf:(sndHand%,ref%)
  86.                     if mode%
  87.                         pause delay%
  88.                     endif
  89.                     p%=p%+1
  90.                 else
  91.                     digit$=left$(digit$,p%-1)+right$(digit$,len(digit$)-p%)
  92.                 endif
  93.             until p%>len(digit$)
  94.             ioclose(sndHand%)
  95.             if not mode%
  96.                 digit$=""
  97.             endif
  98.         endif
  99.     endif
  100. until digit$="X"
  101.  
  102. ENDP
  103.  
  104.  
  105. PROC Dtmf:(sndHand%,ref%)
  106.  
  107. local freq1%(17),freq2%(17),play1%(2),play2%(2)
  108. local ret%,s1stat%,count%,len1%,len2%,cfg%
  109.  
  110. rem define High group of MF freqs
  111.  
  112. freq1%(1)=1209
  113. freq1%(2)=1336
  114. freq1%(3)=1477
  115. freq1%(4)=1632
  116. freq1%(5)=1209
  117. freq1%(6)=1336
  118. freq1%(7)=1477
  119. freq1%(8)=1632
  120. freq1%(9)=1209
  121. freq1%(10)=1336
  122. freq1%(11)=1477
  123. freq1%(12)=1632
  124. freq1%(13)=1209
  125. freq1%(14)=1336
  126. freq1%(15)=1477
  127. freq1%(16)=1632
  128. freq1%(17)=0     rem freq of "pause", i.e. silence
  129. len1%=1          rem number of notes in freq 1
  130.  
  131. rem define low group of MF freqs
  132.   
  133. freq2%(1)=697
  134. freq2%(2)=697
  135. freq2%(3)=697
  136. freq2%(4)=697
  137. freq2%(5)=770
  138. freq2%(6)=770
  139. freq2%(7)=770
  140. freq2%(8)=770
  141. freq2%(9)=852
  142. freq2%(10)=852
  143. freq2%(11)=852
  144. freq2%(12)=852
  145. freq2%(13)=941
  146. freq2%(14)=941
  147. freq2%(15)=941
  148. freq2%(16)=941
  149. freq2%(17)=0    rem freq of "pause" i.e. silence
  150. len2%=1         rem number of notes in freq 2
  151.  
  152. play1%(1)=freq1%(ref%) :play1%(2)=tone%
  153. play2%(1)=freq2%(ref%) :play2%(2)=tone%
  154.  
  155. if ref%>16      rem i.e "pause"
  156.     play1%(2)=pause%
  157.     play2%(2)=pause%
  158. endif
  159.  
  160. rem Set volume & bpm
  161.  
  162. rem cfg%=6-vol%*2 rem for Series 3/3a
  163. cfg%=7-vol%*2
  164. if cfg%>2
  165.     cfg%=cfg%-1
  166. endif
  167. cfg%=$0100*cfg% + $00F0
  168. IOW(sndHand%,7,cfg%,#0)
  169.  
  170. rem voice 1 asynchronous
  171.  
  172. ret%=IOA(sndhand%,1,s1stat%,play1%(),len1%)
  173. if ret%<0
  174.     if ret%=-46
  175.         raise -1
  176.     endif
  177.     s1stat%=ret%
  178.     iosignal
  179. endif
  180.  
  181. rem voice 2 synchronous
  182.  
  183. IOW(sndHand%,2,play2%(),len2%)
  184.  
  185. while s1stat%=-46     rem i.e. not finished
  186.     IOWAIT              rem wait for signal
  187.     if s1stat%=-46      rem not ours
  188.         count%=count%+1   rem so count up stray signals
  189.     endif
  190. endwh
  191.  
  192. rem Put back all stray signals
  193. while count%
  194.     iosignal
  195.     count%=count%-1
  196. endwh
  197.  
  198. ENDP
  199.  
  200.  
  201. PROC updte:
  202.  
  203. trap open "mcmf.def",a,mode%,tone%,delay%,pause%,vol%
  204. if err
  205.     showerr:(err)
  206. else
  207.     tone$=gen$(a.tone%,2)
  208.     delay$=gen$(int(flt(a.delay%)/20*24),2)
  209.     pause$=gen$(a.pause%,2)
  210.     vol$=gen$(a.vol%,1)
  211.     print "       --- Set MCMF Defaults ---"
  212.     print
  213.     print"    (All times in 1/24ths of a second)"
  214.     print
  215.     print "Tone time: ",
  216.     tone%=check%:(tone$)
  217.     print "Delay time:",
  218.     delay%=check%:(delay$)
  219.     print "Pause time:",
  220.     pause%=check%:(pause$)
  221.     print "Tone Volume (1=Quiet, 2=Medium, 3=Loud):",
  222.     vol%=check%:(vol$)
  223.     if tone%<1
  224.         tone%=1
  225.     endif
  226.     if delay%<1
  227.         delay%=1
  228.     endif
  229.     if pause%<1
  230.         pause%=1
  231.     endif
  232.     if vol%<1
  233.         vol%=1
  234.     elseif vol%>3
  235.         vol%=3
  236.     endif
  237.     a.tone%=tone%
  238.     a.delay%=val(fix$(flt(delay%)/24*20,0,2))
  239.     a.pause%=pause%
  240.     a.vol%=vol%
  241.     update
  242.     close
  243. endif
  244.  
  245. ENDP
  246.  
  247.  
  248. PROC Showerr:(e%)
  249.  
  250. print err$(e%)
  251. print
  252. print "Press any key to continue..."
  253. get
  254.  
  255. ENDP
  256.  
  257.  
  258. PROC Check%:(test$)
  259.  
  260. local c%,good%,check$(2),ret%
  261.  
  262. check$=test$
  263. do
  264.     edit check$
  265.     c%=1 :good%=0
  266.     if check$<>""
  267.         do
  268.             good%=loc("1234567890",mid$(check$,c%,1))
  269.             c%=c%+1
  270.         until c%>len(check$) or good%<1
  271.     else
  272.         good%=0
  273.     endif
  274.     if good%
  275.         ret%=val(check$)
  276.     else
  277.         beep 5,300
  278.         print "Please Re-enter:",
  279.     endif
  280. until good%
  281. return ret%
  282.  
  283. ENDP
  284.  
  285.  
  286. PROC Drwscrn:
  287. cls
  288. at 1,2
  289. print "            --- MC-400 DTMF Dialler V1.0 ---"
  290. at 1,4
  291. if mode%
  292.     print "          Input No. to be dialled then <Enter>"
  293. else
  294.     print "                 Free form dialling mode"
  295. endif
  296. at 1,6
  297. if mode%
  298.     print "  (""U <Enter>"" changes defaults, ""X <Enter>"" exits)"
  299.     print " (""L <Enter>"" brings data, ""M <Enter>"" changes mode)"
  300. else
  301.     print "           (""U"" changes defaults, ""X"" exits)"
  302.     print "                   (""M"" changes mode)"
  303. endif
  304.  
  305. ENDP
  306.  
  307.  
  308. PROC Strip$:(test$)
  309.  
  310. local f%,l%,temp$(255)
  311.  
  312. temp$=test$
  313. l%=1
  314. do
  315.     f%=loc("123A456B789C*0#D,",mid$(temp$,l%,1))
  316.     if f%
  317.         l%=l%+1
  318.     else
  319.         temp$=left$(temp$,l%-1)+right$(temp$,len(temp$)-l%)
  320.     endif
  321. until l%>len(temp$)
  322.  
  323. return upper$(left$(temp$,32))
  324.  
  325. ENDP
  326.  
  327.  
  328. rem The following code is based on "LPC.OPL"
  329. rem (Original code written by Colly Myers)
  330. rem (Translated into OPL by Tom Dolbilin)
  331.  
  332. PROC Bring$:
  333.  
  334. global srvPid%      rem PID of Link server
  335. global buf$(255)    rem Buffer to receive data
  336. global ioSem%       rem The I/O semaphore handle
  337.  
  338. local wsrvPid%      rem PID of Window server
  339. local fmt&          rem Message buffer
  340. local pfmt%         rem Pointer to message buffer
  341.  
  342. local name$(15),form%(3),n%,ret%,ret$(255)
  343. local w%(2)
  344.  
  345. rem --- Get Shell's pid
  346.  
  347. rem Note: on the MC, SYS$SHLL.IMG holds Link server data
  348. rem on the Series 3/3a SYS$WSRV.IMG holds Link Server data
  349. rem change name$ to "SYS$WSRV.*" for Series 3/3a
  350.  
  351. name$="SYS$SHLL.*"
  352. wsrvPid%=call($188,addr(name$)+1)
  353.  
  354. rem --- Get the handle of our I/O semaphore
  355.  
  356. call($78b,0,2,0,(call($88) and $fff)+33,addr(ioSem%))
  357.  
  358. rem --- Get the Link Server's pid
  359.  
  360. pfmt%=addr(fmt&)
  361. srvPid%=call($683,wsrvPid%,4,0,addr(pfmt%)) rem MessSendReceiveWithWait
  362.  
  363. if srvPid%<0
  364.     showerr:(srvPid%)
  365.     return ""
  366. elseif srvPid%=0
  367.     at 2,11
  368.     print "Nothing to bring"
  369.     pause 40
  370.     at 2,11
  371.     print "                "
  372.     return ""
  373. endif
  374.  
  375. rem --- Get the name of the Link Server
  376.  
  377. call($a88,srvPid%,0,0,0,addr(name$)+1)
  378. pokeb addr(name$),call($b9,0,0,0,0,addr(name$)+1)
  379.  
  380. w%(1)=$2
  381.  
  382. rem --- Request a rendering
  383.  
  384. ret%=talk%:(w%(1),0)
  385. if ret%=0
  386.     rem --- Server prepared to render data
  387.     while 1
  388.         ret%=talk%:(addr(buf$)+1,255) : rem Get the server data
  389.         if ret%<0
  390.             if ret%=-36     rem End of file
  391.                 ret%=0        rem Avoid an error print
  392.             endif
  393.             break
  394.         endif
  395.         rem --- Display the data received
  396.         pokeb addr(buf$),ret%
  397.         ret$=peek$(addr(buf$))
  398.     endwh
  399. endif
  400.  
  401. if ret%<0
  402.     showerr:(ret%)
  403. endif
  404.  
  405. return ret$
  406.  
  407. ENDP
  408.  
  409.  
  410. PROC Talk%:(a%,b%)
  411. local arg1%,arg2%            rem Message parameters - keep in order
  412. local stat%,count%,ret%
  413. arg1%=a%
  414. arg2%=b%
  415. call($0583,srvPid%,$21,0,addr(arg1%),addr(stat%)) rem MessSendReceiveAsynchronous
  416. while 1
  417.     iowait
  418.     if stat%<>-46 : rem The result has been returned
  419.         ret%=stat%
  420.         break
  421.     else
  422.         count%=count%+1 : rem Count up all other signals
  423.     endif
  424. endwh
  425.  
  426. rem --- Put back spare signals if any
  427. while count%
  428.     iosignal
  429.     rem call($382,ioSem%,0,0,0,0) rem SemSignalOnce
  430.     count%=count%-1
  431. endwh
  432. return ret%
  433. ENDP
  434.