Crawly Crypt Collection 2/crawlyvol2.bin/program/pascal/passrc/shell.pas

Pascal/Delphi Source File | 1985-11-18 | 22.5 KB | 729 lines

{ -----------------------------------------------------------------------------

                                 NOTICE:

      THESE MATERIALS are UNSUPPORTED by OSS!  If you do not understand how to
      use them do not contact OSS for help!  We will not teach you how to
      program in Pascal.  If you find an error in these materials, feel free
      to SEND US A LETTER explaining the error, and how to fix it.

      THE BOTTOM LINE:

         Use it, enjoy it, but you are on your own when using these materials!


                               DISCLAIMER:

      OSS makes no representations or warranties with respect to the contents
      hereof and specifically disclaim all warranties of merchantability or
      fitness for any particular purpose.   This document is subject to change
      without notice.

      OSS provides these materials for use with Personal Pascal.  Use them in
      any way you wish.

   -------------------------------------------------------------------------- }


Program shell;

CONST
        {$I gemconst.pas }              { Include all the GEM constants }
        Desk_Title      =       3;      { Value for Desk menu item      }
        files           =       0;      { File attribute for a file     }
        volumes         =       8;      { File attribute for the volume }
        folders         =       16;     { File attribute for a folder   }

TYPE

        {$I gemtype.pas }

VAR
        wind_title      :       Window_Title;   { Window name           }

        msg             :       Message_Buffer; { GEM message buffer    }

        a_menu          :       Menu_Ptr;       { Value for our menu    }

        Info_Box        :       Dialog_Ptr;     { Need this for Dialog Box }

        out_char        :       char;           { Used to display characters
                                                  to the screen         }

        title1,  {  -                                                   }
        title2,  {   |                                                  }
        title3,  {   |- Variables for our 5 menu titles                 }
        title4,  {   |                                                  }
        title5,  {  -                                                   }
        item11,  {  -                                                   }
        item12,  {   |                                                  }
        item13,  {   |                                                  }
        item21,  {   |                                                  }
        item22,  {   |                                                  }
        item23,  {   |                                                  }
        item31,  {   |                                                  }
        item32,  {   |- Variables for all menu items                    }
        item33,  {   |                                                  }
        item41,  {   |                                                  }
        item42,  {   |                                                  }
        item43,  {   |                                                  }
        item51,  {   |                                                  }
        item52,  {   |                                                  }
        item53,  {  -                                                   }
        sf,
        info_item,
        ok_button,
        button,
        dummy,
        event_val,
        windtype,
        big_window,
        event,
        what_key, { Key pressed and processed }
        key_lo,   { Low order byte of key     }
        key_hi,   { High order byte of key    }
        hx,       { Hold the maximum screen values for WM_Fulled message }
        hy,
        hw,
        hh,
        xm,       { Screen work area after we open the window }
        ym,
        wm,
        hm,
        cw,       { Character size, width, height and the box size }
        ch,
        bw,
        bh,
        cur_x,    { Cursor position for displaying to the screen }
        cur_y,
        zeron,    { Device zero is the printer                   }
        escn,
        x,
        y               :       integer;

        {$I gemsubs.pas }      { Include all GEM subroutines }

Procedure bconout(dev, c:integer);   { Put a character to a device }
BIOS(3);                             { Necessary for esc character }

Procedure build_screen;
begin

        { Your code goes here for what you may want to display on the
          screen. This would have to be saved in order to do a redraw
          after a message from GEM.                                     }

end;

{ The following routine will do a redraw of our window after something
  has been placed over it. It works extremely fast, because it will
  only draw the clipped area, and not the entire screen.                }

Procedure Do_Redraw(handle, x0, y0, w0, h0 : integer);
VAR
  x, y, w, h :integer;

begin
  Begin_Update;
  Hide_Mouse;
  First_Rect(handle, x, y, w, h);
  While (w <> 0) and (h <> 0) do
    begin
      If Rect_Intersect( x0, y0, w0, h0, x, y, w, h) then
        begin
          Set_Clip(x, y, w, h);
          Paint_Color(white);
          Paint_Rect(x, y, w, h);
          build_screen;
        end;
      Next_Rect(handle, x, y, w, h);
    end;
  Show_Mouse;
  Set_Clip(xm, ym, wm, hm);
  End_Update;
end;

{ If we get a message from GEM that our window is now to be the front
  window, then this routine will bring it to the front.                 }

Procedure Do_Topped;
begin
  Set_Clip(xm, ym, wm, hm);
  Bring_To_Front(big_window);
end;

{ This routine will only clear and redraw a blank window. If you have
  already placed something on the screen, then you will need to save
  it somewhere if you wish to see it after a redraw or other type of
  GEM message.                                                          }

Procedure draw_wind;
begin
  Hide_Mouse;
  Work_Rect(big_window,xm,ym,wm,hm);
  Set_Clip(xm,ym,wm,hm);
  Set_Color(white,1000,1000,1000);
  Paint_Rect(xm,ym,wm,hm);
  Show_Mouse;
  cur_x := xm;
  cur_y := ym + ch;
end;

{ The following routines process menu item selection. Each one now only
  performs an ALERT box, but any type of code can be added.             }

Procedure item11_proc;
begin
  dummy := Do_Alert('[1][ITEM| 1 - 1][ OK ]',0);
end;

Procedure item12_proc;
begin
  dummy := Do_Alert('[1][ITEM| 1 - 2][ OK ]',0);
end;

Procedure item13_proc;
begin
  dummy := Do_Alert('[1][ITEM| 1 - 3][ OK ]',0);
end;

Procedure item21_proc;
begin
  dummy := Do_Alert('[1][ITEM| 2 - 1][ OK ]',0);
end;

Procedure item22_proc;
begin
  dummy := Do_Alert('[1][ITEM| 2 - 2][ OK ]',0);
end;

Procedure item23_proc;
begin
  dummy := Do_Alert('[1][ITEM| 2 - 3][ OK ]',0);
end;

Procedure item31_proc;
begin
  dummy := Do_Alert('[1][ITEM| 3 - 1][ OK ]',0);
end;

Procedure item32_proc;
begin
  dummy := Do_Alert('[1][ITEM| 3 - 2][ OK ]',0);
end;

Procedure item33_proc;
begin
  dummy := Do_Alert('[1][ITEM| 3 - 3][ OK ]',0);
end;

Procedure item41_proc;
begin
  dummy := Do_Alert('[1][ITEM| 4 - 1][ OK ]',0);
end;

Procedure item42_proc;
begin
  dummy := Do_Alert('[1][ITEM| 4 - 2][ OK ]',0);
end;

Procedure item43_proc;
begin
  dummy := Do_Alert('[1][ITEM| 4 - 3][ OK ]',0);
end;

Procedure item51_proc;
begin
  dummy := Do_Alert('[1][ITEM| 5 - 1][ OK ]',0);
end;

Procedure item52_proc;
begin
  dummy := Do_Alert('[1][ITEM| 5 - 2][ OK ]',0);
end;

Procedure item53_proc;
begin
  dummy := Do_Alert('[1][ITEM| 5 - 3][ OK ]',0);
end;

{ Here is where we find out which item is selected from the titles      }

Procedure title1_proc;
begin
  if msg[4] = item11 then
    item11_proc
  ELSE if msg[4] = item12 then
    item12_proc
  ELSE if msg[4] = item13 then
    item13_proc;
  Menu_Normal(a_menu,title1);
end;

Procedure title2_proc;
begin
  if msg[4] = item21 then
    item21_proc
  ELSE if msg[4] = item22 then
    item22_proc
  ELSE if msg[4] = item23 then
    item23_proc;
  Menu_Normal(a_menu,title2);
end;

Procedure title3_proc;
begin
  if msg[4] = item31 then
    item31_proc
  ELSE if msg[4] = item32 then
    item32_proc
  ELSE if msg[4] = item33 then
    item33_proc;
  Menu_Normal(a_menu,title3);
end;

Procedure title4_proc;
begin
  if msg[4] = item41 then
    item41_proc
  ELSE if msg[4] = item42 then
    item42_proc
  ELSE if msg[4] = item43 then
    item43_proc;
  Menu_Normal(a_menu,title4);
end;

Procedure title5_proc;
begin
  if msg[4] = item51 then
    item51_proc
  ELSE if msg[4] = item52 then
    item52_proc
  ELSE if msg[4] = item53 then
    item53_proc;
  Menu_Normal(a_menu,title5);
end;

{ So you want to build a DIALOG BOX. Here's how you do it               }

Procedure infodial;
begin
  sf := System_Font;
  Info_Box := New_Dialog(15,0,0,40,18);
  info_item := Add_DItem(Info_Box,G_Text,None,2,1,36,1,0,$1180);
  Set_DText(Info_Box,info_item,'Pascal Shell',sf,TE_Center);
  info_item := Add_DItem(Info_Box,G_Text,None,2,3,36,1,0,$1180);
  Set_DText(Info_Box,info_item,'by F.P. Nagle',sf,TE_Center);
  info_item := Add_DItem(Info_Box,G_Text,None,2,5,36,1,0,$1180);
  Set_DText(Info_Box,info_item,'Copyright (c) 1986',sf,TE_Center);
  info_item := Add_DItem(Info_Box,G_Text,None,2,9,36,1,0,$1180);
  Set_DText(Info_Box,info_item,'Portions of this program',
              sf,TE_Center);
  info_item := Add_DItem(Info_Box,G_Text,None,2,11,36,1,0,$1180);
  Set_DText(Info_Box,info_item,'Copyright (c) 1986 OSS & CCD',
              sf,TE_Center);
  info_item := Add_DItem(Info_Box,G_Text,None,2,13,36,1,0,$1180);
  Set_DText(Info_Box,info_item,'Used by permission of OSS.',
              sf,TE_Center);
  ok_button := Add_DItem(Info_Box,G_Button,Selectable|Exit_Btn|Default,
              15,15,8,2,2,$1180);
  Set_DText(Info_Box,ok_button,'OK',sf,TE_Center);
  Center_Dialog(Info_Box);
  button := Do_Dialog(Info_Box,0);
  End_Dialog(Info_Box);
  Menu_Normal(a_menu,Desk_Title);
end;

{ A menu item has been selected, here we find which one.                }

Procedure menu_proc;
begin
  If msg[3] = title1 then
    title1_proc
  ELSE if msg[3] = title2 then
    title2_proc
  ELSE if msg[3] = title3 then
    title3_proc
  ELSE if msg[3] = title4 then
    title4_proc
  ELSE if msg[3] = title5 then
    title5_proc
  ELSE if msg[3] = Desk_Title then
    infodial;
end;

Procedure blnk_wind;
begin
end;

{ GEM has told us that the window was moved, so we must redraw it with
  the correct NEW size.                                                 }

Procedure move_wind;
begin
  Set_WSize(big_window,msg[4],msg[5],msg[6],msg[7]);
  draw_wind;
end;

{ GEM has told us that the window has been re-sized, so we need to redraw
  the NEW size window.                                                  }

Procedure size_wind;
begin
  Set_WSize(big_window,msg[4],msg[5],msg[6],msg[7]);
  draw_wind;
end;

{ GEM has told us to fill the screen with this window. Note we saved the
  maximum size in hx, hy, hw, hh when we opened the window initially.   }

Procedure full_wind;
begin
  xm := hx;
  ym := hy;
  wm := hw;
  hm := hh;
  Set_WSize(big_window,hx,hy,hw,hh);
  draw_wind;
end;

{ Here's how to draw a "cursor" on the screen.  It's only a line!       }

Procedure linex;
begin
  Line(cur_x + 2, cur_y - (ch - 3), cur_x + 2, cur_y);
end;

{ Here's how to position the "cursor" on the screen.                    }

Procedure pos_cursor;
begin
  cur_x := cur_x + cw;
  If cur_x > (xm + wm) - cw then
    begin
    cur_x := xm;
    cur_y := cur_y + ch;
    If cur_y > (hm + ym) then
      begin
      cur_y := ym + ch;
      draw_wind;
      end
    end;
  linex;
end;

        { The only way to display text on the screen under GEM is to
          draw the string. We have saved the character value from the
          key pressed, so here we Draw_String (just one character) to
          the screen. cur_x and cur_y are the cursor position, and
          out_char is the value to be drawn.                            }

Procedure disp_it;
begin
  Draw_String(cur_x,cur_y,out_char);
end;

        { Here we change the integer value of the key pressed into a
          character which can be used by the Draw_String command. Before
          doing anything to the screen though, we Hide_Mouse so we don't
          lose part of what we want to show. After we get done, we
          Show_Mouse again.                                             }

Procedure disp_char;
begin
  Hide_Mouse;
  out_char := chr(key_lo);
  disp_it;
  pos_cursor;
  Show_Mouse;
end;

        { Because we are Drawing to the screen, if a back space is
          entered, we need to erase the cursor (line) and move back
          one, and draw a space to the screen. We also need to check
          if the cursor is at the far left already. If so, we can't
          go back any further on this line, so position it at the
          beginning of the current line. You could also add code to
          move UP a line and continue back spacing if desired. This
          is only a demo, so we cut it short here.                      }


Procedure back_space;
begin
  Hide_Mouse;
  out_char := chr(32);
  disp_it;
  cur_x := cur_x - cw;
  if cur_x < xm then
    cur_x := xm;
  disp_it;
  linex;
  Show_Mouse;
end;

        { We received a carriage return (ENTER), so we need to erase
          the cursor (line) on the current line. By making the cur_x
          position off the right side of the screen, we can use the
          pos_cursor routine to determine the new line position.        }

Procedure carr_return;
begin
  Hide_Mouse;
  out_char := chr(32);
  disp_it;
  cur_x := xm + wm + cw;
  pos_cursor;
  Show_Mouse;
end;

Procedure esc_char;
begin

{ To actually send the escape character to any output you
  need to use BIOS(3) since GEM will "swallow" all escape
  characters                                               }

{ bconout(zeron,escn);                                     }

end;

Procedure not_used;
begin

{ This program doesn't use these particular keys, but that
  does not mean that they aren't available to you for your
  own usage.  Just  define the  routine  that you  need to
  handle your particular needs.                            }

end;

        { Here we check what value we received from the key pressed.
          I only show a check of the low value, not the entire 16
          bit value. In order to determine the use of Function keys
          and the special Help/Undo etc. keys, you would have to check
          the high value also, or use the full integer value.           }

Procedure check_key;
begin
  CASE key_lo of
    32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,
    52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,
    72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,
    92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,
    109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,
    124,125,126,127             :       disp_char;
    8                           :       back_space;
    13                          :       carr_return;
    27                          :       esc_char;
    0,1,2,3,4,5,6,7,9,10,11,12,14,15,16,17,18,19,20,21,22,23,24,
    25,26,28,29,30,31           :       not_used;
  END;
end;

        { Here we break the 16 bit integer value into two parts, the
          high and low values. Since this is a demo, we are only
          checking for normal ASCII values, excluding Function keys etc.}

Procedure key_process;
begin
  key_lo := what_key & $00FF;
  key_hi := what_key & $FF00;
  key_hi := ShR(key_hi,8);
  check_key;

end;

        { Once we have received a message from GEM it is up to your
          program to determine just what to do with it. This routine
          checks the most used messages, and performs a simple routine
          within the program to handle each type of message.            }

Procedure msg_process;
begin
  Case msg[0] of
        MN_Selected     :  If Front_Window = big_window then
                                menu_proc;

        WM_Sized        :  If Front_Window = big_window then
                                size_wind;

        WM_Fulled       :  If Front_Window = big_window then
                                full_wind;

        WM_Moved        :  If Front_Window = big_window then
                                move_wind;

        WM_Redraw       :  If msg[3] = big_window then
          Do_Redraw(msg[3],msg[4],msg[5],msg[6],msg[7]);

        WM_Topped       :  Do_Topped;

  end;

end;

        { This is the heart of the program. This event routine is
          repeated over and over until a WM_Closed message is
          received. If the window is closed, the program ends. You
          could also use a QUIT command in one of your menus, and
          force a closed message to cause the program to end.           }

Procedure event_rtn;
begin
  event := Get_Event(event_val,
                     0,0,0,             { No button goodies     }
                     0,                 { No timer              }
                     False,0,0,0,0,     { No mouse rects        }
                     False,0,0,0,0,
                     msg,
                     what_key,          { Key pressed           }
                     dummy,dummy,       { Not used              }
                     dummy,dummy,
                     dummy
                     );

  If (event & E_Message) <> 0 then
    msg_process;

  If (event & E_Keyboard) <> 0 then
    key_process;

end;

        { This is a demonstratin of how to create your own menu. Variables
          could be of any integer type, so an array would work. I just
          found it simpler to identify each one uniquely.               }

Procedure build_menu;
begin
  a_menu := New_Menu(30,'Pascal Shell');

  title1 := Add_MTitle(a_menu,' Title 1 ');
  title2 := Add_MTitle(a_menu,' Title 2 ');
  title3 := Add_MTitle(a_menu,' Title 3 ');
  title4 := Add_MTitle(a_menu,' Title 4 ');
  title5 := Add_MTitle(a_menu,' Title 5 ');

  item11 := Add_MItem(a_menu,title1,'  Item 1-1 ');
  item12 := Add_MItem(a_menu,title1,'  Item 1-2 ');
  item13 := Add_MItem(a_menu,title1,'  Item 1-3 ');

  item21 := Add_MItem(a_menu,title2,'  Item 2-1 ');
  item22 := Add_MItem(a_menu,title2,'  Item 2-2 ');
  item23 := Add_MItem(a_menu,title2,'  Item 2-3 ');

  item31 := Add_MItem(a_menu,title3,'  Item 3-1 ');
  item32 := Add_MItem(a_menu,title3,'  Item 3-2 ');
  item33 := Add_MItem(a_menu,title3,'  Item 3-3 ');

  item41 := Add_MItem(a_menu,title4,'  Item 4-1 ');
  item42 := Add_MItem(a_menu,title4,'  Item 4-2 ');
  item43 := Add_MItem(a_menu,title4,'  Item 4-3 ');

  item51 := Add_MItem(a_menu,title5,'  Item 5-1 ');
  item52 := Add_MItem(a_menu,title5,'  Item 5-2 ');
  item53 := Add_MItem(a_menu,title5,'  Item 5-3 ');

  Draw_Menu(a_menu);
end;

        { Just an alert box at the very beginning of the program.       }

Procedure show_progname;
begin
  dummy := Do_Alert('[1][SHELL.PAS|Version 1.0|by F.P.Nagle][ OK ]',0);
end;

        { I always set up at least one initialize procedure in my programs
          which is always called once. This sets the initial values I
          need for titles, etc. Don't rely on ANY compiler to initialize
          your values for you. Play it safe and do it yourself!         }

Procedure init;
begin
  zeron         := 0;
  escn          := 27;
  wind_title    := 'Pascal Program Shell';
  windtype      := G_Name | G_Close | G_Move | G_Size | G_Full;
  event_val     := E_Message | E_Keyboard;

  Text_Style(Normal);
  Sys_Font_Size(cw,ch,bw,bh);
end;

        { This procedure creates and opens YOUR program window!         }

Procedure open_wind;
begin
  big_window := New_Window(windtype,wind_title,0,0,0,0);
  Open_Window(big_window,0,0,0,0);
  Work_Rect(0,hx,hy,hw,hh);    { Here we save the full size for later use }
  Work_Rect(big_window,xm,ym,wm,hm);  { This is the screen work size }
  cur_x := xm;                 { Initialize cursor positions         }
  cur_y := ym + ch;
  blnk_wind;
end;

        { Every program normally has some cleanup to do when the program
          ends. This is my End Of Program (eop) processing. Close the
          window, delete OUR menu etc.                                  }

Procedure eop_processing;
begin
  Close_Window(big_window);
  Delete_Window(big_window);
  Erase_Menu(a_menu);
  Delete_Menu(a_menu);
end;

        { This is the main program. We initialize GEM and check that we
          can run. Init_Mouse will always eliminate any Hides we may have
          remaining from previous programs. It will ALWAYS bring the mouse
          into view. Once we know the status of the mouse we can then
          HIDE it within our program. The clear screen command paints a
          white screen for our program. Just a simple way to give us a
          clean slate to begin with. We then execute a series of procedures
          to set up our program. The repeat within this is the main LOOP
          to continually check for events. When the event is to close the
          window, then we are DONE! The End Of Program processing will
          actually Close and Delete our Window and Menus.               }

BEGIN
        If Init_Gem >= 0 then
        begin
                Init_Mouse;
                Hide_Mouse;
                Clear_Screen;
                build_menu;
                show_progname;
                init;
                open_wind;
                Show_Mouse;
                Repeat
                  event_rtn
                Until msg[0] = WM_Closed;
                eop_processing;
        end;

        { After having used Personal Pascal on a few packages about to
          be released, I felt that the information I had gained could
          be helpful to others in creating GEM applications for the
          520/1040 ST. This SHELL can be expanded into a multitude of
          applications. If you develop a new idea based on this, and
          are looking for ways of distributing it, I can be reached at
          the following:

          Frank P. Nagle
          38346 Logan Drive
          Fremont, CA 94536-5901
          Answering machine [phone]
          MCI Mail - FNAGLE
          Compuserve - 70505,577
          Delphi - FRANKN
          GEnie - F.NAGLE

          Good luck with your Personal Pascal work!                     }

end.