home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 221 / pascal / tosacc.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-02-17  |  5.9 KB  |  156 lines
  1. {******************************************************************************
  2. NAME: TEST.ACC
  3. PURPOSE:        To show how a tos application can be converted to
  4.                 a desk accessory in Personal Pascal version 1.11.
  5.                 Contains many strange but neccessary kludges.
  6. HISTORY:
  7.         Created: Vitas Povilaitis ( 11/01/87 ) @ Atari Apex BBS (716)458-2638
  8.  
  9. This program is PUBLIC DOMAIN.  Send me no money, but mention my name
  10. in important circles.
  11. ******************************************************************************}
  12. {$A+,D-,S40}
  13. PROGRAM Test( input, output );
  14.  
  15. CONST
  16. {$I gemconst.pas }
  17.    AC_Open = 40;        {* accessory opened message value *}
  18.  
  19. TYPE
  20. {$I gemtype.pas }
  21.   Screendef = ^Screendata;
  22.   {* The following should be 1..33023 ( 32767 + 256 ),
  23.          however PP v1.11 has a 32K limit *}
  24.   Screendata = PACKED ARRAY[ 1..32766 ] OF CHAR;
  25.  
  26. VAR
  27.    wind_text : Window_Title; {* title of the window *}
  28.    dummy_window : Integer; {* window to set up the full screen *}
  29.    dummy_menu : Menu_Ptr;  {* menu bar to insure desktop redraws menu when
  30.                            {* we exit *}
  31.    ap_id : Integer;      {* Accessory ID *}
  32.    acc_text : Str255;    {* name of this accessory *}
  33.    menu_id : Integer;    {* our menu ID *}
  34.    event : INTEGER;
  35.    junk: INTEGER;        {* dummy variable for GEM calls *}
  36.    msg : Message_Buffer; {* the message that currently needs to be processed *}
  37.    log_desktop : Screendef;
  38.    phy_desktop : Screendef;
  39.    alt_screen : Screendef;
  40.    dispose_this : Screendef;
  41.  
  42. {$I GEMSUBS.PAS}
  43.  
  44. {******************************************************************************
  45. Main_Register will insert our accessory name into the DESK given our
  46. application ID number and get our menu_id number as well.
  47. (Currently, The ST version of GEM never uses the value returned
  48. by Menu_Register.
  49. ******************************************************************************}
  50. FUNCTION Menu_Register( id : INTEGER; VAR name : Str255 ) : INTEGER;
  51. EXTERNAL;
  52.  
  53. {******************************************************************************
  54. Physbase gets the physical screen RAM address
  55. ******************************************************************************}
  56. FUNCTION Physbase : Screendef;
  57. XBIOS( 2 );
  58.  
  59. {******************************************************************************
  60. Logbase gets the logical screen RAM base address actually written to
  61. ******************************************************************************}
  62. FUNCTION Logbase : Screendef;
  63. XBIOS( 3 );
  64.  
  65. {******************************************************************************
  66. Setscreen sets screen parameters: logical base, physical base, & resolution.
  67. -1 means no change.
  68. ******************************************************************************}
  69. PROCEDURE Setscreen( logbase, phybase : Screendef; rez : INTEGER );
  70. XBIOS( 5 );
  71.  
  72. {******************************************************************************
  73. Alloc_Screen creates the new screen, returns pointer to it.
  74. ******************************************************************************}
  75. FUNCTION Alloc_Screen( VAR dispose_this : Screendef ) : Screendef;
  76.  
  77. CONST
  78.   SCREEN_ADDR_REZ = 256;
  79.  
  80. VAR
  81.   Scrjunk : RECORD
  82.               CASE BYTE OF
  83.                 0 : ( Sali: Long_Integer );
  84.                 1 : ( Sa : Screendef );
  85.             END;
  86.  
  87. BEGIN  {* Alloc_Screen *}
  88.   WITH Scrjunk DO
  89.   BEGIN
  90.     NEW( Sa );
  91.     dispose_this := Sa;
  92.     IF Sali MOD SCREEN_ADDR_REZ <> 0 THEN
  93.       Sali := Sali + ( SCREEN_ADDR_REZ - ( Sali MOD SCREEN_ADDR_REZ ) );
  94.   END;
  95.   Alloc_Screen := Scrjunk.Sa;
  96. END;   {* Alloc_Screen *}
  97.  
  98. {******************************************************************************
  99. Do_Main is the real workhorse since the real main is cluttered with
  100. initialization routines and the accessory loop.
  101. ******************************************************************************}
  102. PROCEDURE Do_Main;
  103. VAR
  104.    aloop : Integer;       {* loop control variable *}
  105.  
  106. BEGIN  {* Do_Main *}
  107.    FOR aloop := 1 TO 90 DO
  108.       WRITELN( aloop, ' : Hello, World!' );
  109. END;   {* Do_Main *}
  110.  
  111. {*****************************************************************************}
  112.  
  113. BEGIN {* TEST *}
  114.    ap_id := Init_Gem;
  115.    IF ap_id >= 0 THEN
  116.    BEGIN
  117.       wind_text := '  Window title which will never get printed anyway  ';
  118.       acc_text := '  Testing, 1, 2, 3 ';
  119.       menu_id := Menu_Register( ap_id, acc_text );
  120.  
  121.       WHILE TRUE DO {* The main acc loop *}
  122.       BEGIN
  123.          event := Get_Event( E_Message, 0, 0, 0, 0,
  124.                              FALSE, 0, 0, 0, 0, FALSE, 0, 0, 0, 0,
  125.                              msg, junk, junk, junk, junk, junk, junk );
  126.          {* note that the usage of menu_id has been commented out below *}
  127.          IF ( msg[ 0 ] = AC_Open) {AND msg[ 4 ] = menu_id} THEN
  128.          BEGIN
  129.             dummy_window := New_Window( 0, wind_text, 0, 0, 0, 0 );
  130.             Open_Window( dummy_window, 0, 0, 0, 0 );
  131.             {* I set up an alternate screen for our TOS application
  132.                to preserve the desktop because I have no better way
  133.                to re-draw the menu bar when I return.  This is too
  134.                memory hungry so I hope someone comes up with a better
  135.                way to re-draw the menu bar.
  136.             *}
  137.             log_desktop := Logbase;
  138.             phy_desktop := Physbase;
  139.             alt_screen := Alloc_Screen( dispose_this );
  140.             Setscreen( alt_screen, alt_screen, -1 );
  141.             Clear_Screen;
  142.             WRITELN;  {* needed or the first line will overwrite the menu bar*}
  143.             Hide_Mouse;
  144.  
  145.             Do_Main;    {* our tos application goes here *}
  146.  
  147.             Show_Mouse;
  148.             Setscreen( log_desktop, phy_desktop, -1 );
  149.             DISPOSE( dispose_this );
  150.             Close_Window( dummy_window );
  151.             Delete_Window( dummy_window );
  152.          END; {*IF*}
  153.       END; {*WHILE; The main acc loop*}
  154.    END; {*IF*}
  155. END.  {* TEST *}
  156.