SUBROUTINE SCRNINT real*8 motor_quad byte esc common /mtr_com/ motor_quad,posm(4),imchn character TIME_STRING*9 external motor_ast data time_string /'0 ::1.00'/ data esc /27/ C c set up timer variable for screen update c call sys$bintim(time_string,motor_quad) c c clear screen and get motor positions c open(unit=90,file='sys$output',carriagecontrol='list',status='old') write(90,4)esc,esc 4 format(a1,'[1;1H',a1,'[2J',8x,'|',16x,'MOTOR POSITIONS',19x,'|' 1/8x,'|',6x,'2theta',7x,'omega',9x,'chi',9x,'phi',t60,'|') do i=1,4 posm(i)=0.0 enddo write(90,8)(posm(i),i=1,4) 8 format(8x,'| ',4(f11.3,1x),' |') write(90,9) 9 format(8x,'|__________________________________________________|') c c set scrolling region and place cursor in position c write(90,12)esc,esc 12 format(a1,'[6;24r',a1,'[6;1H') close(unit=90) c c place timer request c call motor_setast(motor_quad) c c open channel to screen c call sys$assign('sys$output',imchn,,) RETURN END SUBROUTINE motor_SETAST(TIME_QUAD) C C ROUTINE TO PLACE A MOTOR AST REQUEST C IMPLICIT NONE REAL*8 TIME_QUAD EXTERNAL motor_ast C CALL SYS$SETIMR(,TIME_QUAD,motor_ast,) RETURN END SUBROUTINE motor_ast(AST_ARG) C C ROUTINE TO UPDATE MOTOR POSITIONS C C A TIMER ENTRY IS PLACED BY THE INITIALIZATION CODE. WHEN THE C DELAY EXPIRES, THIS ROUTINE IS ENTERED. IT RESCHEDULES C ITSELF AND READS THE POSITION OF A GROUP OF MOTORS. FOR ANY POSITION THAT C IS CHANGED, THE REVISED LOCATION IS UPDATED ON THE SCREEN. C C CODED 15-FEB-90 BY L.W.FINGER C INCLUDE 'newdif.inc' integer cminit byte esc,chout(20) real temp(4) real*8 motor_quad common /mtr_com/ motor_quad,posm(4),imchn data esc /27/ data iwrite /'130'x/ C C RESCHEDULE THE TIMER REQUEST C CALL motor_SETAST(MOTOR_QUAD) c c if code locked out, exit c if(dif_lock.ne.0)return c c read positions of motors and update on screen if changed c call RdAllMTR(temp) do i=1,4 if(abs(temp(i)-posm(i)).ge.0.0001)then c position changed - update screen nrow=3 ncol=(i-1)*12+13 c save cursor, update position and restore cursor encode(20,4,chout)esc,esc,nrow,ncol,temp(i),esc 4 format(a1,'7',a1,'[',i1,';',i2.2,'H',f9.3,a1,'8') call sys$qiow(,%val(imchn),%val(iwrite),,,,chout 1 ,%val(20),,,,) posm(i)=temp(i) end if end do return end