[comp.os.vms] Forms entry from DCL using FMS. Part 1/2

x_larsen_b%use.uio.uninett@TOR.NTA.NO (Bj|rn Larsen) (08/04/87)

Since there have been some discussion of FMS lately, I thought
there might be some interest for this program.

With FORM.EXE you can use FMS forms from DCL command routines,
passing field values to and from the command routine in symbols.

This posting has been packed with an old version of VMS_SHAR.

If you name the two files FORM.COM01 and FORM.COM02,
you will have to catenate them with the command

  $ copy form.com01,form.com02 form.com

and then execute form.com.

Read the READ.ME-file that is created as a result.

There are some hints om usage in the top of FORM.MAR.
In addition there is an example routine, SHOWFILE.COM

Warning:

Although I have been programming in MACRO-10 for several years, this
is my first program in MACRO-32. It works for me. It might work for you..



Bjorn Larsen		x_larsen_b%use.uio.uninett@tor.nta.no

......................... Cut between dotted lines and save ...................
$!.............................................................................
$!
$! VAX/VMS archive file created by VMS_SHAR Version:'09-Jun-1987'
$! Copyright (c) 1987, by Michael Bednarek
$! To unpack, simply execute (@) the file.
$! This archive was created by X_LARSEN_B
$!      on Friday 31-JUL-1987 16:40:55.81
$! It contains the following file(s):
$! BUILD.COM FORM.CLD FORM.MAR FRMLIB.MAR GETFILE.FLG READ.ME SHOWFILE.COM
$! SHOWFILE.FLG
$!==============================================================================
$! ATTENTION: To keep each article below 15872 bytes, this program
$!            has been transmitted in several parts.
$! You should concatenate ALL parts to ONE file and execute (@) that file.
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1:Open/Write Out 'File_is
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record: Read/End_Of_File=EOF In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record
$EOF: Close Out
$ Close In
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2:Return
$Start:
$ File_is="BUILD.COM"
$ Check_Sum_is=2083741540
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$!
X$! This command procedure builds FORM.EXE
X$!
X$ libr/mac/cre frmlib frmlib
X$ macro/nolist form
X$ link form
X$!
X$! create forms for example routine
X$!
X$ fms/translate showfile.flg
X$ fms/translate getfile.flg
X$ fms/libr/cre filelib showfile
X$ fms/libr filelib getfile
X$!
X$! Done.
X$!
$ GoSub Convert_File
$ File_is="FORM.CLD"
$ Check_Sum_is=2014992242
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X        define verb form
X        image sys$disk:[]form.exe
X
X        parameter p1, label=frmnam, prompt="Form"
X          value(required)
X        parameter p2, label=libnam, prompt="Library"
X          value(required,type=$infile)
X
X        qualifier DEFAULT
X        qualifier INPUT
$ GoSub Convert_File
$ File_is="FORM.MAR"
$ Check_Sum_is=1985033573
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X        .title form Display FMS form, and return input in symbols.
X
X;
X;       Copyright (c) 1987 Bj|rn Larsen
X;
X;       This program may be distributed freely, as long as the
X;       above copyright notice remains intact.
X;
X;       If you make useful modifications to this program, please
X;       let me know about it.
X;
X;       Bj|rn Larsen            x_larsen_b%use.uio.uninett@tor.nta.no
X;
X;         ^
X;         !
X;       Yes, that IS a letter. At least in Norway. And so is {}[\].
X;
X
X;
X;       Usage:
X;
X;       $ FORM[/qualifiers] FORMNAME LIBRARYNAME
X;
X;       where FORMNAME is the name of a FMS form in the FMS library
X;       LIBRARYNAME.
X;
X;       Input will be stored in symbols named FRM$<fieldname>.
X;
X;       If you specify /DEFAULT, then for each field the program will
X;       search for a symbol named DEF$<fieldname>. If the symbol exists,
X;       FORM will fill in the form with these default values before
X;       letting the user complete the form.
X;
X;       If you specify /NOINPUT, FORM will not let the user input any data
X;       in the form, but just view it. The program exits as soon as
X;       the user presses RETURN.
X;
X
X;
X;       Uses:
X;       This program is meant to be used from within DCL command
X;       procedures that wishes to present/input data using FMS.
X;
X;       The overhead of starting the program, opening the forms library
X;       and retrieving the correct form is considerable. If you plan to
X;       design a data-entry environment I recommend that you program
X;       it in a traditional language instead of in DCL.
X;
X;       For simple command procedures, the performance is reasonable.
X;
X
X        .subtitle Macros and symbols.
X
X        .library        /frmlib/
X
X        FDV$K_FT_NTR=0                  ; snatched from FDVDEF.MAR
X
X
X        .subtitle Main program.
X        .psect  data,   noexe, wrt
X
X;
X; Character strings used to retrieve information from the CLI.
X;
X
Xfrm$str:.ascid  /FRMNAM/        ; Form name label.
Xlib$str:.ascid  /LIBNAM/        ; Library name label.
Xin$str: .ascid  /INPUT/         ; /INPUT qualifier label.
Xdef$str:.ascid  /DEFAULT/       ; /DEFAULT qualifier label.
X
X;
X; Storage for form and library name.
X;
Xnamlen=255
X
X$descr_s frm$nam,fname,namlen
Xfname:  .blkb   namlen
X
X$descr_s lib$nam,lname,namlen
Xlname:  .blkb   namlen
X
X;
X; Flags for qualifiers.
X;
X
Xinput:  .byte   1       ; Default is /INPUT.
Xdefault:
X        .byte   0       ; Default is /NODEFAULT.
X
X$descr_d usrinp,usrbuf,namlen
Xusrbuf: .blkb   namlen
X
X
X        .psect  code,   exe, nowrt
X
Xretmsg: .ascid  /Press RETURN to continue/
X
X
Xform:   .word
X;
X; Check for presence of qualifiers.
X;
X        pushal  in$str                  ; Pass pointer to "INPUT".
X        calls   #1,g^cli$present        ; Is /INPUT present?
X        cmpl    #cli$_negated,r0        ; And is it negated?
X        bneq    10$                     ; If so,
X        clrl    input                   ;  indicate that.
X10$:    pushal  def$str                 ; Pass pointer to "DEFAULT".
X        calls   #1,g^cli$present        ; If /DEFAULT present?
X        cmpl    #cli$_present,r0        ;
X        bneq    20$                     ; If so,
X        incl    default                 ;  indicate that.
X20$:
X;
X; Retrieve form and library names.
X;
X        pushal  frm$nam
X        pushal  frm$str
X        calls   #2,g^cli$get_value      ; Get form name.
X        cmpl    #ss$_normal,r0          ; OK return value?
X        beql    30$                     ; Give up if anything wrong.
X        jmp     abort
X30$:    pushal  lib$nam
X        pushal  lib$str
X        calls   #2,g^cli$get_value      ; Get library name
X        cmpl    #ss$_normal,r0
X        beql    40$
X        jmp     abort
X40$:
X;
X; Ready to go.
X;
X        jsb     fmsini                  ; Initialize FMS.
X        $fdv$lopen filspc=lib$nam,channel=#1 ; Open the library.
X        jsb     fmschk
X        $fdv$spada mode=#1
X        $fdv$ssigq sigmd=#0
X        jsb     fmschk
X        $fdv$load frmnam=frm$nam        ; Load the form.
X        $fdv$disp frmnam=frm$nam        ; Display it.
X        tstb    default                 ; Should we default values?
X        beql    50$
X        jsb     dodef                   ; Yes.
X50$:    tstb    input                   ; Should we input anything?
X        beql    60$                     ; No.
X        jsb     getinp                  ; Get user input.
X        jmp     quit
X
X60$:    $fdv$putl val=retmsg            ; Ask for a RETURN.
X        $lib$get_input get_str=usrinp   ; Get it.
X; Fall thru to quit.
X
Xquit:   jsb     fmsrdn                  ; Rundown FMS.
X        movzbl  #1, r0
X        ret
X
X
X        .subtitle FMS initialization & rundown.
X
X        .psect  data
X
Xterm:   .ascid  /SYS$INPUT/     ; Terminal name.
X
Xtca:    .blkl   3               ; Terminal Control Area.
X        tcalen=.-tca
Xcwk:    .blkl   3               ; Check Workspace.
X        cwklen=.-cwk
Xwks:    .blkl   3               ; Workspace.
X        wkslen=.-wks
X
X$descr_a tcadsc, tca, 4, tcalen ; Descriptor for TCA.
X$descr_a cwkdsc, cwk, 4, cwklen ; Descriptor for Check Workspace.
X$descr_a wksdsc, wks, 4, wkslen ; Descriptor for Workspace.
X
X        .psect  code
X
X;
X; Assign terminal and allocate workspaces.
X;
Xfmsini: $fdv$aterm tca=tcadsc,size=#12,channel=#2,terminal=term,noclear=#1
X        jsb     fmschk
X        $fdv$awksp wksp=cwkdsc,size=#2000
X        jsb     fmschk
X        $fdv$awksp wksp=wksdsc,size=#2000
X        jsb     fmschk
X        rsb
X
Xfmsrdn: $fdv$lclos
X        $fdv$spada mode=#0
X        $fdv$dwksp wksp=wksdsc
X        $fdv$dwksp wksp=cwkdsc
X        $fdv$dterm tca=tcadsc
X        rsb     
X
X        .subtitle Input from form.
X
X        .psect  data
X
Xfip:    .blkb   132
X        fiplen=.-fip
X
X$descr_s fipdsc, fip, fiplen
X
Xasterix:.ascid  /*/
X
Xtermin: .long   0
X
Xsympfx: .ascii  /FRM$/          ; Returned symbol prefix.
X        .psect  code
X
Xgetinp: movl    sympfx, symnam
X        $fdv$get fldval=fipdsc,fldtrm=termin,fldnam=asterix
X        $fdv$retfn fldnam=flddsc,fldidx=fldidx
X10$:    $fdv$retle fldlen=fipdsc+dsc$w_length,fldnam=flddsc,fldidx=fldidx
X        $lib$set_symbol symdsc,fipdsc
X        $fdv$pft termin
X        cmpl    #fdv$k_ft_ntr,termin    ; Finished?
X        beql    20$
X        $fdv$getaf fipdsc,termin,flddsc,fldidx
X        jmp     10$
X
X20$:    rsb
X
X
X        .subtitle Default symbol handling.
X
X        .psect  data
X
X;
X; Most of this data is also used by GETINP.
X;
X
Xfldidx: .long   0
Xsymnam: .ascii  /DEF$/
Xfldnam: .blkb   namlen
X        fldlen=.-fldnam
X        symlen=.-symnam
X
X$descr_s flddsc, fldnam, fldlen
X$descr_s symdsc, symnam, symlen
X
Xsymval: .blkb   namlen
X
X$descr_s svadsc, symval, namlen
X
Xindex:  .long   0
X
X        .psect code
X
Xdodef:  incl    index
X        $fdv$retfo index,flddsc,fldidx
X        cmpl    #fdv$_suc, r0           ; Ok?
X        bneq    10$                     ; No, there are no more names.
X        $lib$get_symbol symdsc,svadsc
X        cmpl    #ss$_normal, r0
X        bneq    dodef                   ; (if defined)
X        $fdv$put svadsc,flddsc
X        jmp     dodef                   ; Go for next.
X;
X; Here on no more names.
X;
X10$:    rsb
X                        
X        
X        .subtitle Error handling routines.
X
X;
X; ABORT: - abort with last error code returned.
X;
Xabort:  pushl   r0
X        calls   #1,g^lib$stop           ; Stop with previous error.
X
X
X;
X; FMSCHK: - abort if fdv returned error code.
X;
Xfmschk: cmpl    #fdv$_suc,r0
X        bneq    abort
X        rsb
X
X
X        .end    form    
$ GoSub Convert_File