C ================================================== C L_IMPREGRAF (SUBROUTINAS DE REPRESENTACION POR IMPRESORA) C AUTOR: PABLO LAGUNA C DATA: 28-OCTUBRE-87 C ================================================== C ----------------------------------------------------------------------- C Copyright (C) 2002 Pablo Laguna C C This program is free software; you can redistribute it and/or modify it C under the terms of the GNU General Public License as published by the C Free Software Foundation; either version 2 of the License, or (at your C option) any later version. C C This program is distributed in the hope that it will be useful, but C WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU C General Public License for more details. C C You should have received a copy of the GNU General Public License along C with this program; if not, write to the Free Software Foundation, Inc., C 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. C C You may contact the author by e-mail (laguna@posta.unizar.es) or postal C mail (Dpt. Ingenieria Electrónica y Comunicaciones, Grupo de Tecnología C de las Comunicaciones (GTC), Centro Politécnico Superior. Universidad C de Zaragoza, María de Luna, 3 (Pol. Actur), Edificio A, Despacho 3.16, C 50015 Zaragoza. Spain). For updates to this software, please visit C PhysioNet (http://www.physionet.org/). C _______________________________________________________________________ c SE LE LLAMA DESDE ECGMAIN PARA CREAR FICHEROS .LSR c PARA SACAR POR IMPRESORA C C ---------------------------------------------------------- C CREACION DE FICEROS PARA IMPRIMIR C ---------------------------------------------------------- C ---------------------------------------------------------------- C PRINLASER (PRINTA EL GRAFIC REPRESENTAT EN PANTALLA C PER LA IMPRESORA LASER) C ---------------------------------------------------------------- subroutine sacalaser (titgen,lizer,sen,nptssr,npts,if,izero, & escy) character *17 titgen character *5 alfanum character *1 lizer,autoesc character *6 aformatimp dimension sen(100000) real *4 vindx(9),vindy(6) integer*4 npts call calcula_paso(npts,640,npescx,npimp) c call calcula_pasoold(npts,640,npescx,npimp) C CALCULO EL FONDO DE ESCALA write (6,6) titgen 6 format('titgen=',a12,'fin') write(6,1) 1 format('$ grafico autoescalado ? [s]:') read(5,'(a)') autoesc if (autoesc.eq.'n') then write(6,2) 2 format('$ vmax= ') read(5,*) vmax write(6,3) 3 format('$ vmin= ') read(5,*) vmin else call maxmin(sen,nptssr,npts,vmax,vmin) end if if ( lizer.eq.'s') then if (vmin.gt.0) vmin=0 if (vmax.lt.0) vmax=0 end if call repescal(nptssr,npts,8,vmax,vmin,vindx,vindy) if (vmax.ne.vmin) escy=400/(vmax-vmin) izero=440-nint(escy*(0.-vmin)) C OBERTURA FITXER open(unit=2,file=titgen(1:lnblnk(titgen))//'.ps') call l_prinplot(1,1,0,2) npisimp=75 ior_x=150 ior_y=680 write(2,4) ior_x,ior_y 4 format(1x,i3,1x,i3,' translate') scale_y=.5 scale_x=(.5*640)/npimp write(2,5) scale_x,scale_y 5 format(1x,f5.3,1x,f5.3,' scale') C DIBUIXA RECTANGLE (npimp * 400) C AMB L'ORIGEN DE COORDENADES (npsimp,140) call l_printint(npisimp,140,npisimp+npimp,140,12,2) call l_printint(npisimp+npimp,140,npisimp+npimp,540,12,2) call l_printint(npisimp+npimp,540,npisimp,540,12,2) call l_printint(npisimp,540,npisimp,140,12,2) C DIBUIXA RATLLES ESCALA do i=1,7 ix=npisimp+i*npimp/8 call l_printint(ix,140,ix,165,12,2) call l_printint(ix,540,ix,515,12,2) end do do i=1,4 iy=140+i*80 call l_printint(npisimp,iy,20+npisimp,iy,12,2) call l_printint(npisimp+npimp,iy,npisimp-20+npimp,iy,12,2) end do C DIBUIXA RETOLS call l_lit(225,130,titgen,17,3,'H',2) call l_lit(365,600,'seg',3,2,'H',2) call l_lit(npisimp-41,380,'mv',2,2,'V',2) C REPRESENTA ESCALA do i=1,9 if (vindx(9).ge.100) then write(alfanum,11) vindx(i)/if 11 format(f5.1) else write(alfanum,10) vindx(i)/if 10 format(f5.2) end if call l_lit(npisimp-10+(i-1)*npimp/8,580,alfanum,5,2,'H',2) end do C CALCULA EL FORMATO PARA DIBUJAR EN CADA CASO if (vmax.lt.1000..and.vmin.gt.-100) then aformatimp='(f5.1)' else if (vmax.lt.10000..and.vmin.gt.-1000) then aformatimp='(f5.0)' end if C BUSCA Y ESCRIBE EL FORMATO ADECUAD EN EL EJE y do i=1,6 write(alfanum,aformatimp) vindy(i) call l_lit(npisimp-36,560-(i-1)*80,alfanum,5,2,'H',2) end do C DIBUIXA LINIA DE ZERO C (Cal emprar IZERO+100, perque l'origen del grafic C en l'impresora esta desplacat 100 punts respecte a C la pantalla grafica) if(lizer.eq.'S'.or.lizer.eq.'s') then call l_printint(npisimp,izero+100,npisimp+npimp,izero+100,1,2) end if C DIBUIXA SENYAL C Les escales escx i escy corresponen a les de la pantalla grafica: C escx=npts/740 C escy=400(vmax-vmin) C Per a la impresora escy es la mateixa, pero cal emprar una altre C per al eix x (npescx), calculada a CALCULA_ESCALA. if(npts.ge.640) then iy1=(izero+100)-nint(escy*sen(nptssr+npescx*1)) do i=2,npimp iy0=iy1 iy1=(izero+100)-nint(escy*sen(nptssr+npescx*i)) if (nptssr+npescx*i.gt.100000) iy1=0 ix0=npisimp+(i-2) ix1=ix0+1 call l_printint(ix0,iy0,ix1,iy1,5,2) end do else ix1=npisimp+npescx iy1=(izero+100)-nint(escy*sen(nptssr+1)) do i=2,npts iy0=iy1 iy1=(izero+100)-nint(escy*sen(nptssr+i)) ix0=ix1 ix1=npisimp+npescx*i call l_printint(ix0,iy0,ix1,iy1,5,2) end do end if C TANCAR FITXER return end c------------------------------------------------------------------------- subroutine l_saca_basel(basel, irpos, npts, nptssr, izero, escy) c dibuixem les lineas de base dimension basel(8000), irpos(8000) j=1 call calcula_paso(npts,640,npescx,npimp) npisimp=75 do while (irpos(j).lt.npts+nptssr.and.j.le.8000) if (irpos(j).gt.nptssr) then if (npts.ge.640) then ixpin=npisimp+(irpos(j)-nptssr)/npescx-25 ixpfi=npisimp+(irpos(j)-nptssr)/npescx+25 else ixpin=npisimp+(irpos(j)-nptssr)*npescx-25 ixpfi=npisimp+(irpos(j)-nptssr)*npescx+25 end if iyba=(izero+100)-nint(escy*basel(j)) call l_printint(ixpin,iyba,ixpfi,iyba,3,2) end if j=j+1 end do return end c-------------------------------------------------------------------------- c------------------------------------------------------------------------- C -------------------------------------------------------------- C DIBUJA MARCAS EN LA SEQAL DEL FICHERO PARA LASER C ------------------------------------------------------------- subroutine l_pinta_marca(ipos,npts,nptssr,iyi,iyf) C C ipos TIENE LAS POSICIONES DE LAS MARCAS EN X C iyi ,iyf SON LAS POSICIONES INICIAL Y FINAL EN Y DE LAS MARCAS dimension ipos(80) call calcula_paso(npts,640,npescx,npimp) npisimp=75 i=1 do while (ipos(i).lt.npts+nptssr.and.i.le.80) if (ipos(i).gt.nptssr) then c BUSCO LA POSICION DEL QRS EN LA ESCALA DE LA PANTALLA if (npts.ge.640) then ixpos=npisimp+(ipos(i)-nptssr)/npescx else ixpos=npisimp+(ipos(i)-nptssr)*npescx end if call l_printint(ixpos,iyi,ixpos,iyf,2,2) end if i=i+1 end do return end C ----------------------------------------------------------------- C REPRESENTA LE INTERVALO QT EN FUNCION DEL TIEMPO C ----------------------------------------------------------------- subroutine l_grafica_qt(titgen,if,is,ns,iqrs,iqt,nqrs) dimension iqrs(80),iqt(80) character *17 titgen character *5 alfanum character *6 aformatimp real *4 vindx(9),vindy(6) nptssr=is*if npts=ns*if call calcula_paso(npts,640,npescx,npimp) C CALCULO EL FONDO DE ESCALA vmin=0 vmax=550. call repescal(nptssr,npts,8,vmax,vmin,vindx,vindy) escy=400/(vmax-vmin) i440=440-nint(escy*440) C OBERTURA FITXER open(unit=2,file=titgen(1:lnblnk(titgen))//'.ps') call l_prinplot(1,1,0,2) npisimp=75 ior_x=150 ior_y=680 write(2,1) ior_x,ior_y 1 format(1x,i3,1x,i3,' translate') scale_y=.5 scale_x=(.5*640)/npimp write(2,2) scale_x,scale_y 2 format(1x,2f5.2,' scale') C DIBUIXA RECTANGLE (npimp * 400) C AMB L'ORIGEN DE COORDENADES (npsimp,140) call l_printint(npisimp,140,npisimp+npimp,140,12,2) call l_printint(npisimp+npimp,140,npisimp+npimp,540,12,2) call l_printint(npisimp+npimp,540,npisimp,540,12,2) call l_printint(npisimp,540,npisimp,140,12,2) C DIBUIXA RATLLES ESCALA do i=1,7 ix=npisimp+i*npimp/8 call l_printint(ix,140,ix,165,12,2) call l_printint(ix,540,ix,515,12,2) end do do i=1,4 iy=140+i*80 call l_printint(npisimp,iy,20+npisimp,iy,12,2) call l_printint(npisimp+npimp,iy,npisimp-20+npimp,iy,12,2) end do C DIBUIXA RETOLS call l_lit(225,130,titgen,17,3,'H',2) call l_lit(365,600,'seg',3,2,'H',2) call l_lit(npisimp-41,380,'msg',3,2,'V',2) C REPRESENTA ESCALA do i=1,9 if (vindx(9).ge.100) then write(alfanum,11) vindx(i)/if 11 format(f5.1) else write(alfanum,10) vindx(i)/if 10 format(f5.2) end if call l_lit(npisimp-10+(i-1)*npimp/8,580,alfanum,5,2,'H',2) end do C CALCULA EL FORMATO PARA DIBUJAR EN CADA CASO if (vmax.lt.1000..and.vmin.gt.-100) then aformatimp='(f5.1)' else if (vmax.lt.10000..and.vmin.gt.-1000) then aformatimp='(f5.0)' end if C BUSCA Y ESCRIBE EL FORMATO ADECUAD EN EL EJE y do i=1,6 write(alfanum,aformatimp) vindy(i) call l_lit(npisimp-36,560-(i-1)*80,alfanum,5,2,'H',2) end do C DIBUIXA LINIA DE 440 msg C (Cal emprar IZERO+100, perque l'origen del grafic C en l'impresora esta desplacat 100 punts respecte a C la pantalla grafica) call l_printint(npisimp,i440+100,npisimp+npimp,i440+100,1,2) C DIBUIXA SENYAL if(npts.ge.640) then iy1=540-nint(escy*iqt(1)) ix1=npisimp do i=1,nqrs iy0=iy1 if (iqt(i).ne.0) iy1=540-nint(escy*iqt(i)) ix0=ix1 ix1=npisimp+iqrs(i)/npescx call l_printint(ix0,iy0,ix1,iy1,5,2) end do else ix1=npisimp iy1=540-nint(escy*iqt(1)) do i=2,nqrs iy0=iy1 if (iqt(i).ne.0) iy1=540-nint(escy*iqt(i)) ix0=ix1 ix1=npisimp+npescx*iqrs(i) call l_printint(ix0,iy0,ix1,iy1,5,2) end do end if C TANCAR FITXER call l_prinplot(1,1,2,2) close(2) return end