SPACE 2/SPACE - Library 2 - Volume 1.iso/games/144/pascal/print.pas

Pascal/Delphi Source File | 1987-06-16 | 12.5 KB | 387 lines

  {$S0,D-}

Program Print ;

  Const
    maxlines       = 5 ;
    AC_Open        = 40 ;
    BEG_Mctrl      = 3 ;
    END_Mctrl      = 2 ;
    {$I Gemconst.pas}

  Type
    {$I Gemtype.pas}
    Pointer            = ^Char ;
    Int_In_Parms       = ARRAY[ 0..15 ] OF Integer ;
    Int_Out_Parms      = ARRAY[ 0..45 ] OF Integer ;
    Addr_In_Parms      = ARRAY[ 0..1 ] OF Pointer ;
    Addr_Out_Parms     = ARRAY[ 0..0 ] OF Pointer ;

  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 : Boolean ;
    msg  : Message_Buffer ;
    print_dialog : Dialog_Ptr ;


  {$I Gemsubs}


  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 AES_Call( op : Integer;
                VAR int_in : Int_In_Parms; VAR int_out : Int_Out_Parms ;
                VAR addr_in : Addr_In_Parms ; VAR addr_out : Addr_Out_Parms ) ;
    EXTERNAL ;

  { This is a hook into the AES call "WIND_Update" that will allow us to temp-}
  { porarily stop the Screen Manager while processing our own dialog box.}


  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
      BEGIN
        IF (NOT Stop_PRINT) AND ((what_key = $6100) OR (what_key = $1C0D)) THEN
          Stop_PRINT := AskStop ;
      END ;
    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 := '  File Printer' ;
    ap_id := Init_Gem ;  { Initialize GEM and register our accessoary }
    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 }
        sys_Font_Size( char_wide, char_height, bcw, bch ) ;
        rez := GetRez ;
        IF rez = 0 THEN char_wide := char_wide DIV 2 ;
        WHILE TRUE DO
          BEGIN
            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" prompt }
            IF drive < 2 THEN { 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 }
              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 ann error }
                IF choice<3 THEN BEGIN   { open, boomb 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>54 THEN BEGIN { Allow 54 lines per page only }
                        pagecount := pagecount+1 ;
                        Println( Chr(12) ) ;
                        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 ;
              END ;
            END ;
          END ;
      END ;
    END ;
    Exit_GEM ; { Exit gem only if we can not register our accessory. }
  END .