Rでアラーム機能付きの鐘を作ります.

面白い小物です.tはアラーム動作時間であり、単位は秒であり、tを入力形式hour:minute:secondに変更する簡単な変換プログラムを書くことができます.
元の住所:http://bbs.pinggu.org/thread-2266932-1-1.html
簡単に変更する

clock<-function(hour，minute，second,back,circle,hou,sec,min,method){
#     sound ！
#back      
#circle       
#hou     
#sec    
#min    
#hou    
#method         ,   1,2,3,1   ,2     ,       

t<-hour*3600+minute*60+second
  #     
  if(missing(back)){
     back="gray";
     if(missing(circle)){
     circle="green";
     }
  }
  if(missing(hou)){
     hou<-"red";
     if(missing(min)){
        min<-"orange";
        if(missing(sec)){
          sec<-"blue";
        }
        else{next}     
    }
    else{next}
  }
  else{next}
  if(missing(method)){
      method=3;
  }
  library(sound);#sound    
  #    
  par(bg=back,lwd=3,bty="n",xaxt="n", yaxt="n")
  x=seq(0,2*pi,0.01);
  plot(cos(x),sin(x),type="l",xlab="",ylab="",col=circle);
    lines(1.05*sin(x),1.05*cos(x),col=circle);
    title(main="clock",font=2,cex=2);
  #    
   for(k in 1:12){
       second<-c("1","2","3","4","5","6","7",
                 "8","9","10","11","12");
       text(0.93*cos(2*pi/12*(3-k)),0.93*sin(2*pi/12*(3-k)),
            labels = second[k],adj=c(0.5,0.5),col="yellow",
            font=2,cex=1.7);
  
   }
   #      
   A<-date();
   h0<-as.numeric(substr(A,12,13));  
   m0<-as.numeric(substr(A,15,16));
   n0<-as.numeric(substr(A,18,19));
   if(h0>12){
      h0=h0-12;
   }
  #    ,       
  n=60;m=60;h=12;
  #    ,        
  #  
    f1<-function(ii){
       if((16-n0-i)<=-45){
           arrows(0,0,0.7*cos(2*pi/n*(16-m0-j)),
                  0.7*sin(2*pi/n*(16-m0-j)),col=back);   
           arrows(0,0,0.7*cos(2*pi/n*(15-m0-j)),
                  0.7*sin(2*pi/n*(15-m0-j)),col=min);
        }else{
           arrows(0,0,0.7*cos(2*pi/n*(16-m0-j)),
                  0.7*sin(2*pi/n*(16-m0-j)),col=min);
          }
    }
    f2<-function(jj){     
       if((16-m0-j)<=-44&(16-n0-i)<=-45){
           arrows(0,0,0.5*cos(2*pi/h*(4-h0-l)),
                  0.5*sin(2*pi/h*(4-h0-l)),col=back);    
           arrows(0,0,0.5*cos(2*pi/h*(3-h0-l)),
                  0.5*sin(2*pi/h*(3-h0-l)),col=hou);
        }else{
            arrows(0,0,0.5*cos(2*pi/h*(4-h0-l)),
                   0.5*sin(2*pi/h*(4-h0-l)),col=hou);
        }
    } 
    #        
 repeat{
    for(l in 1:h){
      for(j in 1:m){
         for(i in 1:n){
            points(0,0,cex=2);
            arrows(0,0,0.85*cos(2*pi/n*(16-n0-i)),
                   0.85*sin(2*pi/n*(16-n0-i)),col=back);
             f1(i);
             f2(j);            
            arrows(0,0,0.85*cos(2*pi/n*(15-n0-i)),
                   0.85*sin(2*pi/n*(15-n0-i)),col=sec);
            Sys.sleep(1);
            arrows(0,0,0.85*cos(2*pi/n*(15-n0-i)),
                   0.85*sin(2*pi/n*(15-n0-i)),col=back);
            f1(i);
            f2(j);
            lines(sin(x),cos(x),col=circle);
            #      
            t=t-1;
             if(t==0){
                break;
              }else{next}
         }
       #
       f2(j);
       #    
       if(t==0){
           arrows(0,0,0.7*cos(2*pi/n*(15-m0-j)),
                  0.7*sin(2*pi/n*(15-m0-j)),col=back); 
           points(0,0,cex=2);
           break;
       }else{next}

     }
     if(t==0){
       arrows(0,0,0.5*cos(2*pi/h*(3-h0-l)),
              0.5*sin(2*pi/h*(3-h0-l)),col=back); 
       points(0,0,cex=2);
       break;
     }
   }
    if(t==0){break}
    else{next}
 }
  #    
  #     
  #    
  s0 <- Sine(0,0.25);
  s1 <- Sine(523.25,0.25);
  s2 <- Sine(587.33,0.25);
  s3 <- Sine(659.26,0.25);
  s4 <- Sine(698.46,0.25);
  s5 <- Sine(784,0.25);
  s6 <- Sine(880,0.25);
  s7 <- Sine(987.77,0.25);
  s11 <- Sine(1046.5,0.25);
  sound<-appendSample(s5,s6,s5,s3,s4,s5,s4,s2,s1,s3,s5,s11);
  s<-mirror(sound);
  if(method==1){
      play(s);#         
  }
  else if(method==2){ 
      winDialog(,"   ！！！");
  }
  else{
      play(s);#    
      winDialog(,"   ！！！");
  }
}