

{$U30+}

PROGRAM Opus;

{$I i:\opus.i}
{$I i:\GCTV.inc} { global Constants, Types and Variables }

{$I i:\gemsubs.def}
{$I i:\auxsubs.def}
{$I i:\vdi_aes.def}
{$I i:\globsubs.def}
{$I d:\pascal\opus\xbios.def}
{$I d:\pascal\opus\gemdos.def}
{$I d:\pascal\opus\graphout.def}
{$I d:\pascal\opus\resource.def}
{$I d:\pascal\opus\stringfn.def}
{$I d:\pascal\opus\bf.def}

PROCEDURE HANDLE_MESSAGE;
   EXTERNAL;
   

PROCEDURE MOUSE ( mx,my : INTEGER );
   { allows user to select active cell with mouse; select a range via
     dragging beginning in the active cell and extending to the end of the
     rubber box; select an entire row or column by clicking within the
     row/col title areas }
   TYPE ScreenAreas = ( DataArea,RowArea,ColArea );  
   VAR i,j,total,last_width,last_height,x,y,button,key,
       new_row,new_col,x_pos,y_pos,l_scr_row,l_scr_col,
       o_mx,o_my,col_separator,new_x,new_y,spec_col,
       new_width                                       : INTEGER;
       dummy                                           : BOOLEAN;
       code                                            : ScreenAreas;
   BEGIN { MOUSE }
          Work_Rect(act_hdl,x_1,y_1,w_1,h_1);
          code := DataArea;
          { check if user clicked within row/col title areas }
          IF (mx < x_1+38) AND (mx > x_1) THEN
             code := RowArea;
          IF (my < y_1+cell_height-1) AND (my > y_1) THEN
             code := ColArea;
          o_mx := mx;
          o_my := my;   
          IF code <> DataArea THEN BEGIN { outside data area }
             IF code = RowArea THEN      { still check for valid y or x in }
                mx := vert_grid[1]+10    { mouse_row_col }
             ELSE 
                my := y_1+y_margin+1;  
             IF mouse_row_col(mx,my,new_row,new_col) THEN BEGIN
                dummy := deselect_block;         { yes, valid x,y pos }
                IF code = RowArea THEN BEGIN { select all cells in }
                   b_s_row := new_row;       { that row }
                   b_e_row := new_row;
                   b_s_col := logical_col_1;
                   b_e_col := n_cols
                END
                ELSE BEGIN               { select all cells in that column }
                   b_s_row := logical_row_1;
                   b_e_row := n_rows;
                   b_s_col := new_col;
                   b_e_col := new_col
                END;
                block_st_set := TRUE;
                block_end_set := TRUE;
                block_set := TRUE;
                adjust_menu(TRUE); { activate block commands }
                hilight_block
             END
             ELSE IF (code = ColArea) AND (o_mx > vert_grid[1]+4) AND
                     (o_mx <= vert_grid[finish_col-start_col+2]+4) THEN BEGIN
                  FOR i := 2 TO finish_col-start_col+2 DO
                      IF (o_mx >= vert_grid[i]-4) AND        { bigger limit }
                         (o_mx <= vert_grid[i]+4) THEN BEGIN { than needed  }
                         col_separator := i;
                         spec_col := start_col+i-2
                      END;
                  Set_Mouse(M_Flat_Hand);
                  Drag_Box(vert_grid[col_separator],y_1,0,h_1,
                           vert_grid[col_separator-1]+39,y_1,
                           200,h_1,new_x,new_y);
                  Set_Mouse(M_Arrow);
                  new_width := (col_width[spec_col,pixels]+
                                new_x+3-vert_grid[col_separator]) DIV 8;
                  IF new_width <> col_width[spec_col,spaces] THEN BEGIN
                     IF new_width < 5 THEN
                        new_width := 5
                     ELSE IF new_width > 30 THEN
                        new_width := 30;
                     col_width[spec_col,spaces] := new_width;
                     col_width[spec_col,pixels] := new_width*8;
                     Send_Redraw(TRUE,0,0,screen_width,screen_height)
                  END
             END
             ELSE              
          END { code <> DataArea }
          ELSE { clicked w/in worksheet data area }
             { must start with a valid mouse location, so...}
             IF mouse_row_col(mx,my,new_row,new_col) THEN BEGIN
                { first redraw the cell(s) affected, i.e. old and new }
                Hide_Mouse;
                toggle_inverse(Black,data_row,data_col);
                Show_Mouse;
                data_row := new_row;
                data_col := new_col;
                find_screen_pos(new_row,new_col,scr_row,scr_col);
                cell_on_screen(1,data_row,data_col,TRUE);
                write_cell_name;
                { find the x,y coordinates of the current cell's upper left-hand
                  corner }
                Work_Rect(act_hdl,x_1,y_1,w_1,h_1);
                Set_Clip(x_1,y_1,w_1,h_1);
                x_pos := vert_grid[scr_col];
                y_pos := y_1+y_margin+(scr_row-1)*cell_height;
                event := Get_Event(E_Timer,0,0,0,200,FALSE,0,0,0,0,
                                   FALSE,0,0,0,0,msg_area,i,i,i,i,i,i);
                Graf_MKState(x,y,button,kbd_state);
                IF button = 1 THEN { started within current cell?? }
                   IF (x > x_pos) AND
                      (x < x_pos+col_width[data_col,pixels]) AND
                      (y > y_pos) AND (y < y_pos+cell_height) THEN BEGIN
                      dummy := deselect_block;
                      Set_Mouse(M_Point_Hand);
                      Rubber_Box(x,y,4,6 DIV rez,last_width,last_height);
                      Set_Mouse(M_Arrow);
                      { valid stopping location for end-block? }
                      IF mouse_row_col(x+last_width,y+last_height,
                                       new_row,new_col) THEN BEGIN
                         b_s_row := data_row;
                         b_s_col := data_col;
                         b_e_row := new_row;
                         b_e_col := new_col;
                         { valid range bounds? }
                         IF NOT ((b_e_row < b_s_row) OR (b_e_col < b_s_col))
                         THEN BEGIN
                            adjust_menu(TRUE);
                            block_set := TRUE;
                            block_st_set := TRUE;
                            block_end_set := TRUE;
                            hilight_block
                         END
                      END
                   END
             END
   END;  (* MOUSE *)

PROCEDURE EVALUATE_INPUT;
   LABEL 2;
   VAR
     i                              : INTEGER;
     did_assign                     : BOOLEAN;

{$I d:\pascal\opus\arrows.inc}

   PROCEDURE MOVE_TO_EDGE ( new_data_row,new_data_col : INTEGER );
      { moves cursor to edge of screen when control A,Z,T,B are pressed;
        do_draw, do_toggle are in arrows.inc  }
      BEGIN
          do_toggle;
          data_row := new_data_row;
          data_col := new_data_col;
          do_draw
      END;

   BEGIN { EVALUATE_INPUT }
           Work_Rect(act_hdl,x_1,y_1,w_1,h_1);
           Set_Clip(x_1,y_1,w_1,h_1);
           CASE inp_code OF
              w_LEFT_ARROW  : IF data_col > logical_col_1 THEN left_arrow;
              w_RIGHT_ARROW : IF data_col < n_cols THEN right_arrow;
              w_UP_ARROW    : IF data_row > logical_row_1 THEN up_arrow;
              w_DOWN_ARROW  : IF data_row < n_rows THEN down_arrow;
              w_RETURN :
                 IF (auto_cursor) AND
                    (data_row >= b_s_row) AND (data_row <= b_e_row) AND
                    (data_col >= b_s_col) AND (data_col <= b_e_col) AND
                    (block_set) THEN
                    do_auto_cursor
                 ELSE BEGIN
                    did_assign := assign_if_possible;
                    IF did_assign THEN BEGIN
                       cell_on_screen(1,data_row,data_col,TRUE);
                       write_cell_name
                    END
                 END;
              w_cntl_a : move_to_edge(data_row,start_col);
              w_cntl_z : move_to_edge(data_row,finish_col);
              w_cntl_t : move_to_edge(start_row,data_col);
              w_cntl_b : move_to_edge(finish_row,data_col);
              w_PAGE_UP : simulate_message(WM_Arrowed,act_hdl,0);
              w_PAGE_DOWN : simulate_message(WM_Arrowed,act_hdl,1);
              w_PAGE_LEFT : simulate_message(WM_Arrowed,act_hdl,4);
              w_PAGE_RIGHT : simulate_message(WM_Arrowed,act_hdl,5);
              w_F1 : simulate_message(MN_Selected,moptions,mmanrec);
              w_F2 : simulate_message(MN_Selected,mfile,mloadws);
              w_sF2 : simulate_message(MN_Selected,mfile,mloadbl);
              w_F3 : simulate_message(MN_Selected,mfile,msavews);
              w_sF3 : simulate_message(MN_Selected,mfile,msavebl);
              w_F4 : simulate_message(MN_Selected,mfile,msavetxt);
              w_F5 : simulate_message(MN_Selected,mfile,mprintsp);
              f6 : simulate_message(MN_Selected,mblock,minsertr);
              sf6 : simulate_message(MN_Selected,mblock,mdeleter);
              f7 : simulate_message(MN_Selected,mblock,minsertc);
              sf7 : simulate_message(MN_Selected,mblock,mdeletec);
              w_F8 : simulate_message(MN_Selected,mformat,mnum);
              w_F9 : simulate_message(MN_Selected,mformat,mlabel);
              w_F10 : simulate_message(MN_Selected,mformat,mform);
              w_COLUMN : simulate_message(MN_Selected,mformat,mcolwid);
              w_JUSTIFY : simulate_message(MN_Selected,mformat,mjust);
              alt_l : simulate_message(MN_Selected,mformat,mdollar);
              w_percent : simulate_message(MN_Selected,mformat,mpercent);
              w_PRECISION : simulate_message(MN_Selected,mformat,mprec);
              w_style : simulate_message(MN_Selected,mformat,mstyle);
              alt_b : simulate_message(MN_Selected,mformat,mglobalf);
              w_VIEW : simulate_message(MN_Selected,mformat,mviewfor);
              w_START_BLOCK : simulate_message(MN_Selected,mblock,mstartbl);
              w_END_BLOCK : simulate_message(MN_Selected,mblock,mendbl);
              alt_f : simulate_message(MN_Selected,mblock,mdatafil);
              w_REPLICATE : simulate_message(MN_Selected,mblock,mrep);
              w_SORT : simulate_message(MN_Selected,mblock,msort);
              w_DESELECT : simulate_message(MN_Selected,mblock,mdesel);
              w_GOTO : simulate_message(MN_Selected,mmark,mgoto);
              alt_1 : simulate_message(MN_Selected,mmark,ms1);
              alt_2 : simulate_message(MN_Selected,mmark,ms2);
              alt_3 : simulate_message(MN_Selected,mmark,ms3);
              alt_4 : simulate_message(MN_Selected,mmark,ms4);
              c_1 : IF m1s THEN simulate_message(MN_Selected,mmark,mg1);
              c_2 : IF m2s THEN simulate_message(MN_Selected,mmark,mg2);
              c_3 : IF m3s THEN simulate_message(MN_Selected,mmark,mg3);
              c_4 : IF m4s THEN simulate_message(MN_Selected,mmark,mg4);
              c_f : simulate_message(MN_Selected,mmark,mfirstc);
              c_l : simulate_message(MN_Selected,mmark,mlastc);
              alt_i : simulate_message(MN_Selected,moptions,msetauto);
              alt_x : simulate_message(MN_Selected,moptions,mstats);
              alt_h : simulate_message(MN_Selected,moptions,mrefresh);
              alt_t : simulate_message(MN_Selected,moptions,mfreeze);
              alt_c : IF block_set THEN 
                         simulate_message(MN_Selected,mblock,mcopy);
              alt_m : IF block_set THEN
                         simulate_message(MN_Selected,mblock,mmove);
              alt_k : IF block_set THEN
                         simulate_message(MN_Selected,mblock,mdelete);
              w_HOME : BEGIN
                 home_cursor(Origin);
                 sheet_redraw(WholeSheet,FALSE,None);
              END;
              w_MOUSE : BEGIN
                 mx := msg_area[1]; (* mouse x-coord *)
                 my := msg_area[2]; (* mouse y-coord *)
                 mouse(mx,my);
              END;
              w_MESSAGE : BEGIN
                 handle_message;
                 redraw_flag := FALSE
              END;
              OTHERWISE : ;
           END; { CASE }
2: END; (* EVALUATE_INPUT *)

PROCEDURE INIT_FUNCTIONS;
   VAR i : INTEGER;
   BEGIN
       i := 1;
       functions[i].func_name := 'ABS';
       functions[i].func_type := AbsOp;
       i := i+1;
       functions[i].func_name := 'ACOS';
       functions[i].func_type := AcosOp;
       i := i+1;
       functions[i].func_name := 'AND';
       functions[i].func_type := AndOp;
       i := i+1;
       functions[i].func_name := 'ASIN';
       functions[i].func_type := AsinOp;
       i := i+1;
       functions[i].func_name := 'ATAN';
       functions[i].func_type := AtanOp;
       i := i+1;
       functions[i].func_name := 'CORR';
       functions[i].func_type := CorrOp;
       i := i+1;
       functions[i].func_name := 'COS';
       functions[i].func_type := CosOp;
       i := i+1;
       functions[i].func_name := 'COUNT';
       functions[i].func_type := CountOp;
       i := i+1;
       functions[i].func_name := 'DEG';
       functions[i].func_type := DegOp;
       i := i+1;
       functions[i].func_name := 'DIV';
       functions[i].func_type := DivOp;
       i := i+1;
       functions[i].func_name := 'EXP';
       functions[i].func_type := ExpOp;
       i := i+1;
       functions[i].func_name := 'FAC';
       functions[i].func_type := FacOp;
       i := i+1;
       functions[i].func_name := 'FV';
       functions[i].func_type := FvOp;
       i := i+1;
       functions[i].func_name := 'HLOOKUP';
       functions[i].func_type := HlookupOp;
       i := i+1;
       functions[i].func_name := 'IF';
       functions[i].func_type := IfOp;
       i := i+1;
       functions[i].func_name := 'INDEX';
       functions[i].func_type := IndexOp;
       i := i+1;
       functions[i].func_name := 'LINR';
       functions[i].func_type := LinROp;
       i := i+1;
       functions[i].func_name := 'LN';
       functions[i].func_type := LnOp;
       i := i+1;
       functions[i].func_name := 'LOG';
       functions[i].func_type := LogOp;
       i := i+1;
       functions[i].func_name := 'MAX';
       functions[i].func_type := MaxOp;
       i := i+1;
       functions[i].func_name := 'MEAN';
       functions[i].func_type := MeanOp;
       i := i+1;
       functions[i].func_name := 'MIN';
       functions[i].func_type := MinOp;
       i := i+1;
       functions[i].func_name := 'MOD';
       functions[i].func_type := ModOp;
       i := i+1;
       functions[i].func_name := 'NOT';
       functions[i].func_type := NotOp;
       i := i+1;
       functions[i].func_name := 'NPER';
       functions[i].func_type := NperOp;
       i := i+1;
       functions[i].func_name := 'OR';
       functions[i].func_type := OrOp;
       i := i+1;
       functions[i].func_name := 'PI';
       functions[i].func_type := PiOp;
       i := i+1;
       functions[i].func_name := 'PMT';
       functions[i].func_type := PmtOp;
       i := i+1;
       functions[i].func_name := 'PREDV';
       functions[i].func_type := PredVOp;
       i := i+1;
       functions[i].func_name := 'PROD';
       functions[i].func_type := ProdOp;
       i := i+1;
       functions[i].func_name := 'PV';
       functions[i].func_type := PvOp;
       i := i+1;
       functions[i].func_name := 'RAD';
       functions[i].func_type := RadOp;
       i := i+1;
       functions[i].func_name := 'RAND';
       functions[i].func_type := RandOp;
       i := i+1;
       functions[i].func_name := 'ROUND';
       functions[i].func_type := RoundOp;
       i := i+1;
       functions[i].func_name := 'SDEV';
       functions[i].func_type := SdevOp;
       i := i+1;
       functions[i].func_name := 'SERR';
       functions[i].func_type := SerrOp;
       i := i+1;
       functions[i].func_name := 'SIN';
       functions[i].func_type := SinOp;
       i := i+1;
       functions[i].func_name := 'SQR';
       functions[i].func_type := SqrOp;
       i := i+1;
       functions[i].func_name := 'SQRT';
       functions[i].func_type := SqrtOp;
       i := i+1;
       functions[i].func_name := 'SUM';
       functions[i].func_type := SumOp;
       i := i+1;
       functions[i].func_name := 'TAN';
       functions[i].func_type := TanOp;
       i := i+1;
       functions[i].func_name := 'TRUNC';
       functions[i].func_type := TruncOp;
       i := i+1;
       functions[i].func_name := 'VAR';
       functions[i].func_type := VarOp;
       i := i+1;
       functions[i].func_name := 'VLOOKUP';
       functions[i].func_type := VlookupOp;
   END; { INIT_FUNCTIONS }

PROCEDURE CHECK_REZ;
   VAR i : INTEGER;
   FUNCTION Addr ( VAR what : BlitArray ) : LONG_INTEGER;
      EXTERNAL;
   BEGIN
       { save the pallete }
       FOR i := 0 TO 15 DO
           palette[i] := XBIOS_Set_Color(i,-1);
       Extended_Inquire(0);
       screen_width := int_out[0]+1;
       screen_height := int_out[1]+1;
       half_scr_width := screen_width DIV 2;
       half_scr_height := screen_height DIV 2;
       max_screen_cols := screen_width DIV 40;
       Extended_Inquire(1);
       IF int_out[4] = 2 THEN BEGIN { med rez }
          { my favorite colors; I've indicated the ones in the
            ST boot-up ( no mods via control panel ) on the left }
          Set_Color(0,1000,1000,1000);  { white => white }
          Set_Color(1,0,0,0);           { black => black }
          Set_Color(2,1000,0,0);        { red   => red }
          Set_Color(3,0,0,1000);        { green => blue }
          rez := 2 { set it to my rez }
       END
       ELSE IF int_out[4] = 1 THEN BEGIN { high rez }
          Set_Color(0,1000,1000,1000);   { white }
          Set_Color(1,0,0,0);            { black }
          Set_Color(2,0,0,0);            { black }
          Set_Color(3,0,0,0);            { black }
          rez := 1
       END
       ELSE BEGIN { low rez or anything else }
          temp := CONCAT('[3][Opus requires medium or|' ,
                             'high resolution...][  I''ll switch ]');
          i := Do_Alert(temp,1);
          End_Update;
          Exit_Gem;
          Halt
       END;
       screen_mfdb.address := 0; { sufficient to access screen }
       WITH mem_mfdb DO BEGIN
          address := Addr(blit_buffer);
          wid_pix := screen_width;
          ht_pix := screen_height;
          wid_wds := wid_pix DIV 16;
          format := 0;
          planes := int_out[4]; { from Extended_Inquire(1) }
          res1 := 0; { unused vars, but it's recommended to set to zero as  }
          res2 := 0; { they may have significance in future versions of GEM }
          res3 := 0
       END;
       IF rez = 1 THEN
          cell_height := 17
       ELSE
          cell_height := 9;
       two_cell_h := 2*cell_height; { commonly used values }
       three_cell_h := 3*cell_height
   END; { CHECK_REZ }

PROCEDURE INITIALIZE;
   LABEL 1;
   TYPE Switcheroo = RECORD
                          CASE BYTE OF
                             1 : ( str      : STR10 );
                             2 : ( switched : ThreeHundredBytes )
                          END;
   VAR i,j,k,handle : INTEGER;
       n            : LONG_INTEGER;
       c_s          : C_STRING;
       buffer       : Switcheroo;
       m            : PrinterSpecial;
   PROCEDURE ERROR;
      BEGIN
          handle := -1;
          temp := CONCAT('[1][Read error while loading|' ,
                             'PRINTER.INF. No special|' ,
                             'codes will be used when|' ,
                             'printing.][  OK  ]');
          i := Do_Alert(temp,1);
          GOTO 1
      END; { ERROR }
   PROCEDURE READ_BYTES ( n : LONG_INTEGER );
      BEGIN
          IF TOS_Read(handle,n,buffer.switched) <> n THEN 
             error
      END; { READ_BYTES }
   FUNCTION PTR_TO_LONG ( addr : Generic_Ptr ) : LONG_INTEGER;
      EXTERNAL;
   BEGIN
       check_rez;
       drive := TOS_Get_Drive;
       i := TOS_Get_Directory(directory,0);
       C_To_Pascal(directory,full_path);
       full_path := CONCAT(CHR(drive+65),':',full_path);
       IF rez = 1 THEN
          temp_1 := 'H'
       ELSE
          temp_1 := 'M';
       temp := CONCAT(full_path,'\OPUS',temp_1,'.RSC');
       IF NOT Load_Resource(temp) THEN BEGIN
          temp := CONCAT('[3][OPUS',temp_1,'.RSC was not found!|' ,
                             'It must live in the same|' ,
                             'directory as OPUS.PRG.][ Cancel ]');
          alert := Do_Alert(temp,1);
          End_Update;
          Exit_Gem;
          HALT
       END;
       Find_Menu(mainmenu,main_menu); { main_menu is the pointer }
       IF rez = 1 THEN { high rez }
          Menu_Enable(main_menu,msmall);
       Find_Dialog(infodial,info_ptr);
       Find_Dialog(fmatdial,fmat_ptr);
       Find_Dialog(vfrmdial,vfrm_ptr);
       Find_Dialog(gotodial,goto_ptr);
       Find_Dialog(repdial,rep_ptr);
       Find_Dialog(prdial,print_ptr);
       Find_Dialog(sortdial,sort_ptr);
       Find_Dialog(rangdial,rang_ptr);
       Find_Dialog(errdial,err_ptr);
       Find_Dialog(statdial,stat_ptr);
       Find_Dialog(pagedial,page_ptr);
       Find_Dialog(keydial,key_ptr);
       Find_Dialog(formdial,form_ptr);
       Find_Dialog(prhdial,prhelp_ptr);
       Find_Dialog(mhlpdial,mhelp_ptr);
       Find_Dialog(crefdial,crefhelp_ptr);
       Find_Dialog(rechdial,rechelp_ptr);
       Find_Dialog(datadial,data_fill_ptr);
       Find_Dialog(frzdial,freeze_ptr);
       Find_Dialog(actdial,action_ptr);
       Find_Dialog(newdesk,new_desk_ptr);
       hide;
       Form_Anywhere(new_desk_ptr,0,cell_height+2,w_1,h_1);
       Obj_Size(new_desk_ptr,panel,fo_x,fo_y,fo_w,fo_h);
       con_x := 0;
       con_y := fo_y+fo_h+4;
       con_w := screen_width;
       con_h := screen_height-con_y;
       Obj_Size(new_desk_ptr,editarea,area_x,area_y,area_w,area_h);
       area_x := area_x+1;
       area_w := area_w-2;
       area_y := area_y+1;
       area_h := area_h-2;
       edit_x := area_x+8;
       IF rez = 1 THEN
          edit_y := area_y+13
       ELSE
          edit_y := area_y+6;   
       FOR m := Init TO UnderOff DO
           printer_codes[m] := '';
       temp := CONCAT(full_path,'\PRINTER.INF');
       Pascal_To_C(temp,c_s);
       handle := TOS_Open(c_s,0);
       IF handle >= 0 THEN BEGIN
          read_bytes(11);
          IF buffer.str <> 'opus print' THEN BEGIN
             temp := CONCAT('[1][PRINTER.INF is corrupted.|' ,
                                'No special printer codes|' ,
                                'will be used.][  OK  ]');
             alert := Do_Alert(temp,1);
             handle := -1;
             GOTO 1
          END;
          read_bytes(3);
          port := buffer.switched[1];
          nl_chr_line := buffer.switched[2];
          con_chr_line := buffer.switched[3];
          FOR m := Init TO Underoff DO BEGIN
              read_bytes(1);
              IF buffer.switched[1] > 0 THEN 
                 IF TOS_Seek(-1,handle,1) < 0 THEN
                    error
                 ELSE BEGIN
                    read_bytes(buffer.switched[1]+1);
                    printer_codes[m] := buffer.str
                 END
          END
       END
       ELSE BEGIN
          temp := CONCAT('[1][PRINTER.INF was not found.|' ,
                             'No special printer codes|' ,
                             'will be used.][  OK  ]');
          alert := Do_Alert(temp,1)
       END;                   
1:     IF handle < 0 THEN BEGIN
          nl_chr_line := 80;
          con_chr_line := 136;
          port := Centronics;
          FOR m := Init TO UnderOff DO
              printer_codes[m] := ''
       END;       
       default_path[1] := CONCAT(full_path,'\*.OPS');
       default_path[2] := CONCAT(full_path,'\*.DOC');
       current_file := '';
       n_hdls := 1;
       t_1 := ' WorkSheet1 ';
       t_2 := ' WorkSheet2 ';
       w_idx := 1; { index into w_pos array }
       w_pos[w_idx,first_row] := 1; { usage example }
       w_pos[1,first_col] := 1; { Note that for the opening window we needn't }
       w_pos[1,hot_row] := 1;   { specify the finish or scr. pos. parms.      }
       w_pos[1,hot_col] := 1;   { These are relevant for restoring the        }
                                { values after redraws. The second window is  }
                                { always set to the 1st attr when opened.     }
                                
       act_hdl := New_Window(G_All,t_1,con_x,con_y,con_w,con_h);
       IF act_hdl = No_Window THEN BEGIN
          alert := Do_Alert('[3][GEM has no more windows!][ Cancel ]',1);
          Free_Resource;
          End_Update;
          Exit_Gem;
          HALT
       END;
       w_pos[1,w_hdl] := act_hdl;
       init_functions;
       e_table[1] := e;
       e_table[2] := 7.3890560989;
       e_table[3] := 54.598150033;
       e_table[4] := 2.9809579871E3;
       e_table[5] := 8.8861105206E6;
       e_table[6] := 7.8962960185E13;
       e_table[7] := 6.2351490811E27;
       user_quit := FALSE;
       block_set := FALSE;
       block_st_set := FALSE;
       block_end_set := FALSE;
       did_recalc := FALSE;
       redraw_flag := FALSE;
       auto_recalc := TRUE;
       natural := TRUE;
       auto_cursor := TRUE;
       grid_flag := TRUE;
       m1s := FALSE;
       m2s := FALSE;
       m3s := FALSE;
       m4s := FALSE;
       p_row_col := TRUE;
       print_formulas := FALSE;
       form_flag := FALSE;
       small_text := FALSE;
       draft_final := TRUE;
       condensed_print := FALSE;
       p_title_1 := '';
       p_title_2 := '';
       header := '';
       footer := '^c-^p-';
       error_msg[GenError] := 'Error';
       error_msg[SyntaxErr] := 'SyntaxErr';
       error_msg[OutOfRange] := 'OutOfRange'; 
       error_msg[BadRef] := 'BadCellRef'; 
       error_msg[Overflow] := 'Overflow';    
       error_msg[DivBy0] := 'DivBy0';
       error_msg[Undefined] := 'Undefined'; 
       error_msg[BadReal] := 'BadReal';
       days[1] := 'monday';
       days[2] := 'tuesday';
       days[3] := 'wednesday';
       days[4] := 'thursday';
       days[5] := 'friday';
       days[6] := 'saturday';
       days[7] := 'sunday';
       months[1] := 'january';
       months[2] := 'february';
       months[3] := 'march';
       months[4] := 'april';
       months[5] := 'may';
       months[6] := 'june';
       months[7] := 'july';
       months[8] := 'august';
       months[9] := 'september';
       months[10] := 'october';
       months[11] := 'november';
       months[12] := 'december';
       cursor_direction := CursorDown;
       FOR i := 1 TO n_cols DO BEGIN  { the pixel-width is not an exact    }
           col_width[i,spaces] := 10; { multiple of 8 so that the grid     }
           col_width[i,pixels] := 80  { lines may start and end on an 'on' }
       END;                           { pixel; prevents 'shifting' lines   }
                                      { when blitting in high rez }
       char1 := 'A';
       FOR i := 1 TO 26 DO BEGIN
           col_name[i] := char1;
           char1 := SUCC(char1)
       END;
       char1 := PRED('A');
       FOR i := 27 TO n_cols DO BEGIN
           IF (i-27) MOD 26 = 0 THEN
              char1 := SUCC(char1);
           IF (i-27) MOD 26 = 0 THEN
              char2 := 'A'
           ELSE
              char2 := SUCC(char2);
           col_name[i] := CONCAT (char1,char2)
       END;
       FOR i := 1 TO 4 DO BEGIN
           marks[i].row := 0; { the 4 actual marks; 0 = not set }
           marks[i].col := 0
       END;
       
       default_format := $02; { right just; 2 dec places, no sci; no percent }
       up_case := [ 'A'..'Z' ];
       low_case := [ 'a'..'z' ];
       digits := [ '0'..'9' ];
       float := digits+[ '.' , 'E' , 'e' , '+' , '-' ];
       Single := [LogOp..NotOp];
       Double := [DivOp..TruncOp];
       Multiple := [AndOp..OrOp];
       Aggregate := [CountOp..PredVOp];
       Financial := [PvOp..NPerOp];
       LookUp := [VLookUpOp..IndexOp];
       too_long := CONCAT ('[1][You have now entered the|' ,
                               'maximum allowed number of|'  ,
                               'characters...][  OK  ]');
       float_over := CONCAT ('[1][<< Floating point overflow >>|' ,
                                 ' |',
                                 'Numbers must fall within this|' ,
                                 'range:|' ,
                                 '     +/- 1 E +/- 37][  OK  ]');
       null_str := '';
       FOR i := 0 TO n_rows DO
           data[i] := NIL;
       Hide_Mouse;
       Set_Mouse(M_Arrow);
       Draw_Menu(main_menu);
       data_row := 1;
       data_col := 1;
       set_up_cell_name;
       Wind_Set(0,WF_NewDesk,INT(ShR(ptr_to_long(new_desk_ptr),16)),
                INT(ptr_to_long(new_desk_ptr) & $0000FFFF),
                Root,Max_Depth);
       Form_Dial(3,0,0,screen_width,screen_height,
                   0,0,screen_width,screen_height);
       Open_Window(act_hdl,con_x,con_y,con_w,con_h);
       Border_Rect(act_hdl,o_x,o_y,max_w,max_h); { original vals }
       home_cursor(Origin);
       default_draw_attributes;
       freeze_row := 0;
       freeze_col := 0;
       logical_row_1 := 1;
       logical_col_1 := 1;
       x_margin := 38;
       y_margin := cell_height-1;
       Show_Mouse
   END; (* INITIALIZE *)

BEGIN { PROGRAM }
    WHILE KeyPress DO
       long_key := BConIn(2); { clean junk out of keyboard }
    ap_id := Init_Gem;        { save for sending self messages, also for }
    IF ap_id >= 0 THEN BEGIN  { possible communication with accs         }
       Begin_Update;
       initialize;
       { make smaller to account for procedure vars, space returned to stack
         that isn't useful, etc. So this in effect reserves 20K bytes for the
         stack, since we won't allocate the cells which could fit in this
         space. Do this here rather than in INITIALIZE because to get the
         heap size, it subtracts that space between start of heap and 
         end of stack, and any proc variables on the stack detract from 
         Memavail }
       original_memory := MemAvail*2-20000; { words -> bytes }
       working_memory := original_memory;
       REPEAT { heart of the program }
           inp_code := NoCode;
           mask_out_recalc;
           { NOTE: window_input is passed a formula if cell is class F or a
                   string if class A;
                   if no changes in this item are made, it returns the value
                   NULL, and thus the cell is not affected in ANY WAY }
           temp := '';
           ptr := locate_cell(data_row,data_col);
           IF ptr <> NIL THEN
              IF ptr^.class <> Val THEN BEGIN
                 IF ptr^.str <> NIL THEN BEGIN
                    inp_code := w_F;
                    temp := ptr^.str^
                 END;
                 window_input(string_len,AlphaNumeric,temp)
              END  { see wind_inp.pas for global vars it uses }
              ELSE
                 window_input(float_len,FloatingPoint,temp)
           ELSE
              window_input(float_len,FloatingPoint,temp);
           evaluate_input
       UNTIL user_quit; 
       { clean up... }
       End_Update;
       Erase_Menu(main_menu); { needn't delete_menu since I used RCS }
       { close & delete windows so we don't crash GEM }
       IF n_hdls = 2 THEN BEGIN
          Close_Window(w_pos[2,w_hdl]);
          Delete_Window(w_pos[2,w_hdl])
       END;
       Close_Window(w_pos[1,w_hdl]); { which is always present }
       Delete_Window(w_pos[1,w_hdl]);
       Set_Palette(palette); { restore user's colors }
       Wind_Set(0,WF_NewDesk,0,0,Root,Max_Depth); { tell Desktop to use }
       Form_Dial(3,0,0,screen_width,screen_height,{ its own definition  }
                   0,0,screen_width,screen_height);
       Free_Resource; { give GEM the memory back }
       Exit_Gem
    END (* IF ap_id >= 0 *)
END.



