home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Crawly Crypt Collection 1
/
crawlyvol1.bin
/
apps
/
spread
/
opusprg
/
opussrc
/
m.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-05-12
|
44KB
|
1,003 lines
{$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.
