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