GEMini Atari/GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso/files/acc/utility/printpar/printpar.pas

Pascal/Delphi Source File | 1992-05-16 | 12.2 KB | 368 lines

{$A+,D-,S0}

Program Print;

{$I e:\pascal\include\Gemsubs.pas}

CONST
   maxlines       = 5;
   AC_Open        = 40;
   BEG_Mctrl      = 3;
   END_Mctrl      = 2;

VAR
   working                                 : String[249];
   defpath, inpath, linestr, test          : STRING;
    char_wide, char_height, bch, bcw,
    ap_id, menu_id, pagecount, linecount,
    counter, title_1, prompt_1, prompt_2,
    prompt_3, window, cancel_btn, drive,
    rez, choice                            : INTEGER;
    program_name                           : Str255;
    Stop_PRINT, accloop, doneprt           : BOOLEAN;
    msg                                    : Message_Buffer;
    print_dialog                           : Dialog_Ptr;


PROCEDURE IO_Check( b : BOOLEAN );
   EXTERNAL;


FUNCTION IO_Result : INTEGER;
   EXTERNAL;


FUNCTION CurDrv : INTEGER;
   GEMDOS( $19 );


FUNCTION GetRez : INTEGER;
   XBIOS( 4 );

PROCEDURE Obj_Draw ( BOX : Dialog_Ptr; Item : Tree_Index;
                     DEPTH, X, Y, W, H : INTEGER );
   EXTERNAL;

PROCEDURE WIND_Update ( ctrl : INTEGER );
VAR
   int_in   : Int_In_Parms;
   int_out  : Int_Out_Parms;
   addr_in  : Addr_In_Parms;
   addr_out : Addr_Out_Parms;
BEGIN
   int_in[0] := ctrl;
   AES_Call( 107, int_in, int_out, addr_in, addr_out );
END;


{ This procedure is where the accessory waits for a mesaage to activate }
{ and start to print a file. }

PROCEDURE Event_Loop;
VAR
    event, dummy : INTEGER;
    again : BOOLEAN;
BEGIN
   again := FALSE;
   REPEAT
      event := Get_Event( E_Message,0,0,0,0,FALSE,0,0,0,0,
                          FALSE,0,0,0,0,msg,
                          dummy,dummy,dummy,dummy,dummy,dummy );
  { Open up only if "OPEN" message has been received, and the proper menu }
  { identification number is given! }
      IF (msg[0] = AC_Open) AND (msg[4] = menu_id) THEN
          again := TRUE;
   UNTIL again;
END;


{ This procedure converts an INTEGER number into a string }

PROCEDURE Convert( number : INTEGER; VAR tempstr : STRING );
VAR
   temp : STRING;
   tempnum, count1, count2,
   divideby : INTEGER;
   first : BOOLEAN;

   PROCEDURE Num( whatnum : Integer ; VAR str : string ) ;
   CONST
      numbers = '123456789';
   BEGIN
      IF whatnum = 0 THEN
         str := '0'
      ELSE
         str := Copy( numbers, whatnum, 1);
   END;

BEGIN
   tempstr := '';
   first := true;
   FOR count1 := maxlines DOWNTO 1 DO BEGIN
       divideby := 1;
       FOR count2 := 1 TO count1 DO
          divideby := divideby*10;
       tempnum := number div divideby;
       number := number mod divideby;
       Num( tempnum, temp );
       IF tempnum>0 THEN
          first := false;
       IF NOT first THEN
          tempstr := Concat( tempstr, temp );
   END ;
   Num( number, temp );
   tempstr := Concat( tempstr, temp );
END;


{ This function asks whether you want to stop the printing.... If so, it }
{ returns TRUE to the asking procedure. }

FUNCTION AskStop : Boolean ;
VAR
    choice : INTEGER;
    str : Str255;
BEGIN
   str := '[2][ |Do you wish to STOP printing?][ Yes | No ]';
   choice := Do_Alert( str,2 );
   IF choice = 1 THEN
      AskStop := TRUE
   ELSE
      AskStop := FALSE
END;


{ This procedure prints one line on the printer.  It also then loops back }
{ to GEM to see if either the UNDO key has been pressed, or whether the }
{ left mouse button has been pressed over the "CANCEL" box. If either these }
{ conditions have been met, it then asks you if you want to terminate the }
{ printing. }

PROCEDURE Println( str : Str255 ) ;
VAR
   event, what_key, bcnt, bstate,
      mx, my, kbd : INTEGER;
BEGIN
   event := Get_Event( E_Keyboard|E_Timer|E_Button,
                       1, 1, 1, 0,
                       FALSE, 0, 0, 0, 0,
                       FALSE, 0, 0, 0, 0,
                       msg, what_key, bcnt,
                       bstate, mx, my, kbd );
   IF (event & E_Keyboard <> 0 ) THEN
      IF (NOT Stop_PRINT) AND ((what_key = $6100) OR (what_key = $1C0D)) THEN
         Stop_PRINT := AskStop;
   IF (event & E_Button <> 0) AND (bcnt>0) AND
      (mx > (35*char_wide)) AND
      (mx < (45*char_wide)) AND
      (my > (16*char_height + char_height DIV 2)) AND
      (my < (18*char_height + char_height DIV 2)) AND
      (NOT Stop_PRINT) THEN
      Stop_PRINT := AskStop ;
   IF (NOT Stop_PRINT) THEN BEGIN
      IF Length( str ) = 80 THEN
         Write( str )
      ELSE
         Writeln( str );
   END;
END;


{ This procedure writes a passed string (numbers is this program) on the }
{ screen in the interactive dialog box. Note that the mouse is hide as the}
{ string is printed. }

PROCEDURE ListMessage( str : Str255 ; pos : INTEGER );
VAR
   len, c : INTEGER;
BEGIN
   len := Length(str);
   IF len < 14 THEN
      FOR c := 1 TO 14-len DO
         str := Concat( str, ' ' );
   Hide_Mouse;
   Draw_String( 40*char_wide, (11 + pos)*char_height + char_height DIV 3 + 1,
                 str );
   Show_Mouse;
END;

{ This procedure prints the page header on the top of each new page. }

PROCEDURE Header;
VAR
    temp1, temp2 : STRING;
    counter : INTEGER;

BEGIN
   temp1 := inpath;
   Convert( pagecount, temp2 );
   ListMessage( temp2, 4 );
   FOR counter := 74-Length(temp2) DOWNTO Length(temp1) DO
      temp1 := Concat(temp1,' ');
   Insert( 'Page ', temp1, 74-Length(temp2) );
   Insert( temp2, temp1, 79-Length(temp2) );
   Println( temp1 );
   Println( '' );
   Println( '' );
END;


{ This procedure sets up the items needed for the interactive dialog box }
{ to be drawn. }

PROCEDURE Setup_Dialog;
BEGIN
   print_dialog := New_Dialog( 10, 0, 0, 32, 13 );
   title_1 := Add_DItem( print_dialog, G_String, None, 5, 1,
              22, 1, 0, $1180 );
   prompt_1 := Add_DItem( print_dialog, G_String, None, 3, 4,
               30, 1, 0, $1180 );
   prompt_2 := Add_DItem( print_dialog, G_String, None, 3, 6,
               15, 1, 0, $1180 );
   prompt_3 := Add_DItem( print_dialog, G_String, None, 3, 8,
               15, 1, 0, $1180 );
   cancel_btn := Add_DItem( print_dialog, G_BoxText,
               Selectable|Default|Exit_Btn, 11, 10, 10, 2, 2, $1180 );
END;


 { This procedure finds the file name in the path to the file to be printed }
 { and concatenates it the the passed string. }

PROCEDURE Add_Path (VAR str : Str255 ) ;
VAR
   len, x : INTEGER;

BEGIN
   len := Length( inpath );
   LOOP
      EXIT IF (inpath[ len ] = '\') OR (len = 1);
      len := len - 1;
   END;
   str := '  File Name: ';
   FOR x := (len + 1) TO Length( inpath )  DO
       str := Concat( str, inpath[ x ] ) ;
END;


{ This procedure first attempts to open up a window the full size fo the }
{ screen. This is necessary to prevent GEM from misdirecting button }
{ presses for the interactive dialog box to the windows beneath the box. }
{ Whether the window is opened successfully or not, the dialog box is then }
{ drawn on the screen. }

PROCEDURE ShowProgress ;
VAR
   str : Str255;

BEGIN
   Set_DText( print_dialog, title_1,
              'Currently PRINTING File', System_Font, TE_Center );
   Add_Path ( str );
   Set_DText( print_dialog, prompt_1, str, System_Font, TE_Right ) ;
   Set_DText( print_dialog, prompt_2,
              ' Line Count:', System_Font, TE_Right ) ;
   Set_DText( print_dialog, prompt_3,
              'Page Number:', System_Font, TE_Right ) ;
   Set_DText( print_dialog, cancel_btn, 'CANCEL',
              System_Font, TE_Center ) ;
   Obj_SetState( print_dialog, cancel_btn, Normal, FALSE ) ;
   Text_Color( Black ) ;
   Center_Dialog( print_dialog ) ;
   Obj_Draw( print_dialog, 0, 1, 0, 0, 80*char_wide, 24*char_height ) ;
END;


{ This is the main program. }

BEGIN
   program_name := '  Serial File Printer';
   ap_id := Init_Gem;  { Initialize GEM and register our accessoary }
   menu_id := 0;
   IF ( ap_id>0 ) THEN  { If we are an accessory, add name to Desk menu }
      menu_id := Menu_Register( ap_id, program_name );
   IF (ap_id >= 0) AND (menu_id >=0) THEN BEGIN
      { Get the current screen characteristics for positioning later }
      IF (ap_id>0) THEN
         accloop := TRUE  { We are an accessory }
      ELSE
         accloop := FALSE; { We are a program }
      Sys_Font_Size( char_wide, char_height, bcw, bch );
      rez := GetRez;
      IF rez = 0 THEN
         char_wide := char_wide DIV 2;
      doneprt := TRUE;
      REPEAT
         IF accloop AND doneprt THEN  { If we are an accessory, wait to be selected }
            Event_Loop; { Loop until called }
         pagecount := 1;  { Initialize our page/line counts for printing }
         linecount := 1;
         choice := 1;
         drive := CurDrv;  { Find the current drive; If "A" or "B" }
         IF drive < 2 THEN { ask the user to insert a diskette }
            choice := Do_Alert('[3][ | |Insert Source Disk][ OK | Cancel ]', 1)
         ELSE
            choice := 1;
         IF choice = 1 THEN BEGIN
            defpath := 'A:\*.*';
            defpath[1] := Chr( Ord(defpath[1]) + drive );
            IF Get_In_File( defpath, inpath ) THEN BEGIN  { Get the file path }
               test := Copy( inpath, Length(inpath), 1 ); { to print }
               doneprt := FALSE;
               IF test<>'\' THEN BEGIN
                  IO_check( FALSE ) ; { Find out whether line numbers are to be }
                  choice := Do_Alert  { added, and give one more way to stop prg}
                     ('[2][ |Do you want line numbers?][ No | Yes | Cancel ]',1);
                  Reset( Input, inpath ) ;
                  IF ( IO_Result <> 0 ) THEN
                     choice := 3; { If there is an error }
                  IF ( choice < 3 ) THEN BEGIN  { open, bomb out. }
                     WIND_Update( BEG_Mctrl ) ; { Stop the screen manager }
                     Setup_Dialog;
                     Stop_PRINT := FALSE;
                     ShowProgress; { Initialize the interactive dialog box }
                     ListMessage( '1', 2 );
                     ListMessage( '1', 4 );
                     Rewrite( Output, 'PRN:' ); { Open the printer for output }
                     Header;         { Print the initial header }
                     counter := 1;
                     REPEAT
                        Readln( working );
                        IF IO_Result <> 0 THEN
                           Stop_PRINT := TRUE;
                        IF (NOT Stop_PRINT) THEN BEGIN
                           Convert( linecount, linestr );{ Now loop, printing each }
                           ListMessage( linestr, 2 );    {line, then reading the next }
                           IF ( choice=2 ) THEN BEGIN    {until done, or stop message}
                              While Length(linestr)<5 DO { received. }
                                 linestr := Concat( linestr, ' ' );
                              working := Concat( linestr, ' ', working );
                           END;
                           Println( working );
                           linecount := linecount + 1;
                           counter := counter + (Length(working) DIV 81) + 1;
                           IF counter>60 THEN BEGIN { Allow 60 lines per page }
                              pagecount := pagecount+1;
                              Println( Chr(12) ); { Do a form feed }
                              Header;
                              counter := 1;
                           END;
                        END;
                     UNTIL EOF OR Stop_PRINT;
                     Writeln( Chr(12) ); { End printing with a Form Feed }
                     Close( Output );
                     Close( Input );
                     End_Dialog( print_dialog );
                     Delete_Dialog( print_dialog );
                     WIND_Update( END_Mctrl ); { Restart the Screen Manager }
                  END; { if choice < 3 }
               END; { if test <> '\' }
            END  { if get_in_file }
            ELSE
              doneprt := TRUE;
         END; { if choice = 1 }
      UNTIL ((NOT accloop) AND doneprt);
   END; { if ap_id }
   Exit_GEM; { Exit gem only if we cannot register our accessory. }
END.