aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy dot Net 2024-04-19 16:56:29 -07:00
parent 0df55f9f24
commit aec8ed51b6
1045 changed files with 18889 additions and 2777 deletions
Download patch file Download diff file Expand all files Collapse all files

89
Task/Magic-8-ball/COBOL/magic-8-ball.cobol Normal file
View file

@ -0,0 +1,89 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. 8BALL.
AUTHOR. Bill Gunshannon
INSTALLATION.
DATE-WRITTEN. 12 March 2024
************************************************************
** Program Abstract:
** Just ask the Magic 8 Ball and all will be revealed.
************************************************************
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ANSWER-TABLE.
10 ANSWER01 PIC X(40)
VALUE "As I see it, yes ".
10 ANSWER02 PIC X(40)
VALUE "Ask again later ".
10 ANSWER03 PIC X(40)
VALUE "Better not tell you now ".
10 ANSWER04 PIC X(40)
VALUE "Cannot predict now ".
10 ANSWER05 PIC X(40)
VALUE "Concentrate and ask again ".
10 ANSWER06 PIC X(40)
VALUE "Don't bet on it ".
10 ANSWER07 PIC X(40)
VALUE "It is certain ".
10 ANSWER08 PIC X(40)
VALUE "It is decidedly so ".
10 ANSWER09 PIC X(40)
VALUE "Most likely ".
10 ANSWER10 PIC X(40)
VALUE "My reply is no ".
10 ANSWER11 PIC X(40)
VALUE "My sources say maybe ".
10 ANSWER12 PIC X(40)
VALUE "My sources say no ".
10 ANSWER13 PIC X(40)
VALUE "Outlook good ".
10 ANSWER14 PIC X(40)
VALUE "Outlook not so good ".
10 ANSWER15 PIC X(40)
VALUE "Reply hazy, try again ".
10 ANSWER16 PIC X(40)
VALUE "Signs point to yes ".
10 ANSWER17 PIC X(40)
VALUE "Very doubtful ".
10 ANSWER18 PIC X(40)
VALUE "Without a doubt ".
10 ANSWER19 PIC X(40)
VALUE "Yes ".
10 ANSWER20 PIC X(40)
VALUE "Yes, definitely ".
10 ANSWER21 PIC X(40)
VALUE "Yes, probably not ".
10 ANSWER22 PIC X(40)
VALUE "You may rely on it ".
10 ANSWER23 PIC X(40)
VALUE "Your question has already been answered ".
01 PRINT-ANSWER REDEFINES ANSWER-TABLE OCCURS 23 TIMES.
10 THE-BALL-SPEAKS PIC X(40).
01 RND PIC 99999.
01 QUESTION PIC X(72).
01 GREETING PIC X(30)
VALUE "Ask and all will be revealed!!".
PROCEDURE DIVISION.
Main-Program.
DISPLAY GREETING.
ACCEPT QUESTION.
MOVE FUNCTION CURRENT-DATE(1:16) TO RND.
PERFORM 8-BALL.
STOP RUN.
8-BALL.
COMPUTE RND =
FUNCTION RANDOM(RND) * 11111.
DISPLAY PRINT-ANSWER(FUNCTION MOD(RND, 23)).
END-PROGRAM.

127
Task/Magic-8-ball/PL-M/magic-8-ball.plm Normal file
View file

@ -0,0 +1,127 @@
100H:
/*
THE PROCEDURES CLOCK AND RND USE A FEATURE OF PICKLES AND TROUT CP/M2
AND ARE NOT LIKELY TO WORK ON OTHER VERSIONS OF CP/M
*/
BDOS: PROCEDURE (FN, ARG) BYTE; DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; MEMORY(0)=BDOS(0,0); END EXIT;
TTYIN: PROCEDURE BYTE; DECLARE C BYTE; RETURN BDOS(1,0); END TTYIN;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; S=BDOS(9,S); END PRINT;
CLOCK: PROCEDURE;
DECLARE B$ADR ADDRESS; DECLARE B BASED B$ADR BYTE;
B$ADR=047H;
B = 0EH; GO TO 043H; END CLOCK;
RND: PROCEDURE ADDRESS;
DECLARE E$ADR ADDRESS; DECLARE E BASED E$ADR BYTE;
DECLARE D$ADR ADDRESS; DECLARE D BASED D$ADR BYTE;
DECLARE L$ADR ADDRESS; DECLARE L BASED L$ADR BYTE;
DECLARE H$ADR ADDRESS; DECLARE H BASED H$ADR BYTE;
DECLARE (NUM, DE, HL) ADDRESS;
E$ADR=048H; D$ADR=049H; L$ADR=04AH; H$ADR=04BH;
CALL CLOCK;
DE = D * 255 + E; HL = H * 255 + L; NUM = DE * HL; RETURN NUM;
END RND;
EIGHTBALL: DO;
DECLARE CR LITERALLY '13';
DECLARE CRLF(3) BYTE INITIAL (13,10,'$');
DECLARE CHR BYTE;
DECLARE NUM ADDRESS;
DECLARE GREETING(30) BYTE INITIAL
('ASK AND ALL WILL BE REVEALED $');
DECLARE MSG01(41) BYTE INITIAL
( 'AS I SEE IT, YES $' );
DECLARE MSG02(41) BYTE INITIAL
( 'ASK AGAIN LATER $' );
DECLARE MSG03(41) BYTE INITIAL
( 'BETTER NOT TELL YOU NOW $' );
DECLARE MSG04(41) BYTE INITIAL
( 'CANNOT PREDICT NOW $' );
DECLARE MSG05(41) BYTE INITIAL
( 'CONCENTRATE AND ASK AGAIN $' );
DECLARE MSG06(41) BYTE INITIAL
( 'DON''T BET ON IT $' );
DECLARE MSG07(41) BYTE INITIAL
( 'IT IS CERTAIN $' );
DECLARE MSG08(41) BYTE INITIAL
( 'IT IS DECIDEDLY SO $' );
DECLARE MSG09(41) BYTE INITIAL
( 'MOST LIKELY $' );
DECLARE MSG10(41) BYTE INITIAL
( 'MY REPLY IS NO $' );
DECLARE MSG11(41) BYTE INITIAL
( 'MY SOURCES SAY MAYBE $' );
DECLARE MSG12(41) BYTE INITIAL
( 'MY SOURCES SAY NO $' );
DECLARE MSG13(41) BYTE INITIAL
( 'OUTLOOK GOOD $' );
DECLARE MSG14(41) BYTE INITIAL
( 'OUTLOOK NOT SO GOOD $' );
DECLARE MSG15(41) BYTE INITIAL
( 'REPLY HAZY, TRY AGAIN $' );
DECLARE MSG16(41) BYTE INITIAL
( 'SIGNS POINT TO YES $' );
DECLARE MSG17(41) BYTE INITIAL
( 'VERY DOUBTFUL $' );
DECLARE MSG18(41) BYTE INITIAL
( 'WITHOUT A DOUBT $' );
DECLARE MSG19(41) BYTE INITIAL
( 'YES $' );
DECLARE MSG20(41) BYTE INITIAL
( 'YES, DEFINITELY $' );
DECLARE MSG21(41) BYTE INITIAL
( 'YES, PROBABLY NOT $' );
DECLARE MSG22(41) BYTE INITIAL
( 'YOU MAY RELY ON IT $' );
DECLARE MSG23(41) BYTE INITIAL
( 'YOUR QUESTION HAS ALREADY BEEN ANSWERED $' );
NUM = RND MOD 24;
CALL PRINT(.GREETING);
CALL PRINT(.CRLF);
DO WHILE CHR <> CR;
CHR = TTYIN;
END;
CALL PRINT(.CRLF);
DO CASE NUM;
CALL PRINT(.MSG01);
CALL PRINT(.MSG02);
CALL PRINT(.MSG03);
CALL PRINT(.MSG04);
CALL PRINT(.MSG05);
CALL PRINT(.MSG06);
CALL PRINT(.MSG07);
CALL PRINT(.MSG08);
CALL PRINT(.MSG09);
CALL PRINT(.MSG10);
CALL PRINT(.MSG11);
CALL PRINT(.MSG12);
CALL PRINT(.MSG13);
CALL PRINT(.MSG14);
CALL PRINT(.MSG15);
CALL PRINT(.MSG16);
CALL PRINT(.MSG17);
CALL PRINT(.MSG18);
CALL PRINT(.MSG19);
CALL PRINT(.MSG20);
CALL PRINT(.MSG21);
CALL PRINT(.MSG22);
CALL PRINT(.MSG23);
END;
CALL PRINT(.CRLF);
CALL EXIT;
END;
EOF