{$U30+} PROGRAM Opus; {$I i:\opus.i} {$I i:\GCTV.inc} { global Constants, Types and Variables } {$I i:\gemsubs.def} {$I i:\auxsubs.def} {$I i:\vdi_aes.def} {$I i:\globsubs.def} {$I d:\pascal\opus\xbios.def} {$I d:\pascal\opus\gemdos.def} {$I d:\pascal\opus\graphout.def} {$I d:\pascal\opus\resource.def} {$I d:\pascal\opus\stringfn.def} {$I d:\pascal\opus\bf.def} PROCEDURE HANDLE_MESSAGE; EXTERNAL; PROCEDURE MOUSE ( mx,my : INTEGER ); { allows user to select active cell with mouse; select a range via dragging beginning in the active cell and extending to the end of the rubber box; select an entire row or column by clicking within the row/col title areas } TYPE ScreenAreas = ( DataArea,RowArea,ColArea ); VAR i,j,total,last_width,last_height,x,y,button,key, new_row,new_col,x_pos,y_pos,l_scr_row,l_scr_col, o_mx,o_my,col_separator,new_x,new_y,spec_col, new_width : INTEGER; dummy : BOOLEAN; code : ScreenAreas; BEGIN { MOUSE } Work_Rect(act_hdl,x_1,y_1,w_1,h_1); code := DataArea; { check if user clicked within row/col title areas } IF (mx < x_1+38) AND (mx > x_1) THEN code := RowArea; IF (my < y_1+cell_height-1) AND (my > y_1) THEN code := ColArea; o_mx := mx; o_my := my; IF code <> DataArea THEN BEGIN { outside data area } IF code = RowArea THEN { still check for valid y or x in } mx := vert_grid[1]+10 { mouse_row_col } ELSE my := y_1+y_margin+1; IF mouse_row_col(mx,my,new_row,new_col) THEN BEGIN dummy := deselect_block; { yes, valid x,y pos } IF code = RowArea THEN BEGIN { select all cells in } b_s_row := new_row; { that row } b_e_row := new_row; b_s_col := logical_col_1; b_e_col := n_cols END ELSE BEGIN { select all cells in that column } b_s_row := logical_row_1; b_e_row := n_rows; b_s_col := new_col; b_e_col := new_col END; block_st_set := TRUE; block_end_set := TRUE; block_set := TRUE; adjust_menu(TRUE); { activate block commands } hilight_block END ELSE IF (code = ColArea) AND (o_mx > vert_grid[1]+4) AND (o_mx <= vert_grid[finish_col-start_col+2]+4) THEN BEGIN FOR i := 2 TO finish_col-start_col+2 DO IF (o_mx >= vert_grid[i]-4) AND { bigger limit } (o_mx <= vert_grid[i]+4) THEN BEGIN { than needed } col_separator := i; spec_col := start_col+i-2 END; Set_Mouse(M_Flat_Hand); Drag_Box(vert_grid[col_separator],y_1,0,h_1, vert_grid[col_separator-1]+39,y_1, 200,h_1,new_x,new_y); Set_Mouse(M_Arrow); new_width := (col_width[spec_col,pixels]+ new_x+3-vert_grid[col_separator]) DIV 8; IF new_width <> col_width[spec_col,spaces] THEN BEGIN IF new_width < 5 THEN new_width := 5 ELSE IF new_width > 30 THEN new_width := 30; col_width[spec_col,spaces] := new_width; col_width[spec_col,pixels] := new_width*8; Send_Redraw(TRUE,0,0,screen_width,screen_height) END END ELSE END { code <> DataArea } ELSE { clicked w/in worksheet data area } { must start with a valid mouse location, so...} IF mouse_row_col(mx,my,new_row,new_col) THEN BEGIN { first redraw the cell(s) affected, i.e. old and new } Hide_Mouse; toggle_inverse(Black,data_row,data_col); Show_Mouse; data_row := new_row; data_col := new_col; find_screen_pos(new_row,new_col,scr_row,scr_col); cell_on_screen(1,data_row,data_col,TRUE); write_cell_name; { find the x,y coordinates of the current cell's upper left-hand corner } Work_Rect(act_hdl,x_1,y_1,w_1,h_1); Set_Clip(x_1,y_1,w_1,h_1); x_pos := vert_grid[scr_col]; y_pos := y_1+y_margin+(scr_row-1)*cell_height; event := Get_Event(E_Timer,0,0,0,200,FALSE,0,0,0,0, FALSE,0,0,0,0,msg_area,i,i,i,i,i,i); Graf_MKState(x,y,button,kbd_state); IF button = 1 THEN { started within current cell?? } IF (x > x_pos) AND (x < x_pos+col_width[data_col,pixels]) AND (y > y_pos) AND (y < y_pos+cell_height) THEN BEGIN dummy := deselect_block; Set_Mouse(M_Point_Hand); Rubber_Box(x,y,4,6 DIV rez,last_width,last_height); Set_Mouse(M_Arrow); { valid stopping location for end-block? } IF mouse_row_col(x+last_width,y+last_height, new_row,new_col) THEN BEGIN b_s_row := data_row; b_s_col := data_col; b_e_row := new_row; b_e_col := new_col; { valid range bounds? } IF NOT ((b_e_row < b_s_row) OR (b_e_col < b_s_col)) THEN BEGIN adjust_menu(TRUE); block_set := TRUE; block_st_set := TRUE; block_end_set := TRUE; hilight_block END END END END END; (* MOUSE *) PROCEDURE EVALUATE_INPUT; LABEL 2; VAR i : INTEGER; did_assign : BOOLEAN; {$I d:\pascal\opus\arrows.inc} PROCEDURE MOVE_TO_EDGE ( new_data_row,new_data_col : INTEGER ); { moves cursor to edge of screen when control A,Z,T,B are pressed; do_draw, do_toggle are in arrows.inc } BEGIN do_toggle; data_row := new_data_row; data_col := new_data_col; do_draw END; BEGIN { EVALUATE_INPUT } Work_Rect(act_hdl,x_1,y_1,w_1,h_1); Set_Clip(x_1,y_1,w_1,h_1); CASE inp_code OF w_LEFT_ARROW : IF data_col > logical_col_1 THEN left_arrow; w_RIGHT_ARROW : IF data_col < n_cols THEN right_arrow; w_UP_ARROW : IF data_row > logical_row_1 THEN up_arrow; w_DOWN_ARROW : IF data_row < n_rows THEN down_arrow; w_RETURN : IF (auto_cursor) AND (data_row >= b_s_row) AND (data_row <= b_e_row) AND (data_col >= b_s_col) AND (data_col <= b_e_col) AND (block_set) THEN do_auto_cursor ELSE BEGIN did_assign := assign_if_possible; IF did_assign THEN BEGIN cell_on_screen(1,data_row,data_col,TRUE); write_cell_name END END; w_cntl_a : move_to_edge(data_row,start_col); w_cntl_z : move_to_edge(data_row,finish_col); w_cntl_t : move_to_edge(start_row,data_col); w_cntl_b : move_to_edge(finish_row,data_col); w_PAGE_UP : simulate_message(WM_Arrowed,act_hdl,0); w_PAGE_DOWN : simulate_message(WM_Arrowed,act_hdl,1); w_PAGE_LEFT : simulate_message(WM_Arrowed,act_hdl,4); w_PAGE_RIGHT : simulate_message(WM_Arrowed,act_hdl,5); w_F1 : simulate_message(MN_Selected,moptions,mmanrec); w_F2 : simulate_message(MN_Selected,mfile,mloadws); w_sF2 : simulate_message(MN_Selected,mfile,mloadbl); w_F3 : simulate_message(MN_Selected,mfile,msavews); w_sF3 : simulate_message(MN_Selected,mfile,msavebl); w_F4 : simulate_message(MN_Selected,mfile,msavetxt); w_F5 : simulate_message(MN_Selected,mfile,mprintsp); f6 : simulate_message(MN_Selected,mblock,minsertr); sf6 : simulate_message(MN_Selected,mblock,mdeleter); f7 : simulate_message(MN_Selected,mblock,minsertc); sf7 : simulate_message(MN_Selected,mblock,mdeletec); w_F8 : simulate_message(MN_Selected,mformat,mnum); w_F9 : simulate_message(MN_Selected,mformat,mlabel); w_F10 : simulate_message(MN_Selected,mformat,mform); w_COLUMN : simulate_message(MN_Selected,mformat,mcolwid); w_JUSTIFY : simulate_message(MN_Selected,mformat,mjust); alt_l : simulate_message(MN_Selected,mformat,mdollar); w_percent : simulate_message(MN_Selected,mformat,mpercent); w_PRECISION : simulate_message(MN_Selected,mformat,mprec); w_style : simulate_message(MN_Selected,mformat,mstyle); alt_b : simulate_message(MN_Selected,mformat,mglobalf); w_VIEW : simulate_message(MN_Selected,mformat,mviewfor); w_START_BLOCK : simulate_message(MN_Selected,mblock,mstartbl); w_END_BLOCK : simulate_message(MN_Selected,mblock,mendbl); alt_f : simulate_message(MN_Selected,mblock,mdatafil); w_REPLICATE : simulate_message(MN_Selected,mblock,mrep); w_SORT : simulate_message(MN_Selected,mblock,msort); w_DESELECT : simulate_message(MN_Selected,mblock,mdesel); w_GOTO : simulate_message(MN_Selected,mmark,mgoto); alt_1 : simulate_message(MN_Selected,mmark,ms1); alt_2 : simulate_message(MN_Selected,mmark,ms2); alt_3 : simulate_message(MN_Selected,mmark,ms3); alt_4 : simulate_message(MN_Selected,mmark,ms4); c_1 : IF m1s THEN simulate_message(MN_Selected,mmark,mg1); c_2 : IF m2s THEN simulate_message(MN_Selected,mmark,mg2); c_3 : IF m3s THEN simulate_message(MN_Selected,mmark,mg3); c_4 : IF m4s THEN simulate_message(MN_Selected,mmark,mg4); c_f : simulate_message(MN_Selected,mmark,mfirstc); c_l : simulate_message(MN_Selected,mmark,mlastc); alt_i : simulate_message(MN_Selected,moptions,msetauto); alt_x : simulate_message(MN_Selected,moptions,mstats); alt_h : simulate_message(MN_Selected,moptions,mrefresh); alt_t : simulate_message(MN_Selected,moptions,mfreeze); alt_c : IF block_set THEN simulate_message(MN_Selected,mblock,mcopy); alt_m : IF block_set THEN simulate_message(MN_Selected,mblock,mmove); alt_k : IF block_set THEN simulate_message(MN_Selected,mblock,mdelete); w_HOME : BEGIN home_cursor(Origin); sheet_redraw(WholeSheet,FALSE,None); END; w_MOUSE : BEGIN mx := msg_area[1]; (* mouse x-coord *) my := msg_area[2]; (* mouse y-coord *) mouse(mx,my); END; w_MESSAGE : BEGIN handle_message; redraw_flag := FALSE END; OTHERWISE : ; END; { CASE } 2: END; (* EVALUATE_INPUT *) PROCEDURE INIT_FUNCTIONS; VAR i : INTEGER; BEGIN i := 1; functions[i].func_name := 'ABS'; functions[i].func_type := AbsOp; i := i+1; functions[i].func_name := 'ACOS'; functions[i].func_type := AcosOp; i := i+1; functions[i].func_name := 'AND'; functions[i].func_type := AndOp; i := i+1; functions[i].func_name := 'ASIN'; functions[i].func_type := AsinOp; i := i+1; functions[i].func_name := 'ATAN'; functions[i].func_type := AtanOp; i := i+1; functions[i].func_name := 'CORR'; functions[i].func_type := CorrOp; i := i+1; functions[i].func_name := 'COS'; functions[i].func_type := CosOp; i := i+1; functions[i].func_name := 'COUNT'; functions[i].func_type := CountOp; i := i+1; functions[i].func_name := 'DEG'; functions[i].func_type := DegOp; i := i+1; functions[i].func_name := 'DIV'; functions[i].func_type := DivOp; i := i+1; functions[i].func_name := 'EXP'; functions[i].func_type := ExpOp; i := i+1; functions[i].func_name := 'FAC'; functions[i].func_type := FacOp; i := i+1; functions[i].func_name := 'FV'; functions[i].func_type := FvOp; i := i+1; functions[i].func_name := 'HLOOKUP'; functions[i].func_type := HlookupOp; i := i+1; functions[i].func_name := 'IF'; functions[i].func_type := IfOp; i := i+1; functions[i].func_name := 'INDEX'; functions[i].func_type := IndexOp; i := i+1; functions[i].func_name := 'LINR'; functions[i].func_type := LinROp; i := i+1; functions[i].func_name := 'LN'; functions[i].func_type := LnOp; i := i+1; functions[i].func_name := 'LOG'; functions[i].func_type := LogOp; i := i+1; functions[i].func_name := 'MAX'; functions[i].func_type := MaxOp; i := i+1; functions[i].func_name := 'MEAN'; functions[i].func_type := MeanOp; i := i+1; functions[i].func_name := 'MIN'; functions[i].func_type := MinOp; i := i+1; functions[i].func_name := 'MOD'; functions[i].func_type := ModOp; i := i+1; functions[i].func_name := 'NOT'; functions[i].func_type := NotOp; i := i+1; functions[i].func_name := 'NPER'; functions[i].func_type := NperOp; i := i+1; functions[i].func_name := 'OR'; functions[i].func_type := OrOp; i := i+1; functions[i].func_name := 'PI'; functions[i].func_type := PiOp; i := i+1; functions[i].func_name := 'PMT'; functions[i].func_type := PmtOp; i := i+1; functions[i].func_name := 'PREDV'; functions[i].func_type := PredVOp; i := i+1; functions[i].func_name := 'PROD'; functions[i].func_type := ProdOp; i := i+1; functions[i].func_name := 'PV'; functions[i].func_type := PvOp; i := i+1; functions[i].func_name := 'RAD'; functions[i].func_type := RadOp; i := i+1; functions[i].func_name := 'RAND'; functions[i].func_type := RandOp; i := i+1; functions[i].func_name := 'ROUND'; functions[i].func_type := RoundOp; i := i+1; functions[i].func_name := 'SDEV'; functions[i].func_type := SdevOp; i := i+1; functions[i].func_name := 'SERR'; functions[i].func_type := SerrOp; i := i+1; functions[i].func_name := 'SIN'; functions[i].func_type := SinOp; i := i+1; functions[i].func_name := 'SQR'; functions[i].func_type := SqrOp; i := i+1; functions[i].func_name := 'SQRT'; functions[i].func_type := SqrtOp; i := i+1; functions[i].func_name := 'SUM'; functions[i].func_type := SumOp; i := i+1; functions[i].func_name := 'TAN'; functions[i].func_type := TanOp; i := i+1; functions[i].func_name := 'TRUNC'; functions[i].func_type := TruncOp; i := i+1; functions[i].func_name := 'VAR'; functions[i].func_type := VarOp; i := i+1; functions[i].func_name := 'VLOOKUP'; functions[i].func_type := VlookupOp; END; { INIT_FUNCTIONS } PROCEDURE CHECK_REZ; VAR i : INTEGER; FUNCTION Addr ( VAR what : BlitArray ) : LONG_INTEGER; EXTERNAL; BEGIN { save the pallete } FOR i := 0 TO 15 DO palette[i] := XBIOS_Set_Color(i,-1); Extended_Inquire(0); screen_width := int_out[0]+1; screen_height := int_out[1]+1; half_scr_width := screen_width DIV 2; half_scr_height := screen_height DIV 2; max_screen_cols := screen_width DIV 40; Extended_Inquire(1); IF int_out[4] = 2 THEN BEGIN { med rez } { my favorite colors; I've indicated the ones in the ST boot-up ( no mods via control panel ) on the left } Set_Color(0,1000,1000,1000); { white => white } Set_Color(1,0,0,0); { black => black } Set_Color(2,1000,0,0); { red => red } Set_Color(3,0,0,1000); { green => blue } rez := 2 { set it to my rez } END ELSE IF int_out[4] = 1 THEN BEGIN { high rez } Set_Color(0,1000,1000,1000); { white } Set_Color(1,0,0,0); { black } Set_Color(2,0,0,0); { black } Set_Color(3,0,0,0); { black } rez := 1 END ELSE BEGIN { low rez or anything else } temp := CONCAT('[3][Opus requires medium or|' , 'high resolution...][ I''ll switch ]'); i := Do_Alert(temp,1); End_Update; Exit_Gem; Halt END; screen_mfdb.address := 0; { sufficient to access screen } WITH mem_mfdb DO BEGIN address := Addr(blit_buffer); wid_pix := screen_width; ht_pix := screen_height; wid_wds := wid_pix DIV 16; format := 0; planes := int_out[4]; { from Extended_Inquire(1) } res1 := 0; { unused vars, but it's recommended to set to zero as } res2 := 0; { they may have significance in future versions of GEM } res3 := 0 END; IF rez = 1 THEN cell_height := 17 ELSE cell_height := 9; two_cell_h := 2*cell_height; { commonly used values } three_cell_h := 3*cell_height END; { CHECK_REZ } PROCEDURE INITIALIZE; LABEL 1; TYPE Switcheroo = RECORD CASE BYTE OF 1 : ( str : STR10 ); 2 : ( switched : ThreeHundredBytes ) END; VAR i,j,k,handle : INTEGER; n : LONG_INTEGER; c_s : C_STRING; buffer : Switcheroo; m : PrinterSpecial; PROCEDURE ERROR; BEGIN handle := -1; temp := CONCAT('[1][Read error while loading|' , 'PRINTER.INF. No special|' , 'codes will be used when|' , 'printing.][ OK ]'); i := Do_Alert(temp,1); GOTO 1 END; { ERROR } PROCEDURE READ_BYTES ( n : LONG_INTEGER ); BEGIN IF TOS_Read(handle,n,buffer.switched) <> n THEN error END; { READ_BYTES } FUNCTION PTR_TO_LONG ( addr : Generic_Ptr ) : LONG_INTEGER; EXTERNAL; BEGIN check_rez; drive := TOS_Get_Drive; i := TOS_Get_Directory(directory,0); C_To_Pascal(directory,full_path); full_path := CONCAT(CHR(drive+65),':',full_path); IF rez = 1 THEN temp_1 := 'H' ELSE temp_1 := 'M'; temp := CONCAT(full_path,'\OPUS',temp_1,'.RSC'); IF NOT Load_Resource(temp) THEN BEGIN temp := CONCAT('[3][OPUS',temp_1,'.RSC was not found!|' , 'It must live in the same|' , 'directory as OPUS.PRG.][ Cancel ]'); alert := Do_Alert(temp,1); End_Update; Exit_Gem; HALT END; Find_Menu(mainmenu,main_menu); { main_menu is the pointer } IF rez = 1 THEN { high rez } Menu_Enable(main_menu,msmall); Find_Dialog(infodial,info_ptr); Find_Dialog(fmatdial,fmat_ptr); Find_Dialog(vfrmdial,vfrm_ptr); Find_Dialog(gotodial,goto_ptr); Find_Dialog(repdial,rep_ptr); Find_Dialog(prdial,print_ptr); Find_Dialog(sortdial,sort_ptr); Find_Dialog(rangdial,rang_ptr); Find_Dialog(errdial,err_ptr); Find_Dialog(statdial,stat_ptr); Find_Dialog(pagedial,page_ptr); Find_Dialog(keydial,key_ptr); Find_Dialog(formdial,form_ptr); Find_Dialog(prhdial,prhelp_ptr); Find_Dialog(mhlpdial,mhelp_ptr); Find_Dialog(crefdial,crefhelp_ptr); Find_Dialog(rechdial,rechelp_ptr); Find_Dialog(datadial,data_fill_ptr); Find_Dialog(frzdial,freeze_ptr); Find_Dialog(actdial,action_ptr); Find_Dialog(newdesk,new_desk_ptr); hide; Form_Anywhere(new_desk_ptr,0,cell_height+2,w_1,h_1); Obj_Size(new_desk_ptr,panel,fo_x,fo_y,fo_w,fo_h); con_x := 0; con_y := fo_y+fo_h+4; con_w := screen_width; con_h := screen_height-con_y; Obj_Size(new_desk_ptr,editarea,area_x,area_y,area_w,area_h); area_x := area_x+1; area_w := area_w-2; area_y := area_y+1; area_h := area_h-2; edit_x := area_x+8; IF rez = 1 THEN edit_y := area_y+13 ELSE edit_y := area_y+6; FOR m := Init TO UnderOff DO printer_codes[m] := ''; temp := CONCAT(full_path,'\PRINTER.INF'); Pascal_To_C(temp,c_s); handle := TOS_Open(c_s,0); IF handle >= 0 THEN BEGIN read_bytes(11); IF buffer.str <> 'opus print' THEN BEGIN temp := CONCAT('[1][PRINTER.INF is corrupted.|' , 'No special printer codes|' , 'will be used.][ OK ]'); alert := Do_Alert(temp,1); handle := -1; GOTO 1 END; read_bytes(3); port := buffer.switched[1]; nl_chr_line := buffer.switched[2]; con_chr_line := buffer.switched[3]; FOR m := Init TO Underoff DO BEGIN read_bytes(1); IF buffer.switched[1] > 0 THEN IF TOS_Seek(-1,handle,1) < 0 THEN error ELSE BEGIN read_bytes(buffer.switched[1]+1); printer_codes[m] := buffer.str END END END ELSE BEGIN temp := CONCAT('[1][PRINTER.INF was not found.|' , 'No special printer codes|' , 'will be used.][ OK ]'); alert := Do_Alert(temp,1) END; 1: IF handle < 0 THEN BEGIN nl_chr_line := 80; con_chr_line := 136; port := Centronics; FOR m := Init TO UnderOff DO printer_codes[m] := '' END; default_path[1] := CONCAT(full_path,'\*.OPS'); default_path[2] := CONCAT(full_path,'\*.DOC'); current_file := ''; n_hdls := 1; t_1 := ' WorkSheet1 '; t_2 := ' WorkSheet2 '; w_idx := 1; { index into w_pos array } w_pos[w_idx,first_row] := 1; { usage example } w_pos[1,first_col] := 1; { Note that for the opening window we needn't } w_pos[1,hot_row] := 1; { specify the finish or scr. pos. parms. } w_pos[1,hot_col] := 1; { These are relevant for restoring the } { values after redraws. The second window is } { always set to the 1st attr when opened. } act_hdl := New_Window(G_All,t_1,con_x,con_y,con_w,con_h); IF act_hdl = No_Window THEN BEGIN alert := Do_Alert('[3][GEM has no more windows!][ Cancel ]',1); Free_Resource; End_Update; Exit_Gem; HALT END; w_pos[1,w_hdl] := act_hdl; init_functions; e_table[1] := e; e_table[2] := 7.3890560989; e_table[3] := 54.598150033; e_table[4] := 2.9809579871E3; e_table[5] := 8.8861105206E6; e_table[6] := 7.8962960185E13; e_table[7] := 6.2351490811E27; user_quit := FALSE; block_set := FALSE; block_st_set := FALSE; block_end_set := FALSE; did_recalc := FALSE; redraw_flag := FALSE; auto_recalc := TRUE; natural := TRUE; auto_cursor := TRUE; grid_flag := TRUE; m1s := FALSE; m2s := FALSE; m3s := FALSE; m4s := FALSE; p_row_col := TRUE; print_formulas := FALSE; form_flag := FALSE; small_text := FALSE; draft_final := TRUE; condensed_print := FALSE; p_title_1 := ''; p_title_2 := ''; header := ''; footer := '^c-^p-'; error_msg[GenError] := 'Error'; error_msg[SyntaxErr] := 'SyntaxErr'; error_msg[OutOfRange] := 'OutOfRange'; error_msg[BadRef] := 'BadCellRef'; error_msg[Overflow] := 'Overflow'; error_msg[DivBy0] := 'DivBy0'; error_msg[Undefined] := 'Undefined'; error_msg[BadReal] := 'BadReal'; days[1] := 'monday'; days[2] := 'tuesday'; days[3] := 'wednesday'; days[4] := 'thursday'; days[5] := 'friday'; days[6] := 'saturday'; days[7] := 'sunday'; months[1] := 'january'; months[2] := 'february'; months[3] := 'march'; months[4] := 'april'; months[5] := 'may'; months[6] := 'june'; months[7] := 'july'; months[8] := 'august'; months[9] := 'september'; months[10] := 'october'; months[11] := 'november'; months[12] := 'december'; cursor_direction := CursorDown; FOR i := 1 TO n_cols DO BEGIN { the pixel-width is not an exact } col_width[i,spaces] := 10; { multiple of 8 so that the grid } col_width[i,pixels] := 80 { lines may start and end on an 'on' } END; { pixel; prevents 'shifting' lines } { when blitting in high rez } char1 := 'A'; FOR i := 1 TO 26 DO BEGIN col_name[i] := char1; char1 := SUCC(char1) END; char1 := PRED('A'); FOR i := 27 TO n_cols DO BEGIN IF (i-27) MOD 26 = 0 THEN char1 := SUCC(char1); IF (i-27) MOD 26 = 0 THEN char2 := 'A' ELSE char2 := SUCC(char2); col_name[i] := CONCAT (char1,char2) END; FOR i := 1 TO 4 DO BEGIN marks[i].row := 0; { the 4 actual marks; 0 = not set } marks[i].col := 0 END; default_format := $02; { right just; 2 dec places, no sci; no percent } up_case := [ 'A'..'Z' ]; low_case := [ 'a'..'z' ]; digits := [ '0'..'9' ]; float := digits+[ '.' , 'E' , 'e' , '+' , '-' ]; Single := [LogOp..NotOp]; Double := [DivOp..TruncOp]; Multiple := [AndOp..OrOp]; Aggregate := [CountOp..PredVOp]; Financial := [PvOp..NPerOp]; LookUp := [VLookUpOp..IndexOp]; too_long := CONCAT ('[1][You have now entered the|' , 'maximum allowed number of|' , 'characters...][ OK ]'); float_over := CONCAT ('[1][<< Floating point overflow >>|' , ' |', 'Numbers must fall within this|' , 'range:|' , ' +/- 1 E +/- 37][ OK ]'); null_str := ''; FOR i := 0 TO n_rows DO data[i] := NIL; Hide_Mouse; Set_Mouse(M_Arrow); Draw_Menu(main_menu); data_row := 1; data_col := 1; set_up_cell_name; Wind_Set(0,WF_NewDesk,INT(ShR(ptr_to_long(new_desk_ptr),16)), INT(ptr_to_long(new_desk_ptr) & $0000FFFF), Root,Max_Depth); Form_Dial(3,0,0,screen_width,screen_height, 0,0,screen_width,screen_height); Open_Window(act_hdl,con_x,con_y,con_w,con_h); Border_Rect(act_hdl,o_x,o_y,max_w,max_h); { original vals } home_cursor(Origin); default_draw_attributes; freeze_row := 0; freeze_col := 0; logical_row_1 := 1; logical_col_1 := 1; x_margin := 38; y_margin := cell_height-1; Show_Mouse END; (* INITIALIZE *) BEGIN { PROGRAM } WHILE KeyPress DO long_key := BConIn(2); { clean junk out of keyboard } ap_id := Init_Gem; { save for sending self messages, also for } IF ap_id >= 0 THEN BEGIN { possible communication with accs } Begin_Update; initialize; { make smaller to account for procedure vars, space returned to stack that isn't useful, etc. So this in effect reserves 20K bytes for the stack, since we won't allocate the cells which could fit in this space. Do this here rather than in INITIALIZE because to get the heap size, it subtracts that space between start of heap and end of stack, and any proc variables on the stack detract from Memavail } original_memory := MemAvail*2-20000; { words -> bytes } working_memory := original_memory; REPEAT { heart of the program } inp_code := NoCode; mask_out_recalc; { NOTE: window_input is passed a formula if cell is class F or a string if class A; if no changes in this item are made, it returns the value NULL, and thus the cell is not affected in ANY WAY } temp := ''; ptr := locate_cell(data_row,data_col); IF ptr <> NIL THEN IF ptr^.class <> Val THEN BEGIN IF ptr^.str <> NIL THEN BEGIN inp_code := w_F; temp := ptr^.str^ END; window_input(string_len,AlphaNumeric,temp) END { see wind_inp.pas for global vars it uses } ELSE window_input(float_len,FloatingPoint,temp) ELSE window_input(float_len,FloatingPoint,temp); evaluate_input UNTIL user_quit; { clean up... } End_Update; Erase_Menu(main_menu); { needn't delete_menu since I used RCS } { close & delete windows so we don't crash GEM } IF n_hdls = 2 THEN BEGIN Close_Window(w_pos[2,w_hdl]); Delete_Window(w_pos[2,w_hdl]) END; Close_Window(w_pos[1,w_hdl]); { which is always present } Delete_Window(w_pos[1,w_hdl]); Set_Palette(palette); { restore user's colors } Wind_Set(0,WF_NewDesk,0,0,Root,Max_Depth); { tell Desktop to use } Form_Dial(3,0,0,screen_width,screen_height,{ its own definition } 0,0,screen_width,screen_height); Free_Resource; { give GEM the memory back } Exit_Gem END (* IF ap_id >= 0 *) END.