home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / utilsr / teatime10 / TEATIME.OPL < prev    next >
Text File  |  1994-11-08  |  4KB  |  279 lines
  1. REM Teatime V 1.0 by Bernd Meyer 
  2. REM please report bugs and send comments to
  3. REM bernd.meyer@fernuni-hagen.de
  4.  
  5. APP Teatime
  6.     Type 3
  7.     Path "\opd"
  8.     Ext "ttm"
  9.     Icon "\OPD\Teatime.pic"
  10. ENDA
  11.  
  12.  
  13. PROC main:
  14.  
  15.     global handle%, a%(6), w$(128)
  16.     global dur&, ticks&, msg$(255), sel%, file$(128)
  17.     global stat%
  18.     
  19.     local err%, key%
  20.     
  21.     defaultwin 1
  22.     statuswin on,2
  23.     font 1,0
  24.  
  25.     w$=cmd$(2)
  26.     fileh:(cmd$(3))
  27.  
  28.     while 1
  29.         err%=ioopen(handle%,"ALM:",0)
  30.         if err%<0 : raise err% : exit: : endif
  31.         dinit "Teatime 1.0"
  32.         dtime dur&,"Duration",3,0,86399
  33.         dtime ticks&,"Ticks",3,0,43199
  34.         dedit msg$,"Message",20
  35.         dchoice sel%,"Sound","Fanfare,Soft Bells,Church Bells,Rings,Chimes,File,Silence"
  36.         dbuttons "Start",13,"Exit",-27
  37.         lock on
  38.         key%=dialog
  39.         lock off
  40.         if key%=0
  41.             dinit "Save Settings?"
  42.             dbuttons "Yes",%Y,"No",%N
  43.             lock on
  44.             if dialog=%y
  45.                 save:
  46.             endif
  47.             lock off
  48.             exit:
  49.         elseif key%=13
  50.             if ticks&>=dur&
  51.                 warning:("tick interval > duration","No ticks will be given")
  52.                 ioclose(handle%)
  53.                 continue
  54.             endif 
  55.             if sel%=6
  56.                 dinit "Select Soundfile"
  57.                 dfile file$,"File",72
  58.                 lock on
  59.                 dialog
  60.                 lock off
  61.             endif
  62.             if sel%=6 and not exist(file$)
  63.                 warning:("cannot open file"," ")
  64.                 ioclose(handle%)
  65.                 continue
  66.             endif
  67.             count:
  68.         endif
  69.  
  70.         gcls
  71.         ioclose(handle%)
  72.     endwh
  73.  
  74. ENDP
  75.  
  76.  
  77. PROC count:
  78.  
  79.     local expires&, dif&, hours%, minutes%, seconds%, lasttik&
  80.     local systime&, disp$(8), snd$(9)
  81.     local stat%, alm$(19), length%, offset%(6), key%, event%
  82.     
  83.     expires&=dur&+datetosecs(year,month,day,hour,minute,second)
  84.     
  85.     pokel addr(alm$),expires&
  86.     pokel uadd(addr(alm$),4), expires&
  87.     if sel%<=3
  88.         snd$="SYS$AL0"+gen$(sel%,1)
  89.         poke$ uadd(addr(alm$),8), snd$
  90.     endif
  91.     if sel%=4 or sel%=5
  92.         pokeb uadd(addr(alm$),8), 1
  93.         pokeb uadd(addr(alm$),9), sel%-3
  94.     endif
  95.     if sel%=6
  96.         parse$(file$,"",offset%())
  97.         snd$=mid$(file$,offset%(4),offset%(5)-offset%(4))
  98.         poke$ uadd(addr(alm$),8), snd$
  99.     endif
  100.     if sel%=7
  101.         pokeb uadd(addr(alm$),8), 1
  102.         pokeb uadd(addr(alm$),9), 16
  103.     endif        
  104.     msg$=msg$+chr$(0)
  105.     ioc(handle%,11,stat%, alm$,#uadd(addr(msg$),1))
  106.     
  107.     pbinit:
  108.     lasttik&=datetosecs(year,month,day,hour,minute,second)
  109.     do
  110.         systime&=datetosecs(year,month,day,hour,minute,second)
  111.         dif&=expires&-systime&
  112.         if ticks&<>0 and systime&-lasttik&>=ticks&
  113.             lasttik&=systime&
  114.             beep 5,300
  115.         endif
  116.         hours%=dif&/3600
  117.         minutes%=mod%:(dif&,3600)/60
  118.         seconds%=dif&-int(hours%)*3600-minutes%*60
  119.         disp$=num2str$:(hours%)+":"+num2str$:(minutes%)+":"+num2str$:(seconds%)
  120.         gat 160,55
  121.         gprintb disp$,100,3,0,0,5
  122.         gat 37,87
  123.         gfill 347*(1-flt(dif&)/dur&),16,0
  124.         event%=event%:
  125.         if event%=1
  126.             gfont $9a
  127.             gstyle 0
  128.             gat 180,128
  129.             gbutton "Esc",1,60,20,1
  130.             pause 5
  131.             gcls
  132.             dinit "Cancel Alarm?"
  133.             dbuttons "Cancel & Abort",-27, "Abort",32, "Resume",13
  134.             lock on
  135.             key%=dialog
  136.             lock off
  137.             if key%=0
  138.                 iocancel(handle%)
  139.                 iowaitstat stat%
  140.                 break
  141.             elseif key%=32
  142.                 break
  143.             elseif key%=13
  144.                 pbinit:
  145.             endif
  146.         elseif event%=2
  147.             break
  148.         endif
  149.     until dif&<=0
  150.  
  151. ENDP
  152.  
  153.  
  154. PROC pbinit:
  155.  
  156.     gcls
  157.     ggrey 2
  158.     gborder 0
  159.     gfont $9a
  160.     gstyle 0
  161.     gat 180,128
  162.     gbutton "Esc",1,60,20,0
  163.     gfont 8
  164.     gstyle 9
  165.     gat 130,15
  166.     gxborder 1,3,160,55
  167.     gat 30,80
  168.     gxborder 1,3,360,30
  169.  
  170. ENDP
  171.  
  172.  
  173. PROC save:
  174.     A.d&=dur&
  175.     A.t&=ticks&
  176.     A.m$=msg$
  177.     A.s%=sel%
  178.     A.f$=file$
  179.     if count=0
  180.         append
  181.     else
  182.         update
  183.     endif
  184.     giprint "Settings saved"
  185. ENDP
  186.  
  187.  
  188. PROC exit:
  189.     close
  190.     ioclose(handle%)
  191.     stop
  192. ENDP
  193.  
  194.  
  195. PROC mod%:(a&,b%)
  196.            RETURN a&-INT(a&/b%)*b%  
  197. ENDP 
  198.  
  199.  
  200. PROC num2str$:(num%)
  201.     local str$(2)
  202.     
  203.     str$=gen$(num%,2)
  204.     if len(str$)=1 : str$="0"+str$ : endif
  205.     return str$
  206. ENDP
  207.     
  208.     
  209. PROC event%:
  210.     local t$(1)
  211.     if testevent
  212.         getevent a%()
  213.         if a%(1)=$404
  214.             w$=getcmd$
  215.             t$=left$(w$,1)
  216.             w$=mid$(w$,2,128)
  217.             if t$="X" or t$="C" or t$="O"
  218.                 if t$="X"
  219.                     save:
  220.                     exit:
  221.                 else
  222.                     trap close
  223.                     if err
  224.                         raise err
  225.                     endif
  226.                     fileh:(t$)
  227.                 endif
  228.                 return 2
  229.             endif
  230.         elseif a%(1)=27 
  231.             return 1
  232.         else 
  233.             return 0
  234.         endif
  235.     endif
  236. ENDP
  237.  
  238.  
  239.  
  240. PROC fileh:(t$)
  241.     
  242.     if t$="C"
  243.         trap create w$,A,d&,t&,m$,s%,f$
  244.     elseif t$="O"
  245.         trap open w$,A,d&,t&,m$,s%,f$
  246.     endif
  247.     if err
  248.         cls : print err$(err)
  249.         get : exit:
  250.     endif
  251.     setname w$
  252.     if t$="C"
  253.         A.d&=210
  254.         A.t&=0
  255.         A.m$="Tea is ready"
  256.         A.s%=4
  257.         A.f$="loc::m:\wve\*.wve"
  258.         append
  259.     endif
  260.     dur&=A.d&
  261.     ticks&=A.t&
  262.     msg$=A.m$
  263.     sel%=A.s%
  264.     file$=A.f$
  265. ENDP
  266.  
  267.  
  268. PROC warning:(text1$,text2$)
  269.  
  270.         dinit "Warning"    
  271.         dtext "",text1$,2   
  272.         dtext "",text2$,2
  273.         dbuttons "",13
  274.         lock on
  275.         dialog
  276.         lock off
  277.  
  278. ENDP
  279.