C ================================================== C IMPREGRAF (SUBROUTINAS DE REPRESENTACION POR IMPRESORA) C AUTOR: PABLO LAGUNA C DATA: 9-JUNIO-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 .DAT c PARA SACAR POR IMPRESORA C C ---------------------------------------------------------- C CREACION DE FICEROS PARA IMPRIMIR C ---------------------------------------------------------- C -------------------------------------------------- C MAXMIN (TROVA EL MAXIM I EL MINIM DEL SENYAL) C -------------------------------------------------- subroutine maxmin (sen,nptssr,npts,vmax,vmin) real*4 sen(100000) imax=nptssr+1 imin=nptssr+1 if ((npts+nptssr).gt.100000) npts=100000-nptssr do i=2+nptssr,nptssr+npts if (sen(i).gt.sen(imax)) then imax=i else if (sen(i).lt.sen(imin)) then imin=i end if end if end do vmax=sen(imax) vmin=sen(imin) return end C ----------------------------------------------------- C REPESCAL (REPRESENTACIO ESCALES) C ----------------------------------------------------- subroutine repescal (nptssr,npts,ndiv,vmax,vmin,vindx,vindy) real*4 vindx(12),vindy(6) vindx(1)=nptssr xdiv=npts/ndiv do i=2,ndiv+1 vindx(i)=nptssr+xdiv*(i-1) end do ydiv=(vmax-vmin)/5 vindy(1)=vmin do i=2,6 vindy(i)=vmin+ydiv*(i-1) end do return end C ---------------------------------------------------------------- C SACAPANTALLA (PRINTA EL GRAFIC REPRESENTAT EN PANTALLA) C ---------------------------------------------------------------- subroutine sacapantalla (titgen,lizer,sen,nptssr,npts,if,izero, & escy) character *17 titgen character *6 alfanum character *1 lizer,reticula,autoesc real *4 vindx(9),vindy(6),sen(100000) write(6,1) 1 format('$ Quieres pintar reticula en la seqal? [n]: ') read (5,'(a)') reticula write(6,2) 2 format('$ Grafico autoescalado [s]: ') read (5,'(a)') autoesc C CALCULO EL FONDO DE ESCAL if (autoesc.eq.'n') then write(6,50) 50 format('$ Tensio maxima [mV]:') read(5,*) vmax c 60 format(f4.1) write(6,70) 70 format('$ Tensio minima [mV]:') read(5,*) vmin c 80 format(f4.1) else call maxmin(sen,nptssr,npts,vmax,vmin) if ( lizer.eq.'s') then if (vmin.gt.0) vmin=0 if (vmax.lt.0) vmax=0 end if end if call calcula_paso(npts,640,npescx,npimp) npisimp=(700-npimp)/2+75 call repescal(nptssr,npts,5,vmax,vmin,vindx,vindy) if (vmax.ne.vmin) escy=400/(vmax-vmin) izero=440-nint(escy*(0.-vmin)) C OBERTURA FITXER open(2,file=titgen//'.prn',status='new') C call prinplot(1,1,0,2) C DIBUIXA RECTANGLE (640 * 400) C AMB L'ORIGEN DE COORDENADES (75,140) C call printint(npisimp,140,npimp+npisimp,140,1,2) C call printint(npimp+npisimp,140,npimp+npisimp,540,1,2) C call printint(npimp+npisimp,540,npisimp,540,1,2) C call printint(npisimp,540,npisimp,140,1,2) C DIBUIXA RATLLES ESCALA do i=1,4 ix=npisimp+i*npimp/5 C call printint(ix,140,ix,165,1,2) C call printint(ix,540,ix,515,1,2) end do do i=1,4 iy=140+i*80 C call printint(npisimp,iy,npisimp+20,iy,1,2) C call printint(npimp+npisimp,iy,npimp+npisimp-20,iy,1,2) end do C DIBUIXA RETOLS C call liter(225,100,titgen,12,3,'H',2) C call liter(365,560,'seg',3,1,'H',2) C call liter(npisimp-66,348,'mv',2,1,'V',2) C REPRESENTA ESCALA do i=1,6 write(alfanum,10) vindx(i)/IF 10 format(f6.2) C call liter(npisimp-30+(i-1)*npimp/5,545,alfanum,6,1,'H',2) end do do i=1,6 write(alfanum,20) vindy(i) 20 format(f6.2) C call liter(npisimp-59,530-(i-1)*80,alfanum,5,1,'H',2) end do C DIBUJA UNA RETICULA EQUIVALENTE A 25 MM/SEG DE MM. EN MM. if (reticula.eq.'s') then ndiv=npts/if*25 do i=1,ndiv-1 ix=npisimp+i*npimp/ndiv C call printint(ix,140,ix,540,2,2) end do C MARCA EN MAS GORDO LOS CM. do i=1,ndiv/10 ix=npisimp+i*npimp/ndiv*10 C call printint(ix,140,ix,540,1,2) end do end if 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 C call printint(npimp+npisimp,izero+100,npisimp,izero+100,3,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 un altre C per al eix x. 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 C call printint(ix0,iy0,ix1,iy1,1,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 C call printint(ix0,iy0,ix1,iy1,1,2) end do end if return end c------------------------------------------------------------------------- subroutine 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=(700-npimp)/2+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)) C call printint(ixpin,iyba,ixpfi,iyba,3,2) end if j=j+1 end do return end c-------------------------------------------------------------------------- c------------------------------------------------------------------------- subroutine 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(8000) call calcula_paso(npts,640,npescx,npimp) npisimp=(700-npimp)/2+75 i=1 do while (ipos(i).lt.npts+nptssr.and.i.le.8000) 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 C call printint(ixpos,iyi,ixpos,iyf,2,2) end if i=i+1 end do return end C ---------------------------------------------------------- C CALCULA LOS ESCALADOS ADECUADOS C ---------------------------------------------------------- subroutine calcula_paso(npts,nptt,npescx,npimp) c npts ES EL NUMERO DE PUNTOS QUE MANDO IMPRIMIR DE LA SENAL c nptt ES EL NUMERO DE PUNTOS MAXIMO QUE ADMITE EL GRAFICO c npimp NUMERO DE PUNTOS QUE SE IMPRIMEN c npisimp ES EL NUMERO DE PUNTOS INICIALES SIN IMPRIMIR c npescx ES EL PASO DE CADA PUNTO integer*4 npts,npescx,nptt,npimp if (npts.ge.nptt) then npescx = nint((npts*1.)/nptt) c if (npescx*nptt.lt.npts) npescx=npescx+1 npts = npescx*nptt npimp = npts/npescx else npescx = nint(nptt*1./npts) c if (nptt/npescx.lt.npts) npescx=npescx-1 npts = nptt/npescx npimp = npts*npescx end if return end C ---------------------------------------------------------- C CALCULA LOS ESCALADOS ADECUADOS C ---------------------------------------------------------- subroutine calcula_pasoold(npts,nptt,npescx,npimp) c npts ES EL NUMERO DE PUNTOS QUE MANDO IMPRIMIR DE LA SENAL c nptt ES EL NUMERO DE PUNTOS MAXIMO QUE ADMITE EL GRAFICO c npimp NUMERO DE PUNTOS QUE SE IMPRIMEN c npisimp ES EL NUMERO DE PUNTOS INICIALES SIN IMPRIMIR c npescx ES EL PASO DE CADA PUNTO if (npts.ge.nptt) then npescx = nint(npts*1./nptt) if (npescx*nptt.lt.npts) npescx=npescx+1 npimp=npts/npescx else npescx = nint(nptt*1./npts) if (nptt/npescx.lt.npts) npescx=npescx-1 npimp=npts*npescx end if return end C ----------------------------------------------------------------- C REPRESENTA LE INTERVALO QT EN FUNCION DEL TIEMPO C ----------------------------------------------------------------- subroutine p_grafica_qt(titgen,if,is,ns,iqrs,iqt,nqrs) dimension iqrs(8000),iqt(8000) 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,5,vmax,vmin,vindx,vindy) escy=400/(vmax-vmin) i440=440-nint(escy*440) C OBERTURA FITXER open(unit=2,file=titgen//'.prn',status='new') C call prinplot(1,1,0,2) npisimp=(700-npimp)/2+75 C DIBUIXA RECTANGLE (npimp * 400) C AMB L'ORIGEN DE COORDENADES (npsimp,140) C call printint(npisimp,140,npisimp+npimp,140,1,2) C call printint(npisimp+npimp,140,npisimp+npimp,540,1,2) C call printint(npisimp+npimp,540,npisimp,540,1,2) C call printint(npisimp,540,npisimp,140,1,2) C DIBUIXA RATLLES ESCALA do i=1,7 ix=npisimp+i*npimp/8 C call printint(ix,140,ix,165,1,2) C call printint(ix,540,ix,515,1,2) end do do i=1,4 iy=140+i*80 c call printint(npisimp,iy,20+npisimp,iy,1,2) c call printint(npisimp+npimp,iy,npisimp-20+npimp,iy,1,2) end do C DIBUIXA RETOLS C call liter(225,100,titgen,12,3,'H',2) C call liter(365,560,'seg',3,2,'H',2) C call liter(npisimp-41,348,'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 C call liter(npisimp-24+(i-1)*npimp/8,545,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) C call liter(npisimp-59,530-(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) c call 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 C call printint(ix0,iy0,ix1,iy1,1,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) C call printint(ix0,iy0,ix1,iy1,1,2) end do end if C TANCAR FITXER C call prinplot(1,1,2,2) close(2) return end