SPACE 2/SPACE - Library 2 - Volume 1.iso/magazi~1/305/stlog.23/r.pas

Pascal/Delphi Source File | 1988-05-23 | 70.1 KB | 1,766 lines

{$M+}
{$E+}
PROGRAM Mock;

{$I i:\opus.i}
{$I i:\gctv.inc}

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

FUNCTION DESELECT_BLOCK : BOOLEAN;
   EXTERNAL;

PROCEDURE DO_PRINT ( s_row,f_row,s_col,f_col : INTEGER; handle : INTEGER );
   EXTERNAL;

PROCEDURE CAP_A_STRING ( VAR str : STRING );
   VAR i : INTEGER;
   BEGIN
       FOR i := 1 TO LENGTH(str) DO
           IF str[i] IN low_case THEN
              str[i] := CHR(ORD(str[i])-$20)
   END; { CAPITALIZE }

FUNCTION FORM_BEGIN ( box : Dialog_Ptr; index : Tree_Index ) : Tree_Index;
   BEGIN
       Hide_Mouse;
       Set_Mouse(M_Arrow); { in case it was not that }
       Form_Center(box,fo_x,fo_y,fo_w,fo_h);
       Blit(screen_mfdb,mem_mfdb,fo_x,fo_y,fo_x,fo_y,fo_w,fo_h);
       Form_Dial(0,0,0,0,0,fo_x,fo_y,fo_w,fo_h);
       Obj_Draw(box,Root,Max_Depth,fo_x,fo_y,fo_w,fo_h);
       Show_Mouse;
       form_begin := Form_Do(box,index)
   END; { FORM_BEGIN }

PROCEDURE FORM_END;
   VAR event : INTEGER;
   BEGIN
       Hide_Mouse;
       Form_Dial(3,fo_x,fo_y,fo_w,fo_h,fo_x,fo_y,fo_w,fo_h);
       Set_Clip(0,0,screen_width,screen_height);
       Blit(mem_mfdb,screen_mfdb,fo_x,fo_y,fo_x,fo_y,fo_w,fo_h);
       { now must get redraw message generated by clearing the dialog;
         possibility of discarding non-redraw messages but this doesn't seem
         to be a problem, since all messages preceding the dialog call were
         processed, and the modal nature of the dialog prevents the occurence
         of message events ( and others ) for this application during the
         dialog }
       REPEAT
            event := Get_Event(E_Message|E_Timer,0,0,0,5,FALSE,0,0,0,0,
                               FALSE,0,0,0,0,msg_area,i,i,i,i,i,i)
       UNTIL event & E_Timer <> 0;
       Show_Mouse
   END; { FORM_END }

PROCEDURE CHANGE_FORMAT ( caller : FormatCall );
   CONST s = 1;
         r = 2;
         g = 3;
   VAR
       action                       : Tree_Index;
       chosen_width,
       chosen_prec,
       i,j,extent,s_row,s_col,
       f_row,f_col,chosen_style     : INTEGER;
       found,do_cw,do_just,do_prec,
       do_perc,sci_flag,perc_on,
       do_style,dummy,do_dollar,
       dollar_on                    : BOOLEAN;
       temp                         : STR255;
       chosen_just                  : VDI_Just;
       ptr                          : CellPtr;
  PROCEDURE INITIALIZE;
     BEGIN
         indx := Map_Tree(fmat_ptr,Root,Null_Index,ClearSelected);
         IF caller = GlobalCall THEN BEGIN
            extent := g;
            Obj_SetState(fmat_ptr,fmatglob,Selected,FALSE);
            Set_Text(fmat_ptr,fmatbegi,null_str,s1,5);
            Set_Text(fmat_ptr,fmatend,null_str,s2,5)
         END
         ELSE IF block_set THEN BEGIN
            extent := r;
            Obj_SetState(fmat_ptr,fmatrang,Selected,FALSE);
            string_a_cell(b_s_row,b_s_col,temp);
            Set_Text(fmat_ptr,fmatbegi,temp,s1,5);
            string_a_cell(b_e_row,b_e_col,temp);
            Set_Text(fmat_ptr,fmatend,temp,s2,5)
         END
         ELSE BEGIN
            extent := s;
            Obj_SetState(fmat_ptr,fmatcell,Selected,FALSE);
            string_a_cell(data_row,data_col,temp);
            Set_Text(fmat_ptr,fmatbegi,temp,s1,5);
            Set_Text(fmat_ptr,fmatend,null_str,s2,5)
         END;
         do_cw := FALSE;
         do_dollar := FALSE;
         do_just := FALSE;
         do_prec := FALSE;
         do_perc := FALSE;
         do_style := FALSE;
         CASE caller OF
            CWCall   : BEGIN
               Obj_SetState(fmat_ptr,fmatcw,Selected,FALSE);
               do_cw := TRUE
            END;
            DollarCall : BEGIN
               Obj_SetState(fmat_ptr,fmatdoll,Selected,FALSE);
               do_dollar := TRUE
            END;
            JustCall : BEGIN
               Obj_SetState(fmat_ptr,fmatjust,Selected,FALSE);
               do_just := TRUE
            END;
            PrecCall : BEGIN
               Obj_SetState(fmat_ptr,fmatprec,Selected,FALSE);
               do_prec := TRUE
            END;
            PercCall : BEGIN
               Obj_SetState(fmat_ptr,fmatperc,Selected,FALSE);
               do_perc := TRUE
            END;
            StyleCall : BEGIN
               Obj_SetState(fmat_ptr,fmatstyl,Selected,FALSE);
               do_style := TRUE
            END;
            GlobalCall : ;
         END;
         chosen_width := col_width[data_col,spaces];
         int_to_string(chosen_width,temp);
         IF LENGTH(temp) < 2 THEN
            temp := CONCAT(' ',temp);
         Set_Text(fmat_ptr,fmatcwsz,temp,s3,2);
         ptr := locate_cell(data_row,data_col);
         chosen_just := find_just(ptr);
         Obj_SetState(fmat_ptr,chosen_just+ORD(justleft),Selected,FALSE);
         chosen_prec := find_prec(ptr);
         Obj_SetState(fmat_ptr,ORD(prec0)+chosen_prec,Selected,FALSE);
         IF ptr <> NIL THEN
            chosen_style := ptr^.format & style_mask
         ELSE
            chosen_style := default_format & style_mask;
         IF chosen_style & bold_mask <> 0 THEN
            Obj_SetState(fmat_ptr,textbold,Selected,FALSE);
         IF chosen_style & italic_mask <> 0 THEN
            Obj_SetState(fmat_ptr,textital,Selected,FALSE);
         IF chosen_style & under_mask <> 0 THEN
            Obj_SetState(fmat_ptr,textundr,Selected,FALSE);
         IF ptr <> NIL THEN BEGIN
            IF ptr^.format & sci_mask <> 0 THEN
               Obj_SetState(fmat_ptr,precscin,Selected,FALSE);
            IF ptr^.format & dollar_mask <> 0 THEN
               Obj_SetState(fmat_ptr,fmatdchk,Checked,FALSE)
            ELSE
               Obj_SetState(fmat_ptr,fmatdchk,Normal,FALSE);
            IF ptr^.format & perc_mask <> 0 THEN
               Obj_SetState(fmat_ptr,fmatpchk,Checked,FALSE)
            ELSE
               Obj_SetState(fmat_ptr,fmatpchk,Normal,FALSE)
         END
         ELSE BEGIN
            IF default_format & sci_mask <> 0 THEN
               Obj_SetState(fmat_ptr,precscin,Selected,FALSE);
            IF default_format & dollar_mask <> 0 THEN
               Obj_SetState(fmat_ptr,fmatdchk,Checked,FALSE)
            ELSE
               Obj_SetState(fmat_ptr,fmatdchk,Normal,FALSE);
            IF default_format & perc_mask <> 0 THEN
               Obj_SetState(fmat_ptr,fmatpchk,Checked,FALSE)
            ELSE
               Obj_SetState(fmat_ptr,fmatpchk,Normal,FALSE)
         END
     END; { INITIALIZE }
  PROCEDURE EVAL_ACTION;
     LABEL 1;
     VAR i,j,inc  : INTEGER;
         done     : BOOLEAN;
     FUNCTION GET_EDITED (     what : Tree_Index;
                           VAR row,col : INTEGER   ) : BOOLEAN;
         VAR str_pos : INTEGER;
         BEGIN
             Get_Text(fmat_ptr,what,temp);
             cap_a_string(temp);
             str_pos := 1;
             IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
                               dummy,dummy ) <> OK THEN BEGIN
                get_edited := FALSE;
                Obj_SetState(fmat_ptr,fmatok,Normal,TRUE)
             END
             ELSE
                get_edited := TRUE
        END; (* GET_EDITED *)
     BEGIN { EVAL_ACTION }
         done := FALSE;
1:       REPEAT
            IF action = fmatok THEN BEGIN
               CASE Map_Tree(fmat_ptr,fmatcell,fmatglob,ReturnSelected) OF
                  fmatcell : extent := s;
                  fmatrang : extent := r;
                  fmatglob : extent := g
               END;
               IF Obj_State(fmat_ptr,fmatcw) & Selected <> 0 THEN BEGIN
                  Get_Text(fmat_ptr,fmatcwsz,temp);
                  WHILE POS(' ',temp) <> 0 DO
                     DELETE(temp,POS(' ',temp),1);
                  IF LENGTH(temp) = 0 THEN BEGIN
                     Obj_SetState(fmat_ptr,fmatok,Normal,TRUE);
                     action := Form_Do(fmat_ptr,fmatcwsz);
                     GOTO 1
                  END
                  ELSE BEGIN
                     chosen_width := 0;
                     inc := 1;
                     FOR i := LENGTH(temp) DOWNTO 1 DO BEGIN
                         chosen_width := chosen_width+(ORD(temp[i])-$30)*inc;
                         inc := inc*10
                      END;
                      IF (chosen_width < 5) OR (chosen_width > 30) THEN BEGIN
                         Obj_SetState(fmat_ptr,fmatok,Normal,TRUE);
                         action := Form_Do(fmat_ptr,fmatcwsz);
                         GOTO 1
                      END
                  END
               END;
               IF extent = s THEN
                  IF get_edited (fmatbegi,s_row,s_col) THEN
                     done := TRUE
                  ELSE
                     action := Form_Do(fmat_ptr,fmatbegi)
               ELSE IF extent = r THEN
                  IF get_edited (fmatbegi,s_row,s_col) THEN
                     IF get_edited (fmatend,f_row,f_col) THEN
                        IF (s_col > f_col) OR (s_row > f_row) OR
                           (s_col < logical_col_1) OR
                           (s_row < logical_row_1) THEN BEGIN
                           Obj_SetState(fmat_ptr,fmatok,Normal,TRUE);
                           action := Form_Do(fmat_ptr,fmatend)
                        END
                        ELSE
                           done := TRUE
                     ELSE
                        action := Form_Do(fmat_ptr,fmatend)
                  ELSE
                     action := Form_Do(fmat_ptr,fmatbegi)
               ELSE { extent was global }
                  done := TRUE;
            END { action = cwok }
            ELSE IF (action = fmatcwdn) OR (action = fmatcwup) THEN BEGIN
               IF action = fmatcwdn THEN
                  IF chosen_width > 5 THEN
                     chosen_width := chosen_width-1
                  ELSE
               ELSE IF chosen_width < 30 THEN
                  chosen_width := chosen_width+1;
               int_to_string(chosen_width,temp);
               IF LENGTH(temp) < 2 THEN
                  temp := CONCAT(' ',temp);
               Set_Text(fmat_ptr,fmatcwsz,temp,s3,2);
               Obj_Draw(fmat_ptr,fmatcwsz,fmatcwsz,fo_x,fo_y,fo_w,fo_h);
               action := Form_Do(fmat_ptr,fmatcwsz)
            END
            ELSE IF action = fmatdchk THEN BEGIN
               IF dollar_on THEN
                  Obj_SetState(fmat_ptr,fmatdchk,Normal,TRUE)
               ELSE
                  Obj_SetState(fmat_ptr,fmatdchk,Checked,TRUE);
               dollar_on := NOT dollar_on;
               action := Form_Do(fmat_ptr,fmatbegi)
            END
            ELSE IF action = fmatpchk THEN BEGIN
               IF perc_on THEN
                  Obj_SetState(fmat_ptr,fmatpchk,Normal,TRUE)
               ELSE
                  Obj_SetState(fmat_ptr,fmatpchk,Checked,TRUE);
               perc_on := NOT perc_on;
               action := Form_Do(fmat_ptr,fmatbegi)
            END
         UNTIL (done) OR (action = fmatcanc);
     END;   (* EVAL_ACTION *)
  PROCEDURE DO_FORM;
     BEGIN
         IF (caller = CWCall) OR (caller = GlobalCall) THEN
            action := form_begin(fmat_ptr,fmatcwsz)
         ELSE
            action := form_begin(fmat_ptr,fmatbegi);
         eval_action;
         form_end
     END;
  PROCEDURE OUTCOME;
     VAR i,j   : INTEGER;
         ptr   : CellPtr;
     PROCEDURE SET_JUST ( VAR format : INTEGER );
        BEGIN
            CASE chosen_just OF
               VDI_Left   : BEGIN
                  format := format & no_just_mask;
                  format := format | $0010
               END;
               VDI_Center : format := format | $0030;
               VDI_Right  : format := format & no_just_mask
            END
        END; { SET_JUST }
     PROCEDURE SET_PREC ( VAR format : INTEGER );
        BEGIN
            format := format & no_prec_mask;
            format := format | chosen_prec;
            IF sci_flag THEN
               format := format | sci_mask
            ELSE
               format := format & no_sci_mask
        END; { SET_PREC }
     PROCEDURE SET_DOLLAR ( VAR format : INTEGER );
        BEGIN
            format := format & no_dollar_mask;
            IF dollar_on THEN
               format := format | dollar_mask
        END;
     PROCEDURE SET_PERC ( VAR format : INTEGER );
        BEGIN
            format := format & no_perc_mask;
            IF perc_on THEN
               format := format | perc_mask
        END; { SET_PERC }
     PROCEDURE SET_STYLE ( VAR format : INTEGER );
        BEGIN
            format := format & no_style_mask;
            IF Obj_State(fmat_ptr,textbold) & Selected <> 0 THEN
               format := format | bold_mask;
            IF Obj_State(fmat_ptr,textital) & Selected <> 0 THEN
               format := format | italic_mask;
            IF Obj_State(fmat_ptr,textundr) & Selected <> 0 THEN
               format := format | under_mask
        END; { SET_STYLE }
     PROCEDURE SET_BITS ( row,col : INTEGER );
        BEGIN
            ptr := new_cell(row,col);
            IF ptr <> NIL THEN BEGIN
               WITH ptr^ DO BEGIN
                  IF do_just THEN
                     set_just(format);
                  IF do_prec THEN
                     set_prec(format);
                  IF do_dollar THEN
                     set_dollar(format);
                  IF do_perc THEN BEGIN
                     set_perc(format);
                     IF perc_on THEN
                        num := num/100
                     ELSE
                        num := num*100
                  END;
                  IF do_style THEN
                    set_style(format);
               END;
               cell_on_screen(1,row,col,TRUE)
            END
        END; { SET_BITS }
     BEGIN { OUTCOME }
         IF action = fmatok THEN BEGIN
            Set_Mouse(M_Bee);
            IF Obj_State(fmat_ptr,fmatcw) & Selected <> 0 THEN
               do_cw := TRUE
            ELSE
               do_cw := FALSE;
            IF Obj_State(fmat_ptr,fmatjust) & Selected <> 0 THEN BEGIN
               chosen_just := Map_Tree(fmat_ptr,justleft,justrigh,
                                 ReturnSelected)-ORD(justleft);
               do_just := TRUE
            END
            ELSE
               do_just := FALSE;
            IF Obj_State(fmat_ptr,fmatprec) & Selected <> 0 THEN BEGIN
               chosen_prec := Map_Tree(fmat_ptr,prec0,prec5,ReturnSelected)-
                                 ORD(prec0);
               sci_flag := Obj_State(fmat_ptr,precscin) & Selected <> 0;
               do_prec := TRUE
            END
            ELSE
               do_prec := FALSE;
            IF Obj_State(fmat_ptr,fmatdoll) & Selected <> 0 THEN BEGIN
               do_dollar := TRUE;
               dollar_on := Obj_State(fmat_ptr,fmatdchk) & Checked <> 0
            END
            ELSE
               do_dollar := FALSE;
            IF Obj_State(fmat_ptr,fmatperc) & Selected <> 0 THEN BEGIN
               do_perc := TRUE;
               perc_on := Obj_State(fmat_ptr,fmatpchk) & Checked <> 0
            END
            ELSE
               do_perc := FALSE;
            IF Obj_State(fmat_ptr,fmatstyl) & Selected <> 0 THEN
               do_style := TRUE;
            IF (do_cw) OR (do_just) OR (do_perc) OR (do_dollar) OR
               (do_prec) OR (do_style) THEN
               CASE extent OF
                  s : BEGIN
                     IF do_cw THEN BEGIN
                        col_width[s_col,spaces] := chosen_width;
                        col_width[s_col,pixels] := chosen_width*8;
                        Send_Redraw(TRUE,0,0,screen_width,screen_height)
                     END;
                     IF (do_just) OR (do_prec) OR (do_perc) OR
                        (do_style) OR (do_dollar) THEN
                        set_bits(s_row,s_col)
                  END;
                  r : BEGIN
                     IF do_cw THEN BEGIN
                        FOR i := s_col TO f_col DO BEGIN
                            col_width[i,spaces] := chosen_width;
                            col_width[i,pixels] := chosen_width*8;
                        END;
                        Send_Redraw(TRUE,0,0,screen_width,screen_height)
                     END;
                     IF (do_just) OR (do_prec) OR (do_perc) OR
                        (do_style) OR (do_dollar) THEN
                        FOR i := s_row TO f_row DO
                            FOR j := s_col TO f_col DO
                                set_bits(i,j)
                  END;
                  g : BEGIN
                     IF do_cw THEN
                        FOR i := 1 To n_cols DO BEGIN
                            col_width[i,spaces] := chosen_width;
                            col_width[i,pixels] := chosen_width*8;
                        END;
                     IF do_just THEN
                        set_just(default_format);
                     IF do_prec THEN
                        set_prec(default_format);
                     IF do_dollar THEN
                        set_dollar(default_format);
                     IF do_perc THEN
                        set_perc(default_format);
                     IF do_style THEN
                        set_style(default_format);
                     FOR i := 1 TO n_rows DO BEGIN
                         ptr := data[i];
                         WHILE ptr <> NIL DO BEGIN
                            IF do_just THEN
                               ptr^.format := (ptr^.format & no_just_mask) |
                                              (default_format & just_mask);
                            IF do_prec THEN BEGIN
                               ptr^.format := (ptr^.format & no_prec_mask) |
                                              (default_format & prec_mask);
                               IF sci_flag THEN
                                  ptr^.format := (ptr^.format & no_sci_mask) |
                                                 (default_format & sci_mask)
                            END;
                            IF do_dollar THEN
                               ptr^.format := (ptr^.format & no_dollar_mask) |
                                              (default_format & dollar_mask);
                            IF do_perc THEN
                               ptr^.format := (ptr^.format & no_perc_mask) |
                                              (default_format & perc_mask);
                            IF do_style THEN
                               ptr^.format := (ptr^.format & no_style_mask) |
                                              (default_format & style_mask);
                            ptr := ptr^.next
                         END
                     END;
                     Send_Redraw(TRUE,0,0,screen_width,screen_height)
                  END
               END; { CASE extent }
            Set_Mouse(M_Arrow)
         END { IF }
     END; { OUTCOME }
   BEGIN { main! }
       initialize;
       do_form;
       outcome
   END; { CHANGE_FORMAT }

FUNCTION GOTO_CELL : BOOLEAN;
   VAR
       action                  : Tree_Index;
       row,col,str_pos         : INTEGER;
       cell_str                : STRING;
       finished,dummy          : BOOLEAN;
  PROCEDURE EVAL_ACTION;
     BEGIN
         REPEAT
            CASE action OF
               gotook : BEGIN
                  Get_Text ( goto_ptr,gotocell,cell_str );
                  cap_a_string ( cell_str );
                  str_pos := 1;
                  IF translate_cell(cell_str,str_pos,LENGTH(cell_str),row,col,
                                    dummy,dummy) <> OK THEN BEGIN
                     Obj_SetState(goto_ptr,gotook,Normal,True);
                     action := Form_Do(goto_ptr,gotocell);
                     finished := FALSE;
                  END
                  ELSE
                     finished := TRUE
               END;
               gotohome : finished := TRUE;
               gotocanc : finished := TRUE
            END { CASE }
         UNTIL finished
     END; { EVAL_ACTION }
  PROCEDURE DO_FORM;
     BEGIN
         action := form_begin(goto_ptr,gotocell);
         eval_action;
         form_end
     END;
  PROCEDURE OUTCOME;
     BEGIN
         IF action = gotook THEN
            IF (row >= logical_row_1) AND (col >= logical_col_1) THEN BEGIN
               data_row := row;
               data_col := col;
               start_row := row;
               start_col := col;
               goto_cell := TRUE
            END
            ELSE
         ELSE IF action = gotohome THEN BEGIN
            home_cursor(Origin);
            goto_cell := TRUE
         END
         ELSE
            goto_cell := FALSE
     END;
   BEGIN
       indx := Map_Tree(goto_ptr,Root,Null_Index,ClearSelected);
       Set_Text(goto_ptr,gotocell,null_str,s1,5);
       do_form;
       outcome
   END; { GOTO_CELL }

PROCEDURE REPLICATE_CELL;
   VAR
       action                       : Tree_Index;
       row,col,s_row,s_col,
       f_row,f_col,source_row,
       source_col                   : INTEGER;
       temp                         : STR255;
       it_is_a_formula,do_relative  : BOOLEAN;
       ptr                          : CellPtr;
   PROCEDURE INITIALIZE;
      BEGIN
         indx := Map_Tree(rep_ptr,Root,Null_Index,ClearSelected);
         string_a_cell(data_row,data_col,temp);
         Set_Text(rep_ptr,repsourc,temp,s3,5);
         IF block_set THEN BEGIN
            string_a_cell(b_s_row,b_s_col,temp);
            Set_Text(rep_ptr,repbegin,temp,s1,5);
            string_a_cell(b_e_row,b_e_col,temp);
            Set_Text(rep_ptr,repend,temp,s2,5)
         END
         ELSE BEGIN
            Set_Text(rep_ptr,repbegin,null_str,s1,5);
            Set_Text(rep_ptr,repend,null_str,s2,5)
         END;
         Obj_SetState(rep_ptr,reprel,Selected,FALSE)
      END; { INITIALIZE }
   PROCEDURE EVAL_ACTION;
      VAR str_pos    : INTEGER;
          dummy,done : BOOLEAN;
      FUNCTION GET_EDITED (        what : Tree_Index;
                            VAR row,col : INTEGER ) : BOOLEAN;
         BEGIN
             Get_Text(rep_ptr,what,temp);
             cap_a_string(temp);
             str_pos := 1;
             IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
                               dummy,dummy) <> OK THEN BEGIN
                get_edited := FALSE;
                Obj_SetState(rep_ptr,repok,Normal,TRUE);
                CASE what OF
                   repsourc : action := Form_Do(rep_ptr,repsourc);
                   repbegin : action := Form_Do(rep_ptr,repbegin);
                   repend   : action := Form_Do(rep_ptr,repend)
                END
             END
             ELSE
                get_edited := TRUE
         END; (* GET_EDITED *)
      BEGIN { EVAL_ACTION }
          done := FALSE;
          REPEAT
             IF action = repok THEN
                IF get_edited(repsourc,source_row,source_col) THEN
                   IF get_edited(repbegin,s_row,s_col) THEN
                      IF get_edited(repend,f_row,f_col) THEN
                         IF (s_col>f_col) OR (s_row>f_row) OR
                            (s_col < logical_col_1) OR
                            (s_row < logical_row_1) THEN BEGIN
                            Obj_SetState(rep_ptr,repok,Normal,TRUE);
                            action := Form_Do(rep_ptr,repend)
                         END
                         ELSE BEGIN
                            IF Obj_State(rep_ptr,reprel) & Selected <>0 THEN
                               do_relative := TRUE
                            ELSE
                               do_relative := FALSE;
                            IF assigned(source_row,source_col,ptr)<>Void THEN
                               IF (ptr^.class = Expr) AND
                                  (ptr^.status <> Empty) THEN
                                  it_is_a_formula := TRUE
                               ELSE
                                  it_is_a_formula := FALSE
                            ELSE
                               it_is_a_formula := FALSE;
                            done := TRUE
                         END
          UNTIL (done) OR (action = repcanc)
      END; { EVAL_ACTION }
   PROCEDURE DO_FORM;
      BEGIN
          action := form_begin(rep_ptr,repbegin);
          eval_action;
          form_end
      END; { DO_FORM }
   PROCEDURE DO_REPLICATE;
      LABEL 1;
      VAR i,j   : INTEGER;
          dummy : BOOLEAN;
          ptr   : CellPtr;
      BEGIN
          ptr := locate_cell(source_row,source_col);
          IF ptr <> NIL THEN
             FOR i := s_row TO f_row DO
                 FOR j := s_col TO f_col DO
                     IF (i <> source_row) OR (j <> source_col) THEN BEGIN
                        IF comp_assign(source_row,source_col,
                                       i,j,FALSE) THEN BEGIN
                           IF (it_is_a_formula) AND (do_relative) THEN BEGIN
                              ptr := locate_cell(i,j);
                              IF adjust_expr(adj_refs,ptr,
                                             source_row,source_col,i,j,1,1,
                                             n_rows,n_cols) <> OK THEN BEGIN
                                 all_lists(add,ptr,i,j);
                                 GOTO 1 { quick exit, an OutOfRange error and }
                              END       { the user chose to abort }
                           END;
                           IF it_is_a_formula THEN
                              all_lists(add,ptr,i,j);
                        END
                        ELSE BEGIN
                           Set_Mouse(M_Arrow);
                           out_mem_cell(i,j,'replicated');
                           cell_on_screen(1,i,j,TRUE);
                           GOTO 1
                        END;
                        cell_on_screen(1,i,j,TRUE)
                     END
                     ELSE
          ELSE
             delete_range(s_row,s_col,f_row,f_col,TRUE);
1:    END; { DO_REPLICATE }
   PROCEDURE OUTCOME;
      VAR cell_c : INTEGER;
          dummy  : BOOLEAN;
      BEGIN
          IF action = repok THEN BEGIN
             Set_Mouse(M_Bee);
             do_replicate;
             Set_Mouse(M_Arrow)
          END
      END; { OUTCOME }
   BEGIN
       initialize;
       do_form;
       outcome
   END; { REPLICATE_CELL }

PROCEDURE R_TO_S ( n : LONG_INTEGER; VAR temp : STR255 );
   BEGIN
       real_to_string(n*1.0,temp,0,FALSE);
       DELETE(temp,1,1)
   END; { R_TO_S }

PROCEDURE VIEW_FORMAT;
   { gives the following info: cell name, data type, memory used,
                               col width, just, percent, prec }
   VAR
       action               : Tree_Index;
       loc_format           : INTEGER;
       i,cell_size          : LONG_INTEGER;
       temp                 : STR255;
       a                    : AssignedStatus;
       ptr                  : CellPtr;
   PROCEDURE INITIALIZE;
      VAR i   : INTEGER;
          dep : DepPtr;
      BEGIN
         string_a_cell(data_row,data_col,temp);
         Set_Text(vfrm_ptr,viewcell,temp,s1,5);
         a := assigned(data_row,data_col,ptr);
         IF a <> Void THEN BEGIN
            CASE ptr^.class OF
               Val  : temp := 'Numeric';
               Labl : temp := 'Label';
               Expr : temp := 'Formula';
            END;
            loc_format := ptr^.format
         END
         ELSE BEGIN
            temp := 'Numeric';
            loc_format := default_format
         END;
         Set_Text(vfrm_ptr,viewtype,temp,s2,7);
         cell_size := size(data_row,data_col);
         r_to_s(cell_size,temp);
         Set_Text(vfrm_ptr,viewmem,temp,s3,10);
         int_to_string(col_width[data_col,spaces],temp);
         Set_Text(vfrm_ptr,viewcw,temp,s4,2);
         CASE find_just(ptr) OF
            VDI_Right : temp := 'Right';
            VDI_Left : temp := 'Left';
            VDI_Center : temp := 'Center'
         END;
         Set_Text(vfrm_ptr,viewjust,temp,s5,6);
         IF loc_format & perc_mask <> 0 THEN
            temp := 'Yes'
         ELSE
            temp := 'No';
         Set_Text(vfrm_ptr,viewperc,temp,s6,3);
         IF loc_format & dollar_mask <> 0 THEN
            temp := 'Yes'
         ELSE
            temp := 'No';
         Set_Text(vfrm_ptr,viewdoll,temp,s13,3);
         temp := CHR(find_prec(ptr)+$30);
         Set_Text(vfrm_ptr,viewprec,temp,s7,1);
         i := 0;
         IF a <> Void THEN BEGIN
            dep := ptr^.sub;
            WHILE dep <> NIL DO BEGIN
               i := i+1;
               dep := dep^.next
            END
         END;
         r_to_s(i,temp);
         Set_Text(vfrm_ptr,viewdeps,temp,s8,7);
         IF loc_format & sci_mask <> 0 THEN
            Set_Text(vfrm_ptr,viewsci,'Yes',s9,3)
         ELSE
            Set_Text(vfrm_ptr,viewsci,'No',s9,3);
         IF loc_format & bold_mask <> 0 THEN
            Set_Text(vfrm_ptr,viewbold,'Yes',s10,3)
         ELSE
            Set_Text(vfrm_ptr,viewbold,'No',s10,3);
         IF loc_format & italic_mask <> 0 THEN
            Set_Text(vfrm_ptr,viewital,'Yes',s11,3)
         ELSE
            Set_Text(vfrm_ptr,viewital,'No',s11,3);
         IF loc_format & under_mask <> 0 THEN
            Set_Text(vfrm_ptr,viewundr,'Yes',s12,3)
         ELSE
            Set_Text(vfrm_ptr,viewundr,'No',s12,3);
         Obj_SetState(vfrm_ptr,viewok,Normal,FALSE)
      END; { INITIALIZE }
   PROCEDURE DO_FORM;
      BEGIN
          action := form_begin(vfrm_ptr,Root);
          form_end
      END;
   BEGIN
       initialize;
       do_form
   END; { VIEW_FORMAT }

PROCEDURE HELP ( which : INTEGER );
   VAR
       ptr    : Dialog_Ptr;
       action : Tree_Index;
   BEGIN
       CASE which OF
          1 : ptr := key_ptr;
          2 : ptr := form_ptr;
          3 : ptr := prhelp_ptr;
          4 : ptr := mhelp_ptr;
          5 : ptr := crefhelp_ptr;
          6 : ptr := rechelp_ptr
       END;
       indx := Map_Tree(ptr,Root,Null_Index,ClearSelected);
       action := form_begin(ptr,Root);
       form_end
   END; { HELP }

PROCEDURE SORT;
   VAR row_or_col,s_row,s_col,f_row,f_col,
       key_row,key_col,i,j                     : INTEGER;
       action                                  : Tree_Index;
       temp                                    : STR255;
       ascending                               : BOOLEAN;
   PROCEDURE INITIALIZE;
      BEGIN
         clear_buffer;
         indx := Map_Tree(sort_ptr,Root,Null_Index,ClearSelected);
         row_or_col := 1;
         ascending := TRUE;
         string_a_cell(data_row,data_col,temp);
         Set_Text(sort_ptr,sortkey,temp,s3,5);
         IF block_set THEN BEGIN
            string_a_cell(b_s_row,b_s_col,temp);
            Set_Text(sort_ptr,sortbegi,temp,s1,5);
            string_a_cell(b_e_row,b_e_col,temp);
            Set_Text(sort_ptr,sortend,temp,s2,5)
         END
         ELSE BEGIN
            Set_Text(sort_ptr,sortbegi,null_str,s1,5);
            Set_Text(sort_ptr,sortend,null_str,s2,5)
         END;
         Obj_SetState(sort_ptr,sortasce,Selected,FALSE);
         Obj_SetState(sort_ptr,sortrow,Selected,FALSE)
      END; { INITIALIZE }
   PROCEDURE EVAL_ACTION;
      VAR i,j,str_pos : INTEGER;
          dummy,done  : BOOLEAN;
      FUNCTION GET_EDITED (        what : Tree_Index;
                            VAR row,col : INTEGER     ) : BOOLEAN;
         BEGIN
             Get_Text(sort_ptr,what,temp);
             cap_a_string(temp);
             str_pos := 1;
             IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
                               dummy,dummy) <> OK THEN BEGIN
                get_edited := FALSE;
                Obj_SetState(sort_ptr,sortok,Normal,TRUE);
                CASE what OF
                   sortkey  : action := Form_Do(sort_ptr,sortkey);
                   sortbegi : action := Form_Do(sort_ptr,sortbegi);
                   sortend  : action := Form_Do(sort_ptr,sortend)
                END
             END
             ELSE
                get_edited := TRUE;
         END; (* GET_EDITED *)
      BEGIN { EVAL_ACTION }
          done := FALSE;
          REPEAT
             IF action = sortok THEN
                IF get_edited (sortkey,key_row,key_col) THEN
                   IF get_edited (sortbegi,s_row,s_col) THEN
                      IF get_edited (sortend,f_row,f_col) THEN
                         IF (key_row<s_row) OR (key_row>f_row) OR
                            (key_col<s_col) OR (key_col>f_col) THEN BEGIN
                            Obj_SetState ( sort_ptr,sortok,Normal,TRUE );
                            action := Form_Do(sort_ptr,sortkey)
                         END
                         ELSE IF (s_col>f_col) OR (s_row>f_row) OR
                                 ((row_or_col=1) AND ((f_row-s_row)<1)) OR
                                 ((row_or_col=2) AND ((f_col-s_col)<1)) OR
                                 (s_col < logical_col_1) OR
                                 (s_row < logical_row_1) THEN BEGIN
                            Obj_SetState ( sort_ptr,sortok,Normal,TRUE );
                            action := Form_Do(sort_ptr,sortend)
                         END
                         ELSE
                            done := TRUE;
          UNTIL ( done ) OR ( action = sortcanc );
      END;   (* EVAL_ACTION *)
   PROCEDURE DO_FORM;
      BEGIN
          action := form_begin(sort_ptr,sortbegi);
          eval_action;
          form_end;
      END;
   PROCEDURE BUBBLE_SORT;
      LABEL 1;
      VAR i,j,n,dummy   : INTEGER;
          ptr,ptr1,ptr2 : CellPtr;
      PROCEDURE SWAP ( row_1,row_2,col_1,col_2 : INTEGER );
         { any formulas are copied exactly, with no relative ref changes }
         VAR i,j : INTEGER;
         BEGIN
             IF row_or_col = 1 THEN { by row }
                FOR i := s_col TO f_col DO BEGIN
                    { note that the cells' dep lists stay behind,
                      since they belong to the pos in the worksheet, UNLESS
                      we were to simultaneously adjust the formulas which they
                      influence; a pain and not worth doing. However, if
                      restored to original order, everything will be exactly
                      as before. In order to do this, all cells to be sorted
                      are REQUIRED to exist }
                    IF NOT comp_assign(row_2,i,0,0,FALSE) THEN
                       GOTO 1;
                    IF NOT comp_assign(row_1,i,row_2,i,FALSE) THEN
                       GOTO 1;
                    IF NOT comp_assign(0,0,row_1,i,FALSE) THEN
                       GOTO 1;
                    clear_buffer
                END
             ELSE { by column }
                FOR i := s_row TO f_row DO BEGIN
                    IF NOT comp_assign(i,col_2,0,0,FALSE) THEN
                       GOTO 1;
                    IF NOT comp_assign(i,col_1,i,col_2,FALSE) THEN
                       GOTO 1;
                    IF NOT comp_assign(0,0,i,col_1,FALSE) THEN
                       GOTO 1;
                    clear_buffer;
                END
         END; { SWAP }
      FUNCTION COMPARE ( row_1,col_1,row_2,col_2 : INTEGER ) : BOOLEAN;
         { null: status = Empty               }
         {    a: Labl with status <> Empty    }
         {    n: Val or Expr, status <> Empty }
         {    e: cell with error status       }
         { c_type_1 & 2 give the respective compare-types of the 2 cells }
         TYPE CompareTypes = ( null,e,n,a );
         VAR c_type_1,c_type_2 : CompareTypes;
             stat              : AssignedStatus;
             ptr1,ptr2         : CellPtr;
         BEGIN
             compare := FALSE;
             ptr1 := new_cell(row_1,col_1);
             IF ptr1 = NIL THEN
                GOTO 1;
             stat := assigned(row_1,col_1,ptr1);
             IF stat = Desolate THEN
                c_type_1 := null
             ELSE IF stat = Error THEN
                c_type_1 := e
             ELSE IF ptr1^.class = Labl THEN
                c_type_1 := a
             ELSE
                c_type_1 := n;
             ptr2 := new_cell(row_2,col_2);
             IF ptr2 = NIL THEN
                GOTO 1;
             stat := assigned(row_2,col_2,ptr2);
             IF stat = Desolate THEN
                c_type_2 := null
             ELSE IF stat = Error THEN
                c_type_1 := e
             ELSE IF ptr2^.class = Labl THEN
                c_type_2 := a
             ELSE
                c_type_2 := n;
             { so, now we know what we're comparing. Precedence is as follows,
               in order from least to greatest:
                  1. num and str (Labl-type) both not assigned
                     ( num<str still )
                  2. error status
                  3. num assigned
                  4. str ( = Labl ) <> NIL ( or assigned ).
               Note this implies that both num and str are never both
               assigned in a single cell ( that is, unless the cell is an
               Expr, in which case this is irrelevant, because it's taken
               to be a Val-type for the sake of sorting ).
               However, in cells of differing types,
               Labl always wins, even if it is NIL. That way we separate
               the cells into Val/Expr and Labl types. Formulas are simply
               regarded as either values or labels as above.
               Rather than get too complex in sorting out cells with an
               error status, we simply sort them without paying attention
               to the actual error code; i.e. at the end of the sort,
               all the error-status cells will be in a group, but not in
               any specific order.
               row_1,col_1 reference 'j' in bubble_sort;
               row_2,col_2 reference 'j-1' in bubble_sort }
             WITH ptr1^ DO
                IF ascending THEN
                   IF c_type_1 = c_type_2 THEN
                      IF c_type_1 = null THEN
                         IF (class <> Labl) AND
                            (ptr2^.class = Labl) THEN
                            compare := TRUE
                         ELSE
                      ELSE IF c_type_1 = n THEN
                         IF num < ptr2^.num THEN
                            compare := TRUE
                         ELSE
                      ELSE IF c_type_1 = a THEN
                         IF str^ < ptr2^.str^ THEN
                            compare := TRUE
                         ELSE
                      ELSE { don't swap, they both have error status }
                   ELSE
                      CASE c_type_1 OF
                         null : IF (NOT ((class = Labl) AND
                                         (ptr2^.class <> Labl))
                                   ) OR
                                   (c_type_2 = a) THEN
                                   { Labl and Expr are handled by the }
                                   { NOT clause }
                                   compare := TRUE;
                         n    : IF ((c_type_2 = null) AND
                                    (ptr2^.class = Labl)) OR
                                   (c_type_2 = a) THEN
                                   compare := TRUE;
                         a    : ; { do nothing }
                         e    : IF c_type_2 <> null THEN
                                   compare := TRUE;
                      END { CASE }
                ELSE { descending }
                   IF c_type_1 = c_type_2 THEN
                      IF c_type_1 = null THEN
                         IF (class = Labl) AND
                            (ptr2^.class <> Labl) THEN
                            compare := TRUE
                         ELSE
                      ELSE IF c_type_1 = n THEN
                         IF num > ptr2^.num THEN
                            compare := TRUE
                         ELSE
                      ELSE IF c_type_1 = a THEN
                         IF str^ > ptr2^.str^ THEN
                            compare := TRUE
                         ELSE
                      ELSE { error status, don't swap }
                   ELSE
                      CASE c_type_1 OF
                         null : IF (class = Labl) AND
                                   (ptr2^.class <> Labl) THEN
                                   compare := TRUE;
                         n    : IF (c_type_2 = null) AND
                                   (ptr2^.class <> Labl) THEN
                                   compare := TRUE;
                         a    : IF (c_type_2 = null) OR (c_type_2 = n) THEN
                                   compare := TRUE;
                         e    : IF c_type_2 = null THEN
                                   compare := TRUE;
                      END; { CASE }
         END; { COMPARE }
      BEGIN { BUBBLE_SORT }
          IF Obj_State(sort_ptr,sortrow) & Selected <> 0 THEN
             row_or_col := 1
          ELSE
             row_or_col := 2;
          IF Obj_State(sort_ptr,sortasce) & Selected <> 0 THEN
             ascending := TRUE
          ELSE
             ascending := FALSE;
          Set_Mouse(M_Bee);
          { remove the cells to be sorted from dep lists; the dep lists will
            be recreated later }
          FOR i := s_row TO f_row DO
              FOR j := s_col TO f_col DO BEGIN
                  ptr := locate_cell(i,j);
                  all_lists (remove,ptr,i,j)
              END;
          { actual bubble sort algorithm }
          IF row_or_col = 1 THEN { by rows }
             FOR i := s_row TO f_row-1 DO
                 FOR j := f_row DOWNTO i+1 DO
                     IF compare(j,key_col,j-1,key_col) THEN
                        swap(j,j-1,dummy,dummy)
                     ELSE
          ELSE { by cols }
             FOR i := s_col TO f_col-1 DO
                 FOR j := f_col DOWNTO i+1 DO
                     IF compare(key_row,j,key_row,j-1) THEN
                        swap(dummy,dummy,j,j-1);
          { redo dep lists }
1:        FOR i := s_row TO f_row DO
              FOR j := s_col TO f_col DO BEGIN
                  ptr := locate_cell(i,j);
                  all_lists(add,ptr,i,j)
              END
      END; { BUBBLE_SORT }
   BEGIN { SORT }
       initialize;
       do_form;
       IF action = sortok THEN BEGIN
          bubble_sort;
          FOR i := s_row TO f_row DO
              FOR j := s_col TO f_col DO
                  cell_on_screen(1,i,j,TRUE)
       END;
       clear_buffer;
       Set_Mouse(M_Arrow)
   END; { SORT }

PROCEDURE PRINT_SPREADSHEET ( print                       : BOOLEAN;
                              msg                         : STR30;
                              VAR s_row,s_col,f_row,f_col : INTEGER );
   VAR
       action : Tree_Index;
       i      : INTEGER;
       temp   : STR255;
   PROCEDURE INITIALIZE;
      BEGIN
          indx := Map_Tree(print_ptr,Root,Null_Index,ClearSelected);
          IF p_row_col THEN
             Obj_SetState(print_ptr,printrc,Checked,FALSE)
          ELSE
             Obj_SetState(print_ptr,printrc,Normal,FALSE);
          IF print_formulas THEN
             Obj_SetState(print_ptr,printfor,Checked,FALSE)
          ELSE
             Obj_SetState(print_ptr,printfor,Normal,FALSE);
          IF condensed_print THEN
             Obj_SetState(print_ptr,printcon,Checked,FALSE)
          ELSE
             Obj_SetState(print_ptr,printcon,Normal,FALSE);
          IF draft_final THEN
             Obj_SetState(print_ptr,printdra,Selected,FALSE)
          ELSE
             Obj_SetState(print_ptr,printfin,Selected,FALSE);
          Set_Text(print_ptr,prtitle1,p_title_1,s1,40);
          Set_Text(print_ptr,prtitle2,p_title_2,s2,40);
          Set_Text(print_ptr,printhea,header,s3,40);
          Set_Text(print_ptr,printfoo,footer,s4,40);
          IF block_set THEN BEGIN
             string_a_cell(b_s_row,b_s_col,temp);
             Set_Text(print_ptr,printbeg,temp,s5,5);
             string_a_cell(b_e_row,b_e_col,temp);
             Set_Text(print_ptr,printend,temp,s6,5)
          END
          ELSE IF find_first_and_last(FALSE) THEN BEGIN
             string_a_cell(marks[5].row,marks[5].col,temp);
             Set_Text(print_ptr,printbeg,temp,s5,5);
             string_a_cell(marks[6].row,marks[6].col,temp);
             Set_Text(print_ptr,printend,temp,s6,5)
          END
          ELSE BEGIN
             Set_Text(print_ptr,printbeg,null_str,s5,5);
             Set_Text(print_ptr,printend,null_str,s6,5)
          END;
          Set_Text(print_ptr,prwhat,msg,s7,LENGTH(msg))
      END; { INITIALIZE }
   PROCEDURE DO_FORM;
      VAR str_pos               : INTEGER;
          alert_msg1,alert_msg2 : STR255;
          dummy,done            : BOOLEAN;
      FUNCTION GET_EDITED (        what : Tree_Index;
                            VAR row,col : INTEGER     ) : BOOLEAN;
         BEGIN
             Get_Text(print_ptr,what,temp);
             cap_a_string(temp);
             str_pos := 1;
             IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
                               dummy,dummy) <> OK THEN BEGIN
                get_edited := FALSE;
                Obj_SetState(print_ptr,printok,Normal,TRUE);
                IF what = printend THEN
                   action := Form_Do(print_ptr,printend)
                ELSE
                   action := Form_Do(print_ptr,printbeg);
             END
             ELSE
                get_edited := TRUE
         END; { GET_EDITED }
      PROCEDURE HANDLE_CHECK ( action : Tree_Index; VAR flag : BOOLEAN );
         { the box_chars in the dialog may be checked or not }
         BEGIN
             IF flag THEN
                Obj_SetState(print_ptr,action,Normal,TRUE)
             ELSE
                Obj_SetState(print_ptr,action,Checked,TRUE);
             flag := NOT flag
         END; { HANDLE_CHECK }
      FUNCTION REDUNDANT ( what : P_EdText ) : BOOLEAN;
         { can't have more than one each of the justification specifiers
           in the header and footer }
         VAR i,x     : INTEGER;
             justify : ARRAY [1..3] OF STRING[2];
         BEGIN
             redundant := FALSE;
             justify[1] := '^l';
             justify[2] := '^c';
             justify[3] := '^r';
             FOR i := 1 TO 3 DO BEGIN
                 temp := what;
                 x := POS(justify[i],temp);
                 IF x > 0 THEN BEGIN
                    DELETE(temp,1,x+1);
                    IF POS(justify[i],temp) > 0 THEN
                       redundant := TRUE;
                 END;
             END;
         END; { REDUNDANT }
      BEGIN { DO_FORM }
          alert_msg1 := '[1][Invalid ';
          alert_msg2 := CONCAT ( '! Check for|',
                                  '^ as last character and more|',
                                  'than one occurrence each of|',
                                  '^l, ^c, and ^r.| ][ Continue ]' );
          action := form_begin(print_ptr,prtitle1);
          done := FALSE;
          REPEAT
             IF (action = printrc) OR (action = printfor) OR
                (action = printcon) THEN BEGIN
                IF action = printrc THEN
                   handle_check(action,p_row_col)
                ELSE IF action = printfor THEN
                   handle_check(action,print_formulas)
                ELSE IF action = printcon THEN
                   handle_check(action,condensed_print);
                action := Form_Do(print_ptr,prtitle1);
             END
             ELSE BEGIN
                { do this now so that even if "cancel" was chosen, we'll
                  keep whatever the user had typed in these global vars }
                Get_Text(print_ptr,printhea,header);
                Get_Text(print_ptr,printfoo,footer);
                Get_Text(print_ptr,prtitle1,p_title_1);
                Get_Text(print_ptr,prtitle2,p_title_2);
                IF action = printok THEN
                   IF (header[LENGTH(header)] = '^') OR (redundant(header))
                   THEN BEGIN
                      temp := CONCAT(alert_msg1,'header',alert_msg2);
                      alert := Do_Alert(temp,1);
                      Obj_SetState(print_ptr,action,Normal,TRUE);
                      action := Form_Do(print_ptr,printhea)
                   END
                   ELSE IF (footer[LENGTH(footer)] = '^') OR
                           (redundant(footer)) THEN BEGIN
                      temp := CONCAT(alert_msg1,'footer',alert_msg2);
                      alert := Do_Alert(temp,1);
                      Obj_SetState(print_ptr,action,Normal,TRUE);
                      action := Form_Do(print_ptr,printfoo)
                   END
                   ELSE IF get_edited(printbeg,s_row,s_col) THEN
                      IF get_edited(printend,f_row,f_col) THEN
                         IF (s_row>f_row)  OR (s_col>f_col) THEN BEGIN
                            Obj_SetState(print_ptr,printok,Normal,TRUE);
                            action := Form_Do(print_ptr,printend)
                         END
                         ELSE
                            done := TRUE;
             END; { ELSE }
          UNTIL (done) OR (action = prcancel);
          draft_final := Obj_State(print_ptr,printdra) & Selected <> 0;
          IF (action = printok) AND (print) THEN
             do_print(s_row,f_row,s_col,f_col,port);
          IF action = prcancel THEN
             s_row := 0; { flag for save_text }
          form_end
      END; { DO_FORM }
   BEGIN
       initialize;
       do_form
   END; { PRINT_SPREADSHEET }

PROCEDURE DATA_FILL;
   LABEL 2;
   TYPE Caps    = (NoCaps,OneCap,AllCaps);
        Len     = (Abbr,All);
        StrType = (Day,Month);
   VAR
       action                          : Tree_Index;
       s_row,s_col,f_row,f_col,cur_mo,
       mo_incr,i,j,old_format,
       cur_day,day_incr                : INTEGER;
       fill_number,sense               : BOOLEAN;
       cur_val,incr                    : REAL;
       temp,temp1,temp2                : STR255;
       case_stat                       : Caps;
       len_stat                        : Len;
       string_type                     : StrType;
       ptr                             : CellPtr;
   PROCEDURE INITIALIZE;
      BEGIN
          indx := Map_Tree(data_fill_ptr,Root,Null_Index,ClearSelected);
          Obj_SetState(data_fill_ptr,datadown,Selected,FALSE);
          Set_Text(data_fill_ptr,datainit,null_str,s1,12);
          Set_Text(data_fill_ptr,dataincr,null_str,s2,12);
          IF block_set THEN BEGIN
             string_a_cell(b_s_row,b_s_col,temp);
             Set_Text(data_fill_ptr,databegi,temp,s3,5);
             string_a_cell(b_e_row,b_e_col,temp);
             Set_Text(data_fill_ptr,dataend,temp,s4,5)
          END
          ELSE BEGIN
             Set_Text(data_fill_ptr,databegi,null_str,s3,5);
             Set_Text(data_fill_ptr,dataend,null_str,s4,5)
          END
      END; { INITIALIZE }
   FUNCTION DO_FORM : BOOLEAN;
      LABEL 1;
      VAR str_pos,i        : INTEGER;
          done,dummy,found : BOOLEAN;
          str              : STR255;
      FUNCTION GET_EDITED (        what : Tree_Index;
                            VAR row,col : INTEGER     ) : BOOLEAN;
         BEGIN
             Get_Text(data_fill_ptr,what,temp);
             cap_a_string(temp);
             str_pos := 1;
             IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
                               dummy,dummy) <> OK THEN BEGIN
                get_edited := FALSE;
                Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
                IF what = dataend THEN
                   action := Form_Do(data_fill_ptr,dataend)
                ELSE
                   action := Form_Do(data_fill_ptr,databegi);
             END
             ELSE
                get_edited := TRUE
         END; { GET_EDITED }
      BEGIN { DO_FORM }
          do_form := FALSE;
          action := form_begin(data_fill_ptr,datainit);
1:        done := FALSE;
          REPEAT
             IF action = dataok THEN
                IF get_edited(databegi,s_row,s_col) THEN
                   IF get_edited(dataend,f_row,f_col) THEN
                      IF (s_row>f_row)  OR (s_col>f_col) OR
                         (s_col < logical_col_1) OR
                         (s_row < logical_row_1) THEN BEGIN
                         Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
                         action := Form_Do(data_fill_ptr,dataend)
                      END
                      ELSE
                         done := TRUE
          UNTIL (done) OR (action = datacanc);
          IF action = dataok THEN BEGIN
             sense := Obj_State(data_fill_ptr,datadown) & Selected <> 0;
             Get_Text(data_fill_ptr,datainit,temp);
             Get_Text(data_fill_ptr,dataincr,temp1);
             IF valid_number(temp) = OK THEN
                IF valid_number(temp1) = OK THEN BEGIN
                   cur_val := string_to_real(temp);
                   IF temp = 'OVERFLOW' THEN BEGIN
                      Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
                      action := Form_Do(data_fill_ptr,datainit);
                      GOTO 1
                   END
                   ELSE BEGIN
                      incr := string_to_real(temp1);
                      IF temp1 = 'OVERFLOW' THEN BEGIN
                         Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
                         action := Form_Do(data_fill_ptr,dataincr);
                         GOTO 1
                      END
                      ELSE
                         fill_number := TRUE
                   END
                END
                ELSE BEGIN
                   Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
                   action := Form_Do(data_fill_ptr,dataincr);
                   GOTO 1
                END
             ELSE IF LENGTH(temp) < 3 THEN BEGIN
                Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
                action := Form_Do(data_fill_ptr,datainit);
                GOTO 1
             END
             ELSE BEGIN
                str := '';
                FOR i := 1 TO LENGTH(temp) DO
                    IF temp[i] IN up_case THEN
                       str := CONCAT(str,CHR(ORD(temp[i])+32))
                    ELSE
                       str := CONCAT(str,temp[i]);
                i := 1;
                found := FALSE;
                WHILE (i <= 12) AND (NOT found) DO BEGIN
                   temp2 := COPY(months[i],1,3);
                   IF (str = months[i]) OR (str = temp2) THEN BEGIN
                      IF str = temp2 THEN
                         len_stat := Abbr
                      ELSE
                         len_stat := All;
                      IF temp[1] IN low_case THEN { temp = unmodified str }
                         case_stat := NoCaps
                      ELSE IF (temp[2] IN up_case) THEN
                         case_stat := AllCaps
                      ELSE
                         case_stat := OneCap;
                      found := TRUE;
                      string_type := Month;
                      cur_mo := i
                   END
                   ELSE
                      i := i+1
                END;
                IF NOT found THEN BEGIN
                   i := 1;
                   WHILE (i <= 7) AND (NOT found) DO BEGIN
                      temp2 := COPY(days[i],1,3);
                      IF (str = days[i]) OR (str = temp2) THEN BEGIN
                         IF str = temp2 THEN
                            len_stat := Abbr
                         ELSE
                            len_stat := All;
                         IF temp[1] IN low_case THEN
                            case_stat := NoCaps
                         ELSE IF (temp[2] IN up_case) THEN
                            case_stat := AllCaps
                         ELSE
                            case_stat := OneCap;
                         found := TRUE;
                         string_type := Day;
                         cur_day := i
                      END
                      ELSE
                         i := i+1
                   END
                END;
                IF NOT found THEN BEGIN
                   Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
                   action := Form_Do(data_fill_ptr,datainit);
                   GOTO 1
                END
                ELSE IF valid_number(temp1) = OK THEN BEGIN
                   incr := string_to_real(temp1);
                   IF (temp1 = 'OVERFLOW') OR (incr < 0) OR
                      ((incr > 12) AND (string_type = Month)) OR
                      ((incr > 7) AND (string_type = Day)) THEN BEGIN
                      Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
                      action := Form_Do(data_fill_ptr,dataincr);
                      GOTO 1
                   END
                   ELSE IF string_type = Day THEN BEGIN
                      fill_number := FALSE;
                      day_incr := ROUND(incr)
                   END
                   ELSE BEGIN { was months }
                      fill_number := FALSE;
                      mo_incr := ROUND(incr)
                   END
                END
                ELSE BEGIN
                   Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
                   action := Form_Do(data_fill_ptr,dataincr);
                   GOTO 1
                END
             END
          END;
          do_form := action = dataok;
          form_end
      END; { DO_FORM }
   FUNCTION DO_FILL : BOOLEAN;
      VAR i : INTEGER;
      BEGIN
          IF old_format <> 0 THEN
             ptr^.format := old_format;
          do_fill := TRUE;
          IF fill_number THEN BEGIN { working with numbers }
             ptr^.class := Val;
             ptr^.num := cur_val;
             ptr^.status := Full;
             cur_val := cur_val+incr
          END
          ELSE IF NOT request_memory(AString) THEN { working with days or }
             do_fill := FALSE                      { months }
          ELSE BEGIN
             NEW(ptr^.str);
             IF len_stat = Abbr THEN
                IF string_type = Day THEN
                   ptr^.str^ := COPY(days[cur_day],1,3)
                ELSE
                   ptr^.str^ := COPY(months[cur_mo],1,3)
             ELSE IF string_type = Day THEN
                ptr^.str^ := days[cur_day]
             ELSE
                ptr^.str^ := months[cur_mo];
             IF case_stat = OneCap THEN
                ptr^.str^[1] := CHR(ORD(ptr^.str^[1])-32)
             ELSE IF case_stat = AllCaps THEN
                FOR i := 1 TO LENGTH(ptr^.str^) DO
                    ptr^.str^[i] := CHR(ORD(ptr^.str^[i])-32);
             ptr^.class := Labl;
             ptr^.status := Full;
             ptr^.format := (ptr^.format & no_just_mask) | $0010;
             IF string_type = Day THEN BEGIN
                cur_day := cur_day+day_incr;
                IF cur_day > 7 THEN
                   cur_day := cur_day-7
             END
             ELSE BEGIN
                cur_mo := cur_mo+mo_incr;
                IF cur_mo > 12 THEN
                   cur_mo := cur_mo-12
             END
          END
      END; { DO_FILL }
   BEGIN { main }
       initialize;
       IF do_form THEN BEGIN
          Set_Mouse(M_Bee);
          IF sense THEN { fill down }
             FOR i := s_col TO f_col DO
                 FOR j := s_row TO f_row DO BEGIN
                     ptr := locate_cell(j,i);
                     IF ptr <> NIL THEN BEGIN
                        old_format := ptr^.format;
                        delete_cell(j,i,FALSE)
                     END
                     ELSE
                        old_format := 0;
                     ptr := new_cell(j,i);
                     IF ptr <> NIL THEN
                        IF NOT do_fill THEN
                           GOTO 2
                        ELSE
                           cell_on_screen(1,j,i,TRUE)
                     ELSE
                        GOTO 2
                 END
          ELSE { fill right }
             FOR i := s_row TO f_row DO
                 FOR j := s_col TO f_col DO BEGIN
                     ptr := locate_cell(i,j);
                     IF ptr <> NIL THEN BEGIN
                        old_format := ptr^.format;
                        delete_cell(i,j,FALSE)
                     END
                     ELSE
                        old_format := 0;
                     ptr := new_cell(i,j);
                     IF ptr <> NIL THEN
                        IF NOT do_fill THEN
                           GOTO 2
                        ELSE
                           cell_on_screen(1,i,j,TRUE)
                     ELSE
                        GOTO 2
                 END;
       END;
2:     Set_Mouse(M_Arrow)
   END; { DATA_FILL }

PROCEDURE ERROR_MESSAGE ( VAR str     : LorFstr;
                          error       : StatusType;
                          str_pos,len : INTEGER     );
   VAR
       i         : INTEGER;
       action    : Tree_Index;
       temp      : STR255;
   BEGIN
       Obj_SetState(err_ptr,errok,Normal,FALSE);
       Set_Text(err_ptr,errtype,error_msg[error],s1,LENGTH(error_msg[error]));
       IF str_pos > len THEN
          str_pos := len
       ELSE IF str_pos < 1 THEN { should be impossible }
          str_pos := 1;
       Set_Text(err_ptr,errform,str,s2,string_len);
       temp := '';
       FOR i := 1 TO string_len DO
           temp := CONCAT(' ',temp);
       temp[str_pos] := '^';
       Set_Text(err_ptr,errcarat,temp,s3,string_len);
       action := form_begin(err_ptr,errform);
       Get_Text(err_ptr,errform,str);
       form_end
   END; { ERROR_MESSAGE }

FUNCTION ASK_FOR_RANGE ( VAR s_r,s_c,e_r,e_c : INTEGER;
                         title               : STR30    ) : BOOLEAN;
   VAR
       action : Tree_Index;
       i      : INTEGER;
       temp   : STR255;
   FUNCTION EVAL_ACTION : BOOLEAN;
      VAR str_pos    : INTEGER;
          dummy,done : BOOLEAN;
      FUNCTION GET_EDITED (        what : Tree_Index;
                            VAR row,col : INTEGER ) : BOOLEAN;
         BEGIN
             Get_Text(rang_ptr,what,temp);
             cap_a_string(temp);
             str_pos := 1;
             IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
                               dummy,dummy) <> OK THEN BEGIN
                get_edited := FALSE;
                Obj_SetState ( rang_ptr,rangok,Normal,TRUE );
                CASE what OF
                   rangbegi : action := Form_Do(rang_ptr,rangbegi);
                   rangend  : action := Form_Do(rang_ptr,rangend)
                END
            END
             ELSE
                get_edited := TRUE
         END; (* GET_EDITED *)
      BEGIN { EVAL_ACTION }
          done := FALSE;
          eval_action := FALSE;
          REPEAT
             IF action = rangok THEN
                IF get_edited(rangbegi,s_r,s_c) THEN
                   IF get_edited(rangend,e_r,e_c) THEN
                      IF (s_c > e_c) OR (s_r > e_r) THEN BEGIN
                         Obj_SetState(rang_ptr,rangok,Normal,TRUE);
                         action := Form_Do(rang_ptr,rangend)
                      END
                      ELSE BEGIN
                         done := TRUE;
                         eval_action := TRUE
                      END
          UNTIL (done) OR (action = rangcanc)
      END; { EVAL_ACTION }
   BEGIN { RANGE_TO_DISK }
       indx := Map_Tree(rang_ptr,Root,Null_Index,ClearSelected);
       Set_Text(rang_ptr,rangwhat,title,s3,12);
       IF block_set THEN BEGIN
          string_a_cell(b_s_row,b_s_col,temp);
          Set_Text(rang_ptr,rangbegi,temp,s1,5);
          string_a_cell(b_e_row,b_e_col,temp);
          Set_Text(rang_ptr,rangend,temp,s2,5)
       END
       ELSE IF find_first_and_last(FALSE) THEN BEGIN
          string_a_cell(marks[5].row,marks[5].col,temp);
          Set_Text(rang_ptr,rangbegi,temp,s1,5);
          string_a_cell(marks[6].row,marks[6].col,temp);
          Set_Text(rang_ptr,rangend,temp,s2,5)
       END
       ELSE BEGIN
          Set_Text(rang_ptr,rangbegi,null_str,s1,5);
          Set_Text(rang_ptr,rangend,null_str,s2,5)
       END;
       action := form_begin(rang_ptr,rangbegi);
       ask_for_range := eval_action;
       form_end
   END; { ASK_FOR_RANGE }

PROCEDURE STATS;
   VAR i                                 : INTEGER;
       n_cell,n_val,n_label,n_expr,n_dep : LONG_INTEGER;
       temp                              : STR255;
       action                            : Tree_Index;
       dep                               : DepPtr;
       ptr                               : CellPtr;
   BEGIN
       Set_Mouse(M_Bee);
       Obj_SetState(stat_ptr,statok,Normal,FALSE);
       n_cell := 0;
       n_val := 0;
       n_label := 0;
       n_expr := 0;
       n_dep := 0;
       i := 1;
       WHILE i <= n_rows DO BEGIN
          ptr := data[i];
          WHILE ptr <> NIL DO BEGIN
             n_cell := n_cell+1;
             CASE ptr^.class OF
                Val  : n_val := n_val+1;
                Labl : n_label := n_label+1;
                Expr : n_expr := n_expr+1
             END;
             dep := ptr^.sub;
             WHILE dep <> NIL DO BEGIN
                n_dep := n_dep+1;
                dep := dep^.next
             END;
             ptr := ptr^.next
          END;
          i := i+1
       END;
       r_to_s(n_cell,temp);
       Set_Text(stat_ptr,statcell,temp,s1,7);
       r_to_s(n_val,temp);
       Set_Text(stat_ptr,statval,temp,s2,7);
       r_to_s(n_label,temp);
       Set_Text(stat_ptr,statlabl,temp,s3,7);
       r_to_s(n_expr,temp);
       Set_Text(stat_ptr,statexpr,temp,s4,7);
       r_to_s(n_dep,temp);
       Set_Text(stat_ptr,statdeps,temp,s5,7);
       r_to_s(original_memory-working_memory,temp);
       Set_Text(stat_ptr,statmemc,temp,s6,10);
       r_to_s(working_memory,temp);
       Set_Text(stat_ptr,statmema,temp,s7,10);
       action := form_begin(stat_ptr,Root);
       form_end
   END; { STATS }

FUNCTION DO_FREEZE : BOOLEAN;
   VAR redraw,dummy : BOOLEAN;
       temp         : STR255;
       action,which : Tree_Index;
   BEGIN
      temp := CONCAT('[1][You may not freeze the last|' ,
                         'row or column.][  OK  ]');
      do_freeze := FALSE;
      redraw := FALSE;
      indx := Map_Tree(freeze_ptr,Root,Null_Index,ClearSelected);
      action := form_begin(freeze_ptr,Root);
      form_end;
      which := Map_Tree(freeze_ptr,frzrow,frzboth,ReturnSelected);
      IF (action = frzok) AND (which <> Null_Index) THEN BEGIN
         IF (which = frzrow) OR (which = frzboth) THEN
            IF data_row = n_rows THEN
               alert := Do_Alert(temp,1)
            ELSE BEGIN
               freeze_row := data_row;
               logical_row_1 := freeze_row+1;
               start_row := logical_row_1;
               data_row := start_row;
               y_margin := two_cell_h-1;
               { must do this so that switch will save correct finish_row &
                 col so that return_attr can recalc correct v & h_entry.
                 Failure to do this can lead to a crash when handle_message
                 tries to calculate slider positions and these entry values
                 equal n_rows or n_cols due to a non-updated finish row or
                 col }
               get_num_scr_entries(ExRight);
               IF n_hdls = 2 THEN BEGIN
                  switch_window;
                  IF start_row < logical_row_1 THEN
                     start_row := logical_row_1;
                  get_num_scr_entries(ExRight);
                  switch_window
               END;
               IF (block_set) AND (b_s_row < start_row) THEN
                  dummy := deselect_block;
               redraw := TRUE;
               do_freeze := TRUE
            END;
         IF (which = frzcol) OR (which = frzboth) THEN
            IF data_col = n_cols THEN
               alert := Do_Alert(temp,1)
            ELSE BEGIN
               freeze_col := data_col;
               logical_col_1 := freeze_col+1;
               start_col := logical_col_1;
               data_col := start_col;
               x_margin := 39+col_width[freeze_col,pixels];
               get_num_scr_entries(ExRight);
               IF n_hdls = 2 THEN BEGIN
                  switch_window;
                  IF start_col < logical_col_1 THEN
                     start_col := logical_col_1;
                  get_num_scr_entries(ExRight);
                  switch_window
               END;
               IF (block_set) AND (b_s_col < start_col) THEN
                  dummy := deselect_block;
               redraw := TRUE;
               do_freeze := TRUE
            END
      END
      ELSE IF (action = frzundo) AND (which <> Null_Index) THEN BEGIN
         IF ((which = frzrow) OR (which = frzboth)) AND
            (freeze_row > 0) THEN BEGIN
            freeze_row := 0;
            logical_row_1 := 1;
            y_margin := cell_height-1;
            redraw := TRUE;
            do_freeze := TRUE
         END;
         IF ((which = frzcol) OR (which = frzboth)) AND
            (freeze_col > 0) THEN BEGIN
            freeze_col := 0;
            logical_col_1 := 1;
            x_margin := 38;
            redraw := TRUE;
            do_freeze := TRUE
         END
      END;
      IF redraw THEN
         Send_Redraw(TRUE,0,0,screen_width,screen_height)
   END; { DO_FREEZE }




BEGIN
END.