From:	CSBVAX::MRGATE!@SRI.Com:x_larsen_b%use.uio.uninett@NTA-VAX.ARPA@SMTP  2-AUG-1987 15:10
To:	EVERHART
Subj:	Forms entry from DCL using FMS. Part 2/2

Received: from tor.nta.no by KL.SRI.COM with TCP; Fri 31 Jul 87 10:35:37-PDT
Date: Fri, 31 Jul 87 16:54:42 +0200
Posted-Date: Fri, 31 Jul 87 16:54:42 +0200
Received: by tor.nta.no (5.51/3.21)
	id AA00610; Fri, 31 Jul 87 16:54:42 +0200
From: Bj|rn Larsen <x_larsen_b%use.uio.uninett@NTA-VAX.ARPA>
To: <info-vax@sri-kl.arpa>
Message-Id: <316:x_larsen_b@use.uio.uninett>
Subject: Forms entry from DCL using FMS. Part 2/2

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
