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 CL for AS400

Date:04/20/05
Author:Werner Grzemba
URL:n/a
Comments:0
Info:n/a
Score: (3.00 in 29 votes)
    PGM
    /*  99 Bottles of Beer in AS/400 CL (Command Language)           */
    /*  Programmer:  Werner Grzemba, 101326.3300@compuserve.com      */

    /*  To avoid the necessity of any user action, the output is     */
    /*  sent to the status line (except of the buy-request at end)   */

             DCL        VAR(&MSG) TYPE(*CHAR) LEN(79)
             DCL        VAR(&BEER1) TYPE(*CHAR) LEN(30) VALUE(' +
                          bottles of beer on the wall, ')
             DCL        VAR(&BEER2) TYPE(*CHAR) LEN(31) VALUE('Take +
                          one down, pass it around, ')
             DCL        VAR(&BEER3) TYPE(*CHAR) LEN(78) VALUE('Go +
                          to the store and by some more... 99 +
                          bottles of beer')
             DCL        VAR(&BOTTLES) TYPE(*DEC) LEN(2 0) VALUE(99)
             DCL        VAR(&XB) TYPE(*CHAR) LEN(2)
             DCL        VAR(&RPY) TYPE(*CHAR) LEN(4)

             CHGVAR     VAR(&XB) VALUE(&BOTTLES)

    MOREBEER:
             CHGVAR     VAR(&MSG) VALUE(&XB *CAT &BEER1 *CAT &XB +
                          *CAT %SST(&BEER1 1 16))
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSG) +
                          TOPGMQ(*EXT) MSGTYPE(*STATUS)
             DLYJOB     DLY(1)
             CHGVAR     VAR(&BOTTLES) VALUE(&BOTTLES - 1)
             CHGVAR     VAR(&XB) VALUE(&BOTTLES)
             CHGVAR     VAR(&MSG) VALUE(&BEER2 *CAT &XB *CAT +
                          %SST(&BEER1 1 28))
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSG) +
                          TOPGMQ(*EXT) MSGTYPE(*STATUS)
             DLYJOB     DLY(1)
             IF         COND(&BOTTLES > 0) THEN(GOTO CMDLBL(MOREBEER))

             CHGVAR     VAR(&MSG) VALUE('No more' *CAT &BEER1 *CAT +
                          'no more' *CAT %SST(&BEER1 1 16))
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSG) +
                          TOPGMQ(*EXT) MSGTYPE(*STATUS)
             DLYJOB     DLY(2)
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&BEER3) +
                          TOPGMQ(*EXT) MSGTYPE(*INQ) KEYVAR(&RPY)

    ENDPGM

Download Source | Write Comment

Alternative Versions

Comments

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: