x_larsen_b%use.uio.uninett@TOR.NTA.NO (Bj|rn Larsen) (08/04/87)
Here is part 2 of the FORM program.
Catenate this posting to the end of part one, and
execute.
Bjorn Larsen x_larsen_b%use.uio.uninett@tor.nta.no
-------------------- Cut Here -------------------------
$ File_is="FRMLIB.MAR"
$ Check_Sum_is=1229344245
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X;
X; These macros have been snatched from my miscellaneous
X; macro libraries. In this way, I can keep the size of
X; the posting down.
X;
X; If you want the complete macro libraries, please contact me.
X;
X; Bjorn Larsen x_larsen_b%use.uio.uninett@tor.nta.no
X;
X
X.macro $descr_s name,pointer,length,dtype=dsc$k_dtype_t
Xname': .word length ; length of data item in bytes,
X ; or if dsc$b_dtype is DSC$K_DTYPE_V, bits,
X ; or if dsc$b_dtype is DSC$K_DTYPE_P, digits
X ; (4 bits each)
X .byte dtype ; data type code
X .byte DSC$K_CLASS_S ; descriptor class code
X .address pointer ; address of first byte of data storage
X.endm
X
X.macro $descr_d name,pointer,length,dtype=dsc$k_dtype_t
Xname': .word length ; length of data item in bytes,
X ; or if dsc$b_dtype is DSC$K_DTYPE_V, bits,
X ; or if dsc$b_dtype is DSC$K_DTYPE_P, digits
X ; (4 bits each)
X .byte dtype ; data type code
X .byte DSC$K_CLASS_D ; descriptor class code
X .address pointer ; address of first byte of data storage
X.endm
X
X.macro $descr_a name,pointer,length,totallength,dtype=dsc$k_dtype_l,scale=0,-
X digits=0,flags=0,dimct=1
Xname': .word length ; length of an array element in bytes,
X ; or if dsc$b_dtype is DSC$K_DTYPE_V, bits,
X ; or if dsc$b_dtype is DSC$K_DTYPE_P, digits (4 bits each)
X .byte dtype ; data type code
X .byte DSC$K_CLASS_A ; descriptor class code
X .address pointer ; address of first actual byte of data storage
X .byte scale ; scale multiplier to convert from internal to external form
X .byte digits ; number of decimal digits in internal representation
X .byte flags
X .byte dimct ; number of dimensions
X .long totallength ; total size of array in bytes,
X ; or if dsc$b_dtype is DSC$K_DTYPE_P, digits
X ; (4 bits each)
X;
X; One or two optional blocks of information may follow contiguously at this
X; point; the first block contains information about the dimension multipliers
X; (if present, dsc$b_aflags.dsc$v_fl_coeff is set), the second block contains
X; information about the dimension bounds (if present, dsc$b_aflags.
X; dsc$v_fl_bounds is set). If the bounds information is present, the
X; multipliers information must also be present.
X;
X; The multipliers block has the following format:
X; .address a0 ; Address of the element whose subscripts are
X; ; all zero
X; .blkl DIMCT ; Addressing coefficients (multipliers)
X;
X; The bounds block has the following format:
X; .blkl <DIMCT*2> ; Pairs of lower-upper bound longwords.
X;
X; (DIMCT represents the value contained in dsc$b_dimct.)
X;
X.endm
X
X.MACRO $lib$get_input get_str,prompt_str=0,out_len=0
X .GLOBL lib$get_input
X $PUSHADR out_len
X $PUSHADR prompt_str
X $PUSHADR get_str
X CALLS #3,G^lib$get_input
X.ENDM $lib$get_input
X
X.MACRO $lib$set_symbol symbol,value,tbl_ind=0
X .GLOBL lib$set_symbol
X $PUSHADR tbl_ind
X $PUSHADR value
X $PUSHADR symbol
X CALLS #3,G^lib$set_symbol
X.ENDM $lib$set_symbol
X
X.MACRO $lib$get_symbol symbol,ret_buf,ret_len=0,tbl_ind=0
X .GLOBL lib$get_symbol
X $PUSHADR tbl_ind
X $PUSHADR ret_len
X $PUSHADR ret_buf
X $PUSHADR symbol
X CALLS #4,G^lib$get_symbol
X.ENDM $lib$get_symbol
X
X.MACRO $fdv$lopen filspc,channel=0
X .GLOBL fdv$lopen
X $PUSHADR channel
X $PUSHADR filspc
X CALLS #2,G^fdv$lopen
X.ENDM $fdv$lopen
X
X.MACRO $fdv$spada mode
X .GLOBL fdv$spada
X $PUSHADR mode
X CALLS #1,G^fdv$spada
X.ENDM $fdv$spada
X
X.MACRO $fdv$ssigq sigmd
X .GLOBL fdv$ssigq
X $PUSHADR sigmd
X CALLS #1,G^fdv$ssigq
X.ENDM $fdv$ssigq
X
X.MACRO $fdv$load frmnam
X .GLOBL fdv$load
X $PUSHADR frmnam
X CALLS #1,G^fdv$load
X.ENDM $fdv$load
X
X.MACRO $fdv$disp frmnam,offset=0
X .GLOBL fdv$disp
X $PUSHADR offset
X $PUSHADR frmnam
X CALLS #2,G^fdv$disp
X.ENDM $fdv$disp
X
X.MACRO $fdv$putl val=0,line=0
X .GLOBL fdv$putl
X $PUSHADR line
X $PUSHADR val
X CALLS #2,G^fdv$putl
X.ENDM $fdv$putl
X
X.MACRO $fdv$aterm tca,size,channel,terminal=0,faketrmtyp=0,noclear=0
X .GLOBL fdv$aterm
X $PUSHADR noclear
X $PUSHADR faketrmtyp
X $PUSHADR terminal
X $PUSHADR channel
X $PUSHADR size
X $PUSHADR tca
X CALLS #6,G^fdv$aterm
X.ENDM $fdv$aterm
X
X.MACRO $fdv$awksp wksp,size
X .GLOBL fdv$awksp
X $PUSHADR size
X $PUSHADR wksp
X CALLS #2,G^fdv$awksp
X.ENDM $fdv$awksp
X
X.MACRO $fdv$lclos
X .GLOBL fdv$lclos
X CALLS #0,G^fdv$lclos
X.ENDM $fdv$lclos
X
X.MACRO $fdv$dwksp wksp
X .GLOBL fdv$dwksp
X $PUSHADR wksp
X CALLS #1,G^fdv$dwksp
X.ENDM $fdv$dwksp
X
X.MACRO $fdv$dterm tca
X .GLOBL fdv$dterm
X $PUSHADR tca
X CALLS #1,G^fdv$dterm
X.ENDM $fdv$dterm
X
X.MACRO $fdv$get fldval,fldtrm,fldnam,fldidx=0
X .GLOBL fdv$get
X $PUSHADR fldidx
X $PUSHADR fldnam
X $PUSHADR fldtrm
X $PUSHADR fldval
X CALLS #4,G^fdv$get
X.ENDM $fdv$get
X
X.MACRO $fdv$retfn fldnam,fldidx=0
X .GLOBL fdv$retfn
X $PUSHADR fldidx
X $PUSHADR fldnam
X CALLS #2,G^fdv$retfn
X.ENDM $fdv$retfn
X
X.MACRO $fdv$retle fldlen,fldnam,fldidx=0
X .GLOBL fdv$retle
X $PUSHADR fldidx
X $PUSHADR fldnam
X $PUSHADR fldlen
X CALLS #3,G^fdv$retle
X.ENDM $fdv$retle
X
X.MACRO $fdv$pft fldtrm=0,fldnam=0,fldval=0,fldidx=0
X .GLOBL fdv$pft
X $PUSHADR fldidx
X $PUSHADR fldval
X $PUSHADR fldnam
X $PUSHADR fldtrm
X CALLS #4,G^fdv$pft
X.ENDM $fdv$pft
X
X.MACRO $fdv$getaf fldval,fldtrm,fldnam,fldidx=0
X .GLOBL fdv$getaf
X $PUSHADR fldidx
X $PUSHADR fldnam
X $PUSHADR fldtrm
X $PUSHADR fldval
X CALLS #4,G^fdv$getaf
X.ENDM $fdv$getaf
X
X.MACRO $fdv$retfo fldnum,fldnam,fldidx
X .GLOBL fdv$retfo
X $PUSHADR fldidx
X $PUSHADR fldnam
X $PUSHADR fldnum
X CALLS #3,G^fdv$retfo
X.ENDM $fdv$retfo
X
X.MACRO $fdv$put fldval=0,fldnam=0,fldidx=0
X .GLOBL fdv$put
X $PUSHADR fldidx
X $PUSHADR fldnam
X $PUSHADR fldval
X CALLS #3,G^fdv$put
X.ENDM $fdv$put
X
$ GoSub Convert_File
$ File_is="GETFILE.FLG"
$ Check_Sum_is=1279984575
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X
X
X! FMS Form Description Application Aid
X! Version V2.2
X
XFORM NAME='GETFILE'
X AREA_TO_CLEAR=1:23
X WIDTH=CURRENT
X BACKGROUND=CURRENT
X HIGHLIGHT=UNDERLINE
X ;
X
X
XTEXT (2,7) 'Enter name of file to search for.'
X ;
XTEXT (3,7) '(wildcards allowed)'
X ;
XTEXT (7,7) 'Filename:'
X ;
X
XATTRIBUTE_DEFAULTS FIELD
X CLEAR_CHARACTER=' '
X NOAUTOTAB BLANK_FILL NOBLINKING NOBOLD NOREVERSE
X NOUNDERLINE NODISPLAY_ONLY ECHO NOFIXED_DECIMAL
X LEFT_JUSTIFIED NOSUPERVISOR_ONLY NOSUPPRESS NOUPPERCASE
X ;
X
XFIELD NAME='FILENAME' (7,18)
X PICTURE=35'X'
X ;
X
X
XEND_OF_FORM NAME='GETFILE' ;
$ GoSub Convert_File
$ File_is="READ.ME"
$ Check_Sum_is=994473663
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
XFORM - display FMS form and return user input in DCL symbols.
X
XI use this program to present/input data from DCL command procedures.
X
XInstallation:
X
X - Execute BUILD.COM. You should now have a FORM.EXE.
X If BUILD.COM fails when creating the forms for the
X example routine, you may not have the Forms Translator.
X FMSFLG is a separate product. If this is the case, you will
X have to create the forms manually from the information
X in the .FLG files. Good luck.
X - Modify the image spesification in FORM.CLD to point to
X wherever you put the EXE-file.
X - SET COMMAND FORM.CLD, or modify the DCLtables if you want to.
X - Test FORM by executing SHOWFILE.COM.
X
XUsage:
X
X $ FORM[/qualifiers] formname fmslibrary
X
X Example:
X
X Assume you have a form called TFRM inside a FMS library called TLIB.
X
X The form TFRM consists of two fields, NAME and AGE.
X
X It you want to input NAME and AGE from a DCL procedure, you could
X do something like:
X
X $ FORM TFRM TLIB
X $ AGE = F$INTEGER (FRM$AGE)
X $ IF AGE.LT.20 THEN -
X $ WRITE SYS$OUTPUT "Sorry, ''FRM$NAME', but you are too young."
X
X Or, if you wanted to default the age, you could do
X
X $ DEF$AGE = "26"
X $ FORM/DEFAULT TFRM TLIB
X
X If you want to PRESENT data, but not input any, use the /NOINPUT
X qualifier, like in
X
X $ DEF$AGE = "27"
X $ DEF$NAME = "Bj|rn Larsen"
X $ FORM/DEFAULT/NOINPUT TFRM TLIB
X
XWarning:
X
X Do *NOT* yse this program as an substitute for learning how to
X program FDV calls. If you plan to design a data-entry environment,
X do not program it in DCL. I have used this program for doing
X quick-and-dirty design of forms. Once the user is satisfied,
X I rewrite the DCL program to C or Pascal or whatever..
X
X
XBj|rn Larsen x_larsen_b%use.uio.uninett@tor.nta.no
$ GoSub Convert_File
$ File_is="SHOWFILE.COM"
$ Check_Sum_is=338494353
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$ set symbol/scope=nolocal
X$!
X$ deassign sys$input
X$ form getfile filelib
X$ findfile=frm$filename
X$ file = f$search ("")
X$ set term/noecho
X$ on error then goto error
X$ on control_y then goto ctrl_y
X$loop:
X$ file = f$search (findfile)
X$ if file.eqs."" then goto nomore
X$ def$filename = file
X$ def$protection= f$file_attributes(file,"PRO")
X$ def$owner = f$file_attributes(file,"UIC")
X$ def$created = f$file_attributes(file,"CDT")
X$ def$modified = f$file_attributes(file,"RDT")
X$ def$backup = f$file_attributes(file,"BDT")
X$ def$size = f$file_attributes(file,"EOF")
X$ def$allocated = f$file_attributes(file,"ALQ")
X$ def$fileid = f$file_attributes(file,"DID")
X$ def$expires = f$file_attributes(file,"EDT")
X$ form/noinput/default showfile filelib
X$ goto loop
X$nomore:
X$ write sys$output "No more files found to match ''findfile'"
X$ goto stop
X$error:
X$ write sys$output "Error occurred."
X$ goto stop
X$ctrl_y:
X$ write sys$output "Aborted by CTRL/Y"
X$ goto stop
X$stop:
X$ set term/echo
X$ exit
$ GoSub Convert_File
$ File_is="SHOWFILE.FLG"
$ Check_Sum_is=2083217059
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X
X
X! FMS Form Description Application Aid
X! Version V2.2
X
XFORM NAME='SHOWFILE'
X AREA_TO_CLEAR=1:23
X WIDTH=CURRENT
X BACKGROUND=CURRENT
X ;
X
X
XTEXT (1,1) 'Filename:'
X ;
XTEXT (2,1) 'File ID:'
X ;
XTEXT (4,6) 'Size:'
X ;
XTEXT (4,18) 'blocks Created:'
X ;
XTEXT (5,1) 'Allocated:'
X ;
XTEXT (5,18) 'blocks Last modified:'
X ;
XTEXT (6,39) 'Backup taken:'
X ;
XTEXT (7,39) 'Expires:'
X ;
XTEXT (10,6) 'Owner:'
X ;
XTEXT (11,1) 'Protection:'
X ;
X
XATTRIBUTE_DEFAULTS FIELD
X CLEAR_CHARACTER=' '
X NOAUTOTAB BLANK_FILL NOBLINKING NOBOLD NOREVERSE
X NOUNDERLINE NODISPLAY_ONLY ECHO NOFIXED_DECIMAL
X LEFT_JUSTIFIED NOSUPERVISOR_ONLY NOSUPPRESS NOUPPERCASE
X ;
X
XFIELD NAME='FILENAME' (1,12)
X PICTURE=59'X'
X ;
XFIELD NAME='FILEID' (2,12)
X PICTURE=15'X'
X ;
XFIELD NAME='SIZE' (4,12)
X PICTURE=5'X'
X RIGHT_JUSTIFIED
X ;
XFIELD NAME='CREATED' (4,54)
X PICTURE=17'X'
X ;
XFIELD NAME='ALLOCATED' (5,12)
X PICTURE=5'X'
X RIGHT_JUSTIFIED
X ;
XFIELD NAME='MODIFIED' (5,54)
X PICTURE=17'X'
X ;
XFIELD NAME='BACKUP' (6,54)
X PICTURE=17'X'
X ;
XFIELD NAME='EXPIRES' (7,54)
X PICTURE=17'X'
X ;
XFIELD NAME='OWNER' (10,13)
X PICTURE=14'X'
X ;
XFIELD NAME='PROTECTION' (11,13)
X PICTURE=43'X'
X ;
X
XORDER BEGIN_WITH = 1
X NAME='FILENAME'
X NAME='FILEID'
X NAME='SIZE'
X NAME='CREATED'
X NAME='ALLOCATED'
X NAME='MODIFIED'
X NAME='BACKUP'
X NAME='EXPIRES'
X NAME='OWNER'
X NAME='PROTECTION'
X ;
X
X
XEND_OF_FORM NAME='SHOWFILE' ;
$ GoSub Convert_File