home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / apps / spread / opusprg / opussrc / bf.pas < prev    next >
Pascal/Delphi Source File  |  1988-05-12  |  36KB  |  894 lines
  1.  
  2.  
  3. {$M+}
  4. {$E+}
  5.  
  6. PROGRAM Mock;
  7.  
  8.    {$I i:\opus.i}
  9.    {$I i:\gctv.inc}
  10.    
  11.    {$I i:\gemsubs.def}
  12.    {$I i:\globsubs.def}
  13.    {$I i:\vdi_aes.def}
  14.    {$I d:\pascal\opus\gemdos.def}
  15.    {$I d:\pascal\opus\resource.def}
  16.    {$I d:\pascal\opus\graphout.def}
  17.    {$I d:\pascal\opus\stringfn.def}
  18.  
  19. PROCEDURE DO_PRINT ( s_row,f_row,s_col,f_col : INTEGER; hdl : INTEGER );
  20.    EXTERNAL;
  21.  
  22. PROCEDURE HILIGHT_BLOCK;
  23.    { either does inverse the block or restores it to normal depending on
  24.      whether already inversed or not }
  25.    VAR i,j : INTEGER;
  26.    BEGIN
  27.        Hide_Mouse;
  28.        Work_Rect(act_hdl,x_1,y_1,w_1,h_1);
  29.        Set_Clip(x_1,y_1,w_1,h_1);
  30.        FOR i := start_row TO virtual_f_row DO
  31.            FOR j := start_col TO virtual_f_col DO
  32.                IF (i >= b_s_row) AND (i <= b_e_row) AND
  33.                   (j >= b_s_col) AND (j <= b_e_col) THEN
  34.                   toggle_inverse(Black,i,j);
  35.        IF n_hdls = 2 THEN BEGIN
  36.           switch_window;
  37.           Send_Redraw(FALSE,0,0,screen_width,screen_height);
  38.           switch_window
  39.        END;
  40.        Show_Mouse
  41.    END; { HILIGHT_BLOCK }
  42.  
  43. FUNCTION START_BLOCK : BOOLEAN;
  44.    VAR temp : INTEGER;
  45.    BEGIN
  46.        IF block_set THEN
  47.           hilight_block;
  48.        b_s_row := data_row;
  49.        b_s_col := data_col;
  50.        block_st_set := TRUE;
  51.        IF block_end_set THEN BEGIN
  52.           IF b_s_row > b_e_row THEN BEGIN
  53.              temp := b_e_row;
  54.              b_e_row := b_s_row;
  55.              b_s_row := temp
  56.           END;
  57.           IF b_s_col > b_e_col THEN BEGIN
  58.              temp := b_e_col;
  59.              b_e_col := b_s_col;
  60.              b_s_col := temp
  61.           END;
  62.           block_set := TRUE;
  63.           hilight_block;
  64.           adjust_menu(TRUE)
  65.        END;   
  66.        start_block := block_set
  67.    END; { START_BLOCK }
  68.  
  69. FUNCTION END_BLOCK : BOOLEAN;
  70.    VAR temp : INTEGER;
  71.    BEGIN
  72.        IF block_set THEN
  73.           hilight_block;
  74.        b_e_row := data_row;
  75.        b_e_col := data_col;
  76.        block_end_set := TRUE;
  77.        IF block_st_set THEN BEGIN
  78.           IF b_s_row > b_e_row THEN BEGIN
  79.              temp := b_e_row;
  80.              b_e_row := b_s_row;
  81.              b_s_row := temp
  82.           END;
  83.           IF b_s_col > b_e_col THEN BEGIN
  84.              temp := b_e_col;
  85.              b_e_col := b_s_col;
  86.              b_s_col := temp
  87.           END;
  88.           block_set := TRUE;
  89.           hilight_block;
  90.           adjust_menu(TRUE)
  91.        END;   
  92.        end_block := block_set
  93.    END; { END_BLOCK }
  94.  
  95. FUNCTION DESELECT_BLOCK : BOOLEAN;
  96.    VAR i,j,row,col : INTEGER;
  97.    BEGIN
  98.        IF block_set THEN
  99.           hilight_block;
  100.        adjust_menu(FALSE);
  101.        block_set := FALSE;
  102.        block_st_set := FALSE;
  103.        block_end_set := FALSE;
  104.        deselect_block := TRUE
  105.    END; { DESELECT_BLOCK }
  106.  
  107. PROCEDURE DELETE_BLOCK;
  108.    VAR i,j        : INTEGER;
  109.        successful : BOOLEAN;
  110.    BEGIN
  111.        temp := CONCAT('[3][Do you really wish to DELETE|' ,
  112.                           'the block? Data will be|' ,
  113.                           'irreversibly lost!]',
  114.                           '[ Cancel |OK]');
  115.        IF Do_Alert(temp,2) = 2 THEN BEGIN
  116.           Set_Mouse(M_Bee);
  117.           delete_range(b_s_row,b_s_col,b_e_row,b_e_col,TRUE);
  118.           successful := deselect_block;
  119.           block_set := FALSE;
  120.           block_st_set := FALSE;
  121.           block_end_set := FALSE;
  122.           Set_Mouse(M_Arrow)
  123.        END
  124.    END; { DELETE_BLOCK }
  125.    
  126. FUNCTION DO_PASTE ( src_row,   { nominally the row of origin }
  127.                     dest_row,  { row number to be pasted to }
  128.                     dest_col,  { col number to be pasted at }
  129.                     st_r,st_c, { definitions of the source block }
  130.                     e_r,e_c        : INTEGER;
  131.                     do_relative,
  132.                     draw           : BOOLEAN  ) : BOOLEAN;
  133.    { This function is used by SHIFT_BLOCK and LOAD_FILE when "load block at
  134.      cursor" was chosen.  It assumes that a buffer row has been built in 
  135.      row 0, and src_row should equal the current row number within the
  136.      source block. It operates ONE row at a time. }
  137.    VAR col,offset    : INTEGER;
  138.        quit          : BOOLEAN;
  139.        ptr,ptr1,ptr2 : CellPtr;
  140.    BEGIN   
  141.        offset := dest_col-st_c;
  142.        quit := FALSE;
  143.        ptr1 := data[0];
  144.        WHILE (ptr1 <> NIL) AND (NOT quit) DO BEGIN
  145.           col := ptr1^.c+offset;
  146.           IF comp_assign(0,ptr1^.c,dest_row,col,FALSE) THEN BEGIN
  147.              ptr2 := locate_cell(dest_row,col);
  148.              IF ptr2 <> NIL THEN
  149.                 IF (ptr2^.class = Expr) AND
  150.                    (ptr2^.status <> Empty) THEN BEGIN
  151.                    IF do_relative THEN { adjust refs within block }
  152.                       IF adjust_expr(adj_refs,ptr2,src_row,ptr1^.c,
  153.                                      dest_row,col,
  154.                                      st_r,st_c,e_r,e_c) <> OK THEN
  155.                          quit := TRUE; { OutOfRange error }
  156.                    IF NOT quit THEN      
  157.                       all_lists(add,ptr2,dest_row,col);
  158.                 END
  159.           END
  160.           ELSE BEGIN
  161.              Set_Mouse ( M_Arrow );
  162.              out_mem_cell(dest_row,ptr1^.c,'pasted to');
  163.              alert := Do_Alert(temp,1);
  164.              quit := TRUE
  165.           END;
  166.           IF draw THEN
  167.              cell_on_screen(1,dest_row,col,TRUE);
  168.           delete_cell(0,ptr1^.c,FALSE); { free slot in buffer }
  169.           ptr1 := data[0] { start of list }
  170.        END; { WHILE }
  171.        do_paste := NOT quit;
  172.        clear_buffer
  173.    END; { DO_PASTE }       
  174.  
  175. PROCEDURE SHIFT_BLOCK ( action,
  176.                         dest_r,dest_c,
  177.                         st_r,st_c,e_r,e_c  : INTEGER );
  178.    { procedure physically moves/copies and redraws a block defined by
  179.      the block bouds parameters. Called by transport block with action of
  180.      mmove, mcopy; called by sheet_insert with action of mmove to insert a
  181.      row or column }
  182.    LABEL 1;
  183.    VAR i,j,m,n,r,offset,
  184.        b_row_begin,b_row_end,
  185.        d_row_begin,d_row_end,
  186.        row_inc,num_rows,num_cols : INTEGER;
  187.        do_relative,dummy,done    : BOOLEAN;
  188.        ptr                       : CellPtr;
  189.    { use a work_cell because we need to use comp_assign which expects
  190.      whole cell arguments and since the source str may be altered if
  191.      it is an Expr and contains relative cell refs; this way, the 
  192.      source is left alone, which is what we want if say, we're copying }
  193.    BEGIN { SHIFT_BLOCK }
  194.        num_rows := e_r-st_r+1;
  195.        num_cols := e_c-st_c+1;
  196.        temp:='[2][Treat cell references as:][ Absolute | Relative ]';
  197.        IF Do_Alert(temp,2) = 2 THEN
  198.           do_relative := TRUE
  199.        ELSE
  200.           do_relative := FALSE;
  201.        IF st_r > dest_r THEN BEGIN
  202.           b_row_begin := st_r;
  203.           b_row_end := e_r;
  204.           d_row_begin := dest_r;
  205.           d_row_end := dest_r+num_rows-1;
  206.           row_inc := 1;
  207.        END
  208.        ELSE BEGIN
  209.           b_row_begin := e_r;
  210.           b_row_end := st_r;
  211.           d_row_begin := dest_r+num_rows-1;
  212.           d_row_end := dest_r;
  213.           row_inc := -1;
  214.        END;
  215.        done := FALSE;
  216.        Set_Mouse(M_Bee);
  217.        m := b_row_begin;
  218.        i := d_row_begin;
  219.        offset := dest_c-st_c;
  220.        clear_buffer;
  221.        WHILE NOT done DO BEGIN
  222.           { build buffer area }
  223.           ptr := data[m];
  224.           WHILE ptr <> NIL DO BEGIN
  225.              IF (ptr^.c >= st_c) AND (ptr^.c <= e_c) THEN BEGIN
  226.                 IF NOT comp_assign(m,ptr^.c,0,ptr^.c,FALSE) THEN BEGIN
  227.                    int_to_string(m,temp);
  228.                    temp := CONCAT('[3][Not enough memory to build|' ,
  229.                                       'buffer row therefore row|' ,
  230.                                       temp ,
  231.                                       ' was not pasted.][ Cancel ]');
  232.                    alert := Do_Alert(temp,1);
  233.                    GOTO 1
  234.                 END
  235.              END;
  236.              ptr := ptr^.next
  237.           END;
  238.           { wait to delete source row until buffer row is constructed since
  239.             if out of mem occurred, and we deleted as we went along, the row
  240.             up to that point would be gone }
  241.           IF action = mmove THEN 
  242.              delete_range(m,st_c,m,e_c,TRUE);
  243.           { delete the dest row }   
  244.           delete_range(i,dest_c,i,dest_c+num_cols-1,TRUE);   
  245.           { finally do the paste, deleting the buffer as we go, so chances of
  246.             an out of mem error are exceedingly small }
  247.           IF NOT do_paste(m,i,dest_c,st_r,st_c,e_r,e_c,
  248.                           do_relative,TRUE) THEN
  249.              GOTO 1;
  250.           IF i = d_row_end THEN
  251.              done := TRUE
  252.           ELSE BEGIN
  253.              i := i+row_inc;
  254.              m := m+row_inc
  255.           END
  256.        END; { WHILE NOT done }
  257. 1:     clear_buffer; { just in case }
  258.        Set_Mouse(M_Arrow)
  259.    END; { SHIFT_BLOCK }
  260.  
  261. FUNCTION TRANSPORT_BLOCK ( action : INTEGER ) : BOOLEAN;
  262.    { depending on action, copies or moves a marked block to another
  263.      location, beginning at the current cell. Also copies cell_format
  264.      regardless of action. Possible values are: mmove, mcopy }
  265.    LABEL 2;
  266.    VAR
  267.        num_rows,num_cols : INTEGER;
  268.        a,b               : STR10;
  269.        dummy             : BOOLEAN;
  270.    BEGIN
  271.        num_rows := b_e_row-b_s_row+1;
  272.        num_cols := b_e_col-b_s_col+1;
  273.        transport_block := FALSE;
  274.        IF (data_row+num_rows-1 <= n_rows) AND
  275.           (data_col+num_cols-1 <= n_cols) THEN BEGIN
  276.           IF (data_row = b_s_row) AND (data_col = b_s_col) THEN BEGIN
  277.              temp := CONCAT('[3][You may not copy or move|' ,
  278.                                 'a block to itself! Move the|' ,
  279.                                 'cursor to a position other|' ,
  280.                                 'than the start of the block.][  OK  ]');
  281.              alert := Do_Alert(temp,1);
  282.              GOTO 2 { exit }
  283.           END;
  284.           IF action = mmove THEN
  285.              temp := 'MOVE'
  286.           ELSE
  287.              temp := 'COPY';
  288.           temp := CONCAT('[2][Really ' , temp , ' block?][ Cancel |OK]');
  289.           IF Do_Alert(temp,2) = 2 THEN BEGIN
  290.              shift_block(action,data_row,data_col,b_s_row,b_s_col,
  291.                          b_e_row,b_e_col);
  292.              IF action = mmove THEN BEGIN
  293.                 dummy := deselect_block;
  294.                 block_set := TRUE;
  295.                 block_st_set := TRUE;
  296.                 block_end_set := TRUE;
  297.                 b_s_row := data_row;
  298.                 b_s_col := data_col;
  299.                 b_e_row := data_row+num_rows-1;
  300.                 b_e_col := data_col+num_cols-1;
  301.                 adjust_menu(TRUE);
  302.                 hilight_block
  303.              END   
  304.           END               
  305.           ELSE { falls through }
  306.        END
  307.        ELSE BEGIN
  308.           a := col_name[n_cols-num_cols+1];
  309.           int_to_string(n_rows-num_rows+1,b);
  310.           block_too_big(a,b);
  311.           transport_block := FALSE
  312.        END;
  313. 2: END; { TRANSPORT_BLOCK }
  314.  
  315.  
  316. (************************************************************************)
  317. (*                             File IO                                  *)
  318. (************************************************************************)
  319.  
  320.  
  321.  
  322. PROCEDURE ACTION_BANNER ( action : STR10 );
  323.    BEGIN
  324.        Hide_Mouse;
  325.        fo_x := 512;
  326.        IF rez = 1 THEN
  327.           fo_y := 57
  328.        ELSE
  329.           fo_y := 29;
  330.        Form_Anywhere(action_ptr,fo_x,fo_y,fo_w,fo_h);
  331.        fo_x := fo_x-3; { now account for outline around dialog, since }
  332.        fo_y := fo_y-3; { the width and height in the object def don't }
  333.        fo_w := fo_w+6;
  334.        fo_h := fo_h+6;
  335.        Set_Text(action_ptr,actwhat,action,s1,10);
  336.        Form_Dial(0,0,0,0,0,fo_x,fo_y,fo_w,fo_h);
  337.        Obj_Draw(action_ptr,Root,Max_Depth,fo_x,fo_y,fo_w,fo_h);
  338.        Show_Mouse
  339.    END; { ACTION_BANNER }
  340.  
  341. FUNCTION FILE_TO_C ( VAR whole_name : STRING; 
  342.                      VAR c_name     : C_STRING;
  343.                      what           : DiskIoOps ) : BOOLEAN;
  344.    { GEMDOS wants a "C" type string }                  
  345.    BEGIN
  346.        IF POS('.',whole_name) = 0 THEN
  347.           IF what = SaveText THEN
  348.              whole_name := CONCAT(whole_name,'.DOC')
  349.           ELSE
  350.              whole_name := CONCAT(whole_name,'.OPS');
  351.        IF Filename(whole_name) THEN BEGIN
  352.           Pascal_To_C(whole_name,c_name);
  353.           file_to_c := TRUE
  354.        END
  355.        ELSE
  356.           file_to_c := FALSE   
  357.    END; { FILE_TO_C }
  358.    
  359. FUNCTION GET_FILE_NAME ( VAR c_name : C_STRING;
  360.                          what       : DiskIoOps ) : BOOLEAN;
  361.    { present file selector }
  362.    VAR i : INTEGER;
  363.    BEGIN
  364.        get_file_name := FALSE;
  365.        IF what = SaveText THEN
  366.           i := 2
  367.        ELSE
  368.           i := 1;
  369.        IF Get_In_File(default_path[i],current_file) THEN { user pressed OK }
  370.           IF file_to_c(current_file,c_name,what) THEN { valid file name? }
  371.              get_file_name := TRUE
  372.           ELSE { oh oh }
  373.              alert := Do_Alert('[1][Bad path/file name.][ Cancel ]',1)
  374.    END; { GET_FILE_NAME }
  375.    
  376. FUNCTION CREATE_FILE ( VAR c_name : C_STRING; VAR handle : INTEGER ) : BOOLEAN;
  377.    BEGIN
  378.        handle := TOS_Create(c_name,0);
  379.        IF handle >= 0 THEN
  380.           create_file := TRUE
  381.        ELSE BEGIN
  382.           create_file := FALSE;
  383.           Form_Error(handle)
  384.        END   
  385.    END; { CREATE_FILE }       
  386.           
  387. FUNCTION OPEN_FILE ( VAR c_name : C_STRING; VAR handle : INTEGER ) : BOOLEAN;
  388.    BEGIN   
  389.        handle := TOS_Open(c_name,0);
  390.        IF handle >= 0 THEN
  391.           open_file := TRUE
  392.        ELSE BEGIN
  393.           open_file := FALSE;
  394.           Form_Error(handle)
  395.        END
  396.    END; { OPEN_FILE }
  397.  
  398. PROCEDURE CLOSE_FILE ( handle : INTEGER );
  399.    BEGIN
  400.        handle := TOS_Close(handle);
  401.        IF handle < 0 THEN { probably will never happen }
  402.           Form_Error(handle)
  403.    END; { CLOSE_FILE }
  404.    
  405. PROCEDURE SAVE_FILE ( what : DiskIoOps; s_r,s_c,e_r,e_c : INTEGER );
  406.    LABEL 1;
  407.    VAR count                                   : BYTE;
  408.        i,j,k,m,handle,result                   : INTEGER;
  409.        quit                                    : BOOLEAN;
  410.        c_name                                  : C_STRING;
  411.        converter                               : Switcheroo;
  412.        int_buffer                              : HundredInts;
  413.        byte_buffer                             : ThreeHundredBytes;
  414.        ptr                                     : CellPtr;
  415.    FUNCTION Int_Write (     handle : INTEGER; n : LONG_INTEGER;
  416.                         VAR buf : HundredInts ) : LONG_INTEGER;
  417.       GEMDOS ($40);
  418.    PROCEDURE WRITE_BYTES ( n : LONG_INTEGER; VAR buffer : ThreeHundredBytes );
  419.       VAR bytes_written : LONG_INTEGER;
  420.       BEGIN
  421.           bytes_written := TOS_Write(handle,n,buffer);
  422.           IF bytes_written <> n THEN BEGIN
  423.              IF bytes_written >= 0 THEN
  424.                 alert := Do_Alert('[1][Not enough room on disk.][ Cancel ]',1)
  425.              ELSE
  426.                 Form_Error(bytes_written);   
  427.              GOTO 1 { quick exit }
  428.           END   
  429.       END; { WRITE_BYTES }   
  430.    PROCEDURE WRITE_INTS ( n : LONG_INTEGER; VAR buffer : HundredInts );
  431.       VAR ints_written : LONG_INTEGER;
  432.       BEGIN
  433.           ints_written := Int_Write(handle,n,buffer);
  434.           IF ints_written <> n THEN BEGIN
  435.              IF ints_written >= 0 THEN
  436.                 alert := Do_Alert('[1][Not enough room on disk.][ Cancel ]',1)
  437.              ELSE
  438.                 Form_Error(ints_written);   
  439.              GOTO 1 { quick exit }
  440.           END   
  441.       END; { WRITE_BYTES }   
  442.    BEGIN
  443.        IF what = SaveFile THEN { let user know what he's doing }
  444.           action_banner('Save Sheet')
  445.        ELSE
  446.           action_banner('Save Block');
  447.        IF get_file_name(c_name,what) THEN { valid file name? }
  448.           IF create_file(c_name,handle) THEN BEGIN { able to write to disk? }
  449.              Set_Mouse(M_Bee);
  450.              byte_buffer[1] := 1;  { write some numbers to indicate it's our }
  451.              byte_buffer[2] := 14; { file }
  452.              byte_buffer[3] := 85;
  453.              byte_buffer[4] := 10;
  454.              byte_buffer[5] := 22;
  455.              byte_buffer[6] := 84;
  456.              write_bytes(6,byte_buffer);
  457.              converter.str := p_title_1; { save the printer titles }
  458.              write_bytes(LENGTH(p_title_1)+1,converter.switched);
  459.              converter.str := p_title_2;
  460.              write_bytes(LENGTH(p_title_2)+1,converter.switched);
  461.              converter.str := header;
  462.              write_bytes(LENGTH(header)+1,converter.switched);
  463.              converter.str := footer;
  464.              write_bytes(LENGTH(footer)+1,converter.switched);
  465.              byte_buffer[1] := ORD(p_row_col); { print dialog variables }
  466.              byte_buffer[2] := ORD(print_formulas);
  467.              byte_buffer[3] := ORD(condensed_print);
  468.              byte_buffer[4] := ORD(draft_final);
  469.              byte_buffer[5] := ORD(grid_flag); { system variables }
  470.              byte_buffer[6] := ORD(small_text);
  471.              byte_buffer[7] := ORD(form_flag);
  472.              byte_buffer[8] := ORD(auto_cursor);
  473.              byte_buffer[9] := ORD(auto_recalc);
  474.              byte_buffer[10] := ORD(natural);
  475.              byte_buffer[11] := ORD(cursor_direction);
  476.              FOR i := 12 TO n_cols+11 DO { column widths }
  477.                  byte_buffer[i] := col_width[i-11,spaces];
  478.              write_bytes(n_cols+11,byte_buffer); { and write it to disk }
  479.              int_buffer[1] := default_format;
  480.              int_buffer[2] := s_r; { the coordinates of block we are writing }
  481.              int_buffer[3] := s_c;
  482.              int_buffer[4] := e_r;
  483.              int_buffer[5] := e_c;
  484.              i := 1; { prepare to save marks }
  485.              j := 6;
  486.              WHILE i < 5 DO BEGIN
  487.                 int_buffer[j] := marks[i].row;
  488.                 j := j+1;
  489.                 int_buffer[j] := marks[i].col;
  490.                 j := j+1;
  491.                 i := i+1
  492.              END;
  493.              int_buffer[14] := freeze_row;
  494.              int_buffer[15] := freeze_col;
  495.              write_ints(30,int_buffer);
  496.              FOR i := 1 TO n_rows DO BEGIN { do this way so a block may be    }
  497.                  ptr := data[i];           { easily loaded as if it was an    }
  498.                  count := 0;               { entire sheet. No extra data is   }
  499.                  WHILE ptr <> NIL DO BEGIN { saved, beyond count for each row }
  500.                     IF (i >= s_r) AND (i <= e_r) AND
  501.                        (ptr^.c >= s_c) AND (ptr^.c <= e_c) THEN
  502.                        count := count+1;
  503.                     ptr := ptr^.next
  504.                  END;
  505.                  byte_buffer[1] := count;    { so each row 1..999 has a count }
  506.                  write_bytes(1,byte_buffer); { of number cells in itself }
  507.                  IF (count > 0) AND { only write to disk if we are in range }         
  508.                     (i >= s_r) AND (i <= e_r) THEN BEGIN
  509.                     quit := FALSE;
  510.                     ptr := data[i];            
  511.                     WHILE (ptr <> NIL) AND (NOT (quit)) DO BEGIN
  512.                        WITH ptr^ DO 
  513.                           IF (c >= s_c) AND (c <= e_c) THEN BEGIN
  514.                              converter.c := c;
  515.                              write_bytes(2,converter.switched);
  516.                              converter.format := format;
  517.                              write_bytes(2,converter.switched);
  518.                              converter.class := class;
  519.                              write_bytes(2,converter.switched);
  520.                              converter.status := status;
  521.                              write_bytes(2,converter.switched);
  522.                              IF ((class = Val) OR (class = Expr)) AND 
  523.                                 (status = Full) THEN BEGIN
  524.                                 converter.number := num;
  525.                                 write_bytes(6,converter.switched);
  526.                              END;
  527.                              IF str <> NIL THEN BEGIN
  528.                                 converter.str := str^;
  529.                                 write_bytes(LENGTH(str^)+1,converter.switched)
  530.                              END
  531.                              ELSE BEGIN
  532.                                 byte_buffer[1] := 0;
  533.                                 write_bytes(1,byte_buffer)
  534.                              END
  535.                           END
  536.                           ELSE IF c > e_c THEN
  537.                              quit := TRUE;   
  538.                        ptr := ptr^.next
  539.                     END { WHILE }
  540.                  END { IF }
  541.              END; { FOR }
  542. 1:           close_file(handle);
  543.              Set_Mouse(M_Arrow)
  544.           END; { IF create_file }
  545.        Form_Dial(3,0,0,0,0,fo_x,fo_y,fo_w,fo_h)
  546.    END; { SAVE_FILE }
  547.  
  548. PROCEDURE LOAD_FILE ( what : DiskIoOps );
  549.    LABEL 1,2;
  550.    VAR count                                  : BYTE;
  551.        d,i,j,handle,result,s_r,s_c,e_r,e_c    : INTEGER;
  552.        did_load,at_cursor                     : BOOLEAN;
  553.        a,b                                    : STR10;
  554.        c_name                                 : C_STRING;
  555.        converter                              : Switcheroo;
  556.        int_buffer                             : HundredInts;
  557.        byte_buffer                            : ThreeHundredBytes;
  558.        ptr                                    : CellPtr;
  559.    FUNCTION Int_Read (     handle : INTEGER; n : LONG_INTEGER;
  560.                         VAR buf : HundredInts ) : LONG_INTEGER;
  561.       GEMDOS ($3F);
  562.    PROCEDURE MY_SEEK;
  563.       { Seeks back one byte after finding a string length > 0 }
  564.       VAR dis : LONG_INTEGER;
  565.       BEGIN
  566.           dis := TOS_Seek(-1,handle,1);
  567.           IF dis < 0 THEN BEGIN
  568.              Form_Error(dis);
  569.              GOTO 1
  570.           END
  571.       END; { MY_SEEK }
  572.    PROCEDURE READ_BYTES ( n : LONG_INTEGER; VAR buffer : ThreeHundredBytes );
  573.       VAR bytes_read : LONG_INTEGER;
  574.       BEGIN
  575.           bytes_read := TOS_Read(handle,n,buffer);
  576.           IF bytes_read <> n THEN BEGIN
  577.              IF bytes_read >= 0 THEN
  578.                 Form_Error(-11)
  579.              ELSE
  580.                 Form_Error(bytes_read);   
  581.              GOTO 1
  582.           END   
  583.       END; { READ_BYTES }    
  584.    PROCEDURE READ_INTS ( n : LONG_INTEGER; VAR buffer : HundredInts );
  585.       VAR ints_read : LONG_INTEGER;
  586.       BEGIN
  587.           ints_read := Int_Read(handle,n,buffer);
  588.           IF ints_read <> n THEN BEGIN
  589.              IF ints_read >= 0 THEN
  590.                 Form_Error(-11)
  591.              ELSE
  592.                 Form_Error(ints_read);    
  593.              GOTO 1
  594.           END   
  595.       END; { READ_INTS }    
  596.    PROCEDURE OUT_OF_MEM ( c : INTEGER );
  597.       BEGIN
  598.           Set_Mouse(M_Arrow);
  599.           out_mem_cell(i,c,'loaded');
  600.           GOTO 1
  601.        END; { OUT_OF_MEM }
  602.    PROCEDURE SET_FLAGS ( flag    : BOOLEAN;
  603.                          menu_id : INTEGER );
  604.       BEGIN
  605.           IF flag THEN
  606.              Menu_Check(main_menu,menu_id,TRUE)
  607.           ELSE
  608.              Menu_Check(main_menu,menu_id,FALSE)
  609.       END;
  610.    BEGIN { LOAD_FILE }
  611.        did_load := FALSE;
  612.        at_cursor := FALSE;
  613.        IF what = LoadFile THEN
  614.           action_banner ('Load Sheet')
  615.        ELSE 
  616.           action_banner ('Load Block');
  617.        IF get_file_name(c_name,what) THEN 
  618.           IF open_file(c_name,handle) THEN BEGIN
  619.              IF what = LoadBlock THEN BEGIN
  620.                 temp := CONCAT('[2][1. Load at original position|' ,
  621.                                    '2. Load at cursor][Cancel|1|2]' );
  622.                 alert := Do_Alert(temp,1);
  623.                 IF alert = 1 THEN                   
  624.                    GOTO 2
  625.                 ELSE 
  626.                    at_cursor := alert = 3
  627.              END;      
  628.              Set_Mouse(M_Bee);
  629.              read_bytes(6,byte_buffer); { read the header }
  630.              IF (byte_buffer[1] <> 1) OR (byte_buffer[2] <> 14) OR
  631.                 (byte_buffer[3] <> 85) OR (byte_buffer[4] <> 10) OR
  632.                 (byte_buffer[5] <> 22) OR (byte_buffer[6] <> 84) THEN BEGIN
  633.                 temp := CONCAT ('[3][Incorrect file-type or|' ,
  634.                                      'corrupted file.][ Cancel ]');
  635.                 alert := Do_Alert(temp,1);
  636.                 GOTO 1
  637.              END;
  638.              IF what = LoadFile THEN
  639.                 clear_worksheet;
  640.              block_set := FALSE;
  641.              block_st_set := FALSE;
  642.              block_end_set := FALSE;
  643.              adjust_menu(FALSE);
  644.              read_bytes(1,byte_buffer);
  645.              IF byte_buffer[1] > 0 THEN BEGIN
  646.                 my_seek;
  647.                 read_bytes(byte_buffer[1]+1,converter.switched);
  648.                 IF what = LoadFile THEN
  649.                    p_title_1 := converter.str
  650.              END
  651.              ELSE IF what = LoadFile THEN
  652.                 p_title_1 := '';
  653.              read_bytes(1,byte_buffer);
  654.              IF byte_buffer[1] > 0 THEN BEGIN
  655.                 my_seek;
  656.                 read_bytes(byte_buffer[1]+1,converter.switched);
  657.                 IF what = LoadFile THEN
  658.                    p_title_2 := converter.str
  659.              END
  660.              ELSE IF what = LoadFile THEN
  661.                 p_title_2 := '';
  662.              read_bytes(1,byte_buffer);
  663.              IF byte_buffer[1] > 0 THEN BEGIN
  664.                 my_seek;
  665.                 read_bytes(byte_buffer[1]+1,converter.switched);
  666.                 IF what = LoadFile THEN
  667.                    header := converter.str
  668.              END
  669.              ELSE IF what = LoadFile THEN
  670.                 header := '';
  671.              read_bytes(1,byte_buffer);
  672.              IF byte_buffer[1] > 0 THEN BEGIN
  673.                 my_seek;
  674.                 read_bytes(byte_buffer[1]+1,converter.switched);
  675.                 IF what = LoadFile THEN
  676.                    footer := converter.str
  677.              END
  678.              ELSE IF what = LoadFile THEN
  679.                 footer := '';
  680.              read_bytes(n_cols+11,byte_buffer);
  681.              IF what = LoadFile THEN BEGIN
  682.                 p_row_col := byte_buffer[1] = 1;
  683.                 print_formulas := byte_buffer[2] = 1;
  684.                 condensed_print := byte_buffer[3] = 1;
  685.                 draft_final := byte_buffer[4] = 1;
  686.                 grid_flag := byte_buffer[5] = 1;
  687.                 small_text := byte_buffer[6] = 1;
  688.                 form_flag := byte_buffer[7] = 1;
  689.                 auto_cursor := byte_buffer[8] = 1;
  690.                 auto_recalc := byte_buffer[9] = 1;
  691.                 natural := byte_buffer[10] = 1;
  692.                 IF byte_buffer[11] = 1 THEN
  693.                    cursor_direction := CursorRight
  694.                 ELSE
  695.                    cursor_direction := CursorDown;
  696.                 set_flags(grid_flag,mshowgri);
  697.                 set_flags(form_flag,mshowfor);
  698.                 set_flags(auto_cursor,mautocur);
  699.                 set_flags(auto_recalc,mautorec);
  700.                 set_flags(natural,mnatural);
  701.                 FOR i := 12 TO n_cols+11 DO BEGIN
  702.                     col_width[i-11,spaces] := byte_buffer[i];
  703.                     col_width[i-11,pixels] := byte_buffer[i]*8
  704.                 END
  705.              END;
  706.              read_ints(30,int_buffer);
  707.              s_r := int_buffer[2];
  708.              s_c := int_buffer[3];
  709.              e_r := int_buffer[4];
  710.              e_c := int_buffer[5];
  711.              IF (what = LoadBlock) AND (at_cursor) THEN
  712.                 IF (data_row+e_r-s_r > n_rows) OR 
  713.                    (data_col+e_c-s_c > n_cols) THEN BEGIN
  714.                    a := col_name[n_cols-(e_c-s_c)];
  715.                    int_to_string(n_rows-(e_r-s_r),b);
  716.                    block_too_big(a,b);
  717.                    GOTO 1
  718.                 END;                      
  719.              IF what = LoadFile THEN BEGIN
  720.                 default_format := int_buffer[1];
  721.                 i := 1;
  722.                 j := 6;
  723.                 WHILE i < 5 DO BEGIN
  724.                    marks[i].row := int_buffer[j];
  725.                    j := j+1;
  726.                    marks[i].col := int_buffer[j];
  727.                    i := i+1;
  728.                    j := j+1
  729.                 END;
  730.                 m1s := marks[1].row > 0;
  731.                 m2s := marks[2].row > 0;
  732.                 m3s := marks[3].row > 0;
  733.                 m4s := marks[4].row > 0;
  734.                 IF m1s THEN
  735.                    Menu_Enable(main_menu,mg1)
  736.                 ELSE
  737.                    Menu_Disable(main_menu,mg1);
  738.                 IF m2s THEN
  739.                    Menu_Enable(main_menu,mg2)
  740.                 ELSE
  741.                    Menu_Disable(main_menu,mg2);
  742.                 IF m3s THEN
  743.                    Menu_Enable(main_menu,mg3)
  744.                 ELSE
  745.                    Menu_Disable(main_menu,mg3);
  746.                 IF m4s THEN
  747.                    Menu_Enable(main_menu,mg4)
  748.                 ELSE
  749.                    Menu_Disable(main_menu,mg4);
  750.                 freeze_row := int_buffer[14];
  751.                 freeze_col := int_buffer[15];
  752.                 logical_row_1 := freeze_row+1;
  753.                 logical_col_1 := freeze_col+1;
  754.                 start_row := logical_row_1;
  755.                 start_col := logical_col_1;
  756.                 data_row := start_row;
  757.                 data_col :=start_col;
  758.                 IF freeze_row > 0 THEN
  759.                    y_margin := two_cell_h-1
  760.                 ELSE
  761.                    y_margin := cell_height-1;
  762.                 IF freeze_col > 0 THEN
  763.                    x_margin := 39+col_width[freeze_col,pixels]
  764.                 ELSE
  765.                    x_margin := 38;
  766.                { must do this so that switch will save correct finish_row &
  767.                  col so that return_attr can recalc correct v & h_entry.
  768.                  Failure to do this can lead to a crash when handle_message
  769.                  tries to calculate slider positions and these entry values
  770.                  equal n_rows or n_cols due to a non-updated finish row or
  771.                  col }
  772.                 get_num_scr_entries(ExRight);
  773.                 IF n_hdls = 2 THEN BEGIN
  774.                    switch_window;
  775.                    start_row := logical_row_1;
  776.                    start_col := logical_col_1;
  777.                    data_row := start_row;
  778.                    data_col := start_col;
  779.                    get_num_scr_entries(ExRight);
  780.                    switch_window
  781.                 END
  782.              END;
  783.              IF what = LoadBlock THEN
  784.                 IF at_cursor THEN
  785.                    delete_range(data_row,data_col,
  786.                                 data_row+e_r-s_r,data_col+e_c-s_c,FALSE)
  787.                 ELSE IF (s_r = 1) AND (s_c = 1) AND { just in case... }
  788.                         (e_r = n_rows) AND (e_c = n_cols) THEN
  789.                    clear_worksheet
  790.                 ELSE
  791.                    delete_range(s_r,s_c,e_r,e_c,FALSE);
  792.              clear_buffer;
  793.              FOR i := 1 TO n_rows DO BEGIN
  794.                  read_bytes(1,byte_buffer);
  795.                  count := byte_buffer[1];
  796.                  FOR j := 1 TO count DO BEGIN
  797.                      read_bytes(2,converter.switched);
  798.                      IF (what = LoadBlock) AND (at_cursor) THEN
  799.                         ptr := new_cell(0,converter.c)
  800.                      ELSE
  801.                         ptr := new_cell(i,converter.c);
  802.                      IF ptr <> NIL THEN
  803.                         WITH ptr^ DO BEGIN
  804.                            c := converter.c;
  805.                            read_bytes(2,converter.switched);
  806.                            format := converter.format;
  807.                            read_bytes(2,converter.switched);
  808.                            class := converter.class;
  809.                            read_bytes(2,converter.switched);
  810.                            status := converter.status;
  811.                            IF ((class = Val) OR (class = Expr)) AND 
  812.                               (status = Full) THEN BEGIN
  813.                               read_bytes(6,converter.switched);
  814.                               num := converter.number
  815.                            END;
  816.                            read_bytes(1,byte_buffer);
  817.                            IF byte_buffer[1] > 0 THEN BEGIN
  818.                               IF str = NIL THEN
  819.                                  IF request_memory(AString) THEN
  820.                                     NEW(str)
  821.                                  ELSE
  822.                                     out_of_mem(c);
  823.                               my_seek;
  824.                               read_bytes(byte_buffer[1]+1,converter.switched);
  825.                               str^ := converter.str;
  826.                               IF NOT ((what = LoadBlock) AND (at_cursor)) THEN
  827.                                  all_lists(add,ptr,i,c)
  828.                            END
  829.                         END
  830.                      ELSE
  831.                         out_of_mem(converter.c)
  832.                  END; { FOR j }
  833.                  IF (what = LoadBlock) AND (at_cursor) THEN 
  834.                     IF count > 0 THEN
  835.                        IF NOT do_paste(i,data_row+i-s_r,data_col,
  836.                                        s_r,s_c,e_r,e_c,at_cursor,FALSE) THEN
  837.                           GOTO 1;
  838.              END; { FOR i }
  839.              IF rez = 1 THEN BEGIN
  840.                 { do like this since the message handler flips small_text
  841.                   from TRUE to FALSE and vice-versa }
  842.                 small_text := NOT small_text;
  843.                 simulate_message(MN_Selected,moptions,msmall)
  844.              END
  845.              ELSE
  846.                 small_text := FALSE;
  847.              did_load := TRUE; 
  848. 1:           close_file(handle);
  849.              Set_Mouse(M_Arrow)
  850.           END; { IF open_file }
  851. 2:     Form_Dial(3,0,0,0,0,0,0,screen_width,screen_height);
  852.        clear_buffer
  853.    END; { LOAD_FILE }
  854.  
  855. PROCEDURE SAVE_TEXT ( s_r,s_c,e_r,e_c : INTEGER );
  856.    VAR handle,x,y,w,h : INTEGER;
  857.        c_name         : C_STRING;
  858.    BEGIN
  859.        print_spreadsheet(FALSE,'Save as Text',s_r,s_c,e_r,e_c);
  860.        IF s_r > 0 THEN BEGIN
  861.           action_banner('Save Text');
  862.           x := fo_x; { because do_print will wipe out these for its own }
  863.           y := fo_y; { nefarious purposes, i.e. displaying the page #   }
  864.           w := fo_w;
  865.           h := fo_h;
  866.           IF get_file_name(c_name,SaveText) THEN
  867.              IF create_file(c_name,handle) THEN BEGIN
  868.                 do_print(s_r,e_r,s_c,e_c,handle);
  869.                 close_file(handle)
  870.              END;   
  871.           Form_Dial(3,0,0,0,0,x,y,w,h)
  872.        END   
  873.    END; { SAVE_TEXT }
  874.  
  875. PROCEDURE DISK_IO ( what : DiskIoOps );
  876.    VAR s_r,s_c,e_r,e_c : INTEGER;
  877.    BEGIN
  878.        CASE what OF
  879.           LoadFile : load_file(LoadFile);
  880.           SaveFile : save_file(SaveFile,1,1,n_rows,n_cols);
  881.           LoadBlock : load_file(LoadBlock);
  882.           SaveBlock : 
  883.              IF ask_for_range(s_r,s_c,e_r,e_c,'Save Block') THEN
  884.                 save_file(SaveBlock,s_r,s_c,e_r,e_c);
  885.           SaveText : save_text(s_r,s_c,e_r,e_c)
  886.        END
  887.    END; { DISK_IO }             
  888.  
  889.  
  890. BEGIN
  891. END.
  892.  
  893.  
  894.