home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Snippets / Animate Cursor / SpinCursor.p < prev    next >
Encoding:
Text File  |  1994-04-28  |  3.0 KB  |  142 lines  |  [TEXT/PJMM]
  1. (************************************************************************)
  2. (*            put up an interrupt driven cursor        *)
  3. (*            from inside Macintosh "Processes"        *)
  4. (*                   Daniel W. Rickey                *)
  5. (*               drickey@irus.rri.uwo.ca            *)
  6. (*                London, Ontario                *)
  7. (*                    CANADA                *)
  8. (*                last modified 1994-04-28            *)
  9. (************************************************************************)
  10.  
  11. Program SpinCursor;
  12.  
  13.     Uses
  14.         Retrace;
  15.  
  16.     Const
  17.         InterruptDelay = 4;
  18.         MaxNumberCursors = 16;    {maximum number of cursors in animation}
  19.  
  20.     Type
  21.         CursorsList = Array[1..MaxNumberCursors] Of CursHandle;
  22.         CursorTask = Record
  23.                 myVBLTask: VBLTask;
  24.                 myCursors: CursorsList;
  25.                 myFrame: Integer;
  26.                 NumberOfCursors: Integer;
  27.             End;
  28.  
  29.         CursorTaskPTR = ^CursorTask;
  30.  
  31.     Var
  32.         gmyCursorTask: CursorTask;
  33.  
  34.   (**** returns address of a VBL task record, from within a VBL task ****)
  35.     Function GetVBLRec: LongInt;
  36.     Inline
  37.         $2E88;
  38.  
  39. (**** this is the task that is executed during a VBL ****)
  40. {$PUSH}
  41. {$D- V- R-}
  42.   {can not have debug information in an interrupt routine!}
  43.     Procedure ChangeCursor;
  44.  
  45.         Var
  46.             RecPTR: CursorTaskPtr;
  47.  
  48.     Begin
  49.   (* get cursor information *)
  50.     RecPtr := CursorTaskPtr(GetVBLRec);
  51.  
  52.     With RecPtr^ Do
  53.         Begin
  54.     (* display the next cursor *)
  55.         SetCursor(myCursors[myFrame]^^);
  56.  
  57.     (* advance to the next cursor frame *)
  58.         myFrame := myFrame + 1;
  59.  
  60.     (* wrap around to the first cursor *)
  61.         If myFrame > NumberOfCursors Then
  62.             Begin
  63.             myFrame := 1;
  64.             End;
  65.         End;
  66.  
  67.   (* set task to run again *)
  68.     RecPtr^.myVBLTask.vblCount := InterruptDelay;
  69.     End;        {ChangeCursor}
  70. {$POP}
  71.  
  72.  
  73.   (**** call this procedure to start a moving cursor ****)
  74.     Procedure StartSpinning (NumOfCursors, InitialResID: Integer);
  75.  
  76.         Const
  77.             InitialDelay = 10;
  78.  
  79.         Var
  80.             myError: OSerr;
  81.             Count: Integer;
  82.  
  83.     Begin
  84.  
  85.   (*initialise cursor information*)
  86.     gMyCursorTask.NumberOfCursors := NumOfCursors;
  87.  
  88.     For Count := 1 To NumOfCursors Do
  89.         Begin
  90.     (* load cursor into memory*)
  91.         gMyCursorTask.MyCursors[Count] := GetCursor(InitialResID + Count - 1);
  92.  
  93.     (*lock cursor so that we can call SetCursor at Interrupt time*)
  94.         HLockHi(Handle(gMyCursorTask.MyCursors[Count]));
  95.         End;
  96.  
  97.     gMyCursorTask.MyFrame := 1;
  98.  
  99.   (* initialise the VBL task record *)
  100.     With gMyCursorTask.MyVBLTask Do
  101.         Begin
  102.         qType := ORD(vType);    (* set queue type *)
  103.         vblAddr := @ChangeCursor;    (* get address of VBL task *)
  104.         vblCount := InitialDelay;    (* set task frequency/delay *)
  105.         vblPhase := 0;        (* no phase *)
  106.         End;
  107.  
  108.   (* install the interrupt *)
  109.     myError := VInstall(@gMyCursorTask.MyVBLTask);
  110.     End;  {StartSpinning}
  111.  
  112.  
  113.   (**** call this to stop the moving/spinning cursor ****)
  114.     Procedure StopSpinning;
  115.  
  116.         Var
  117.             myError: OSErr;
  118.             Count: Integer;
  119.  
  120.     Begin
  121.   (*remove the task record from its queue*)
  122.     MyError := VRemove(@gMyCursorTask.MyVBLTask);
  123.  
  124.   (*free memory occupied by the cursors *)
  125.     For Count := 1 To gMyCursorTask.NumberOfCursors Do
  126.         Begin
  127.         ReleaseResource(Handle(gMyCursorTask.MyCursors[Count]));
  128.         End;
  129.  
  130.     End;  {StopSpinning}
  131.  
  132. Begin
  133.  
  134. StartSpinning(7, 128);
  135.  
  136. Repeat
  137. Until Button;
  138.  
  139. StopSpinning;
  140.  
  141.  
  142. End.