home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / apps / spread / opusprg / opussrc / opus.pas < prev    next >
Pascal/Delphi Source File  |  1988-05-12  |  33KB  |  805 lines
  1.  
  2.  
  3. {$U30+}
  4.  
  5. PROGRAM Opus;
  6.  
  7. {$I i:\opus.i}
  8. {$I i:\GCTV.inc} { global Constants, Types and Variables }
  9.  
  10. {$I i:\gemsubs.def}
  11. {$I i:\auxsubs.def}
  12. {$I i:\vdi_aes.def}
  13. {$I i:\globsubs.def}
  14. {$I d:\pascal\opus\xbios.def}
  15. {$I d:\pascal\opus\gemdos.def}
  16. {$I d:\pascal\opus\graphout.def}
  17. {$I d:\pascal\opus\resource.def}
  18. {$I d:\pascal\opus\stringfn.def}
  19. {$I d:\pascal\opus\bf.def}
  20.  
  21. PROCEDURE HANDLE_MESSAGE;
  22.    EXTERNAL;
  23.    
  24.  
  25. PROCEDURE MOUSE ( mx,my : INTEGER );
  26.    { allows user to select active cell with mouse; select a range via
  27.      dragging beginning in the active cell and extending to the end of the
  28.      rubber box; select an entire row or column by clicking within the
  29.      row/col title areas }
  30.    TYPE ScreenAreas = ( DataArea,RowArea,ColArea );  
  31.    VAR i,j,total,last_width,last_height,x,y,button,key,
  32.        new_row,new_col,x_pos,y_pos,l_scr_row,l_scr_col,
  33.        o_mx,o_my,col_separator,new_x,new_y,spec_col,
  34.        new_width                                       : INTEGER;
  35.        dummy                                           : BOOLEAN;
  36.        code                                            : ScreenAreas;
  37.    BEGIN { MOUSE }
  38.           Work_Rect(act_hdl,x_1,y_1,w_1,h_1);
  39.           code := DataArea;
  40.           { check if user clicked within row/col title areas }
  41.           IF (mx < x_1+38) AND (mx > x_1) THEN
  42.              code := RowArea;
  43.           IF (my < y_1+cell_height-1) AND (my > y_1) THEN
  44.              code := ColArea;
  45.           o_mx := mx;
  46.           o_my := my;   
  47.           IF code <> DataArea THEN BEGIN { outside data area }
  48.              IF code = RowArea THEN      { still check for valid y or x in }
  49.                 mx := vert_grid[1]+10    { mouse_row_col }
  50.              ELSE 
  51.                 my := y_1+y_margin+1;  
  52.              IF mouse_row_col(mx,my,new_row,new_col) THEN BEGIN
  53.                 dummy := deselect_block;         { yes, valid x,y pos }
  54.                 IF code = RowArea THEN BEGIN { select all cells in }
  55.                    b_s_row := new_row;       { that row }
  56.                    b_e_row := new_row;
  57.                    b_s_col := logical_col_1;
  58.                    b_e_col := n_cols
  59.                 END
  60.                 ELSE BEGIN               { select all cells in that column }
  61.                    b_s_row := logical_row_1;
  62.                    b_e_row := n_rows;
  63.                    b_s_col := new_col;
  64.                    b_e_col := new_col
  65.                 END;
  66.                 block_st_set := TRUE;
  67.                 block_end_set := TRUE;
  68.                 block_set := TRUE;
  69.                 adjust_menu(TRUE); { activate block commands }
  70.                 hilight_block
  71.              END
  72.              ELSE IF (code = ColArea) AND (o_mx > vert_grid[1]+4) AND
  73.                      (o_mx <= vert_grid[finish_col-start_col+2]+4) THEN BEGIN
  74.                   FOR i := 2 TO finish_col-start_col+2 DO
  75.                       IF (o_mx >= vert_grid[i]-4) AND        { bigger limit }
  76.                          (o_mx <= vert_grid[i]+4) THEN BEGIN { than needed  }
  77.                          col_separator := i;
  78.                          spec_col := start_col+i-2
  79.                       END;
  80.                   Set_Mouse(M_Flat_Hand);
  81.                   Drag_Box(vert_grid[col_separator],y_1,0,h_1,
  82.                            vert_grid[col_separator-1]+39,y_1,
  83.                            200,h_1,new_x,new_y);
  84.                   Set_Mouse(M_Arrow);
  85.                   new_width := (col_width[spec_col,pixels]+
  86.                                 new_x+3-vert_grid[col_separator]) DIV 8;
  87.                   IF new_width <> col_width[spec_col,spaces] THEN BEGIN
  88.                      IF new_width < 5 THEN
  89.                         new_width := 5
  90.                      ELSE IF new_width > 30 THEN
  91.                         new_width := 30;
  92.                      col_width[spec_col,spaces] := new_width;
  93.                      col_width[spec_col,pixels] := new_width*8;
  94.                      Send_Redraw(TRUE,0,0,screen_width,screen_height)
  95.                   END
  96.              END
  97.              ELSE              
  98.           END { code <> DataArea }
  99.           ELSE { clicked w/in worksheet data area }
  100.              { must start with a valid mouse location, so...}
  101.              IF mouse_row_col(mx,my,new_row,new_col) THEN BEGIN
  102.                 { first redraw the cell(s) affected, i.e. old and new }
  103.                 Hide_Mouse;
  104.                 toggle_inverse(Black,data_row,data_col);
  105.                 Show_Mouse;
  106.                 data_row := new_row;
  107.                 data_col := new_col;
  108.                 find_screen_pos(new_row,new_col,scr_row,scr_col);
  109.                 cell_on_screen(1,data_row,data_col,TRUE);
  110.                 write_cell_name;
  111.                 { find the x,y coordinates of the current cell's upper left-hand
  112.                   corner }
  113.                 Work_Rect(act_hdl,x_1,y_1,w_1,h_1);
  114.                 Set_Clip(x_1,y_1,w_1,h_1);
  115.                 x_pos := vert_grid[scr_col];
  116.                 y_pos := y_1+y_margin+(scr_row-1)*cell_height;
  117.                 event := Get_Event(E_Timer,0,0,0,200,FALSE,0,0,0,0,
  118.                                    FALSE,0,0,0,0,msg_area,i,i,i,i,i,i);
  119.                 Graf_MKState(x,y,button,kbd_state);
  120.                 IF button = 1 THEN { started within current cell?? }
  121.                    IF (x > x_pos) AND
  122.                       (x < x_pos+col_width[data_col,pixels]) AND
  123.                       (y > y_pos) AND (y < y_pos+cell_height) THEN BEGIN
  124.                       dummy := deselect_block;
  125.                       Set_Mouse(M_Point_Hand);
  126.                       Rubber_Box(x,y,4,6 DIV rez,last_width,last_height);
  127.                       Set_Mouse(M_Arrow);
  128.                       { valid stopping location for end-block? }
  129.                       IF mouse_row_col(x+last_width,y+last_height,
  130.                                        new_row,new_col) THEN BEGIN
  131.                          b_s_row := data_row;
  132.                          b_s_col := data_col;
  133.                          b_e_row := new_row;
  134.                          b_e_col := new_col;
  135.                          { valid range bounds? }
  136.                          IF NOT ((b_e_row < b_s_row) OR (b_e_col < b_s_col))
  137.                          THEN BEGIN
  138.                             adjust_menu(TRUE);
  139.                             block_set := TRUE;
  140.                             block_st_set := TRUE;
  141.                             block_end_set := TRUE;
  142.                             hilight_block
  143.                          END
  144.                       END
  145.                    END
  146.              END
  147.    END;  (* MOUSE *)
  148.  
  149. PROCEDURE EVALUATE_INPUT;
  150.    LABEL 2;
  151.    VAR
  152.      i                              : INTEGER;
  153.      did_assign                     : BOOLEAN;
  154.  
  155. {$I d:\pascal\opus\arrows.inc}
  156.  
  157.    PROCEDURE MOVE_TO_EDGE ( new_data_row,new_data_col : INTEGER );
  158.       { moves cursor to edge of screen when control A,Z,T,B are pressed;
  159.         do_draw, do_toggle are in arrows.inc  }
  160.       BEGIN
  161.           do_toggle;
  162.           data_row := new_data_row;
  163.           data_col := new_data_col;
  164.           do_draw
  165.       END;
  166.  
  167.    BEGIN { EVALUATE_INPUT }
  168.            Work_Rect(act_hdl,x_1,y_1,w_1,h_1);
  169.            Set_Clip(x_1,y_1,w_1,h_1);
  170.            CASE inp_code OF
  171.               w_LEFT_ARROW  : IF data_col > logical_col_1 THEN left_arrow;
  172.               w_RIGHT_ARROW : IF data_col < n_cols THEN right_arrow;
  173.               w_UP_ARROW    : IF data_row > logical_row_1 THEN up_arrow;
  174.               w_DOWN_ARROW  : IF data_row < n_rows THEN down_arrow;
  175.               w_RETURN :
  176.                  IF (auto_cursor) AND
  177.                     (data_row >= b_s_row) AND (data_row <= b_e_row) AND
  178.                     (data_col >= b_s_col) AND (data_col <= b_e_col) AND
  179.                     (block_set) THEN
  180.                     do_auto_cursor
  181.                  ELSE BEGIN
  182.                     did_assign := assign_if_possible;
  183.                     IF did_assign THEN BEGIN
  184.                        cell_on_screen(1,data_row,data_col,TRUE);
  185.                        write_cell_name
  186.                     END
  187.                  END;
  188.               w_cntl_a : move_to_edge(data_row,start_col);
  189.               w_cntl_z : move_to_edge(data_row,finish_col);
  190.               w_cntl_t : move_to_edge(start_row,data_col);
  191.               w_cntl_b : move_to_edge(finish_row,data_col);
  192.               w_PAGE_UP : simulate_message(WM_Arrowed,act_hdl,0);
  193.               w_PAGE_DOWN : simulate_message(WM_Arrowed,act_hdl,1);
  194.               w_PAGE_LEFT : simulate_message(WM_Arrowed,act_hdl,4);
  195.               w_PAGE_RIGHT : simulate_message(WM_Arrowed,act_hdl,5);
  196.               w_F1 : simulate_message(MN_Selected,moptions,mmanrec);
  197.               w_F2 : simulate_message(MN_Selected,mfile,mloadws);
  198.               w_sF2 : simulate_message(MN_Selected,mfile,mloadbl);
  199.               w_F3 : simulate_message(MN_Selected,mfile,msavews);
  200.               w_sF3 : simulate_message(MN_Selected,mfile,msavebl);
  201.               w_F4 : simulate_message(MN_Selected,mfile,msavetxt);
  202.               w_F5 : simulate_message(MN_Selected,mfile,mprintsp);
  203.               f6 : simulate_message(MN_Selected,mblock,minsertr);
  204.               sf6 : simulate_message(MN_Selected,mblock,mdeleter);
  205.               f7 : simulate_message(MN_Selected,mblock,minsertc);
  206.               sf7 : simulate_message(MN_Selected,mblock,mdeletec);
  207.               w_F8 : simulate_message(MN_Selected,mformat,mnum);
  208.               w_F9 : simulate_message(MN_Selected,mformat,mlabel);
  209.               w_F10 : simulate_message(MN_Selected,mformat,mform);
  210.               w_COLUMN : simulate_message(MN_Selected,mformat,mcolwid);
  211.               w_JUSTIFY : simulate_message(MN_Selected,mformat,mjust);
  212.               alt_l : simulate_message(MN_Selected,mformat,mdollar);
  213.               w_percent : simulate_message(MN_Selected,mformat,mpercent);
  214.               w_PRECISION : simulate_message(MN_Selected,mformat,mprec);
  215.               w_style : simulate_message(MN_Selected,mformat,mstyle);
  216.               alt_b : simulate_message(MN_Selected,mformat,mglobalf);
  217.               w_VIEW : simulate_message(MN_Selected,mformat,mviewfor);
  218.               w_START_BLOCK : simulate_message(MN_Selected,mblock,mstartbl);
  219.               w_END_BLOCK : simulate_message(MN_Selected,mblock,mendbl);
  220.               alt_f : simulate_message(MN_Selected,mblock,mdatafil);
  221.               w_REPLICATE : simulate_message(MN_Selected,mblock,mrep);
  222.               w_SORT : simulate_message(MN_Selected,mblock,msort);
  223.               w_DESELECT : simulate_message(MN_Selected,mblock,mdesel);
  224.               w_GOTO : simulate_message(MN_Selected,mmark,mgoto);
  225.               alt_1 : simulate_message(MN_Selected,mmark,ms1);
  226.               alt_2 : simulate_message(MN_Selected,mmark,ms2);
  227.               alt_3 : simulate_message(MN_Selected,mmark,ms3);
  228.               alt_4 : simulate_message(MN_Selected,mmark,ms4);
  229.               c_1 : IF m1s THEN simulate_message(MN_Selected,mmark,mg1);
  230.               c_2 : IF m2s THEN simulate_message(MN_Selected,mmark,mg2);
  231.               c_3 : IF m3s THEN simulate_message(MN_Selected,mmark,mg3);
  232.               c_4 : IF m4s THEN simulate_message(MN_Selected,mmark,mg4);
  233.               c_f : simulate_message(MN_Selected,mmark,mfirstc);
  234.               c_l : simulate_message(MN_Selected,mmark,mlastc);
  235.               alt_i : simulate_message(MN_Selected,moptions,msetauto);
  236.               alt_x : simulate_message(MN_Selected,moptions,mstats);
  237.               alt_h : simulate_message(MN_Selected,moptions,mrefresh);
  238.               alt_t : simulate_message(MN_Selected,moptions,mfreeze);
  239.               alt_c : IF block_set THEN 
  240.                          simulate_message(MN_Selected,mblock,mcopy);
  241.               alt_m : IF block_set THEN
  242.                          simulate_message(MN_Selected,mblock,mmove);
  243.               alt_k : IF block_set THEN
  244.                          simulate_message(MN_Selected,mblock,mdelete);
  245.               w_HOME : BEGIN
  246.                  home_cursor(Origin);
  247.                  sheet_redraw(WholeSheet,FALSE,None);
  248.               END;
  249.               w_MOUSE : BEGIN
  250.                  mx := msg_area[1]; (* mouse x-coord *)
  251.                  my := msg_area[2]; (* mouse y-coord *)
  252.                  mouse(mx,my);
  253.               END;
  254.               w_MESSAGE : BEGIN
  255.                  handle_message;
  256.                  redraw_flag := FALSE
  257.               END;
  258.               OTHERWISE : ;
  259.            END; { CASE }
  260. 2: END; (* EVALUATE_INPUT *)
  261.  
  262. PROCEDURE INIT_FUNCTIONS;
  263.    VAR i : INTEGER;
  264.    BEGIN
  265.        i := 1;
  266.        functions[i].func_name := 'ABS';
  267.        functions[i].func_type := AbsOp;
  268.        i := i+1;
  269.        functions[i].func_name := 'ACOS';
  270.        functions[i].func_type := AcosOp;
  271.        i := i+1;
  272.        functions[i].func_name := 'AND';
  273.        functions[i].func_type := AndOp;
  274.        i := i+1;
  275.        functions[i].func_name := 'ASIN';
  276.        functions[i].func_type := AsinOp;
  277.        i := i+1;
  278.        functions[i].func_name := 'ATAN';
  279.        functions[i].func_type := AtanOp;
  280.        i := i+1;
  281.        functions[i].func_name := 'CORR';
  282.        functions[i].func_type := CorrOp;
  283.        i := i+1;
  284.        functions[i].func_name := 'COS';
  285.        functions[i].func_type := CosOp;
  286.        i := i+1;
  287.        functions[i].func_name := 'COUNT';
  288.        functions[i].func_type := CountOp;
  289.        i := i+1;
  290.        functions[i].func_name := 'DEG';
  291.        functions[i].func_type := DegOp;
  292.        i := i+1;
  293.        functions[i].func_name := 'DIV';
  294.        functions[i].func_type := DivOp;
  295.        i := i+1;
  296.        functions[i].func_name := 'EXP';
  297.        functions[i].func_type := ExpOp;
  298.        i := i+1;
  299.        functions[i].func_name := 'FAC';
  300.        functions[i].func_type := FacOp;
  301.        i := i+1;
  302.        functions[i].func_name := 'FV';
  303.        functions[i].func_type := FvOp;
  304.        i := i+1;
  305.        functions[i].func_name := 'HLOOKUP';
  306.        functions[i].func_type := HlookupOp;
  307.        i := i+1;
  308.        functions[i].func_name := 'IF';
  309.        functions[i].func_type := IfOp;
  310.        i := i+1;
  311.        functions[i].func_name := 'INDEX';
  312.        functions[i].func_type := IndexOp;
  313.        i := i+1;
  314.        functions[i].func_name := 'LINR';
  315.        functions[i].func_type := LinROp;
  316.        i := i+1;
  317.        functions[i].func_name := 'LN';
  318.        functions[i].func_type := LnOp;
  319.        i := i+1;
  320.        functions[i].func_name := 'LOG';
  321.        functions[i].func_type := LogOp;
  322.        i := i+1;
  323.        functions[i].func_name := 'MAX';
  324.        functions[i].func_type := MaxOp;
  325.        i := i+1;
  326.        functions[i].func_name := 'MEAN';
  327.        functions[i].func_type := MeanOp;
  328.        i := i+1;
  329.        functions[i].func_name := 'MIN';
  330.        functions[i].func_type := MinOp;
  331.        i := i+1;
  332.        functions[i].func_name := 'MOD';
  333.        functions[i].func_type := ModOp;
  334.        i := i+1;
  335.        functions[i].func_name := 'NOT';
  336.        functions[i].func_type := NotOp;
  337.        i := i+1;
  338.        functions[i].func_name := 'NPER';
  339.        functions[i].func_type := NperOp;
  340.        i := i+1;
  341.        functions[i].func_name := 'OR';
  342.        functions[i].func_type := OrOp;
  343.        i := i+1;
  344.        functions[i].func_name := 'PI';
  345.        functions[i].func_type := PiOp;
  346.        i := i+1;
  347.        functions[i].func_name := 'PMT';
  348.        functions[i].func_type := PmtOp;
  349.        i := i+1;
  350.        functions[i].func_name := 'PREDV';
  351.        functions[i].func_type := PredVOp;
  352.        i := i+1;
  353.        functions[i].func_name := 'PROD';
  354.        functions[i].func_type := ProdOp;
  355.        i := i+1;
  356.        functions[i].func_name := 'PV';
  357.        functions[i].func_type := PvOp;
  358.        i := i+1;
  359.        functions[i].func_name := 'RAD';
  360.        functions[i].func_type := RadOp;
  361.        i := i+1;
  362.        functions[i].func_name := 'RAND';
  363.        functions[i].func_type := RandOp;
  364.        i := i+1;
  365.        functions[i].func_name := 'ROUND';
  366.        functions[i].func_type := RoundOp;
  367.        i := i+1;
  368.        functions[i].func_name := 'SDEV';
  369.        functions[i].func_type := SdevOp;
  370.        i := i+1;
  371.        functions[i].func_name := 'SERR';
  372.        functions[i].func_type := SerrOp;
  373.        i := i+1;
  374.        functions[i].func_name := 'SIN';
  375.        functions[i].func_type := SinOp;
  376.        i := i+1;
  377.        functions[i].func_name := 'SQR';
  378.        functions[i].func_type := SqrOp;
  379.        i := i+1;
  380.        functions[i].func_name := 'SQRT';
  381.        functions[i].func_type := SqrtOp;
  382.        i := i+1;
  383.        functions[i].func_name := 'SUM';
  384.        functions[i].func_type := SumOp;
  385.        i := i+1;
  386.        functions[i].func_name := 'TAN';
  387.        functions[i].func_type := TanOp;
  388.        i := i+1;
  389.        functions[i].func_name := 'TRUNC';
  390.        functions[i].func_type := TruncOp;
  391.        i := i+1;
  392.        functions[i].func_name := 'VAR';
  393.        functions[i].func_type := VarOp;
  394.        i := i+1;
  395.        functions[i].func_name := 'VLOOKUP';
  396.        functions[i].func_type := VlookupOp;
  397.    END; { INIT_FUNCTIONS }
  398.  
  399. PROCEDURE CHECK_REZ;
  400.    VAR i : INTEGER;
  401.    FUNCTION Addr ( VAR what : BlitArray ) : LONG_INTEGER;
  402.       EXTERNAL;
  403.    BEGIN
  404.        { save the pallete }
  405.        FOR i := 0 TO 15 DO
  406.            palette[i] := XBIOS_Set_Color(i,-1);
  407.        Extended_Inquire(0);
  408.        screen_width := int_out[0]+1;
  409.        screen_height := int_out[1]+1;
  410.        half_scr_width := screen_width DIV 2;
  411.        half_scr_height := screen_height DIV 2;
  412.        max_screen_cols := screen_width DIV 40;
  413.        Extended_Inquire(1);
  414.        IF int_out[4] = 2 THEN BEGIN { med rez }
  415.           { my favorite colors; I've indicated the ones in the
  416.             ST boot-up ( no mods via control panel ) on the left }
  417.           Set_Color(0,1000,1000,1000);  { white => white }
  418.           Set_Color(1,0,0,0);           { black => black }
  419.           Set_Color(2,1000,0,0);        { red   => red }
  420.           Set_Color(3,0,0,1000);        { green => blue }
  421.           rez := 2 { set it to my rez }
  422.        END
  423.        ELSE IF int_out[4] = 1 THEN BEGIN { high rez }
  424.           Set_Color(0,1000,1000,1000);   { white }
  425.           Set_Color(1,0,0,0);            { black }
  426.           Set_Color(2,0,0,0);            { black }
  427.           Set_Color(3,0,0,0);            { black }
  428.           rez := 1
  429.        END
  430.        ELSE BEGIN { low rez or anything else }
  431.           temp := CONCAT('[3][Opus requires medium or|' ,
  432.                              'high resolution...][  I''ll switch ]');
  433.           i := Do_Alert(temp,1);
  434.           End_Update;
  435.           Exit_Gem;
  436.           Halt
  437.        END;
  438.        screen_mfdb.address := 0; { sufficient to access screen }
  439.        WITH mem_mfdb DO BEGIN
  440.           address := Addr(blit_buffer);
  441.           wid_pix := screen_width;
  442.           ht_pix := screen_height;
  443.           wid_wds := wid_pix DIV 16;
  444.           format := 0;
  445.           planes := int_out[4]; { from Extended_Inquire(1) }
  446.           res1 := 0; { unused vars, but it's recommended to set to zero as  }
  447.           res2 := 0; { they may have significance in future versions of GEM }
  448.           res3 := 0
  449.        END;
  450.        IF rez = 1 THEN
  451.           cell_height := 17
  452.        ELSE
  453.           cell_height := 9;
  454.        two_cell_h := 2*cell_height; { commonly used values }
  455.        three_cell_h := 3*cell_height
  456.    END; { CHECK_REZ }
  457.  
  458. PROCEDURE INITIALIZE;
  459.    LABEL 1;
  460.    TYPE Switcheroo = RECORD
  461.                           CASE BYTE OF
  462.                              1 : ( str      : STR10 );
  463.                              2 : ( switched : ThreeHundredBytes )
  464.                           END;
  465.    VAR i,j,k,handle : INTEGER;
  466.        n            : LONG_INTEGER;
  467.        c_s          : C_STRING;
  468.        buffer       : Switcheroo;
  469.        m            : PrinterSpecial;
  470.    PROCEDURE ERROR;
  471.       BEGIN
  472.           handle := -1;
  473.           temp := CONCAT('[1][Read error while loading|' ,
  474.                              'PRINTER.INF. No special|' ,
  475.                              'codes will be used when|' ,
  476.                              'printing.][  OK  ]');
  477.           i := Do_Alert(temp,1);
  478.           GOTO 1
  479.       END; { ERROR }
  480.    PROCEDURE READ_BYTES ( n : LONG_INTEGER );
  481.       BEGIN
  482.           IF TOS_Read(handle,n,buffer.switched) <> n THEN 
  483.              error
  484.       END; { READ_BYTES }
  485.    FUNCTION PTR_TO_LONG ( addr : Generic_Ptr ) : LONG_INTEGER;
  486.       EXTERNAL;
  487.    BEGIN
  488.        check_rez;
  489.        drive := TOS_Get_Drive;
  490.        i := TOS_Get_Directory(directory,0);
  491.        C_To_Pascal(directory,full_path);
  492.        full_path := CONCAT(CHR(drive+65),':',full_path);
  493.        IF rez = 1 THEN
  494.           temp_1 := 'H'
  495.        ELSE
  496.           temp_1 := 'M';
  497.        temp := CONCAT(full_path,'\OPUS',temp_1,'.RSC');
  498.        IF NOT Load_Resource(temp) THEN BEGIN
  499.           temp := CONCAT('[3][OPUS',temp_1,'.RSC was not found!|' ,
  500.                              'It must live in the same|' ,
  501.                              'directory as OPUS.PRG.][ Cancel ]');
  502.           alert := Do_Alert(temp,1);
  503.           End_Update;
  504.           Exit_Gem;
  505.           HALT
  506.        END;
  507.        Find_Menu(mainmenu,main_menu); { main_menu is the pointer }
  508.        IF rez = 1 THEN { high rez }
  509.           Menu_Enable(main_menu,msmall);
  510.        Find_Dialog(infodial,info_ptr);
  511.        Find_Dialog(fmatdial,fmat_ptr);
  512.        Find_Dialog(vfrmdial,vfrm_ptr);
  513.        Find_Dialog(gotodial,goto_ptr);
  514.        Find_Dialog(repdial,rep_ptr);
  515.        Find_Dialog(prdial,print_ptr);
  516.        Find_Dialog(sortdial,sort_ptr);
  517.        Find_Dialog(rangdial,rang_ptr);
  518.        Find_Dialog(errdial,err_ptr);
  519.        Find_Dialog(statdial,stat_ptr);
  520.        Find_Dialog(pagedial,page_ptr);
  521.        Find_Dialog(keydial,key_ptr);
  522.        Find_Dialog(formdial,form_ptr);
  523.        Find_Dialog(prhdial,prhelp_ptr);
  524.        Find_Dialog(mhlpdial,mhelp_ptr);
  525.        Find_Dialog(crefdial,crefhelp_ptr);
  526.        Find_Dialog(rechdial,rechelp_ptr);
  527.        Find_Dialog(datadial,data_fill_ptr);
  528.        Find_Dialog(frzdial,freeze_ptr);
  529.        Find_Dialog(actdial,action_ptr);
  530.        Find_Dialog(newdesk,new_desk_ptr);
  531.        hide;
  532.        Form_Anywhere(new_desk_ptr,0,cell_height+2,w_1,h_1);
  533.        Obj_Size(new_desk_ptr,panel,fo_x,fo_y,fo_w,fo_h);
  534.        con_x := 0;
  535.        con_y := fo_y+fo_h+4;
  536.        con_w := screen_width;
  537.        con_h := screen_height-con_y;
  538.        Obj_Size(new_desk_ptr,editarea,area_x,area_y,area_w,area_h);
  539.        area_x := area_x+1;
  540.        area_w := area_w-2;
  541.        area_y := area_y+1;
  542.        area_h := area_h-2;
  543.        edit_x := area_x+8;
  544.        IF rez = 1 THEN
  545.           edit_y := area_y+13
  546.        ELSE
  547.           edit_y := area_y+6;   
  548.        FOR m := Init TO UnderOff DO
  549.            printer_codes[m] := '';
  550.        temp := CONCAT(full_path,'\PRINTER.INF');
  551.        Pascal_To_C(temp,c_s);
  552.        handle := TOS_Open(c_s,0);
  553.        IF handle >= 0 THEN BEGIN
  554.           read_bytes(11);
  555.           IF buffer.str <> 'opus print' THEN BEGIN
  556.              temp := CONCAT('[1][PRINTER.INF is corrupted.|' ,
  557.                                 'No special printer codes|' ,
  558.                                 'will be used.][  OK  ]');
  559.              alert := Do_Alert(temp,1);
  560.              handle := -1;
  561.              GOTO 1
  562.           END;
  563.           read_bytes(3);
  564.           port := buffer.switched[1];
  565.           nl_chr_line := buffer.switched[2];
  566.           con_chr_line := buffer.switched[3];
  567.           FOR m := Init TO Underoff DO BEGIN
  568.               read_bytes(1);
  569.               IF buffer.switched[1] > 0 THEN 
  570.                  IF TOS_Seek(-1,handle,1) < 0 THEN
  571.                     error
  572.                  ELSE BEGIN
  573.                     read_bytes(buffer.switched[1]+1);
  574.                     printer_codes[m] := buffer.str
  575.                  END
  576.           END
  577.        END
  578.        ELSE BEGIN
  579.           temp := CONCAT('[1][PRINTER.INF was not found.|' ,
  580.                              'No special printer codes|' ,
  581.                              'will be used.][  OK  ]');
  582.           alert := Do_Alert(temp,1)
  583.        END;                   
  584. 1:     IF handle < 0 THEN BEGIN
  585.           nl_chr_line := 80;
  586.           con_chr_line := 136;
  587.           port := Centronics;
  588.           FOR m := Init TO UnderOff DO
  589.               printer_codes[m] := ''
  590.        END;       
  591.        default_path[1] := CONCAT(full_path,'\*.OPS');
  592.        default_path[2] := CONCAT(full_path,'\*.DOC');
  593.        current_file := '';
  594.        n_hdls := 1;
  595.        t_1 := ' WorkSheet1 ';
  596.        t_2 := ' WorkSheet2 ';
  597.        w_idx := 1; { index into w_pos array }
  598.        w_pos[w_idx,first_row] := 1; { usage example }
  599.        w_pos[1,first_col] := 1; { Note that for the opening window we needn't }
  600.        w_pos[1,hot_row] := 1;   { specify the finish or scr. pos. parms.      }
  601.        w_pos[1,hot_col] := 1;   { These are relevant for restoring the        }
  602.                                 { values after redraws. The second window is  }
  603.                                 { always set to the 1st attr when opened.     }
  604.                                 
  605.        act_hdl := New_Window(G_All,t_1,con_x,con_y,con_w,con_h);
  606.        IF act_hdl = No_Window THEN BEGIN
  607.           alert := Do_Alert('[3][GEM has no more windows!][ Cancel ]',1);
  608.           Free_Resource;
  609.           End_Update;
  610.           Exit_Gem;
  611.           HALT
  612.        END;
  613.        w_pos[1,w_hdl] := act_hdl;
  614.        init_functions;
  615.        e_table[1] := e;
  616.        e_table[2] := 7.3890560989;
  617.        e_table[3] := 54.598150033;
  618.        e_table[4] := 2.9809579871E3;
  619.        e_table[5] := 8.8861105206E6;
  620.        e_table[6] := 7.8962960185E13;
  621.        e_table[7] := 6.2351490811E27;
  622.        user_quit := FALSE;
  623.        block_set := FALSE;
  624.        block_st_set := FALSE;
  625.        block_end_set := FALSE;
  626.        did_recalc := FALSE;
  627.        redraw_flag := FALSE;
  628.        auto_recalc := TRUE;
  629.        natural := TRUE;
  630.        auto_cursor := TRUE;
  631.        grid_flag := TRUE;
  632.        m1s := FALSE;
  633.        m2s := FALSE;
  634.        m3s := FALSE;
  635.        m4s := FALSE;
  636.        p_row_col := TRUE;
  637.        print_formulas := FALSE;
  638.        form_flag := FALSE;
  639.        small_text := FALSE;
  640.        draft_final := TRUE;
  641.        condensed_print := FALSE;
  642.        p_title_1 := '';
  643.        p_title_2 := '';
  644.        header := '';
  645.        footer := '^c-^p-';
  646.        error_msg[GenError] := 'Error';
  647.        error_msg[SyntaxErr] := 'SyntaxErr';
  648.        error_msg[OutOfRange] := 'OutOfRange'; 
  649.        error_msg[BadRef] := 'BadCellRef'; 
  650.        error_msg[Overflow] := 'Overflow';    
  651.        error_msg[DivBy0] := 'DivBy0';
  652.        error_msg[Undefined] := 'Undefined'; 
  653.        error_msg[BadReal] := 'BadReal';
  654.        days[1] := 'monday';
  655.        days[2] := 'tuesday';
  656.        days[3] := 'wednesday';
  657.        days[4] := 'thursday';
  658.        days[5] := 'friday';
  659.        days[6] := 'saturday';
  660.        days[7] := 'sunday';
  661.        months[1] := 'january';
  662.        months[2] := 'february';
  663.        months[3] := 'march';
  664.        months[4] := 'april';
  665.        months[5] := 'may';
  666.        months[6] := 'june';
  667.        months[7] := 'july';
  668.        months[8] := 'august';
  669.        months[9] := 'september';
  670.        months[10] := 'october';
  671.        months[11] := 'november';
  672.        months[12] := 'december';
  673.        cursor_direction := CursorDown;
  674.        FOR i := 1 TO n_cols DO BEGIN  { the pixel-width is not an exact    }
  675.            col_width[i,spaces] := 10; { multiple of 8 so that the grid     }
  676.            col_width[i,pixels] := 80  { lines may start and end on an 'on' }
  677.        END;                           { pixel; prevents 'shifting' lines   }
  678.                                       { when blitting in high rez }
  679.        char1 := 'A';
  680.        FOR i := 1 TO 26 DO BEGIN
  681.            col_name[i] := char1;
  682.            char1 := SUCC(char1)
  683.        END;
  684.        char1 := PRED('A');
  685.        FOR i := 27 TO n_cols DO BEGIN
  686.            IF (i-27) MOD 26 = 0 THEN
  687.               char1 := SUCC(char1);
  688.            IF (i-27) MOD 26 = 0 THEN
  689.               char2 := 'A'
  690.            ELSE
  691.               char2 := SUCC(char2);
  692.            col_name[i] := CONCAT (char1,char2)
  693.        END;
  694.        FOR i := 1 TO 4 DO BEGIN
  695.            marks[i].row := 0; { the 4 actual marks; 0 = not set }
  696.            marks[i].col := 0
  697.        END;
  698.        
  699.        default_format := $02; { right just; 2 dec places, no sci; no percent }
  700.        up_case := [ 'A'..'Z' ];
  701.        low_case := [ 'a'..'z' ];
  702.        digits := [ '0'..'9' ];
  703.        float := digits+[ '.' , 'E' , 'e' , '+' , '-' ];
  704.        Single := [LogOp..NotOp];
  705.        Double := [DivOp..TruncOp];
  706.        Multiple := [AndOp..OrOp];
  707.        Aggregate := [CountOp..PredVOp];
  708.        Financial := [PvOp..NPerOp];
  709.        LookUp := [VLookUpOp..IndexOp];
  710.        too_long := CONCAT ('[1][You have now entered the|' ,
  711.                                'maximum allowed number of|'  ,
  712.                                'characters...][  OK  ]');
  713.        float_over := CONCAT ('[1][<< Floating point overflow >>|' ,
  714.                                  ' |',
  715.                                  'Numbers must fall within this|' ,
  716.                                  'range:|' ,
  717.                                  '     +/- 1 E +/- 37][  OK  ]');
  718.        null_str := '';
  719.        FOR i := 0 TO n_rows DO
  720.            data[i] := NIL;
  721.        Hide_Mouse;
  722.        Set_Mouse(M_Arrow);
  723.        Draw_Menu(main_menu);
  724.        data_row := 1;
  725.        data_col := 1;
  726.        set_up_cell_name;
  727.        Wind_Set(0,WF_NewDesk,INT(ShR(ptr_to_long(new_desk_ptr),16)),
  728.                 INT(ptr_to_long(new_desk_ptr) & $0000FFFF),
  729.                 Root,Max_Depth);
  730.        Form_Dial(3,0,0,screen_width,screen_height,
  731.                    0,0,screen_width,screen_height);
  732.        Open_Window(act_hdl,con_x,con_y,con_w,con_h);
  733.        Border_Rect(act_hdl,o_x,o_y,max_w,max_h); { original vals }
  734.        home_cursor(Origin);
  735.        default_draw_attributes;
  736.        freeze_row := 0;
  737.        freeze_col := 0;
  738.        logical_row_1 := 1;
  739.        logical_col_1 := 1;
  740.        x_margin := 38;
  741.        y_margin := cell_height-1;
  742.        Show_Mouse
  743.    END; (* INITIALIZE *)
  744.  
  745. BEGIN { PROGRAM }
  746.     WHILE KeyPress DO
  747.        long_key := BConIn(2); { clean junk out of keyboard }
  748.     ap_id := Init_Gem;        { save for sending self messages, also for }
  749.     IF ap_id >= 0 THEN BEGIN  { possible communication with accs         }
  750.        Begin_Update;
  751.        initialize;
  752.        { make smaller to account for procedure vars, space returned to stack
  753.          that isn't useful, etc. So this in effect reserves 20K bytes for the
  754.          stack, since we won't allocate the cells which could fit in this
  755.          space. Do this here rather than in INITIALIZE because to get the
  756.          heap size, it subtracts that space between start of heap and 
  757.          end of stack, and any proc variables on the stack detract from 
  758.          Memavail }
  759.        original_memory := MemAvail*2-20000; { words -> bytes }
  760.        working_memory := original_memory;
  761.        REPEAT { heart of the program }
  762.            inp_code := NoCode;
  763.            mask_out_recalc;
  764.            { NOTE: window_input is passed a formula if cell is class F or a
  765.                    string if class A;
  766.                    if no changes in this item are made, it returns the value
  767.                    NULL, and thus the cell is not affected in ANY WAY }
  768.            temp := '';
  769.            ptr := locate_cell(data_row,data_col);
  770.            IF ptr <> NIL THEN
  771.               IF ptr^.class <> Val THEN BEGIN
  772.                  IF ptr^.str <> NIL THEN BEGIN
  773.                     inp_code := w_F;
  774.                     temp := ptr^.str^
  775.                  END;
  776.                  window_input(string_len,AlphaNumeric,temp)
  777.               END  { see wind_inp.pas for global vars it uses }
  778.               ELSE
  779.                  window_input(float_len,FloatingPoint,temp)
  780.            ELSE
  781.               window_input(float_len,FloatingPoint,temp);
  782.            evaluate_input
  783.        UNTIL user_quit; 
  784.        { clean up... }
  785.        End_Update;
  786.        Erase_Menu(main_menu); { needn't delete_menu since I used RCS }
  787.        { close & delete windows so we don't crash GEM }
  788.        IF n_hdls = 2 THEN BEGIN
  789.           Close_Window(w_pos[2,w_hdl]);
  790.           Delete_Window(w_pos[2,w_hdl])
  791.        END;
  792.        Close_Window(w_pos[1,w_hdl]); { which is always present }
  793.        Delete_Window(w_pos[1,w_hdl]);
  794.        Set_Palette(palette); { restore user's colors }
  795.        Wind_Set(0,WF_NewDesk,0,0,Root,Max_Depth); { tell Desktop to use }
  796.        Form_Dial(3,0,0,screen_width,screen_height,{ its own definition  }
  797.                    0,0,screen_width,screen_height);
  798.        Free_Resource; { give GEM the memory back }
  799.        Exit_Gem
  800.     END (* IF ap_id >= 0 *)
  801. END.
  802.  
  803.  
  804.  
  805.