{$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_rowf_row) OR (key_colf_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 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.