SUBROUTINE WW.REGEN.HTML
******************************************************************
* Description of subroutine
* Used for documentation purposes (including auto documentation)
******************************************************************
*
$INCLUDE DMSKELCODE COMMON
$INCLUDE DMSKELCODE STANDARD.EQU
$INCLUDE WWINSERT WW.RAPI.H
*
EQU STARTATT TO 10
PNAME = ''
CALL SB.INPUT(0,0,20,0,'Process Name','',PNAME,ESC)
IF ESC THEN RETURN
*
OPEN '','WWCONTROL' TO F.WWCONTROL ELSE
CALL SB.DISP(3,'CANNOT OPEN WWCONTROL')
RETURN
END
READ CONVREC FROM F.WWCONTROL,'SBCONV' ELSE
CALL SB.DISP(3,'CANNOT READ SBCONV FROM WWCONTROL')
RETURN
END
* CONVREC - att1 - label foreground
* att2 - data foreground
* att3 - text for accept button
* att4 - text for reset button
* att5 - header id - forms
* att6 - footer id - forms
* att7 - page id - forms
* change ; to VM for colors
FOR Z = 1 TO 2
IF CONVREC > '' THEN
VAL = CONVREC
CALL SB.REPLACE(';', SVM, VAL)
CONVREC = VAL
END
NEXT Z
IF CONVREC<3> > '' THEN ACCEPTTXT = CONVREC<3> ELSE ACCEPTTXT = "Accept"
IF CONVREC<4> > '' THEN RESETTXT = CONVREC<4> ELSE RESETTXT = "Reset"
*
READ PREC FROM F.PROC,PNAME ELSE
CALL SB.DISP(3,'COULD NOT FIND PROCESS ':PNAME)
RETURN
END
IF PREC<1> = "I" OR PREC<1> = "O" ELSE
CALL SB.DISP(3,'THIS IS NOT AN INPUT OR OUTPUT PROCESS')
RETURN
END
* check name for illegal characters
CALL WW.REGEN.RENAME(PNAME)
VAL = ''
CALL WW.RAPI(RAPI.READ.OBJ, SYSID, PNAME, VAL, ERR)
IF NOT(ERR) THEN
IF VAL<1> = 'wwinputformclass' THEN
OK = 'N'
CALL SB.INPUT(0,0,1,0,'Overwrite existing definition?','',OK,ESC)
IF OK = 'N' THEN RETURN
END ELSE
CALL SB.DISP(3,'OBJECT ':PNAME:' EXISTS AS TYPE ':VAL<1>)
RETURN
END
END ELSE ERR = 0
DICTNAME = PREC<5,1> ; SCRNAME = PREC<6> ; DATANAME = PREC<5,2>
IF DATANAME = '' THEN DATANAME = DICTNAME
CALL WW.REGEN.RENAME(DATANAME)
OPEN 'DICT',DICTNAME TO F.SCRDICT ELSE
CALL SB.DISP(3,'CANNOT OPEN DICT ':DICTNAME)
RETURN
END
READ GUIREC FROM F.SCRDICT,SCRNAME:'.GUI' ELSE
CALL SB.DISP(3,'CANNOT READ GUI SCREEN ':SCRNAME:'.GUI')
RETURN
END
READ SCRREC FROM F.SCRDICT,SCRNAME ELSE
CALL SB.DISP(3,'CANNOT READ SCREEN DEFN ITEM ':SCRNAME)
RETURN
END
*
OBJDEFN = '' ; * used to store the new definition record
CHILDLIST = '' ; * used to store children refs for main parent
*
GOSUB 1500 ; * parse thru fields and look for mv cont/dep stuff
*
* make sure we have a datasource for this file
GOSUB 1000
*
* each object has 4 attr as its definition - starting from line 11
LOCATE('coordinates', GUIREC, 1 ;COORDPOS) ELSE
CALL SB.DISP(3,'CANNOT FIND COORDINATES')
RETURN
END
LOCATE('dimensions', GUIREC ,1 ;DIMENSPOS) ELSE
CALL SB.DISP(3,'CANNOT FIND DIMENSIONS')
RETURN
END
LOCATE('string', GUIREC ,1 ;STRINGPOS) ELSE
CALL SB.DISP(3,'CANNOT FIND STRING')
RETURN
END
NO.OBJS = DCOUNT(GUIREC,AM) ; MVPARENT = 0
FOR ATTNO = 11 TO NO.OBJS STEP 4
POS = GUIREC
CLASSNAME = GUIREC
OBJNAME = GUIREC
ATT1 = '' ; ATT2 = '' ; ATT3 = '' ; ATT4 = ''
* all objects should have coords and dimens - get these now
LOCATE(COORDPOS, GUIREC, 1; CPOS) THEN
COORDVAL = GUIREC
ATT3<1,-1> = 'coordinates'
ATT4<1,-1> = COORDVAL
END
LOCATE(DIMENSPOS, GUIREC, ATTNO+2; DPOS) THEN
DIMENSVAL = GUIREC
ATT3<1,-1> = 'dimensions'
ATT4<1,-1> = DIMENSVAL
END
CODE = 1 ; MVFLD = 0
*** temp fix for mv fields - they must all be textclasses!
LOCATE(OBJNAME,SCRREC,15;POS) THEN
IF SCRREC<23,POS> = 'C' OR SCRREC<23,POS> = 'D' THEN CLASSNAME = "textclass"
END
BEGIN CASE
CASE CLASSNAME = 'formclass'
GOSUB 100
CASE CLASSNAME = 'labelclass'
GOSUB 200
CASE CLASSNAME = 'textclass'
GOSUB 300
CASE CLASSNAME = 'sbcomboboxclass'
GOSUB 400
CASE CLASSNAME = 'sbtoggleclass'
GOSUB 500
CASE 1
CODE = 0
END CASE
IF CODE THEN
IF ATT1 # 'wwinputformclass' THEN
CHILDLIST<1,1,-1> = DCOUNT(OBJDEFN,AM) + 1
END
IF MVPARENT AND MVFLD THEN
IF DEPFLD > 1 THEN
ATT2<1,1> = MVPARENT
OBJDEFN = DCOUNT(OBJDEFN,AM) + 1
END ELSE ATT1<2,2,1> = DCOUNT(OBJDEFN,AM) + 5
END
OBJDEFN<-1> = ATT1:AM:ATT2:AM:ATT3:AM:ATT4
END
NEXT ATTNO
* now add buttons
ATTS = 'coordinates':VM:'dimensions':VM:'value':VM:'callbacks'
VALS = 15:SVM:DIMENS<1,1,2>-30:VM:50:SVM:25:VM:ACCEPTTXT:VM:'onClick~hCb~appobj.WriteData()'
ATT1 = 'wwpbclass'
ATT2 = 1:VM:VM:'acceptpb'
ATT3 = ATTS
ATT4 = VALS
CHILDLIST<1,1,-1> = DCOUNT(OBJDEFN,AM) + 1
OBJDEFN<-1> = ATT1:AM:ATT2:AM:ATT3:AM:ATT4
VALS = 90:SVM:DIMENS<1,1,2>-30:VM:50:SVM:25:VM:RESETTXT:VM:'onClick~hCb~appobj.Clear()'
ATT1 = 'wwpbclass'
ATT2 = 1:VM:VM:'resetpb'
ATT3 = ATTS
ATT4 = VALS
CHILDLIST<1,1,-1> = DCOUNT(OBJDEFN,AM) + 1
OBJDEFN<-1> = ATT1:AM:ATT2:AM:ATT3:AM:ATT4
OBJDEFN<2,2> = CHILDLIST
CALL WW.RAPI(RAPI.WRITE.OBJ, SYSID, PNAME, OBJDEFN, ERR)
RETURN
*
*
100 * formclass
ATT1 = 'wwinputformclass'
ATT2 = 0:VM:VM:PNAME
ATT3<1,-1> = 'data_source':VM:'back_button':VM:'home_button'
ATT4<1,-1> = DATANAME:VM:'top':VM:'top'
* look for background colour
LOCATE('background', GUIREC, 1;BPOS) THEN
LOCATE(BPOS, GUIREC, 1; BPOS) THEN
ATT3<1,-1> = 'bgcolor'
ATT4<1,-1> = GUIREC
END
END
LOCATE('dimensions', ATT3, 1;POS) THEN
DIMENS = ATT4<1,POS>
END ELSE DIMENS = 400:SVM:400
IF PREC<2> > '' THEN
ATT3<1,-1> = "title"
ATT4<1,-1> = PREC<2>
END
IF CONVREC<5> > '' THEN
ATT3<1,-1> = "header_id"
ATT4<1,-1> = CONVREC<5>
END
IF CONVREC<6> > '' THEN
ATT3<1,-1> = "footer_id"
ATT4<1,-1> = CONVREC<6>
END
IF CONVREC<7> > '' THEN
ATT3<1,-1> = "page_id"
ATT4<1,-1> = CONVREC<7>
END
RETURN
*
200 * labelclass or dataclass
READV CHK FROM F.SCRDICT,OBJNAME,1 THEN
ATT1 = "wwdataclass"
STRVAL = ""
TYPE = "DATA"
END ELSE
ATT1 = 'wwlabelclass'
TYPE = "LABEL"
END
ATT2 = 1:VM:VM:OBJNAME
* for now justification is left
ATT3<1,-1> = 'align':VM:'value'
STRVAL = ''
LOCATE('string', GUIREC, 1; SPOS) THEN
LOCATE(SPOS, GUIREC, 1; SPOS) THEN
STRVAL = GUIREC
END
END
ATT4<1,-1> = 'left':VM:STRVAL
IF TYPE = "LABEL" AND CONVREC<1> > "" THEN
ATT3<1,-1> = "foreground" ; ATT4<1,-1> = CONVREC<1>
END
IF TYPE = "DATA" AND CONVREC<2> > "" THEN
ATT3<1,-1> = "foreground" ; ATT4<1,-1> = CONVREC<2>
END
RETURN
*
300 * textclass
ATT1 = 'wwtextclass'
* check if this is a mv field
* if it is then we need to see if it has dependants
* this will determine whether it remains a textclass or if we
* need a mvclass to act as the container to the textclass(es)
ATT1 = 'wwtextclass'
ATT2 = 1:VM:VM:OBJNAME
IF NOT(MVPARENT) THEN
FOR ZZ = 1 TO NO.SET ; * set in gosub 1500
IF OBJNAME = MVSET THEN
CONTRL = ZZ
MVFLD = 1 ; DEPFLD = 1
IF MVSET > '' THEN ; * dependant(s) !
LOCATE(OBJNAME, SCRREC, 15;POS) THEN WINSIZE = FIELD(SCRREC<24,POS> + 1,'.',1) ELSE WINSIZE = 4
MVATT = "wwmvclass"
MVATT<-1> = 1
MVATT<-1> = "coordinates":VM:"border_width":VM:"col_widths":VM:"window_size":VM:"num_cols"
MVATT<-1> = COORDVAL :VM:3 :VM:ATT4<1,2,1>:VM:WINSIZE :VM:1
ATT1 = MVATT:AM:ATT1
MVPARENT = DCOUNT(OBJDEFN,AM) + 1
ATT2<1,1> = MVPARENT
ATT4<1,1> = 4:SVM:30
ATT4<1,2,2> = 20
END ELSE
ATT1 = "wwtextareaclass"
END
ZZ = NO.SET
END
NEXT ZZ
END ELSE ; * check if this is a depending field
LOCATE(OBJNAME, MVSET, CONTRL;POS) THEN
MVFLD = 1 ; DEPFLD = DEPFLD + 1
OBJDEFN = DEPFLD
ATT4<1,1> = 7 + (100 * DEPFLD) - 100 : SVM : 30
OBJDEFN = ATT4<1,2,1> ; * set width
* position is based upon previous fields position
PREVPOS = OBJDEFN
PREVCOL = OBJDEFN
PREVWID = OBJDEFN
* now set this coord col
ATT4<1,1,1> = PREVCOL + PREVWID + 4
* also set dimensions - sb gui uses real depth - here we repeat field
ATT4<1,2,2> = 20
END
END
* need size from dict and also check if this is key field
READ DICTREC FROM F.SCRDICT, OBJNAME ELSE RETURN
SIZE = DICTREC<5>[1,LEN(DICTREC<5>)-1]
IF DICTREC<1> = "D" AND DICTREC<2> = 0 THEN
ATTS = "callbacks"
VALS = "onChange~hCb~appobj.ReadData()"
END ELSE
ATTS = "" ; VALS = ""
END
* validations required?
READ DICTREC FROM F.SCRDICT, '.':OBJNAME ELSE DICTREC = '' ; * should never happen!
* check for date
IF DICTREC<11> = 2 THEN
ATTS<1,-1> = 'validation'
VALS<1,-1> = 'date'
END
* check for numerics
IF DICTREC<11> = 1 OR DICTREC<11> = 3 THEN
ATTS<1,-1> = 'validation'
VALS<1,-1> = 'numeric'
END
* now check for other validations
VALIDCODE = DICTREC<6>
* if combination of errors then not support at this stage
IF INDEX(VALIDCODE, 'AND', 1) OR INDEX(VALIDCODE, 'OR', 1) THEN
COMBINATION = 1
END ELSE COMBINATION = 0
VALIDTYPE = VALIDCODE[1,2]
VALIDCODE = VALIDCODE[3,999]
BEGIN CASE
CASE COMBINATION
VALIDATION = ""
CASE VALIDTYPE = "L:"
VALIDATION = 'length ':VALIDCODE
CASE VALIDTYPE = "R:"
CALL SB.REPLACE(' TO ', '-', VALIDCODE)
VALIDATION = 'range ':VALIDCODE
CASE VALIDTYPE = 'I:'
VALIDATION = 'integer'
CASE VALIDTYPE = 'S:'
VALIDATION = 'nospaces'
CASE VALIDTYPE = 'M:'
VALIDATION = 'mandatory'
CASE VALIDTYPE = 'P:'
VALIDATION = 'pattern ':VALIDCODE
CASE 1
VALIDATION = ''
END CASE
IF VALIDATION > '' THEN
ATTS<1,-1> = 'validation'
VALS<1,-1> = VALIDATION
END
ATT3<1,-1> = 'size':VM:ATTS
ATT4<1,-1> = SIZE:VM:VALS
RETURN
*
400 * comboclass
ATT1 = 'wwcomboclass'
ATT2 = 1:VM:VM:OBJNAME
ATT3<1,-1> = 'item_set':VM:'scroll':VM:'true_vals'
* first get table name or list of values from dict
READ DICTREC FROM F.SCRDICT,'.':OBJNAME ELSE RETURN
IF DICTREC<6>[1,2] = 'V:' THEN ; * we have a list of valid values
VALLIST = DICTREC<6>[3,999]
CALL SB.REPLACE(',',';',VALLIST)
TRUEVALS = VALLIST
END ELSE
* must be a table
TABLEID = DICTREC<7>[9,9999]
TABLEID = FIELD(TABLEID, "'", 1)
READ TABLEREC FROM F.DEFN, TABLEID THEN
VALLIST = TABLEREC<4>
CALL SB.REPLACE(VM, ';', VALLIST)
TRUEVALS = TABLEREC<3>
IF TRUEVALS = "" THEN
TRUEVALS = VALLIST
END ELSE CALL SB.REPLACE(VM, ';', TRUEVALS)
END
END
ATT4<1,-1> = VALLIST:VM:1:VM:TRUEVALS
RETURN
500 * toggleclass
ATT1 = 'wwcheckclass'
ATT2 = 1:VM:VM:OBJNAME
ATT3<1,-1> = 'checked':VM:'value'
* first get list of values from dict
READ DICTREC FROM F.SCRDICT,'.':OBJNAME ELSE RETURN
IF DICTREC<6>[1,2] = 'V:' THEN ; * we have a list of valid values
VALLIST = DICTREC<6>[3,999]
CALL SB.REPLACE(',',';',VALLIST)
END ELSE
RETURN
END
ATT4<1,-1> = 0:VM:'on'
RETURN
1000 * build datasource if required
CALL WW.RAPI(RAPI.READ.OBJ, SYSID, DATANAME, VAL, ERR)
IF VAL > '' THEN RETURN ; * already exist
REC = 'wwdatasourceclass'
REC<1> = 0:VM:VM:DATANAME
REC<2> = 'external_name':VM:'field_format'
REC<3> = DICTNAME:VM:'UDT'
CALL WW.RAPI(RAPI.WRITE.OBJ, SYSID, DATANAME, REC, ERR)
RETURN
*
1500 * check for mv fields
NO.FLDS = DCOUNT(SCRREC<15>,VM)
MVSET = '' ; CONTRL = 0
FOR Z = 1 TO NO.FLDS
BEGIN CASE
CASE SCRREC<23,Z> = 'D' AND CONTRL
MVSET = SCRREC<15,Z>
CASE SCRREC<23,Z> = 'C'
CONTRL = CONTRL + 1
MVSET = SCRREC<15,Z>
CASE 1
NULL
END CASE
NEXT Z
NO.SET = DCOUNT(MVSET,AM) ; * used when checking feilds
RETURN
END