00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019
00020 subroutine printid
00021 save
00022 c
00023 c Put identifying information at top of page.
00024 c
00025 parameter (lid=150)
00026 character*150 id
00027 character*11 page
00028 character*10 tim, dat
00029 common /plot origin/ ro,so
00030 common /dev status/ idevon,idevpen,idevwt
00031 common /ps pages/ npage
00032 c
00033 character*40 font
00034 common /ps font/ font,ifsize
00035 save /ps font/
00036 c
00037 common /ps head flag/ iheadflag
00038 c
00039 common /ps orient/ior
00040 c
00041 save /ps head flag/,/ps orient/
00042 c
00043 c Draw any outstanding lines:
00044 c
00045 call ps stroke
00046 c
00047 if(iheadflag.eq.0)return
00048 c
00049 c Set up the identifying strings:
00050 c
00051 id=' '
00052 nid=6
00053 id(1:nid+2)='User: '
00054 c
00055 call mygetlog(id(nid+3:lid))
00056 do 10 i=lid,nid+2,-1
00057 if(id(i:i).gt.' ')go to 20
00058 10 continue
00059 20 nid=i+3
00060 id(nid:nid)='('
00061 c
00062 call myhostname(id(nid+1:lid))
00063 do 30 i=lid,nid,-1
00064 if(id(i:i).gt.' ')go to 40
00065 30 continue
00066 40 nid=i+11
00067 id(nid-10:nid)='). '
00068 c
00069 call mydate(dat)
00070 write(id(nid+1:nid+27),'(''Date: '',a10,''.'',9x)')dat
00071 nid=nid+27
00072 c
00073 call mytime(tim)
00074 write(id(nid+1:nid+18),'(''Time: '',a10,''.'')')tim
00075 nid=min(lid,nid+18)
00076 c
00077 write(page,'(''Page'',i7)')npage
00078 c
00079 c Set header font, pen color and weight (weight probably unnecessary):
00080 c
00081 write(42,'(/''/Times-Roman findfont 12 scalefont setfont''/)')
00082 ipsto=idevpen
00083 call color(0)
00084 iwsto=idevwt
00085 call weight(7)
00086 c
00087 c Draw the header:
00088 c
00089 c Some more magic numbers!
00090 c
00091 if (ior.eq.1) then
00092 ix = 50
00093 jy = 750
00094 kx = 525
00095 else
00096 ix = 50
00097 jy = 580
00098 kx = 725
00099 end if
00100 c
00101 write(42,50)ix,jy,(id(i:i),i=1,nid)
00102 50 format(/2i4,' m ('/100a1)
00103 write(42,51)kx,jy,page
00104 51 format( ') show ',2i4,' m (',a11,') show')
00105 c
00106 c Reset font, pen color and weight.
00107 c
00108 write(42,60)font,ifsize
00109 60 format('/',a20,' findfont ',i3,' scalefont setfont'/)
00110 call color(ipsto)
00111 call weight(iwsto)
00112 c
00113 return
00114 c
00115 entry noheader
00116 c
00117 iheadflag=0
00118 c
00119 return
00120 c
00121 entry header
00122 c
00123 iheadflag=1
00124 c
00125 end
