{ ************************************************************************* * * * * * * C P A S * S Y S T E M * * * * * * * * * * S t a n d a r d L i b r a r y * * * * * * * * * --- Listing Manager Library Environment --- * * --- Version 2.2--A -- 30/06/2010 --- * * * * by : * * * * P. Wolfers * * c.n.r.s. * * Laboratoire de Cristallographie * * B.P. 166 X 38042 Grenoble Cedex * * FRANCE. * * * ************************************************************************* ///////////////////////////////////////////////////////////////////////// // // // // // Global Public Licence (GPL) // // // // // // This license described in this file overrides all other licenses // // that might be specified in other files for this library. // // // // This library is free software; you can redistribute it and/or // // modify it under the terms of the GNU Lesser General Public // // License as published by the Free Software Foundation; either // // version 2.1 of the License, or (at your option) any later version. // // // // This library is distributed in the hope that it will be useful, // // but WITHOUT ANY WARRANTY; without even the implied warranty of // // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU // // Library General Public License for more details. // // // // You should have received a copy of the GNU Lesser General Public // // License along with this library (see COPYING.LIB); if not, write to // // the Free Software Foundation : // // Inc., 675 Mass Ave, Cambridge, MA 02139, USA. // // // ///////////////////////////////////////////////////////////////////////// } (* [inherit ( 'LIB:BASIC_ENV_STR', { string manager def. } 'LIB:BASIC_ENV_TXF'), { text file manager def. } environment('LIB:BASIC_ENV_LST')] { create the environment file } module BASIC_ENV_LST; *) const lst_maxheading = 60; { The maximum of maxheading is txf_maxline - 72 } type str_ptr = ^string; { pointer of string } lst_ptr = ^lst_context; { listing pointer definition } lst_flagsty = ( lstf_print, { Flag for automatic print out on the Close Time } lstf_terminal, { Flag for the terminal mode (the file is a terminal device) } lstf_stdout, { Flag for the consol mode (the Pascal file is output) } lstf_break, { Flag for break } lstf_centered, { Flag for centered mode } lstf_justified, { Flag for justified mode } lstf_virtual { Flag for virtual output list (in memory) } ); lst_flgsetw = set of lst_flagsty; { A flags word } lst_context = record { Listing context cpas_b__lstdefinition } lst_next: lst_ptr; { Listing link pointer } lst_currline, { Listing current line } lst_heading, { Listing page heading pointer } lst_title, { Listing title pointer } lst_sbttl: str_ptr; { Listing sub title output } lst_lncnt, { Line count inside a page } lst_pgcnt, { Page count } lst_lm, { Listing left margin } lst_rm, { Listing right margin } lst_lnsize, { Line size in character } lst_pgsize: integer; { Page size in line } lst_flagsw: lst_flgsetw; { Listing Flags Word } case boolean of { For virtual output list (in memory) } false: (lst_file: text); { Text file pointer/ or nil if output } true: (lst_lsthde: $wild_pointer) { String list pointer } end; var lst_current, { Current listing pointer } lst_hde: [external] lst_ptr; { Used listing list header } lst_spc_mode: [external] flags_file; { Flag file mode to use } lst_date, { Current time of day } lst_time: [external] string(14); { Current date of day } procedure STR_COPY_LIM( var trg: str_ptr; var src: [readonly] string; lim: integer ); external; {********************************************************} {*********** listing managment routines ************} {********************************************************} procedure LST_INIT( p: lst_ptr ); external; function LST_ALLOCATE: lst_ptr; { to allocate a listing, the result is the listing context address } external; procedure LST_FREE( var p: lst_ptr ); { to free an allocated listing, at result the given address is clear to nil } external; procedure LST_CLOSE( var p: lst_ptr; bfree: boolean ); { to close a listing file with optional deallocation } external; procedure LST_OPEN( var p: lst_ptr; in_var fspc, heading, title, sbttl: string := ''; lnsize, pgsize: integer; bunknown, bprint, bappend: boolean; var ierr: integer ); { open a listing file: p is the listing context pointer, if nil on call then allocate a context. fspc is the file specification pointer, heading is the page heading pointer (first line of each page), title is the job title (second line of each page), sbttl is the sub-job title (third line of each page), lnsize is the size of a line in character (cannot be exceed txf_maxline), pgsize is the size of a page in line ( - the five first lines). if pgsize < 10 then the page handling is suppressed. if bunknown then if the file is already existing, then it is supershed, if bappend then the file should be append to previously existent file, if bprint then the file should be printed on close time. } external; procedure LST_NEWLINE; { to output a line of listing as given in lst_outline } { must be call before to write a new line on a listing } external; procedure LST_EOLN; external; procedure LST_BREAKOUTPUT; external; procedure LST_PAGE; external; procedure LST_SET_COLUMN( col: integer ); external; procedure LST_SET_MARGIN( lm, rm: integer ); external; procedure LST_SKIP_LINE( nli: integer ); external; procedure LST_CHANGE_HEADING( in_var str: string ); external; procedure LST_CHANGE_TITLE( in_var str: string ); external; procedure LST_CHANGE_SUBTITLE( in_var str: string ); external; procedure LST_SET_CHAR_ATTR( in_var sattr: string ); external; procedure LST_TEST_LINE( iskip, tstli: integer ); external; procedure LST_PUT_CHAR( ch: char ); external; procedure LST_PUT_MCHAR( ch: char; m: integer ); external; procedure LST_PUT_STRING( var str: [readonly] string ); { output a pascal string with given left margin } { if the line is too long then wrap the line } external; procedure LST_PUT_INT( int, size: integer; base: integer := 0 ); external; procedure LST_PUT_FLOAT( dv: double; fs, dcsz, es: integer ); external; procedure LST_PUT_FIXED( dv: double; fs, dcsz, dcmin: integer ); external; {********************************************************} {********** common initialization routine ***********} {********************************************************} procedure LST_G_INIT( var def_lst, def_heading: [readonly] string; var ierr: integer ); { common string and text file initialization routine } external; (* end. *)