Printing out a square/triangle

[Bookashade]

Hello,

I would like to print out a square, but the part that has got me stuck is that it has to be dynamic, depending on user input. Also, the square has to be made of 'o' characters.
So, say for instance that the user gets to choose a number between 2-10 and selects 5, a square has to be printed that is 5 'o' 's wide and 5 'o' 's long. The inner square is made of dots:

ooooo
o . . . o
o . . . o
o . . . o
ooooo

I also have to do this in a pyramid, say for example that the user selects 5 again then it has to look like this(including the .'s):
....o....
...ooo...
..ooooo..
.ooooooo.
ooooooooo

Here I noticed the pattern that the dots always start with input -1 and the o's increment by +2 each line. But I don't know how to implement this.

Could someone tell me the syntax how to pull this off in CL? I'm writing a script which I compile and call to execute it.

[Scott Klement]

Why on earth would someone want to do this? What practical purpose does it serve?

And... how do you print stuff from CL? Well,okay, I know of a few ways, but it certainly isn't a normal CL task. More likely this would be done in RPG.

Why are you doing this? Someone trying to create a challenge just to see if it's possible?

[Scott Klement]

I decided to take on the challenge... this was kind of fun to do, but it is not a common task to do in CL, and would've been easier in an HLL like RPG. Still, it was fun to try doing it in CL.

To try it, copy/paste the code below into a source member and compile it like this:

CRTBNDCL PGM(SHAPECL) SRCFILE(QCLSRC)

Run it like this:

CALL PGM(SHAPECL) PARM(SQUARE 40)
-or-
CALL PGM(SHAPECL) PARM(TRIANGLE 31)

The first parameter must be either square or triangle (or it will do nothing) the second parameter must be the desired width of the shape. The output goes to the spool, view it with WRKSPLF.

Here's the source code:

PGM PARM(&TYPE &SIZE)

   DCL VAR(&TYPE)   TYPE(*CHAR) LEN(8)
   DCL VAR(&SIZE)   TYPE(*DEC)  LEN(15 5)

   DCL VAR(&WIDTH)  TYPE(*INT)  LEN(4)
   DCL VAR(&HEIGHT) TYPE(*INT)  LEN(4)
   DCL VAR(&START)  TYPE(*INT)  LEN(4)
   DCL VAR(&END)    TYPE(*INT)  LEN(4)
   DCL VAR(&ROW)    TYPE(*INT)  LEN(4)
   DCL VAR(&COL)    TYPE(*INT)  LEN(4)
   DCL VAR(&REC)    TYPE(*CHAR) LEN(132)
   DCL VAR(&ROWWIDTH) TYPE(*INT)  LEN(4)

   DCL VAR(&PRINTER)  TYPE(*PTR)
   DCL VAR(&FILENAME) TYPE(*CHAR) LEN(32) VALUE('QSYS/QSYSPRT')
   DCL VAR(&MODE)     TYPE(*CHAR) LEN(32) VALUE('wr')
   DCL VAR(&NULL)     TYPE(*CHAR) LEN(1)  VALUE(x'00')

   CALLSUBR OPENPRINT

   IF (&TYPE *EQ SQUARE) DO
      CALLSUBR SQUARE
   ENDDO

   IF (&TYPE *EQ TRIANGLE) DO
      CALLSUBR TRIANGLE
   ENDDO

   CALLSUBR CLOSEPRINT

   RETURN



   SUBR SQUARE

     CHGVAR VAR(&WIDTH) VALUE(&SIZE)
     CHGVAR VAR(&HEIGHT) VALUE(&SIZE)

     DOFOR VAR(&ROW) FROM(1) TO(&HEIGHT)

        CHGVAR VAR(&REC) VALUE(' ')
        DOFOR VAR(&COL) FROM(1) TO(&WIDTH)
           CHGVAR VAR(%SST(&REC &COL 1)) VALUE('.')
        ENDDO

        DOFOR VAR(&COL) FROM(1) TO(&WIDTH)

           IF (&COL *EQ 1 *OR &COL *EQ &WIDTH +
               *OR &ROW *EQ 1 *OR &ROW *EQ &HEIGHT) DO
              CHGVAR VAR(%SST(&REC &COL 1)) VALUE('o')
           ENDDO

        ENDDO

        CALLSUBR PRINT

     ENDDO

   ENDSUBR



   SUBR TRIANGLE

      CHGVAR VAR(&WIDTH) VALUE(&SIZE)

      DOFOR VAR(&ROWWIDTH) FROM(1) TO(&WIDTH) BY(2)

         CHGVAR VAR(&REC) VALUE(' ')
         CHGVAR VAR(&START) VALUE(((&SIZE - &ROWWIDTH) / 2) + 1)
         CHGVAR VAR(&END) VALUE((&START + &ROWWIDTH) - 1)

         DOFOR VAR(&COL) FROM(1) TO(&WIDTH)
            IF (&COL *GE &START *AND &COL *LE &END) DO
               CHGVAR VAR(%SST(&REC &COL 1)) VALUE('o')
            ENDDO
            ELSE DO
               CHGVAR VAR(%SST(&REC &COL 1)) VALUE('.')
            ENDDO
         ENDDO

         CALLSUBR PRINT

      ENDDO

   ENDSUBR


   SUBR OPENPRINT
      OVRPRTF FILE(QSYSPRT) HOLD(*YES)

      CHGVAR VAR(&FILENAME) VALUE(&FILENAME *TCAT &NULL)
      CHGVAR VAR(&MODE)     VALUE(&MODE *TCAT &NULL)
      CALLPRC PRC('_Ropen') PARM(&FILENAME &MODE) RTNVAL(&PRINTER)
   ENDSUBR

   SUBR PRINT
      CALLPRC PRC('_Rwrite') PARM((&PRINTER *BYVAL) +
                                  (&REC     *BYREF) +
                                  (&WIDTH   *BYVAL) )
   ENDSUBR

   SUBR CLOSEPRINT
      CALLPRC PRC('_Rclose') PARM((&PRINTER *BYVAL))
      DLTOVR FILE(QSYSPRT)
   ENDSUBR
ENDPGM

[TedHolt]

I hope Bookashade answers soon. I am dying of curiosity wondering why anybody would need such a program.