Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!caip!nike!ucbcad!ucbvax!AMES-NAS.ARPA!fouts
From: fouts@AMES-NAS.ARPA
Newsgroups: net.micro.atari16
Subject: OSS Demo (3 of 5 pager.pas)
Message-ID: <8607270600.AA14242@ames-nas.ARPA>
Date: Sun, 27-Jul-86 02:00:04 EDT
Article-I.D.: ames-nas.8607270600.AA14242
Posted: Sun Jul 27 02:00:04 1986
Date-Received: Sun, 27-Jul-86 06:19:40 EDT
Sender: daemon@ucbvax.BERKELEY.EDU
Organization: The ARPA Internet
Lines: 953


This is pager.pas, it's the third part of my OSS Pascal demo. Place this,
    strval.pas, and peekpoke.pas in the same file, and compile pager.pas.

- ----- CUT HERE -----
{
  pager.pas is a demonstration of the GEM interface, as exercised
  by OSS Personal Pascal.  Pager.pas is in the public domain, and
  may be used for any purpose, so long as the author is acknowledged.

  Martin Fouts
}

PROGRAM pager;

CONST
  {$I GEMCONST.PAS}
  SUPER_MODE = $20;  { GEMDOS call number to enter supervisor mode }
  Max_Wind = 10;
  Delay = 10000; { Time between timeouts (in milliseconds) }
  Max_Char = 80;

TYPE
  {$I GEMTYPE.PAS}
  Wind_No = 1..Max_Wind;
  { Ubuffer = packed array [1..Max_Char] of char;}
  UBuffer = string [255];
  UTPtr = ^Utext;
  Utext = Record
    Prev, Next : UTPtr;
    Uline : Ubuffer;
  End;
  UFile = packed File of char;
  Wind_Rec = Record
    Handle : integer;    { GEM Handle from New_Window }
    InUse : boolean;     { True if this record is in use }
    Title : string;      { Contents of title bar }
    Full : boolean;      { True if last click on full made full window }
    Ufp : UFile;         { File associated with window }
    Ufirst : UTPtr;      { Start of data from this file }
    Ulast : UTPtr;       { End of data from this file }
    UCurrent : UTPtr;    { First line of current screen }
    UCharNo : integer;   { First character of current screen (zero based )}
    ULineNo : integer;   { First line of current screen }
    UWide : integer;     { Width of widest line in this file }
    UHigh : integer;     { Number of lines read in }
    LWide : integer;     { Number of characters wide }
    LHigh : integer;     { Number of characters high }
    X_percent : 0..1000; { Position of slider, initially 0 }
    Y_percent : 0..1000; { Position of slider, initially 0 }
    Ended : boolean;     { True if EOF(Ufp) has occured }
    { Current coordinates }
    windx, windy, windw, windh : integer;
    { Last coordinates less than full size }
    smallx, smally, smallw, smallh : integer;
    { Coordinates of working space }
    workx, worky, workw, workh : integer;
  end;
  Wind_Array = array[Wind_No] of Wind_Rec;

VAR
  wind : Wind_Array;    { Track the windows we are using }
  running : boolean;    { Set to false to quit execution }
  pathname : string;    { Default search path for file opens }
  filename : string;    { Filename returned by select file }
  mymenu : Menu_Ptr;    { Pointer to menu for this program }
  mytitle : Integer;    { Pointer to first (only) title bar in menu }
  Item1 : Integer;      { First (open) item in File menu }
  Item2 : Integer;      { Second (close) item in File menu }
  Item3 : Integer;      { Third (quit) item in File menu }
  B_Left : Integer;     { Status of Left Button, 0 = up, 1 = down }
  InWindow : Boolean;   { True if in the front (active) window }
  Timeouts : Integer;   { Count the number of timeouts }
  cw, ch : Integer;     { Width and Height of a character }
  bw, bh : Integer;     { Width and Height of a box around a char }
  ticks : long_integer; { Timer count at start of program }
  mouse_init : Boolean; { True if mouse has been initialized }
  menu_init : Boolean;  { True if menu has been initialized }

{$I GEMSUBS.PAS}
{$I PEEKPOKE.PAS}
{$I STRVAL.PAS}

FUNCTION min (x, y : integer) : integer;
BEGIN
  if (x < y)
  THEN min := x
  ELSE min := y;
END;

FUNCTION max (x, y : integer) : integer;
BEGIN
  if (x > y)
  THEN max := x
  ELSE max := y;
END;

PROCEDURE Update_Slides(VAR wind : Wind_Rec);
VAR
  XSize : Integer;
  YSize : Integer;

  FUNCTION Kof(X,Y:integer) : integer;
  { Returns X div Y, normalized to the range 0-1000,
    excess values are 'clipped' to the endpoints of the range }
  VAR
    Ftemp1 : real;
    Ftemp2 : real;
    Itemp : Integer;
  BEGIN
    { These calculations are done this way to avoid integer overflow
      and preserve decimal places. }
    IF (Y = 0) { Avoid divide by zero errors }
      THEN Kof := 0
      ELSE
        BEGIN
          Ftemp1 := X;
          Ftemp2 := Y;
          ITemp := Trunc((Ftemp1 / Ftemp2) * 1000.0);
          Kof := MAX(MIN(1000,Itemp),1);
        END;
  END;

BEGIN
  WITH wind DO
  BEGIN
    work_rect(handle,WorkX,WorkY,WorkW,WorkH);
    sys_font_size(cw,ch,bw,bh);
    LWide := WorkW div cw; { convert pixel size to character size }
    LHigh := WorkH div ch;
    { Calculate position and size of horizontal elevator }
    X_Percent := Kof(UCharNo+1,UWide);
    XSize := Kof(LWide,UWide);
    { Calculate position and size of vertical elevator }
    IF (Ended)
      THEN
        BEGIN  { Actually know length of file, so use real values }
          Y_Percent := Kof(UlineNo,Uhigh);
          YSize := Kof(LHigh,UHigh);
        END
      ELSE
        BEGIN  { Don't know length, allow one page of end room }
          Y_Percent := Kof(UlineNo,(Uhigh+Lhigh));
          YSize := Kof(LHigh,(UHigh+Lhigh));
        END;
    { Now set the elevator position and size }
    Wind_Set(handle,WF_HSlSize,XSize,0,0,0);
    Wind_Set(handle,WF_VSlSize,YSize,0,0,0);
    Wind_Set(handle,WF_HSlide,X_percent,0,0,0);
    Wind_Set(handle,WF_VSlide,Y_percent,0,0,0);
  END;
END;

FUNCTION super( sp: long_integer) : long_integer;
  GEMDOS($20);

FUNCTION Get_timer : long_integer;
VAR
  ssp : long_integer;
BEGIN
  ssp := super(0);
  Get_timer := 5*lpeek($4ba);
  ssp := super(ssp);
END;

PROCEDURE Get_String(VAR Ufd:Ufile; VAR Uline:Ubuffer;
                     VAR Ended : boolean);
{ Read a carriage return terminated string and return it with
  the carriage return replaced by null }
VAR
  i : integer;
  c : char;
BEGIN
  i := 0;
  c := chr(0);
  ended := false;
  WHILE (i < Max_Char) AND (c <> chr(13)) AND (NOT Ended) DO
  BEGIN
    c := Ufd^;
    i := i + 1;
    Uline[i] := c;
    Ended := Eof(Ufd);
    IF NOT Ended THEN get(Ufd);
  END;
  Ended := Eof(Ufd);
  IF NOT Ended THEN get(Ufd); { Skip the linefeed }
  Uline[0] := chr(i);
  If i = 0 THEN i := 1;
  Uline[i] := chr(0);
END;

PROCEDURE Init_Menu;
{ Set up the Menu.  GEM Requires all titles first, then all items
  IN ORDER within Title. }
BEGIN
  menu_init := true;
  mymenu := New_Menu(10, ' About Pager');
  mytitle := Add_MTitle(mymenu,' FILE ');
  Item1 :=   Add_MItem(mymenu,mytitle,' Open ');
  Item2 :=   Add_MItem(mymenu,mytitle,' Close ');
  Item3 :=   Add_MItem(mymenu,mytitle,' Quit ');
  Draw_Menu(mymenu);
END;

FUNCTION Match_Window(new_handle : integer) : integer;
{ Find the window record for the specified handle. Return 0 if not found }
VAR
 i, n : Integer;
BEGIN
  n := 0;
  FOR i := 1 to Max_Wind DO
    IF (Wind[i].handle = new_handle) THEN n := i;
  Match_Window := n;
END;

PROCEDURE Redraw_Text(handle,x,y,w,h:integer);
VAR
  i : integer;
  lines : integer;
  lineno : integer;
  ptr : UTPtr;
  finished : boolean;
BEGIN
  i := Match_Window(handle);
  Set_Clip(x,y,w,h);
  WITH Wind[i] DO
  BEGIN
    Work_Rect(handle,x,y,w,h);
    lines := h div ch;
    ptr := Ucurrent;
    lineno := 1;
    finished := false;
    WHILE (lineno <= lines) AND (NOT finished) DO
      BEGIN
        IF (Ptr = nil)
        THEN
          BEGIN
            IF (NOT Ended) THEN
              BEGIN
                New(ptr);
                Get_String(Ufp,Ptr^.Uline,Ended);
                Draw_String(cw*(-UCharNo),ch*lineno,Ptr^.Uline);
                Uhigh := Uhigh + 1;
                Uwide := MAX(UWide,Length(Ptr^.Uline));
                ptr^.prev := Ulast;
                Ulast^.next := ptr;
                Ulast := ptr;
                ptr^.next := nil;
                ptr := ptr^.next;
              END;
            finished := Ended;
          END
        ELSE
          BEGIN
            Draw_String(cw*(-UCharNo),ch*lineno,Ptr^.Uline);
            Ptr := Ptr^.next;
          END;
        lineno := lineno + 1;
      END;
  END;
  Update_Slides(wind[i]);
END;

FUNCTION Free_Window : integer;
{ Find an unused window. Returns 0 if none available. }
VAR
  i : Integer;
  found : Boolean;
BEGIN
  found := False;
  i := 1;
  WHILE (i < Max_wind) AND (NOT found) DO
  BEGIN
    found := NOT wind[i].InUse;
    i := i + 1;
  END;
  IF found
    THEN Free_Window := i - 1
    ELSE Free_Window := 0;
END;

PROCEDURE Make_Window(VAR wind : Wind_Rec);
 { Build the data structures for a window }
BEGIN
  WITH wind DO
  BEGIN
    InWindow := false;
    B_Left := 0;
    title := filename;
    handle := New_Window(G_All,title,0,0,0,0);
    full := true;
    InUse := true;
    UWide := 0;
    UHigh := 0;
    X_percent := 0;
    Y_percent := 0;
    ULineNo := 0;
    Ufirst := nil;
    ULast := nil;
    UCurrent := nil;
    UCharNo := 0;
    Ended := False;
  END;
END;

PROCEDURE Draw_Window(VAR wind : Wind_Rec);
 { Draw the window on the screen }
VAR
  x, y, w, h : Integer;
BEGIN
  WITH wind DO
  BEGIN
    Begin_Update;
    Hide_Mouse;
    Open_Window(handle,0,0,0,0);
    Set_Window(handle);
    Bring_To_Front(handle);
    Work_rect(handle,workx,worky,workw,workh);
    Set_Clip(workx,worky,workw,workh);
    smallx := workx;
    smally := worky;
    smallw := workw div 2;
    smallh := workh div 2;
    Update_Slides(wind);
    Show_Mouse;
    End_Update;
  END;
END;

PROCEDURE Update_window(handle : integer);
VAR
  x, y, w, h : Integer;
  x0, y0, w0, h0 : Integer;
BEGIN
  Begin_Update;
  Hide_Mouse;
  Work_Rect(handle,x0,y0,w0,h0);
  First_Rect(handle,x,y,w,h);  { Locate an area in need of update }
  WHILE (w <> 0) OR (h <> 0) DO
    BEGIN               { For each area of the window }
      Paint_Rect(x-x0,y-y0,w,h); { need to convert absolute to }
      Redraw_Text(handle,x,y,w,h);
      Next_Rect(handle,x,y,w,h); { Find another rectangle to test }
  END;
  Show_Mouse;
  End_Update;
END;

PROCEDURE prev_window(VAR wind : Wind_rec; lines : integer);
VAR
  lineno : integer;
  ptr : UTPtr;
BEGIN
  WITH wind DO
  BEGIN
    work_rect(handle,workx,worky,workw,workh);
    Paint_Rect(0,0,workw,workh);
    ptr := UCurrent;
    IF (ptr <> NIL) THEN
      WHILE (lines > 0) AND (ptr^.prev <> nil) DO
        BEGIN
          lines := lines - 1;
          ULineNo := ULineNo - 1;
          ptr := ptr^.prev;
        END;
    UCurrent := ptr;
    Update_window(handle);
  END;
END;

PROCEDURE next_window(VAR wind : Wind_rec; lines : integer);
VAR
  lineno : INTEGER;
  Ptr : UTPtr;
BEGIN
  WITH wind DO
  BEGIN
    work_rect(handle,workx,worky,workw,workh);
    Paint_Rect(0,0,workw,workh);
    lineno := 1;
    ptr := Ucurrent;
    IF (ptr <> NIL) THEN
      WHILE (lineno <= lines) AND (Ptr^.next <> nil) DO
        BEGIN
          ptr := ptr^.next;
          lineno := lineno + 1;
          ULineNo := ULineNo + 1;
        END;
    UCurrent := ptr;
    Update_Window(handle);
  END;
END;

PROCEDURE fill_window(VAR wind : Wind_rec);
VAR
  lines : INTEGER;
  lineno : INTEGER;
  Ptr : UTPtr;
BEGIN
  WITH wind DO
  BEGIN
    lines := LHigh;
    reset(Ufp,filename); { Open the file for reading }
    lineno := 1;
    WHILE (lineno <= lines) AND (NOT ended) DO
      BEGIN
        new(Ptr);
        If (UFirst = nil) THEN UFirst := Ptr;
        Ptr^.Prev := Ucurrent;
        IF (UCurrent <> Nil) THEN Ucurrent^.Next := Ptr;
        Ptr^.Next := Nil;
        UCurrent := Ptr;
        Get_String(Ufp,Ptr^.Uline,Ended);
        lineno := lineno + 1;
        UHigh := UHigh + 1;
        UWide := MAX(UWide,Length(Ptr^.Uline));
      END;
    ULast := UCurrent;
    UCurrent := UFirst;
  END;
  UPdate_Slides(wind);
END;

FUNCTION Init_Window : Boolean;
{ Attempt to create a new window and open a file.  Returns false if aborted by
  the filename dialog, or if there are no windows left }
VAR
  n : Integer;
  temp : Boolean;
  i : integer;
  trying : Boolean;
PROCEDURE IO_CHECK(flag:boolean); EXTERNAL;
FUNCTION IO_RESULT : INTEGER; EXTERNAL;
BEGIN
  n := Free_Window;  { Find a window record for this window }
  temp := n > 0;
  IF NOT temp      { No window available, so fail }
    THEN n := Do_Alert('[3][No More Windows][ OK ]',1)
         { Have a window, so look for a file spec }
    ELSE
      BEGIN
        trying := Get_In_file(pathname,filename);
        WHILE Trying DO
          BEGIN  { Try to open the specified file }
            IO_Check(false);       { We want to handle I/O problems }
            reset(wind[n].Ufp,filename);
            i := IO_Result;
            IO_check(true);
            if (i = 0)
              THEN
                BEGIN
                  temp := true;
                  trying := false;
                END
              ELSE
                BEGIN
                  i := Do_Alert('[3][Open failed!][ OK ]',1);
                  temp := Get_In_file(pathname,filename);
                  trying := temp;
                END;
          END;
      END;
  IF temp THEN  { Set up the window }
    BEGIN
      Make_Window(wind[n]);
      Draw_Window(wind[n]);
      Fill_Window(wind[n]);
    END;
  Init_Window := temp;
END;

PROCEDURE Start_up;
{ Initialize the mouse and the menu and open the first window }
VAR
  i : integer;
  x, y, w, h : Integer;
BEGIN
  { First, give user a chance to bag the program }
  i := Do_Alert(
     '[1][ File Pager | A Program by Martin Fouts ][ Ready | Cancel ]',2);
  running := (i = 1);
  pathname := 'A:*.*';
  mouse_init := false;
  menu_init := false;
  IF running THEN
    BEGIN
      Init_Menu;
      Init_Mouse;
      mouse_init := true;
      Sys_Font_Size(cw,ch,bw,bh);
      Paint_Color(White);
      running := Init_Window;
      timeouts := 0;
      ticks := Get_timer; { What time is it? }
    END;
END;

PROCEDURE Process;
{ Where the work gets done.  Handle a keyboard or message event }
VAR
  i : integer;
  message : Message_Buffer;  { These are all returned by get_event }
  key : Integer;
  bcnt : Integer;
  bstate : Integer;
  mx : Integer;
  my : Integer;
  kbd_state : Integer;
  Cur_X, Cur_Y, Cur_W, Cur_H : Integer;

  PROCEDURE Do_Message;   { Process a Message event }

    PROCEDURE Close_It(n:Integer); { Close a window }
    VAR
      windno, x0, y0, w0, h0 : Integer;
    BEGIN
      Close_Window(n);
      Delete_Window(n);
      Set_Window(Front_Window);
      Work_Rect(Front_Window, x0, y0, w0, h0);
      Set_Clip(x0, y0, w0, h0);
      windno := Match_Window(n);
      WITH Wind[windno] DO
        BEGIN
          InUse := False;
          Close(Ufp);
          IF (UFirst <> Nil) THEN
            WHILE (Ufirst <> Nil) DO
              BEGIN
                UCurrent := Ufirst^.Next;
                Dispose(Ufirst);
                UFirst := UCurrent;
              END;
        END;
    END;

    PROCEDURE Do_Selection; { Process a menu selection event }

    VAR
      temp : integer;

      PROCEDURE Menu_Open; { File Menu Open Item selected }
      VAR
        temp : boolean;
      BEGIN
        temp := Init_Window;   { Open A Window }
      END;

      PROCEDURE Menu_Close; { File Menu Close Item selected }
      BEGIN
        Close_It(Front_Window);
      END;

      PROCEDURE Menu_Quit;  { File Menu Quit Item selected }
      VAR                   { Use an alert to verify the Quit }
        temp : integer;
      BEGIN
        temp :=
          Do_Alert('[3][ Do you really want to Quit? ][ Quit | Continue ]',2);
          running := (temp <> 1);  { Return FALSE to Quit! }
      END;

    BEGIN
      Menu_Normal(mymenu,message[3]); { Turn off menu highlight }
      IF (message[3] = 3) THEN  { Special case, the INFO box }
        temp := Do_Alert('[1][A Sample Program][ OK ]',0)
      ELSE IF (message[4] = item1) THEN Menu_Open
      ELSE IF (message[4] = item2) THEN Menu_Close
      ELSE IF (message[4] = item3) THEN Menu_Quit;
    END; { Procedure Do_Selection }

    PROCEDURE Do_Redraw;  { Handle a redraw message }
    VAR
     temp, x, y, w, h : Integer;
     x0, y0, w0, h0 : Integer;
    BEGIN
      Begin_Update;        { Prevent interference }
      Hide_Mouse;          { Keep the mouse out of the way }
      temp := Get_Window;  { Remember the active window }
      Set_Window(message[3]); { Make the updated window active }
      Work_Rect(message[3],x0,y0,w0,h0); { Find out about it }
      Set_Clip(x0,y0,w0,h0);
      First_Rect(message[3],x,y,w,h);  { Locate an area in need of update }
      WHILE (w <> 0) OR (h <> 0) DO
        BEGIN               { For each area of the window }
          IF Rect_Intersect(message[4],message[5],message[6],message[7],
                            x,y,w,h) THEN
            BEGIN           { Find the area which must be updated and do so }
              Paint_Rect(x-x0,y-y0,w,h); { need to convert absolute to }
              Redraw_Text(message[3],x,y,w,h);
            END;                         { relitive coordinates for Paint }
          Next_Rect(message[3],x,y,w,h); { Find another rectangle to test }
        END;
      Show_Mouse;           { Make the mouse active again }
      End_Update;           { Allow GEM activity again }
      Set_Window(temp);     { Restore the active window }
      Work_Rect(temp,x0,y0,w0,h0);
      Set_Clip(x0,y0,w0,h0); { And set it up as the i/o port }
    END;

    PROCEDURE Do_Newtop;     { Bring a new window to the top }
    BEGIN
      Bring_To_Front(message[3]);
      Set_Window(message[3]);
    END;

    PROCEDURE Do_Close;       { Close a window (and it's file) }
    BEGIN
      Close_It(message[3]);
    END;

    PROCEDURE Do_Fulled;      { Handle a click on the full box }
    var
      n, x, y, w, h : integer;
    BEGIN
      n := Match_Window(message[3]);  { Find the window }
      WITH wind[n] DO
        BEGIN
          IF Wind[n].Full     { If already full then shrink the window }
          THEN
            BEGIN
              Set_WSize(handle, smallx, smally, smallw, smallh);
              windx := smallx;
              windy := smally;
              Windw := smallw;
              windh := smallh;
            END
          ELSE
            BEGIN                  { If small make largest size possible }
              Wind_Get(handle,WF_FullXYWH,windx,windy,windw,windh);
              Set_Wsize(handle,windx,windy,windw,windh);
            END;
          Full := NOT Full;    { Swap the full mode }
          Update_Slides(wind[n]);
        END;
    END;

    PROCEDURE Do_Arrowed;      { Handle an arrow being clicked }
    VAR
      n : integer;

      PROCEDURE Page_up;
      BEGIN
        prev_window(wind[n],wind[n].Lhigh);
      END;

      PROCEDURE Page_down;
      BEGIN
        next_window(wind[n],wind[n].Lhigh);
      END;

      PROCEDURE Row_up;
      BEGIN
        WITH wind[n] DO
          BEGIN
            if (Ucurrent <> nil) THEN
              if (Ucurrent^.prev <> nil) THEN
                BEGIN
                  Ucurrent := Ucurrent^.prev;
                  update_window(handle);
                  ULineno := ULineno - 1;
                END;
          END;
      END;

      PROCEDURE Row_down;
      BEGIN
        WITH wind[n] DO
          BEGIN
            if (Ucurrent <> nil) THEN
              if (Ucurrent^.next <> nil) THEN
                BEGIN
                  Ucurrent := Ucurrent^.next;
                  update_window(handle);
                  ULineno := ULineno + 1;
                END;
          END;
      END;

      PROCEDURE Page_left;
      BEGIN
        WITH wind[n] DO
          BEGIN
            if (UCharNo >= Lwide)
              THEN UCharNo := UCharNo - Lwide
              ELSE UCharNo := 1;
            update_window(handle);
          END;
      END;

      PROCEDURE Page_right;
      BEGIN
        WITH wind[n] DO
          BEGIN
            if (wind[n].UCharNo <= (Uwide - Lwide - 2))
              THEN UCharNo := UCharNo + LWide
              ELSE UcharNo := Uwide - Lwide - 2;
            update_window(handle);
          END;
      END;

      PROCEDURE Column_left;
      BEGIN
        if (wind[n].UCharNo > 0 ) THEN
          BEGIN
            wind[n].UCharNo := wind[n].UCharNo - 1;
            update_window(wind[n].handle);
          END;
      END;

      PROCEDURE Column_right;
      BEGIN
        WITH wind[n] DO
          BEGIN
            if (UCharNo <= (Uwide - Lwide)) THEN
              BEGIN
                UCharNo := UCharNo + 1;
                update_window(handle);
              END;
          END;
      END;

      PROCEDURE No_move;
      BEGIN
      END;

    BEGIN
      n := Match_window(message[3]);
      CASE message[4] OF
        0: Page_up;
        1: Page_down;
        2: Row_up;
        3: Row_down;
        4: Page_left;
        5: Page_right;
        6: Column_left;
        7: Column_right;
        OTHERWISE: No_move;
      END;
    END;

    FUNCTION NofK(X,Y:integer) : integer;
    VAR
      temp1, temp2 : real;
    BEGIN
      temp1 := X;
      temp1 := temp1 / 1000.0;
      temp2 := Y;
      NofK := trunc(temp1*temp2) - 1;
    END;

    PROCEDURE Do_Hor;  { Horizontal slider movement }
    VAR
      n : integer;
    BEGIN
      n := Match_Window(message[3]);
      WITH wind[n] DO
        BEGIN
          UCharno := NofK(message[4],Uwide);
          update_window(handle);
        END;
    END;

    PROCEDURE Do_Ver;  { Vertical slider movement }
    VAR
      n : integer;
      newline : integer;
    BEGIN
      n := Match_Window(message[3]);
      WITH wind[n] DO
        BEGIN
          newline := NofK(message[4],Uhigh);
          IF (newline < Ulineno)
            THEN prev_window(wind[n],Ulineno-newline)
            ELSE
              IF (newline > Ulineno)
                THEN next_window(wind[n],newline-Ulineno);
        END;
    END;

    PROCEDURE Do_Size;
    { Change the size of the current window, and remember the new size }
    VAR
      n : integer;
    BEGIN
      n := Match_Window(message[3]);
      WITH wind[n] DO
        BEGIN
          Set_Wsize(handle,message[4],message[5],message[6],message[7]);
          smallx := message[4];
          smally := message[5];
          smallw := message[6];
          smallh := message[7];
          windx := smallx;
          windy := smally;
          windw := smallw;
          windh := smallh;
          Update_Slides(wind[n]);
        END;
    END;

    PROCEDURE Do_Move;
    { Move the current window to a new place }
    VAR
      n : integer;
    BEGIN
      n := Match_Window(message[3]);
      WITH wind[n] DO
        BEGIN
          Set_Wsize(handle,message[4],message[5],message[6],message[7]);
          smallx := message[4];
          smally := message[5];
          smallw := message[6];
          smallh := message[7];
          windx := smallx;
          windy := smally;
          windw := smallw;
          windh := smallh;
          Update_Slides(wind[n]);
        END;
    END;

    PROCEDURE Do_Nothing;
    BEGIN
    END;

    BEGIN
      CASE message[0] of
        MN_Selected : Do_Selection;
        WM_Redraw   : Do_Redraw;
        WM_Topped   : Do_Newtop;
        WM_Closed   : Do_Close;
        WM_Fulled   : Do_Fulled;
        WM_Arrowed  : Do_Arrowed;
        WM_HSlid    : Do_Hor;
        WM_Vslid    : Do_Ver;
        WM_Sized    : Do_Size;
        WM_Moved    : Do_move;
        Otherwise   : Do_Nothing;
      END;
    END;

    PROCEDURE Do_Keyboard;
    VAR
      temp : integer;
    BEGIN
      IF key = $06200 THEN { HELP Key pushed }
        temp := Do_Alert('[1][ I can''t fix your problems ][ Continue ]',1);
      IF key = $06100 THEN { UNDO Key pushed }
      BEGIN
        temp :=
          Do_Alert('[3][ Do you really want to Quit? ][ Quit | Continue ]',2);
          running := (temp <> 1);  { Return FALSE to Quit! }
      END;
    END;

    PROCEDURE New_Mouse(f:Boolean; n:Integer);
    VAR
      i : Integer;
    BEGIN
      IF f THEN i := 1 ELSE i := 0;
      i := i + (n * 2);
      CASE i OF
        0: Set_Mouse(M_Point_Hand);
        1: Set_Mouse(M_Outln_Cross);
        2: Set_Mouse(M_Arrow);
        3: Set_Mouse(M_Thin_Cross);
        OtherWise: Set_Mouse(M_Bee);
      END;
    END;

    PROCEDURE Do_Button;
    { Mostly for form, change the cursor when the left Button changes }
    BEGIN
      B_Left := 1 - B_Left;
      New_Mouse(InWindow,B_Left);
    END;

    PROCEDURE Do_Rect1;
    { Mostly for form, use the cursor shape to track if the mouse is in
      or out of the active window }
    BEGIN
      InWindow := Not InWindow;
      New_Mouse(InWindow,B_Left);
    END;

    PROCEDURE Do_Timer;
    { This one's just here to fill out the template }
    VAR
      i : integer;
      r : real;
      message : String;
      rval : String;
    BEGIN
      r := (Get_Timer - Ticks) / 1000.0; { Convert to seconds elapsed }
      Str(r,rval);
      message := Concat('[1][ Program run | ', rval,
                        ' | seconds ][ Continue ]');
      i := Do_Alert(message,1);
    END;

BEGIN  { Wait for a GEM message or a keyboard event }
  Work_Rect(Front_Window,Cur_X,Cur_Y,Cur_W,Cur_H);
  i := Get_Event(E_Keyboard|E_Message|E_Button|E_Mrect_1|E_Timer,
                 1, B_Left, 1,  { Wait for left button Change }
                 Delay,         { Wait for timeout }
                 InWindow,Cur_X,Cur_Y,Cur_W,Cur_H, { Front Window border }
                 False,0,0,0,0, { No Rectangle 2 }
                 message,       { Returns message if E_Message }
                 key,           { Returns key pressed if E_Keyboard }
                 bcnt,          { Returns button count if E_Button }
                 bstate,        { Returns button status if E_Button }
                 mx, my,        { Mouse position if E_Button }
                 kbd_state);    { Keyboard state if E_Keyboard }

  IF (i & E_Message) <> 0  THEN Do_Message;
  IF (i & E_Keyboard) <> 0 THEN Do_Keyboard;
  IF (i & E_Timer) <> 0 THEN Do_Timer;
  IF (i & E_MRect_1) <> 0 THEN Do_Rect1;
  IF (i & E_Button) <> 0 THEN Do_Button;

END; { Procedure Process }

PROCEDURE Clean_up;
VAR
  i : integer;
BEGIN
  FOR I := 1 to Max_wind DO
    IF wind[i].InUse THEN
      BEGIN
        Close_Window(wind[i].handle);
        Delete_Window(wind[i].handle);
      END;
  IF mouse_init THEN Set_Mouse(M_Arrow);
  IF menu_init THEN
    BEGIN
      Erase_Menu(mymenu);
      Delete_Menu(mymenu);
    END;
  Exit_Gem;
END;

PROCEDURE Go_For_It; { This is where it happens, Jack }
BEGIN
  running := false;
  Start_up;
  While running do Process;
  Clean_up;
END;

BEGIN { template }
  IF Init_Gem >= 0 THEN Go_For_It;
END. { PROGRAM template }