home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 1B / DATAFILE_PDCD1B.iso / _pocketbk / pocketbook / 003 / timer_zip / TIMER.OPL < prev    next >
Text File  |  1992-06-27  |  2KB  |  115 lines
  1. APP timer
  2. type 0
  3. icon "\opd\timer"
  4. ENDA
  5.  
  6. PROC timer:
  7. global mcb% rem handle of control block
  8.     rem filled in by ioopen
  9. local min& rem minutes delay required
  10. local secs& rem equivalent in seconds
  11. local i% rem beep counter
  12. local lim% rem limit number beeps
  13. local s1% rem previous seconds value
  14. local s% rem current value of time in seconds
  15. local val1%(1)
  16. local val2%(1)
  17. local val3%(1)
  18. local val4%(1)
  19.  
  20. val1%(1)=$30+(40*256)
  21. val2%(1)=$30+(40*256)+(1*64)
  22. val3%(1)=$30+(40*256)+(2*64)
  23. val4%(1)=$30+(40*256)+(3*64)
  24.  
  25. InstMus: 
  26. lim%=30
  27. dinit"Countdown Timer"
  28. min&=5
  29. dlong min&,"Minutes",0,10
  30. dialog
  31.  
  32. statuswin on
  33. screen 30,9,1,1
  34. gsetwin 0,0,179,79
  35. secs&=60*min&
  36.  
  37. s1%=second rem get the seconds now
  38. at  3,3 :print"Mike Newman's Timer Vn. 1.0"
  39. at  3,5 :print "Countdown time:-"
  40. at 23,5 :print gen$(secs&/60,-2);"m"
  41. at 27,5 :print gen$(mod&:(secs&,int(60)),-2);"s"
  42.  
  43. disp::
  44. rem output the time remaining
  45. at  3,6 :print "Time remaining:-"
  46. at 23,6 :print gen$(secs&/60,-2);"m"
  47. at 27,6 :print gen$(mod&:(secs&,int(60)),-2);"s"
  48.  
  49. rem see if finished
  50. if secs&<=0
  51.     do
  52.         OpenMus:
  53.         if i%>9
  54.             play:(addr(val4%()),1)
  55.         elseif i%>6
  56.             play:(addr(val3%()),1)
  57.         elseif i%>3
  58.             play:(addr(val2%()),1)
  59.         else
  60.             play:(addr(val1%()),1)
  61.         endif
  62.         CloseMus:
  63.         pause 10
  64.         if key :break :endif
  65.         i%=i%+1
  66.     until i%>lim%
  67.     return
  68. endif
  69.  
  70. rem see if user interupt
  71. if key :return :endif
  72.  
  73. no:: rem see if a second has passed
  74. s%=second
  75. if s%=s1% :goto no:: :endif
  76.  
  77. s1%=s%
  78. secs&=secs&-1 rem decr secs
  79. goto disp::
  80.  
  81. ENDP
  82.  
  83. PROC mod&:(a&,b&)
  84. rem modulo function
  85. rem computes a& mod b&
  86. return a&-(a&/b&)*b&
  87. ENDP
  88.  
  89. PROC InstMus:
  90.     local s$(16)
  91.     s$="LOC::M:\SNDFRC"+chr$(0)
  92.     call ($685,addr(s$)+1,0,0,0,0)
  93. ENDP
  94.  
  95. PROC OpenMus:
  96.     local ret%
  97.     while 1
  98.         ret%=ioopen(mcb%,"MUS:",-1)
  99.         if ret%=0
  100.             return
  101.         endif
  102.         print err$(ret%)
  103.         print "Retrying ("+chr$(2)+"-Esc aborts)"
  104.         pause 10
  105.     endwh
  106. ENDP
  107.  
  108. PROC CloseMus:
  109.     ioclose(mcb%)
  110. ENDP
  111.  
  112. PROC play:(buf%, len%)
  113.     iowrite(mcb%,buf%,len%)
  114. ENDP
  115.