COBOL

Contributed by Chris Rathman

Try shapes (TRYME.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. TRYME.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 WORKING-STORAGE SECTION.
000060*
000070*  array to hold shape instances
000080   01  FILLER.
000090       02  SCRIBBLE OCCURS 2 TIMES.
000100           COPY "SHAPE-COPY.COB".
000110*          note: Since this record will hold different subclasses,
000120*          we need to allocate space for the largest subclass.  Can
000130*          either manually size the filler, or copy in largest subclass.
000140*          05  FILLER-FOR-LARGEST-SUBCLASS PIC X(6).
000150           COPY "RECTANGLE-COPY.COB".
000160   77  IX PIC 9(3) VALUE 0.
000170*
000180*  rectangle instance
000190   01  MYRECTANGLE.
000200       COPY "SHAPE-COPY.COB".
000210       COPY "RECTANGLE-COPY.COB".
000220*
000230*  variables used for passing values to methods
000240   77  PARM-X PIC 9(3) VALUE 0.
000250   77  PARM-Y PIC 9(3) VALUE 0.
000260   77  PARM-HEIGHT PIC 9(3) VALUE 0.
000270   77  PARM-WIDTH PIC 9(3) VALUE 0.
000280   77  PARM-RADIUS PIC 9(3) VALUE 0.
000290*
000300 PROCEDURE DIVISION.
000310*
000320*    create some shape instances
000330     MOVE 10 TO PARM-X
000340     MOVE 20 TO PARM-Y
000350     MOVE 5 TO PARM-WIDTH
000360     MOVE 6 TO PARM-HEIGHT
000370     CALL "RECTANGLE-INIT" USING SCRIBBLE(1), PARM-X, PARM-Y, PARM-WIDTH, PARM-HEIGHT
000380     MOVE 15 TO PARM-X
000390     MOVE 25 TO PARM-Y
000400     MOVE 8 TO PARM-RADIUS
000410     CALL "CIRCLE-INIT" USING SCRIBBLE(2), PARM-X, PARM-Y, PARM-RADIUS
000420*
000430*    iterate through the list and handle shapes polymorphically
000440     PERFORM VARYING IX FROM 1 BY 1 UNTIL IX > 2
000450        CALL SHAPE-DRAW OF SCRIBBLE(IX) USING SCRIBBLE(IX)
000460        MOVE 100 TO PARM-X
000470        MOVE 100 TO PARM-Y
000480        CALL "SHAPE-RMOVETO" USING SCRIBBLE(IX), PARM-X, PARM-Y
000490        CALL SHAPE-DRAW OF SCRIBBLE(IX) USING SCRIBBLE(IX)
000500     END-PERFORM
000510*
000520*    call a rectangle specific function
000530     MOVE 0 TO PARM-X
000540     MOVE 0 TO PARM-Y
000550     MOVE 15 TO PARM-WIDTH
000560     MOVE 15 TO PARM-HEIGHT
000570     CALL "RECTANGLE-INIT" USING MYRECTANGLE, PARM-X, PARM-Y, PARM-WIDTH, PARM-HEIGHT
000580     MOVE 30 TO PARM-WIDTH
000590     CALL "RECTANGLE-SETWIDTH" USING MYRECTANGLE, PARM-WIDTH
000600     CALL SHAPE-DRAW OF MYRECTANGLE USING MYRECTANGLE
000610*
000620     STOP RUN.
000630*
000640 END PROGRAM TRYME.

Shape class

Shape copy library (SHAPE-COPY.COB)

000010       05  SHAPE-DRAW PIC X(50).
000020       05  X PIC 9(3).
000030       05  Y PIC 9(3).

Shape init method (SHAPE-INIT.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. SHAPE-INIT.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080   77  PARM-X PIC 9(3).
000090   77  PARM-Y PIC 9(3).
000100 PROCEDURE DIVISION USING THIS, PARM-X, PARM-Y.
000110     CALL "SHAPE-MOVETO" USING THIS, PARM-X, PARM-Y
000120     EXIT PROGRAM.
000130 END PROGRAM SHAPE-INIT.

Shape getx accessor (SHAPE-GETX.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. SHAPE-GETX.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080   77  PARM-X PIC 9(3).
000090 PROCEDURE DIVISION USING THIS, PARM-X.
000100     MOVE X TO PARM-X
000110     EXIT PROGRAM.
000120 END PROGRAM SHAPE-GETX.

Shape gety accessor (SHAPE-GETY.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. SHAPE-GETY.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080   77  PARM-Y PIC 9(3).
000090 PROCEDURE DIVISION USING THIS, PARM-Y.
000100     MOVE Y TO PARM-Y
000110     EXIT PROGRAM.
000120 END PROGRAM SHAPE-GETY.

Shape setx accessor (SHAPE-SETX.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. SHAPE-SETX.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080   77  PARM-X PIC 9(3).
000090 PROCEDURE DIVISION USING THIS, PARM-X.
000100     MOVE PARM-X TO X
000110     EXIT PROGRAM.
000120 END PROGRAM SHAPE-SETX.

Shape sety accessor (SHAPE-SETY.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. SHAPE-SETY.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080   77  PARM-Y PIC 9(3).
000090 PROCEDURE DIVISION USING THIS, PARM-Y.
000100     MOVE PARM-Y TO Y
000110     EXIT PROGRAM.
000120 END PROGRAM SHAPE-SETY.

Shape moveto method (SHAPE-MOVETO.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. SHAPE-MOVETO.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080   77  PARM-X PIC 9(3).
000090   77  PARM-Y PIC 9(3).
000100 PROCEDURE DIVISION USING THIS, PARM-X, PARM-Y.
000110     CALL "SHAPE-SETX" USING THIS, PARM-X
000120     CALL "SHAPE-SETY" USING THIS, PARM-Y
000130     EXIT PROGRAM.
000140 END PROGRAM SHAPE-MOVETO.

Shape rmoveto method (SHAPE-RMOVETO.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. SHAPE-RMOVETO.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 WORKING-STORAGE SECTION.
000060   77  TEMP-X PIC 9(3).
000070   77  TEMP-Y PIC 9(3).
000080 LINKAGE SECTION.
000090   01  THIS.
000100       COPY "SHAPE-COPY.COB".
000110   77  PARM-X PIC 9(3).
000120   77  PARM-Y PIC 9(3).
000130 PROCEDURE DIVISION USING THIS, PARM-X, PARM-Y.
000140     CALL "SHAPE-GETX" USING THIS, TEMP-X
000150     CALL "SHAPE-GETY" USING THIS, TEMP-Y
000160     ADD PARM-X TO TEMP-X
000170     ADD PARM-Y TO TEMP-Y
000180     CALL "SHAPE-MOVETO" USING THIS, TEMP-X, TEMP-Y
000190     EXIT PROGRAM.
000200 END PROGRAM SHAPE-RMOVETO.

Rectangle class

Rectangle copy library (RECTANGLE-COPY.COB)

000010       05  WIDTH PIC 9(3).
000020       05  HEIGHT PIC 9(3).

Rectangle init method (RECTANGLE-INIT.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. RECTANGLE-INIT.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080       COPY "RECTANGLE-COPY.COB".
000090   77  PARM-X PIC 999.
000100   77  PARM-Y PIC 999.
000110   77  PARM-WIDTH PIC 999.
000120   77  PARM-HEIGHT PIC 999.
000130 PROCEDURE DIVISION USING THIS, PARM-X, PARM-Y, PARM-WIDTH, PARM-HEIGHT.
000140     MOVE "RECTANGLE-DRAW" TO SHAPE-DRAW
000150     CALL "SHAPE-INIT" USING THIS, PARM-X, PARM-Y
000160     CALL "RECTANGLE-SETWIDTH" USING THIS, PARM-WIDTH
000170     CALL "RECTANGLE-SETHEIGHT" USING THIS, PARM-HEIGHT
000180     EXIT PROGRAM.
000190 END PROGRAM RECTANGLE-INIT.

Rectangle getwidth accessor (RECTANGLE-GETWIDTH.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. RECTANGLE-GETWIDTH.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080       COPY "RECTANGLE-COPY.COB".
000090   77  PARM-WIDTH PIC 9(3).
000100 PROCEDURE DIVISION USING THIS, PARM-WIDTH.
000110     MOVE WIDTH TO PARM-WIDTH
000120     EXIT PROGRAM.
000130 END PROGRAM RECTANGLE-GETWIDTH.

Rectangle getheight accessor (RECTANGLE-GETHEIGHT.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. RECTANGLE-GETHEIGHT.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080       COPY "RECTANGLE-COPY.COB".
000090   77  PARM-HEIGHT PIC 9(3).
000100 PROCEDURE DIVISION USING THIS, PARM-HEIGHT.
000110     MOVE HEIGHT TO PARM-HEIGHT
000120     EXIT PROGRAM.
000130 END PROGRAM RECTANGLE-GETHEIGHT.

Rectangle setwidth accessor (RECTANGLE-SETWIDTH.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. RECTANGLE-SETWIDTH.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080       COPY "RECTANGLE-COPY.COB".
000090   77  PARM-WIDTH PIC 9(3).
000100 PROCEDURE DIVISION USING THIS, PARM-WIDTH.
000110     MOVE PARM-WIDTH TO WIDTH
000120     EXIT PROGRAM.
000130 END PROGRAM RECTANGLE-SETWIDTH.

Rectangle setheight accessor (RECTANGLE-SETHEIGHT.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. RECTANGLE-SETHEIGHT.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080       COPY "RECTANGLE-COPY.COB".
000090   77  PARM-HEIGHT PIC 9(3).
000100 PROCEDURE DIVISION USING THIS, PARM-HEIGHT.
000110     MOVE PARM-HEIGHT TO HEIGHT
000120     EXIT PROGRAM.
000130 END PROGRAM RECTANGLE-SETHEIGHT.

Rectangle draw method (RECTANGLE-DRAW.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. RECTANGLE-DRAW.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080       COPY "RECTANGLE-COPY.COB".
000090 PROCEDURE DIVISION USING THIS.
000100     DISPLAY "Drawing a Rectangle at:(", X, ",", Y,
000110        "), Width ", WIDTH, ", Height ", HEIGHT
000120     EXIT PROGRAM.
000130 END PROGRAM RECTANGLE-DRAW.

Circle class

Circle copy library (CIRCLE-COPY.COB)

000010       05  RADIUS PIC 9(3).

Circle init method (CIRCLE-INIT.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. CIRCLE-INIT.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080       COPY "CIRCLE-COPY.COB".
000090   77  PARM-X PIC 9(3).
000100   77  PARM-Y PIC 9(3).
000110   77  PARM-RADIUS PIC 999.
000120 PROCEDURE DIVISION USING THIS, PARM-X, PARM-Y, PARM-RADIUS.
000130     MOVE "CIRCLE-DRAW" TO SHAPE-DRAW
000140     CALL "SHAPE-INIT" USING THIS, PARM-X, PARM-Y
000150     CALL "CIRCLE-SETRADIUS" USING THIS, PARM-RADIUS
000160     EXIT PROGRAM.
000170 END PROGRAM CIRCLE-INIT.

Circle getradius accessor (CIRCLE-GETRADIUS.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. CIRCLE-GETRADIUS.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080       COPY "CIRCLE-COPY.COB".
000090   77  PARM-RADIUS PIC 9(3).
000100 PROCEDURE DIVISION USING THIS, PARM-RADIUS.
000110     MOVE RADIUS TO PARM-RADIUS
000120     EXIT PROGRAM.
000130 END PROGRAM CIRCLE-GETRADIUS.

Circle setradius accessor (CIRCLE-SETRADIUS.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. CIRCLE-SETRADIUS.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080       COPY "CIRCLE-COPY.COB".
000090   77  PARM-RADIUS PIC 9(3).
000100 PROCEDURE DIVISION USING THIS, PARM-RADIUS.
000110     MOVE PARM-RADIUS TO RADIUS
000120     EXIT PROGRAM.
000130 END PROGRAM CIRCLE-SETRADIUS.

Circle draw method (CIRCLE-DRAW.COB)

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. CIRCLE-DRAW.
000030 ENVIRONMENT DIVISION.
000040 DATA DIVISION.
000050 LINKAGE SECTION.
000060   01  THIS.
000070       COPY "SHAPE-COPY.COB".
000080       COPY "CIRCLE-COPY.COB".
000090 PROCEDURE DIVISION USING THIS.
000100     DISPLAY "Drawing a Circle at:(", X, ",", Y, "), Radius ", RADIUS
000110     EXIT PROGRAM.
000120 END PROGRAM CIRCLE-DRAW.

Output

Drawing a Rectangle at:(010,020), Width 005, Height 006
Drawing a Rectangle at:(110,120), Width 005, Height 006
Drawing a Circle at:(015,025), Radius 008
Drawing a Circle at:(115,125), Radius 008
Drawing a Rectangle at:(000,000), Width 030, Height 015

Chris Rathman / Chris.Rathman@tx.rr.com