84 lines
2.0 KiB
Forth
84 lines
2.0 KiB
Forth
program terinq
|
|
|
|
implicit none
|
|
character gdev*32, pps*32, line*256
|
|
integer rows, i, ll, l, cols
|
|
logical debug
|
|
|
|
call sys_getenv('TERINQ_DEB', line)
|
|
debug=(line .ne. ' ')
|
|
line=' '
|
|
call sys_get_cmdpar(line, i)
|
|
if (i .eq. 0) i=1
|
|
|
|
call sys_loadenv
|
|
|
|
if (line(1:7) .eq. 'gethost') then ! host info on command line
|
|
i=index(line,'!')
|
|
if (i .ne. 0) then
|
|
call sys_setenv('REMOTEHOST', line(9:i-1))
|
|
endif
|
|
i=index(line,'(')
|
|
if (i .ne. 0) then
|
|
line=line(i+1:)
|
|
i=index(line, ')')
|
|
if (i .gt. 1) then
|
|
call sys_setenv('REMOTEHOST', line(1:i-1))
|
|
endif
|
|
endif
|
|
line=' '
|
|
i=1
|
|
endif
|
|
|
|
call sys_setenv('CHOOSER_TERINQ', '1')
|
|
call cho_inq(line(1:i), gdev, pps, cols, rows)
|
|
if (debug) print *,'cho_inq: rows=',rows
|
|
ll=0
|
|
if (gdev .ne. ' ') then
|
|
call sys_setenv('CHOOSER_GDEV',gdev)
|
|
call sys_setenv('PGPLOT_DEV','/'//gdev)
|
|
call str_trim(gdev, gdev, l)
|
|
line='Display type: '//gdev(1:l)
|
|
ll=l+14
|
|
endif
|
|
call cho_vpp_cups(pps)
|
|
if (pps .ne. ' ') then
|
|
if (ll .gt. 0) then
|
|
line(ll+1:)=', '
|
|
ll=ll+3
|
|
endif
|
|
call str_trim(pps, pps, l)
|
|
line(ll+1:)='Default Printer: '//pps(1:l)
|
|
ll=ll+l+17
|
|
call sys_setenv('CHOOSER_DEST',pps(1:l))
|
|
call sys_setenv('CHOOSER_PDEV','CPS')
|
|
endif
|
|
if (rows .ne. 0) then
|
|
if (debug) print *,'terinq: rows=',rows
|
|
if (ll .gt. 0) then
|
|
line(ll+1:)=', '
|
|
ll=ll+2
|
|
endif
|
|
write(line(ll+1:), '(i3,a)') rows, ' rows'
|
|
call sys_setenv('TERINQ_ROWS', line(ll+1:ll+3))
|
|
ll=ll+8
|
|
endif
|
|
if (cols .ne. 0) then
|
|
if (ll .gt. 0) then
|
|
line(ll+1:ll+1)=','
|
|
ll=ll+1
|
|
endif
|
|
write(line(ll+1:), '(i3,a)') cols, ' cols'
|
|
call sys_setenv('TERINQ_COLS', line(ll+1:ll+3))
|
|
ll=ll+8
|
|
endif
|
|
if (ll .gt. 0) then
|
|
print *
|
|
print *,line(1:ll)
|
|
print *
|
|
endif
|
|
90 continue
|
|
call sys_saveenv
|
|
call sys_clean_tmp
|
|
end
|