home *** CD-ROM | disk | FTP | other *** search
/ Generous Efforts of Many / gemcd.zip / GEM.CD.E.po / NDA:CLOCKS:ANACLOCK / ANACLOCK.PAS.txt next >
Text File  |  2010-05-14  |  7KB  |  305 lines
  1. {$DeskAcc 60 -1 'Analog Clock'}
  2. {$LongGlobals+}
  3.  
  4. { Welcome to the Desk Accessory 'Analog Clock'!
  5.  
  6.     This DA Displays an Analog Clock in a window.   }
  7.  
  8. Program AnaClock;
  9.     uses
  10.         Qdintf, GSIntf, MiscTools,ConsoleIO;
  11.     var
  12.         Update:            Integer;
  13.         MyWindOpen: Boolean;
  14.         MyWind:            NewWindowParamBlk;
  15.         MyWindPtr:    WindowPtr;
  16.         theTime:        packed array[0..20] of byte;
  17.         GlobalHour: integer;
  18.     
  19.     procedure DrawTheTime;
  20.         forward;
  21.     procedure QuickHand(count:integer);
  22.         forward;
  23.     procedure DoTheHour;
  24.         forward;
  25.                     
  26.     Procedure EraseTheFace;
  27.         var
  28.             face_area:            rect;
  29.         begin
  30.             with face_area do
  31.                 begin
  32.                     top     := 20;
  33.                     left    := 10;
  34.                     bottom:= 81;
  35.                     right := 216;
  36.                 end;
  37.             
  38.             SetSolidPenPat(15);
  39.             FrameRect(face_area);
  40.             PaintRect(face_area);
  41.             SetSolidPenPat( 0);
  42.         end;  
  43.     
  44.     Function DAOpen: WindowPtr;
  45.         Begin
  46.             If MyWindOpen then
  47.                 SelectWindow(MyWindPtr)
  48.             Else
  49.                 begin
  50.                 with myWind do
  51.                         begin
  52.                             param_length := sizeof(NewWindowParamBlk);
  53.                             wFrame            := $C0A0;
  54.                             wTitle            := @'Analog Clock';
  55.                             wRefCon      := 0;
  56.                      wZoom.top    := 0;
  57.                      wZoom.left   := 0;
  58.                   wZoom.bottom := 0;
  59.                      wZoom.right  := 0;
  60.                      wColor          := nil;
  61.                      wYOrigin     := 10;
  62.                      wXOrigin     := 50;
  63.                      wDataH          := 0;
  64.                      wDataW          := 0;
  65.                      wMaxH          := 0;
  66.                      wMaxW          := 0;
  67.                      wScrollVer   := 0;
  68.                      wScrollHor   := 0;
  69.                      wPageVer     := 0;
  70.                      wPageHor     := 0;
  71.                      wInfoRefCon  := 0;
  72.                      wInfoHeight  := 0;
  73.                      wFrameDefProc:= nil;
  74.                      wInfoDefProc := nil;
  75.                      wContDefProc := nil;
  76.                      wPosition.top    := 70;          { X Width:  225       pixels }
  77.                      wPosition.left   := 50;            { Y Width:     90 [-11] pixels }
  78.                      wPosition.bottom := 160;
  79.                      wPosition.right  := 275;
  80.                      wPlane       := -1;
  81.                      wStorage       := nil;
  82.                  end;
  83.          
  84.              MyWindPtr    := NewWindow(MyWind);
  85.              SetSysWindow(MyWindPtr);
  86.          end;
  87.        DAOpen        := MyWindPtr;
  88.        Update := 0;
  89.        MyWindOpen := True;
  90.      end;                                                                    { END  OF  DAOPEN }
  91. procedure DAClose;
  92.     begin
  93.         CloseWindow(MyWindPtr);
  94.         MyWindOpen    := False;
  95.         Update := 0;
  96.     end;                                                                        { END OF DACLOSE }
  97. procedure DAAction( Code: Integer; Param: LongInt );
  98.     var
  99.         currPort: GrafPtr;
  100.     begin
  101.         case Code of
  102.             DAEvent: begin
  103.             if EventRecordPtr(param)^.what = updateEvt then begin
  104.             BeginUpdate(myWindPtr);
  105.             Update := 0;
  106.             DrawTheTime;
  107.             EndUpdate(myWindPtr);
  108.             end
  109.         end;
  110.             DARun: begin
  111.         currport := GetPort;
  112.         SetPort(GrafPtr(MyWindPtr));
  113.         DrawTheTime;
  114.         SetPort(currPort);
  115.         end;
  116.             DACursor: ;
  117.             DAMenu: begin
  118.         end;
  119.             DAUndo,
  120.             DACut,
  121.             DACopy,
  122.             DAPaste,
  123.             DAClear:  Code := 1;
  124.         end;
  125. end;                                    { END  OF  DAACTION }
  126. procedure DAInit(Code: Integer);
  127.     begin
  128.         if Code = 0 then begin
  129.             { Desk Shutdown call, make sure window is closed }
  130.             if MyWindOpen then DAClose;
  131.             end
  132.         else begin
  133.             { Desk startup call, set flag for my window }
  134.             MyWindOpen := false;
  135.             end;
  136. end;                                                                                    { END  OF  DAINIT }       
  137.     
  138. procedure DrawTheTime;
  139.     var
  140.         c,
  141.         t,
  142.         week,
  143.         month,
  144.         day,
  145.         year,
  146.         hour,
  147.         minute,
  148.         second : integer;
  149. begin
  150.     ReadTimeHex(week,month,day,year,hour,minute,second);
  151.                               { GlobalHour is set so that }
  152.     GlobalHour := hour;       { "DoTheHour" can tell the  }
  153.                                                         { hour.                                         }
  154.     ReadAsciiTime(@theTime);
  155.     for c := 0 to 19 do
  156.         TheTime[c] := BitAnd(TheTime[c],$7F);
  157.     MoveTo(40,8);
  158.     DrawCString(@thetime);
  159.     MoveTo(0,9);
  160.     LineTo(225,9);
  161.     Moveto(0,0);
  162.     Lineto(0,9);
  163.     MoveTo(224,0);
  164.     LineTo(224,9);
  165.     
  166.     { Now Draw the Digital Clock }   {48,112}
  167.     
  168.     MoveTo(48,112);                                     { Vert. from 10-90:  80 steps }
  169.                                                                      { Horz. from 0-225: 225 steps }
  170.     { Draw Time Numerals }
  171.     
  172.     if update = 0 then begin
  173.         MoveTo(102,18);
  174.         DrawString('12');
  175.         MoveTo(216,51);
  176.         DrawString('3');
  177.         MoveTo(2,51);
  178.         DrawString('9');
  179.         MoveTo(107,89);
  180.         DrawString('6');
  181.         MoveTo(111,45); { Center Dot  .  }
  182.         LineTo(111,45);    
  183.         
  184.         MoveTo(2,18);
  185.         DrawString('V.1.5');
  186.         MoveTo(174,18);
  187.         DrawString('Feb/88');
  188.         
  189.         MoveTo(2,89);
  190.         DrawString('By G. Grant');
  191.         
  192.         Update := 1;  { Don't do this again unless needed. }
  193.         { Now, That's all done. }
  194.         
  195.     end;  { of the Credits, etc. UPDATE }    
  196.         
  197.     { ------------------------- The Main Thingy ------------------------- }
  198.     
  199.         EraseTheFace;                { Clear the face of the clock, excluding numerals. }            
  200.         QuickHand(minute);    { Draw the Minute Hand.                                                         }
  201.         QuickHand(second);  { Draw the Second Hand.                                                         }
  202.         DoTheHour;                    { Draw the Hour hand ( the short one. )            }
  203.         
  204.     end;
  205.  
  206.  
  207.  
  208. procedure QuickHand(count: integer);
  209.         var
  210.           x,y: integer;
  211.         begin
  212.             case count of
  213.                 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15:
  214.                     begin              {^x: 225,^y: 80}
  215.                           if count <9 then 
  216.                               begin
  217.                                x := 111+ ( count * 11);
  218.                                y := 20;
  219.                               end;
  220.                           if count >8 then 
  221.                               begin
  222.                                   x := 215; 
  223.                                 y := 20 + ( ( count - 8) * 4) - 3;
  224.                               end;
  225.                     MoveTo(111,45);
  226.                     LineTo(x,y);
  227.                     end;
  228.                 end;
  229.             case count of
  230.                 16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  231.                     begin              {^x: 225,^y: 80}
  232.                           if count <23 then 
  233.                               begin
  234.                                   x := 215;
  235.                                   y := 46 + ( ( count - 15) * 4) - 3;
  236.                               end;
  237.                           if count >22 then 
  238.                               begin
  239.                                   x := 215 - ( ( count - 21) * 11) - 5; 
  240.                                 y := 80;
  241.                               end;
  242.                     MoveTo(111,45);
  243.                     LineTo(x,y);
  244.                     end;
  245.                 end;
  246.             case count of
  247.                 31,32,33,34,35,36,37,38,39,40,41,42,43,44,45:
  248.                     begin              {^x: 225,^y: 80}
  249.                           if count <38 then 
  250.                               begin
  251.                                 x := 111 - ( ( count - 30) * 11 );
  252.                                   y := 80;
  253.                               end;
  254.                           if count >37 then 
  255.                               begin
  256.                                   x := 10;
  257.                                   y := 80 - ( ( count - 37) * 4) - 3;
  258.                               end;
  259.                     MoveTo(111,45);
  260.                     LineTo(x,y);
  261.                     end;
  262.                 end;
  263.             case count of
  264.                 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60:
  265.                     begin              {^x: 225,^y: 80}
  266.                           if count <53 then 
  267.                               begin
  268.                                 x := 10;
  269.                                 y := 45 - ( ( count - 45 ) * 3);
  270.                               end;
  271.                           if count >52 then 
  272.                               begin
  273.                                   x := 21 + ( ( count - 52 ) * 11); 
  274.                                 y := 20;
  275.                               end;
  276.                     MoveTo(111,45);
  277.                     LineTo(x,y);
  278.                     end;
  279.                 end;
  280.             end;
  281.             
  282. procedure DoTheHour;
  283.     begin
  284.         MoveTo(111,45); { The center dot [axis] }
  285.         case GlobalHour of
  286.                 1 ,13 :  LineTo(124,35);        {}        { 111,46}
  287.                 2 ,14 :     LineTo(137,40);
  288.                 3 ,15 :  LineTo(150,45);    {}
  289.                 4 ,16    :     LineTo(137,50);
  290.                 5 ,17 :  LineTo(124,55);
  291.                 6 ,18 :  LineTo(111,60);    {}
  292.                 7 ,19 :  LineTo( 98,55);
  293.                 8 ,20 :  LineTo( 85,50);
  294.                 9 ,21 :  LineTo( 72,45);    {}
  295.                 10,22 :  LineTo( 85,40); 
  296.                 11,23 :  LineTo( 98,35);
  297.                 12, 0 :  LineTo(111,30);    {}
  298.     end;  { of CASE }
  299. end;        { of DoTheHour }                    
  300.  
  301.  
  302. begin                        { Look Ma, NO PROGRAM! }
  303. end.            { In an NDA, the DAxxx PROCEDUREs are called independantly }
  304.  
  305.