! hp_demo.sqr (hp printer support library and utilities for SQR)
! Copyright (C) 1997 Ray Ontko & Company
!
! This program is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 2 of the License, or
! (at your option) any later version.
!
! This program 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 General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!++
!
! Name
!
!   hp_demo.sqr
!
! Description
!
!   Demonstrates the hp_font_truncate and other proportional
!   font features of the hp printer support routine library
!   (hp.sqh)
!
!--
!
! Author
!
! Ray Ontko
! Ray Ontko & Company
! Richmond, In 47375
! 
!
! Modification History
!
! Name             Date       Comment
! ---------------- ---------- ----------------------------------------
! Ray Ontko        1997/06/04 Added this header
!

#define inc_hp_initialize
#define inc_hp_font_load
#define inc_hp_font_truncate
#include 'hp.sqh'

begin-setup
declare-layout default
   orientation=landscape
   char-width=4.5
end-declare
end-setup

begin-program
do hp_initialize
do main
end-program

!------------------------------------------------------------------- main
begin-procedure main
!
! note: this information should be derived from the input file,
! but until we get this done, it will be necessary to modify
! this "alter-printer" line.
!
alter-printer font=4148 point-size=7.5 font-type=proportional

input $font_metrics_file_name 'Font metrics file name'
do hp_font_load( 0 , $font_metrics_file_name , #status )
if #status
   show 'error: opening font metrics file "' $font_metrics_file_name 
        '" for input'
   stop quiet
end-if

input $test_file_name 'Test File Name'
open $test_file_name as 1 for-reading record=500:vary status=#status
if #status
   string 'error: unable to open test file "' $test_file_name '" for input'
      by '' into $msg
   show $msg
   stop quiet
end-if

input $length 'Truncation Length (in points)'
let #length = to_number( $length )

#debug show '#length ' #length
read 1 into $line:500
while not #end-file
   do hp_font_truncate( 0 , $line , #length , $result )
   print $result (1,1)
   next-listing
   read 1 into $line:500
end-while
close 1

move 32 to #i
while #i < 127
   let $c = chr( #i )
   let $s = rpad( $c , 100 , $c )
   do hp_font_truncate( 0 , $s , #length , $result )
   print $result (1,1)
   next-listing
   add 1 to #i
end-while

end-procedure ! main