home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Crawly Crypt Collection 1
/
crawlyvol1.bin
/
apps
/
spread
/
opusprg
/
opussrc
/
gl.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-05-18
|
66KB
|
1,792 lines
{$M+}
{$E+}
PROGRAM Mock;
{$I i:\opus.i}
{$I i:\gctv.inc}
{$I i:\vdi_aes.def}
{$I i:\gemsubs.def}
{$I i:\auxsubs.def}
{$I d:\pascal\opus\graphout.def}
PROCEDURE REAL_TO_STRING ( real_num: REAL; VAR string_real: STRING;
digits: INTEGER; sci_not: BOOLEAN );
EXTERNAL;
FUNCTION STRING_TO_REAL ( VAR string_real : STR30 ) : REAL;
EXTERNAL;
PROCEDURE INT_TO_STRING ( a : INTEGER; VAR b : STR10 );
EXTERNAL;
PROCEDURE HANDLE_MESSAGE;
EXTERNAL;
PROCEDURE EVALUATE_FORMULA ( row,col : INTEGER;
force,
new_form : BOOLEAN;
cell : CellPtr );
EXTERNAL;
FUNCTION REQUEST_MEMORY ( what : ReqType ) : BOOLEAN;
FORWARD;
PROCEDURE INIT_CELL ( what : CellPtr; row,col : INTEGER );
FORWARD;
FUNCTION LOCATE_CELL ( row,col : INTEGER ) : CellPtr;
FORWARD;
FUNCTION NEW_CELL ( row,col : INTEGER ) : CellPtr;
FORWARD;
PROCEDURE DELETE_CELL ( row,col : INTEGER;
total_kill : BOOLEAN );
FORWARD;
PROCEDURE FIND_SCREEN_POS ( row,col : INTEGER;
VAR l_scr_row,l_scr_col : INTEGER );
FORWARD;
PROCEDURE SAVE_ATTR;
FORWARD;
PROCEDURE RETURN_ATTR;
FORWARD;
PROCEDURE CELL_ON_SCREEN ( draw_or_toggle,row,col : INTEGER; force : BOOLEAN );
FORWARD;
PROCEDURE STRING_A_CELL ( row,col : INTEGER; VAR temp : STR10 );
FORWARD;
PROCEDURE OUT_MEM_CELL ( row,col : INTEGER; specific : STR10 );
FORWARD;
FUNCTION REL_OVERFLOW ( row,col : INTEGER; VAR what : STR10 ) : INTEGER;
FORWARD;
PROCEDURE FREE_DEP_LIST ( ptr : CellPtr );
FORWARD;
FUNCTION LIST_END ( ptr : CellPtr ) : DepPtr;
FORWARD;
FUNCTION DUPLICATING ( dep_row,dep_col : INTEGER; ptr : CellPtr ) : BOOLEAN;
FORWARD;
PROCEDURE LIST_INSERT ( fx_row,fx_col,dep_row,dep_col : INTEGER );
FORWARD;
PROCEDURE LIST_DELETE ( fx_row,fx_col,dep_row,dep_col : INTEGER );
FORWARD;
PROCEDURE STRIP_NUM ( VAR num_str : LorFstr;
VAR str : LorFstr;
VAR str_pos,
len : INTEGER );
FORWARD;
FUNCTION VALID_COL_NAME ( VAR temp : STR10;
VAR col_number : INTEGER ) : BOOLEAN;
FORWARD;
PROCEDURE GET_COL ( VAR str : LorFstr; VAR str_pos : INTEGER;
len : INTEGER; VAR col : INTEGER;
VAR col_rel : BOOLEAN; VAR status : StatusType );
FORWARD;
PROCEDURE GET_ROW ( VAR str : LorFstr; VAR str_pos : INTEGER;
len : INTEGER; VAR row : INTEGER;
VAR row_rel : BOOLEAN; VAR status : StatusType );
FORWARD;
FUNCTION TRANSLATE_CELL ( VAR str : LorFstr; { cell_str or formula }
VAR str_pos : INTEGER; { position; 1 for cell }
len : INTEGER; { length of string }
VAR row,col : INTEGER;
VAR row_rel, { relative reference? }
col_rel : BOOLEAN ) : StatusType;
FORWARD;
FUNCTION SCAN_FOR_CELLS ( VAR str : LorFstr;
VAR str_pos : INTEGER;
len : INTEGER;
VAR cell_pos : INTEGER;
VAR row,col : INTEGER;
VAR row_rel,
col_rel : BOOLEAN ) : BOOLEAN;
FORWARD;
FUNCTION ADJUST_EXPR ( action : INTEGER; { add,remove, }
ptr : CellPtr; { adj_refs }
src_row,src_col,
dest_row,dest_col,
row_st,col_st,
row_end,col_end : INTEGER ) : StatusType;
FORWARD;
PROCEDURE ALL_LISTS ( action : INTEGER; ptr : CellPtr; row,col : INTEGER );
FORWARD;
PROCEDURE DEFAULT_DRAW_ATTRIBUTES;
FORWARD;
PROCEDURE REDRAW_MESSAGE ( hdl,x,y,w,h : INTEGER );
FORWARD;
PROCEDURE Send_Redraw ( all_windows : BOOLEAN;
x,y,w,h : INTEGER );
FORWARD;
PROCEDURE ADJUST_MENU ( enable : BOOLEAN );
FORWARD;
FUNCTION FIND_PREC ( ptr : CellPtr ) : INTEGER;
FORWARD;
FUNCTION FIND_JUST ( ptr : CellPtr ) : VDI_Just;
FORWARD;
FUNCTION ASSIGNED ( row,col : INTEGER; VAR ptr : CellPtr ) : AssignedStatus;
FORWARD;
FUNCTION VALID_NUMBER ( VAR num_str : LorFstr ) : StatusType;
FORWARD;
PROCEDURE PREPARE_NUM ( ptr : CellPtr; VAR temp : STRING );
FORWARD;
PROCEDURE MASK_OUT_RECALC;
FORWARD;
FUNCTION ASSIGN ( VAR temp : LorFstr ) : CellPtr;
FORWARD;
FUNCTION SIZE ( row,col : INTEGER ) : INTEGER;
FORWARD;
FUNCTION COMP_ASSIGN ( src_row,src_col,dest_row,dest_col : INTEGER;
build : BOOLEAN ) : BOOLEAN;
FORWARD;
PROCEDURE DELETE_RANGE ( s_row,s_col,f_row,f_col : INTEGER; draw : BOOLEAN );
FORWARD;
PROCEDURE CLEAR_WORKSHEET;
FORWARD;
PROCEDURE SIMULATE_MESSAGE ( msg_type,three,four : INTEGER );
FORWARD;
PROCEDURE HOME_CURSOR ( extent : HomeType );
FORWARD;
PROCEDURE MY_LINE_STYLE ( style : INTEGER );
FORWARD;
PROCEDURE SWITCH_WINDOW;
FORWARD;
PROCEDURE DEP_RECALC ( dep : DepPtr );
FORWARD;
PROCEDURE CLEAR_BUFFER;
FORWARD;
FUNCTION FIND_FIRST_AND_LAST ( virtual_or_actual : BOOLEAN ) : BOOLEAN;
FORWARD;
PROCEDURE BLOCK_TOO_BIG ( col,row : STR10 );
FORWARD;
PROCEDURE HIDE;
FORWARD;
PROCEDURE UNHIDE ( menu : Tree_Index );
FORWARD;
FUNCTION MOUSE_ROW_COL ( mouse_x,mouse_y : INTEGER;
VAR new_row,new_col : INTEGER ) : BOOLEAN;
{ gives the data[x,y] positions of the cell encompassing the area
containing the coordinates mouse,x,mouse_y; returns true if within a
cell. passes back data[x,y] in new_row,new_col. Used by OPUS.PAS and
window_input }
VAR i,j : INTEGER;
row_ok,col_ok : BOOLEAN;
BEGIN
row_ok := FALSE;
col_ok := FALSE;
j := y_1+y_margin;
i := start_row;
WHILE i <= finish_row DO BEGIN
IF (mouse_y > j) AND
(mouse_y < j+cell_height) THEN BEGIN
new_row := i;
row_ok := TRUE;
i := finish_row
END;
j := j+cell_height;
i := i+1
END;
j := 1;
i := start_col;
WHILE i <= finish_col DO BEGIN
IF (mouse_x > vert_grid[j]+4) AND
(mouse_x < vert_grid[j+1]-4) THEN BEGIN
new_col := i;
col_ok := TRUE;
i := finish_col
END;
j := j+1;
i := i+1
END;
IF (row_ok) AND (col_ok) THEN
mouse_row_col := TRUE
ELSE
mouse_row_col := FALSE
END; { MOUSE_ROW_COL }
(*************************************************)
(* Functions to manipulate main data structure *)
(*************************************************)
FUNCTION REQUEST_MEMORY;
VAR resulting_free_mem : LONG_INTEGER;
BEGIN
IF what = ACell THEN
resulting_free_mem := working_memory-cell_size
ELSE
resulting_free_mem := working_memory-str_size;
IF resulting_free_mem < 0 THEN BEGIN
alert := Do_Alert (
'[1][Running out of memory.|Request denied...][ OK ]',1 );
request_memory := FALSE
END
ELSE BEGIN
working_memory := resulting_free_mem;
request_memory := TRUE
END
END; { REQUEST_MEMORY }
FUNCTION LOCATE_CELL;
{ searches for a cell in a given row; if it exists, returns the address,
otherwise returns NIL }
VAR found,passed : BOOLEAN;
ptr : CellPtr;
BEGIN
ptr := data[row];
found := FALSE;
passed := FALSE;
WHILE (ptr <> NIL) AND (NOT found) AND (NOT passed) DO
IF ptr^.c = col THEN
found := TRUE
ELSE IF ptr^.c > col THEN
passed := TRUE
ELSE
ptr := ptr^.next;
IF found THEN
locate_cell := ptr
ELSE
locate_cell := NIL
END; { LOCATE_CELL }
PROCEDURE INIT_CELL;
{ called by NEW_CELL; does NOT handle adjustment of pointers }
BEGIN
WITH what^ DO BEGIN
c := col;
class := Val;
num := 0;
format := default_format;
status := Empty;
str := NIL;
sub := NIL;
next := NIL
END
END; { INIT_CELL }
FUNCTION NEW_CELL;
{ creates a new cell or if the cell already exists, returns the address. If
not enough mem, returns NIL }
VAR found : BOOLEAN;
dumbo,temp,ptr : CellPtr;
BEGIN
ptr := locate_cell(row,col);
IF ptr = NIL THEN
IF request_memory(ACell) THEN BEGIN
ptr := data[row];
found := FALSE;
IF ptr <> NIL THEN
IF ptr^.c > col THEN BEGIN
NEW(dumbo);
init_cell(dumbo,row,col);
data[row] := dumbo;
data[row]^.next := ptr;
new_cell := dumbo
END
ELSE BEGIN
WHILE (ptr^.next <> NIL) AND (NOT found) DO
IF ptr^.next^.c > col THEN
found := TRUE
ELSE
ptr := ptr^.next;
temp := ptr^.next; { save cell addr to follow new one or NIL }
NEW(dumbo);
init_cell(dumbo,row,col);
ptr^.next := dumbo;
new_cell := dumbo;
ptr^.next^.next := temp
END
ELSE BEGIN
NEW(data[row]);
new_cell := data[row];
init_cell(data[row],row,col)
END
END
ELSE
new_cell := NIL
ELSE
new_cell := ptr
END; { NEW_CELL }
PROCEDURE DELETE_CELL;
{ removes a cell from the sheet; i.e. a list. However, if the cell has
dependents, the cell won't be deallocated unless total_kil = TRUE or if
it already has a NIL dep list }
VAR i : INTEGER;
found : BOOLEAN;
dep : DepPtr;
ptr,temp : CellPtr;
BEGIN
found := FALSE;
ptr := locate_cell(row,col);
IF ptr <> NIL THEN
all_lists(remove,ptr,row,col);
{ now, all_lists may have removed a cell in front of and
directly pointing to this cell; this can happen if in the
cell to have its dep list modified, it turned out that
sub = NIL and status = Empty. Thus, ptr^.next no longer
points to OUR cell, since "ptr" is no longer defined. So, do the
all_lists call first. }
ptr := data[row];
IF ptr <> NIL THEN BEGIN
IF ptr^.c <> col THEN BEGIN
WHILE (ptr^.next <> NIL) AND (NOT found) DO
IF ptr^.next^.c = col THEN
found := TRUE
ELSE
ptr := ptr^.next;
{ ptr^.next will represent the desired cell, if found, and
of course will be non-NIL }
IF found THEN BEGIN
IF ptr^.next^.str <> NIL THEN BEGIN
DISPOSE(ptr^.next^.str);
ptr^.next^.str := NIL;
working_memory := working_memory+str_size
END;
IF total_kill THEN { so only destroy dep list if }
free_dep_list(ptr^.next); { clearing wks }
IF ptr^.next^.sub = NIL THEN BEGIN { no point in keeping the }
working_memory := working_memory+cell_size; { cell around }
temp := ptr^.next^.next;
DISPOSE(ptr^.next);
ptr^.next := temp
END
ELSE
ptr^.next^.status := Empty
END { IF found }
END { IF ptr^.c <> col }
ELSE BEGIN { first cell in list }
found := TRUE;
IF ptr^.str <> NIL THEN BEGIN
DISPOSE(ptr^.str);
ptr^.str := NIL;
working_memory := working_memory+str_size
END;
IF total_kill THEN
free_dep_list(ptr);
IF ptr^.sub = NIL THEN BEGIN
working_memory := working_memory+cell_size;
temp := ptr^.next;
DISPOSE(ptr);
data[row] := temp
END
ELSE
ptr^.status := Empty
END { ELSE from IF found }
END
END; { DELETE_CELL }
FUNCTION ASSIGNED;
{ if found, returns address in ptr or NIL }
BEGIN
ptr := locate_cell(row,col);
IF ptr <> NIL THEN
WITH ptr^ DO
IF status = Empty THEN
assigned := Desolate
ELSE IF status <> Full THEN
assigned := Error
ELSE IF (class = Val) OR (class = Expr) THEN
assigned := Value
ELSE
assigned := NonValue
ELSE
assigned := Void
END; { ASSIGNED }
PROCEDURE MASK_OUT_RECALC;
VAR i : INTEGER;
BEGIN
IF did_recalc THEN BEGIN
FOR i := 1 TO n_rows DO BEGIN
ptr := data[i];
WHILE ptr <> NIL DO BEGIN
IF ptr^.class = Expr THEN
ptr^.format := ptr^.format & no_recalc_mask &
not_pending_mask;
ptr := ptr^.next
END
END;
did_recalc := FALSE
END
END; { MASK_OUT_RECALC }
PROCEDURE DEP_RECALC;
VAR ptr : CellPtr;
BEGIN
IF dep <> NIL THEN BEGIN
did_recalc := TRUE;
WHILE dep <> NIL DO BEGIN
ptr := locate_cell(dep^.r,dep^.c);
IF ptr <> NIL THEN
IF (ptr^.class = Expr) AND
(ptr^.format & recalc_mask = 0) AND
(ptr^.format & pending_mask = 0) THEN
evaluate_formula(dep^.r,dep^.c,FALSE,FALSE,ptr);
dep := dep^.next
END
END
END; { DEP_RECALC }
FUNCTION ASSIGN;
VAR number : REAL;
changed,failed : BOOLEAN;
old_status : StatusType;
ptr : CellPtr;
PROCEDURE CAPITALIZE_AND_EAT_UP_SPACES ( VAR temp : LorFstr );
VAR i : INTEGER;
BEGIN
i := 1;
WHILE i <= LENGTH(temp) DO BEGIN
IF temp[i] = ' ' THEN
DELETE(temp,i,1)
ELSE IF temp[i] IN low_case THEN BEGIN
temp[i] := CHR(ORD(temp[i])-$20);
i := i+1
END
ELSE
i := i+1
END
END; { CAPITALIZE_AND_EAT_UP_SPACES }
BEGIN
Set_Mouse(M_Bee);
changed := FALSE;
ptr := locate_cell(data_row,data_col);
all_lists(remove,ptr,data_row,data_col);
ptr := new_cell(data_row,data_col);
IF ptr <> NIL THEN
WITH ptr^ DO BEGIN
CASE class OF
Val : BEGIN
old_status := status;
number := string_to_real(temp);
IF format & perc_mask <> 0 THEN
number := number/100;
IF temp = 'OVERFLOW' THEN
IF status <> Overflow THEN BEGIN
changed := TRUE;
status := Overflow
END
ELSE
ELSE BEGIN
status := Full;
IF ((num <> number) OR
(old_status <> status)) THEN BEGIN
num := number;
changed := TRUE
END
END;
IF (auto_recalc) AND (changed) THEN
dep_recalc(sub)
END; { Val }
Labl : BEGIN
IF str = NIL THEN
IF request_memory(AString) THEN
NEW (str)
ELSE
status := GenError;
IF status <> GenError THEN BEGIN
str^ := temp;
status := Full
END
END; { Labl }
Expr : BEGIN
failed := FALSE;
IF str = NIL THEN
IF request_memory(AString) THEN
NEW (str)
ELSE BEGIN
status := GenError;
failed := TRUE
END;
IF NOT failed THEN BEGIN
capitalize_and_eat_up_spaces(temp);
IF ptr <> NIL THEN BEGIN
str^ := temp;
{ evaluate_formula will recalc dependents if
appropriate }
REPEAT { user can edit errors in a dialog box }
mask_out_recalc; { in case we're doing again }
did_recalc := TRUE;
old_form := str^; { eval uses global temp }
evaluate_formula(data_row,data_col,FALSE,TRUE,ptr);
capitalize_and_eat_up_spaces(str^);
UNTIL (str^ = old_form) OR (str^ = '');
all_lists(add,ptr,data_row,data_col)
END
END
END { Expr }
END (* CASE *)
END; (* WITH *)
Set_Mouse(M_Arrow);
assign := ptr
END; (* ASSIGN *)
FUNCTION SIZE;
VAR cell_mem : INTEGER;
dep : DepPtr;
ptr : CellPtr;
BEGIN
cell_mem := 0;
IF assigned(row,col,ptr) <> Void THEN BEGIN
cell_mem := cell_size;
WITH ptr^ DO BEGIN
IF str <> NIL THEN
cell_mem := cell_mem+str_size;
dep := sub;
WHILE dep <> NIL DO BEGIN
cell_mem := cell_mem+dep_size;
dep := dep^.next
END
END
END;
size := cell_mem
END; { SIZE }
FUNCTION COMP_ASSIGN;
{ COMPrehensive ASSIGNment between two CELLs; builds dep lists of other
cells if build is TRUE; note that the dest cell's dep lists will not
be affected if it already exists }
VAR src_ptr,dest_ptr : CellPtr;
dep : DepPtr;
BEGIN
comp_assign := TRUE;
delete_cell(dest_row,dest_col,FALSE);
IF assigned(src_row,src_col,src_ptr) <> Void THEN BEGIN
dest_ptr := new_cell(dest_row,dest_col);
IF dest_ptr <> NIL THEN BEGIN
WITH src_ptr^ DO BEGIN
dest_ptr^.class := class;
dest_ptr^.num := num;
dest_ptr^.status := status;
dest_ptr^.format := format
END;
IF src_ptr^.str <> NIL THEN
IF request_memory(AString) THEN BEGIN
NEW(dest_ptr^.str);
dest_ptr^.str^ := src_ptr^.str^;
IF build THEN
all_lists(add,dest_ptr,dest_row,dest_col)
END
ELSE BEGIN
comp_assign := FALSE;
dest_ptr^.status := GenError
END
ELSE
END
ELSE { not enough memory }
comp_assign := FALSE
END
END; { COMP_ASSIGN }
(********************************************************)
(* End of Functions to manipulate main data structure *)
(********************************************************)
(************************************)
(* Dependent-cell list manipulation *)
(************************************)
PROCEDURE FREE_DEP_LIST;
VAR temp : DepPtr;
BEGIN
IF ptr <> NIL THEN
WHILE ptr^.sub <> NIL DO BEGIN
temp := ptr^.sub^.next;
DISPOSE(ptr^.sub);
ptr^.sub := temp;
working_memory := working_memory+dep_size
END
END; { FREE_DEP_LIST }
FUNCTION LIST_END;
{ returns a POINTER to the element at the end of the list; i.e. the
element whose next points to the last one }
VAR dep : DepPtr;
BEGIN
IF ptr <> NIL THEN BEGIN
dep := ptr^.sub;
IF dep <> NIL THEN
WHILE dep^.next <> NIL DO
dep := dep^.next;
list_end := dep
END
ELSE
list_end := NIL
END; { LIST_END }
FUNCTION DUPLICATING;
{ traverses a cell's dependency list and locates any pre-existing entries }
{ for the cell to be added to the list, i.e. prevents duplicates }
VAR
found : BOOLEAN;
dep : DepPtr;
BEGIN
found := FALSE;
dep := ptr^.sub;
WHILE (dep <> NIL) AND (NOT found) DO
IF (dep^.r = dep_row) AND (dep^.c = dep_col) THEN
found := TRUE
ELSE
dep := dep^.next;
duplicating := found
END; { DUPLICATING }
PROCEDURE LIST_INSERT;
{ inserts an element at the end of the list for the cell fx_row,fx_col;
'fx' = 'affects' a dependent cell dep_row,dep_col }
VAR dep : DepPtr;
fx_ptr,dep_ptr : CellPtr;
BEGIN
fx_ptr := new_cell(fx_row,fx_col);
dep_ptr := locate_cell(dep_row,dep_col);
IF (fx_ptr <> NIL) AND (dep_ptr <> NIL) THEN
IF NOT duplicating(dep_row,dep_col,fx_ptr) THEN
IF working_memory-dep_size > 0 THEN BEGIN
IF fx_ptr^.sub = NIL THEN BEGIN
NEW(fx_ptr^.sub);
fx_ptr^.sub^.next := NIL
END
ELSE BEGIN
dep := list_end(fx_ptr);
NEW(dep^.next);
dep^.next^.next := NIL
END;
dep := list_end(fx_ptr);
dep^.r := dep_row;
dep^.c := dep_col;
working_memory := working_memory-dep_size
END
ELSE
alert := Do_Alert (
'[1][Running out of memory.|Request denied...][ OK ]',1)
END; { LIST_INSERT }
PROCEDURE LIST_DELETE;
VAR found : BOOLEAN;
dep,temp : DepPtr;
ptr : CellPtr;
BEGIN
ptr := locate_cell(fx_row,fx_col);
IF ptr <> NIL THEN BEGIN
dep := ptr^.sub;
IF dep <> NIL THEN
IF (dep^.r <> dep_row) OR (dep^.c <> dep_col) THEN BEGIN
found := FALSE;
WHILE (NOT found) AND (dep^.next <> NIL) DO
IF (dep^.next^.r = dep_row) AND
(dep^.next^.c = dep_col) THEN
found := TRUE
ELSE
dep := dep^.next;
IF found THEN BEGIN
temp := dep^.next^.next;
DISPOSE(dep^.next);
dep^.next := temp;
working_memory := working_memory+dep_size
END
END
ELSE BEGIN { was first element in list }
temp := dep^.next;
DISPOSE(dep);
ptr^.sub := temp;
working_memory := working_memory+dep_size
END
END
END; { LIST_DELETE }
PROCEDURE ALL_LISTS;
{ adds/removes all references to this cell to/from the dependency
lists of each cell that should/already has an entry for it. Action
equals: 'add', 'remove' }
VAR dummy : INTEGER;
result : StatusType;
BEGIN
IF ptr <> NIL THEN
IF ptr^.class = Expr THEN
IF ptr^.str <> NIL THEN
result := adjust_expr(action,ptr,
row,col,
dummy,dummy,dummy,dummy,dummy,dummy)
END; { ALL_LISTS }
(*******************************************)
(* End of Dependent-cell list manipulation *)
(*******************************************)
(************************)
(* Screen-related stuff *)
(************************)
PROCEDURE FIND_SCREEN_POS;
{ takes sheet pos in row,col and returns screen pos;
called by MOUSE,draw_cell,display_data,reset_window }
VAR i : INTEGER;
BEGIN
l_scr_row := 1;
l_scr_col := 1;
i := start_row;
REPEAT
IF i < row THEN
l_scr_row := l_scr_row+1;
i := i+1
UNTIL i >= row;
i := start_col;
REPEAT
IF i < col THEN
l_scr_col := l_scr_col+1;
i := i+1
UNTIL i >= col
END; { FIND_SCREEN_POS }
PROCEDURE SAVE_ATTR;
BEGIN
w_pos[w_idx,w_hdl] := act_hdl;
w_pos[w_idx,first_row] := start_row;
w_pos[w_idx,last_row] := finish_row;
w_pos[w_idx,first_col] := start_col;
w_pos[w_idx,last_col] := finish_col;
w_pos[w_idx,hot_row] := data_row;
w_pos[w_idx,hot_col] := data_col;
w_vert_grid[w_idx] := vert_grid
END; { SAVE_ATTR }
PROCEDURE RETURN_ATTR;
BEGIN
act_hdl := w_pos[w_idx,w_hdl];
start_row := w_pos[w_idx,first_row];
finish_row := w_pos[w_idx,last_row];
start_col := w_pos[w_idx,first_col];
finish_col := w_pos[w_idx,last_col];
data_row := w_pos[w_idx,hot_row];
data_col := w_pos[w_idx,hot_col];
vert_grid := w_vert_grid[w_idx];
h_entry := finish_col-start_col+1;
v_entry := finish_row-start_row+1;
IF finish_col < n_cols THEN BEGIN
virtual_f_col := finish_col+1;
virtual_h_entry := h_entry+1
END
ELSE BEGIN
virtual_f_col := finish_col;
virtual_h_entry := h_entry
END;
IF finish_row < n_rows THEN BEGIN
virtual_f_row := finish_row+1;
virtual_v_entry := v_entry+1
END
ELSE BEGIN
virtual_f_row := finish_row;
virtual_v_entry := v_entry
END;
find_screen_pos(data_row,data_col,scr_row,scr_col)
END; { RETURN_ATTR }
PROCEDURE SWITCH_WINDOW;
BEGIN
save_attr;
w_idx := ABS(w_idx-3);
return_attr
END; { SWITCH_WINDOW }
PROCEDURE CELL_ON_SCREEN;
{ update a cell; if two windows are open and cell is visible in both, it
will be updated in both. }
VAR a1,a2,b1,b2,c1,c2,d1,d2 : INTEGER;
BEGIN
IF n_hdls = 2 THEN BEGIN
Border_Rect(w_pos[1,w_hdl],a1,b1,c1,d1);
Border_Rect(w_pos[2,w_hdl],a2,b2,c2,d2);
IF NOT Rect_Intersect( a1,b1,c1,d1,a2,b2,c2,d2) THEN BEGIN
switch_window;
IF (row >= start_row) AND (row <= virtual_f_row) AND
(col >= start_col) AND (col <= virtual_f_col) THEN BEGIN
Hide_Mouse;
IF draw_or_toggle = 1 THEN { completely draw the cell; }
draw_cell(row,col,TRUE) { avoid draw_cell inversing it }
ELSE BEGIN { as it would if FALSE was passed. }
Work_Rect(act_hdl,x_1,y_1,w_1,h_1); { since toggle does }
Set_Clip(x_1,y_1,w_1,h_1); { NOT affect clip }
toggle_inverse(Black,row,col)
END;
Show_Mouse
END;
switch_window;
Work_Rect(act_hdl,x_1,y_1,w_1,h_1); { just in case toggle was }
Set_Clip(x_1,y_1,w_1,h_1) { used; antibug... }
END
ELSE BEGIN { completely redraw the portion(s) of the inactive }
{ window using the GEM message queue to make sure }
switch_window; { we get the proper clip values }
IF (row >= start_row) AND (row <= virtual_f_row) AND
(col >= start_col) AND (col <= virtual_f_col) THEN BEGIN
First_Rect(act_hdl,a1,b1,c1,d1);
WHILE (c1 <> 0) AND (d1 <> 0) DO BEGIN
Send_Redraw(FALSE,a1,b1,c1,d1);
Next_Rect(act_hdl,a1,b1,c1,d1)
END
END;
switch_window
END
END;
{ now do active window }
IF (row >= start_row) AND (row <= virtual_f_row) AND
(col >= start_col) AND (col <= virtual_f_col) THEN BEGIN
Hide_Mouse;
IF draw_or_toggle = 1 THEN
draw_cell(row,col,force)
ELSE
toggle_inverse(Black,row,col);
Show_Mouse
END
END; { CELL_ON_SCREEN }
PROCEDURE DEFAULT_DRAW_ATTRIBUTES;
BEGIN
Paint_Style(Solid);
Paint_Outline(FALSE);
Paint_Color(White);
Text_Color(Black);
Draw_Mode(Replace_Mode);
Text_Style(Normal)
END; { DEFAULT_DRAW_ATTRIBUTES }
PROCEDURE REDRAW_MESSAGE;
VAR
other_window : BOOLEAN;
BEGIN
default_draw_attributes;
First_Rect(hdl,redraw_x,redraw_y,redraw_w,redraw_h);
WHILE (redraw_w <> 0) AND (redraw_h <> 0) DO BEGIN
IF Rect_Intersect(x,y,w,h,
redraw_x,redraw_y,
redraw_w,redraw_h) THEN BEGIN
other_window := FALSE;
IF hdl <> act_hdl THEN BEGIN
switch_window;
other_window := TRUE
END;
redraw_flag := TRUE; { confine sheet_redraw clip rect }
{ draw whole sheet, but within bounds of redraw_x, etc.}
sheet_redraw(WholeSheet,FALSE,None); { it saves attr }
IF other_window THEN
switch_window
END;
Next_Rect(hdl,redraw_x,redraw_y,redraw_w,redraw_h)
END
END; { REDRAW_MESSAGE }
PROCEDURE Send_Redraw;
{ write a redraw message to the event queue after displaying fsel so
that after LOAD, we can redraw the entire screen, instead of first
redrawing the area covered by the fsel then doing a full redraw of the
screen. The AES merges the two messages into one. Also, used to send
the message to redraw the area covered by the 'action indicator'
which show whether a file is to be loaded, saved, etc. The AES always
merges this redraw w/ the one generated by fsel. }
BEGIN
msg[0] := WM_Redraw;
msg[1] := ap_id;
msg[2] := 0;
msg[3] := act_hdl;
msg[4] := x;
msg[5] := y;
msg[6] := w;
msg[7] := h;
Write_Message(ap_id,16,msg);
IF all_windows THEN
IF n_hdls = 2 THEN BEGIN
IF act_hdl = w_pos[1,w_hdl] THEN
msg[3] := w_pos[2,w_hdl]
ELSE
msg[3] := w_pos[1,w_hdl];
Write_Message(ap_id,16,msg)
END
END; { Send_Redraw }
PROCEDURE HOME_CURSOR;
{ note that home to row,col = 1,1 requires a redraw unless 1,1 is on
screen- in that case should use both, not origin. Use of both,r,s implies
that the cell to be moved to already resides on the screen }
BEGIN
IF extent = Origin THEN BEGIN
data_row := logical_row_1;
data_col := logical_col_1;
start_row := data_row;
start_col := data_col
END;
IF (extent = R) OR (extent = Both) THEN BEGIN
data_row := start_row;
scr_row := 1
END;
IF (extent = C) OR (extent = Both) THEN BEGIN
data_col := start_col;
scr_col := 1
END
END; { HOME_CURSOR }
PROCEDURE MY_LINE_STYLE;
{ uses VDI calls for a custom line style; looks better than the 6 default
patterns provided by VDI; dots are closer together for the vertical
line }
BEGIN
Create_User_Line_Type(style);
User_Line_Style { like Pasgem Line_Type }
END; { MY_LINE_STYLE }
(*******************************)
(* End of Screen-related stuff *)
(*******************************)
PROCEDURE STRING_A_CELL;
{ take a row and col and convert them to a cell; i.e. 5,2 => B5 }
BEGIN
int_to_string(row,temp);
temp := CONCAT(col_name[col],temp)
END; { STRING_A_CELL }
PROCEDURE OUT_MEM_CELL;
BEGIN
string_a_cell(row,col,temp);
temp := CONCAT('[1][Out of memory in cell ' , temp , ',|' ,
'which was NOT ' , specific , '.]' ,
'[ OK ]' );
alert := Do_Alert(temp,1)
END; { OUT_MEM_CELL }
FUNCTION REL_OVERFLOW;
{ called by perform_2 in adjust_expr }
BEGIN
string_a_cell(row,col,temp);
temp := CONCAT('[1][A relative cell reference|' ,
'caused a boundary overflow|' ,
'to occur upon incrementing|' ,
'a reference in cell ', what ,
'.][Cancel|Continue]');
Set_Mouse(M_Arrow);
rel_overflow := Do_Alert(temp,2);
{ restore mouse to bee since the caller had it set to bee }
Set_Mouse(M_Bee);
END; { REL_OVERFLOW }
(***********************)
(* Real number parsing *)
(***********************)
PROCEDURE STRIP_NUM;
{ strips a REAL from a string; str_pos = position just after last char in
number, when done. Called by factor in evalexpr, and also by
scan_for_cells }
VAR original_pos,e_pos : INTEGER;
n_chr : CHAR;
e_found,e_sign,done : BOOLEAN;
BEGIN
e_found := FALSE;
e_sign := FALSE;
done := FALSE;
original_pos := str_pos;
num_str := '';
WHILE (str_pos <= len) AND (NOT done) DO BEGIN
n_chr := str[str_pos];
IF n_chr IN float THEN BEGIN
IF (n_chr = 'E') OR (n_chr = 'e') THEN BEGIN
e_pos := str_pos;
e_found := TRUE;
END;
IF (n_chr = '+') OR (n_chr = '-') THEN
IF NOT e_sign THEN
IF str_pos > original_pos THEN { either exponent sign or }
IF e_found THEN { delimiter }
IF str_pos-1 = e_pos THEN
e_sign := TRUE
ELSE
done := TRUE
ELSE
done := TRUE
ELSE { just the sign of the number }
ELSE { must have been a delimiter }
done := TRUE;
IF NOT done THEN BEGIN
num_str := CONCAT(num_str,n_chr);
str_pos := str_pos+1;
END;
END
ELSE
done := TRUE
END { WHILE }
END; { STRIP_NUM }
FUNCTION VALID_NUMBER;
{ sees if num_str is a valid number for real_to_string; rules
out ALL potential errors, including E3, 1.2.3E4-3, 1.23e3-2, etc.
called by window_input, parser. }
VAR n_pos,num_sign_pos,exp_sign_pos,
dec_pos,e_pos,i,len_num_str : INTEGER;
n_chr : CHAR;
ok_num : StatusType;
BEGIN
ok_num := OK;
n_pos := 1;
num_sign_pos := 0;
exp_sign_pos := 0;
dec_pos := 0;
e_pos := 0;
len_num_str := LENGTH(num_str);
IF len_num_str = 0 THEN
ok_num := BadReal
ELSE
WHILE (n_pos <= len_num_str) AND (ok_num = OK) DO BEGIN
n_chr := num_str[n_pos];
IF NOT (n_chr IN float) THEN
ok_num := BadReal
ELSE BEGIN
(* good and bad e or E *)
IF ( n_chr='E' ) OR ( n_chr='e' ) THEN
IF e_pos = 0 THEN
IF n_pos > 1 THEN
IF ( { account for -e & -E }
(n_pos = 2) AND (NOT(num_str[1] IN digits))
) OR
(n_pos = len_num_str) THEN
ok_num := BadReal
ELSE
e_pos := n_pos
{ account for e12 & E123 }
ELSE
ok_num := BadReal
{ > 1 e's }
ELSE
ok_num := BadReal;
(* good and bad sign, for both number and exponent *)
IF (n_chr = '+') OR (n_chr = '-') THEN
IF n_pos = 1 THEN { sign of number }
IF num_sign_pos = 0 THEN
IF len_num_str > 1 THEN
{ really a pointless assignment, since nothing
else depends on this; it does clarify and
keep the routine consistent by documenting
this, however }
num_sign_pos := n_pos
ELSE
ok_num := BadReal
ELSE { no other possibility }
ELSE IF n_pos = len_num_str THEN
ok_num := BadReal
ELSE IF e_pos = 0 THEN
ok_num := BadReal
ELSE IF exp_sign_pos = 0 THEN
IF (
(POS('E',num_str)=n_pos-1) OR
(POS('e',num_str)=n_pos-1)
) THEN
exp_sign_pos := n_pos
ELSE
ok_num := BadReal
ELSE
ok_num := BadReal;
(* good & bad decimal *)
IF n_chr = '.' THEN
IF (dec_pos = 0) AND (e_pos = 0) THEN
IF n_pos = len_num_str THEN
ok_num := BadReal
ELSE IF NOT (num_str[n_pos+1] IN digits) THEN
ok_num := BadReal
ELSE
dec_pos := n_pos
ELSE
ok_num := BadReal;
n_pos := n_pos+1;
END; { ELSE }
END; { WHILE }
valid_number := ok_num;
END; (* VALID_NUMBER *)
(******************************)
(* End of Real number parsing *)
(******************************)
(****************)
(* Cell Parsing *)
(****************)
FUNCTION VALID_COL_NAME;
{ column name = A,B,...,Z,AA,BB,AB,ID, etc. depending on n_cols }
VAR first,second,sum : INTEGER;
BEGIN
valid_col_name := FALSE;
sum := 0;
IF LENGTH(temp) > 0 THEN BEGIN
first := ORD(temp[1])-64;
IF LENGTH(temp) > 1 THEN
IF temp[2] IN up_case THEN BEGIN
second := ORD(temp[2])-64;
sum := first*26+second
END
ELSE
sum := first
ELSE
sum := first
END;
IF (sum > 0) AND (sum <= n_cols) THEN
IF col_name[sum] = temp THEN
valid_col_name := TRUE;
col_number := sum { meaningless if valid_col_name set to false }
END; { VALID_COL_NAME }
PROCEDURE GET_COL;
VAR column : STR10;
at_end : BOOLEAN;
BEGIN
IF str[str_pos] = '$' THEN BEGIN
col_rel := FALSE;
str_pos := str_pos+1
END
ELSE
col_rel := TRUE;
IF str_pos >= len THEN
status := BadRef
ELSE BEGIN
column := '';
at_end := FALSE;
WHILE (NOT at_end) AND (status <> BadRef) DO BEGIN
IF str[str_pos] IN up_case THEN BEGIN
column := CONCAT(column,str[str_pos]);
str_pos := str_pos+1;
IF LENGTH(column) > 2 THEN
status := BadRef
END
ELSE
at_end := TRUE;
IF str_pos > len THEN
status := BadRef
END;
IF status = OK THEN
IF NOT valid_col_name(column,col) THEN
status := BadRef
END
END; { GET_COL }
PROCEDURE GET_ROW;
VAR i,multiplier : INTEGER;
row_str : STR10;
at_end : BOOLEAN;
BEGIN
IF str[str_pos] = '$' THEN BEGIN
row_rel := FALSE;
str_pos := str_pos+1
END
ELSE
row_rel := TRUE;
IF str_pos > len THEN
status := BadRef
ELSE BEGIN
row_str := '';
at_end := FALSE;
WHILE (status <> BadRef) AND (NOT at_end) DO BEGIN
IF str[str_pos] IN digits THEN BEGIN
row_str := CONCAT(row_str,str[str_pos]);
str_pos := str_pos+1;
IF LENGTH(row_str) > 3 THEN
status := BadRef
END
ELSE
at_end := TRUE;
IF str_pos > len THEN
at_end := TRUE
END;
IF LENGTH(row_str) = 0 THEN
status := BadRef;
IF status = OK THEN BEGIN
multiplier := 1;
row := 0;
FOR i := LENGTH(row_str) DOWNTO 1 DO BEGIN
row := row+(ORD(row_str[i])-$30)*multiplier;
multiplier := multiplier*10
END
END
END { ELSE }
END; { GET_ROW }
FUNCTION TRANSLATE_CELL;
{ A1 => 1,1; Expects the starting position of the tentative cell ref and the
length of the string it appears in.
After the call, if no error was found, str_pos will
equal the position immediately following the cell reference, and
returns OK; otherwise, returns an error message }
VAR status : StatusType;
BEGIN
IF len < 2 THEN
translate_cell := BadRef
ELSE BEGIN
status := OK;
get_col(str,str_pos,len,col,col_rel,status);
IF status = OK THEN
get_row(str,str_pos,len,row,row_rel,status);
IF status = OK THEN
IF (col < 1) OR (col > n_cols) OR
(row < 1) OR (row > n_rows) THEN
status := OutOfRange;
translate_cell := status
END
END; { TRANSLATE_CELL }
(***********************)
(* End of Cell Parsing *)
(***********************)
(********************************)
(* Expression-specific routines *)
(********************************)
FUNCTION SCAN_FOR_CELLS;
{ scans a string for cells, beginning at str_pos; returns the
position immediately FOLLOWING the ref. Further error checking
by translate_cell is performed. Note str_pos is also modified
by translate_cell so that it equals the position following the
cell ref. To scan for all cell in a string, the caller must call
this function until str_pos = len. If an error, str_pos may equal
len+1, depending on where the error occurred. Also when no cell
is found. The cell's position is returned in cell_pos }
VAR found_status : BOOLEAN;
dummy : LorFstr;
BEGIN
found_status := FALSE;
WHILE (str_pos < len) AND (NOT found_status) DO
IF str[str_pos] IN up_case THEN
IF str[str_pos+1] IN digits+['$'] THEN BEGIN
found_status := TRUE;
cell_pos := str_pos
END
ELSE IF str_pos+1 < len THEN
IF (str[str_pos+1] IN up_case) AND
(str[str_pos+2] IN digits+['$']) THEN BEGIN
found_status := TRUE;
cell_pos := str_pos
END
ELSE
REPEAT
str_pos := str_pos+1
UNTIL (NOT (str[str_pos] IN up_case)) OR (str_pos = len)
ELSE { must have been a keyword; skip remaining caps so }
REPEAT { that SERR, CORR won't be considered a cell. Note }
str_pos := str_pos+1
UNTIL (NOT (str[str_pos] IN up_case)) OR (str_pos = len)
ELSE IF str[str_pos] = '$' THEN BEGIN
found_status := TRUE;
cell_pos := str_pos
END
ELSE IF str[str_pos] IN digits+['.'] THEN { don't care about sign }
strip_num(dummy,str,str_pos,len) { here; what if -E1? }
ELSE
str_pos := str_pos+1;
scan_for_cells := found_status;
IF found_status THEN
IF translate_cell(str,str_pos,len,row,col,row_rel,col_rel)<>OK THEN
scan_for_cells := FALSE { wasn't really a cell }
END; { SCAN_FOR_CELLS }
FUNCTION ADJUST_EXPR;
{ called by adjust_cell_refs for which it scans a string for cell
refs and if appropriate, modifies the string so that these cell
refs reference a different cell ( i.e. a relative adjustment );
src_row..dest_col are significant as are row_st..col_end.
The latter four represent the scope of the
block move; action = adj_cell_refs }
{ called by all_lists for which it scans a string for cell refs
and updates the found cells' dep lists to contain the cell passed
in src_row, src_col; action = add or remove }
{ called by replicate cell for which it scans a string and modifies
the cell refs relatively; src_row..dest_col are meaningful; so we
can use the code of perform_2, need to pass row_st..col_end with
values of 1,n_rows,1,n_cols since we always wish to adjust and must
therefore define a block size equalling the entire sheet;
action = adj_cell_refs }
{ the function returns a value of OK unless it was adjusting cell
refs, a range error occurred, and the user selected 'Cancel' from
the alert box in rel_overflow, in which case it returns OutOfRange }
LABEL 1; { label to go to if an adjusted cell ref is invalid and the
user wants to abort the action }
VAR i,j,s_r,s_c,dummy,cell_pos,
len,str_pos,row,col,adj_r,adj_c : INTEGER;
row_rel,col_rel,abort,do_range : BOOLEAN;
dup_str : LorFstr;
status : StatusType;
dep : DepPtr;
PROCEDURE PERFORM_1 ( row,col : INTEGER );
{ row,col = the cell which appeared as a reference }
VAR ptr : CellPtr;
BEGIN
IF action = add THEN { action inherited from adj_expr }
list_insert(row,col,src_row,src_col)
ELSE BEGIN { action = remove }
list_delete(row,col,src_row,src_col);
ptr := locate_cell(row,col);
IF ptr <> NIL THEN
IF (ptr^.sub = NIL) AND (ptr^.status = Empty) THEN
delete_cell(row,col,FALSE)
END
END; { PERFORM_1 }
PROCEDURE PERFORM_2 ( row,col : INTEGER );
{ row,col = the cell which appeared as a reference }
VAR r,c,offset,cell_len : INTEGER;
temp1,temp2 : STR10;
PROCEDURE ALTER_STR;
BEGIN
string_a_cell(dest_row,dest_col,temp1);
int_to_string(r,temp2);
IF NOT row_rel THEN
temp2 := CONCAT('$',temp2);
temp2 := CONCAT(col_name[c],temp2);
IF NOT col_rel THEN
temp2 := CONCAT('$',temp2);
cell_len := str_pos-cell_pos;
IF len-cell_len+LENGTH(temp2) > string_len THEN BEGIN
temp := CONCAT('[1][Adjusting a relative cell|' ,
'reference in cell ' , temp1 , '|' ,
'caused the formula length to|' ,
'exceed the maximum allowed.]' ,
'[Cancel|Continue]');
ptr^.status := GenError;
IF Do_Alert(temp,2) = 1 THEN BEGIN
adjust_expr := GenError;
ptr^.str^ := dup_str;
cell_on_screen(1,dest_row,dest_col,TRUE);
write_cell_name;
GOTO 1
END
END
ELSE BEGIN
DELETE(ptr^.str^,cell_pos,cell_len);
IF cell_pos > LENGTH(ptr^.str^) THEN { can't insert to pos }
ptr^.str^ := CONCAT(ptr^.str^,temp2) { past end of string }
ELSE
INSERT(temp2,ptr^.str^,cell_pos);
str_pos := cell_pos+LENGTH(temp2) { just in case }
END;
len := LENGTH(ptr^.str^)
END; { ALTER_STR }
BEGIN
IF (row >= row_st) AND (row <= row_end) AND
(col >= col_st) AND (col <= col_end) THEN BEGIN
{ so it's within the realm of the block passed; errors due to
adjusted rel. refs exceeding the sheet bounds need NOT be
checked; they are IMPOSSIBLE***, since:
1. only valid cell refs may appear in formulas;
2. only cell refs falling within the bounds of the block
are adjusted;
3. block moves must have a destination block falling within
the bounds of the sheet.
So, the above really says the following things, using rows as
an example, for a cell ref that will be adjusted:
src_block_start <= row_ref <= src_block_end;
dest_block_start <= dest_row_ref <= dest_block_end
<= n_rows.
***All the above applies to sheet inserts/deletes.
BUT cell REPLICATION
can still generate out-of-bounds cell refs, so must still check
for these errors; easiest just to do for all cases, and
hardly takes any time at all. }
string_a_cell(dest_row,dest_col,temp1); { in case OutOfRange }
IF row_rel THEN BEGIN
offset := src_row-row;
IF (dest_row-offset<1) OR (dest_row-offset>n_rows) THEN BEGIN
ptr^.status := GenError;
IF rel_overflow(dest_row,dest_col,temp1) = 1 THEN BEGIN
adjust_expr := OutOfRange;
ptr^.str^ := dup_str;
cell_on_screen(1,dest_row,dest_col,TRUE);
write_cell_name;
GOTO 1 { hasty exit }
END
ELSE
r := row { no change, continue anyway }
END
ELSE
r := dest_row-offset
END
ELSE
r := row;
IF col_rel THEN BEGIN
offset := src_col-col;
IF (dest_col-offset<1) OR (dest_col-offset>n_cols) THEN BEGIN
ptr^.status := GenError;
IF rel_overflow(dest_row,dest_col,temp1) = 1 THEN BEGIN
adjust_expr := OutOfRange;
ptr^.str^ := dup_str;
cell_on_screen(1,dest_row,dest_col,TRUE);
write_cell_name;
GOTO 1
END
ELSE
c := col
END
ELSE
c := dest_col-offset
END
ELSE
c := col;
IF NOT do_range THEN BEGIN
adj_r := r;
adj_c := c
END
ELSE IF (adj_r > r) OR (adj_c > c) THEN BEGIN
ptr^.status := GenError;
temp := CONCAT('[1][A range reference in cell|' ,
temp1, ' will be altered to|' ,
'prevent an invalid range from|' ,
'being created.][Cancel|Continue]');
IF Do_Alert(temp,2) = 1 THEN BEGIN
adjust_expr := BadRef;
ptr^.str^ := dup_str;
cell_on_screen(1,dest_row,dest_col,TRUE);
write_cell_name;
GOTO 1
END
ELSE BEGIN
r := adj_r;
c := adj_c
END
END;
alter_str
END
ELSE IF NOT do_range THEN BEGIN
adj_r := row;
adj_c := col
END
ELSE IF (adj_r > row) OR (adj_c > col) THEN BEGIN
ptr^.status := GenError;
temp := CONCAT('[1][A range reference in cell|' ,
temp1, ' will be altered to|' ,
'prevent an invalid range from|' ,
'being created.][Cancel|Continue]');
IF Do_Alert(temp,2) = 1 THEN BEGIN
adjust_expr := BadRef;
ptr^.str^ := dup_str;
cell_on_screen(1,dest_row,dest_col,TRUE);
write_cell_name;
GOTO 1
END
ELSE BEGIN
r := adj_r;
c := adj_c;
alter_str
END
END
END; { PERFORM_2 }
PROCEDURE PERFORM ( loc_action,s_row,s_col,e_row,e_col : INTEGER );
VAR i,j : INTEGER;
BEGIN
CASE loc_action OF
add,remove { 1,2 } : perform_1(s_row,s_col);
adj_refs { 3 } : perform_2(s_row,s_col);
4 : IF action = adj_refs THEN { action was inherited }
perform_2(s_row,s_col) { from parent }
ELSE
FOR i := s_row TO e_row DO
FOR j := s_col TO e_col DO
perform_1(i,j)
END
END; { PERFORM }
BEGIN { ADJUST_EXPR }
adjust_expr := OK;
IF ptr <> NIL THEN
IF (ptr^.class = Expr) AND (ptr^.str <> NIL) THEN BEGIN
abort := FALSE;
len := LENGTH(ptr^.str^);
dup_str := ptr^.str^;
str_pos := 1;
WHILE (str_pos < len) AND (NOT abort) DO BEGIN
do_range := FALSE;
IF scan_for_cells(ptr^.str^,str_pos,len,cell_pos,row,col,
row_rel,col_rel) THEN
IF str_pos < len THEN
IF ptr^.str^[str_pos] <> ':' THEN
perform(action,row,col,dummy,dummy)
ELSE BEGIN { a range was referenced }
s_r := row;
s_c := col;
IF action = adj_refs THEN
perform(action,s_r,s_c,dummy,dummy);
str_pos := str_pos+1;
do_range := TRUE;
IF scan_for_cells(ptr^.str^,str_pos,len,cell_pos,
row,col,row_rel,col_rel) THEN
IF action = adj_refs THEN
perform(action,row,col,dummy,dummy)
ELSE
perform(4,s_r,s_c,row,col)
ELSE
abort := TRUE;
END
ELSE
perform(action,row,col,dummy,dummy)
ELSE
abort := TRUE
END { WHILE }
END;
1: END; { ADJUST_EXPR }
(***************************************)
(* End of Expression-specific routines *)
(***************************************)
(***********************)
(* Miscellaneous stuff *)
(***********************)
PROCEDURE ADJUST_MENU;
{ block set or not set }
BEGIN
IF enable THEN BEGIN
Menu_Enable(main_menu,mcopy);
Menu_Enable(main_menu,mmove);
Menu_Enable(main_menu,mdelete);
Menu_Text(main_menu,mfirstc,' Show Block Start cF');
Menu_Text(main_menu,mlastc, ' Show Block End cL')
END
ELSE BEGIN
Menu_Disable(main_menu,mcopy);
Menu_Disable(main_menu,mmove);
Menu_Disable(main_menu,mdelete);
Menu_Text(main_menu,mfirstc,' Show First Cell cF');
Menu_Text(main_menu,mlastc, ' Show Last Cell cL')
END
END; { ADJUST_MENU }
FUNCTION FIND_PREC;
BEGIN
IF ptr <> NIL THEN
find_prec := ptr^.format & prec_mask
ELSE
find_prec := default_format & prec_mask
END; { FIND_PREC }
FUNCTION FIND_JUST;
VAR just : INTEGER;
BEGIN
just := 0;
IF ptr <> NIL THEN
just := ptr^.format & just_mask
ELSE
just := default_format & just_mask;
IF just = 0 THEN
find_just := VDI_Right
ELSE IF just = $0030 THEN
find_just := VDI_Center
ELSE
find_just := VDI_Left
END; { FIND_JUST }
PROCEDURE PREPARE_NUM;
{ converts a number within a cell to a string,
taking into account col_width, precision, etc.
called by draw_cell, display_data, print }
VAR
prec : INTEGER;
number : REAL;
perc_set,dollar_set : BOOLEAN;
BEGIN
IF ptr <> NIL THEN
WITH ptr^ DO
IF ((class = Val) OR (class = Expr)) AND { faster than calling }
(status = Full) THEN BEGIN { assigned, which must }
number := num; { do a locate_cell }
dollar_set := format & dollar_mask <> 0;
perc_set := format & perc_mask <> 0;
IF perc_set THEN
number := number*100;
prec := find_prec(ptr);
IF number <> 0 THEN
IF format & $0008 <> 0 THEN
real_to_string(number,temp,prec,TRUE)
ELSE
real_to_string(number,temp,prec,FALSE)
ELSE
temp := '0';
IF temp[1] = ' ' THEN
DELETE(temp,1,1);
IF dollar_set THEN
IF temp[1] = '-' THEN
INSERT('$',temp,2)
ELSE
temp := CONCAT('$',temp);
IF perc_set THEN
temp := CONCAT(temp,'%')
END
ELSE IF status < OK THEN
temp := error_msg[status]
END; { PREPARE_NUM }
PROCEDURE BLOCK_TOO_BIG;
{ called by load_file when "load_block at cursor position" and by
transport_block }
VAR temp : STR255;
BEGIN
Set_Mouse(M_Arrow);
temp := CONCAT('[3][The block is too large to|' ,
'insert at that position.|' ,
'Required row & col values:|' ,
'Col <= ' , col ,
'|Row <= ' , row , '][ Cancel ]' );
alert := Do_Alert(temp,1)
END; { BLOCK_TOO_BIG }
FUNCTION FIND_FIRST_AND_LAST;
VAR i,
pert_row,
pert_col : INTEGER;
ptr : CellPtr;
BEGIN
marks[5].row := n_rows;
marks[5].col := n_cols;
IF virtual_or_actual THEN BEGIN
pert_row := logical_row_1;
pert_col := logical_col_1;
marks[6].row := logical_row_1;
marks[6].col := logical_col_1
END
ELSE BEGIN
pert_row := 1;
pert_col := 1;
marks[6].row := 1;
marks[6].col := 1
END;
FOR i := pert_row TO n_rows DO BEGIN
ptr := data[i];
WHILE ptr <> NIL DO BEGIN
IF ptr^.c >= pert_col THEN BEGIN
IF i < marks[5].row THEN
marks[5].row := i;
IF ptr^.c < marks[5].col THEN
marks[5].col := ptr^.c;
marks[6].row := i;
IF ptr^.c > marks[6].col THEN
marks[6].col := ptr^.c
END;
ptr := ptr^.next
END
END;
IF (marks[5].row <= marks[6].row) AND
(marks[5].col <= marks[6].col) THEN
find_first_and_last := TRUE
ELSE
find_first_and_last := FALSE
END; { FIND_FIRST_AND_LAST }
PROCEDURE CLEAR_BUFFER;
{ clears out row 0, which is not used for data but rather as a buffer
for block moves and file i/o when "insert block at cursor" was chosen }
VAR ptr : CellPtr;
BEGIN
ptr := data[0];
WHILE ptr <> NIL DO BEGIN
delete_cell(0,ptr^.c,FALSE);
ptr := data[0]
END
END; { CLEAR_BUFFER }
PROCEDURE DELETE_RANGE;
VAR i,col : INTEGER;
ptr : CellPtr;
BEGIN
{ Want to leave the dep list alone if a cell outside the range
accesses a cell inside the range and will exist after the deletes;
that is the in range cell must be alive to have a dep list }
i := s_row;
WHILE i <= f_row DO BEGIN
ptr := data[i];
WHILE ptr <> NIL DO
IF (ptr^.c >= s_col) AND (ptr^.c <= f_col) THEN BEGIN
col := ptr^.c;
delete_cell(i,col,FALSE);
ptr := locate_cell(i,col); { may still be alive }
IF ptr = NIL THEN
ptr := data[i]
ELSE
ptr := ptr^.next;
IF draw THEN
cell_on_screen(1,i,col,TRUE);
END
ELSE
ptr := ptr^.next;
i := i+1
END
END; { DELETE_RANGE }
PROCEDURE CLEAR_WORKSHEET;
VAR i : INTEGER;
BEGIN
{ can NOT use Mark..Release here because apparently these commands
are buggy; may have to use them within same scope. When load_block
at cursor followed by load_file, got > 1 cell being set to the same
address, leading to crashes. Presumably, the 'free pointer space'
list was not properly reinited by the Release, leading to
new_cell returning the same ptr for > 1 cell, in cells in different
rows, in the first col! The following, however, DISPOSEs of each
cell individually, and although slow for large sheets, it *works* }
FOR i := 0 TO n_rows DO
WHILE data[i] <> NIL DO
delete_cell(i,data[i]^.c,TRUE);
working_memory := original_memory; { should not have changed }
block_set := FALSE;
adjust_menu(FALSE);
Send_Redraw(TRUE,0,0,screen_width,screen_height)
END; { CLEAR_WORKSHEET }
PROCEDURE SIMULATE_MESSAGE;
{ fills message_buffer and inits inp_code so the caller may then call
handle_message; valid for MN_Selected, WM_Arrowed, etc. Does NOT write to
GEM's queue }
BEGIN
IF msg_type = MN_Selected THEN
Menu_Hilight(main_menu,three);
msg_area[0] := msg_type;
msg_area[3] := three;
msg_area[4] := four;
handle_message;
redraw_flag := FALSE
END; { SIMULATE_MESSAGE }
PROCEDURE HIDE;
BEGIN
Obj_SetFlags(new_desk_ptr,mathmenu,
Obj_Flags(new_desk_ptr,mathmenu) | Hide_Tree);
Obj_SetFlags(new_desk_ptr,trigmenu,
Obj_Flags(new_desk_ptr,trigmenu) | Hide_Tree);
Obj_SetFlags(new_desk_ptr,statmenu,
Obj_Flags(new_desk_ptr,statmenu) | Hide_Tree);
Obj_SetFlags(new_desk_ptr,finmenu,
Obj_Flags(new_desk_ptr,finmenu) | Hide_Tree);
Obj_SetFlags(new_desk_ptr,boolmenu,
Obj_Flags(new_desk_ptr,boolmenu) | Hide_Tree);
Obj_SetFlags(new_desk_ptr,tabmenu,
Obj_Flags(new_desk_ptr,tabmenu) | Hide_Tree)
END; { HIDE }
PROCEDURE UNHIDE;
BEGIN
Obj_SetFlags(new_desk_ptr,menu,
Obj_Flags(new_desk_ptr,menu) & ~Hide_Tree)
END; { UNHIDE }
(******************************)
(* End of Miscellaneous stuff *)
(******************************)
BEGIN
END.
