Voting

Category

real language

Bookmarking

Del.icio.us Digg Diigo DZone Earthlink Google Kick.ie
Windows Live LookLater Ma.gnolia Reddit Rojo StumbleUpon Technorati

Language RPG IV Free-Form

(Using the Dynamic Screen API's)

Date:01/10/06
Author:James Wall
URL:n/a
Comments:3
Info:http://publib.boulder.ibm.com/infocenter/iseries/v5r3/index.jsp
Score: (2.96 in 23 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

Alternative Versions

Comments

>>  drewd said on 12/16/08 04:20:02

drewd Ridiculous. Try this:

d i s 3 0 inz(99)
c/free
dow i > 0;
dsply %editc(i:'Z')+' bottles of beer on the wall';
dsply %editc(i:'Z')+' bottles of beer';
dsply 'take one down, pass it around';
i--;
enddo;
return;


Virtually all of the other version is caught up with using non-standard i/o.
Alternately, the program could write a screen display, compile it, and use it to display the song as a subfile.

>>  Obelix-it said on 04/14/09 10:24:48

Obelix-it Pardon me, but... where's the last row?? i mean, i missed the

"Take one down and pass it around, no more bottles of beer on the wall.

No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall."

part.

Also, using an overlay array in 21th century seems a bit idiot, duh-uh??

>>  Koos said on 05/13/09 14:38:25

Koos Drewd, you cannot use DSPLY, limmit of 52 chars, besides, that also shows "DSPLY:" before the message, which is not part of the spec for the song ........
try a bit harder, it is not that simple, then there is the screen with subfile, an awfull lot of coding ..............

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!

Name:

eMail:

URL:

Security Code:
  
Comment: