Voting
Category
real language
Bookmarking
Language RPG IV Free-Form
(Using the Dynamic Screen API's)
| Date: | 01/10/06 |
| Author: | James Wall |
| URL: | n/a |
| Comments: | 0 |
| Info: | http://publib.boulder.ibm.com/infocenter/iseries/v5r3/index.jsp |
| Score: |  (2.77 in 13 votes) |
********************************************************************
** 99 Bottles of Beer on the Wall *
* Example Code courtesy of ...
* http://www.iseriesnetwork.com/Resources/ClubTech/TNT400/bo400ng/as400scmapi.htm
********************************************************************
H dftactgrp(*no)
H actgrp(*caller)
D DS
D idx 2 0 inz(99)
D idxAlpha 2A overlay(idx:1)
D F3 c x'33'
D sa_norm c x'20'
D sa_highlight c x'22'
D BeerLine1 s 30 inz(' Bottles of beer on the wall, ')
D BeerLine2 s 17 inz(' Bottles of beer ')
D BeerLine3 s 32 inz('Take one down and pass it +
D around')
D ExitStr s 43 inz('Press Enter to Continue or +
D Press F3 to Exit')
D txt s 128
D txtlen s 9b 0 inz(132)
D err s 8 inz(x'0000000000000000'
D aid s 1
D lines s 9b 0 inz(1)
D wf1 s 1
D wrtn s 9b 0
D ClrScr PR 9b 0 extproc('QsnClrScr')
D mode 1 options(*nopass) const
D cmdbuf 9b 0 options(*nopass) const
D env 9b 0 options(*nopass) const
D error 8 options(*nopass)
D WrtDta PR 9b 0 extproc('QsnWrtDta')
D data 128
D datalen 9b 0
D fldid 9b 0 options(*nopass) const
D row 9b 0 options(*nopass) const
D col 9b 0 options(*nopass) const
D strmatr 1 options(*nopass) const
D endmatr 1 options(*nopass) const
D strcatr 1 options(*nopass) const
D endcatr 1 options(*nopass) const
D cmdbuf 9b 0 options(*nopass) const
D env 9b 0 options(*nopass) const
D error 8 options(*nopass)
D GetAID PR 1 extproc('QsnGetAID')
D aid 1 options(*nopass)
D env 9b 0 options(*nopass) const
D error 8 options(*nopass)
D RollUp PR 9b 0 extproc('QsnRollUp')
D lines 9b 0 const
D top 9b 0 const
D bottom 9b 0 const
D cmdbuf 9b 0 options(*nopass) const
D env 9b 0 options(*nopass) const
D error 8 options(*nopass)
**************************************************************************************
* Mainline
**************************************************************************************
/FREE
wrtn = ClrScr('4' : 0 : 0 : err);
txt = ExitStr;
txtlen = %Len(txt);
wrtn = WrtDta (txt : txtlen : 0 : 1 : 2 :
sa_norm : sa_norm : sa_highlight : sa_highlight :
0 : 0 : err);
for idx = 99 Downto 1;
txt = idxAlpha + BeerLine1 + idxAlpha + BeerLine2 + BeerLine3;
txtlen = %Len(txt);
wrtn = WrtDta (txt : txtlen : 0 : 26 : 2 :
sa_norm : sa_norm : sa_norm : sa_norm :
0 : 0 : err);
wf1 = GetAID (aid : 0 : err);
If aid = F3;
Leave;
EndIf;
wrtn = RollUp (lines : 2 : 27 : 0 : 0: err);
endfor;
*INLR = *ON;
/END-FREE
Download Source | Write Comment
Download Source | Write Comment
Add Comment
Please provide a value for the fields Name,
Comment and Security Code.
This is a gravatar-friendly website.
E-mail addresses will never be shown.
Enter your e-mail address to use your gravatar.
Please don't post large portions of code here! Use the form to submit new examples or updates instead!
Comments