+ X-NEWS: spcvxb alt.folklore.computers: 7382 I Relay-Version: VMS News - V6.0 13.10.90 VAX/VMS V5.4; site spcvxb.spc.edu g Path: spcvxb.spc.edu!njin!princeton!udel!wuarchive!zaphod.mps.ohio-state.edu!van-bc!rsoft!mindlink!a218 " Newsgroups: alt.folklore.computers0 Subject: The Common Business-Oriented Goldilocks  Message-ID: <4509@mindlink.UUCP>( From: a218@mindlink.UUCP (Charlie Gibbs) Date: 20 Jan 91 16:58:51 GMT3 Organization: MIND LINK! - British Columbia, Canada 
 Lines: 154   OK, by popular demand, here's   ' THE COMMON BUSINESS-ORIENTED GOLDILOCKS   > (which originally appeared in an ancient issue of Datamation):     000001 IDENTIFICATION DIVISION. " 000002 PROGRAM-ID.    ACOBOLFABLE.' 000003 DATE-WRITTEN.  ONCE UPON A TIME. 1 000004* THIS IS AN EXAMPLE OF COBOLX VERSATILITY.  000005 000006 000007 000008 ENVIRONMENT DIVISION. 000009 CONFIGURATION SECTION. D 000010 OBJECT-COMPUTER.  ANY MUSIC-BOX, MEMORY SIZE 8**64 CHARACTERS8 000011                   19 TAPE-DRIVES, 11 DISC-DRIVES,/ 000012                   1 GOLDILOCKS, 3 BEARS.  000013 INPUT-OUTPUT SECTION. 000014 FILE-CONTROL.2 000015     SELECT TAPE-DRIVES, ASSIGN TO CREDITOR. 000016     SELECT DISC-DRIVES.B 000017     SELECT GOLDILOCKS, SELECT BEARS; ASSIGN TO ONE-COTTAGE. 000018 I-O-CONTROL. / 000019     APPLY RED-TAPE        ON TAPE-DRIVES . 000020     APPLY HOFFNUNG-RECORD ON DISC-DRIVE, 000021     APPLY GOLDI, BEARS    ON COTTAGE. 000022 000023 000024 000025 DATA DIVISION.  000026 FILE SECTION. 000027 FD GOLDI % 000028     LABEL RECORDS ARE STANDARD + 000029     VALUE OF FILE-ID IS 'GOLDILOCKS' % 000030     DATA RECORD IS GOLDILOCKS.  000031 01 GOLDILOCKS. ! 000032     02 HGT SIZE IS 62 INS. " 000033     02 WGT SIZE IS 110 LBS. 000034     02 VITAL-STATS. 000035         03 B 38.  000036         03 W 24.  000037         03 H 36.  000038     02 RATING 100%. 000039 01 FD 3-BEARS% 000040     LABEL RECORDS ARE STANDARD & 000041     VALUE OF FILE-ID IS 'BEARS'> 000042     DATA RECORDS ARE DADDY-BEAR, MUMMY-BEAR, BABY-BEAR. 000043 01 DADDY-BEAR.  000044     02 HGT 70 INS.  000045     02 WGT 750 LBS.& 000046     02 COLOR OF EYES BLOODSHOT.% 000047     02 DISPOSITION UNBEARABLE.  000048 01 MUMMY-BEAR.  000049     02 HGT 65 INS.  000050     02 WGT 700 LBS.! 000051     02 COLOR OR EYES BLUE. # 000052     02 DISPOSITION BEARABLE.  000053 01 BABY-BEAR. 000054     02 HGT 40 INS.  000055     02 WGT 200 LBS.! 000056     02 COLOR OF EYES BLUE. $ 000057     02 DISPOSITION INFANTILE. 000058 000059 WORKING-STORAGE SECTION. # 000060 01 COTTAGE  PICTURE IS COZY.  000061     02 KITCHEN.5 000062         03 TABLE   SIZE IS LARGE,  VALUE IS 1. 5 000063         03 CHAIRS  SIZE IS MEDIUM, VALUE IS 3.  000064     02 PORRIDGE. - 000065         03 KING-SIZE   OCCURS 1 TIMES. - 000066         03 QUEEN-SIZE  OCCURS 1 TIMES. - 000067         03 PRINCE-SIZE OCCURS 1 TIMES. 1 000068     02 DOOR  SIZE IS USUAL, VALUE IS OPEN.  000069     02 BEDROOM. 000070         03 BED.- 000071             04 LARGE   OCCURS 1 TIMES. - 000072             04 MEDIUM  OCCURS 1 TIMES. - 000073             04 SMALL   OCCURS 1 TIMES. 7 000074         03 WINDOW  SIZE IS SMALL, VALUE IS OPEN. 9 000075 01 RIGHT-COTTAGE REDEFINES COTTAGE, VALUE IS SAME. H 000076 01 KING-SIZE-BED-SLEPT-IN   SIZE IS BIG,    VALUE IS ROCK-BOTTOM.F 000077 01 QUEEN-SIZE-BED-SLEPT-IN  SIZE IS MEDIUM, VALUE IS DEPRESSED.8 000078 01 NO-PORRIDGE  SIZE IS SMALL,     VALUE IS ZERO.< 000079 01 SIP          SIZE IS LITTLE,    VALUE IS 'SSSLUP'.> 000080 01 SLUMBERLAND  SIZE IS UNLIMITED, VALUE IS ZZZZZZZZZZ. 000081 CONSTANT SECTION. 000082 01 COMMENT1  PIC X(36) 8 000083     VALUE 'SOMEBODY HAS BEEN EATING MY PORRIDGE'. 000084 01 COMMENT2  PIC X(36) 8 000085     VALUE 'SOMEBODY HAS BEEN SLEEPING IN MY BED'. 000086 000087 000088 000089 PROCEDURE DIVISION. 000090 FOREST SECTION. 000091 START-OF-TALE. ' 000092     OPEN STORY.  READ FOLLOWING.  000093 FIRST-MOVE.& 000094     MOVE GOLDILOCKS TO COTTAGE.; 000095     IF DOOR IS CLOSED OR BEARS ARE GREATER THAN ZERO B 000096         ALTER ENTER-GOLDILOCKS TO PROCEED TO HASTY-RETREAT. 000097 ENTER-GOLDILOCKS. 000098     GO TO KITCHEN-SCENE.  000099 KITCHEN-SCENE. " 000100     IF PORRIDGE = KING-SIZE$ 000101         PERFORM TASTE-ROUTINE7 000102             VARYING PORRIDGE FROM KING-SIZE BY 1 / 000103             UNTIL PORRIDGE = PRINCE-SIZE  000104     ELSE 2 000105         COMPUTE IF COTTAGE = RIGHT-COTTAGE. 000106     GO TO BEDROOM-SCENE.  000107 TASTE-ROUTINE. 2 000108     SUBTRACT SIP FROM PORRIDGE (KING-SIZE).3 000109     SUBTRACT SIP FROM PORRIDGE (QUEEN-SIZE). G 000110     SUBTRACT SIP FROM PORRIDGE (PRINCE-SIZE) GIVING NO-PORRIDGE.  000111 BEDROOM-SCENE. & 000112     MOVE GOLDILOCKS TO BEDROOM.) 000113     ADD GOLDILOCKS TO BED (LARGE). $ 000114     DISPLAY 'IT IS TOO HARD'./ 000115     SUBTRACT GOLDILOCKS FROM BED (LARGE) - 000116         GIVING KING-SIZE-BED-SLEPT-IN. + 000117     MOVE GOLDILOCKS TO BED (MEDIUM). $ 000118     DISPLAY 'IT IS TOO SOFT'.0 000119     SUBTRACT GOLDILOCKS FROM BED (MEDIUM). 000120         GIVING QUEEN-SIZE-BED-SLEPT-IN.* 000121     MOVE GOLDILOCKS TO BED (SMALL).& 000122     DISPLAY 'IT IS JUST RIGHT'.) 000123     ADD GOLDILOCKS TO SLUMBERLAND.  000124 BEARS-RETURN.= 000125     MOVE DADDY-BEAR, MUMMY-BEAR, BABY-BEAR TO KITCHEN. 0 000126     MOVE CORRESPONDING BEARS TO PORRIDGE.* 000127     DISPLAY 'DADDY BEAR', COMMENT1.* 000128     DISPLAY 'MUMMY BEAR', COMMENT1.@ 000129     DISPLAY 'BABY BEAR', COMMENT1, 'AND EATEN IT ALL UP'.! 000130     MOVE BEARS TO BEDROOM.  000131 BEARS-IN-BEDROOM.: 000132     INSPECT BEDS REPLACING ALL GOLDILOCKS BY BEARS.* 000133     DISPLAY 'DADDY BEAR', COMMENT2.* 000134     DISPLAY 'MUMMY BEAR', COMMENT2.< 000135     DISPLAY 'BABY BEAR', COMMENT2, 'AND HERE SHE IS'. 000136 HASTY-RETREAT.  000137     IF WINDOW IS OPEN 000138         EXIT GOLDILOCKS 000139     ELSE ' 000140         MOVE GOLDILOCKS TO DOOR.  000141     EXIT. 000142 END.  000143     CLOSE STORY. : 000144     DISPLAY 'WOULD YOU BELIEVE CINDERELLA IN PL/I'. 000145     END TALE.C 000146* "THE COMMON BUSINESS-ORIENTED GOLDILOCKS" BY PHILIP STANLEY H 000147*                           (CONVERTED TO ANSI74 BY CHARLIE GIBBS)