*scrsel: * proc (exdata,panname,pansect,msgid,araydim,varname,varlen,varval) * options(main,amode(31),rmode(any),reentrant,autodata(loc(below) * )); *@list off; *%include syslib(dclssys ); *@list on; * * /*****************************************************************/ * /* */ * /* Exit paremeters: Zverb, zscrolln, zscrolla, dynarea, */ * /* shadow,width,1stline */ * /* */ * /*****************************************************************/ * * dcl * varlen(7) fixed bin(31), /* Variable value lengths */ * varval char(*); /* String of values */ * dcl * zverb char(4) based(zverb_p), /* 1 Zverb */ * zscrolln char(*) based(zscrolln_p), /* 2 Zscrolln */ * zscrolla char(1) based(zscrolla_p), /* 3 Zscrolla */ * width char(*) based(width_p), /* 4 Width of dynamic area */ * prevtop char(4) based(prevtop_p), /* 5 Top line (Zero origin)*/ * dynarea char(*) based(dynarea_p), /* 6 Dynamic area variable */ * shadow char(*) based(shadow_p), /* 7 Shadow variable */ * zverb_p ptr(31), /* 1 Zverb */ * zscrolln_p ptr(31), /* 2 Zscrolln */ * zscrolla_p ptr(31), /* 3 Zscrolla */ * width_p ptr(31), /* 4 Width of dynamic area */ * prevtop_p ptr(31), /* 5 Top line (Zero origin) */ * dynarea_p ptr(31), /* 6 Dynamic area variable */ * shadow_p ptr(31), /* 7 Shadow variable */ * amount fixed, /* Scroll amount (In binary) */ * dynwidth fixed, /* Dynamic area width (In binary)*/ * top fixed, /* Top line (In binary) */ * packed char(8) boundary(dword); /* Work area */ * *! * * zverb_p = addr(varval); * zscrolln_p = zverb_p + varlen(1); * zscrolla_p = zscrolln_p + varlen(2); * width_p = zscrolla_p + varlen(3); * prevtop_p = width_p + varlen(4); * dynarea_p = prevtop_p + varlen(5); * shadow_p = dynarea_p + varlen(6); * *! * * if (varlen(1) = 2 & zverb(1:2) = 'UP') /* UP command ? */ * | (varlen(1) = 4 & zverb(1:4) = 'DOWN') then /* Or DOWN * command? */ * do; * pack(packed,zscrolln(1:varlen(2))); /* Convert zscrolln */ * cvb(amount,packed); /* Placing it in 'amount' */ * pack(packed,width(1:varlen(4))); /* Convert width to number */ * cvb(dynwidth,packed); /* Placing it in 'dynwidth' */ * pack(packed,prevtop(1:varlen(5))); /* Conv 1st displayed line*/ * cvb(top,packed); /* Placing it in 'top' */ * amount = amount * dynwidth; * if zverb(1) = 'U' then /* If command is 'UP' */ * if zscrolla = 'M' then /* If 'UP MAX' */ * top = 0; /* Go to the top */ * else /* Command not MAX */ * top = top - amount; /* Move UP amount ispf said */ * else * if zscrolla = 'M' then /* If 'DOWN MAX' */ * top = 9000; /* Move DOWN lots of lines */ * else /* Not 'DOWN MAX' */ * top = top + amount; /* Move DOWN amount ispf said */ * top = min(top,varlen(6)-dynwidth); /* MAX scroll DOWN */ * top = MAX(0,TOP); /* MAX scroll UP */ * ?spfmvcl in(dynarea(top+1)) /* Shift whole dynamic area and */ * outa(dynarea_p) /* Shadow area to do the actual */ * inl(varlen(6)-top) /* Scroll. (These variables */ * outl(varlen(6)); /* Hold the entire contents of */ * ?spfmvcl in(shadow(top+1)) /* The dynamic area on input, */ * outa(shadow_p) /* Not just what shows on the */ * inl(varlen(7)-top) /* Screen. */ * outl(varlen(7)); /* */ * ?spfctn(top,packed); /* UPDATE the top line variable. */ * prevtop(1:varlen(5)) = packed(9-varlen(5)::8); * end; * return code(0); /* Always return code zero */ * end scrsel; *---------------------------------------------------------------------* *-------------------- Assembler code starts below --------------------* *---------------------------------------------------------------------* TITLE ' scrsel:' SCRSEL CSECT , SCRSEL AMODE 31 SCRSEL RMODE ANY STM 14,12,12(13) LR 12,15 USING SCRSEL,12 LA 15,0 L 0,DSECT_SZ+4 GETMAIN RU,LV=(0),SP=(15), * LOC=BELOW LR 11,1 USING @DATD,11 ST 13,4(,11) ST 11,8(,13) LM 15,1,16(13) LR 13,11 MVC INPUTPTRS1(32),0(1) * *! * * zverb_p = addr(varval); L 4,INPUTPTRS1+28 * zscrolln_p = zverb_p + varlen(1); L 7,INPUTPTRS1+24 L 2,0(,7) LR 6,4 ALR 6,2 * zscrolla_p = zscrolln_p + varlen(2); LR 5,6 AL 5,4(,7) * width_p = zscrolla_p + varlen(3); LR 3,5 AL 3,8(,7) * prevtop_p = width_p + varlen(4); LR 10,3 AL 10,12(,7) * dynarea_p = prevtop_p + varlen(5); LR 9,10 AL 9,16(,7) * shadow_p = dynarea_p + varlen(6); * L 8,20(,7) LR 14,9 ALR 14,8 ST 14,SHADOW_P *! * * IF (varlen(1) = 2 & zverb(1:2) = 'UP') /* UP command ? */ * | (varlen(1) = 4 & zverb(1:4) = 'DOWN') THEN /* Or DOWN * command? */ LA 0,2 CR 2,0 BNE LABEL_1 CLC 0(2,4),=CL2'UP' BE LABEL_2 LABEL_1 LA 14,4 CR 2,14 BNE LABEL_9 CLC 0(4,4),=CL4'DOWN' BNE LABEL_9 LABEL_2 DS 0H * DO; * pack(packed,zscrolln(1:varlen(2))); /* Convert zscrolln */ L 15,4(,7) BCTR 15,0 N 15,=X'0000000F' EX 15,INSTRUCTION1 -> PACK PACKED(8),0(0,6) * cvb(amount,packed); /* Placing it in 'amount' */ CVB 2,PACKED * pack(packed,width(1:varlen(4))); /* Convert width to number */ L 6,12(,7) BCTR 6,0 N 6,=X'0000000F' EX 6,INSTRUCTION2 -> PACK PACKED(8),0(0,3) * cvb(dynwidth,packed); /* Placing it in 'dynwidth' */ CVB 3,PACKED * pack(packed,prevtop(1:varlen(5))); /* Conv 1st displayed line*/ L 6,16(,7) BCTR 6,0 N 6,=X'0000000F' EX 6,INSTRUCTION3 -> PACK PACKED(8),0(0,10) * cvb(top,packed); /* Placing it in 'top' */ CVB 6,PACKED * amount = amount * dynwidth; LR 15,2 MR 14,3 LR 2,15 * IF zverb(1) = 'U' THEN /* If command is 'UP' */ CLI 0(4),C'U' BNE LABEL_4 * IF zscrolla = 'M' THEN /* If 'UP MAX' */ CLI 0(5),C'M' BNE LABEL_3 * top = 0; /* Go to the top */ SLR 2,2 LR 6,2 * ELSE /* Command not MAX */ * top = top - amount; /* Move UP amount ispf said */ B LABEL_6 LABEL_3 SLR 6,2 * ELSE * IF zscrolla = 'M' THEN /* If 'DOWN MAX' */ SLR 2,2 B LABEL_6 LABEL_4 CLI 0(5),C'M' BNE LABEL_5 * top = 9000; /* Move DOWN lots of lines */ L 6,=F'9000' SLR 2,2 * ELSE /* Not 'DOWN MAX' */ * top = top + amount; /* Move DOWN amount ispf said */ B LABEL_6 LABEL_5 ALR 6,2 SLR 2,2 * top = min(top,varlen(6)-dynwidth); /* MAX scroll DOWN */ LABEL_6 LR 4,8 SLR 4,3 CR 6,4 BNH LABEL_7 LR 6,4 LABEL_7 DS 0H * top = MAX(0,TOP); /* MAX scroll UP */ * CR 6,2 BNL LABEL_8 LR 6,2 LABEL_8 DS 0H * /*************************************************************/ * /* */ * /* ?SPFMVCL IN(dynarea(top+1))OUTA(dynarea_p)INL(varlen(6)-to*/ * /* p)OUTL(varlen(6)) */ * /* */ * /*************************************************************/ * * DO; * RESPECIFY * (R0, * R1, * R14, * R15) RESTRICTED; * R0 = dynarea_p; LR 0,9 * R1 = varlen(6); LR 1,8 * R14 = ADDR(dynarea(top+1)); LA 14,0(6,9) * R15 = varlen(6) - top + '40000000'X; LR 15,8 SLR 15,6 AL 15,=X'40000000' * MVCL(R0,R14); MVCL 0,14 * RESPECIFY * (R0, * R1, * R14, * R15); * END; * * /*************************************************************/ * /* */ * /* ?SPFMVCL IN(shadow(top+1))OUTA(shadow_p)INL(varlen(7)-top)*/ * /* OUTL(varlen(7)) */ * /* */ * /*************************************************************/ * * DO; * RESPECIFY * (R0, * R1, * R14, * R15) RESTRICTED; * R0 = shadow_p; L 0,SHADOW_P * R1 = varlen(7); L 7,INPUTPTRS1+24 L 8,24(,7) LR 1,8 * R14 = ADDR(shadow(top+1)); L 14,SHADOW_P LA 14,0(6,14) * R15 = varlen(7) - top + '40000000'X; LR 15,8 SLR 15,6 AL 15,=X'40000000' * MVCL(R0,R14); MVCL 0,14 * RESPECIFY * (R0, * R1, * R14, * R15); * END; * * /*************************************************************/ * /* */ * /* ?SPFCTN (top,packed) */ * /* */ * /*************************************************************/ * * DO; * DECLARE * SPFCTNW CHAR(8) BOUNDARY(DWORD), * SPFCTNX CHAR(16); * CVD(top,SPFCTNW); CVD 6,SPFCTNW * UNPK(SPFCTNX,SPFCTNW); UNPK SPFCTNX(16),SPFCTNW(8) * GENERATE( OI SPFCTNX+15,X'F0'); OI SPFCTNX+15,X'F0' * packed = SPFCTNX(17-LENGTH(packed):16); MVC PACKED(8),SPFCTNX+8 * END; * prevtop(1:varlen(5)) = packed(9-varlen(5)::8); L 2,INPUTPTRS1+24 L 3,16(,2) LA 2,9 SLR 2,3 BCTR 3,0 LA 4,PACKED-1(2) EX 3,INSTRUCTION4 -> MVC 0(0,10),0(4) * END; * RETURN code(0); /* Always return code zero */ LABEL_9 LR 1,11 L 13,4(,13) LA 15,0 L 0,DSECT_SZ+4 FREEMAIN RU,LV=(0),A=(1),SP=(15) SLR 15,15 L 14,12(,13) LM 0,12,20(13) BR 14 * END scrsel; INSTRUCTION1 PACK PACKED(8),0(0,6) INSTRUCTION2 PACK PACKED(8),0(0,3) INSTRUCTION3 PACK PACKED(8),0(0,10) INSTRUCTION4 MVC 0(0,10),0(4) LTORG DSECT_SZ DS 0A DC AL1(0),AL3(((@ENDDATD-@DATD+7)/8)*8) DC A(((@ENDDATD-@DATD+7)/8)*8) @DATD DSECT SAVEAREA_1 DS 18F INPUTPTRS1 DS 8F SHADOW_P DS A DS CL4 PACKED DS CL8 SPFCTNW DS CL8 SPFCTNX DS CL16 ORG *+1-(*-@DATD)/(*-@DATD) @ENDDATD DS 0X END SCRSEL,(PL/X-370,0104,00165) Simple sample panel follows: )ATTR @ AREA(DYNAMIC) EXTEND(OFF) SCROLL(ON) # TYPE(CHAR) COLOR(YELLOW) )BODY % A Test select panel with a scrollable dynamic area+ +COMMAND ===>_ZCMD + + @D,S @ @ @ @ @ @ @ @ @ @ @ @ @ )INIT &DVAR='1. OPTION 01' &DVAR='&DVAR.2. OPTION 02' /* initialization of the */ &DVAR='&DVAR.3. OPTION 03' /* dynamic area and shadow */ &DVAR='&DVAR.4. OPTION 04' /* variable can be moved out of*/ &DVAR='&DVAR.5. OPTION 05' /* the panel logic (of course) */ &DVAR='&DVAR.6. OPTION 06' &DVAR='&DVAR.7. OPTION 07' &DVAR='&DVAR.8. OPTION 08' &DVAR='&DVAR.9. OPTION 09' &DVAR='&DVAR.10.OPTION 10' &DVAR='&DVAR.11.OPTION 11' &SVAR='# X' &SVAR='&SVAR.# X' &SVAR='&SVAR.# X' &SVAR='&SVAR.# X' &SVAR='&SVAR.# X' &SVAR='&SVAR.# X' &SVAR='&SVAR.# X' &SVAR='&SVAR.# X' &SVAR='&SVAR.# X' &SVAR='&SVAR.## X' &SVAR='&SVAR.## X' IF (&PREVTOP = &Z) &PREVTOP = '0000' &D=&DVAR &S=&SVAR )PROC VGET (ZSCROLLN,ZSCROLLA,ZVERB) /* get scrolling indicators */ &D=&DVAR /* Copy of dynamic area which will be used for display */ &S=&SVAR /* copy of shadow area which will be used for display */ &DWIDTH = '12' /* Width if the dynamic area */ PANEXIT ((ZVERB,ZSCROLLN,ZSCROLLA,DWIDTH,PREVTOP,D,S),LOAD,SCRSEL) &ZSEL = TRANS(&ZCMD 'X',EXIT ' ',' ' *,'?') )END