home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / apps / spread / opusprg / opussrc / r.pas < prev    next >
Pascal/Delphi Source File  |  1988-05-23  |  72KB  |  1,766 lines
  1.  
  2.  
  3. {$M+}
  4. {$E+}
  5. PROGRAM Mock;
  6.  
  7. {$I i:\opus.i}
  8. {$I i:\gctv.inc}
  9.  
  10. {$I i:\gemsubs.def}
  11. {$I i:\vdi_aes.def}
  12. {$I i:\globsubs.def}
  13. {$I d:\pascal\opus\xbios.def}
  14. {$I d:\pascal\opus\graphout.def}
  15. {$I d:\pascal\opus\stringfn.def}
  16.  
  17. FUNCTION DESELECT_BLOCK : BOOLEAN;
  18.    EXTERNAL;
  19.  
  20. PROCEDURE DO_PRINT ( s_row,f_row,s_col,f_col : INTEGER; handle : INTEGER );
  21.    EXTERNAL;
  22.  
  23. PROCEDURE CAP_A_STRING ( VAR str : STRING );
  24.    VAR i : INTEGER;
  25.    BEGIN
  26.        FOR i := 1 TO LENGTH(str) DO
  27.            IF str[i] IN low_case THEN
  28.               str[i] := CHR(ORD(str[i])-$20)
  29.    END; { CAPITALIZE }
  30.  
  31. FUNCTION FORM_BEGIN ( box : Dialog_Ptr; index : Tree_Index ) : Tree_Index;
  32.    BEGIN
  33.        Hide_Mouse;
  34.        Set_Mouse(M_Arrow); { in case it was not that }
  35.        Form_Center(box,fo_x,fo_y,fo_w,fo_h);
  36.        Blit(screen_mfdb,mem_mfdb,fo_x,fo_y,fo_x,fo_y,fo_w,fo_h);
  37.        Form_Dial(0,0,0,0,0,fo_x,fo_y,fo_w,fo_h);
  38.        Obj_Draw(box,Root,Max_Depth,fo_x,fo_y,fo_w,fo_h);
  39.        Show_Mouse;
  40.        form_begin := Form_Do(box,index)
  41.    END; { FORM_BEGIN }
  42.    
  43. PROCEDURE FORM_END;
  44.    VAR event : INTEGER;
  45.    BEGIN
  46.        Hide_Mouse;
  47.        Form_Dial(3,fo_x,fo_y,fo_w,fo_h,fo_x,fo_y,fo_w,fo_h);
  48.        Set_Clip(0,0,screen_width,screen_height);
  49.        Blit(mem_mfdb,screen_mfdb,fo_x,fo_y,fo_x,fo_y,fo_w,fo_h);
  50.        { now must get redraw message generated by clearing the dialog;
  51.          possibility of discarding non-redraw messages but this doesn't seem
  52.          to be a problem, since all messages preceding the dialog call were
  53.          processed, and the modal nature of the dialog prevents the occurence
  54.          of message events ( and others ) for this application during the
  55.          dialog }
  56.        REPEAT
  57.             event := Get_Event(E_Message|E_Timer,0,0,0,5,FALSE,0,0,0,0,
  58.                                FALSE,0,0,0,0,msg_area,i,i,i,i,i,i)
  59.        UNTIL event & E_Timer <> 0;
  60.        Show_Mouse
  61.    END; { FORM_END }
  62.  
  63. PROCEDURE CHANGE_FORMAT ( caller : FormatCall );
  64.    CONST s = 1;
  65.          r = 2;
  66.          g = 3;
  67.    VAR
  68.        action                       : Tree_Index;
  69.        chosen_width,
  70.        chosen_prec,
  71.        i,j,extent,s_row,s_col,
  72.        f_row,f_col,chosen_style     : INTEGER;
  73.        found,do_cw,do_just,do_prec,
  74.        do_perc,sci_flag,perc_on,
  75.        do_style,dummy,do_dollar,
  76.        dollar_on                    : BOOLEAN;
  77.        temp                         : STR255;
  78.        chosen_just                  : VDI_Just;
  79.        ptr                          : CellPtr;
  80.   PROCEDURE INITIALIZE;
  81.      BEGIN
  82.          indx := Map_Tree(fmat_ptr,Root,Null_Index,ClearSelected);
  83.          IF caller = GlobalCall THEN BEGIN
  84.             extent := g;
  85.             Obj_SetState(fmat_ptr,fmatglob,Selected,FALSE);
  86.             Set_Text(fmat_ptr,fmatbegi,null_str,s1,5);
  87.             Set_Text(fmat_ptr,fmatend,null_str,s2,5)
  88.          END
  89.          ELSE IF block_set THEN BEGIN
  90.             extent := r;
  91.             Obj_SetState(fmat_ptr,fmatrang,Selected,FALSE);
  92.             string_a_cell(b_s_row,b_s_col,temp);
  93.             Set_Text(fmat_ptr,fmatbegi,temp,s1,5);
  94.             string_a_cell(b_e_row,b_e_col,temp);
  95.             Set_Text(fmat_ptr,fmatend,temp,s2,5)
  96.          END
  97.          ELSE BEGIN
  98.             extent := s;
  99.             Obj_SetState(fmat_ptr,fmatcell,Selected,FALSE);
  100.             string_a_cell(data_row,data_col,temp);
  101.             Set_Text(fmat_ptr,fmatbegi,temp,s1,5);
  102.             Set_Text(fmat_ptr,fmatend,null_str,s2,5)
  103.          END;
  104.          do_cw := FALSE;
  105.          do_dollar := FALSE;
  106.          do_just := FALSE;
  107.          do_prec := FALSE;
  108.          do_perc := FALSE;
  109.          do_style := FALSE;
  110.          CASE caller OF
  111.             CWCall   : BEGIN
  112.                Obj_SetState(fmat_ptr,fmatcw,Selected,FALSE);
  113.                do_cw := TRUE
  114.             END;
  115.             DollarCall : BEGIN
  116.                Obj_SetState(fmat_ptr,fmatdoll,Selected,FALSE);
  117.                do_dollar := TRUE
  118.             END;
  119.             JustCall : BEGIN
  120.                Obj_SetState(fmat_ptr,fmatjust,Selected,FALSE);
  121.                do_just := TRUE
  122.             END;
  123.             PrecCall : BEGIN
  124.                Obj_SetState(fmat_ptr,fmatprec,Selected,FALSE);
  125.                do_prec := TRUE
  126.             END;
  127.             PercCall : BEGIN
  128.                Obj_SetState(fmat_ptr,fmatperc,Selected,FALSE);
  129.                do_perc := TRUE
  130.             END;
  131.             StyleCall : BEGIN
  132.                Obj_SetState(fmat_ptr,fmatstyl,Selected,FALSE);
  133.                do_style := TRUE
  134.             END;
  135.             GlobalCall : ;
  136.          END;
  137.          chosen_width := col_width[data_col,spaces];
  138.          int_to_string(chosen_width,temp);
  139.          IF LENGTH(temp) < 2 THEN
  140.             temp := CONCAT(' ',temp);
  141.          Set_Text(fmat_ptr,fmatcwsz,temp,s3,2);
  142.          ptr := locate_cell(data_row,data_col);
  143.          chosen_just := find_just(ptr);
  144.          Obj_SetState(fmat_ptr,chosen_just+ORD(justleft),Selected,FALSE);
  145.          chosen_prec := find_prec(ptr);
  146.          Obj_SetState(fmat_ptr,ORD(prec0)+chosen_prec,Selected,FALSE);
  147.          IF ptr <> NIL THEN
  148.             chosen_style := ptr^.format & style_mask
  149.          ELSE
  150.             chosen_style := default_format & style_mask;
  151.          IF chosen_style & bold_mask <> 0 THEN
  152.             Obj_SetState(fmat_ptr,textbold,Selected,FALSE);
  153.          IF chosen_style & italic_mask <> 0 THEN
  154.             Obj_SetState(fmat_ptr,textital,Selected,FALSE);
  155.          IF chosen_style & under_mask <> 0 THEN
  156.             Obj_SetState(fmat_ptr,textundr,Selected,FALSE);
  157.          IF ptr <> NIL THEN BEGIN
  158.             IF ptr^.format & sci_mask <> 0 THEN
  159.                Obj_SetState(fmat_ptr,precscin,Selected,FALSE);
  160.             IF ptr^.format & dollar_mask <> 0 THEN
  161.                Obj_SetState(fmat_ptr,fmatdchk,Checked,FALSE)
  162.             ELSE
  163.                Obj_SetState(fmat_ptr,fmatdchk,Normal,FALSE);
  164.             IF ptr^.format & perc_mask <> 0 THEN
  165.                Obj_SetState(fmat_ptr,fmatpchk,Checked,FALSE)
  166.             ELSE
  167.                Obj_SetState(fmat_ptr,fmatpchk,Normal,FALSE)
  168.          END
  169.          ELSE BEGIN
  170.             IF default_format & sci_mask <> 0 THEN
  171.                Obj_SetState(fmat_ptr,precscin,Selected,FALSE);
  172.             IF default_format & dollar_mask <> 0 THEN
  173.                Obj_SetState(fmat_ptr,fmatdchk,Checked,FALSE)
  174.             ELSE
  175.                Obj_SetState(fmat_ptr,fmatdchk,Normal,FALSE);
  176.             IF default_format & perc_mask <> 0 THEN
  177.                Obj_SetState(fmat_ptr,fmatpchk,Checked,FALSE)
  178.             ELSE
  179.                Obj_SetState(fmat_ptr,fmatpchk,Normal,FALSE)
  180.          END
  181.      END; { INITIALIZE }
  182.   PROCEDURE EVAL_ACTION;
  183.      LABEL 1;
  184.      VAR i,j,inc  : INTEGER;
  185.          done     : BOOLEAN;
  186.      FUNCTION GET_EDITED (     what : Tree_Index;
  187.                            VAR row,col : INTEGER   ) : BOOLEAN;
  188.          VAR str_pos : INTEGER;
  189.          BEGIN
  190.              Get_Text(fmat_ptr,what,temp);
  191.              cap_a_string(temp);
  192.              str_pos := 1;
  193.              IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
  194.                                dummy,dummy ) <> OK THEN BEGIN
  195.                 get_edited := FALSE;
  196.                 Obj_SetState(fmat_ptr,fmatok,Normal,TRUE)
  197.              END
  198.              ELSE
  199.                 get_edited := TRUE
  200.         END; (* GET_EDITED *)
  201.      BEGIN { EVAL_ACTION }
  202.          done := FALSE;
  203. 1:       REPEAT
  204.             IF action = fmatok THEN BEGIN
  205.                CASE Map_Tree(fmat_ptr,fmatcell,fmatglob,ReturnSelected) OF
  206.                   fmatcell : extent := s;
  207.                   fmatrang : extent := r;
  208.                   fmatglob : extent := g
  209.                END;
  210.                IF Obj_State(fmat_ptr,fmatcw) & Selected <> 0 THEN BEGIN
  211.                   Get_Text(fmat_ptr,fmatcwsz,temp);
  212.                   WHILE POS(' ',temp) <> 0 DO
  213.                      DELETE(temp,POS(' ',temp),1);
  214.                   IF LENGTH(temp) = 0 THEN BEGIN
  215.                      Obj_SetState(fmat_ptr,fmatok,Normal,TRUE);
  216.                      action := Form_Do(fmat_ptr,fmatcwsz);
  217.                      GOTO 1
  218.                   END
  219.                   ELSE BEGIN
  220.                      chosen_width := 0;
  221.                      inc := 1;
  222.                      FOR i := LENGTH(temp) DOWNTO 1 DO BEGIN
  223.                          chosen_width := chosen_width+(ORD(temp[i])-$30)*inc;
  224.                          inc := inc*10
  225.                       END;
  226.                       IF (chosen_width < 5) OR (chosen_width > 30) THEN BEGIN
  227.                          Obj_SetState(fmat_ptr,fmatok,Normal,TRUE);
  228.                          action := Form_Do(fmat_ptr,fmatcwsz);
  229.                          GOTO 1
  230.                       END
  231.                   END   
  232.                END;
  233.                IF extent = s THEN
  234.                   IF get_edited (fmatbegi,s_row,s_col) THEN
  235.                      done := TRUE
  236.                   ELSE
  237.                      action := Form_Do(fmat_ptr,fmatbegi)
  238.                ELSE IF extent = r THEN
  239.                   IF get_edited (fmatbegi,s_row,s_col) THEN
  240.                      IF get_edited (fmatend,f_row,f_col) THEN
  241.                         IF (s_col > f_col) OR (s_row > f_row) OR
  242.                            (s_col < logical_col_1) OR 
  243.                            (s_row < logical_row_1) THEN BEGIN
  244.                            Obj_SetState(fmat_ptr,fmatok,Normal,TRUE);
  245.                            action := Form_Do(fmat_ptr,fmatend)
  246.                         END
  247.                         ELSE
  248.                            done := TRUE
  249.                      ELSE
  250.                         action := Form_Do(fmat_ptr,fmatend)
  251.                   ELSE
  252.                      action := Form_Do(fmat_ptr,fmatbegi)
  253.                ELSE { extent was global }
  254.                   done := TRUE;
  255.             END { action = cwok }
  256.             ELSE IF (action = fmatcwdn) OR (action = fmatcwup) THEN BEGIN
  257.                IF action = fmatcwdn THEN 
  258.                   IF chosen_width > 5 THEN
  259.                      chosen_width := chosen_width-1
  260.                   ELSE
  261.                ELSE IF chosen_width < 30 THEN
  262.                   chosen_width := chosen_width+1;
  263.                int_to_string(chosen_width,temp);
  264.                IF LENGTH(temp) < 2 THEN
  265.                   temp := CONCAT(' ',temp);
  266.                Set_Text(fmat_ptr,fmatcwsz,temp,s3,2);
  267.                Obj_Draw(fmat_ptr,fmatcwsz,fmatcwsz,fo_x,fo_y,fo_w,fo_h);
  268.                action := Form_Do(fmat_ptr,fmatcwsz)
  269.             END
  270.             ELSE IF action = fmatdchk THEN BEGIN
  271.                IF dollar_on THEN
  272.                   Obj_SetState(fmat_ptr,fmatdchk,Normal,TRUE)
  273.                ELSE
  274.                   Obj_SetState(fmat_ptr,fmatdchk,Checked,TRUE);
  275.                dollar_on := NOT dollar_on;
  276.                action := Form_Do(fmat_ptr,fmatbegi)
  277.             END      
  278.             ELSE IF action = fmatpchk THEN BEGIN
  279.                IF perc_on THEN
  280.                   Obj_SetState(fmat_ptr,fmatpchk,Normal,TRUE)
  281.                ELSE
  282.                   Obj_SetState(fmat_ptr,fmatpchk,Checked,TRUE);
  283.                perc_on := NOT perc_on;
  284.                action := Form_Do(fmat_ptr,fmatbegi)
  285.             END      
  286.          UNTIL (done) OR (action = fmatcanc);
  287.      END;   (* EVAL_ACTION *)
  288.   PROCEDURE DO_FORM;
  289.      BEGIN
  290.          IF (caller = CWCall) OR (caller = GlobalCall) THEN
  291.             action := form_begin(fmat_ptr,fmatcwsz)
  292.          ELSE
  293.             action := form_begin(fmat_ptr,fmatbegi);
  294.          eval_action;
  295.          form_end
  296.      END;
  297.   PROCEDURE OUTCOME;
  298.      VAR i,j   : INTEGER;
  299.          ptr   : CellPtr;
  300.      PROCEDURE SET_JUST ( VAR format : INTEGER );
  301.         BEGIN
  302.             CASE chosen_just OF
  303.                VDI_Left   : BEGIN
  304.                   format := format & no_just_mask;
  305.                   format := format | $0010
  306.                END;
  307.                VDI_Center : format := format | $0030;
  308.                VDI_Right  : format := format & no_just_mask
  309.             END   
  310.         END; { SET_JUST }
  311.      PROCEDURE SET_PREC ( VAR format : INTEGER );
  312.         BEGIN
  313.             format := format & no_prec_mask;
  314.             format := format | chosen_prec;
  315.             IF sci_flag THEN
  316.                format := format | sci_mask
  317.             ELSE
  318.                format := format & no_sci_mask
  319.         END; { SET_PREC }
  320.      PROCEDURE SET_DOLLAR ( VAR format : INTEGER );
  321.         BEGIN
  322.             format := format & no_dollar_mask;
  323.             IF dollar_on THEN
  324.                format := format | dollar_mask
  325.         END;
  326.      PROCEDURE SET_PERC ( VAR format : INTEGER );
  327.         BEGIN
  328.             format := format & no_perc_mask;
  329.             IF perc_on THEN
  330.                format := format | perc_mask
  331.         END; { SET_PERC }
  332.      PROCEDURE SET_STYLE ( VAR format : INTEGER );
  333.         BEGIN
  334.             format := format & no_style_mask;
  335.             IF Obj_State(fmat_ptr,textbold) & Selected <> 0 THEN
  336.                format := format | bold_mask;
  337.             IF Obj_State(fmat_ptr,textital) & Selected <> 0 THEN
  338.                format := format | italic_mask;
  339.             IF Obj_State(fmat_ptr,textundr) & Selected <> 0 THEN
  340.                format := format | under_mask
  341.         END; { SET_STYLE }       
  342.      PROCEDURE SET_BITS ( row,col : INTEGER );
  343.         BEGIN
  344.             ptr := new_cell(row,col);
  345.             IF ptr <> NIL THEN BEGIN
  346.                WITH ptr^ DO BEGIN
  347.                   IF do_just THEN
  348.                      set_just(format);
  349.                   IF do_prec THEN 
  350.                      set_prec(format);
  351.                   IF do_dollar THEN
  352.                      set_dollar(format);
  353.                   IF do_perc THEN BEGIN
  354.                      set_perc(format);
  355.                      IF perc_on THEN
  356.                         num := num/100
  357.                      ELSE
  358.                         num := num*100
  359.                   END;
  360.                   IF do_style THEN
  361.                     set_style(format);
  362.                END;
  363.                cell_on_screen(1,row,col,TRUE)
  364.             END   
  365.         END; { SET_BITS }
  366.      BEGIN { OUTCOME }
  367.          IF action = fmatok THEN BEGIN
  368.             Set_Mouse(M_Bee);
  369.             IF Obj_State(fmat_ptr,fmatcw) & Selected <> 0 THEN 
  370.                do_cw := TRUE
  371.             ELSE
  372.                do_cw := FALSE;
  373.             IF Obj_State(fmat_ptr,fmatjust) & Selected <> 0 THEN BEGIN
  374.                chosen_just := Map_Tree(fmat_ptr,justleft,justrigh,
  375.                                  ReturnSelected)-ORD(justleft);
  376.                do_just := TRUE
  377.             END
  378.             ELSE
  379.                do_just := FALSE;
  380.             IF Obj_State(fmat_ptr,fmatprec) & Selected <> 0 THEN BEGIN
  381.                chosen_prec := Map_Tree(fmat_ptr,prec0,prec5,ReturnSelected)-
  382.                                  ORD(prec0);
  383.                sci_flag := Obj_State(fmat_ptr,precscin) & Selected <> 0;
  384.                do_prec := TRUE
  385.             END
  386.             ELSE
  387.                do_prec := FALSE;
  388.             IF Obj_State(fmat_ptr,fmatdoll) & Selected <> 0 THEN BEGIN
  389.                do_dollar := TRUE;
  390.                dollar_on := Obj_State(fmat_ptr,fmatdchk) & Checked <> 0
  391.             END
  392.             ELSE
  393.                do_dollar := FALSE;
  394.             IF Obj_State(fmat_ptr,fmatperc) & Selected <> 0 THEN BEGIN
  395.                do_perc := TRUE;
  396.                perc_on := Obj_State(fmat_ptr,fmatpchk) & Checked <> 0
  397.             END
  398.             ELSE
  399.                do_perc := FALSE;
  400.             IF Obj_State(fmat_ptr,fmatstyl) & Selected <> 0 THEN 
  401.                do_style := TRUE;
  402.             IF (do_cw) OR (do_just) OR (do_perc) OR (do_dollar) OR
  403.                (do_prec) OR (do_style) THEN
  404.                CASE extent OF
  405.                   s : BEGIN
  406.                      IF do_cw THEN BEGIN
  407.                         col_width[s_col,spaces] := chosen_width;
  408.                         col_width[s_col,pixels] := chosen_width*8;
  409.                         Send_Redraw(TRUE,0,0,screen_width,screen_height)
  410.                      END;
  411.                      IF (do_just) OR (do_prec) OR (do_perc) OR 
  412.                         (do_style) OR (do_dollar) THEN
  413.                         set_bits(s_row,s_col)
  414.                   END;
  415.                   r : BEGIN
  416.                      IF do_cw THEN BEGIN
  417.                         FOR i := s_col TO f_col DO BEGIN
  418.                             col_width[i,spaces] := chosen_width;
  419.                             col_width[i,pixels] := chosen_width*8;
  420.                         END;
  421.                         Send_Redraw(TRUE,0,0,screen_width,screen_height)
  422.                      END;
  423.                      IF (do_just) OR (do_prec) OR (do_perc) OR 
  424.                         (do_style) OR (do_dollar) THEN
  425.                         FOR i := s_row TO f_row DO
  426.                             FOR j := s_col TO f_col DO
  427.                                 set_bits(i,j)
  428.                   END;
  429.                   g : BEGIN
  430.                      IF do_cw THEN
  431.                         FOR i := 1 To n_cols DO BEGIN
  432.                             col_width[i,spaces] := chosen_width;
  433.                             col_width[i,pixels] := chosen_width*8;
  434.                         END;
  435.                      IF do_just THEN
  436.                         set_just(default_format);
  437.                      IF do_prec THEN 
  438.                         set_prec(default_format);
  439.                      IF do_dollar THEN
  440.                         set_dollar(default_format);
  441.                      IF do_perc THEN
  442.                         set_perc(default_format);
  443.                      IF do_style THEN
  444.                         set_style(default_format);
  445.                      FOR i := 1 TO n_rows DO BEGIN
  446.                          ptr := data[i];
  447.                          WHILE ptr <> NIL DO BEGIN
  448.                             IF do_just THEN
  449.                                ptr^.format := (ptr^.format & no_just_mask) |
  450.                                               (default_format & just_mask);
  451.                             IF do_prec THEN BEGIN
  452.                                ptr^.format := (ptr^.format & no_prec_mask) |
  453.                                               (default_format & prec_mask);
  454.                                IF sci_flag THEN
  455.                                   ptr^.format := (ptr^.format & no_sci_mask) |
  456.                                                  (default_format & sci_mask)
  457.                             END;      
  458.                             IF do_dollar THEN
  459.                                ptr^.format := (ptr^.format & no_dollar_mask) |
  460.                                               (default_format & dollar_mask);
  461.                             IF do_perc THEN
  462.                                ptr^.format := (ptr^.format & no_perc_mask) |
  463.                                               (default_format & perc_mask);
  464.                             IF do_style THEN
  465.                                ptr^.format := (ptr^.format & no_style_mask) |
  466.                                               (default_format & style_mask);
  467.                             ptr := ptr^.next
  468.                          END
  469.                      END;
  470.                      Send_Redraw(TRUE,0,0,screen_width,screen_height)
  471.                   END
  472.                END; { CASE extent }
  473.             Set_Mouse(M_Arrow)
  474.          END { IF }
  475.      END; { OUTCOME }
  476.    BEGIN { main! }
  477.        initialize;
  478.        do_form;
  479.        outcome
  480.    END; { CHANGE_FORMAT }
  481.  
  482. FUNCTION GOTO_CELL : BOOLEAN;
  483.    VAR
  484.        action                  : Tree_Index;
  485.        row,col,str_pos         : INTEGER;
  486.        cell_str                : STRING;
  487.        finished,dummy          : BOOLEAN;
  488.   PROCEDURE EVAL_ACTION;
  489.      BEGIN
  490.          REPEAT
  491.             CASE action OF
  492.                gotook : BEGIN
  493.                   Get_Text ( goto_ptr,gotocell,cell_str );
  494.                   cap_a_string ( cell_str );
  495.                   str_pos := 1; 
  496.                   IF translate_cell(cell_str,str_pos,LENGTH(cell_str),row,col,
  497.                                     dummy,dummy) <> OK THEN BEGIN
  498.                      Obj_SetState(goto_ptr,gotook,Normal,True);
  499.                      action := Form_Do(goto_ptr,gotocell);
  500.                      finished := FALSE;
  501.                   END
  502.                   ELSE
  503.                      finished := TRUE
  504.                END;
  505.                gotohome : finished := TRUE;
  506.                gotocanc : finished := TRUE
  507.             END { CASE }
  508.          UNTIL finished
  509.      END; { EVAL_ACTION }
  510.   PROCEDURE DO_FORM;
  511.      BEGIN
  512.          action := form_begin(goto_ptr,gotocell);
  513.          eval_action;
  514.          form_end
  515.      END;
  516.   PROCEDURE OUTCOME;
  517.      BEGIN
  518.          IF action = gotook THEN
  519.             IF (row >= logical_row_1) AND (col >= logical_col_1) THEN BEGIN
  520.                data_row := row;
  521.                data_col := col;
  522.                start_row := row;
  523.                start_col := col;
  524.                goto_cell := TRUE
  525.             END
  526.             ELSE
  527.          ELSE IF action = gotohome THEN BEGIN
  528.             home_cursor(Origin);
  529.             goto_cell := TRUE
  530.          END
  531.          ELSE
  532.             goto_cell := FALSE
  533.      END;
  534.    BEGIN
  535.        indx := Map_Tree(goto_ptr,Root,Null_Index,ClearSelected);
  536.        Set_Text(goto_ptr,gotocell,null_str,s1,5);
  537.        do_form;
  538.        outcome
  539.    END; { GOTO_CELL }
  540.  
  541. PROCEDURE REPLICATE_CELL;
  542.    VAR
  543.        action                       : Tree_Index;
  544.        row,col,s_row,s_col,
  545.        f_row,f_col,source_row,
  546.        source_col                   : INTEGER;
  547.        temp                         : STR255;
  548.        it_is_a_formula,do_relative  : BOOLEAN;
  549.        ptr                          : CellPtr;
  550.    PROCEDURE INITIALIZE;
  551.       BEGIN
  552.          indx := Map_Tree(rep_ptr,Root,Null_Index,ClearSelected);
  553.          string_a_cell(data_row,data_col,temp);
  554.          Set_Text(rep_ptr,repsourc,temp,s3,5);
  555.          IF block_set THEN BEGIN
  556.             string_a_cell(b_s_row,b_s_col,temp);
  557.             Set_Text(rep_ptr,repbegin,temp,s1,5);
  558.             string_a_cell(b_e_row,b_e_col,temp);
  559.             Set_Text(rep_ptr,repend,temp,s2,5)
  560.          END
  561.          ELSE BEGIN
  562.             Set_Text(rep_ptr,repbegin,null_str,s1,5);
  563.             Set_Text(rep_ptr,repend,null_str,s2,5)
  564.          END;
  565.          Obj_SetState(rep_ptr,reprel,Selected,FALSE)
  566.       END; { INITIALIZE }
  567.    PROCEDURE EVAL_ACTION;
  568.       VAR str_pos    : INTEGER;
  569.           dummy,done : BOOLEAN;
  570.       FUNCTION GET_EDITED (        what : Tree_Index; 
  571.                             VAR row,col : INTEGER ) : BOOLEAN;
  572.          BEGIN
  573.              Get_Text(rep_ptr,what,temp);
  574.              cap_a_string(temp);
  575.              str_pos := 1;
  576.              IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
  577.                                dummy,dummy) <> OK THEN BEGIN
  578.                 get_edited := FALSE;
  579.                 Obj_SetState(rep_ptr,repok,Normal,TRUE);
  580.                 CASE what OF
  581.                    repsourc : action := Form_Do(rep_ptr,repsourc);
  582.                    repbegin : action := Form_Do(rep_ptr,repbegin);
  583.                    repend   : action := Form_Do(rep_ptr,repend)
  584.                 END
  585.              END
  586.              ELSE
  587.                 get_edited := TRUE
  588.          END; (* GET_EDITED *)
  589.       BEGIN { EVAL_ACTION }
  590.           done := FALSE;
  591.           REPEAT
  592.              IF action = repok THEN
  593.                 IF get_edited(repsourc,source_row,source_col) THEN
  594.                    IF get_edited(repbegin,s_row,s_col) THEN
  595.                       IF get_edited(repend,f_row,f_col) THEN 
  596.                          IF (s_col>f_col) OR (s_row>f_row) OR
  597.                             (s_col < logical_col_1) OR 
  598.                             (s_row < logical_row_1) THEN BEGIN
  599.                             Obj_SetState(rep_ptr,repok,Normal,TRUE);
  600.                             action := Form_Do(rep_ptr,repend)
  601.                          END
  602.                          ELSE BEGIN
  603.                             IF Obj_State(rep_ptr,reprel) & Selected <>0 THEN 
  604.                                do_relative := TRUE
  605.                             ELSE
  606.                                do_relative := FALSE;
  607.                             IF assigned(source_row,source_col,ptr)<>Void THEN
  608.                                IF (ptr^.class = Expr) AND
  609.                                   (ptr^.status <> Empty) THEN
  610.                                   it_is_a_formula := TRUE
  611.                                ELSE
  612.                                   it_is_a_formula := FALSE
  613.                             ELSE
  614.                                it_is_a_formula := FALSE;
  615.                             done := TRUE
  616.                          END 
  617.           UNTIL (done) OR (action = repcanc)
  618.       END; { EVAL_ACTION }
  619.    PROCEDURE DO_FORM;
  620.       BEGIN
  621.           action := form_begin(rep_ptr,repbegin);
  622.           eval_action;
  623.           form_end
  624.       END; { DO_FORM }
  625.    PROCEDURE DO_REPLICATE;
  626.       LABEL 1;
  627.       VAR i,j   : INTEGER;
  628.           dummy : BOOLEAN;
  629.           ptr   : CellPtr;
  630.       BEGIN
  631.           ptr := locate_cell(source_row,source_col);
  632.           IF ptr <> NIL THEN
  633.              FOR i := s_row TO f_row DO
  634.                  FOR j := s_col TO f_col DO
  635.                      IF (i <> source_row) OR (j <> source_col) THEN BEGIN
  636.                         IF comp_assign(source_row,source_col,
  637.                                        i,j,FALSE) THEN BEGIN
  638.                            IF (it_is_a_formula) AND (do_relative) THEN BEGIN
  639.                               ptr := locate_cell(i,j);
  640.                               IF adjust_expr(adj_refs,ptr,
  641.                                              source_row,source_col,i,j,1,1,
  642.                                              n_rows,n_cols) <> OK THEN BEGIN
  643.                                  all_lists(add,ptr,i,j);
  644.                                  GOTO 1 { quick exit, an OutOfRange error and }
  645.                               END       { the user chose to abort }
  646.                            END;
  647.                            IF it_is_a_formula THEN
  648.                               all_lists(add,ptr,i,j);
  649.                         END
  650.                         ELSE BEGIN
  651.                            Set_Mouse(M_Arrow);
  652.                            out_mem_cell(i,j,'replicated');
  653.                            cell_on_screen(1,i,j,TRUE);
  654.                            GOTO 1
  655.                         END;   
  656.                         cell_on_screen(1,i,j,TRUE)
  657.                      END
  658.                      ELSE
  659.           ELSE
  660.              delete_range(s_row,s_col,f_row,f_col,TRUE);
  661. 1:    END; { DO_REPLICATE }
  662.    PROCEDURE OUTCOME;
  663.       VAR cell_c : INTEGER;
  664.           dummy  : BOOLEAN;
  665.       BEGIN
  666.           IF action = repok THEN BEGIN
  667.              Set_Mouse(M_Bee);
  668.              do_replicate;
  669.              Set_Mouse(M_Arrow)
  670.           END
  671.       END; { OUTCOME }
  672.    BEGIN
  673.        initialize;
  674.        do_form;
  675.        outcome
  676.    END; { REPLICATE_CELL }
  677.  
  678. PROCEDURE R_TO_S ( n : LONG_INTEGER; VAR temp : STR255 );    
  679.    BEGIN
  680.        real_to_string(n*1.0,temp,0,FALSE);
  681.        DELETE(temp,1,1)
  682.    END; { R_TO_S }
  683.  
  684. PROCEDURE VIEW_FORMAT;
  685.    { gives the following info: cell name, data type, memory used,
  686.                                col width, just, percent, prec }
  687.    VAR
  688.        action               : Tree_Index;
  689.        loc_format           : INTEGER;
  690.        i,cell_size          : LONG_INTEGER;
  691.        temp                 : STR255;
  692.        a                    : AssignedStatus;
  693.        ptr                  : CellPtr;
  694.    PROCEDURE INITIALIZE;
  695.       VAR i   : INTEGER;
  696.           dep : DepPtr;
  697.       BEGIN
  698.          string_a_cell(data_row,data_col,temp);
  699.          Set_Text(vfrm_ptr,viewcell,temp,s1,5);
  700.          a := assigned(data_row,data_col,ptr);
  701.          IF a <> Void THEN BEGIN
  702.             CASE ptr^.class OF
  703.                Val  : temp := 'Numeric';
  704.                Labl : temp := 'Label';
  705.                Expr : temp := 'Formula';
  706.             END;
  707.             loc_format := ptr^.format
  708.          END   
  709.          ELSE BEGIN
  710.             temp := 'Numeric';
  711.             loc_format := default_format
  712.          END;
  713.          Set_Text(vfrm_ptr,viewtype,temp,s2,7);
  714.          cell_size := size(data_row,data_col);
  715.          r_to_s(cell_size,temp);
  716.          Set_Text(vfrm_ptr,viewmem,temp,s3,10);
  717.          int_to_string(col_width[data_col,spaces],temp);
  718.          Set_Text(vfrm_ptr,viewcw,temp,s4,2);
  719.          CASE find_just(ptr) OF
  720.             VDI_Right : temp := 'Right';
  721.             VDI_Left : temp := 'Left';
  722.             VDI_Center : temp := 'Center'
  723.          END;
  724.          Set_Text(vfrm_ptr,viewjust,temp,s5,6);
  725.          IF loc_format & perc_mask <> 0 THEN
  726.             temp := 'Yes'
  727.          ELSE
  728.             temp := 'No';
  729.          Set_Text(vfrm_ptr,viewperc,temp,s6,3);
  730.          IF loc_format & dollar_mask <> 0 THEN
  731.             temp := 'Yes'
  732.          ELSE
  733.             temp := 'No';
  734.          Set_Text(vfrm_ptr,viewdoll,temp,s13,3);
  735.          temp := CHR(find_prec(ptr)+$30);
  736.          Set_Text(vfrm_ptr,viewprec,temp,s7,1);
  737.          i := 0;
  738.          IF a <> Void THEN BEGIN
  739.             dep := ptr^.sub;
  740.             WHILE dep <> NIL DO BEGIN
  741.                i := i+1;
  742.                dep := dep^.next
  743.             END
  744.          END;
  745.          r_to_s(i,temp);
  746.          Set_Text(vfrm_ptr,viewdeps,temp,s8,7);
  747.          IF loc_format & sci_mask <> 0 THEN
  748.             Set_Text(vfrm_ptr,viewsci,'Yes',s9,3)
  749.          ELSE   
  750.             Set_Text(vfrm_ptr,viewsci,'No',s9,3);
  751.          IF loc_format & bold_mask <> 0 THEN
  752.             Set_Text(vfrm_ptr,viewbold,'Yes',s10,3)
  753.          ELSE   
  754.             Set_Text(vfrm_ptr,viewbold,'No',s10,3);
  755.          IF loc_format & italic_mask <> 0 THEN
  756.             Set_Text(vfrm_ptr,viewital,'Yes',s11,3)
  757.          ELSE
  758.             Set_Text(vfrm_ptr,viewital,'No',s11,3);
  759.          IF loc_format & under_mask <> 0 THEN
  760.             Set_Text(vfrm_ptr,viewundr,'Yes',s12,3)
  761.          ELSE   
  762.             Set_Text(vfrm_ptr,viewundr,'No',s12,3);
  763.          Obj_SetState(vfrm_ptr,viewok,Normal,FALSE)
  764.       END; { INITIALIZE }
  765.    PROCEDURE DO_FORM;
  766.       BEGIN
  767.           action := form_begin(vfrm_ptr,Root);
  768.           form_end
  769.       END;
  770.    BEGIN
  771.        initialize;
  772.        do_form
  773.    END; { VIEW_FORMAT }
  774.  
  775. PROCEDURE HELP ( which : INTEGER );
  776.    VAR
  777.        ptr    : Dialog_Ptr;
  778.        action : Tree_Index;
  779.    BEGIN
  780.        CASE which OF
  781.           1 : ptr := key_ptr;
  782.           2 : ptr := form_ptr;
  783.           3 : ptr := prhelp_ptr;
  784.           4 : ptr := mhelp_ptr;
  785.           5 : ptr := crefhelp_ptr;
  786.           6 : ptr := rechelp_ptr
  787.        END;
  788.        indx := Map_Tree(ptr,Root,Null_Index,ClearSelected);
  789.        action := form_begin(ptr,Root);
  790.        form_end
  791.    END; { HELP }
  792.  
  793. PROCEDURE SORT;
  794.    VAR row_or_col,s_row,s_col,f_row,f_col,
  795.        key_row,key_col,i,j                     : INTEGER;
  796.        action                                  : Tree_Index;
  797.        temp                                    : STR255;
  798.        ascending                               : BOOLEAN;
  799.    PROCEDURE INITIALIZE;
  800.       BEGIN
  801.          clear_buffer;
  802.          indx := Map_Tree(sort_ptr,Root,Null_Index,ClearSelected);
  803.          row_or_col := 1;
  804.          ascending := TRUE;
  805.          string_a_cell(data_row,data_col,temp);
  806.          Set_Text(sort_ptr,sortkey,temp,s3,5);
  807.          IF block_set THEN BEGIN
  808.             string_a_cell(b_s_row,b_s_col,temp);
  809.             Set_Text(sort_ptr,sortbegi,temp,s1,5);
  810.             string_a_cell(b_e_row,b_e_col,temp);
  811.             Set_Text(sort_ptr,sortend,temp,s2,5)
  812.          END
  813.          ELSE BEGIN
  814.             Set_Text(sort_ptr,sortbegi,null_str,s1,5);
  815.             Set_Text(sort_ptr,sortend,null_str,s2,5)
  816.          END;
  817.          Obj_SetState(sort_ptr,sortasce,Selected,FALSE);
  818.          Obj_SetState(sort_ptr,sortrow,Selected,FALSE)
  819.       END; { INITIALIZE }
  820.    PROCEDURE EVAL_ACTION;
  821.       VAR i,j,str_pos : INTEGER;
  822.           dummy,done  : BOOLEAN;
  823.       FUNCTION GET_EDITED (        what : Tree_Index; 
  824.                             VAR row,col : INTEGER     ) : BOOLEAN;
  825.          BEGIN
  826.              Get_Text(sort_ptr,what,temp);
  827.              cap_a_string(temp);
  828.              str_pos := 1; 
  829.              IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
  830.                                dummy,dummy) <> OK THEN BEGIN
  831.                 get_edited := FALSE;               
  832.                 Obj_SetState(sort_ptr,sortok,Normal,TRUE);
  833.                 CASE what OF
  834.                    sortkey  : action := Form_Do(sort_ptr,sortkey);
  835.                    sortbegi : action := Form_Do(sort_ptr,sortbegi);
  836.                    sortend  : action := Form_Do(sort_ptr,sortend)
  837.                 END
  838.              END
  839.              ELSE
  840.                 get_edited := TRUE;
  841.          END; (* GET_EDITED *)
  842.       BEGIN { EVAL_ACTION }
  843.           done := FALSE; 
  844.           REPEAT
  845.              IF action = sortok THEN 
  846.                 IF get_edited (sortkey,key_row,key_col) THEN
  847.                    IF get_edited (sortbegi,s_row,s_col) THEN
  848.                       IF get_edited (sortend,f_row,f_col) THEN
  849.                          IF (key_row<s_row) OR (key_row>f_row) OR 
  850.                             (key_col<s_col) OR (key_col>f_col) THEN BEGIN
  851.                             Obj_SetState ( sort_ptr,sortok,Normal,TRUE );
  852.                             action := Form_Do(sort_ptr,sortkey)
  853.                          END
  854.                          ELSE IF (s_col>f_col) OR (s_row>f_row) OR
  855.                                  ((row_or_col=1) AND ((f_row-s_row)<1)) OR
  856.                                  ((row_or_col=2) AND ((f_col-s_col)<1)) OR
  857.                                  (s_col < logical_col_1) OR 
  858.                                  (s_row < logical_row_1) THEN BEGIN
  859.                             Obj_SetState ( sort_ptr,sortok,Normal,TRUE );
  860.                             action := Form_Do(sort_ptr,sortend)
  861.                          END
  862.                          ELSE
  863.                             done := TRUE;
  864.           UNTIL ( done ) OR ( action = sortcanc );
  865.       END;   (* EVAL_ACTION *)
  866.    PROCEDURE DO_FORM;
  867.       BEGIN
  868.           action := form_begin(sort_ptr,sortbegi);
  869.           eval_action;
  870.           form_end;
  871.       END;
  872.    PROCEDURE BUBBLE_SORT;
  873.       LABEL 1;
  874.       VAR i,j,n,dummy   : INTEGER;
  875.           ptr,ptr1,ptr2 : CellPtr;
  876.       PROCEDURE SWAP ( row_1,row_2,col_1,col_2 : INTEGER );
  877.          { any formulas are copied exactly, with no relative ref changes }
  878.          VAR i,j : INTEGER;
  879.          BEGIN
  880.              IF row_or_col = 1 THEN { by row }
  881.                 FOR i := s_col TO f_col DO BEGIN
  882.                     { note that the cells' dep lists stay behind,
  883.                       since they belong to the pos in the worksheet, UNLESS
  884.                       we were to simultaneously adjust the formulas which they
  885.                       influence; a pain and not worth doing. However, if
  886.                       restored to original order, everything will be exactly
  887.                       as before. In order to do this, all cells to be sorted
  888.                       are REQUIRED to exist }
  889.                     IF NOT comp_assign(row_2,i,0,0,FALSE) THEN
  890.                        GOTO 1;
  891.                     IF NOT comp_assign(row_1,i,row_2,i,FALSE) THEN
  892.                        GOTO 1;
  893.                     IF NOT comp_assign(0,0,row_1,i,FALSE) THEN
  894.                        GOTO 1;
  895.                     clear_buffer
  896.                 END
  897.              ELSE { by column }
  898.                 FOR i := s_row TO f_row DO BEGIN
  899.                     IF NOT comp_assign(i,col_2,0,0,FALSE) THEN
  900.                        GOTO 1;
  901.                     IF NOT comp_assign(i,col_1,i,col_2,FALSE) THEN
  902.                        GOTO 1;
  903.                     IF NOT comp_assign(0,0,i,col_1,FALSE) THEN
  904.                        GOTO 1;
  905.                     clear_buffer;
  906.                 END
  907.          END; { SWAP }
  908.       FUNCTION COMPARE ( row_1,col_1,row_2,col_2 : INTEGER ) : BOOLEAN;
  909.          { null: status = Empty               }
  910.          {    a: Labl with status <> Empty    } 
  911.          {    n: Val or Expr, status <> Empty }
  912.          {    e: cell with error status       }
  913.          { c_type_1 & 2 give the respective compare-types of the 2 cells }
  914.          TYPE CompareTypes = ( null,e,n,a ); 
  915.          VAR c_type_1,c_type_2 : CompareTypes;
  916.              stat              : AssignedStatus;  
  917.              ptr1,ptr2         : CellPtr;
  918.          BEGIN
  919.              compare := FALSE;
  920.              ptr1 := new_cell(row_1,col_1);
  921.              IF ptr1 = NIL THEN
  922.                 GOTO 1;
  923.              stat := assigned(row_1,col_1,ptr1);
  924.              IF stat = Desolate THEN
  925.                 c_type_1 := null
  926.              ELSE IF stat = Error THEN
  927.                 c_type_1 := e  
  928.              ELSE IF ptr1^.class = Labl THEN
  929.                 c_type_1 := a
  930.              ELSE 
  931.                 c_type_1 := n;            
  932.              ptr2 := new_cell(row_2,col_2);
  933.              IF ptr2 = NIL THEN
  934.                 GOTO 1;
  935.              stat := assigned(row_2,col_2,ptr2);
  936.              IF stat = Desolate THEN
  937.                 c_type_2 := null
  938.              ELSE IF stat = Error THEN
  939.                 c_type_1 := e  
  940.              ELSE IF ptr2^.class = Labl THEN
  941.                 c_type_2 := a
  942.              ELSE 
  943.                 c_type_2 := n;            
  944.              { so, now we know what we're comparing. Precedence is as follows,
  945.                in order from least to greatest:
  946.                   1. num and str (Labl-type) both not assigned
  947.                      ( num<str still )
  948.                   2. error status
  949.                   3. num assigned 
  950.                   4. str ( = Labl ) <> NIL ( or assigned ).
  951.                Note this implies that both num and str are never both 
  952.                assigned in a single cell ( that is, unless the cell is an
  953.                Expr, in which case this is irrelevant, because it's taken
  954.                to be a Val-type for the sake of sorting ).
  955.                However, in cells of differing types,
  956.                Labl always wins, even if it is NIL. That way we separate
  957.                the cells into Val/Expr and Labl types. Formulas are simply
  958.                regarded as either values or labels as above.
  959.                Rather than get too complex in sorting out cells with an
  960.                error status, we simply sort them without paying attention
  961.                to the actual error code; i.e. at the end of the sort,
  962.                all the error-status cells will be in a group, but not in
  963.                any specific order. 
  964.                row_1,col_1 reference 'j' in bubble_sort;
  965.                row_2,col_2 reference 'j-1' in bubble_sort }
  966.              WITH ptr1^ DO
  967.                 IF ascending THEN
  968.                    IF c_type_1 = c_type_2 THEN
  969.                       IF c_type_1 = null THEN
  970.                          IF (class <> Labl) AND
  971.                             (ptr2^.class = Labl) THEN
  972.                             compare := TRUE
  973.                          ELSE
  974.                       ELSE IF c_type_1 = n THEN
  975.                          IF num < ptr2^.num THEN
  976.                             compare := TRUE
  977.                          ELSE
  978.                       ELSE IF c_type_1 = a THEN 
  979.                          IF str^ < ptr2^.str^ THEN
  980.                             compare := TRUE
  981.                          ELSE
  982.                       ELSE { don't swap, they both have error status }
  983.                    ELSE
  984.                       CASE c_type_1 OF
  985.                          null : IF (NOT ((class = Labl) AND
  986.                                          (ptr2^.class <> Labl))
  987.                                    ) OR
  988.                                    (c_type_2 = a) THEN
  989.                                    { Labl and Expr are handled by the } 
  990.                                    { NOT clause }
  991.                                    compare := TRUE;
  992.                          n    : IF ((c_type_2 = null) AND
  993.                                     (ptr2^.class = Labl)) OR
  994.                                    (c_type_2 = a) THEN
  995.                                    compare := TRUE;
  996.                          a    : ; { do nothing }
  997.                          e    : IF c_type_2 <> null THEN
  998.                                    compare := TRUE; 
  999.                       END { CASE }
  1000.                 ELSE { descending }
  1001.                    IF c_type_1 = c_type_2 THEN
  1002.                       IF c_type_1 = null THEN
  1003.                          IF (class = Labl) AND
  1004.                             (ptr2^.class <> Labl) THEN
  1005.                             compare := TRUE
  1006.                          ELSE
  1007.                       ELSE IF c_type_1 = n THEN
  1008.                          IF num > ptr2^.num THEN
  1009.                             compare := TRUE
  1010.                          ELSE
  1011.                       ELSE IF c_type_1 = a THEN 
  1012.                          IF str^ > ptr2^.str^ THEN
  1013.                             compare := TRUE
  1014.                          ELSE
  1015.                       ELSE { error status, don't swap }   
  1016.                    ELSE
  1017.                       CASE c_type_1 OF
  1018.                          null : IF (class = Labl) AND
  1019.                                    (ptr2^.class <> Labl) THEN
  1020.                                    compare := TRUE;
  1021.                          n    : IF (c_type_2 = null) AND
  1022.                                    (ptr2^.class <> Labl) THEN
  1023.                                    compare := TRUE;
  1024.                          a    : IF (c_type_2 = null) OR (c_type_2 = n) THEN
  1025.                                    compare := TRUE;
  1026.                          e    : IF c_type_2 = null THEN
  1027.                                    compare := TRUE;
  1028.                       END; { CASE }
  1029.          END; { COMPARE }
  1030.       BEGIN { BUBBLE_SORT }
  1031.           IF Obj_State(sort_ptr,sortrow) & Selected <> 0 THEN
  1032.              row_or_col := 1
  1033.           ELSE
  1034.              row_or_col := 2;
  1035.           IF Obj_State(sort_ptr,sortasce) & Selected <> 0 THEN
  1036.              ascending := TRUE
  1037.           ELSE
  1038.              ascending := FALSE;
  1039.           Set_Mouse(M_Bee);
  1040.           { remove the cells to be sorted from dep lists; the dep lists will
  1041.             be recreated later }
  1042.           FOR i := s_row TO f_row DO
  1043.               FOR j := s_col TO f_col DO BEGIN
  1044.                   ptr := locate_cell(i,j);
  1045.                   all_lists (remove,ptr,i,j)
  1046.               END;
  1047.           { actual bubble sort algorithm }
  1048.           IF row_or_col = 1 THEN { by rows }
  1049.              FOR i := s_row TO f_row-1 DO
  1050.                  FOR j := f_row DOWNTO i+1 DO
  1051.                      IF compare(j,key_col,j-1,key_col) THEN
  1052.                         swap(j,j-1,dummy,dummy)
  1053.                      ELSE
  1054.           ELSE { by cols }
  1055.              FOR i := s_col TO f_col-1 DO
  1056.                  FOR j := f_col DOWNTO i+1 DO
  1057.                      IF compare(key_row,j,key_row,j-1) THEN
  1058.                         swap(dummy,dummy,j,j-1);
  1059.           { redo dep lists }
  1060. 1:        FOR i := s_row TO f_row DO
  1061.               FOR j := s_col TO f_col DO BEGIN
  1062.                   ptr := locate_cell(i,j);
  1063.                   all_lists(add,ptr,i,j)
  1064.               END
  1065.       END; { BUBBLE_SORT }
  1066.    BEGIN { SORT }
  1067.        initialize;
  1068.        do_form;
  1069.        IF action = sortok THEN BEGIN
  1070.           bubble_sort;
  1071.           FOR i := s_row TO f_row DO
  1072.               FOR j := s_col TO f_col DO
  1073.                   cell_on_screen(1,i,j,TRUE)
  1074.        END;
  1075.        clear_buffer;
  1076.        Set_Mouse(M_Arrow)
  1077.    END; { SORT }
  1078.  
  1079. PROCEDURE PRINT_SPREADSHEET ( print                       : BOOLEAN; 
  1080.                               msg                         : STR30;
  1081.                               VAR s_row,s_col,f_row,f_col : INTEGER );
  1082.    VAR
  1083.        action : Tree_Index;
  1084.        i      : INTEGER;
  1085.        temp   : STR255;
  1086.    PROCEDURE INITIALIZE;
  1087.       BEGIN
  1088.           indx := Map_Tree(print_ptr,Root,Null_Index,ClearSelected);
  1089.           IF p_row_col THEN
  1090.              Obj_SetState(print_ptr,printrc,Checked,FALSE)
  1091.           ELSE
  1092.              Obj_SetState(print_ptr,printrc,Normal,FALSE);
  1093.           IF print_formulas THEN
  1094.              Obj_SetState(print_ptr,printfor,Checked,FALSE)
  1095.           ELSE
  1096.              Obj_SetState(print_ptr,printfor,Normal,FALSE);
  1097.           IF condensed_print THEN
  1098.              Obj_SetState(print_ptr,printcon,Checked,FALSE)
  1099.           ELSE
  1100.              Obj_SetState(print_ptr,printcon,Normal,FALSE);
  1101.           IF draft_final THEN
  1102.              Obj_SetState(print_ptr,printdra,Selected,FALSE)
  1103.           ELSE
  1104.              Obj_SetState(print_ptr,printfin,Selected,FALSE);
  1105.           Set_Text(print_ptr,prtitle1,p_title_1,s1,40);
  1106.           Set_Text(print_ptr,prtitle2,p_title_2,s2,40);
  1107.           Set_Text(print_ptr,printhea,header,s3,40);
  1108.           Set_Text(print_ptr,printfoo,footer,s4,40);
  1109.           IF block_set THEN BEGIN
  1110.              string_a_cell(b_s_row,b_s_col,temp);
  1111.              Set_Text(print_ptr,printbeg,temp,s5,5);
  1112.              string_a_cell(b_e_row,b_e_col,temp);
  1113.              Set_Text(print_ptr,printend,temp,s6,5)
  1114.           END
  1115.           ELSE IF find_first_and_last(FALSE) THEN BEGIN
  1116.              string_a_cell(marks[5].row,marks[5].col,temp);     
  1117.              Set_Text(print_ptr,printbeg,temp,s5,5);
  1118.              string_a_cell(marks[6].row,marks[6].col,temp);
  1119.              Set_Text(print_ptr,printend,temp,s6,5)
  1120.           END
  1121.           ELSE BEGIN
  1122.              Set_Text(print_ptr,printbeg,null_str,s5,5);
  1123.              Set_Text(print_ptr,printend,null_str,s6,5)
  1124.           END;
  1125.           Set_Text(print_ptr,prwhat,msg,s7,LENGTH(msg))
  1126.       END; { INITIALIZE }
  1127.    PROCEDURE DO_FORM;
  1128.       VAR str_pos               : INTEGER;
  1129.           alert_msg1,alert_msg2 : STR255;
  1130.           dummy,done            : BOOLEAN;
  1131.       FUNCTION GET_EDITED (        what : Tree_Index; 
  1132.                             VAR row,col : INTEGER     ) : BOOLEAN;
  1133.          BEGIN
  1134.              Get_Text(print_ptr,what,temp);
  1135.              cap_a_string(temp);
  1136.              str_pos := 1;
  1137.              IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
  1138.                                dummy,dummy) <> OK THEN BEGIN
  1139.                 get_edited := FALSE;
  1140.                 Obj_SetState(print_ptr,printok,Normal,TRUE);
  1141.                 IF what = printend THEN
  1142.                    action := Form_Do(print_ptr,printend)
  1143.                 ELSE
  1144.                    action := Form_Do(print_ptr,printbeg);
  1145.              END
  1146.              ELSE
  1147.                 get_edited := TRUE
  1148.          END; { GET_EDITED }
  1149.       PROCEDURE HANDLE_CHECK ( action : Tree_Index; VAR flag : BOOLEAN );
  1150.          { the box_chars in the dialog may be checked or not }
  1151.          BEGIN
  1152.              IF flag THEN
  1153.                 Obj_SetState(print_ptr,action,Normal,TRUE)
  1154.              ELSE
  1155.                 Obj_SetState(print_ptr,action,Checked,TRUE);
  1156.              flag := NOT flag
  1157.          END; { HANDLE_CHECK }
  1158.       FUNCTION REDUNDANT ( what : P_EdText ) : BOOLEAN;
  1159.          { can't have more than one each of the justification specifiers
  1160.            in the header and footer }
  1161.          VAR i,x     : INTEGER;
  1162.              justify : ARRAY [1..3] OF STRING[2];
  1163.          BEGIN
  1164.              redundant := FALSE;
  1165.              justify[1] := '^l';
  1166.              justify[2] := '^c';
  1167.              justify[3] := '^r';
  1168.              FOR i := 1 TO 3 DO BEGIN
  1169.                  temp := what;
  1170.                  x := POS(justify[i],temp);
  1171.                  IF x > 0 THEN BEGIN
  1172.                     DELETE(temp,1,x+1);
  1173.                     IF POS(justify[i],temp) > 0 THEN
  1174.                        redundant := TRUE;
  1175.                  END;
  1176.              END;
  1177.          END; { REDUNDANT }
  1178.       BEGIN { DO_FORM }
  1179.           alert_msg1 := '[1][Invalid ';
  1180.           alert_msg2 := CONCAT ( '! Check for|',
  1181.                                   '^ as last character and more|',
  1182.                                   'than one occurrence each of|',
  1183.                                   '^l, ^c, and ^r.| ][ Continue ]' );
  1184.           action := form_begin(print_ptr,prtitle1);
  1185.           done := FALSE;
  1186.           REPEAT
  1187.              IF (action = printrc) OR (action = printfor) OR
  1188.                 (action = printcon) THEN BEGIN
  1189.                 IF action = printrc THEN
  1190.                    handle_check(action,p_row_col)
  1191.                 ELSE IF action = printfor THEN
  1192.                    handle_check(action,print_formulas)
  1193.                 ELSE IF action = printcon THEN
  1194.                    handle_check(action,condensed_print);
  1195.                 action := Form_Do(print_ptr,prtitle1);
  1196.              END
  1197.              ELSE BEGIN
  1198.                 { do this now so that even if "cancel" was chosen, we'll
  1199.                   keep whatever the user had typed in these global vars }
  1200.                 Get_Text(print_ptr,printhea,header);
  1201.                 Get_Text(print_ptr,printfoo,footer);
  1202.                 Get_Text(print_ptr,prtitle1,p_title_1);
  1203.                 Get_Text(print_ptr,prtitle2,p_title_2);
  1204.                 IF action = printok THEN 
  1205.                    IF (header[LENGTH(header)] = '^') OR (redundant(header))
  1206.                    THEN BEGIN
  1207.                       temp := CONCAT(alert_msg1,'header',alert_msg2);
  1208.                       alert := Do_Alert(temp,1);
  1209.                       Obj_SetState(print_ptr,action,Normal,TRUE);
  1210.                       action := Form_Do(print_ptr,printhea)
  1211.                    END
  1212.                    ELSE IF (footer[LENGTH(footer)] = '^') OR 
  1213.                            (redundant(footer)) THEN BEGIN
  1214.                       temp := CONCAT(alert_msg1,'footer',alert_msg2);
  1215.                       alert := Do_Alert(temp,1);
  1216.                       Obj_SetState(print_ptr,action,Normal,TRUE);
  1217.                       action := Form_Do(print_ptr,printfoo)
  1218.                    END
  1219.                    ELSE IF get_edited(printbeg,s_row,s_col) THEN
  1220.                       IF get_edited(printend,f_row,f_col) THEN
  1221.                          IF (s_row>f_row)  OR (s_col>f_col) THEN BEGIN
  1222.                             Obj_SetState(print_ptr,printok,Normal,TRUE);
  1223.                             action := Form_Do(print_ptr,printend)
  1224.                          END
  1225.                          ELSE
  1226.                             done := TRUE;
  1227.              END; { ELSE }
  1228.           UNTIL (done) OR (action = prcancel);
  1229.           draft_final := Obj_State(print_ptr,printdra) & Selected <> 0;
  1230.           IF (action = printok) AND (print) THEN
  1231.              do_print(s_row,f_row,s_col,f_col,port);
  1232.           IF action = prcancel THEN 
  1233.              s_row := 0; { flag for save_text }  
  1234.           form_end
  1235.       END; { DO_FORM }
  1236.    BEGIN
  1237.        initialize;
  1238.        do_form
  1239.    END; { PRINT_SPREADSHEET }
  1240.    
  1241. PROCEDURE DATA_FILL;
  1242.    LABEL 2;
  1243.    TYPE Caps    = (NoCaps,OneCap,AllCaps);
  1244.         Len     = (Abbr,All);
  1245.         StrType = (Day,Month);
  1246.    VAR
  1247.        action                          : Tree_Index;
  1248.        s_row,s_col,f_row,f_col,cur_mo,
  1249.        mo_incr,i,j,old_format,
  1250.        cur_day,day_incr                : INTEGER;
  1251.        fill_number,sense               : BOOLEAN;
  1252.        cur_val,incr                    : REAL;
  1253.        temp,temp1,temp2                : STR255;
  1254.        case_stat                       : Caps;
  1255.        len_stat                        : Len;
  1256.        string_type                     : StrType;
  1257.        ptr                             : CellPtr;
  1258.    PROCEDURE INITIALIZE;
  1259.       BEGIN
  1260.           indx := Map_Tree(data_fill_ptr,Root,Null_Index,ClearSelected);
  1261.           Obj_SetState(data_fill_ptr,datadown,Selected,FALSE);
  1262.           Set_Text(data_fill_ptr,datainit,null_str,s1,12);
  1263.           Set_Text(data_fill_ptr,dataincr,null_str,s2,12);
  1264.           IF block_set THEN BEGIN
  1265.              string_a_cell(b_s_row,b_s_col,temp);
  1266.              Set_Text(data_fill_ptr,databegi,temp,s3,5);
  1267.              string_a_cell(b_e_row,b_e_col,temp);
  1268.              Set_Text(data_fill_ptr,dataend,temp,s4,5)
  1269.           END
  1270.           ELSE BEGIN
  1271.              Set_Text(data_fill_ptr,databegi,null_str,s3,5);
  1272.              Set_Text(data_fill_ptr,dataend,null_str,s4,5)
  1273.           END
  1274.       END; { INITIALIZE }
  1275.    FUNCTION DO_FORM : BOOLEAN;
  1276.       LABEL 1;
  1277.       VAR str_pos,i        : INTEGER;
  1278.           done,dummy,found : BOOLEAN;
  1279.           str              : STR255;
  1280.       FUNCTION GET_EDITED (        what : Tree_Index; 
  1281.                             VAR row,col : INTEGER     ) : BOOLEAN;
  1282.          BEGIN
  1283.              Get_Text(data_fill_ptr,what,temp);
  1284.              cap_a_string(temp);
  1285.              str_pos := 1;
  1286.              IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
  1287.                                dummy,dummy) <> OK THEN BEGIN
  1288.                 get_edited := FALSE;
  1289.                 Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
  1290.                 IF what = dataend THEN
  1291.                    action := Form_Do(data_fill_ptr,dataend)
  1292.                 ELSE
  1293.                    action := Form_Do(data_fill_ptr,databegi);
  1294.              END
  1295.              ELSE
  1296.                 get_edited := TRUE
  1297.          END; { GET_EDITED }
  1298.       BEGIN { DO_FORM }
  1299.           do_form := FALSE;
  1300.           action := form_begin(data_fill_ptr,datainit);
  1301. 1:        done := FALSE;                
  1302.           REPEAT
  1303.              IF action = dataok THEN
  1304.                 IF get_edited(databegi,s_row,s_col) THEN
  1305.                    IF get_edited(dataend,f_row,f_col) THEN
  1306.                       IF (s_row>f_row)  OR (s_col>f_col) OR
  1307.                          (s_col < logical_col_1) OR 
  1308.                          (s_row < logical_row_1) THEN BEGIN
  1309.                          Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
  1310.                          action := Form_Do(data_fill_ptr,dataend)
  1311.                       END
  1312.                       ELSE 
  1313.                          done := TRUE
  1314.           UNTIL (done) OR (action = datacanc);
  1315.           IF action = dataok THEN BEGIN            
  1316.              sense := Obj_State(data_fill_ptr,datadown) & Selected <> 0;
  1317.              Get_Text(data_fill_ptr,datainit,temp);
  1318.              Get_Text(data_fill_ptr,dataincr,temp1);
  1319.              IF valid_number(temp) = OK THEN
  1320.                 IF valid_number(temp1) = OK THEN BEGIN
  1321.                    cur_val := string_to_real(temp);
  1322.                    IF temp = 'OVERFLOW' THEN BEGIN
  1323.                       Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
  1324.                       action := Form_Do(data_fill_ptr,datainit);
  1325.                       GOTO 1
  1326.                    END
  1327.                    ELSE BEGIN
  1328.                       incr := string_to_real(temp1);
  1329.                       IF temp1 = 'OVERFLOW' THEN BEGIN
  1330.                          Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
  1331.                          action := Form_Do(data_fill_ptr,dataincr);
  1332.                          GOTO 1
  1333.                       END
  1334.                       ELSE
  1335.                          fill_number := TRUE
  1336.                    END   
  1337.                 END
  1338.                 ELSE BEGIN
  1339.                    Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
  1340.                    action := Form_Do(data_fill_ptr,dataincr);
  1341.                    GOTO 1
  1342.                 END
  1343.              ELSE IF LENGTH(temp) < 3 THEN BEGIN
  1344.                 Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
  1345.                 action := Form_Do(data_fill_ptr,datainit);
  1346.                 GOTO 1
  1347.              END
  1348.              ELSE BEGIN
  1349.                 str := '';
  1350.                 FOR i := 1 TO LENGTH(temp) DO
  1351.                     IF temp[i] IN up_case THEN
  1352.                        str := CONCAT(str,CHR(ORD(temp[i])+32))
  1353.                     ELSE   
  1354.                        str := CONCAT(str,temp[i]);
  1355.                 i := 1;
  1356.                 found := FALSE;
  1357.                 WHILE (i <= 12) AND (NOT found) DO BEGIN
  1358.                    temp2 := COPY(months[i],1,3);
  1359.                    IF (str = months[i]) OR (str = temp2) THEN BEGIN
  1360.                       IF str = temp2 THEN
  1361.                          len_stat := Abbr
  1362.                       ELSE
  1363.                          len_stat := All;
  1364.                       IF temp[1] IN low_case THEN { temp = unmodified str }
  1365.                          case_stat := NoCaps
  1366.                       ELSE IF (temp[2] IN up_case) THEN
  1367.                          case_stat := AllCaps
  1368.                       ELSE
  1369.                          case_stat := OneCap;
  1370.                       found := TRUE;
  1371.                       string_type := Month;
  1372.                       cur_mo := i
  1373.                    END
  1374.                    ELSE 
  1375.                       i := i+1
  1376.                 END;
  1377.                 IF NOT found THEN BEGIN
  1378.                    i := 1;
  1379.                    WHILE (i <= 7) AND (NOT found) DO BEGIN
  1380.                       temp2 := COPY(days[i],1,3);
  1381.                       IF (str = days[i]) OR (str = temp2) THEN BEGIN
  1382.                          IF str = temp2 THEN
  1383.                             len_stat := Abbr
  1384.                          ELSE
  1385.                             len_stat := All;
  1386.                          IF temp[1] IN low_case THEN
  1387.                             case_stat := NoCaps
  1388.                          ELSE IF (temp[2] IN up_case) THEN
  1389.                             case_stat := AllCaps
  1390.                          ELSE
  1391.                             case_stat := OneCap;
  1392.                          found := TRUE;
  1393.                          string_type := Day;
  1394.                          cur_day := i
  1395.                       END
  1396.                       ELSE 
  1397.                          i := i+1
  1398.                    END
  1399.                 END;   
  1400.                 IF NOT found THEN BEGIN
  1401.                    Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
  1402.                    action := Form_Do(data_fill_ptr,datainit);
  1403.                    GOTO 1
  1404.                 END
  1405.                 ELSE IF valid_number(temp1) = OK THEN BEGIN
  1406.                    incr := string_to_real(temp1);
  1407.                    IF (temp1 = 'OVERFLOW') OR (incr < 0) OR
  1408.                       ((incr > 12) AND (string_type = Month)) OR 
  1409.                       ((incr > 7) AND (string_type = Day)) THEN BEGIN
  1410.                       Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
  1411.                       action := Form_Do(data_fill_ptr,dataincr);
  1412.                       GOTO 1
  1413.                    END   
  1414.                    ELSE IF string_type = Day THEN BEGIN
  1415.                       fill_number := FALSE;
  1416.                       day_incr := ROUND(incr)
  1417.                    END
  1418.                    ELSE BEGIN { was months }
  1419.                       fill_number := FALSE;
  1420.                       mo_incr := ROUND(incr)
  1421.                    END
  1422.                 END
  1423.                 ELSE BEGIN
  1424.                    Obj_SetState(data_fill_ptr,dataok,Normal,TRUE);
  1425.                    action := Form_Do(data_fill_ptr,dataincr);
  1426.                    GOTO 1
  1427.                 END      
  1428.              END
  1429.           END;
  1430.           do_form := action = dataok;
  1431.           form_end
  1432.       END; { DO_FORM }
  1433.    FUNCTION DO_FILL : BOOLEAN;
  1434.       VAR i : INTEGER;
  1435.       BEGIN
  1436.           IF old_format <> 0 THEN
  1437.              ptr^.format := old_format;
  1438.           do_fill := TRUE;
  1439.           IF fill_number THEN BEGIN { working with numbers }
  1440.              ptr^.class := Val;
  1441.              ptr^.num := cur_val;
  1442.              ptr^.status := Full;
  1443.              cur_val := cur_val+incr
  1444.           END
  1445.           ELSE IF NOT request_memory(AString) THEN { working with days or }
  1446.              do_fill := FALSE                      { months }
  1447.           ELSE BEGIN
  1448.              NEW(ptr^.str);
  1449.              IF len_stat = Abbr THEN
  1450.                 IF string_type = Day THEN
  1451.                    ptr^.str^ := COPY(days[cur_day],1,3)
  1452.                 ELSE
  1453.                    ptr^.str^ := COPY(months[cur_mo],1,3)
  1454.              ELSE IF string_type = Day THEN
  1455.                 ptr^.str^ := days[cur_day]
  1456.              ELSE
  1457.                 ptr^.str^ := months[cur_mo];
  1458.              IF case_stat = OneCap THEN
  1459.                 ptr^.str^[1] := CHR(ORD(ptr^.str^[1])-32)
  1460.              ELSE IF case_stat = AllCaps THEN
  1461.                 FOR i := 1 TO LENGTH(ptr^.str^) DO
  1462.                     ptr^.str^[i] := CHR(ORD(ptr^.str^[i])-32);
  1463.              ptr^.class := Labl;
  1464.              ptr^.status := Full;
  1465.              ptr^.format := (ptr^.format & no_just_mask) | $0010;
  1466.              IF string_type = Day THEN BEGIN
  1467.                 cur_day := cur_day+day_incr;
  1468.                 IF cur_day > 7 THEN
  1469.                    cur_day := cur_day-7
  1470.              END
  1471.              ELSE BEGIN
  1472.                 cur_mo := cur_mo+mo_incr;
  1473.                 IF cur_mo > 12 THEN
  1474.                    cur_mo := cur_mo-12
  1475.              END
  1476.           END             
  1477.       END; { DO_FILL }
  1478.    BEGIN { main }
  1479.        initialize;
  1480.        IF do_form THEN BEGIN
  1481.           Set_Mouse(M_Bee);
  1482.           IF sense THEN { fill down }
  1483.              FOR i := s_col TO f_col DO
  1484.                  FOR j := s_row TO f_row DO BEGIN
  1485.                      ptr := locate_cell(j,i);
  1486.                      IF ptr <> NIL THEN BEGIN
  1487.                         old_format := ptr^.format;
  1488.                         delete_cell(j,i,FALSE)
  1489.                      END   
  1490.                      ELSE
  1491.                         old_format := 0;
  1492.                      ptr := new_cell(j,i);
  1493.                      IF ptr <> NIL THEN
  1494.                         IF NOT do_fill THEN
  1495.                            GOTO 2
  1496.                         ELSE
  1497.                            cell_on_screen(1,j,i,TRUE)
  1498.                      ELSE
  1499.                         GOTO 2
  1500.                  END
  1501.           ELSE { fill right }
  1502.              FOR i := s_row TO f_row DO
  1503.                  FOR j := s_col TO f_col DO BEGIN
  1504.                      ptr := locate_cell(i,j);
  1505.                      IF ptr <> NIL THEN BEGIN
  1506.                         old_format := ptr^.format;
  1507.                         delete_cell(i,j,FALSE)
  1508.                      END
  1509.                      ELSE
  1510.                         old_format := 0;   
  1511.                      ptr := new_cell(i,j);
  1512.                      IF ptr <> NIL THEN
  1513.                         IF NOT do_fill THEN
  1514.                            GOTO 2
  1515.                         ELSE
  1516.                            cell_on_screen(1,i,j,TRUE)
  1517.                      ELSE
  1518.                         GOTO 2
  1519.                  END;
  1520.        END;
  1521. 2:     Set_Mouse(M_Arrow)          
  1522.    END; { DATA_FILL }
  1523.  
  1524. PROCEDURE ERROR_MESSAGE ( VAR str     : LorFstr; 
  1525.                           error       : StatusType;
  1526.                           str_pos,len : INTEGER     );
  1527.    VAR 
  1528.        i         : INTEGER;
  1529.        action    : Tree_Index;
  1530.        temp      : STR255;
  1531.    BEGIN    
  1532.        Obj_SetState(err_ptr,errok,Normal,FALSE);
  1533.        Set_Text(err_ptr,errtype,error_msg[error],s1,LENGTH(error_msg[error]));
  1534.        IF str_pos > len THEN
  1535.           str_pos := len
  1536.        ELSE IF str_pos < 1 THEN { should be impossible }
  1537.           str_pos := 1;
  1538.        Set_Text(err_ptr,errform,str,s2,string_len);
  1539.        temp := '';
  1540.        FOR i := 1 TO string_len DO
  1541.            temp := CONCAT(' ',temp);
  1542.        temp[str_pos] := '^';
  1543.        Set_Text(err_ptr,errcarat,temp,s3,string_len);
  1544.        action := form_begin(err_ptr,errform);
  1545.        Get_Text(err_ptr,errform,str);
  1546.        form_end
  1547.    END; { ERROR_MESSAGE }             
  1548.  
  1549. FUNCTION ASK_FOR_RANGE ( VAR s_r,s_c,e_r,e_c : INTEGER;
  1550.                          title               : STR30    ) : BOOLEAN;
  1551.    VAR
  1552.        action : Tree_Index;
  1553.        i      : INTEGER;
  1554.        temp   : STR255;
  1555.    FUNCTION EVAL_ACTION : BOOLEAN;
  1556.       VAR str_pos    : INTEGER;
  1557.           dummy,done : BOOLEAN;
  1558.       FUNCTION GET_EDITED (        what : Tree_Index; 
  1559.                             VAR row,col : INTEGER ) : BOOLEAN;
  1560.          BEGIN
  1561.              Get_Text(rang_ptr,what,temp);
  1562.              cap_a_string(temp);
  1563.              str_pos := 1;
  1564.              IF translate_cell(temp,str_pos,LENGTH(temp),row,col,
  1565.                                dummy,dummy) <> OK THEN BEGIN
  1566.                 get_edited := FALSE;
  1567.                 Obj_SetState ( rang_ptr,rangok,Normal,TRUE );
  1568.                 CASE what OF
  1569.                    rangbegi : action := Form_Do(rang_ptr,rangbegi);
  1570.                    rangend  : action := Form_Do(rang_ptr,rangend)
  1571.                 END
  1572.             END
  1573.              ELSE
  1574.                 get_edited := TRUE
  1575.          END; (* GET_EDITED *)
  1576.       BEGIN { EVAL_ACTION }
  1577.           done := FALSE;
  1578.           eval_action := FALSE;
  1579.           REPEAT
  1580.              IF action = rangok THEN
  1581.                 IF get_edited(rangbegi,s_r,s_c) THEN
  1582.                    IF get_edited(rangend,e_r,e_c) THEN 
  1583.                       IF (s_c > e_c) OR (s_r > e_r) THEN BEGIN
  1584.                          Obj_SetState(rang_ptr,rangok,Normal,TRUE);
  1585.                          action := Form_Do(rang_ptr,rangend)
  1586.                       END
  1587.                       ELSE BEGIN
  1588.                          done := TRUE;
  1589.                          eval_action := TRUE
  1590.                       END
  1591.           UNTIL (done) OR (action = rangcanc)
  1592.       END; { EVAL_ACTION }
  1593.    BEGIN { RANGE_TO_DISK }
  1594.        indx := Map_Tree(rang_ptr,Root,Null_Index,ClearSelected);
  1595.        Set_Text(rang_ptr,rangwhat,title,s3,12);
  1596.        IF block_set THEN BEGIN
  1597.           string_a_cell(b_s_row,b_s_col,temp);
  1598.           Set_Text(rang_ptr,rangbegi,temp,s1,5);
  1599.           string_a_cell(b_e_row,b_e_col,temp);
  1600.           Set_Text(rang_ptr,rangend,temp,s2,5)
  1601.        END
  1602.        ELSE IF find_first_and_last(FALSE) THEN BEGIN
  1603.           string_a_cell(marks[5].row,marks[5].col,temp);     
  1604.           Set_Text(rang_ptr,rangbegi,temp,s1,5);
  1605.           string_a_cell(marks[6].row,marks[6].col,temp);
  1606.           Set_Text(rang_ptr,rangend,temp,s2,5)
  1607.        END   
  1608.        ELSE BEGIN   
  1609.           Set_Text(rang_ptr,rangbegi,null_str,s1,5);
  1610.           Set_Text(rang_ptr,rangend,null_str,s2,5)
  1611.        END;   
  1612.        action := form_begin(rang_ptr,rangbegi);
  1613.        ask_for_range := eval_action;
  1614.        form_end
  1615.    END; { ASK_FOR_RANGE }    
  1616.  
  1617. PROCEDURE STATS;
  1618.    VAR i                                 : INTEGER;
  1619.        n_cell,n_val,n_label,n_expr,n_dep : LONG_INTEGER;
  1620.        temp                              : STR255;
  1621.        action                            : Tree_Index;
  1622.        dep                               : DepPtr;
  1623.        ptr                               : CellPtr;
  1624.    BEGIN
  1625.        Set_Mouse(M_Bee);
  1626.        Obj_SetState(stat_ptr,statok,Normal,FALSE);
  1627.        n_cell := 0;
  1628.        n_val := 0;
  1629.        n_label := 0;
  1630.        n_expr := 0;
  1631.        n_dep := 0;
  1632.        i := 1;
  1633.        WHILE i <= n_rows DO BEGIN
  1634.           ptr := data[i];
  1635.           WHILE ptr <> NIL DO BEGIN
  1636.              n_cell := n_cell+1;
  1637.              CASE ptr^.class OF
  1638.                 Val  : n_val := n_val+1;
  1639.                 Labl : n_label := n_label+1;
  1640.                 Expr : n_expr := n_expr+1
  1641.              END;   
  1642.              dep := ptr^.sub;
  1643.              WHILE dep <> NIL DO BEGIN
  1644.                 n_dep := n_dep+1;
  1645.                 dep := dep^.next
  1646.              END;
  1647.              ptr := ptr^.next
  1648.           END;      
  1649.           i := i+1
  1650.        END;
  1651.        r_to_s(n_cell,temp);
  1652.        Set_Text(stat_ptr,statcell,temp,s1,7);
  1653.        r_to_s(n_val,temp);
  1654.        Set_Text(stat_ptr,statval,temp,s2,7);
  1655.        r_to_s(n_label,temp);
  1656.        Set_Text(stat_ptr,statlabl,temp,s3,7);
  1657.        r_to_s(n_expr,temp);
  1658.        Set_Text(stat_ptr,statexpr,temp,s4,7);
  1659.        r_to_s(n_dep,temp);
  1660.        Set_Text(stat_ptr,statdeps,temp,s5,7);
  1661.        r_to_s(original_memory-working_memory,temp);
  1662.        Set_Text(stat_ptr,statmemc,temp,s6,10);
  1663.        r_to_s(working_memory,temp);
  1664.        Set_Text(stat_ptr,statmema,temp,s7,10);
  1665.        action := form_begin(stat_ptr,Root);
  1666.        form_end
  1667.    END; { STATS }    
  1668.        
  1669. FUNCTION DO_FREEZE : BOOLEAN;
  1670.    VAR redraw,dummy : BOOLEAN;
  1671.        temp         : STR255;
  1672.        action,which : Tree_Index;
  1673.    BEGIN
  1674.       temp := CONCAT('[1][You may not freeze the last|' ,
  1675.                          'row or column.][  OK  ]');
  1676.       do_freeze := FALSE;
  1677.       redraw := FALSE;
  1678.       indx := Map_Tree(freeze_ptr,Root,Null_Index,ClearSelected);
  1679.       action := form_begin(freeze_ptr,Root);
  1680.       form_end;
  1681.       which := Map_Tree(freeze_ptr,frzrow,frzboth,ReturnSelected);
  1682.       IF (action = frzok) AND (which <> Null_Index) THEN BEGIN
  1683.          IF (which = frzrow) OR (which = frzboth) THEN
  1684.             IF data_row = n_rows THEN
  1685.                alert := Do_Alert(temp,1)
  1686.             ELSE BEGIN   
  1687.                freeze_row := data_row;
  1688.                logical_row_1 := freeze_row+1;
  1689.                start_row := logical_row_1;
  1690.                data_row := start_row;
  1691.                y_margin := two_cell_h-1;
  1692.                { must do this so that switch will save correct finish_row &
  1693.                  col so that return_attr can recalc correct v & h_entry.
  1694.                  Failure to do this can lead to a crash when handle_message
  1695.                  tries to calculate slider positions and these entry values
  1696.                  equal n_rows or n_cols due to a non-updated finish row or
  1697.                  col }
  1698.                get_num_scr_entries(ExRight);
  1699.                IF n_hdls = 2 THEN BEGIN
  1700.                   switch_window;
  1701.                   IF start_row < logical_row_1 THEN
  1702.                      start_row := logical_row_1;
  1703.                   get_num_scr_entries(ExRight);
  1704.                   switch_window
  1705.                END;
  1706.                IF (block_set) AND (b_s_row < start_row) THEN
  1707.                   dummy := deselect_block;
  1708.                redraw := TRUE;
  1709.                do_freeze := TRUE
  1710.             END;
  1711.          IF (which = frzcol) OR (which = frzboth) THEN
  1712.             IF data_col = n_cols THEN
  1713.                alert := Do_Alert(temp,1)
  1714.             ELSE BEGIN
  1715.                freeze_col := data_col;
  1716.                logical_col_1 := freeze_col+1;
  1717.                start_col := logical_col_1;
  1718.                data_col := start_col;
  1719.                x_margin := 39+col_width[freeze_col,pixels];
  1720.                get_num_scr_entries(ExRight);
  1721.                IF n_hdls = 2 THEN BEGIN
  1722.                   switch_window;
  1723.                   IF start_col < logical_col_1 THEN
  1724.                      start_col := logical_col_1;
  1725.                   get_num_scr_entries(ExRight);
  1726.                   switch_window
  1727.                END;   
  1728.                IF (block_set) AND (b_s_col < start_col) THEN
  1729.                   dummy := deselect_block;
  1730.                redraw := TRUE;
  1731.                do_freeze := TRUE
  1732.             END
  1733.       END
  1734.       ELSE IF (action = frzundo) AND (which <> Null_Index) THEN BEGIN
  1735.          IF ((which = frzrow) OR (which = frzboth)) AND
  1736.             (freeze_row > 0) THEN BEGIN
  1737.             freeze_row := 0;
  1738.             logical_row_1 := 1;
  1739.             y_margin := cell_height-1;
  1740.             redraw := TRUE;
  1741.             do_freeze := TRUE
  1742.          END;
  1743.          IF ((which = frzcol) OR (which = frzboth)) AND
  1744.             (freeze_col > 0) THEN BEGIN
  1745.             freeze_col := 0;
  1746.             logical_col_1 := 1;
  1747.             x_margin := 38;
  1748.             redraw := TRUE;
  1749.             do_freeze := TRUE
  1750.          END
  1751.       END;
  1752.       IF redraw THEN
  1753.          Send_Redraw(TRUE,0,0,screen_width,screen_height)
  1754.    END; { DO_FREEZE }
  1755.          
  1756.       
  1757.          
  1758.      
  1759. BEGIN
  1760. END.
  1761.  
  1762.  
  1763.  
  1764.  
  1765.  
  1766.