Info-Vax-REQUEST@SRI-KL.ARPA.UUCP (03/12/87)
Info-Vax Digest Wednesday, 11 Mar 1987 Volume 0 : Issue 1
Special note:
Due to an unusual backlog of info-vax messages we have decided to
place them all together in a series of digests for more efficient
mailing. Please do not mail comments on the digest format to the
info-vax list. We anticipate returning to the old direct mailing
system shortly. Thank you.
Today's Topics:
VMS printer symbiont for PostScript
swing
Re: LIB$SPAWN
RE: Improvements to VMS
Re: LIB$SPAWN
Display MacPaint images on a VMS workstation
----------------------------------------------------------------------
Date: Sat, 7 Mar 87 03:40 EST
From: Jeffrey Del Papa <dp@JASPER.PALLADIAN.COM>
Reply-to: Jeffrey Del Papa <DP%JASPER@LIVE-OAK.LCS.MIT.EDU>
Subject: VMS printer symbiont for PostScript
Date: Thu, 5 Mar 87 17:03:12 est
From: Eric Gisin <egisin%watmath.waterloo.edu@RELAY.CS.NET>
I have a printer symbiont written in C for PostScript printers.
It has a feature to spawn a subprocess to run a filter
(to convert text to PS or DVI to PS) via the job's form type.
I also have a couple of text to PS filters.
I'll send it to anyone on InterNet, UUCP, or BITNET (in VMSDUMP format).
I can also uuencode it if necessary.
Eric Gisin, egisin@math.waterloo.edu, egisin@wataco.bitnet.
I would love a copy. try mail.. you could mail me just the source (cleartext) if it
isn't too huge.
<dp>
------------------------------
Date: Sat, 7 Mar 87 07:46 MET
From: Arno Diehl <DIEHL%iravcl%germany.csnet@RELAY.CS.NET>
Subject: swing
hallo swingers,
SWING crashed when you tried:
SET DEFAULT DUA0:[000000] ! to get all directories on that
! volume
RUN SWING
The reason was LIB$FIND_FILE returning: DUA0:[000000]000000.DIR;1
causing SWING to search for DUA0:[000000.000000]*.DIR;
This returned DUA0:[000000.000000]000000.DIR;1 and so on...
A simple modification in procedure LOAD_NODES.FOR will handle this
situation. The only thing you have to do is to change the loops
from:
icontext(1) = 0
do while ( lib$find_file( search(1), spec, icontext(1) ) )
call append_node( 1, spec, search(2) )
icontext(2) = 0
do while ( lib$find_file( search(2), spec, icontext(2) ) )
call append_node( 2, spec, search(3) )
...
end do
call lib$find_file_end( icontext(2) )
end do
call lib$find_file_end( icontext(1) )
to:
icontext(1) = 0
do while ( lib$find_file( search(1), spec, icontext(1) ) )
if (index(spec,'000000.DIR;1').eq.0) then
call append_node( 1, spec, search(2) )
icontext(2) = 0
do while ( lib$find_file( search(2), spec, icontext(2) ) )
if (index(spec,'000000.DIR;1').eq.0) then
call append_node( 2, spec, search(3) )
...
end if
end do
call lib$find_file_end( icontext(2) )
end if
end do
call lib$find_file_end( icontext(1) )
--------------
arno diehl, university of karlsruhe, west germany
------------------------------
Date: Sat, 7 Mar 87 05:07:13 PST
From: carl@CitHex.Caltech.Edu (Carl J Lydick)
Subject: Re: LIB$SPAWN
> Does LIB$SPAWN work from a detached process? I have a simple program
> that works fine until I try to RUN/DETACH. Any comments welcome. I have
> included the code to illustrate.
Yes, of course it works from a detached process. Provided of course, that the
detached process has a CLI recognized by LIB$SPAWN (the set of such CLI's
currently consists entirely of DCL). If by detached process you meant what
could better be described as a "detached image", in that the process was
created by giving the name of the image to $CREPRC rather than passing it to
the CLI that an image was already running, then no, it doesn't. Quoting from
LIB$SPAWN requests the command language interpreter (CLI)
of the calling process to spawn a subprocess for executing CLI
commands. LIB$SPAWN provides the same function as the DCL
SPAWN command.
In a the sort of process to which you seem to be referring, there is no CLI to
which LIB$SPAWN can present the request. The LIB$SPAWN exits with the status
%x0015837C, "%LIB-F-NOCLI, no CLI present to perform function", as does (in
the case of your example, the image which called LIB$SPAWN, and since that
image is the entire process, the process as well; the easiest way to verify
way to verify that this was happening is to examine the relevent accounting
records).
------------------------------
Date: Sun, 8 Mar 87 00:23:33 est
From: woo@nyu-acf4.arpa (Alex C. Woo)
Subject: VMS disassembler
Are there any VMS disassemblers available? Hopefully one avaiable from
DECUS? Please send mail directly.
Alex Woo
woo@nyu-acf4.arpa
wooa@nyuacf.bitnet
------------------------------
Date: Sat, 7 Mar 87 19:14 N
From: <BART%HDETUD53.BITNET@wiscvm.wisc.edu>
Subject: RE: Improvements to VMS
In reply to: Jon Forrest (BLIA.UUCP!FORREST@CGL.UCSF.EDU)
I agree with most of Jon's wishes regarding VMS and its components.
However, one of them is realy simple to accomplish: the UNDEFINE
command can be created with the following CLD
!****************************UNDEFINE******************************
define syntax UNDEFINE_ALL_NAMES
noparameters
define verb UNDEFINE
cliroutine DEASSIGN
parameter P1 , prompt="Log name"
value (required,type=$inlog)
qualifier SYSTEM
qualifier GROUP
qualifier JOB
qualifier PROCESS
qualifier USER_MODE
qualifier SUPERVISOR_MODE
qualifier EXECUTIVE_MODE
qualifier TABLE
value (required)
qualifier ALL , syntax=UNDEFINE_ALL_NAMES
Just $ SET COMMAND UNDEFINE, and during your current login session
DCL understands what you mean.
If you want to add the command permanently issue the following commands:
$ SET COMMAND/TABLE=SYS$SHARE:DCLTABLES.EXE/OUTPUT=SYS$SHARE:DCLTABLES.EXE -
UNDEFINE
$ INSTALL REPLACE SYS$SHARE:DCLTABLES.EXE
If you omit the second command the addition of UNDEFINE will only take
effect after the next reboot of the system.
I used Joe Meadows' VERB program to extract the definition of DEASSIGN
It's really great if you want to change or add something to the command
tables!
Bart Zorn (BART@HDETUD53.BITNET)
Delft University of Technology
Faculty of Electrical Engineering
------------------------------
Date: Sat, 7 Mar 87 20:12:53 EST
From: garry@tcgould.tn.cornell.edu (Garry Wiegand)
Reply-to: garry@oak.cadif.cornell.edu
Subject: Re: LIB$SPAWN
In a recent article "%*Gayman, Beth" <gayman@ari-hq1.ARPA> wrote:
>Does LIB$SPAWN work from a detached process? I have a simple program that
>works fine until I try to RUN/DETACH. Any comments welcome.
Lib$Spawn is purely a DCL callback operation - it consists of DCL starting
itself up in a subprocess and then piping in the current process logical names,
the current DCL symbols, and then the Spawn parameters.
In your case - RUN/DETACH progname - there isn't any DCL to call back to!
All you've got is the naked program.
To rectify this, you need to get DCL itself running detached:
$ RUN/DETACH SYS$SYSTEM:LOGINOUT/INPUT=cmdfile
where 'cmdfile' then consists of an "immediate" run:
$ RUN progname
plus pointing SYS$INPUT somewhere appropriate.
One final note: your program was exiting with the Lib$Spawn error as its
final status. To get a look at that status (probably something about "no
command interpreter"), you might do:
$ SET ACC/ENABLE (if not already)
$ SET ACC/ENABLE=DETACH (if not already)
$ SET ACC/NEW (makes it easier to see your run)
(run program)
(wait for it to die)
$ ACC/FULL (look at the reason)
(disable accounting)
Hope this helps
garry wiegand (garry@oak.cadif.cornell.edu)
------------------------------
Date: Sat, 7 Mar 87 22:11:56 CST
From: mic@ngp.utexas.edu (Mic Kaczmarczik)
Subject: Display MacPaint images on a VMS workstation
I wrote this program to learn about UIS and FORTRAN (it was my first
"real" FORTRAN program of any size) on our VAXstation-II/GPX. Enjoy!
Mic Kaczmarczik
User Services Digital Support Group
U.T. Austin Computation Center
ARPA: mic@ngp.utexas.edu
UUCP: ...!seismo!ut-sally!ut-ngp!mic
BITNET: ccep001@utadnx.bitnet
$!
$! DAR: DCL text file archiver
$! To unpack, cut on the dotted line and execute as a DCL command procedure
$! - - - - - - - - - - - - - - - CUT HERE- - - - - - - - - - - - - - - - - - -
$!
$! DCL text archive created by DRAGON::MIC 7-MAR-1987 21:45:10.57
$!
$! Files in this archive:
$! AAAREADME.1ST
$! MACUIS.RNH
$! MACUIS.CLD
$! MACPNTDEF.FOR
$! MACUIS.FOR
$! MACUISDEF.FOR
$!
$ verify = f$verify(0)
$ write sys$error "Unpacking AAAREADME.1ST"
$ copy sys$input AAAREADME.1ST
$ deck/dollars=7MAR1987214510
MACUIS is a program that displays Macintosh MacPaint images on a VMS
workstation screen. It can either be run as a continuous "slide show",
or wait for user input before continuing to the next slide.
I have compiled and run MACUIS successfully using VAX FORTRAN 4.5 on a
8-plane color MicroVAX-II/GPX running MicroVMS 4.5 and VWS 3.0. Your
mileage may vary, based on road conditions and weather :-).
To construct MACUIS, modify MACUIS.CLD to point to where MACUIS
resides on your system, then issue the commands
$ FORTRAN MACUIS ! compile it
$ LINK MACUIS ! link it
$ SET COMMAND MACUIS ! put MACUIS in command tables
$ MACUIS macpaint_file ! run macuis
To construct the help,
$ RUNOFF MACUIS.RNH
To translate MACUIS.HLP into something you can use with the VMS help system,
$ LIBRARY/CREATE/HELP MACUIS.HLB MACUIS.HLP
$ DEFINE HLP$LIBRARY dev:[dir]MACUIS.HLB
$ HELP @MACUIS MACUIS
Please send any comments or bug reports or bug fixes to
Mic Kaczmarczik
User Services Digital Support Group
U.T. Austin Computation Center
ARPA: mic@ngp.utexas.edu
UUCP: ...!ihnp4!seismo!ut-sally!ut-ngp!mic
BITNET: ccep001@utadnx.bitnet
7MAR1987214510
$ write sys$error "Unpacking MACUIS.RNH"
$ copy sys$input MACUIS.RNH
$ deck/dollars=7MAR1987214510
!
! MACUIS.RNH
! Mic Kaczmarczik
! User Services Digital Support Group
! U.T. Austin Computation Center
!
.lm+1
.i-1
1 MACUIS
.br
(07 March 1987)
.sk
The MACUIS command displays Macintosh MacPaint images on a VMS
Workstation running UIS version 3.0 workstation software.
.s
Format
.s
.i+2;MACUIS qualifiers file-spec,...
.i-1
2 Parameters
.s
file-spec,...
.s
The specification(s) of the MacPaint image files to be displayed. Wildcard
characters are allowed, and the plus sign may be used in place of the
comma between file specifications. The file type defaults to MPT.
.i-1
2 Qualifiers
.i-1
/CYCLE
.s
/CYCLE
.br
/NOCYCLE [D]
.s
Repeatedly display the specified files. Useful for continuous "slide
shows" when combined with the /TIMEOUT qualifier.
.s
.i-1
/TIMEOUT
.s
/TIMEOUT
.br
/NOTIMEOUT [D]
.s
Specify an amount of time to display one MacPaint image before displaying
the next. The default timeout value is 8 seconds. Can be used with the
/CYCLE qualifier to create continuous "slide shows" on the workstation
display.
.s
Using a /TIMEOUT value much less than 00:00:00.5 (1/2 second) is not
recommended, since such a short timeout does not provide much time to
type a key to pause the current image before the next one is being read.
.i-1
2 Record__Format
.br
MACUIS expects MacPaint image files to be composed of fixed-size
records. To achieve this, enter
.i+5;SET FILE TYPE FIXED
.s;in VMS Kermit before you transfer the MacPaint file.
Other VMS communications packages may write files in other formats, so
check before you upload a MacPaint file from a Macintosh.
.s;On the Macintosh, use the BINARY transfer option when sending the
file using MacKermit, since MacPaint files are composed of 8-bit
binary data.
7MAR1987214510
$ write sys$error "Unpacking MACUIS.CLD"
$ copy sys$input MACUIS.CLD
$ deck/dollars=7MAR1987214510
! MACUIS.CLD
! The image definition is designed to let you test MACUIS while
! you have SET DEFAULT to the directory it's in.
! Modify this location to suit wherever you want to put it.
!
define verb macuis
image sys$disk:[]macuis
qualifier timeout, value(type=$deltatime), negatable
qualifier cycle, negatable
parameter p1, value(type=$file,list,required),
prompt "MacPaint file(s) [.mpt]"
7MAR1987214510
$ write sys$error "Unpacking MACPNTDEF.FOR"
$ copy sys$input MACPNTDEF.FOR
$ deck/dollars=7MAR1987214510
c
c MACPNTDEF.FOR
c
c Parameter definitions for MacPaint images
c
parameter mpt$scanlines=720 ! lines in MacPaint doc
parameter mpt$scanbytes=72 ! bytes/line
parameter mpt$scanbits=mpt$scanbytes*8 ! pixels/scanline
parameter mpt$imgsiz=mpt$scanlines*mpt$scanbytes! size of image array
7MAR1987214510
$ write sys$error "Unpacking MACUIS.FOR"
$ copy sys$input MACUIS.FOR
$ deck/dollars=7MAR1987214510
c
c Title: MACUIS -- show MacPaint pictures using UIS 3.0
c
c Author: Mic Kaczmarczik
c User Services Digital Support Group
c University of Texas at Austin Computation Center
c ARPA: mic@ngp.utexas.edu
c UUCP: ...!ihnp4!seismo!ut-sally!ut-ngp!mic
c BITNET: CCEP001@UTADNX.BITNET
c
c Created: 28-NOV-1986 MPK My first "real" FORTRAN program
c Modified: 03-DEC-1986 RW Cycle through filespec, other fixes
c 10-DEC-1986 MPK Rearrange, use CLD, disable resize
c 15-JAN-1987 RW Allow early EOF in image file
c 17-JAN-1987 MPK Fix defaults to match documentation,
c get rid of EOF message (since
c we show the picture anyway)
c Credits:
c Many thanks to Philip Watson for the code to read MacPaint images.
c Ditto to Rick Watson for bug fixes, additions, and inspiration.
c
c Usage:
c MACUIS filelist[/qualifiers]
c where
c filespec is a list of MacPaint files to display.
c MacPaint image files are assumed to be composed of
c fixed-length, binary records. You can achieve this
c by typing
c SET FILE TYPE FIXED
c
c in VMS Kermit before you transfer the MacPaint file.
c (Be sure to use the BINARY transfer option when
c sending the file from the Mac using MacKermit).
c
c All MACUIS expects is that the records have fixed
c length; it uses the FORTRAN INQUIRE procedure to
c determine the record length for itself.
c and qualifiers are:
c /[NO]CYCLE -- repeatedly cycle through files
c The default is /NOCYCLE
c
c /TIMEOUT=deltatime -- wait for specified time, then continue
c /NOTIMEOUT -- always wait for user to type a key
c The default is /NOTIMEOUT.
c
c At any time, clicking the right mouse button exits the program.
c
c When /TIMEOUT is enabled, typing any key pauses the display until
c another key is typed. A window with "an informative message"
c pops up telling you what to do next.
c
c
c Notes:
c In all windows, the world coordinate system is the same as the virtual
c display's coordinate system.
c
implicit integer(a-z)
include 'sys$library:uisentry'
include 'sys$library:uisusrdef'
include '($LIBDEF)'
include '($RMSDEF)'
include '($SSDEF)'
include 'macpntdef' ! MacPaint constants
include 'macuisdef' ! MACUIS constants
c file specification list
character*128 filespecs(maxfile) ! List of file specs
integer nfiles ! number of files
integer context ! Search context
character*128 macfilename ! Parsed file name
c
c Macpaint image buffer
c
byte image(mpt$imgsiz) ! image data
logical unpack, unpack_sts ! unpacks MacPaint file
c
c Macpaint image display variables
c
integer vd_id,wd_id,vcm_id,kb_id ! UIS identifiers
real*4 vd_width, vd_height ! virtual display size
real*4 dspwidth, dspheight ! VAXstation disp. size
real*4 wd_x, wd_y, wd_h, wd_w ! viewport size
real*4 xres,yres ! resolution factors
parameter vcm_size=2 ! 1-plane color map
character*60 windowtitle ! window title
c
c "type key to continue" window variables
c
integer pause_vd, pause_wd ! pausing window
real*4 pause_width /10.0/, pause_height /1.0/
real*4 pmsg_width, pmsg_height
structure /wdpl_attributes/
integer*4 code
union
map
real*4 position ! ABS_POS_x
end map
map
integer*4 flags ! position flags
end map
end union
end structure
record /wdpl_attributes/ pause_attr(4)
c
c qualifier flags/values
c
character*40 time_str ! time out period
logical*1 keytyped ! Key AST flag
logical*1 repeat ! cycle display?
logical*1 time_out ! time out flag
logical*1 quit ! exit now?
c
c UIS keyboard management
c
logical*1 keybuf(4) ! KB input buffer
integer*4 bintim(2) ! used by $SETIMR
common /kb/kb_id, keybuf, keytyped, qualifiers, quit
common /wd/wd_id
external keystroke,timeout,button ! AST routines
c
c Parse command qualifiers and file names into the appropriate variables.
c
call parse(filespecs,nfiles,repeat,time_out,time_str)
if (time_out) then ! set timeout period
status = sys$bintim(time_str,bintim)
if (.not. status) call lib$stop(%VAL(status))
endif
c
c Create a virtual display with the right characteristics for the image
c
call uis$get_display_size('SYS$WORKSTATION',
* dspwidth, dspheight, xres, yres)
vd_width = float(mpt$scanbits) / xres
vd_height = float(mpt$scanlines) / yres
vcm_id = uis$create_color_map(vcm_size)
vd_id = uis$create_display(0.0, 0.0, float(mpt$scanbits),
* float(mpt$scanlines), vd_width, vd_height, vcm_id)
c
c Create a virtual display with "type a key" message (displayed when pausing)
c
if (time_out) then
pause_vd = uis$create_display(0.0,0.0,
* pause_width, pause_height, pause_width, pause_height)
pause_attr(1).code = WDPL$C_ABS_POS_X
pause_attr(2).code = WDPL$C_ABS_POS_Y
pause_attr(3).code = WDPL$C_ATTRIBUTES
pause_attr(3).flags = WDPL$M_NOKB_ICON
* + WDPL$M_NOMENU_ICON + WDPL$M_NOBANNER
pause_attr(4).code = WDPL$C_END_OF_LIST
call uis$measure_text(pause_vd,0,'Type any key to continue',
* pmsg_width, pmsg_height)
call uis$set_aligned_position(pause_vd,0,
* (pause_width - pmsg_width) / 2,
* pmsg_height + (pause_height - pmsg_height) / 2)
call uis$text(pause_vd,0,'Type any key to continue')
end if
c
c Set up colors (black & white!) and create drawing window that we can
c keep drawing new images into (with mode UIS$C_MODE_REPL)
c
call uis$set_color(vd_id,0,1.0,1.0,1.0) ! set index 0 (bg) white
call uis$set_color(vd_id,1,0.0,0.0,0.0) ! set index 1 (fg) black
call uis$set_writing_mode(vd_id, 0, 1, UIS$C_MODE_REPL)
if (time_out) then ! set appropriate window title
windowtitle =
* ' Any key pauses (twice continues), right mouse button exits'
else
windowtitle =
* ' Type any key to continue, right mouse button exits '
end if
wd_id = uis$create_window(vd_id,'SYS$WORKSTATION',windowtitle)
call uis$set_resize_ast(vd_id,wd_id) ! disable resizing!
c
c Create a connection between the window and the physical keyboard
c
kb_id = uis$create_kb('SYS$WORKSTATION')
call uis$enable_viewport_kb(kb_id, wd_id) ! let user select kb
call uis$enable_kb(kb_id, wd_id) ! select it for him...
c
c Loop through the list of files and display any file that
c is successfully found and unpacked.
c
100 do specnum = 1, nfiles
c ... find a file
context = 0 ! set up search context
110 status = lib$find_file(filespecs(specnum),macfilename,
* context,'.MPT')
if (status .eq. RMS$_NMF) then
call lib$find_file_end(context) ! end search
goto 120 ! goto end of loop
else if (status .ne. RMS$_NORMAL) then
write(*,'('' %MACUIS-F-FNF, file not found'')')
call lib$find_file_end(context) ! end search
goto 130 ! exit!
end if
c ... unpack it
unpack_sts = unpack(macfilename,image) ! unpack image
if (.not. unpack_sts) then
write(*,'('' %MACUIS-F-UNPACK, image unpack failed'')')
goto 130 ! exit!
end if
c ... display image
call uisdc$image(wd_id, 1, 0.0, 0.0, float(mpt$scanbits),
* float(mpt$scanlines), mpt$scanbits, mpt$scanlines, 1, image)
c ... wait for user action or timeout
call uis$set_button_ast(vd_id, wd_id, button,,%ref(qualifiers))
call uis$set_kb_ast(kb_id, keystroke, 0, keybuf)! set AST's
if (.not. time_out) then
call sys$hiber() ! wait for key/button
else
keytyped = .false. ! reset key flag
call sys$setimr(,bintim,timeout,) ! set timeout
call sys$hiber() ! wait for key|timeout
call sys$cantim(,) ! cancel timeout
if (keytyped .and. (.not. quit)) then
call uis$get_viewport_position(wd_id,wd_x,wd_y)
call uis$get_viewport_size(wd_id,wd_w,wd_h)
pause_attr(1).position = wd_x + (wd_w - pause_width) / 2
pause_attr(2).position = wd_y + wd_h
pause_wd = uis$create_window(pause_vd,'SYS$WORKSTATION',
* 'Type any key to continue',
* 0.0,0.0,pause_width,pause_height,
* pause_width,pause_height,pause_attr)
call sys$hiber() ! pause
call uis$delete_window(pause_wd)! delete it
end if
end if
call uis$set_button_ast(vd_id, wd_id) ! reset mouse AST
if (quit) then
goto 130 ! immediate exit
else
goto 110 ! look for next file
end if
c ... here when done with current file specification (find_file returns NMF)
120 continue
end do
c
c Here when done with for loop. If repeat is set, start the whole thing over.
c
if (repeat) goto 100
c
c Done! Clean up and exit, deleting items in reverse order of creation.
c
130 if (context .ne. 0) call lib$find_file_end(context) ! finish search
call uis$delete_kb(kb_id)
call uis$delete_window(wd_id)
call uis$delete_display(vd_id)
if (time_out) call uis$delete_display(pause_vd)
call uis$delete_color_map(vcm_id)
call sys$exit(%VAL(SS$_NORMAL))
end
c* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c
c Parse command line options.
c On return:
c filespecs is a list of file specifications
c nfiles is the number of file specs in filespecs
c repeat indicates the value of /CYCLE
c time_out indicates the value of /TIMEOUT
c time_str is the delta time value when /TIMEOUT=time is chosen
c
SUBROUTINE PARSE(filespecs,nfiles,repeat,time_out,time_str)
implicit integer(a-z)
include 'macuisdef'
character*128 filespecs(maxfile) ! file names
integer nfiles ! # filespecs parsed
logical*1 repeat ! cycle?
logical*1 time_out ! time out flag
character*40 time_str ! timeout time string
integer present, val_stat
external CLI$_PRESENT, CLI$_DEFAULTED, CLI$_NEGATED
external CLI$_ABSENT, CLI$_COMMA, CLI$_CONCAT
external SS$_NORMAL
c
c Check for /CYCLE qualifier
c
repeat = .false. ! don't repeat unless requested.
present = cli$present('CYCLE')
if ((present .eq. %LOC(CLI$_PRESENT)) .or.
* (present .eq. %LOC(CLI$_DEFAULTED))) then
repeat = .true.
else if (present .eq. %LOC(CLI$_NEGATED)) then
repeat = .false.
end if
c
c Check for /TIMEOUT qualifier
c
time_out = .false. ! wait for user
present = cli$present('TIMEOUT')
if ((present .eq. %LOC(CLI$_PRESENT)) .or.
* (present .eq. %LOC(CLI$_DEFAULTED))) then
time_out = .true.
val_stat = cli$get_value('TIMEOUT',time_str)
if (val_stat .ne. %LOC(SS$_NORMAL)) then! set default timeout
time_str = '0 00:00:08.00'
end if
else if (present .eq. %LOC(CLI$_NEGATED)) then
time_out = .false.
time_str = '1 00:00:00.00' ! filewall at 1 day...
else
time_out = .false.
time_str = '0 00:00:08.00' ! default to 8 seconds
end if
c
c Get list of file names to show. We accept wildcards (but not MasterCard :-)
c
nfiles = 0
present = cli$present('P1')
if (present .ne. %LOC(CLI$_PRESENT)) then
write(*,'('' %MACUIS-F-NOP1, P1 is not present! '')')
call sys$exit(present)
end if
100 if (nfiles .gt. maxfile) then
write(*,'('' %MACUIS-W-TMF, too many files on command line! '')')
goto 110
end if
val_stat = cli$get_value('P1',filespecs(nfiles + 1))
nfiles = nfiles + 1
if ((val_stat .eq. %LOC(CLI$_COMMA)) .or.
* (val_stat .eq. %LOC(CLI$_CONCAT))) goto 100 ! more specs in list
110 continue
end
c* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c
c AST routine that is invoked when user types a key. When invoked,
c it sets the flag keytyped, and wakes the process up
c
SUBROUTINE KEYSTROKE
implicit integer(a-z)
include 'sys$library:uisentry'
include 'sys$library:uisusrdef'
common /kb/kb_id, keybuf, keytyped, qualifiers, quit
logical*1 keybuf(4) ! input buffer
logical*1 keytyped ! was a key typed?
status = uis$test_kb(kb_id) ! should always be true
keytyped = .true. ! key was typed
call sys$wake(,) ! wake up!
end
c* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c
c AST routine activated when button is clicked anywhere in the
c picture window. Sets quit when the right mouse button is released,
c does nothing when it's pressed.
c
SUBROUTINE BUTTON
implicit integer(a-z)
include 'sys$library:uisentry'
include 'sys$library:uisusrdef'
common /kb/kb_id, keybuf, keytyped, qualifiers, quit
common /wd/wd_id
integer kb_id
logical*1 keybuf(4)
logical*1 keytyped
integer qualifiers
logical*1 quit
integer wd_id
logical*1 down
integer keycode
down = btest(qualifiers,UIS$V_KEY_DOWN)
keycode = ibits(qualifiers,0,16)
if ((.not. down) .and. (keycode .eq. UIS$C_POINTER_BUTTON_1)) then
call uis$pop_viewport(wd_id)
end if
if ((.not. down) .and. (keycode .eq. UIS$C_POINTER_BUTTON_3)) then
quit = .true. ! user wants to quit
call sys$wake(,) ! wake up process
end if
end
c* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c
c AST routine set up by call to sys$setimr (just wakes us up again)
c
SUBROUTINE TIMEOUT
call sys$wake(,)
end
c* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c
c Unpack the MacPaint image. On successful return, image contains a
c 8-pixel-per-byte bitmap that represents the MacPaint image.
c
LOGICAL FUNCTION UNPACK(FILESPEC,IMAGE)
implicit integer(a-z)
include 'macpntdef'
include 'macuisdef'
include '($SSDEF)'
character*128 filespec ! file name
byte image(mpt$imgsiz) ! image data
byte byte
integer nextbyte ! index into array
logical getbyte, get_status ! reads a byte
character*12 rectype ! must be 'FIXED'
integer recordsize ! i/o common
integer maclun /1/
common /io/recordsize,maclun
common /index/index ! getbyte index
c
c Trans(i) is the 8-bit signed number you get when you take the bit pattern
c for i and reverse the bits from left to right. This converts a Mac-style
c bitmap image byte into a UIS-style image byte.
c
c Take -128 for example. Its bit representation is 10000000, so its
c reverse is 00000001 (=1).
c
byte trans(-128:127) /
* 1, -127, 65, -63, 33, -95, 97, -31, ! -128 - -121
* 17, -111, 81, -47, 49, -79, 113, -15, ! -120 - -113
* 9, -119, 73, -55, 41, -87, 105, -23, ! -112 - -105
* 25, -103, 89, -39, 57, -71, 121, -7, ! -104 - -97
* 5, -123, 69, -59, 37, -91, 101, -27, ! -96 - -89
* 21, -107, 85, -43, 53, -75, 117, -11, ! -88 - -81
* 13, -115, 77, -51, 45, -83, 109, -19, ! -80 - -73
* 29, -99, 93, -35, 61, -67, 125, -3, ! -72 - -65
* 3, -125, 67, -61, 35, -93, 99, -29, ! -64 - -57
* 19, -109, 83, -45, 51, -77, 115, -13, ! -56 - -49
* 11, -117, 75, -53, 43, -85, 107, -21, ! -48 - -41
* 27, -101, 91, -37, 59, -69, 123, -5, ! -40 - -33
* 7, -121, 71, -57, 39, -89, 103, -25, ! -32 - -25
* 23, -105, 87, -41, 55, -73, 119, -9, ! -24 - -17
* 15, -113, 79, -49, 47, -81, 111, -17, ! -16 - -9
* 31, -97, 95, -33, 63, -65, 127, -1, ! -8 - -1
* 0, -128, 64, -64, 32, -96, 96, -32, ! 0 - 7
* 16, -112, 80, -48, 48, -80, 112, -16, ! 8 - 15
* 8, -120, 72, -56, 40, -88, 104, -24, ! 16 - 23
* 24, -104, 88, -40, 56, -72, 120, -8, ! 24 - 31
* 4, -124, 68, -60, 36, -92, 100, -28, ! 32 - 39
* 20, -108, 84, -44, 52, -76, 116, -12, ! 40 - 47
* 12, -116, 76, -52, 44, -84, 108, -20, ! 48 - 55
* 28, -100, 92, -36, 60, -68, 124, -4, ! 56 - 63
* 2, -126, 66, -62, 34, -94, 98, -30, ! 64 - 71
* 18, -110, 82, -46, 50, -78, 114, -14, ! 72 - 79
* 10, -118, 74, -54, 42, -86, 106, -22, ! 80 - 87
* 26, -102, 90, -38, 58, -70, 122, -6, ! 88 - 95
* 6, -122, 70, -58, 38, -90, 102, -26, ! 96 - 103
* 22, -106, 86, -42, 54, -74, 118, -10, ! 104 - 111
* 14, -114, 78, -50, 46, -82, 110, -18, ! 112 - 119
* 30, -98, 94, -34, 62, -66, 126, -2 ! 120 - 127
* /
c
c Inspect the MacPaint file to get the record size and type
c
inquire(file=filespec,defaultfile='.mpt',recl=recordsize,
* recordtype=rectype)
if (rectype .ne. 'FIXED ') then
write(*,'('' %MACUIS-F-NOTFIX, file must have fixed records'')')
unpack = .false.
return
end if
if (recordsize .eq. 0) then
write(*,'('' %MACUIS-F-NOTFOUND, file not found'')')
unpack = .false.
return
end if
if (recordsize .gt. maxrec) then
write(*,'('' %MACUIS-F-TOOLONG, recl exceeds buffer size'')')
unpack = .false.
return
end if
c
c Reset getbyte and open the MacPaint file
c
index = recordsize ! preset getbyte
open(unit=maclun,file=filespec,defaultfile='.mpt',type='old',
* form='unformatted',recordtype='fixed',recl=recordsize/4,err=100)
goto 105 ! ...success
c
c...can't find file
c
100 write(*,'('' %MACUIS-F-OPENIN, error opening file for input'')')
unpack = .false.
return
c
c...skip header in file
c
105 do i=1,512
get_status=getbyte(byte)
enddo
c
c Unpack Mac file into buffer
c
nextbyte = 1
110 if(.not.getbyte(byte)) goto 120
count=byte
if(count.ge.0) then
do i=0,count
get_status=getbyte(byte) ! reverse bits
image(nextbyte)=trans(byte)
nextbyte=nextbyte + 1
if (nextbyte .gt. mpt$imgsiz) goto 120 ! done
enddo
else
get_status=getbyte(byte)
byte = trans(byte) ! reverse bits (once)
do i=0,abs(count)
image(nextbyte)=byte
nextbyte=nextbyte+1
if (nextbyte .gt. mpt$imgsiz) goto 120 ! done!
enddo
endif
if(get_status) goto 110
c
c...unexpected end of file encountered -- ignore it and fill the
c rest of the image out with 0's
c
do i = nextbyte, mpt$imgsiz ! zero rest of image
image(i) = 0
enddo
c
c file unpacked fine
c
120 unpack=.true.
close(unit=maclun)
return
end
c* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c
c Get next byte from common logical unit maclun
c
LOGICAL FUNCTION GETBYTE(BYTE)
implicit integer(a-z)
include 'macuisdef'
integer recordsize,maclun
integer forterr,rmssts,rmsstv,lunit,condval
common /io/recordsize,maclun ! defined by main
common /index/index
byte buffer(maxrec), byte
save buffer
index=index+1
if(index.gt.recordsize) then
read(maclun,err=90,end=100) (buffer(i),i=1,recordsize)
index=1
endif
byte=buffer(index)
getbyte=.true.
goto 110
c
c
c
90 call errsns(forterr,rmssts,rmsstv,lunit,condval)
call lib$signal(%val(condval))
getbyte = .false.
return
c
c...byte not available
c
100 byte=0
getbyte=.false.
index=recordsize
c
c Return
c
110 return
end
7MAR1987214510
$ write sys$error "Unpacking MACUISDEF.FOR"
$ copy sys$input MACUISDEF.FOR
$ deck/dollars=7MAR1987214510
c
c MACUISDEF.FOR
c
c Constant definitions for MACUIS
c
parameter maxrec=512 ! File record size
parameter maxfile=40 ! Max # files in table
7MAR1987214510
$ write sys$error "All done bunky!"
$ if verify then -
set verify
$ exit
------------------------------
End of Info-Vax Digest
**********************