home *** CD-ROM | disk | FTP | other *** search
/ Carousel / CAROUSEL.cdr / mactosh / fonts / fontshow.sit / FontShow.Pas < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  9KB  |  164 lines
  1. PROGRAM FontShow;
  2. (* This program lets the user select a font and size (from Font and Size menus, of course), and *)
  3. (* displays all of the characters at the selected font/size along with their Hexadecimal codes. *)
  4. (* It includes several special features, including:                                             *)
  5. (*              Ñ "Automatic" window updates.                                                   *)
  6. (*              Ñ Automatic notification when we are running out of memory (as well as measures *)
  7. (*                designed to help keep us out of a crash).                                     *)
  8. (*              Ñ Memory management techniques designed to reduce fragmentation.                *)
  9. (*              Ñ A Size menu which outlines lists the available font sizes.                    *)
  10. (*              Ñ Multiple window types, and the mechanisms necesary to update them.            *)
  11. (*              Ñ Full Desk Accessory support.                                                  *)
  12. (*              Ñ Font information may be transported through the Clipboard.                    *)
  13. (*                                                                                              *)
  14. (* This program doesn't do anything special under MultiFinder, although is does have a SIZE     *)
  15. (* resource.                                                                                    *)
  16. (*                                                                                              *)
  17. (* This code is in the Public Domain.  You may use any part of it in your own programs, and I'm *)
  18. (* not asking for any money.                                                                    *)
  19. (*                                                                                              *)
  20. (* Version History:                                                                             *)
  21. (*          Version 1.0, September 9, 1988                                                      *)
  22. (*          Version 1.1, September 13, 1988                                                     *)
  23. (*              Ñ Fixed problems with PICT objects and the Clipboard by creating a seperate     *)
  24. (*                PICT for the clipboard itself (instead of recycling a window pict.)           *)
  25. (*              Ñ Added TEXT type to the clipboard (string contains all 256 characters)         *)
  26. (*                                                                                              *)
  27. (* Written by Richard Clark. You can reach me at:                                               *)
  28. (*   GEnie/DELPHI/MCI Mail/The MouseHole (Orange County, CA): RDCLARK                           *)
  29. (*   Compu$erve: (I have an account, but never use it.  Try the MCI gateway)                    *)
  30. (*   The Desktop BBS (Orange County, CA): Box #003.                                             *)
  31.  
  32. {$D+}                                                   
  33. {$U-}                                       (* Don't include Standard I/O units *)
  34. {$S+}                                       (* Use segmentation *)
  35. {$B+}                                       (* Turn on the Bundle Bit *)
  36. {$R FontShow.rsrc}                          (* Use these resources *)
  37. {$T APPLFSho}                               (* Our creator code is "FSho" (NOT registered with Apple) *)
  38.  
  39.   {$U Globals}
  40.   {$U Windows}
  41.   {$U Menus}
  42.   {$U MemHandler}
  43.   {$U Initialization}
  44.  
  45.   USES
  46.     {$S MainSeg}  MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf,
  47.                         Globals,
  48.     {$S WindSeg}  Windows,                  (* Windows and menus have their own segments. *)
  49.     {$S MenuSeg}  Menus,                    (* Initialization is in its own segment *)
  50.     {$S MainSeg}  MemHandler,               (* Our globals, memory watchdog, and main loop share a segment *)
  51.     {$S InitSeg}  Initialization;
  52.  
  53.  {$S MainSeg}                               (* This is in the MAIN segment *)
  54.   
  55.   PROCEDURE MainLoop;
  56.   (* Collect and process events. *)
  57.         VAR
  58.              theEvent  : EventRecord;                (* Our current event *)
  59.              realEvent : Boolean;                    
  60.  
  61.           PROCEDURE handleMouseDown;
  62.     (* This handles a mouse-down event anywhere in our screen *)
  63.              VAR
  64.                   location    : INTEGER;                (* Which area was it in? *)
  65.                   whichWindow : WindowPtr;              (* Which window as it in? *)
  66.                   menuCode    : LONGINT;                (* If we had a menu event, here's the code for it *)
  67.                   newWindSize : LONGINT;                (* If we're resizing a window, here's the new size *)
  68.  
  69.           BEGIN
  70.                location := FindWindow(theEvent.where, whichWindow); (* Locate where the mouse was clicked *)
  71.                CASE location OF                      (* Take the appropriate action *)
  72.                     inMenuBar   : BEGIN                 (* ...pulling down a menu *)
  73.                                           menuCode := MenuSelect(theEvent.where); (* Hilite the menu and track the mouse *)
  74.                                           DoMenus(menuCode);  (* Give the result to the menu handler *)
  75.                                      END;
  76.  
  77.                     inContent   : SelectWindow(whichWindow); (* Bring this window to the front *)
  78.  
  79.                     inSysWindow : SystemClick(theEvent, whichWindow);  (* Give DAs their clicks *)
  80.  
  81.                     inGoAway    : IF TrackGoAway(whichWindow, theEvent.where) THEN (* We have a click in the close box *)
  82.                                         BEGIN
  83.                         CloseAWindow(whichWindow);
  84.                         AdjustMenus(FALSE);
  85.                       END;
  86.  
  87.         inDrag      :     DragWindow(whichWindow, theEvent.where, DragLimits); (* Move this window *)
  88.  
  89.         inGrow      :     BEGIN                (* resize this window *)
  90.                                            newWindSize := GrowWindow(whichWindow, theEvent.where, SizeLimits);
  91.                                            IF (newWindSize <> 0) THEN (* resize the window, and let the Mac take care of the updating *)
  92.                                                 SizeWindow(whichWindow, LoWord(newWindSize), HiWord(newWindSize), TRUE);
  93.                                    END;
  94.  
  95.       OTHERWISE
  96.                        ; (* Do nothing *)
  97.                END; (* case location *)
  98.           END; (* handleMouseDown *)
  99.  
  100.           PROCEDURE handleKeyDown;
  101.     (* This procedure checks to see if a keypress is a menu command, and if so, calls the menu handler *)
  102.           VAR
  103.                   ch       : Char;                      (* the current character *)
  104.                   menuCode : LONGINT;                   (* Our menu selection *)
  105.  
  106.           BEGIN 
  107.                ch := chr(BitAnd(theEvent.message, charCodeMask));     (* Extract the character from the event record *)
  108.                IF BitAnd(CmdKey, theEvent.modifiers) <> 0 THEN
  109.                BEGIN                                 (* This is a menu command *)
  110.                        menuCode := MenuKey(ch);            (* Find out which item, and hilite the menu *)
  111.                        doMenus(menuCode);                  (* Give the information to our menu handler *)
  112.                   END;
  113.           END; (* handleKeyDown *)
  114.  
  115.   BEGIN (* MainLoop *)
  116.           REPEAT
  117.                UnloadSeg(@DoMenus);                  (* We're not using these code segments now, so free up *)
  118.                UnloadSeg(@UpdateWindow);             (* some memory *)
  119.                MemStatus;                            (* Report if we're running out of memory *)
  120.  
  121.                PreAllocate;                          (* Get any fixed blocks while the heap is as clean as possible *)
  122.             UpdateUsage;                          (* If the "about" window is open, update the memory information *)
  123.  
  124.                SystemTask;                           (* Give open Desk Accessories some time *)
  125.                
  126.       realEvent := GetNextEvent(everyEvent, theEvent); (* Get our next event *)
  127.                CASE (theEvent.what) OF               (* Dispatch the event to the appropriate handler *)
  128.                     nullEvent   : (* Do nothing *) ;
  129.  
  130.                     MouseDown   :     handleMouseDown;
  131.  
  132.                     KeyDown     :     handleKeyDown;
  133.  
  134.                     UpdateEvt   :     UpdateWindow(WindowPtr(theEvent.message));
  135.  
  136.                     ActivateEvt : BEGIN                 (* If a Font window is coming to the front, update *)
  137.                                           ActivateWindow(WindowPeek(theEvent.message), (* our font and size globals *)
  138.                                        odd(theEvent.modifiers));
  139.                                           AdjustMenus(TRUE);  (* Adjust the menus to reflect the new window, and force *)
  140.                                      END;                  (* them to be redrawn.                                   *)
  141.                     OTHERWISE
  142.                          ;  (* Trap all other event codes *)
  143.                END; (* case (theEvent.where) *)
  144.           UNTIL Quit;
  145.      END; (* MainLoop *)
  146.  
  147.  
  148.   PROCEDURE Shutdown;
  149.   (* This procedure cleans up when we quit *)
  150.      VAR
  151.     scrapErr : LONGINT;
  152.  
  153.   BEGIN
  154.           CloseAllWindows;
  155.     scrapErr := LoadScrap;                   (* Make certain that the scrap is kept in memory *)
  156.      END; (* Shutdown *)
  157.  
  158.  
  159. BEGIN
  160.      Initialize;
  161.      UnloadSeg(@Initialize);                    (* We won't need this segment again, so free up the memory *)
  162.      MainLoop;
  163.      Shutdown;
  164. END.