{$M+} {$E+} PROGRAM Mock; {$I i:\opus.i} {$I i:\gctv.inc} {$I i:\globsubs.def} {$I i:\gemsubs.def} {$I i:\vdi_aes.def} {$I d:\pascal\opus\resource.def} {$I d:\pascal\opus\bf.def} {$I d:\pascal\opus\graphout.def} PROCEDURE EVALUATE_FORMULA ( row,col : INTEGER; force, new_form : BOOLEAN; cell : CellPtr ); EXTERNAL; PROCEDURE HANDLE_MESSAGE; LABEL 9; VAR i,j,dummy : INTEGER; redraw,sci : BOOLEAN; num_ptr : PtrToReal; str_ptr : PtrToString; ptr : CellPtr; (* in all these following routines, slider positions are changed by a subsequent call to RESET_WINDOW *) { extent is the variable that determines which part of the screen is to be redrawn; it is initialized to WholeSheet and stays WholeSheet unless something changes it. Of course, depending on the action, the sheet may not be redrawn at all... } PROCEDURE PAGE_UP; BEGIN start_row := start_row-v_entry; IF start_row < logical_row_1 THEN start_row := logical_row_1; data_row := start_row+scr_row-1 END; { PAGE_UP } PROCEDURE PAGE_DOWN; BEGIN start_row := start_row+v_entry; IF start_row+v_entry-1 > n_rows THEN start_row := n_rows-v_entry+1; data_row := start_row+scr_row-1 END; { PAGE_DOWN } PROCEDURE ROW_UP; BEGIN { toggle because we are going to blit, and we need to toggle based on the current cells position, which is about to change, and since we aren't doing a complete screen redraw } Hide_Mouse; toggle_inverse(Black,data_row,data_col); Show_Mouse; start_row := start_row-1; data_row := data_row-1 END; { ROW_UP } PROCEDURE ROW_DOWN; BEGIN { toggle because we are going to blit, and we need to toggle based on the current cells position, which is about to change, and since we aren't doing a complete screen redraw } Hide_Mouse; toggle_inverse(Black,data_row,data_col); Show_Mouse; start_row := start_row+1; data_row := data_row+1 END; { ROW_DOWN } PROCEDURE MOVE_V_SLIDER; VAR old_slider_pos : INTEGER; BEGIN v_slider_pos := msg_area[4]; Wind_Get(act_hdl,WF_VSlide,old_slider_pos,dummy,dummy,dummy); IF (v_slider_pos >= ROUND(old_slider_pos+v_slide_inc)) OR (v_slider_pos <= ROUND(old_slider_pos-v_slide_inc)) THEN BEGIN start_row := ROUND(v_slider_pos/v_slide_inc)+1; IF start_row+v_entry-1 > n_rows THEN start_row := n_rows-v_entry+1; IF start_row < logical_row_1 THEN start_row := logical_row_1; data_row := start_row+scr_row-1 END ELSE GOTO 9 END; (* MOVE_V_SLIDER *) PROCEDURE COL_RIGHT; BEGIN { toggle because we are going to blit, and we need to toggle based on the current cells position, which is about to change, and since we aren't doing a complete screen redraw } Hide_Mouse; toggle_inverse(Black,data_row,data_col); Show_Mouse; finish_col := finish_col+1; data_col := data_col+1; get_num_scr_entries(ExLeft) END; { COL_RIGHT } PROCEDURE COL_LEFT; BEGIN Hide_Mouse; toggle_inverse(Black,data_row,data_col); Show_Mouse; start_col := start_col-1; data_col := data_col-1 { don't need to get_num_scr_entries } END; { COL_LEFT } PROCEDURE PAGE_RIGHT; VAR rel_pos : REAL; BEGIN rel_pos := scr_col/h_entry; start_col := start_col+h_entry; get_num_scr_entries(ExRight); data_col := start_col+ROUND(rel_pos*h_entry)-1 END; { PAGE_RIGHT } PROCEDURE PAGE_LEFT; VAR rel_pos : REAL; BEGIN rel_pos := scr_col/h_entry; finish_col := start_col-1; get_num_scr_entries(ExLeft); data_col := start_col+ROUND(rel_pos*h_entry)-1 END; { PAGE_LEFT } PROCEDURE MOVE_H_SLIDER; VAR old_slider_pos : INTEGER; rel_pos : REAL; BEGIN rel_pos := scr_col/h_entry; h_slider_pos := msg_area[4]; Wind_Get(act_hdl,WF_HSlide,old_slider_pos,dummy,dummy,dummy); IF (h_slider_pos >= ROUND(old_slider_pos+h_slide_inc)) OR (h_slider_pos <= ROUND(old_slider_pos-h_slide_inc)) THEN BEGIN start_col := ROUND(h_slider_pos/h_slide_inc)+1; get_num_scr_entries(ExRight); data_col := start_col+ROUND(rel_pos*h_entry)-1 END ELSE GOTO 9 END; (* MOVE_H_SLIDER *) PROCEDURE MOVED_WINDOW; VAR new_x,new_y,new_w,new_h : INTEGER; BEGIN new_x := msg_area[4]; { AES blits here- no need to redraw } new_y := msg_area[5]; new_w := msg_area[6]; new_h := msg_area[7]; new_x := 8*((new_x+4) DIV 8); { this aligns by bytes } { note the following code assumes that the width of the window is legal; since the max width is the entire screen, we needn't check that in resize_sheet, since windows can't be resized off-screen. } IF new_x+new_w > o_x+max_w THEN { off screen to the right } new_x := o_x+max_w-new_w; IF new_y < o_y THEN new_y := o_y; IF new_y+new_h > o_y+max_h THEN { off screen below } new_y := o_y+max_h-new_h; Set_WSize(act_hdl,new_x,new_y,new_w,new_h); def_sheet_area { must reset vert_grid } END; (* MOVED_WINDOW *) PROCEDURE RESIZED_WINDOW; VAR new_x,new_y,new_w,new_h,x,y,w,h : INTEGER; BEGIN Border_Rect(act_hdl,x,y,w,h); new_x := msg_area[4]; new_y := msg_area[5]; new_w := msg_area[6]; new_h := msg_area[7]; { make sure that at least 20 characters can be displayed on one line in the edit line so we can limit the size of the blit buffer; max length string to be displayed there is 60. Height really doesn't matter given this constraint and since GEM itself limits it. Also limit the size so that the widest column can fit in the smallest window; i.e. 30 columns. Do this so won't have to check whether or not a column is too big to fit, by itself, in a window. } IF new_w < half_scr_width-5 THEN new_w := half_scr_width-5; Set_WSize(act_hdl,new_x,new_y,new_w,new_h); def_sheet_area; write_cell_name; Send_Redraw(FALSE,new_x,new_y,new_w,new_h) END; (* RESIZED_WINDOW *) PROCEDURE FULLED_WINDOW; VAR x,y,w,h,p_x,p_y,p_w,p_h : INTEGER; BEGIN Border_Rect(act_hdl,x,y,w,h); IF (w = max_w) AND (h = max_h) THEN BEGIN Wind_Get(act_hdl,WF_PrevXYWH,p_x,p_y,p_w,p_h); IF (p_w <> max_w) OR (p_h <> max_h) THEN BEGIN Set_WSize(act_hdl,p_x,p_y,p_w,p_h); Send_Redraw(FALSE,p_x,p_y,p_w,p_h) END END ELSE Set_WSize(act_hdl,o_x,o_y,max_w,max_h); def_sheet_area; write_cell_name END; (* FULLED_WINDOW *) PROCEDURE TOPPED_WINDOW; BEGIN IF (n_hdls = 2) AND (msg_area[3] <> act_hdl) THEN switch_window; Bring_To_Front(act_hdl); write_cell_name; cell_on_screen(1,data_row,data_col,TRUE) END; { TOPPED_WINDOW } FUNCTION REALLY_QUIT : BOOLEAN; BEGIN temp:='[3][Have you saved your work?][ Cancel |Quit]'; IF Do_Alert(temp,2) = 2 THEN really_quit := TRUE ELSE really_quit := FALSE END; { REALLY_QUIT } PROCEDURE MANUAL_RECALC; VAR i : INTEGER; ptr : CellPtr; BEGIN did_recalc := TRUE; { recalc nominally in row-major order } FOR i := 1 TO n_rows DO BEGIN ptr := data[i]; WHILE ptr <> NIL DO BEGIN IF (ptr^.class = Expr) AND (ptr^.format & recalc_mask = 0) AND (ptr^.format & pending_mask = 0) THEN evaluate_formula(i,ptr^.c,TRUE,FALSE,ptr); ptr := ptr^.next END END; cell_on_screen(1,data_row,data_col,TRUE) END; { MANUAL_RECALC } PROCEDURE DO_MENU; VAR d,menu_title,i,j, s_r,s_c,e_r,e_c,default : INTEGER; dummy,found,over,quit : BOOLEAN; a : AssignedStatus; ptr : CellPtr; PROCEDURE CHANGE_CLASS ( new_class : ClassType ); VAR ptr : CellPtr; BEGIN delete_range(data_row,data_col,data_row,data_col,TRUE); ptr := new_cell(data_row,data_col); IF ptr <> NIL THEN BEGIN ptr^.class := new_class; ptr^.format := default_format; IF new_class = Labl THEN ptr^.format := (ptr^.format & no_just_mask) | $0010 END END; { CHANGE_CLASS } PROCEDURE GOTO_MARK ( which : INTEGER ); BEGIN WITH marks[which] DO IF (row >= logical_row_1) AND (col >= logical_col_1) THEN BEGIN data_row := row; data_col := col; start_row := row; start_col := col; Send_Redraw(FALSE,0,0,screen_width,screen_height) END END; { GOTO_MARK } PROCEDURE SHEET_INSERT_AND_DELETE ( action,which : INTEGER ); VAR i,j,k,m : INTEGER; a1,a2 : STRING; BEGIN IF action = 1 THEN temp := 'INSERT ' ELSE temp := 'DELETE '; IF which = 1 THEN temp := CONCAT(temp,'row') ELSE temp := CONCAT(temp,'column'); a2 := CONCAT('[2][' , temp , ' mode: ][Cancel|Partial|Whole]'); a1 := CONCAT('[1][You can not ' , temp , '|because you are at a|' , 'worksheet border.][ OK ]'); IF block_set THEN default := 2 ELSE default := 3; alert := Do_Alert(a2,default); IF alert <> 1 THEN IF which = 1 THEN { row } IF data_row = n_rows THEN alert := Do_Alert(a1,1) ELSE IF alert = 2 THEN { partial } IF block_set THEN IF b_e_row = n_rows THEN alert := Do_Alert(a1,1) ELSE IF action = 1 THEN { insert } shift_block(mmove,b_s_row+1,b_s_col, b_s_row,b_s_col,n_rows-1,b_e_col) ELSE { delete } shift_block(mmove,b_s_row,b_s_col, b_s_row+1,b_s_col,n_rows,b_e_col) ELSE IF action = 1 THEN { insert } shift_block(mmove,data_row+1,data_col, data_row,data_col,n_rows-1,n_cols) ELSE { delete } shift_block(mmove,data_row,data_col, data_row+1,data_col,n_rows,n_cols) ELSE IF action = 1 THEN { insert } { whole row } shift_block(mmove,data_row+1,1, data_row,1,n_rows-1,n_cols) ELSE { delete } shift_block(mmove,data_row,1, data_row+1,1,n_rows,n_cols) ELSE { column } IF data_col = n_cols THEN alert := Do_Alert(a1,1) ELSE BEGIN IF alert = 2 THEN { partial } IF block_set THEN IF b_e_col = n_cols THEN alert := Do_Alert(a1,1) ELSE IF action = 1 THEN { insert } shift_block(mmove,b_s_row,b_s_col+1, b_s_row,b_s_col,b_e_row,n_cols-1 ) ELSE { delete } shift_block(mmove,b_s_row,b_s_col, b_s_row,b_s_col+1,b_e_row,n_cols) ELSE IF action = 1 THEN { insert } shift_block(mmove,data_row,data_col+1, data_row,data_col,n_rows,n_cols-1) ELSE { delete } shift_block(mmove,data_row,data_col, data_row,data_col+1,n_rows,n_cols) ELSE IF action = 1 THEN { insert whole col } shift_block(mmove,1,data_col+1, 1,data_col,n_rows,n_cols-1) ELSE shift_block(mmove,1,data_col, 1,data_col+1,n_rows,n_cols); IF action = 1 THEN { insert } FOR i := n_cols-1 DOWNTO data_col DO BEGIN IF col_width[i+1,spaces] <> col_width[i,spaces] THEN BEGIN col_width[i+1,spaces] := col_width[i,spaces]; col_width[i+1,pixels] := col_width[i,pixels]; redraw := TRUE END END ELSE { delete } FOR i := data_col TO n_cols-1 DO BEGIN IF col_width[i+1,spaces] <> col_width[i,spaces] THEN BEGIN col_width[i,spaces] := col_width[i+1,spaces]; col_width[i,pixels] := col_width[i+1,pixels]; redraw := TRUE END END; IF redraw THEN Send_Redraw(TRUE,0,0,screen_width,screen_height) END { ELSE } END; { SHEET_INSERT_AND_DELETE } BEGIN { DO_MENU } menu_title := msg_area[3]; CASE menu_title OF Desk : BEGIN Obj_SetState(info_ptr,aboutok,Normal,FALSE); indx := form_begin(info_ptr,Root); form_end END; mfile : CASE msg_area[4] OF mloadws : disk_io(LoadFile); msavews : disk_io(SaveFile); mloadbl : disk_io(LoadBlock); msavebl : disk_io(SaveBlock); msavetxt : disk_io(SaveText); mprintsp : print_spreadsheet(TRUE,'Print WorkSheet', s_r,s_c,e_r,e_c); mopenw : BEGIN d := New_Window(G_All,t_2,0,0,0,0); IF d > No_Window THEN BEGIN { window available } Set_WSize(act_hdl,o_x,o_y,half_scr_width-5,max_h); sheet_redraw(WholeSheet,FALSE,None); act_hdl := d; Open_Window(act_hdl,half_scr_width+4,o_y, half_scr_width-5,max_h); n_hdls := 2; w_idx := 2; w_pos[2] := w_pos[1]; w_pos[2,w_hdl] := act_hdl; return_attr; { redraw_msg only does this if act_hdl } { <> handle sent to it; here, it is = } Menu_Disable(main_menu,mopenw) END ELSE BEGIN temp := CONCAT('[1][GEM is out of windows. You|' , 'must close one before you|' , 'may open another.][ OK ]' ); alert := Do_Alert(temp,1) END END; mclosew : IF n_hdls = 2 THEN BEGIN { generates a redraw message } Close_Window(act_hdl); Delete_Window(act_hdl); t_1 := ' WorkSheet1 '; { restore these because } t_2 := ' WorkSheet2 '; { PASGEM had -> 'C'-string } IF w_idx = 1 THEN { closed window 1? } w_pos[1] := w_pos[2] { including handle } ELSE w_idx := 1; return_attr; { retrieve attributes, including hdl } Set_WName(act_hdl,t_1); n_hdls := 1; Menu_Enable(main_menu,mopenw) END ELSE IF really_quit THEN user_quit := TRUE; mainquit : IF really_quit THEN user_quit := TRUE { quit maximize } END; { mfile } mformat : CASE msg_area[4] OF mnum : change_class(Val); mlabel : change_class(Labl); mform : change_class(Expr); mcolwid : change_format(CWCall); mjust : change_format(JustCall); mdollar : change_format(DollarCall); mpercent : change_format(PercCall); mprec : change_format(PrecCall); mstyle : change_format(StyleCall); mglobalf : change_format(GlobalCall); mviewfor : view_format END; mblock : CASE msg_area[4] OF mstartbl : dummy := start_block; mendbl : dummy := end_block; mcopy : dummy := transport_block(mcopy); mmove : dummy := transport_block(mmove); mdesel : dummy := deselect_block; mdelete : delete_block; minsertr : sheet_insert_and_delete(1,1); { insert,row } minsertc : sheet_insert_and_delete(1,2); { insert,col } mdeleter : sheet_insert_and_delete(2,1); { delete,row } mdeletec : sheet_insert_and_delete(2,2); { delete,col } mdatafil : data_fill; mrep : replicate_cell; msort : sort END; { mblock } mmark : CASE msg_area[4] OF ms1 : WITH marks[1] DO BEGIN row := data_row; col := data_col; m1s := TRUE; Menu_Enable(main_menu,mg1) END; ms2 : WITH marks[2] DO BEGIN row := data_row; col := data_col; m2s := TRUE; Menu_Enable(main_menu,mg2) END; ms3 : WITH marks[3] DO BEGIN row := data_row; col := data_col; m3s := TRUE; Menu_Enable(main_menu,mg3) END; ms4 : WITH marks[4] DO BEGIN row := data_row; col := data_col; m4s := TRUE; Menu_Enable(main_menu,mg4) END; mg1 : goto_mark(1); mg2 : goto_mark(2); mg3 : goto_mark(3); mg4 : goto_mark(4); mcmarks : BEGIN Menu_Disable(main_menu,mg1); Menu_Disable(main_menu,mg2); Menu_Disable(main_menu,mg3); Menu_Disable(main_menu,mg4); m1s := FALSE; m2s := FALSE; m3s := FALSE; m4s := FALSE; FOR i := 1 TO 4 DO BEGIN marks[i].row := 0; marks[i].col := 0 END END; mfirstc : BEGIN IF block_set THEN BEGIN start_row := b_s_row; start_col := b_s_col; data_row := start_row; data_col := start_col END ELSE IF find_first_and_last(TRUE) THEN goto_mark(5) ELSE home_cursor(Origin); Send_Redraw(FALSE,0,0,screen_width,screen_height) END; mlastc : BEGIN IF block_set THEN BEGIN data_row := b_e_row; data_col := b_e_col; start_row := b_e_row-v_entry+1; finish_col := b_e_col; get_num_scr_entries(ExLeft) END ELSE IF find_first_and_last(TRUE) THEN BEGIN WITH marks[6] DO BEGIN data_row := row; data_col := col; start_row := row-v_entry+1; finish_col := col END; get_num_scr_entries(ExLeft) END ELSE home_cursor(Origin); Send_Redraw(FALSE,0,0,screen_width,screen_height) END; mgoto : BEGIN redraw := goto_cell; IF redraw THEN Send_Redraw(FALSE,0,0,screen_width,screen_height) END END; { mmark } moptions : CASE msg_area[4] OF msetauto : BEGIN IF cursor_direction = CursorDown THEN default := 2 ELSE default := 1; temp := CONCAT('[2][Auto-cursor direction:]' , '[ Right | Down ]'); IF Do_Alert(temp,default) = 2 THEN cursor_direction := CursorDown ELSE cursor_direction := CursorRight END; mautocur : BEGIN IF auto_cursor THEN Menu_Check(main_menu,mautocur,FALSE) ELSE Menu_Check(main_menu,mautocur,TRUE); auto_cursor := NOT auto_cursor END; msmall : BEGIN { only available if high rez } IF small_text THEN BEGIN cell_height := 17; two_cell_h := 34; three_cell_h := 51; IF freeze_row > 0 THEN y_margin := two_cell_h-1 ELSE y_margin := cell_height-1; Set_Char_Height(13); { 8x16 font } Menu_Check(main_menu,msmall,FALSE) END ELSE BEGIN cell_height := 9; two_cell_h := 18; three_cell_h := 27; IF freeze_row > 0 THEN y_margin := two_cell_h-1 ELSE y_margin := cell_height-1; Set_Char_Height(6); { 8x8 font } Menu_Check(main_menu,msmall,TRUE) END; small_text := NOT small_text; redraw := TRUE; Send_Redraw(TRUE,0,0,screen_width,screen_height) END; mshowfor : BEGIN IF form_flag THEN Menu_Check(main_menu,mshowfor,FALSE) ELSE Menu_Check(main_menu,mshowfor,TRUE); form_flag := NOT form_flag; Set_Mouse(M_Bee); FOR i := 1 TO n_rows DO BEGIN ptr := data[i]; WHILE ptr <> NIL DO BEGIN IF ptr^.class = Expr THEN cell_on_screen(1,i,ptr^.c,TRUE); ptr := ptr^.next END END; Set_Mouse(M_Arrow) END; mclearws : BEGIN temp := CONCAT('[3][Do you REALLY wish to CLEAR|' , 'the worksheet? "Number"|' , 'means that only numeric|' , 'cells will be cleared.]' , '[Cancel|Number|OK]'); alert := Do_Alert(temp,3); IF alert = 3 THEN BEGIN Set_Mouse(M_Bee); clear_worksheet; Set_Mouse(M_Arrow); redraw := TRUE END ELSE IF alert = 2 THEN BEGIN Set_Mouse(M_Bee); FOR i := 1 TO n_rows DO BEGIN ptr := data[i]; WHILE ptr <> NIL DO BEGIN IF ptr^.class = Val THEN ptr^.status := Empty; ptr := ptr^.next END END; Set_Mouse(M_Arrow); redraw := TRUE; Send_Redraw(TRUE,0,0,screen_width,screen_height) END END; mstats : stats; mfreeze : redraw := do_freeze; mmanrec : BEGIN Set_Mouse(M_Bee); manual_recalc; Set_Mouse(M_Arrow) END; mautorec : BEGIN IF auto_recalc THEN Menu_Check(main_menu,mautorec,FALSE) ELSE Menu_Check(main_menu,mautorec,TRUE); auto_recalc := NOT auto_recalc END; mnatural : BEGIN IF natural THEN Menu_Check(main_menu,mnatural,FALSE) ELSE Menu_Check(main_menu,mnatural,TRUE); natural := NOT natural END; mrefresh : BEGIN temp := CONCAT('[2][Choose one of the following:]', '[Cancel|Window|Data]'); alert := Do_Alert(temp,3); IF alert = 3 THEN BEGIN Set_Mouse(M_Bee); FOR i := start_row TO finish_row DO BEGIN found := FALSE; quit := FALSE; ptr := data[i]; WHILE (ptr <> NIL) AND (NOT found) AND (NOT quit) DO IF (ptr^.c >= start_col) AND (ptr^.c <= finish_col) THEN found := TRUE ELSE IF ptr^.c > finish_col THEN quit := TRUE ELSE ptr := ptr^.next; over := FALSE; IF found THEN WHILE (ptr <> NIL) AND (NOT over) DO BEGIN cell_on_screen(1,i,ptr^.c,TRUE); ptr := ptr^.next; IF ptr <> NIL THEN IF ptr^.c > finish_col THEN over := TRUE END END; cell_on_screen(1,data_row,data_col,TRUE); Set_Mouse(M_Arrow) END ELSE IF alert = 2 THEN Send_Redraw(FALSE,0,0,screen_width,screen_height) END; mshowgri : BEGIN IF grid_flag THEN Menu_Check(main_menu,mshowgri,FALSE) ELSE Menu_Check(main_menu,mshowgri,TRUE); grid_flag := NOT grid_flag; Send_Redraw(TRUE,0,0,screen_width,screen_height) END END; { moptions } { MHELP is handled within window_input so that help may be obtained without losing any typed information in edit area } OTHERWISE : ; END; { CASE menu_title } Menu_Normal(main_menu,menu_title) END; { DO_MENU } FUNCTION Addr ( VAR data : DataTable ) : LONG_INTEGER; EXTERNAL; FUNCTION MFDB_ADDR ( which : INTEGER ) : LONG_INTEGER; FUNCTION Addr ( VAR a : Mfdb ) : LONG_INTEGER; EXTERNAL; BEGIN IF which > 0 THEN mfdb_addr := Addr(mem_mfdb) ELSE mfdb_addr := Addr(screen_mfdb) END; FUNCTION PTR_TO_LONG ( ptr : CellPtr ) : LONG_INTEGER; VAR swap : RECORD CASE BYTE OF 1 : ( a : CellPtr ); 2 : ( b : LONG_INTEGER ) END; BEGIN swap.a := ptr; ptr_to_long := swap.b END; { PTR_TO_LONG } FUNCTION RealPtr ( where : LONG_INTEGER ) : PtrToReal; FUNCTION Ptr ( where : LONG_INTEGER ) : PtrToReal; EXTERNAL; BEGIN RealPtr := Ptr(where) END; FUNCTION StrPtr ( where : LONG_INTEGER ) : PtrToString; FUNCTION Ptr ( where : LONG_INTEGER ) : PtrToString; EXTERNAL; BEGIN StrPtr := Ptr(where) END; PROCEDURE SEND_MSG ( msg_type : INTEGER ); BEGIN msg[0] := msg_type; msg[1] := ap_id; msg[2] := 0; Write_Message(msg_area[1],16,msg) END; { SEND_MSG } BEGIN (* handle_message *) { save for BLITs in SHEET_REDRAW } old_vert_grid := vert_grid; find_screen_pos(data_row,data_col,scr_row,scr_col); o_scr_row := scr_row; o_scr_col := scr_col; o_s_row := start_row; o_f_row := finish_row; o_s_col := start_col; o_f_col := finish_col; message_type := msg_area[0]; extent := WholeSheet; v_slide_inc := 1000/(n_rows-v_entry); { / number off-screen } h_slide_inc := 1000/(n_cols-h_entry); redraw := FALSE; CASE message_type OF WM_Arrowed : BEGIN CASE msg_area[4] OF 0 : IF start_row > logical_row_1 THEN page_up ELSE GOTO 9; 1 : IF finish_row < n_rows THEN page_down ELSE GOTO 9; 2 : IF start_row > logical_row_1 THEN row_up ELSE GOTO 9; 3 : IF finish_row < n_rows THEN row_down ELSE GOTO 9; 4 : IF start_col > logical_col_1 THEN page_left ELSE GOTO 9; 5 : IF finish_col < n_cols THEN page_right ELSE GOTO 9; 6 : IF start_col > logical_col_1 THEN col_left ELSE GOTO 9; 7 : IF finish_col < n_cols THEN col_right ELSE GOTO 9 END; CASE msg_area[4] OF 0,1,2,3 : extent := NoColNames; 4,5,6,7 : extent := NoRowNames END END; WM_VSlid : BEGIN move_v_slider; extent := NoColNames END; WM_HSlid : BEGIN move_h_slider; extent := NoRowNames END; WM_Moved : moved_window; WM_Sized : resized_window; WM_Fulled : fulled_window; WM_Topped : topped_window; { code for redraw_message is in globsubs.pas since clean_up_after_dialog needs access to it } WM_Redraw : redraw_message(msg_area[3],msg_area[4], msg_area[5],msg_area[6], msg_area[7]); MN_Selected : IF Front_Window = act_hdl THEN do_menu ELSE BEGIN redraw := TRUE; Menu_Normal(main_menu,msg_area[3]) END; WM_Closed : { note sim. calls handle_message } IF n_hdls = 2 THEN { a recursive call } simulate_message(MN_Selected,mfile,mclosew) ELSE IF really_quit THEN user_quit := TRUE; { Desk Accessory requests } PresentMsg : BEGIN msg[3] := data_row; { always > 0 } msg[4] := data_col; send_msg(PresentReply) END; AssignedMsg : BEGIN msg[5] := ORD(assigned(msg_area[3],msg_area[4],ptr)); data_addr := ptr_to_long(ptr); msg[3] := ShR(data_addr,16); msg[4] := data_addr & $0000FFFF; send_msg(AssignedReply) END; RedrawMsg : BEGIN Send_Redraw(TRUE,0,0,screen_width,screen_height); send_msg(RedrawReply) END; DataMsg : BEGIN data_addr := Addr(data); msg[3] := ShR(data_addr,16); { high } msg[4] := data_addr & $0000FFFF; { low } send_msg(DataReply) END; NewMsg : BEGIN ptr := new_cell(msg_area[3],msg_area[4]); data_addr := ptr_to_long(ptr); msg[3] := ShR(data_addr,16); msg[4] := data_addr & $0000FFFF; send_msg(NewReply) END; DeleteMsg : BEGIN delete_cell(msg_area[3],msg_area[4],FALSE); send_msg(DeleteReply) END; LocateMsg : BEGIN ptr := locate_cell(msg_area[3],msg_area[4]); data_addr := ptr_to_long(ptr); msg[3] := ShR(data_addr,16); msg[4] := data_addr & $0000FFFF; send_msg(LocateReply) END; DefRangeMsg : BEGIN IF block_set THEN BEGIN msg[3] := b_s_row; msg[4] := b_s_col; msg[5] := b_e_row; msg[6] := b_e_col END ELSE msg[3] := 0; send_msg(DefRangeReply) END; GetRangeMsg : BEGIN IF ask_for_range(msg[3],msg[4],msg[5],msg[6], 'Accessory') THEN msg[7] := 1 ELSE msg[7] := 0; send_msg(GetRangeReply) END; MfdbAddrMsg : BEGIN data_addr := mfdb_addr(1); { Memory MFDB } msg[3] := ShR(data_addr,16); msg[4] := data_addr & $0000FFFF; data_addr := mfdb_addr(0); { Screen MFDB } msg[5] := ShR(data_addr,16); msg[6] := data_addr & $0000FFFF; send_msg(MfdbAddrReply) END; RealToStrMsg : BEGIN data_addr := msg_area[3]; data_addr := ShL(data_addr,16) | msg_area[4]; num_ptr := RealPtr(data_addr); data_addr := msg_area[5]; data_addr := ShL(data_addr,16) | msg_area[6]; str_ptr := StrPtr(data_addr); IF msg_area[7] & $8000 <> 0 THEN sci := TRUE ELSE sci := FALSE; i := msg_area[7] & $7FFF; real_to_string(num_ptr^,str_ptr^,i,sci); send_msg(RealToStrReply) END; StrToRealMsg : BEGIN data_addr := msg_area[3]; data_addr := ShL(data_addr,16) | msg_area[4]; str_ptr := StrPtr(data_addr); data_addr := msg_area[5]; data_addr := ShL(data_addr,16) | msg_area[6]; num_ptr := RealPtr(data_addr); num_ptr^ := string_to_real(str_ptr^); send_msg(StrToRealReply) END; TranslateMsg : BEGIN data_addr := msg_area[3]; data_addr := ShL(data_addr,16) | msg_area[4]; str_ptr := StrPtr(data_addr); i := 1; IF translate_cell(str_ptr^,i,LENGTH(str_ptr^), msg[3],msg[4],sci,sci) = OK THEN msg[5] := 1 ELSE msg[5] := 0; send_msg(TranslateReply) END; StringaCellMsg : BEGIN data_addr := msg_area[5]; data_addr := ShL(data_addr,16) | msg_area[6]; str_ptr := StrPtr(data_addr); string_a_cell(msg_area[3],msg_area[4],str_ptr^); send_msg(StringaCellReply) END; RecalcMsg : BEGIN Set_Mouse(M_Bee); manual_recalc; Set_Mouse(M_Arrow); send_msg(RecalcReply) END; END; (* CASE message_type *) CASE message_type OF WM_VSlid,WM_HSlid : sheet_redraw(extent,FALSE,None); MN_Selected : IF NOT redraw THEN write_cell_name; WM_Arrowed : CASE msg_area[4] OF 0,1,4,5 : sheet_redraw(extent,FALSE,None); 2 : sheet_redraw(extent,TRUE,Up); 3 : sheet_redraw(extent,TRUE,Down); 6 : sheet_redraw(extent,TRUE,Left); 7 : sheet_redraw(extent,TRUE,Right) END END; 9: END; (* HANDLE_MESSAGE *) BEGIN END.